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

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

to macro keyword table. 13779 13780 000227'01 201 01 0 00 000000# movei t1, mactab ; Stick it in the macro table. 13781 000230'01 514 02 0 00 000007 hrlz t2, q3 ; Address of keyword,, 13782 000231'01 540 02 0 00 000010 hrr t2, q4 ; argument (address of body) 13783 000232'01 104 00 0 00 000536 TBADD% ; Inserting it should always work 13784 000233'01 320 12 0 00 000235' %jserr (,r) ; Must have missed a case, above 13785 000234'01 254 00 0 00 000240' 13786 000235'01 265 01 0 00 000206* 13787 000236'01 000000000000# 13788 000237'01 254 00 0 00 000210* 13789 000055'04 105 162 162 157 162 13790 000240'01 263 17 0 00 000000 ret 13791 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 4 K20MAC MAC 30-Jun-23 17:21 /UNDEFINE processing 13792 subttl /UNDEFINE processing 13793 13794 ; Come here directly to undefine an existing macro. 13795 ; First look it up. We should ALWAYS find it because we don't come 13796 ; here unless we had a keyword match in the first place. 13797 13798 000241'01 332 02 0 00 000000# $defi7: skipe t2, tbent ; Do we already have the keyword? 13799 000242'01 254 00 0 00 000267' ifskp. ; No, go get it 13800 000243'01 201 01 0 00 000000# movei t1, mactab ; Yes, look up its address in the kwd table. 13801 000244'01 200 02 0 00 000000# move t2, onamp ; Pointer to macro name. 13802 000245'01 104 00 0 00 000537 TBLUK% ; See if it's in there (should be) 13803 000246'01 320 12 0 00 000250' %jserr (,r) 13804 000247'01 254 00 0 00 000253' 13805 000250'01 265 01 0 00 000235* 13806 000251'01 000000000000# 13807 000252'01 254 00 0 00 000237* 13808 000062'04 103 157 165 154 144 13809 000253'01 603 02 0 00 040000 ifxe. t2, tl%exm ;[194] Found an exact match? 13810 000254'01 254 00 0 00 000266' 13811 000255'01 200 01 0 00 000000# txmsg <% "> ;[194] ;" No, warn. 13812 000256'01 104 00 0 00 000076 13813 000257'01 320 12 0 00 000260' 13814 000014'02 000000000000# 13815 000074'04 045 040 042 000 000 13816 000260'01 200 01 0 00 000000# move t1, onamp 13817 000261'01 104 00 0 00 000076 PSOUT 13818 000262'01 200 01 0 00 000000# txmsg < " not found in SET macro table> ;[194] ;" Font crock 13819 000263'01 104 00 0 00 000076 13820 000264'01 320 12 0 00 000265' 13821 000015'02 000000000000# 13822 000075'04 040 042 040 156 157 13823 000265'01 263 17 0 00 000000 ret 13824 000266'01 endif. ;[194] 13825 000266'01 200 02 0 00 000001 move t2, t1 ; The address we just got. 13826 000267'01 endif. ; End case didn't already have entry 13827 13828 ; Using the table index just obtained, delete the entry. 13829 13830 000267'01 201 01 0 00 000000# movei t1, mactab 13831 remark t2, ; Either already had it or found it 13832 000270'01 104 00 0 00 000535 TBDEL% ; Delete the old entry. 13833 000271'01 320 12 0 00 000273' %jserr (,r) 13834 000272'01 254 00 0 00 000276' 13835 000273'01 265 01 0 00 000250* 13836 000274'01 000000000000# 13837 000275'01 254 00 0 00 000252* 13838 000104'04 103 157 165 154 144 13839 000276'01 263 17 0 00 000000 ret 13840 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 5 K20MAC MAC 30-Jun-23 17:21 /UNDEFINE parsing 13841 subttl /UNDEFINE parsing 13842 13843 000277'01 260 17 0 00 000000* .undef: confrm ; Confirm the line 13844 000300'01 263 17 0 00 000000 ret ; Done 13845 13846 remark The reason there is no $UNDEF 13847 13848 ; Since the macro has no body, the default action is to remove it. Thus, 13849 ; /UNDEFINE doesn't really do anything other than function as a kind of 13850 ; 'syntactic sugar'. 13851 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 6 K20MAC MAC 30-Jun-23 17:21 /DUPLICATE parsing 13852 subttl /DUPLICATE parsing 13853 13854 000301'01 200 16 0 00 000000# .dupli: guide ; Macro definition 13855 000302'01 260 17 0 00 000052* 13856 000016'02 000000000000# 13857 000116'04 164 157 040 141 040 13858 movei t1, [ 13859 flddb. .cmqst,,,,,[ 13860 flddb. .cmfld,,,,, 13861 000303'01 201 01 0 00 002526' ]] 13862 13863 000304'01 260 17 0 00 000061* call rfield ; Get the macro name 13864 dmove t1, [ mactab ; Load the address of the keyword table 13865 000305'01 120 01 0 00 002531' point 7, atmbuf ] ; And a pointer to the atom buffer 13866 000306'01 104 00 0 00 000537 TBLUK% ; See if it's in there (shouldn't be) 13867 000307'01 320 12 0 00 000311' %jserr (,cmder1) ; Fail, allow a ^H 13868 000310'01 254 00 0 00 000314' 13869 000311'01 265 01 0 00 000273* 13870 000312'01 000000 000000 13871 000313'01 254 00 0 00 000033* 13872 13873 000314'01 607 02 0 00 040000 ifxn. t2, tl%exm ; Found an exact match? 13874 000315'01 254 00 0 00 000326' 13875 000316'01 200 01 0 00 000000# emsg ;" font crock mode 13876 000317'01 104 00 0 00 000313 13877 000017'02 000000000000# 13878 000123'04 124 150 145 040 162 13879 000320'01 561 01 0 00 000215* hrroi t1, atmbuf ; Point to the atom buffer 13880 000321'01 104 00 0 00 000076 PSOUT% ; Type the new name which won't work 13881 000322'01 200 01 0 00 000000# txmsg <" already exists> ;" font crock mode 13882 000323'01 104 00 0 00 000076 13883 000324'01 320 12 0 00 000325' 13884 000020'02 000000000000# 13885 000132'04 042 040 141 154 162 13886 000325'01 254 00 0 00 000313* jrst cmder1 ; Allow ^H 13887 000326'01 endif. 13888 13889 dmove t1, [point 7, atmbuf ; Load pointer to new keyword 13890 000326'01 120 01 0 00 002441' point 7, namatm] ; And a pointer to the macro name buffer 13891 000327'01 260 17 0 00 000102* call asczcp ; Copy the ASCIZ string over 13892 000330'01 202 03 0 00 000113* movem t3, namlen ; Save the length of what we copied 13893 13894 000331'01 260 17 0 00 000277* confrm ; Tie off the line 13895 13896 000332'01 201 01 0 00 002533' movei t1, [.dupli,,$dupli] ;Load our own semantic action 13897 000333'01 202 01 0 00 000000* movem t1, pars1 ; Stomp top-level parse, we're taking it from here 13898 000334'01 263 17 0 00 000000 ret ; Return into /DUPLICATE semantic action 13899 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 7 K20MAC MAC 30-Jun-23 17:21 /DUPLICATE semantic action 13900 subttl /DUPLICATE semantic action 13901 13902 000335'01 265 16 0 00 002466' $dupli: saveac ; MUST have same register usage as $defin!! 13903 000336'01 332 10 0 00 000000# skipe q4, tbent ; Already have the table address? 13904 000337'01 254 00 0 00 000366' ifskp. ; No, go find it 13905 000340'01 201 01 0 00 000000# movei t1, mactab ; Load the address of the keyword table 13906 000341'01 200 02 0 00 000000# move t2, onamp ; And the keyword text pointer 13907 000342'01 104 00 0 00 000537 TBLUK% ; See if it's in there (should be) 13908 000343'01 320 12 0 00 000345' %jserr (,r) 13909 000344'01 254 00 0 00 000350' 13910 000345'01 265 01 0 00 000311* 13911 000346'01 000000000000# 13912 000347'01 254 00 0 00 000275* 13913 000136'04 105 162 162 157 162 13914 000350'01 603 02 0 00 040000 ifxe. t2, tl%exm ; Found an exact match? 13915 000351'01 254 00 0 00 000365' 13916 000352'01 200 01 0 00 000000# emsg ;" No, bomb 13917 000353'01 104 00 0 00 000313 13918 000021'02 000000000000# 13919 000147'04 103 157 165 154 144 13920 000354'01 561 01 0 00 000165* hrroi t1, namatm ; Point at what we should have found 13921 000355'01 104 00 0 00 000076 PSOUT% ; Type it 13922 000356'01 200 01 0 00 000000# txmsg <" macro in order to duplicate it> 13923 000357'01 104 00 0 00 000076 13924 000360'01 320 12 0 00 000361' 13925 000022'02 000000000000# 13926 000154'04 042 040 155 141 143 13927 000361'01 561 01 0 00 000222* hrroi t1, crlf ; Tie off the line 13928 000362'01 104 00 0 00 000076 PSOUT% 13929 000363'01 263 17 0 00 000000 ret ; Get out of here 13930 000364'01 254 00 0 00 000366' else. ; Otherwise, found something 13931 000365'01 200 10 0 00 000001 move q4, t1 ; Save the table entry 13932 000366'01 endif. ; End case looking for the keyword 13933 000366'01 endif. ; End case already had it 13934 13935 ; Now the calculate the size in words of the new keyword 13936 13937 000366'01 200 05 0 00 000330* move q1, namlen ; Load length of macro expansion text 13938 000367'01 200 02 0 00 002442' move t2, [point 7,namatm] ; Load pointer to same 13939 000370'01 133 05 0 00 000002 adjbp q1, t2 ; Calculate the ending pointer 13940 000371'01 302 05 0 00 440700 caie q1, 440700 ; On a word boundary? 13941 000372'01 271 05 0 00 000001 addi q1, ^d1 ; No, round up a word 13942 000373'01 621 05 0 00 777777 tlz q1, -1 ; Shut off the pointer part 13943 000374'01 621 02 0 00 777777 tlz t2, -1 ; in both pointers 13944 000375'01 274 05 0 00 000002 sub q1, t2 ; Now have required words 13945 13946 ; Take a copy of the expansion text for the macro 13947 13948 000376'01 550 01 0 10 000000 hrrz t1, (q4) ; Get address of text 13949 000377'01 505 01 0 00 440700 hrli t1, (point 7,0) ; Now have our source 13950 000400'01 200 02 0 00 002500' move t2, [ point 7, expatm ] ; Put it in as new expansion 13951 000401'01 260 17 0 00 000327* call asczcp ; Copy the ASCIZ string over 13952 000402'01 202 03 0 00 000123* movem t3, explen ; And store the length 13953 13954 ; And figure out how long that was in words k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 7-1 K20MAC MAC 30-Jun-23 17:21 /DUPLICATE semantic action 13955 13956 000403'01 200 06 0 00 000003 move q2, t3 ; Put the length where $defad wants it 13957 000404'01 200 02 0 00 002500' move t2, [ point 7, expatm ] ; Point to base of expansion 13958 000405'01 133 06 0 00 000002 adjbp q2, t2 ; Calculate the ending pointer 13959 000406'01 302 06 0 00 440700 caie q2, 440700 ; On a word boundary? 13960 000407'01 271 06 0 00 000001 addi q2, ^d1 ; No, round up a word 13961 000410'01 621 06 0 00 777777 tlz q2, -1 ; Shut off the pointer part 13962 000411'01 621 02 0 00 777777 tlz t2, -1 ; in both pointers 13963 000412'01 274 06 0 00 000002 sub q2, t2 ; Now have required words 13964 13965 ; Join $defad at the point of adding something 13966 13967 000413'01 254 00 0 00 000133' callret $defad ; And just add every 13968 000414'01 263 17 0 00 000000 ret 13969 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 8 K20MAC MAC 30-Jun-23 17:21 /REMOVE parsing 13970 subttl /REMOVE parsing 13971 13972 emacro < 13973 13974 .mremo: remark need to parse for the set parameter here 13975 confrm ; Tie off the line 13976 13977 movei t1, [.mremo,,$mremo] ;Load our own semantic action 13978 movem t1, pars1 ; Stomp top-level parse, we're taking it from here 13979 ret ; Return into /RENAME semantic action 13980 13981 >;;emacro 13982 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 9 K20MAC MAC 30-Jun-23 17:21 /REMOVE semantic action 13983 subttl /REMOVE semantic action 13984 13985 emacro < 13986 13987 $mremo: saveac ; Needs a lot of registers 13988 13989 skipe q4, tbent ; Already have the table address? 13990 ifskp. ; No, go find it 13991 movei t1, mactab ; Load the address of the keyword table 13992 move t2, onamp ; And the keyword text pointer 13993 TBLUK% ; See if it's in there (should be) 13994 %jserr (,r) 13995 ifxe. t2, tl%exm ; Found an exact match? 13996 emsg ;" No, bomb 13997 hrroi t1, namatm ; Point at what we should have found 13998 PSOUT% ; Type it 13999 txmsg <" macro in order to remove from it> 14000 hrroi t1, crlf ; Tie off the line 14001 PSOUT% 14002 ret ; Get out of here 14003 else. ; Otherwise, found something 14004 move q4, t1 ; Save the table entry 14005 endif. ; End case looking for the keyword 14006 endif. ; End case already had it 14007 14008 remark ; Toss anything in the macro editor 14009 seto t1, ; Case IV, deleting process memory 14010 dmove t2, [ .fhslf,,medpg ; This process, page number of medit psect 14011 pm%cnt!fld(edpgs,pm%rpt) ] ; Number of pages to toss 14012 PMAP% ; Trim our working set 14013 %jserr (,) ; Odd... but continue 14014 14015 remark ; Set up editing table prototype 14016 xmovei t3, medorg ; Load base of .psect 14017 dmove t1, [ 0,,MACMAX ; TBLUK% table has no entries now 14018 0 ] ; Stomp the 2nd location, just in case 14019 dmovem t1, (t3) ; Now have an empty table 14020 xmovei q3, MACMAX+1(t3) ; Now have top of macro text editing area 14021 dmove t1, q3 ; Load information for splitter 14022 call csplit ; Split the text into keyword names and data 14023 >;;emacro 14024 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 10 K20MAC MAC 30-Jun-23 17:21 Takes a pointer to macro text and splits it up with COMND% 14025 subttl Takes a pointer to macro text and splits it up with COMND% 14026 14027 ; t1/ Top of editing area to stash things 14028 ; t2/ TBLUK% entry of existing macro 14029 14030 ;N.B., assumes editing area is zeroed!! 14031 14032 emacro < 14033 14034 csplit: saveac 14035 move q3, t1 ; Save top of macro insertion 14036 hrli q4, (point 7,0) ; Build a section local pointer 14037 hrr q4, (t2) ; Get address of macro text 14038 14039 do. ; Enter loop context 14040 call splini ; Initialize for parsing from string 14041 move q2, t2 ; Put the CMDBUF pointer in a safe place 14042 call prepar ; Prepare to parse 14043 jumpe t1,endlp. ; Done at end of string 14044 move q1, t1 ; Save it 14045 call dopair ; Do a set pair 14046 cain q1, .chlfd ; Line Feed? 14047 exit. ; Yes, last command in text 14048 loop. ; Next pair 14049 enddo. ; Exit loop lexical context 14050 14051 call splfix ; Fix the CSB up 14052 ret ; Done 14053 14054 >;;emacro 14055 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 11 K20MAC MAC 30-Jun-23 17:21 Do a SET paramater-value pair 14056 subttl Do a SET paramater-value pair 14057 14058 ; N.B., might not just be a pair, could be secondary parsing 14059 ; 14060 ; Maybe put the .sigio stuff in when debugging? Gives real nasty 14061 ; error because we can't trap it. 14062 14063 emacro < 14064 14065 ccrlf: point 7, crlf 14066 -^d2 14067 14068 dopair: saveac ; Needs to save a few things 14069 14070 move q1, sbk+.cmioj ; Load current input and output JFN pair 14071 hrli t1, .sigio ; Set to blow up on a read 14072 hrr t1, q1 ; Let it blat if it wants to 14073 movem t1, sbk+.cmioj ; Set up our trick wire 14074 14075 movei t1, [ flddb. .cmkey,,settab ] 14076 call rflde ; Parse just the SET keyword 14077 %ermsg (,r) ; Leave 14078 ldb t4, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 14079 move q2, t2 ; Keep selected item safe 14080 14081 hlro t1,(q2) ; Show parameter name (keyword 14082 psout% 14083 call csbinf ; Maybe type out interesting CSB stuff 14084 hrrz t4, (q2) ; Get parser and action for parameter valud 14085 hlrz t1, (t4) ; This is the parser portion 14086 14087 setom definf ; Fake we're defining 14088 call (t1) ; Parse the rest of something 14089 setzm definf ; Out of phoney define 14090 14091 move t1, q1 ; Load saved in and out JFN pair 14092 movem t1, sbk+.cmioj ; Restore to the SBK 14093 14094 hrroi t1, atmbuf ; Point to what we parsed 14095 PSOUT% 14096 call csbinf 14097 14098 hrroi t1, crlf 14099 psout 14100 ret 14101 14102 >;;emacro 14103 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 12 K20MAC MAC 30-Jun-23 17:21 Display Useful CSB Information 14104 subttl Display Useful CSB Information 14105 14106 emacro < 14107 14108 csbinf: skipg t4, sbk+.cminc ; Anything left to parse? 14109 ifskp. ; It appears so 14110 cain t4, ^d1 ; One dinky character? 14111 anskp. ; Yep; don't let's bother with that 14112 movei t1, .priou ; Going to terminal 14113 movei t2, .chtab ; Space over 14114 BOUT% ; Do it 14115 erjmps .+1 ; Catch and suppress error 14116 move t2, t4 14117 movei t3, ^d10 14118 NOUT% 14119 erjmps .+1 ; Catch and suppress error 14120 movei t2, "," ; Quote it to be sure 14121 BOUT% ; Do it 14122 movei t2, "'" ; Quote it to be sure 14123 BOUT% ; Do it 14124 erjmps .+1 ; Catch and suppress error 14125 move t2, sbk+.cmptr ; Point to rest of text 14126 movn t3, t4 ; Counted SOUT% 14127 SOUT% ; See what's left 14128 erjmpr .+1 ; Catch and ignore error 14129 movei t2, "'" ; Quote it to be sure 14130 BOUT% ; Do it 14131 erjmps .+1 ; Catch and suppress error 14132 movei t2, .chtab ; Space over 14133 BOUT% ; Do it 14134 erjmps .+1 ; Catch and suppress error 14135 else. ; Otherwise, just tab over 14136 movei t1, .chtab ; Space over 14137 PBOUT% 14138 PBOUT% 14139 endif. 14140 ret 14141 >;;emacro 14142 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 13 K20MAC MAC 30-Jun-23 17:21 .SIGIO Input handler 14143 subttl .SIGIO Input handler 14144 14145 emacro < 14146 ; N.B., This code doesn't work. It will *NEVER* work unless a 14147 ; significant change is made to Tops-20. 14148 ; 14149 ; .SIGIO is unfortunately hard wired to be multiplexed on channel 14150 ; 19 (along with address break), which is Inferior Fork Termination 14151 ; (.ICIFT). Tops-20 very reasonably does not allow a fork to catch 14152 ; its own termination. 14153 ; 14154 ; I would have thought a more obvious approach would have been to 14155 ; implement .SIGIO in a similar fashion to the .TICTI/.TICTO 14156 ; terminal codes (interrupt on type-in/output detected), the 14157 ; difference being that if you didn't handle .SIGIO, it's goes 14158 ; 'upstairs' like other panic channels. 14159 ; 14160 ; For debugging, using .SIGIO still helps because if you mess up 14161 ; the pointers in the CSB, then the fork will terminate and you can 14162 ; investigate with DDT instead of going into a terminal wait. 14163 14164 repeat 0,< ; See above, can't use this, ever 14165 extern pc3 ; Globalized in K20SUB 14166 14167 sitrap: intern sitrap ; K20SUB needs the address in CHNTAB 14168 14169 aos sintn ; Count a signal just because ... 14170 push p, t1 ; Save an accumulator 14171 push p, t2 ; And another one 14172 push p, t3 ; One more!!! 14173 14174 move t1, pc3 ; Pick up our interrupted location 14175 ifxe. t1, pc%usr ; We are only breaking out of a JSYS 14176 hrrz t2, t1 ; PC is where the JSYS will return 14177 subi t2, ^d1 ; So fix it to look at the JSYS 14178 hllz t3, (t2) ; Isolate the left half word 14179 txz t3, 777 ; Want just the opcode 14180 came t3, [ COMND% ] ; Trying to parse something? 14181 anskp. ; Nope, we're done 14182 txo t1, pc%usr ; Force user mode 14183 movem t1, pc3 ; Change DEBRK% action 14184 movx t1, cm%nop ; Force a parse failure 14185 else. ; Otherwise, leave everything alone 14186 setz t1, ; And no flag fix up 14187 endif. 14188 14189 sitepi: pop p, t3 ; Signal trap epilogue 14190 pop p, t2 ; Restores ac2 and ac3 immediately 14191 orm t1, (p) ; Or in any flags before restore 14192 pop p, t1 ; Restore modified or unmodified 14193 14194 DEBRK% ; Done 14195 >;;End Repeat 0 14196 >;;emacro 14197 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 14 K20MAC MAC 30-Jun-23 17:21 Turn .sigio interrupts on and off 14198 subttl Turn .sigio interrupts on and off 14199 14200 emacro < 14201 repeat 0,< ; See above, will never work 14202 extern sigchb ; Defined in K20SUB 14203 14204 dosigh: .fhslf ; This process 14205 sigchb ; .SIGIO channel bit 14206 14207 tsigon: dmove t1, dosigh ; Turn on the signal I/O handler 14208 AIC% ; Enable to catch it 14209 %jserr (,) ; Odd, but carry on 14210 ret 14211 14212 sigoff: dmove t1, dosigh ; Turn off the signal I/O handler 14213 DIC% ; Enable to catch it 14214 %jserr (,) ; Odd, but carry on 14215 ret 14216 >;;End Repeat 0 14217 >;;emacro 14218 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 15 K20MAC MAC 30-Jun-23 17:21 COMND% Command State Block Initialization/Fix Up 14219 subttl COMND% Command State Block Initialization/Fix Up 14220 14221 emacro < 14222 splini: remark ; Split initialization 14223 remark ; Tweak the csb to parse from string 14224 dmove t2,[point 7,cmdbuf ;Point to beginning of command buffer 14225 cmdbln*5 ] ; Max characters in command buffer 14226 dmovem t2, sbk+.cmptr ; Stomp both in; beginning of parse 14227 setzm sbk+.cminc ; No unparsed characters, yet... 14228 ret 14229 14230 splfix: remark ; Done parsing, fix the CSB back up 14231 dmove t1,[point 7,cmdbuf ;Point to beginning of command buffer 14232 cmdbln*5 ] ; Max characters in command buffer 14233 dmovem t1, sbk+.cmptr ; Stomp both in; nothing left to parse 14234 setzm sbk+.cminc ; No unparsed characters anymore 14235 setzb t1, t2 ; Cons up ten .CHNUL's 14236 dmovem t1, cmdbuf ; Scrub the command buffer an itty bit 14237 hllm t1, sbk ; Zero the CSB flags. 14238 ret 14239 14240 >;;emacro 14241 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 16 K20MAC MAC 30-Jun-23 17:21 Prepare CSB and CMDBUF to parse from string 14242 subttl Prepare CSB and CMDBUF to parse from string 14243 14244 ; Expects 14245 ; 14246 ; q4/ Pointer to macro text 14247 ; q2/ Pointer to command buffer 14248 ; 14249 ; Returns: 14250 ; 14251 ; t1/ Terminating character 14252 ; 14253 ; CMDBUF filled 14254 ; CSB conditioned 14255 14256 emacro < 14257 14258 prepar: do. ; Enter loop context 14259 ildb t1, q4 ; Get a character from the macro text 14260 jumpe t1, endlp. ; Exit routine on end of string 14261 cain t1, .chcrt ; A carriage return? 14262 movei t1, .chlfd ; Turn into what COMND% wants ... 14263 idpb t1, q2 ; Copy the character into the command buffer 14264 aos sbk+.cminc ; Account for character to be parsed 14265 sos sbk+.cmcnt ; Account for character storage used 14266 cain t1, .chlfd ; A line feed? 14267 exit. ; Last command on line 14268 cain t1, "," ; Hit a comma? 14269 exit. ; Yes, SET pair seperator 14270 loop. ; Process next character 14271 enddo. ; End loop lexical context 14272 14273 ret ; And done 14274 >;;emacro 14275 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 17 K20MAC MAC 30-Jun-23 17:21 msplit - Takes a macro text and splits it up 14276 subttl msplit - Takes a macro text and splits it up 14277 14278 ; t1/ Top of editing area to stash things 14279 ; t2/ TBLUK% entry of existing macro 14280 ; 14281 ; First attempt, abandoned for using COMND% based approach 14282 ; 14283 ;N.B., assumes editing area is zeroed!! 14284 14285 emacro < 14286 repeat 0,< 14287 msplit: saveac 14288 move q3, t1 ; Save top of macro insertion 14289 hrli q4, (point 7,0) ; Build a section local pointer 14290 hrr q4, (t2) ; Get address of macro text 14291 14292 do. ; Enter main loop context 14293 move q1, q3 ; This will be a SET keyword 14294 hrrz t2, q1 ; Pointer starts there 14295 hrli t2, (point 7,0) ; Build a section local pointer 14296 setz t3, ; No beginning of keyword, yet 14297 do. ; Enter keyword identification loop 14298 ildb t1, q4 ; Pick up a byte of keyword 14299 block. ; Enter block context for easier control flow 14300 jumpe t1, rskp ; End of string? That's odd 14301 cain t1, .chspc ; Space? 14302 retskp ; End of keyword 14303 cain t1, .chtab ; Tab? 14304 retskp ; End of keyword 14305 cain t1, .chlpa ; Left parenthesis? 14306 retskp ; COMND% will break on that 14307 ret ; None of the above 14308 endbk. ; Exit block context 14309 ifskp. ; Hit a break character 14310 jumpn t3, endlp. ; If started significance, this a break, so leave 14311 loop. ; Nope, swallow it and get another 14312 else. ; Otherwise, signicant 14313 idpb t1, t2 ; Deposit in keyword area 14314 aoja t3, top. ; Flag start of significance 14315 endif. 14316 enddo. ; End keyword indentification loop 14317 ife. t1 ; Should not hit end of string after keyword 14318 move t1, q3 ; Load updated top of text area 14319 ret ; And stop 14320 endif. 14321 caie t2, 440700 ; On a word boundary? 14322 addi t2, ^d1 ; No, round up a word 14323 hrrz q2, t2 ; This will be the SET parameter 14324 move q3, q2 ; Also new top of storage 14325 setzb t3, t4 ; Haven't seen any characters, yet 14326 do. ; Enter value identification loop 14327 ildb t1, q4 ; Pick up a byte of keyword 14328 block. ; Enter block context for easier control flow 14329 cain t1, .chspc ; Space? 14330 retskp ; Reset value length counter k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 17-1 K20MAC MAC 30-Jun-23 17:21 msplit - Takes a macro text and splits it up 14331 cain t1, .chtab ; Tab? 14332 retskp ; Reset value length counter 14333 cain t1, .chrpa ; Right parenthesis? 14334 retskp ; Reset value length counter 14335 ife. t1 ; .chnul?? 14336 seto t4, ; Flag end of keyword value 14337 ret ; But count it 14338 endif. 14339 caie t1, "," ; Value terminator? 14340 ifskp. ; Yes, we have the value for this keyword 14341 seto t4, ; Flag end of keyword value 14342 ret ; But count it 14343 endif. 14344 ret ; Some other character, count it 14345 endbk. ; End block context 14346 ifskp. ; +2 means hit a seperator character 14347 setz t3, ; Reset the counter 14348 loop. ; And get another character 14349 else. ; Otherwise, count towards a keyword 14350 jumpn t4, endlp. ; Break loop on end of keyword value 14351 aoja t3, top. ; Count the character and loop 14352 endif. ; End of block exit handling 14353 enddo. ; End search loop 14354 ife. t3 ; Never found a value? 14355 addi q3, ^d1 ; Leave a word of .chnul's 14356 else. ; Otherwise have to play with pointers 14357 move t1, q2 ; Destination is top of storage 14358 hrli t1,(point 7,0) ; Turn into a word based pointer 14359 movn t2, t3 ; Load negatve keyword length 14360 subi t2, ^d1 ; Don't copy the comma or .chnul 14361 adjbp t2, q4 ; Back up to beginning of keyword 14362 do. ; And copy the keyword over 14363 ildb t4, t2 ; Pick up a byte from macro text 14364 idpb t4, t1 ; And put into edit area 14365 sojg t3, top. ; Do all of them 14366 enddo. 14367 caie t1, 440700 ; Ended on a word boundary? 14368 addi t1, ^d1 ; No, round up a word 14369 hrrz q3, t1 ; Set new top of storage 14370 endif. 14371 14372 movei t1, medorg ; Address of keyword table 14373 hrlz t2, q1 ; Load address of keyword text 14374 hrr t2, q2 ; Identified value 14375 TBADD% ; Cross our fingers and insert 14376 %jserr (,) ;Carry on 14377 ldb t1, q4 ; Load stopping character 14378 jumpe t1, endlp. ; End of macro text, done 14379 loop. ; Look for next keyword value pair 14380 enddo. ; End of split loop 14381 14382 move t1, q3 ; Load updated top of text area 14383 ret 14384 >;;repeat 0 14385 >;;emacro k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 17-2 K20MAC MAC 30-Jun-23 17:21 msplit - Takes a macro text and splits it up 14386 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 18 K20MAC MAC 30-Jun-23 17:21 /RENAME parsing 14387 subttl /RENAME parsing 14388 14389 000415'01 200 16 0 00 000000# .renam: guide ; Macro definition 14390 000416'01 260 17 0 00 000302* 14391 000023'02 000000000000# 14392 000163'04 164 157 040 141 040 14393 movei t1, [ 14394 flddb. .cmqst,,,,,[ 14395 flddb. .cmfld,,,,, 14396 000417'01 201 01 0 00 002526' ]] 14397 14398 000420'01 260 17 0 00 000304* call rfield ; Get the new name for the macro 14399 14400 dmove t1, [ mactab ; Load the address of the keyword table 14401 000421'01 120 01 0 00 002534' point 7, atmbuf ] ; And a pointer to the atom buffer 14402 000422'01 104 00 0 00 000537 TBLUK% ; See if it's in there (shouldn't be) 14403 000423'01 320 12 0 00 000425' %jserr (,cmder1) ; Fail, allow a ^H 14404 000424'01 254 00 0 00 000430' 14405 000425'01 265 01 0 00 000345* 14406 000426'01 000000 000000 14407 000427'01 254 00 0 00 000325* 14408 14409 000430'01 607 02 0 00 040000 ifxn. t2, tl%exm ; Found an exact match? 14410 000431'01 254 00 0 00 000442' 14411 000432'01 200 01 0 00 000000# emsg ;" font crock mode 14412 000433'01 104 00 0 00 000313 14413 000024'02 000000000000# 14414 000170'04 124 150 145 040 162 14415 000434'01 561 01 0 00 000320* hrroi t1, atmbuf ; Point to the atom buffer 14416 000435'01 104 00 0 00 000076 PSOUT% ; Type the new name which won't work 14417 000436'01 200 01 0 00 000000# txmsg <" already exists> ;" font crock mode 14418 000437'01 104 00 0 00 000076 14419 000440'01 320 12 0 00 000441' 14420 000025'02 000000000000# 14421 000177'04 042 040 141 154 162 14422 000441'01 254 00 0 00 000427* jrst cmder1 ; Allow ^H 14423 000442'01 endif. 14424 14425 dmove t1, [point 7, atmbuf ; Load pointer to new keyword 14426 000442'01 120 01 0 00 002441' point 7, namatm] ; And a pointer to the macro name buffer 14427 000443'01 260 17 0 00 000401* call asczcp ; Copy the ASCIZ string over 14428 000444'01 202 03 0 00 000366* movem t3, namlen ; Save the length of what we copied 14429 14430 000445'01 260 17 0 00 000331* confrm ; Tie off the line 14431 14432 000446'01 201 01 0 00 002536' movei t1, [.renam,,$renam] ;Load our own semantic action 14433 000447'01 202 01 0 00 000333* movem t1, pars1 ; Stomp top-level parse, we're taking it from here 14434 000450'01 263 17 0 00 000000 ret ; Return into /RENAME semantic action 14435 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 19 K20MAC MAC 30-Jun-23 17:21 /RENAME semantic action 14436 subttl /RENAME semantic action 14437 14438 000451'01 265 16 0 00 002466' $renam: saveac ; Doesn't link with $define 14439 000452'01 332 10 0 00 000000# skipe q4, tbent ; Do we already have the keyword address? 14440 000453'01 254 00 0 00 000502' ifskp. ; Nope, go get it 14441 000454'01 201 01 0 00 000000# movei t1, mactab ; Load the address of the keyword table 14442 000455'01 200 02 0 00 000000# move t2, onamp ; And the keyword text pointer we started with 14443 000456'01 104 00 0 00 000537 TBLUK% ; See if it's in there (it betterbe) 14444 000457'01 320 12 0 00 000461' %jserr (,r) 14445 000460'01 254 00 0 00 000464' 14446 000461'01 265 01 0 00 000425* 14447 000462'01 000000000000# 14448 000463'01 254 00 0 00 000347* 14449 000203'04 105 162 162 157 162 14450 000464'01 603 02 0 00 040000 ifxe. t2, tl%exm ; Found an exact match? 14451 000465'01 254 00 0 00 000501' 14452 000466'01 200 01 0 00 000000# emsg ;" No, bomb 14453 000467'01 104 00 0 00 000313 14454 000026'02 000000000000# 14455 000213'04 103 157 165 154 144 14456 000470'01 561 01 0 00 000354* hrroi t1, namatm ; Point at what we should have found 14457 000471'01 104 00 0 00 000076 PSOUT% ; Type it 14458 000472'01 200 01 0 00 000000# txmsg <" macro in order to duplicate it> 14459 000473'01 104 00 0 00 000076 14460 000474'01 320 12 0 00 000475' 14461 000027'02 000000000000# 14462 000220'04 042 040 155 141 143 14463 000475'01 561 01 0 00 000361* hrroi t1, crlf ; Tie off the line 14464 000476'01 104 00 0 00 000076 PSOUT% 14465 000477'01 263 17 0 00 000000 ret ; Get out of here 14466 000500'01 254 00 0 00 000502' else. ; Otherwise, have something 14467 000501'01 200 10 0 00 000001 move q4, t1 ; Save the table entry 14468 000502'01 endif. ; End case looking for macro name 14469 000502'01 endif. ; End case already had the keyword address 14470 14471 ; Calculate the size of the new macro name in words 14472 14473 000502'01 200 05 0 00 000444* move q1, namlen ; Load length of macro name in characters 14474 000503'01 200 02 0 00 002442' move t2, [point 7,namatm] ; Load pointer to same 14475 000504'01 133 05 0 00 000002 adjbp q1, t2 ; Calculate the ending pointer 14476 000505'01 302 05 0 00 440700 caie q1, 440700 ; On a word boundary? 14477 000506'01 271 05 0 00 000001 addi q1, ^d1 ; No, round up a word 14478 000507'01 621 05 0 00 777777 tlz q1, -1 ; Shut off the pointer part 14479 000510'01 621 02 0 00 777777 tlz t2, -1 ; in both pointers 14480 000511'01 274 05 0 00 000002 sub q1, t2 ; Now have required words to transfer new name 14481 14482 ; But!! Would putting it in the table take us over the end? 14483 14484 000512'01 200 01 0 00 000000# move t1, macbp ; Load the current top of macro text 14485 000513'01 621 01 0 00 777777 tlz t1, -1 ; Shut off pointer (its always a word boundary) 14486 000514'01 270 01 0 00 000005 add t1, q1 ; Add in the new name's length in words 14487 000515'01 301 01 0 00 000000# cail t1, macx ; Not off the end, I hope? 14488 000516'01 334 00 0 00 000000 %ermsg (,r) 14489 000517'01 254 00 0 00 000523' 14490 000520'01 265 01 0 00 000461* k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 19-1 K20MAC MAC 30-Jun-23 17:21 /RENAME semantic action 14491 000521'01 000000000000# 14492 000522'01 254 00 0 00 000463* 14493 000227'04 115 141 143 162 157 14494 14495 ; Ok, so safe to pop the name into the macro table 14496 14497 000523'01 550 07 0 00 000000# hrrz q3, macbp ; Use word address of keyword location 14498 000524'01 200 01 0 00 000005 move t1, q1 ; Number of words to copy 14499 000525'01 201 02 0 00 000470* movei t2, namatm ; Source is the name that was in the atom buffer 14500 000526'01 200 03 0 00 000007 move t3, q3 ; Destination is in macro storage 14501 000527'01 123 01 0 00 002501' xblt. t1 ; And transfer it over 14502 000530'01 505 03 0 00 440700 hrli t3, (point 7,0) ; Turn final address into a word aligned pointer 14503 000531'01 202 03 0 00 000000# movem t3, macbp ; Set new top of macro storage 14504 14505 ; Now build the TBLUK% table entry to insert 14506 14507 000532'01 514 06 0 00 000007 hrlz q2, q3 ; Keyword is what we just copied in 14508 000533'01 540 06 0 10 000000 hrr q2, (q4) ; But the macro text remains the same 14509 14510 ; First, remove the old keyword so we don't have to check the table entry count 14511 14512 000534'01 201 01 0 00 000000# movei t1, mactab ; Load the address of the macro table 14513 000535'01 200 02 0 00 000010 move t2, q4 ; And the address of the keyword entry 14514 000536'01 104 00 0 00 000535 TBDEL% ; Remove (should always work since just found it) 14515 000537'01 320 12 0 00 000541' %jserr (,r) ;?? 14516 000540'01 254 00 0 00 000544' 14517 000541'01 265 01 0 00 000520* 14518 000542'01 000000000000# 14519 000543'01 254 00 0 00 000522* 14520 000240'04 122 145 156 141 155 14521 14522 ; Finally insert ours; should work because previously checked 14523 14524 000544'01 201 01 0 00 000000# movei t1, mactab ; Load the address of the macro table 14525 000545'01 200 02 0 00 000006 move t2, q2 ; And our new keyword entry 14526 000546'01 104 00 0 00 000536 TBADD% ; Enter it in the TBLUK% table 14527 000547'01 320 12 0 00 000551' %jserr (,r) 14528 000550'01 254 00 0 00 000554' 14529 000551'01 265 01 0 00 000541* 14530 000552'01 000000000000# 14531 000553'01 254 00 0 00 000543* 14532 000251'04 122 145 156 141 155 14533 14534 000554'01 263 17 0 00 000000 ret 14535 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 20 K20MAC MAC 30-Jun-23 17:21 DEFINE macro table maintenance functions 14536 subttl DEFINE macro table maintenance functions 14537 14538 ; Begin code insertion 14539 14540 000030'02 000000 000000 %table(tabswi) ; Table maintenance switches 14541 000031'02 000000# 000000# %key3 , .mcomp, $mcomp ; Garbage collect 14542 000015'03 143 157 155 160 141 14543 000017'03 000000# 000000# 14544 000032'02 000000# 000000# %key3 , .mdump, $mdump ; Write a macros in binary format 14545 000020'03 144 165 155 160 000 14546 000021'03 000000# 000000# 14547 000033'02 000000# 000000# %keyf4 , .mrese, $mrese, cm%inv ; (sleepy Tom...) 14548 000022'03 002000 000001 14549 000023'03 151 156 164 151 141 14550 000025'03 000000# 000000# 14551 000034'02 000000# 000000# %key3 , .mmap, $mmap ; Directly use macros from binary file 14552 000026'03 155 141 160 000 000 14553 000027'03 000000# 000000# 14554 000035'02 000000# 000000# %key3 , .mrese, $mrese ; Whack everything 14555 000030'03 162 145 163 145 164 14556 000032'03 000000# 000000# 14557 000036'02 000000# 000000# %key3 , .msave, $msave ; Save macros in ASCII format 14558 000033'03 163 141 166 145 000 14559 000034'03 000000# 000000# 14560 000037'02 000000# 000000# %key3 , .msumm, $msumm ; Summary of table usage 14561 000035'03 163 165 155 155 141 14562 000037'03 000000# 000000# 14563 000030'02 000007 000007 %tbend 14564 14565 000555'01 550 04 0 02 000000 tablem: hrrz t4, (t2) ; Get the command routine addresses. 14566 000556'01 202 04 0 00 000447* movem t4, pars1 ; Stomp top-level parse, we're taking it from here 14567 000557'01 554 01 0 04 000000 hlrz t1, (t4) ; Get the syntax routine 14568 000560'01 254 00 0 01 000000 callret (t1) ; Call it and carry on 14569 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 21 K20MAC MAC 30-Jun-23 17:21 Parse the /DUMP switch 14570 subttl Parse the /DUMP switch 14571 14572 ; Tries for a device first as this is more efficient for NUL: and 14573 ; catches more errors earlier and more easily. 14574 14575 ; Default command filespec fields for .CMFIL: 14576 14577 000561'01 600020 777777 dmpbk: gj%flg!gj%fou!gj%new!fld(.gjnhg,.rhalf) ; .GJGEN 14578 000562'01 000100 000101 .priin,,.priou ; .GJSRC (ignored if COMND%) 14579 000563'01 000000 000000 0 ; .GJDEV (do not default the device) 14580 000564'01 000000 000000 0 ; .GJDIR (do not default the directory) 14581 000565'01 000000 000000 0 ; .GJNAM (do not default the name) 14582 000566'01 000000000000# eascii () ; .GJEXT (default extension is .BIN) 14583 000261'04 102 111 116 000 000 14584 000567'01 000000000000# 0 ; .GJPRO (use system default protection) 14585 000570'01 000000 000000 0 ; .GJACT (use job's current account) 14586 000010 dmpbkl==<.-dmpbk> ; Length of this GTJFN argument block. 14587 14588 000571'01 265 16 0 00 002466' .mdump: saveac ; Protect some registers 14589 000572'01 200 01 0 00 002537' movx t1, cz%ncl!.fhslf ; Release non-open JFN's on reparse 14590 000573'01 104 00 0 00 000034 CLZFF% 14591 000574'01 320 12 0 00 000575' erjmpr .+1 ; Catch and ignore errors 14592 000575'01 200 16 0 00 000000# guide 14593 000576'01 260 17 0 00 000416* 14594 000040'02 000000000000# 14595 000262'04 155 141 143 162 157 14596 000577'01 200 01 0 00 002540' move t1, [dmpbk,,cjfnbk] ; Insert our file parsing defaults. 14597 000600'01 251 01 0 00 000000# blt t1, cjfnbk+dmpbkl 14598 14599 movei t1, [ ; Catch bare device 14600 flddb. .cmfil,,,,,[ 14601 000601'01 201 01 0 00 002551' flddb. .cmdev,cm%sdh,,,,]] 14602 000602'01 260 17 0 00 000420* call rfield ; Ask them to supply the file 14603 000603'01 135 05 0 00 002440' ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 14604 000604'01 200 06 0 00 000002 move q2, t2 ; Save parsed data (device or JFN) 14605 14606 000605'01 200 01 0 00 000006 move t1, q2 ; Load parse item for DVCHR% 14607 000606'01 302 05 0 00 000016 caie q1, .cmdev ; Typed a bare device? 14608 000607'01 621 01 0 00 777777 tlz t1, -1 ; Shut off flags so DVCHR% doesn't choke 14609 000610'01 104 00 0 00 000117 DVCHR% ; and find out about it 14610 000611'01 320 12 0 00 000613' %jserr (,r) 14611 000612'01 254 00 0 00 000616' 14612 000613'01 265 01 0 00 000551* 14613 000614'01 000000000000# 14614 000615'01 254 00 0 00 000553* 14615 000267'04 125 156 141 142 154 14616 000616'01 135 07 0 00 002554' ldb q3, [pointr t2, dv%typ] ; Pick up the device type 14617 14618 000617'01 302 05 0 00 000016 caie q1, .cmdev ; Typed a bare device? 14619 000620'01 254 00 0 00 000647' ifskp. ; Yes, see what it is 14620 000621'01 302 07 0 00 000015 caie q3, .dvnul ; NUL:? 14621 000622'01 254 00 0 00 000627' ifskp. ; Yes, we can simulate that 14622 000623'01 260 17 0 00 000445* confrm ; Confirm the selection 14623 000624'01 200 01 0 00 002555' movx t1, ;Use special designator and flags 14624 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 20:02 27-Nov-23 Page 21-1 K20MAC MAC 30-Jun-23 17:21 Parse the /DUMP switch 14625 000626'01 263 17 0 00 000000 ret ; Done with this special case 14626 000627'01 endif. ; Any other device is NOT VALID 14627 14628 000627'01 302 07 0 00 000000 caie q3, .dvdsk ; Bare device? 14629 000630'01 254 00 0 00 000646' ifskp. ; Yes, but needs a file name 14630 000631'01 200 01 0 00 000000# emsg ; First part of blat 14631 000632'01 104 00 0 00 000313 14632 000041'02 000000000000# 14633 000302'04 124 150 145 040 000 14634 000633'01 200 02 0 00 000006 move t2, q2 ; Load whatever we parsed 14635 000634'01 201 01 0 00 000101 movei t1, .priou ; Output to the terminal 14636 000635'01 104 00 0 00 000121 DEVST% ; Write the device name into the AC's 14637 000636'01 320 12 0 00 000640' %jserr (,cmder1) 14638 000637'01 254 00 0 00 000643' 14639 000640'01 265 01 0 00 000613* 14640 000641'01 000000000000# 14641 000642'01 254 00 0 00 000441* 14642 000303'04 125 156 141 142 154 14643 000643'01 200 01 0 00 000000# sxtext (t1,<: structure needs a file specification>) 14644 000042'02 000000000000# 14645 000314'04 072 040 163 164 162 14646 000644'01 104 00 0 00 000076 PSOUT% ; Finish the informative blat 14647 000645'01 254 00 0 00 000642* jrst cmder1 ; Allow reparse 14648 000646'01 endif. ; Any other device is NOT VALID 14649 14650 000646'01 254 00 0 00 000670' jrst .mdmpe ; Otherwise, handle as a general parse error 14651 000647'01 endif. ; End case .cmdev 14652 14653 remark .cmfil ; Everything else is a file 14654 14655 000647'01 302 07 0 00 000015 caie q3, .dvnul ; A JFN on NUL:?? 14656 000650'01 254 00 0 00 000663' ifskp. ; Yes, we can simulate that 14657 000651'01 260 17 0 00 000623* confrm ; Confirm the selection 14658 000652'01 200 01 0 00 000006 move t1, q2 ; Load parsed JFN 14659 000653'01 260 17 0 00 000000* call isnulj ; Convert it to a special JFN, releasing original 14660 000654'01 334 01 0 00 000000# ermsg% (,cmder1) ; Allow ^H 14661 000655'01 254 00 0 00 000661' 14662 000656'01 202 01 0 00 000000* 14663 000657'01 104 00 0 00 000313 14664 000660'01 254 00 0 00 000645* 14665 000043'02 000000000000# 14666 000324'04 113 105 122 115 111 14667 14668 000661'01 202 01 0 00 000625* movem t1, pars2 ; Store the JFN and original parse flags 14669 000662'01 263 17 0 00 000000 ret ; Done with this second special NUL: case 14670 000663'01 endif. 14671 14672 000663'01 302 07 0 00 000000 caie q3, .dvdsk ; Was this a structure? 14673 000664'01 254 00 0 00 000670' jrst .mdmpe ; No, any other device is NOT VALID 14674 14675 000665'01 260 17 0 00 000651* confrm ; Otherwise, fine; confirm selection 14676 000666'01 202 06 0 00 000661* movem q2, pars2 ; Store the JFN and flags 14677 000667'01 263 17 0 00 000000 ret ; Done with the parse 14678 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 22 K20MAC MAC 30-Jun-23 17:21 Parse the /DUMP switch 14679 remark Here for common parse errors 14680 14681 000670'01 200 01 0 00 000000# .mdmpe: emsg ; Begin whining 14682 000671'01 104 00 0 00 000313 14683 000044'02 000000000000# 14684 000336'04 124 150 145 040 000 14685 000672'01 201 01 0 00 000101 movei t1, .priou ; Output to terminal, always 14686 000673'01 302 05 0 00 000016 caie q1, .cmdev ; Device? 14687 000674'01 254 00 0 00 000705' ifskp. ; Yes, use DEVST% 14688 000675'01 200 02 0 00 000006 move t2, q2 ; Load whatever we parsed 14689 000676'01 104 00 0 00 000121 DEVST% ; Write the device name into the AC's 14690 000677'01 320 12 0 00 000701' %jserr (,cmder1) 14691 000700'01 254 00 0 00 000704' 14692 000701'01 265 01 0 00 000640* 14693 000702'01 000000000000# 14694 000703'01 254 00 0 00 000660* 14695 000337'04 125 156 141 142 154 14696 000704'01 254 00 0 00 000715' else. ; Otherwise, DEVST% will choke on the JFN 14697 000705'01 550 02 0 00 000006 hrrz t2, q2 ; Load just the JFN 14698 dmove t3, [ ; Just want the device name, no punctuation 14699 fld(.jsaof,js%dev) 14700 000706'01 120 03 0 00 002556' 0 ] ; No odd prefix, whatever that is 14701 000707'01 104 00 0 00 000030 JFNS% ; Convert to something readable 14702 000710'01 320 12 0 00 000712' %jserr (,cmder1) 14703 000711'01 254 00 0 00 000715' 14704 000712'01 265 01 0 00 000701* 14705 000713'01 000000000000# 14706 000714'01 254 00 0 00 000703* 14707 000347'04 125 156 141 142 154 14708 000715'01 endif. ; Either way, error should be more informative 14709 14710 000715'01 200 01 0 00 000000# txmsg <: device does not have binary dumping capabilities> 14711 000716'01 104 00 0 00 000076 14712 000717'01 320 12 0 00 000720' 14713 000045'02 000000000000# 14714 000361'04 072 040 144 145 166 14715 000720'01 561 01 0 00 000475* hrroi t1, crlf ; Newline 14716 000721'01 104 00 0 00 000076 PSOUT% ; Tie off the blat 14717 000722'01 320 12 0 00 000723' erjmpr .+1 ; Catch and ignore that error, too 14718 14719 000723'01 302 05 0 00 000006 caie q1, .cmfil ; Had we parsed a file, actually? 14720 000724'01 254 00 0 00 000730' ifskp. ; Yes, then have a little clean up to do 14721 000725'01 550 01 0 00 000006 hrrz t1, q2 ; Load our poor JFN, sans flags 14722 000726'01 104 00 0 00 000023 RLJFN% ; Toss it; can't use it 14723 000727'01 320 12 0 00 000714* erjmpr cmder1 ; Ignore error and beat it 14724 000730'01 endif. 14725 14726 000730'01 254 00 0 00 000727* jrst cmder1 ; Allow ^H 14727 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 23 K20MAC MAC 30-Jun-23 17:21 Execute the /DUMP switch 14728 subttl Execute the /DUMP switch 14729 14730 000731'01 265 16 0 00 002466' $mdump: saveac ; Wants a few accumulators 14731 14732 000732'01 200 05 0 00 000666* move q1, pars2 ; Load the JFN and flags 14733 000733'01 550 01 0 00 000005 hrrz t1, q1 ; Look at just the JFN 14734 000734'01 306 01 0 00 377777 cain t1, .nulio ; Special cased? 14735 000735'01 254 00 0 00 000745' ifskp. ; No, have to really open the file 14736 000736'01 200 02 0 00 002560' movx t2, 14737 000737'01 104 00 0 00 000021 OPENF% ; Try to create the file 14738 000740'01 320 12 0 00 000742' %jserr (,$mdmpe) 14739 000741'01 254 00 0 00 000745' 14740 000742'01 265 01 0 00 000712* 14741 000743'01 000000000000# 14742 000744'01 254 00 0 00 001060' 14743 000374'04 125 156 141 142 154 14744 000745'01 endif. ; End case file not on NUL: 14745 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 24 K20MAC MAC 30-Jun-23 17:21 Set up to dump the macros into binary file 14746 subttl Set up to dump the macros into binary file 14747 14748 ; N.B., Although the mapping direction seems non-intuitive here, 14749 ; what's actually happening is that we are reserving space in the 14750 ; output file to populate as we will. If we don't touch a page, it 14751 ; won't exist in the file, effectively showing up as a 'hole'. 14752 14753 remark PMAP% Case IV: deleting process memory 14754 000745'01 474 01 0 00 000000 seto t1, ; Don't want anything in gc .psect 14755 dmove t2, [ .fhslf,,gcpag ; This process, page number of gc psect 14756 000746'01 120 02 0 00 002561' pm%cnt!fld(gcpgs,pm%rpt) ] ; Number of pages to toss 14757 000747'01 104 00 0 00 000056 PMAP% ; Kick them all into oblivion 14758 000750'01 320 12 0 00 000752' %jserr (,$mdmpe) 14759 000751'01 254 00 0 00 000755' 14760 000752'01 265 01 0 00 000742* 14761 000753'01 000000000000# 14762 000754'01 254 00 0 00 001060' 14763 000404'04 125 156 141 142 154 14764 14765 remark PMAP% Case I: Mapping File Pages to a Process 14766 000755'01 514 01 0 00 000005 hrlz t1, q1 ; 'Input' file, page zero 14767 000756'01 316 01 0 00 002563' camn t1, [.nulio,,0] ; NUL:? 14768 000757'01 254 00 0 00 000767' ifskp. ; No, do the page map for real 14769 dmove t2, [ .fhslf,,gcpag ; This process, page number of gc psect 14770 000760'01 120 02 0 00 002564' pm%wr!pm%cnt!fld(gcpgs,pm%rpt) ] ; Number of pages to reserve 14771 000761'01 104 00 0 00 000056 PMAP% ; And get ready to drop data into them 14772 000762'01 320 12 0 00 000764' %jserr (,$mdmpe) 14773 000763'01 254 00 0 00 000767' 14774 000764'01 265 01 0 00 000752* 14775 000765'01 000000000000# 14776 000766'01 254 00 0 00 001060' 14777 000416'04 125 156 141 142 154 14778 000767'01 endif. ; End setting up a real file 14779 14780 remark ; Set up loop context 14781 remark q1, ; Has JFN and flags 14782 000767'01 201 06 0 00 000007 movx q2, gcpgs ; Load pages in table psect 14783 14784 dmove q3, [ macorg ; Source is the macros .psect 14785 000770'01 120 07 0 00 002566' gcorg ] ; Destination is garbage collection .psect 14786 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 25 K20MAC MAC 30-Jun-23 17:21 Loop to map out pages appropriately 14787 subttl Loop to map out pages appropriately 14788 14789 000771'01 do. ; Enter loop context 14790 000771'01 200 01 0 00 000007 move t1, q3 ; Load current macros address 14791 000772'01 242 01 0 00 777767 lsh t1, -^d9 ; Turn into a page number 14792 000773'01 505 01 0 00 400000 hrli t1, .fhslf ; This process 14793 000774'01 104 00 0 00 000057 RPACS% ; Find out what's in there 14794 000775'01 320 12 0 00 000777' ifje. r ; Catch and ignore error 14795 000776'01 254 00 0 00 001000' 14796 000777'01 400 02 0 00 000000 setz t2, ; Assume the page doesn't exist 14797 001000'01 endif. 14798 001000'01 607 02 0 00 010000 ifxn. t2, pa%pex ; Does the page exist? 14799 001001'01 254 00 0 00 001007' 14800 001002'01 607 02 0 00 100000 andxn. t2, pa%rd ; *AND* ... Can we read it? 14801 001003'01 254 00 0 00 001007' 14802 001004'01 201 01 0 00 001000 movei t1, ^d512 ; Yep, load the eternal page size 14803 001005'01 120 02 0 00 000007 dmove t2, q3 ; Load source and destination address 14804 001006'01 123 01 0 00 002501' xblt. t1 ; And put into the macros psect 14805 001007'01 endif. 14806 001007'01 363 06 0 00 001012' sojle q2, endlp. ; Exit when nothing left to do 14807 001010'01 114 07 0 00 002570' dadd q3, [exp ^d512,^d512 ] ; Step to next set of addresses 14808 001011'01 254 00 0 00 000771' loop. 14809 001012'01 enddo. ; Exit loop lexical context 14810 14811 remark ; Loop exit post processing 14812 14813 remark PMAP% Case IV: deleting process memory (but not really) 14814 001012'01 474 01 0 00 000000 seto t1, ; Don't want anything in gc .psect 14815 dmove t2, [ .fhslf,,gcpag ; This process, page number of gc psect 14816 001013'01 120 02 0 00 002561' pm%cnt!fld(gcpgs,pm%rpt) ] ; Number of pages to remove 14817 001014'01 104 00 0 00 000056 PMAP% ; Kick them all over to DDMP 14818 001015'01 320 12 0 00 001017' %jserr (,$mdmpe) 14819 001016'01 254 00 0 00 001022' 14820 001017'01 265 01 0 00 000764* 14821 001020'01 000000000000# 14822 001021'01 254 00 0 00 001060' 14823 000427'04 125 156 141 142 154 14824 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 26 K20MAC MAC 30-Jun-23 17:21 Loop to map out pages appropriately 14825 remark Binary file Epilogue 14826 14827 001022'01 550 01 0 00 000005 hrrz t1, q1 ; Load the file JFN 14828 001023'01 306 01 0 00 377777 cain t1, .nulio ; NUL:? 14829 001024'01 254 00 0 00 001054' ifskp. ; No, a real file 14830 001025'01 661 01 0 00 400000 txo t1, co%nrj ; Keep the JFN 14831 001026'01 104 00 0 00 000022 CLOSF% ; Close the file, mostly 14832 001027'01 320 12 0 00 001031' %jsErr (, $mdmpe) 14833 001030'01 254 00 0 00 001034' 14834 001031'01 265 01 0 00 001017* 14835 001032'01 000000000000# 14836 001033'01 254 00 0 00 001060' 14837 000437'04 125 156 141 142 154 14838 001034'01 505 01 0 00 000012 hrli t1, .fbsiz ; Set the number of macros as bytes 14839 001035'01 474 02 0 00 000000 seto t2, ; Changing all the bits in the word 14840 001036'01 554 03 0 00 000000# hlrz t3, mactab ; Load current macro count 14841 001037'01 104 00 0 00 000064 CHFDB% ; Set that for the curious 14842 001040'01 320 12 0 00 001042' %jsErr (,) 14843 001041'01 254 00 0 00 001045' 14844 001042'01 265 01 0 00 001031* 14845 001043'01 000000000000# 14846 001044'01 254 00 0 00 001045' 14847 000446'04 125 156 141 142 154 14848 001045'01 550 01 0 00 000005 hrrz t1, q1 ; Load the JFN one last time 14849 001046'01 104 00 0 00 000023 RLJFN% ; And toss it 14850 001047'01 320 12 0 00 001051' %jsErr (,) 14851 001050'01 254 00 0 00 001054' 14852 001051'01 265 01 0 00 001042* 14853 001052'01 000000000000# 14854 001053'01 254 00 0 00 001054' 14855 000460'04 125 156 141 142 154 14856 001054'01 endif. ; End case not NUL: 14857 14858 001054'01 200 01 0 00 000000# txmsg 14859 001055'01 104 00 0 00 000076 14860 001056'01 320 12 0 00 001057' 14861 000046'02 000000000000# 14862 000471'04 127 162 157 164 145 14863 001057'01 254 00 0 00 002070' callret $msumm ; Give us some summary information 14864 remark ret ; $msumm returns for us 14865 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 27 K20MAC MAC 30-Jun-23 17:21 Error handling 14866 subttl Error handling 14867 14868 001060'01 $mdmpe: remark ; Here to handle errors 14869 001060'01 474 01 0 00 000000 seto t1, ; Case IV, deleting process memory 14870 dmove t2, [ .fhslf,,gcpag ; This process, page number of gc psect 14871 001061'01 120 02 0 00 002561' pm%cnt!fld(gcpgs,pm%rpt) ] ; Number of pages to toss 14872 001062'01 104 00 0 00 000056 PMAP% ; Trim our working set 14873 001063'01 320 12 0 00 001065' %jserr (,) 14874 001064'01 254 00 0 00 001070' 14875 001065'01 265 01 0 00 001051* 14876 001066'01 000000000000# 14877 001067'01 254 00 0 00 001070' 14878 000473'04 102 151 156 141 162 14879 14880 001070'01 332 01 0 00 000005 skipe t1, q1 ; Didn't have a JFN? 14881 001071'01 260 17 0 00 000000* call frclos ; We did, go get rid of it 14882 001072'01 600 00 0 00 000000 nop ; Ignore any goofy error 14883 001073'01 263 17 0 00 000000 ret ; Done 14884 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 28 K20MAC MAC 30-Jun-23 17:21 Parse the /MAP switch 14885 subttl Parse the /MAP switch 14886 14887 ; Tries for a device first as this is more efficient for NUL: and 14888 ; catches more errors earlier and more easily. 14889 14890 ; Default command filespec fields for .CMFIL: 14891 14892 001074'01 100020 000000 mapbk: gj%flg!gj%old ; Must be existing file. 14893 repeat 4,<0> ; Normal defaults for dev:name. 14894 001075'01 000000 000000 14895 001076'01 000000 000000 14896 001077'01 000000 000000 14897 001100'01 000000 000000 14898 001101'01 000000000000# eascii () ; Default extension is .BIN. 14899 000505'04 102 111 116 000 000 14900 001102'01 000000000000# 0 ; Default protection, 14901 001103'01 000000 000000 0 ; and account. 14902 000010 mapbkl==<.-mapbk> ; Length of this GTJFN argument block. 14903 14904 001104'01 265 16 0 00 002466' .mmap: saveac ; Protect some registers 14905 001105'01 200 01 0 00 002537' movx t1, cz%ncl!.fhslf ; Release non-open JFN's on reparse 14906 001106'01 104 00 0 00 000034 CLZFF% 14907 001107'01 320 12 0 00 001110' erjmpr .+1 ; Catch and ignore errors 14908 001110'01 200 16 0 00 000000# guide 14909 001111'01 260 17 0 00 000576* 14910 000047'02 000000000000# 14911 000506'04 142 151 156 141 162 14912 001112'01 200 01 0 00 002572' move t1, [mapbk,,cjfnbk] ; Insert our file parsing defaults. 14913 001113'01 251 01 0 00 000000# blt t1, cjfnbk+mapbkl 14914 14915 movei t1, [ ; Catch bare device 14916 flddb. .cmfil,,,,,[ 14917 001114'01 201 01 0 00 002602' flddb. .cmdev,cm%sdh,,,,]] 14918 001115'01 260 17 0 00 000602* call rfield ; Ask them to supply the file 14919 001116'01 135 05 0 00 002440' ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 14920 001117'01 200 06 0 00 000002 move q2, t2 ; Save parsed data (device or JFN) 14921 14922 001120'01 200 01 0 00 000006 move t1, q2 ; Load parse item for DVCHR% 14923 001121'01 302 05 0 00 000016 caie q1, .cmdev ; Typed a bare device? 14924 001122'01 621 01 0 00 777777 tlz t1, -1 ; Shut off flags so DVCHR% doesn't choke 14925 001123'01 104 00 0 00 000117 DVCHR% ; and find out about it 14926 001124'01 320 12 0 00 001126' %jserr (,r) 14927 001125'01 254 00 0 00 001131' 14928 001126'01 265 01 0 00 001065* 14929 001127'01 000000000000# 14930 001130'01 254 00 0 00 000615* 14931 000512'04 125 156 141 142 154 14932 001131'01 135 07 0 00 002554' ldb q3, [pointr t2, dv%typ] ; Pick up the device type 14933 14934 001132'01 302 05 0 00 000016 caie q1, .cmdev ; Typed a bare device? 14935 001133'01 254 00 0 00 001162' ifskp. ; Yes, see what it is 14936 001134'01 302 07 0 00 000015 caie q3, .dvnul ; NUL:? 14937 001135'01 254 00 0 00 001142' ifskp. ; Yes, we can simulate that 14938 001136'01 260 17 0 00 000665* confrm ; Confirm the selection 14939 001137'01 200 01 0 00 002555' movx t1, ;Use special designator and flags k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 28-1 K20MAC MAC 30-Jun-23 17:21 Parse the /MAP switch 14940 001140'01 202 01 0 00 000732* movem t1, pars2 ; Store the JFN and (phoney) flags 14941 001141'01 263 17 0 00 000000 ret ; Done with this special case 14942 001142'01 endif. ; Any other device is NOT VALID 14943 14944 001142'01 302 07 0 00 000000 caie q3, .dvdsk ; Bare device? 14945 001143'01 254 00 0 00 001161' ifskp. ; Yes, but needs a file name 14946 001144'01 200 01 0 00 000000# emsg ; First part of blat 14947 001145'01 104 00 0 00 000313 14948 000050'02 000000000000# 14949 000525'04 124 150 145 040 000 14950 001146'01 200 02 0 00 000006 move t2, q2 ; Load whatever we parsed 14951 001147'01 201 01 0 00 000101 movei t1, .priou ; Output to terminal 14952 001150'01 104 00 0 00 000121 DEVST% ; Write the device name into the AC's 14953 001151'01 320 12 0 00 001153' %jserr (,cmder1) 14954 001152'01 254 00 0 00 001156' 14955 001153'01 265 01 0 00 001126* 14956 001154'01 000000000000# 14957 001155'01 254 00 0 00 000730* 14958 000526'04 125 156 141 142 154 14959 001156'01 200 01 0 00 000000# emsg <: structure needs a file specification> 14960 001157'01 104 00 0 00 000313 14961 000051'02 000000000000# 14962 000537'04 072 040 163 164 162 14963 001160'01 254 00 0 00 001155* jrst cmder1 ; Allow reparse 14964 001161'01 endif. ; Any other device is NOT VALID 14965 14966 001161'01 254 00 0 00 001203' jrst .mmape ; Handle as a general parse error 14967 001162'01 endif. ; End case .cmdev 14968 14969 remark .cmfil ; Everything else is a file 14970 14971 001162'01 302 07 0 00 000015 caie q3, .dvnul ; A JFN on NUL:?? 14972 001163'01 254 00 0 00 001176' ifskp. ; Yes, we can simulate that 14973 001164'01 260 17 0 00 001136* confrm ; Confirm the selection 14974 001165'01 200 01 0 00 000006 move t1, q2 ; Load parsed JFN 14975 001166'01 260 17 0 00 000653* call isnulj ; Convert it to a special JFN, releasing original 14976 001167'01 334 01 0 00 000000# ermsg% (,cmder1) ; Allow ^H 14977 001170'01 254 00 0 00 001174' 14978 001171'01 202 01 0 00 000656* 14979 001172'01 104 00 0 00 000313 14980 001173'01 254 00 0 00 001160* 14981 000052'02 000000000000# 14982 000547'04 113 105 122 115 111 14983 14984 001174'01 202 01 0 00 001140* movem t1, pars2 ; Store the JFN and original parse flags 14985 001175'01 263 17 0 00 000000 ret ; Done with this second special NUL: case 14986 001176'01 endif. 14987 14988 001176'01 302 07 0 00 000000 caie q3, .dvdsk ; Was this a structure? 14989 001177'01 254 00 0 00 001203' jrst .mmape ; No, any other device is NOT VALID 14990 14991 001200'01 260 17 0 00 001164* confrm ; Otherwise, fine; confirm selection 14992 001201'01 202 06 0 00 001174* movem q2, pars2 ; Store the JFN and flags 14993 001202'01 263 17 0 00 000000 ret ; Done with the parse 14994 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 29 K20MAC MAC 30-Jun-23 17:21 Parse the /MAP switch 14995 remark Here for common parse errors 14996 14997 001203'01 200 01 0 00 000000# .mmape: emsg ; Begin whining 14998 001204'01 104 00 0 00 000313 14999 000053'02 000000000000# 15000 000561'04 124 150 145 040 000 15001 15002 001205'01 201 01 0 00 000101 movei t1, .priou ; Output to terminal, always 15003 001206'01 302 05 0 00 000016 caie q1, .cmdev ; Device? 15004 001207'01 254 00 0 00 001220' ifskp. ; Yes, use DEVST% 15005 001210'01 200 02 0 00 000006 move t2, q2 ; Load whatever we parsed 15006 001211'01 104 00 0 00 000121 DEVST% ; Write the device name into the AC's 15007 001212'01 320 12 0 00 001214' %jserr (,cmder1) 15008 001213'01 254 00 0 00 001217' 15009 001214'01 265 01 0 00 001153* 15010 001215'01 000000000000# 15011 001216'01 254 00 0 00 001173* 15012 000562'04 125 156 141 142 154 15013 001217'01 254 00 0 00 001230' else. ; Otherwise, DEVST% will choke on the JFN 15014 001220'01 550 02 0 00 000006 hrrz t2, q2 ; Load just the JFN 15015 dmove t3, [ ; Just want the device name, no punctuation 15016 fld(.jsaof,js%dev) 15017 001221'01 120 03 0 00 002556' 0 ] ; No odd prefix, whatever that is 15018 001222'01 104 00 0 00 000030 JFNS% ; Convert to something readable 15019 001223'01 320 12 0 00 001225' %jserr (,cmder1) 15020 001224'01 254 00 0 00 001230' 15021 001225'01 265 01 0 00 001214* 15022 001226'01 000000000000# 15023 001227'01 254 00 0 00 001216* 15024 000572'04 125 156 141 142 154 15025 001230'01 endif. ; Either way, error should be more informative 15026 15027 001230'01 200 01 0 00 000000# txmsg <: device does not have binary mapping capabilities> 15028 001231'01 104 00 0 00 000076 15029 001232'01 320 12 0 00 001233' 15030 000054'02 000000000000# 15031 000604'04 072 040 144 145 166 15032 001233'01 561 01 0 00 000720* hrroi t1, crlf ; Newline 15033 001234'01 104 00 0 00 000076 PSOUT% ; Tie off the blat 15034 001235'01 320 12 0 00 001236' erjmpr .+1 ; Catch and ignore that error, too 15035 15036 001236'01 302 05 0 00 000006 caie q1, .cmfil ; Had we parsed a file, actually? 15037 001237'01 254 00 0 00 001243' ifskp. ; Yes, then have a little clean up to do 15038 001240'01 550 01 0 00 000006 hrrz t1, q2 ; Load our poor JFN, sans flags 15039 001241'01 104 00 0 00 000023 RLJFN% ; Toss it; can't use it 15040 001242'01 320 12 0 00 001227* erjmpr cmder1 ; Ignore error and beat it 15041 001243'01 endif. 15042 15043 001243'01 254 00 0 00 001242* jrst cmder1 ; Allow ^H 15044 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 30 K20MAC MAC 30-Jun-23 17:21 Execute the /MAP switch 15045 subttl Execute the /MAP switch 15046 15047 001244'01 265 16 0 00 002466' $mmap: saveac ; Wants a few accumulators 15048 001245'01 403 05 0 00 000006 setzb q1, q2 ; Zero local JFN and input file size (pages) 15049 15050 001246'01 200 05 0 00 001201* move q1, pars2 ; Load the JFN and flags 15051 001247'01 550 01 0 00 000005 hrrz t1, q1 ; Look at just the JFN 15052 001250'01 306 01 0 00 377777 cain t1, .nulio ; Special cased? 15053 001251'01 254 00 0 00 001405' jrst $mmapn ; Yes, go do it 15054 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 31 K20MAC MAC 30-Jun-23 17:21 Set up and check to map a real binary file 15055 subttl Set up and check to map a real binary file 15056 15057 001252'01 104 00 0 00 000036 SIZEF% ; Find out about the file 15058 001253'01 320 12 0 00 001255' %jserr (,r) ; Go no further 15059 001254'01 254 00 0 00 001260' 15060 001255'01 265 01 0 00 001225* 15061 001256'01 000000000000# 15062 001257'01 254 00 0 00 001130* 15063 000617'04 102 151 156 141 162 15064 001260'01 322 02 0 00 001405' jumpe t2, $mmapn ; No macros written? Assume empty, then 15065 001261'01 322 03 0 00 001405' jumpe t3, $mmapn ; Empty file? Treat as NUL: case 15066 15067 001262'01 303 02 0 00 000252 caile t2, macmax ; Too many macros? 15068 001263'01 334 00 0 00 000000 %ermsg (,$mmape) 15069 001264'01 254 00 0 00 001270' 15070 001265'01 265 01 0 00 001255* 15071 001266'01 000000000000# 15072 001267'01 254 00 0 00 001401' 15073 000630'04 124 157 157 040 155 15074 001270'01 303 03 0 00 000007 caile t3, macpgs ; Too large? 15075 001271'01 334 00 0 00 000000 %ermsg (,$mmape) 15076 001272'01 254 00 0 00 001276' 15077 001273'01 265 01 0 00 001265* 15078 001274'01 000000000000# 15079 001275'01 254 00 0 00 001401' 15080 000641'04 102 151 156 141 162 15081 001276'01 200 06 0 00 000003 move q2, t3 ; Save binary file size (in pages) 15082 ; Read-Only, force open even if PMAP%'ed 15083 001277'01 200 02 0 00 002605' movx t2, 15084 001300'01 104 00 0 00 000021 OPENF% ; Try to open the file 15085 001301'01 320 12 0 00 001303' %jserr (,$mmape) 15086 001302'01 254 00 0 00 001306' 15087 001303'01 265 01 0 00 001273* 15088 001304'01 000000000000# 15089 001305'01 254 00 0 00 001401' 15090 000650'04 125 156 141 142 154 15091 15092 remark PMAP% Case IV, deleting process memory 15093 001306'01 474 01 0 00 000000 seto t1, ; Don't want anything in gc .psect 15094 dmove t2, [ .fhslf,,gcpag ; This process, page number of gc psect 15095 001307'01 120 02 0 00 002561' pm%cnt!fld(gcpgs,pm%rpt) ] ; Number of pages to toss 15096 001310'01 104 00 0 00 000056 PMAP% ; Kick them all into oblivion 15097 001311'01 320 12 0 00 001313' %jserr (,$mmape) 15098 001312'01 254 00 0 00 001316' 15099 001313'01 265 01 0 00 001303* 15100 001314'01 000000000000# 15101 001315'01 254 00 0 00 001401' 15102 000660'04 125 156 141 142 154 15103 15104 remark PMAP% Case IV, deleting process memory 15105 001316'01 474 01 0 00 000000 seto t1, ; Don't want anything in macros .psect 15106 dmove t2, [ .fhslf,,macpag ; This process, page number of macros psect 15107 001317'01 120 02 0 00 002606' pm%cnt!fld(macpgs,pm%rpt) ] ; Number of pages to toss 15108 001320'01 104 00 0 00 000056 PMAP% ; Kick them all into oblivion 15109 001321'01 320 12 0 00 001323' %jserr (,$mmapi) k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 31-1 K20MAC MAC 30-Jun-23 17:21 Set up and check to map a real binary file 15110 001322'01 254 00 0 00 001326' 15111 001323'01 265 01 0 00 001313* 15112 001324'01 000000000000# 15113 001325'01 254 00 0 00 001410' 15114 000671'04 125 156 141 142 154 15115 15116 remark PMAP% Case I: Mapping File Pages to a Process 15117 001326'01 514 01 0 00 000005 hrlz t1, q1 ; File JFN, starting from page zero 15118 001327'01 200 02 0 00 002561' movx t2, <.fhslf,, gcpag> ; Put them into the *garbage collection* area 15119 001330'01 200 03 0 00 000006 move t3, q2 ; Get page count 15120 001331'01 302 03 0 00 000001 caie t3, ^d1 ; Only a single page? 15121 001332'01 661 03 0 00 400000 txo t3, pm%cnt ; No, turn on repeat (slower, even for 1 page) 15122 001333'01 661 03 0 00 110000 txo t3, pm%rd!pm%pld ; Get them all in fast 15123 001334'01 104 00 0 00 000056 PMAP% ; And do the I/O 15124 001335'01 320 12 0 00 001337' %jserr (,$mmapi) 15125 001336'01 254 00 0 00 001342' 15126 001337'01 265 01 0 00 001323* 15127 001340'01 000000000000# 15128 001341'01 254 00 0 00 001410' 15129 000704'04 125 156 141 142 154 15130 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 32 K20MAC MAC 30-Jun-23 17:21 Loop to copy pages appropriately 15131 subttl Loop to copy pages appropriately 15132 15133 ; Do we have to check the file page if there's nothing there or the memory? 15134 15135 001342'01 200 04 0 00 000006 move t4, q2 ; Load size as a count 15136 dmove q3, [ gcorg ; Source is garbage collection .psect 15137 001343'01 120 07 0 00 002610' macorg ] ; Destination is the macros .psect 15138 15139 001344'01 do. ; Enter loop context 15140 001344'01 200 01 0 00 000007 move t1, q3 ; Load current gc address 15141 001345'01 242 01 0 00 777767 lsh t1, -^d9 ; Turn into a page number 15142 001346'01 505 01 0 00 400000 hrli t1, .fhslf ; This process 15143 001347'01 104 00 0 00 000057 RPACS% ; Find out what's in there 15144 001350'01 320 12 0 00 001352' ifje. r ; Catch and ignore error 15145 001351'01 254 00 0 00 001353' 15146 001352'01 400 02 0 00 000000 setz t2, ; Assume the page doesn't exist 15147 001353'01 endif. 15148 001353'01 607 02 0 00 010000 ifxn. t2, pa%pex ; Does the page exist? 15149 001354'01 254 00 0 00 001362' 15150 001355'01 607 02 0 00 100000 andxn. t2, pa%rd ; *AND* ... Can we read it? 15151 001356'01 254 00 0 00 001362' 15152 001357'01 201 01 0 00 001000 movei t1, ^d512 ; Yep, load the eternal page size 15153 001360'01 120 02 0 00 000007 dmove t2, q3 ; Load source and destination address 15154 001361'01 123 01 0 00 002501' xblt. t1 ; And put into the macros psect 15155 001362'01 endif. 15156 001362'01 363 04 0 00 001365' sojle t4, endlp. ; Exit when nothing left to do 15157 001363'01 114 07 0 00 002570' dadd q3, [exp ^d512,^d512 ] ; Step to next set of addresses 15158 001364'01 254 00 0 00 001344' loop. ; And go around again 15159 001365'01 enddo. ; Exit loop lexical context 15160 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 33 K20MAC MAC 30-Jun-23 17:21 Loop to copy pages appropriately 15161 remark Binary input file Epilogue 15162 15163 remark Toss the file pages we mapped into the garbage collector 15164 dmove t1, [ -1 ; Case IV, deleting process memory 15165 001365'01 120 01 0 00 002612' .fhslf,,gcpag ] ; This process, page number of gc psect 15166 001366'01 200 03 0 00 000006 move t3, q2 ; Get page count 15167 001367'01 302 03 0 00 000001 caie t3, ^d1 ; Only a single page? 15168 001370'01 661 03 0 00 400000 txo t3, pm%cnt ; No, turn on repeat (slower, even for 1 page) 15169 001371'01 104 00 0 00 000056 PMAP% ; Get rid of them so we can close the file 15170 001372'01 320 12 0 00 001374' %jserr (,) ; Odd... but carry on 15171 001373'01 254 00 0 00 001377' 15172 001374'01 265 01 0 00 001337* 15173 001375'01 000000000000# 15174 001376'01 254 00 0 00 001377' 15175 000716'04 102 151 156 141 162 15176 001377'01 336 00 0 00 000000* skipn iniflg## ;[237] Don't blat if starting up 15177 001400'01 260 17 0 00 002070' call $msumm ; Give us some summary information 15178 15179 remark $mmape ; Falls through to close the JFN 15180 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 34 K20MAC MAC 30-Jun-23 17:21 Error handling, NUL: mapping special case and Initialization 15181 subttl Error handling, NUL: mapping special case and Initialization 15182 15183 001401'01 $mmape: remark ; Here if some other error 15184 001401'01 332 01 0 00 000005 skipe t1, q1 ; Didn't have a JFN? 15185 001402'01 260 17 0 00 001071* call frclos ; We did, go get rid of it 15186 001403'01 600 00 0 00 000000 nop ; Ignore any goofy error 15187 001404'01 263 17 0 00 000000 ret ; But leave the current macro table alone 15188 15189 001405'01 260 17 0 00 001410' $mmapn: call $mmapi ; Whack everything (types summary) 15190 001406'01 260 17 0 00 001401' call $mmape ; Toss any JFN's 15191 001407'01 263 17 0 00 000000 ret ; That was easy enough 15192 15193 001410'01 $mmapi: remark ; Here to initialize for mapping 15194 001410'01 260 17 0 00 001424' call $mrese ; Whack the macros .psect 15195 remark ; Toss anything in garbage collector 15196 001411'01 474 01 0 00 000000 seto t1, ; Case IV, deleting process memory 15197 dmove t2, [ .fhslf,,gcpag ; This process, page number of gc psect 15198 001412'01 120 02 0 00 002561' pm%cnt!fld(gcpgs,pm%rpt) ] ; Number of pages to toss 15199 001413'01 104 00 0 00 000056 PMAP% ; Trim our working set 15200 001414'01 320 12 0 00 001416' %jserr (,) ; Odd... but continue 15201 001415'01 254 00 0 00 001421' 15202 001416'01 265 01 0 00 001374* 15203 001417'01 000000000000# 15204 001420'01 254 00 0 00 001421' 15205 000725'04 102 151 156 141 162 15206 001421'01 263 17 0 00 000000 ret ; Done 15207 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 35 K20MAC MAC 30-Jun-23 17:21 Here to whack all the macros 15208 subttl Here to whack all the macros 15209 15210 remark parse the rest of /RESET 15211 15212 001422'01 260 17 0 00 001200* .mrese: confrm ; Just confirm 15213 001423'01 263 17 0 00 000000 ret ; Then return so we can get on with it 15214 15215 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 36 K20MAC MAC 30-Jun-23 17:21 Execute the /RESET 15216 subttl Execute the /RESET 15217 15218 001424'01 474 01 0 00 000000 $mrese: seto t1, ; Case IV, deleting process memory 15219 dmove t2, [ .fhslf,,macpag ; This process, page number of macros psect 15220 001425'01 120 02 0 00 002606' pm%cnt!fld(macpgs,pm%rpt) ] ; Number of pages to toss 15221 001426'01 104 00 0 00 000056 PMAP% ; Kick them all into oblivion 15222 001427'01 320 12 0 00 001431' ifje. r ; Failed?? 15223 001430'01 254 00 0 00 001444' 15224 001431'01 200 04 0 00 000001 move t4, t1 ; Save the error code 15225 001432'01 201 01 0 00 006777 movx t1, maclen-1 ; Whack the buffer the old fashioned way 15226 001433'01 402 00 0 00 011000 setzm macorg ; Stomp the first location to zero 15227 dmove t2, [ macorg ; Then transfering the first word 15228 001434'01 120 02 0 00 002614' macorg+1 ] ;To the second 15229 001435'01 123 01 0 00 002501' xblt. t1 ; It's turtles all the way down! 15230 001436'01 600 00 0 00 000000 nop ; Ignore the error, we're trying hard enough 15231 001437'01 334 00 0 00 000000 %ermsg (,) 15232 001440'01 254 00 0 00 001444' 15233 001441'01 265 01 0 00 001416* 15234 001442'01 000000000000# 15235 001443'01 254 00 0 00 001444' 15236 000737'04 103 157 165 154 144 15237 001444'01 endif. ; Not promising, but carry on 15238 15239 001444'01 402 00 0 00 000000# setzm onamp ; No previous pointer 15240 dmove t1, [ 0,,MACMAX ; TBLUK% table has no entries now 15241 001445'01 120 01 0 00 002616' 0 ] ; Stomp the 2nd location, just in case 15242 001446'01 124 01 0 00 000000# dmovem t1, mactab ; Now have an empty table 15243 001447'01 200 01 0 00 002620' move t1,[point 7, macbuf] ; Point to beginning of macro storage 15244 001450'01 202 01 0 00 000000# movem t1, macbp ; Stomp into the new table 15245 emacro < 15246 remark ; Toss anything in the macro editor 15247 seto t1, ; Case IV, deleting process memory 15248 dmove t2, [ .fhslf,,medpg ; This process, page number of medit psect 15249 pm%cnt!fld(edpgs,pm%rpt) ] ; Number of pages to toss 15250 PMAP% ; Trim our working set 15251 %jserr (,) ; Odd... but continue 15252 >;; emacro 15253 remark $msumm ; They can do a /summary 15254 ; if they want to know 15255 001451'01 263 17 0 00 000000 ret 15256 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 37 K20MAC MAC 30-Jun-23 17:21 Parse the /SAVE switch 15257 subttl Parse the /SAVE switch 15258 15259 ; Tries for a device first as this is more efficient for NUL: and 15260 ; catches more errors earlier and more easily. 15261 15262 ; Default command filespec fields for .CMFIL: 15263 15264 001452'01 600020 777777 savbk: gj%flg!gj%fou!gj%new!fld(.gjnhg,.rhalf) ; .GJGEN 15265 001453'01 000100 000101 .priin,,.priou ; .GJSRC (ignored if COMND%) 15266 001454'01 000000 000000 0 ; .GJDEV (do not default the device) 15267 001455'01 000000 000000 0 ; .GJDIR (do not default the directory) 15268 001456'01 000000 000000 0 ; .GJNAM (do not default the name) 15269 001457'01 000000000000# eascii () ; .GJEXT (default extension is .CMD) 15270 000750'04 103 115 104 000 000 15271 001460'01 000000000000# 0 ; .GJPRO (use system default protection) 15272 001461'01 000000 000000 0 ; .GJACT (use job's current account) 15273 000010 savbkl==<.-savbk> ; Length of this GTJFN argument block. 15274 15275 001462'01 265 16 0 00 002466' .msave: saveac ; Protect some registers 15276 001463'01 200 01 0 00 002537' movx t1, cz%ncl!.fhslf ; Release non-open JFN's on reparse 15277 001464'01 104 00 0 00 000034 CLZFF% 15278 001465'01 320 12 0 00 001466' erjmpr .+1 ; Catch and ignore errors 15279 001466'01 200 16 0 00 000000# guide 15280 001467'01 260 17 0 00 001111* 15281 000055'02 000000000000# 15282 000751'04 155 141 143 162 157 15283 001470'01 200 01 0 00 002621' move t1, [savbk,,cjfnbk] ; Insert our file parsing defaults. 15284 001471'01 251 01 0 00 000000# blt t1, cjfnbk+savbkl 15285 15286 movei t1, [ ; Catch bare device 15287 flddb. .cmfil,,,,,[ 15288 001472'01 201 01 0 00 002627' flddb. .cmdev,cm%sdh,,,,]] 15289 001473'01 260 17 0 00 001115* call rfield ; Ask them to supply the file 15290 001474'01 135 05 0 00 002440' ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 15291 001475'01 200 06 0 00 000002 move q2, t2 ; Save parsed data (device or JFN) 15292 15293 001476'01 200 01 0 00 000006 move t1, q2 ; Load parse item for DVCHR% 15294 001477'01 302 05 0 00 000016 caie q1, .cmdev ; Typed a bare device? 15295 001500'01 621 01 0 00 777777 tlz t1, -1 ; Shut off flags so DVCHR% doesn't choke 15296 001501'01 104 00 0 00 000117 DVCHR% ; and find out about it 15297 001502'01 320 12 0 00 001504' %jserr (,r) 15298 001503'01 254 00 0 00 001507' 15299 001504'01 265 01 0 00 001441* 15300 001505'01 000000000000# 15301 001506'01 254 00 0 00 001257* 15302 000756'04 125 156 141 142 154 15303 001507'01 200 10 0 00 000001 move q4, t1 ; Store the device designator 15304 001510'01 135 07 0 00 002554' ldb q3, [pointr t2, dv%typ] ; Pick up the device type 15305 15306 001511'01 302 05 0 00 000016 caie q1, .cmdev ; Typed a bare device? 15307 001512'01 254 00 0 00 001567' ifskp. ; Yes, see what it is 15308 001513'01 302 07 0 00 000012 caie q3, .dvtty ; A terminal? 15309 001514'01 254 00 0 00 001542' ifskp. ; Yes, maybe show the user what we'd write 15310 001515'01 550 01 0 00 000010 hrrz t1, q4 ; Load the terminal number 15311 001516'01 316 01 0 00 000000* camn t1, mytty ; Not mine? k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 37-1 K20MAC MAC 30-Jun-23 17:21 Parse the /SAVE switch 15312 001517'01 254 00 0 00 001536' ifskp. ; Nope, disallow it 15313 001520'01 200 01 0 00 000000# emsg 15314 001521'01 104 00 0 00 000313 15315 000056'02 000000000000# 15316 000771'04 131 157 165 040 141 15317 001522'01 201 01 0 00 000101 movei t1, .priou ; Text is coming out on the terminal 15318 001523'01 200 02 0 00 000006 move t2, q2 ; Load the device designator 15319 001524'01 104 00 0 00 000121 DEVST% ; Convert device to string 15320 001525'01 320 12 0 00 001527' %jserr (,r) 15321 001526'01 254 00 0 00 001532' 15322 001527'01 265 01 0 00 001504* 15323 001530'01 000000000000# 15324 001531'01 254 00 0 00 001506* 15325 000776'04 125 156 141 142 154 15326 001532'01 200 01 0 00 000000# txmsg <:> 15327 001533'01 104 00 0 00 000076 15328 001534'01 320 12 0 00 001535' 15329 000057'02 000000000000# 15330 001007'04 072 000 000 000 000 15331 001535'01 254 00 0 00 001243* jrst cmder1 ; Allow ^H 15332 001536'01 endif. 15333 001536'01 260 17 0 00 001422* confrm ; Confirm the selection 15334 001537'01 200 01 0 00 002632' movx t1, ;Use special designator and flags 15335 001540'01 202 01 0 00 001246* movem t1, pars2 ; Store the JFN and (phoney) flags 15336 001541'01 263 17 0 00 000000 ret ; Done with this special case 15337 001542'01 endif. ; Any other device is NOT VALID 15338 15339 001542'01 302 07 0 00 000015 caie q3, .dvnul ; NUL:? 15340 001543'01 254 00 0 00 001550' ifskp. ; Yes, we can simulate that 15341 001544'01 260 17 0 00 001536* confrm ; Confirm the selection 15342 001545'01 200 01 0 00 002555' movx t1, ;Use special designator and flags 15343 001546'01 202 01 0 00 001540* movem t1, pars2 ; Store the JFN and (phoney) flags 15344 001547'01 263 17 0 00 000000 ret ; Done with this special case 15345 001550'01 endif. ; Any other device is NOT VALID 15346 15347 001550'01 302 07 0 00 000000 caie q3, .dvdsk ; Bare device? 15348 001551'01 254 00 0 00 001566' ifskp. ; Yes, but needs a file name 15349 001552'01 200 01 0 00 000000# emsg ; First part of blat 15350 001553'01 104 00 0 00 000313 15351 000060'02 000000000000# 15352 001010'04 124 150 145 040 000 15353 001554'01 200 02 0 00 000006 move t2, q2 ; Load whatever we parsed 15354 001555'01 201 01 0 00 000101 movei t1, .priou ; Output to the terminal 15355 001556'01 104 00 0 00 000121 DEVST% ; Write the device name into the AC's 15356 001557'01 320 12 0 00 001561' %jserr (,cmder1) 15357 001560'01 254 00 0 00 001564' 15358 001561'01 265 01 0 00 001527* 15359 001562'01 000000000000# 15360 001563'01 254 00 0 00 001535* 15361 001011'04 125 156 141 142 154 15362 001564'01 200 01 0 00 000000# sxtext (t1,<: structure needs a file specification>) 15363 000061'02 000000000000# 15364 001022'04 072 040 163 164 162 15365 001565'01 254 00 0 00 001563* jrst cmder1 ; Allow reparse 15366 001566'01 endif. ; Any other device is NOT VALID k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 37-2 K20MAC MAC 30-Jun-23 17:21 Parse the /SAVE switch 15367 15368 001566'01 254 00 0 00 001647' jrst .msve ; Otherwise, handle as a general parse error 15369 001567'01 endif. ; End case .cmdev 15370 15371 remark .cmfil ; Everything else is a file 15372 15373 001567'01 302 07 0 00 000012 caie q3, .dvtty ; A JFN on a terminal? 15374 001570'01 254 00 0 00 001626' ifskp. ; Yes, maybe show the user what we'd write 15375 001571'01 550 01 0 00 000010 hrrz t1, q4 ; Load the terminal number 15376 001572'01 312 01 0 00 001516* came t1, mytty ; Mine? 15377 001573'01 254 00 0 00 001600' ifskp. ; Yep 15378 001574'01 550 01 0 00 000006 hrrz t1, q2 ; Load the JFN 15379 001575'01 104 00 0 00 000023 RLJFN% ; Punt it, we won't be using it 15380 001576'01 320 12 0 00 001577' erjmpr .+1 ; Just strange... 15381 001577'01 254 00 0 00 001622' else. ; Nope, disallow it 15382 001600'01 200 01 0 00 000000# emsg 15383 001601'01 104 00 0 00 000313 15384 000062'02 000000000000# 15385 001032'04 131 157 165 040 141 15386 001602'01 201 01 0 00 000101 movei t1, .priou ; Text is coming out on the terminal 15387 001603'01 550 02 0 00 000006 hrrz t2, q2 ; Load just the JFN 15388 dmove t3, [ ; DEVST% will choke on a JFN... 15389 fld(.jsaof,js%dev) ;Just want the device name, no punctuation 15390 001604'01 120 03 0 00 002556' 0 ] ; No odd prefix, whatever that is 15391 001605'01 104 00 0 00 000030 JFNS% ; Convert to something readable 15392 001606'01 320 12 0 00 001610' %jserr (,cmder1) 15393 001607'01 254 00 0 00 001613' 15394 001610'01 265 01 0 00 001561* 15395 001611'01 000000000000# 15396 001612'01 254 00 0 00 001565* 15397 001037'04 125 156 141 142 154 15398 001613'01 200 01 0 00 000000# txmsg <:> 15399 001614'01 104 00 0 00 000076 15400 001615'01 320 12 0 00 001616' 15401 000063'02 000000000000# 15402 001051'04 072 000 000 000 000 15403 001616'01 550 01 0 00 000006 hrrz t1, q2 ; Load the JFN 15404 001617'01 104 00 0 00 000023 RLJFN% ; Chuck it, we can't use it 15405 001620'01 320 12 0 00 001621' erjmpr .+1 ; Just strange... 15406 001621'01 254 00 0 00 001612* jrst cmder1 ; Allow ^H 15407 001622'01 endif. 15408 15409 001622'01 260 17 0 00 001544* confrm ; Confirm the selection 15410 001623'01 200 01 0 00 002632' movx t1, ;Use special designator and flags 15411 001624'01 202 01 0 00 001546* movem t1, pars2 ; Store the JFN and (phoney) flags 15412 001625'01 263 17 0 00 000000 ret ; Done with this special case 15413 001626'01 endif. ; Any other terminal is NOT valid 15414 15415 001626'01 302 07 0 00 000015 caie q3, .dvnul ; A JFN on NUL:?? 15416 001627'01 254 00 0 00 001642' ifskp. ; Yes, we can simulate that 15417 001630'01 260 17 0 00 001622* confrm ; Confirm the selection 15418 001631'01 200 01 0 00 000006 move t1, q2 ; Load parsed JFN 15419 001632'01 260 17 0 00 001166* call isnulj ; Convert it to a special JFN, releasing original 15420 001633'01 334 01 0 00 000000# ermsg% (,cmder1) ; Allow ^H 15421 001634'01 254 00 0 00 001640' k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 37-3 K20MAC MAC 30-Jun-23 17:21 Parse the /SAVE switch 15422 001635'01 202 01 0 00 001171* 15423 001636'01 104 00 0 00 000313 15424 001637'01 254 00 0 00 001621* 15425 000064'02 000000000000# 15426 001052'04 113 105 122 115 111 15427 15428 001640'01 202 01 0 00 001624* movem t1, pars2 ; Store the JFN and original parse flags 15429 001641'01 263 17 0 00 000000 ret ; Done with this second special NUL: case 15430 001642'01 endif. 15431 15432 001642'01 302 07 0 00 000000 caie q3, .dvdsk ; Was this a structure? 15433 001643'01 254 00 0 00 001647' jrst .msve ; No, any other device is NOT VALID 15434 15435 001644'01 260 17 0 00 001630* confrm ; Otherwise, fine; confirm selection 15436 001645'01 202 06 0 00 001640* movem q2, pars2 ; Store the JFN and flags 15437 001646'01 263 17 0 00 000000 ret ; Done with the parse 15438 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 38 K20MAC MAC 30-Jun-23 17:21 Parse the /SAVE switch 15439 remark Here for common parse errors 15440 15441 001647'01 200 01 0 00 000000# .msve: emsg ; Begin whining 15442 001650'01 104 00 0 00 000313 15443 000065'02 000000000000# 15444 001064'04 124 150 145 040 000 15445 15446 001651'01 201 01 0 00 000101 movei t1, .priou ; Output to terminal, always 15447 001652'01 302 05 0 00 000016 caie q1, .cmdev ; Device? 15448 001653'01 254 00 0 00 001664' ifskp. ; Yes, use DEVST% 15449 001654'01 200 02 0 00 000006 move t2, q2 ; Load whatever we parsed 15450 001655'01 104 00 0 00 000121 DEVST% ; Write the device name into the AC's 15451 001656'01 320 12 0 00 001660' %jserr (,cmder1) 15452 001657'01 254 00 0 00 001663' 15453 001660'01 265 01 0 00 001610* 15454 001661'01 000000000000# 15455 001662'01 254 00 0 00 001637* 15456 001065'04 125 156 141 142 154 15457 001663'01 254 00 0 00 001674' else. ; Otherwise, DEVST% will choke on the JFN 15458 001664'01 550 02 0 00 000006 hrrz t2, q2 ; Load just the JFN 15459 dmove t3, [ ; Just want the device name, no punctuation 15460 fld(.jsaof,js%dev) 15461 001665'01 120 03 0 00 002556' 0 ] ; No odd prefix, whatever that is 15462 001666'01 104 00 0 00 000030 JFNS% ; Convert to something readable 15463 001667'01 320 12 0 00 001671' %jserr (,cmder1) 15464 001670'01 254 00 0 00 001674' 15465 001671'01 265 01 0 00 001660* 15466 001672'01 000000000000# 15467 001673'01 254 00 0 00 001662* 15468 001075'04 125 156 141 142 154 15469 001674'01 endif. ; Either way, error should be more informative 15470 15471 001674'01 200 01 0 00 000000# txmsg <: device is not valid for saving macros> 15472 001675'01 104 00 0 00 000076 15473 001676'01 320 12 0 00 001677' 15474 000066'02 000000000000# 15475 001107'04 072 040 144 145 166 15476 001677'01 561 01 0 00 001233* hrroi t1, crlf ; Newline 15477 001700'01 104 00 0 00 000076 PSOUT% ; Tie off the blat 15478 001701'01 320 12 0 00 001702' erjmpr .+1 ; Catch and ignore that error, too 15479 15480 001702'01 302 05 0 00 000006 caie q1, .cmfil ; Had we parsed a file, actually? 15481 001703'01 254 00 0 00 001707' ifskp. ; Yes, then have a little clean up to do 15482 001704'01 550 01 0 00 000006 hrrz t1, q2 ; Load our poor JFN, sans flags 15483 001705'01 104 00 0 00 000023 RLJFN% ; Toss it; can't use it 15484 001706'01 320 12 0 00 001673* erjmpr cmder1 ; Ignore error and beat it 15485 001707'01 endif. 15486 15487 001707'01 254 00 0 00 001706* jrst cmder1 ; Allow ^H 15488 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 39 K20MAC MAC 30-Jun-23 17:21 Execute the /SAVE switch 15489 subttl Execute the /SAVE switch 15490 15491 ; Not that fast. If you want fast, use /DUMP 15492 15493 001710'01 265 16 0 00 002466' $msave: saveac ; Wants a few accumulators 15494 15495 001711'01 554 06 0 00 000000# hlrz q2, mactab ; Load the macro count 15496 001712'01 326 06 0 00 001717' ife. q2 ; BUT!! Anything to save, really? 15497 txmsg <% No macros to save 15498 001713'01 200 01 0 00 000000# > ; Give a mild scolding 15499 001714'01 104 00 0 00 000076 15500 001715'01 320 12 0 00 001716' 15501 000067'02 000000000000# 15502 001117'04 045 040 116 157 040 15503 15504 001716'01 254 00 0 00 002062' jrst $msve ; And go flush the JFN 15505 001717'01 endif. 15506 15507 001717'01 200 05 0 00 001645* move q1, pars2 ; Load the JFN and flags 15508 001720'01 550 01 0 00 000005 hrrz t1, q1 ; Look at just the JFN 15509 001721'01 306 01 0 00 377777 cain t1, .nulio ; Special cased? 15510 001722'01 254 00 0 00 001734' ifskp. ; No, we're going to have to open it 15511 001723'01 306 01 0 00 000101 cain t1, .priou ; Unless it is primary output 15512 001724'01 254 00 0 00 001734' anskp. ; It is, don't bother 15513 001725'01 200 02 0 00 002633' movx t2, 15514 001726'01 104 00 0 00 000021 OPENF% ; Try to create the file 15515 001727'01 320 12 0 00 001731' %jserr (,$msve) 15516 001730'01 254 00 0 00 001734' 15517 001731'01 265 01 0 00 001671* 15518 001732'01 000000000000# 15519 001733'01 254 00 0 00 002062' 15520 001124'04 125 156 141 142 154 15521 001734'01 endif. 15522 15523 remark t1, ; Either way, t1 has something SOUT% can use 15524 001734'01 400 04 0 00 000000 setz t4, ; For uncounted SOUT%, always stop on a NUL 15525 001735'01 201 07 0 00 000000# movei q3, mactab+1 ; Start at the beginning of the table 15526 15527 001736'01 do. ; Enter loop context 15528 001736'01 120 02 0 00 000000# dxtext (t2,) ; Issue the command (NOTE TRAILING SPACE!!) 15529 000070'02 000000000000# 15530 000071'02 777777 777771 15531 001132'04 144 145 146 151 156 15532 001737'01 104 00 0 00 000053 SOUT% ; Start out with that 15533 001740'01 320 12 0 00 001742' %jserr (,$msve) 15534 001741'01 254 00 0 00 001745' 15535 001742'01 265 01 0 00 001731* 15536 001743'01 000000000000# 15537 001744'01 254 00 0 00 002062' 15538 001134'04 125 156 141 142 154 15539 001745'01 554 02 0 07 000000 hlrz t2, (q3) ; Address of macro name 15540 001746'01 505 02 0 00 440700 hrli t2, (point 7,0) ; Turn into a section local pointer 15541 001747'01 400 03 0 00 000000 setz t3, ; Uncounted, stop on a NUL 15542 001750'01 104 00 0 00 000053 SOUT% ; Write that 15543 001751'01 320 12 0 00 001753' %jserr (,$msve) k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 39-1 K20MAC MAC 30-Jun-23 17:21 Execute the /SAVE switch 15544 001752'01 254 00 0 00 001756' 15545 001753'01 265 01 0 00 001742* 15546 001754'01 000000000000# 15547 001755'01 254 00 0 00 002062' 15548 001143'04 125 156 141 142 154 15549 001756'01 201 02 0 00 000040 movei t2, .chspc ; Seperate macro name and body 15550 001757'01 104 00 0 00 000051 BOUT% ; Emit the space 15551 001760'01 550 02 0 07 000000 hrrz t2, (q3) ; Address of macro body 15552 001761'01 505 02 0 00 440700 hrli t2, (point 7,0) ; Turn into a section local pointer 15553 001762'01 400 03 0 00 000000 setz t3, ; Uncounted, stop on a NUL 15554 001763'01 104 00 0 00 000053 SOUT% ; Write that 15555 001764'01 320 12 0 00 001766' %jserr (,$msve) 15556 001765'01 254 00 0 00 001771' 15557 001766'01 265 01 0 00 001753* 15558 001767'01 000000000000# 15559 001770'01 254 00 0 00 002062' 15560 001151'04 125 156 141 142 154 15561 remark ; All have CRLF 15562 001771'01 363 06 0 00 001773' sojle q2, endlp. ; At end? Then stop 15563 001772'01 344 07 0 00 001736' aoja q3, top. ; Otherwise, do next table entry 15564 001773'01 enddo. ; End loop lexical context 15565 15566 001773'01 306 01 0 00 377777 cain t1, .nulio ; Not writing to NUL:? 15567 001774'01 254 00 0 00 002015' ifskp. ; Nope, then we should have a byte count 15568 001775'01 306 01 0 00 000101 cain t1, .priou ; Unless it's primary output 15569 001776'01 254 00 0 00 002015' anskp. ; That won't have one, either 15570 001777'01 104 00 0 00 000043 RFPTR% ; See how much we've written 15571 002000'01 320 12 0 00 002002' %jsErr (, $msve) 15572 002001'01 254 00 0 00 002005' 15573 002002'01 265 01 0 00 001766* 15574 002003'01 000000000000# 15575 002004'01 254 00 0 00 002062' 15576 001157'04 125 156 141 142 154 15577 002005'01 200 07 0 00 000002 move q3, t2 ; Save the (non-negative) byte count 15578 002006'01 104 00 0 00 000022 CLOSF% ; Completely close the (disk) file 15579 002007'01 320 12 0 00 002011' %jsErr (, $msve) 15580 002010'01 254 00 0 00 002014' 15581 002011'01 265 01 0 00 002002* 15582 002012'01 000000000000# 15583 002013'01 254 00 0 00 002062' 15584 001166'04 125 156 141 142 154 15585 002014'01 254 00 0 00 002016' else. ; Neither NUL: nor TTY: will have byte counts 15586 002015'01 474 07 0 00 000000 seto q3, ; Flag that 15587 002016'01 endif. 15588 15589 002016'01 200 01 0 00 000000# txmsg 15590 002017'01 104 00 0 00 000076 15591 002020'01 320 12 0 00 002021' 15592 000072'02 000000000000# 15593 001174'04 127 162 157 164 145 15594 002021'01 201 01 0 00 000101 movei t1, .priou ; Typing to terminal 15595 002022'01 554 02 0 00 000000# hlrz t2, mactab ; Number of macros 15596 002023'01 201 03 0 00 000012 movei t3, ^d10 ; All numbers are in base ten 15597 002024'01 200 04 0 00 000002 move t4, t2 ; Save the count 15598 002025'01 104 00 0 00 000224 NOUT% k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 39-2 K20MAC MAC 30-Jun-23 17:21 Execute the /SAVE switch 15599 002026'01 320 14 0 00 000001 erjmps +1 ; Catch and suppress error 15600 002027'01 200 01 0 00 000000# txmsg < macro> ; Assume singular 15601 002030'01 104 00 0 00 000076 15602 002031'01 320 12 0 00 002032' 15603 000073'02 000000000000# 15604 001176'04 040 155 141 143 162 15605 002032'01 306 04 0 00 000001 cain t4, ^d1 ; BUT! Non-plural or zero? 15606 002033'01 254 00 0 00 002037' ifskp. ; Nope, have to inflect because we're grammatical 15607 002034'01 201 01 0 00 000163 movei t1, "s" ; Pluralizer 15608 002035'01 104 00 0 00 000074 PBOUT% ; Properly inflect 15609 002036'01 320 14 0 00 000001 erjmps +1 ; Catch and suppress error 15610 002037'01 endif. 15611 15612 002037'01 321 07 0 00 002057' ifge. q3 ; Could we count the data? 15613 002040'01 200 01 0 00 000000# txmsg <, > ; Yes, so type it 15614 002041'01 104 00 0 00 000076 15615 002042'01 320 12 0 00 002043' 15616 000074'02 000000000000# 15617 001200'04 054 040 000 000 000 15618 002043'01 201 01 0 00 000101 movei t1, .priou ; Typing to terminal 15619 002044'01 200 02 0 00 000007 move t2, q3 ; Number of characters written 15620 002045'01 104 00 0 00 000224 NOUT% 15621 002046'01 320 14 0 00 000001 erjmps +1 ; Catch and suppress error 15622 002047'01 200 01 0 00 000000# txmsg < character> ; Assume singular 15623 002050'01 104 00 0 00 000076 15624 002051'01 320 12 0 00 002052' 15625 000075'02 000000000000# 15626 001201'04 040 143 150 141 162 15627 002052'01 306 04 0 00 000001 cain t4, ^d1 ; BUT! Non-plural or zero? 15628 002053'01 254 00 0 00 002057' ifskp. ; Nope, have to inflect because we're grammatical 15629 002054'01 201 01 0 00 000163 movei t1, "s" ; Pluralizer 15630 002055'01 104 00 0 00 000074 PBOUT% ; Properly inflect 15631 002056'01 320 14 0 00 000001 erjmps +1 ; Catch and suppress error 15632 002057'01 endif. 15633 002057'01 endif. 15634 15635 002057'01 561 01 0 00 001677* hrroi t1, crlf ; Tie off the line 15636 002060'01 104 00 0 00 000076 PSOUT% 15637 15638 002061'01 263 17 0 00 000000 ret ; Finally done 15639 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 40 K20MAC MAC 30-Jun-23 17:21 Error handling 15640 subttl Error handling 15641 15642 002062'01 $msve: remark ; Here to handle errors 15643 002062'01 332 01 0 00 000005 skipe t1, q1 ; Didn't have a JFN? 15644 002063'01 260 17 0 00 001402* call frclos ; We did, go get rid of it 15645 002064'01 600 00 0 00 000000 nop ; Ignore any goofy error 15646 002065'01 263 17 0 00 000000 ret ; Done 15647 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 41 K20MAC MAC 30-Jun-23 17:21 Provide summary information 15648 subttl Provide summary information 15649 15650 002066'01 260 17 0 00 001644* .msumm: confrm ; Tie off the line 15651 002067'01 263 17 0 00 000000 ret 15652 15653 002070'01 200 01 0 00 000000# $msumm: txmsg 15654 002071'01 104 00 0 00 000076 15655 002072'01 320 12 0 00 002073' 15656 000076'02 000000000000# 15657 001204'04 115 141 143 162 157 15658 002073'01 201 01 0 00 000101 movei t1, .priou ; This terminal 15659 002074'01 554 02 0 00 000000# hlrz t2, mactab ; Load macro keyword table entries 15660 002075'01 200 04 0 00 000002 move t4, t2 ; Tuck that away for later 15661 002076'01 201 03 0 00 000012 movei t3, ^d10 ; It's in base ten 15662 002077'01 104 00 0 00 000224 NOUT% ; Type it 15663 002100'01 320 12 0 00 002102' %jserr (,) ; Dubious, but carry on 15664 002101'01 254 00 0 00 002105' 15665 002102'01 265 01 0 00 002011* 15666 002103'01 000000 000000 15667 002104'01 254 00 0 00 002105' 15668 002105'01 200 01 0 00 000000# txmsg < used, > 15669 002106'01 104 00 0 00 000076 15670 002107'01 320 12 0 00 002110' 15671 000077'02 000000000000# 15672 001206'04 040 165 163 145 144 15673 002110'01 201 01 0 00 000101 movei t1, .priou ; This terminal 15674 002111'01 550 02 0 00 000000# hrrz t2, mactab ; Load maximum macro keyword table entries 15675 002112'01 274 02 0 00 000004 sub t2, t4 ; Yields remaining 15676 002113'01 104 00 0 00 000224 NOUT% ; Type that 15677 002114'01 320 12 0 00 002116' %jserr (,) ; Sigh... Carry on 15678 002115'01 254 00 0 00 002121' 15679 002116'01 265 01 0 00 002102* 15680 002117'01 000000 000000 15681 002120'01 254 00 0 00 002121' 15682 txmsg < remaining. 15683 002121'01 200 01 0 00 000000# Available storage: > 15684 002122'01 104 00 0 00 000076 15685 002123'01 320 12 0 00 002124' 15686 000100'02 000000000000# 15687 001210'04 040 162 145 155 141 15688 15689 002124'01 260 17 0 00 002144' call $mchrs ; Get us some other table numbers 15690 002125'01 200 02 0 00 000001 move t2, t1 ; Load total storage 15691 002126'01 200 04 0 00 000001 move t4, t1 ; Save a copy 15692 002127'01 201 01 0 00 000101 movei t1, .priou ; This terminal 15693 002130'01 201 03 0 00 000012 movei t3, ^d10 ; Base ten 15694 002131'01 104 00 0 00 000224 NOUT% ; Convert to external and display 15695 002132'01 320 12 0 00 002133' erjmpr .+1 ; Catch and ignore error 15696 002133'01 200 01 0 00 000000# txmsg < character> ; Assume (rare) singular case) 15697 002134'01 104 00 0 00 000076 15698 002135'01 320 12 0 00 002136' 15699 000101'02 000000000000# 15700 001217'04 040 143 150 141 162 15701 002136'01 201 01 0 00 000163 movei t1,"s" ;[203] Load inflection 15702 002137'01 302 04 0 00 000001 caie t4,^d1 ;[203] Singular case? k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 41-1 K20MAC MAC 30-Jun-23 17:21 Provide summary information 15703 002140'01 104 00 0 00 000074 PBOUT% ;[203] No, must inflect it 15704 15705 002141'01 561 01 0 00 002057* hrroi t1, crlf 15706 002142'01 104 00 0 00 000076 PSOUT% 15707 002143'01 263 17 0 00 000000 ret 15708 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 42 K20MAC MAC 30-Jun-23 17:21 Provide some table information to caller 15709 subttl Provide some table information to caller 15710 15711 ; Returns: 15712 ; 15713 ; t1/ characters available in macro table 15714 15715 002144'01 $mchrs: entry $mchrs ; Called by k20dsp 15716 002144'01 265 16 0 00 002634' saveac ; Be extra tidy 15717 15718 002145'01 201 01 0 00 000000# movei t1, macx ; Load end of macro table 15719 002146'01 200 02 0 00 000000# move t2, macbp ; Load end of macro expansions 15720 002147'01 554 03 0 00 000002 hlrz t3, t2 ; Load the byte pointer 15721 002150'01 302 03 0 00 440700 caie t3, 440700 ; On a word boundary? 15722 002151'01 271 02 0 00 000001 addi t2,^d1 ; No, round up a word 15723 002152'01 621 02 0 00 777777 tlz t2, -1 ; Shut off the byte pointer 15724 002153'01 274 01 0 00 000002 sub t1, t2 ; Calculate remaining words 15725 002154'01 221 01 0 00 000005 imuli t1, ^d5 ; Have total characters 15726 002155'01 263 17 0 00 000000 ret 15727 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 43 K20MAC MAC 30-Jun-23 17:21 Garbage collection 15728 subttl Garbage collection 15729 15730 remark Parsing 15731 15732 002156'01 260 17 0 00 002066* .mcomp: confrm ; Tie off the line 15733 002157'01 263 17 0 00 000000 ret ; Then get going on processing 15734 15735 remark Semantic action 15736 15737 extern ehptim ; Display elapsed processor ticks 15738 15739 002160'01 $mcomp: remark ; Garbage collection prologue 15740 002160'01 265 16 0 00 002466' saveac ; Will need some registers for control 15741 002161'01 200 01 0 00 000000# txmsg ; Set up for some blat 15742 002162'01 104 00 0 00 000076 15743 002163'01 320 12 0 00 002164' 15744 000102'02 000000000000# 15745 001222'04 102 145 146 157 162 15746 002164'01 260 17 0 00 002070' call $msumm ; Display macro table usage 15747 15748 002165'01 260 17 0 00 000000* call statim ; Record start time garbage collection run 15749 002166'01 201 01 0 00 000001 movx t1, .hprnt ; Request current CPU time used 15750 002167'01 104 00 0 00 000501 HPTIM% ; by this process 15751 002170'01 320 12 0 00 002172' %jserr (,r) ; Fail and don't do anything more 15752 002171'01 254 00 0 00 002175' 15753 002172'01 265 01 0 00 002116* 15754 002173'01 000000 000000 15755 002174'01 254 00 0 00 001531* 15756 002175'01 200 10 0 00 000001 move q4, t1 ; Store that 15757 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 44 K20MAC MAC 30-Jun-23 17:21 Garbage collection 15758 remark Set up loop context 15759 15760 remark ; First copy current macro .psect to the GC 15761 002176'01 554 05 0 00 000000# hlrz q1, mactab ; Save count of current entries 15762 002177'01 326 05 0 00 002204' ife. q1 ; Wait a second, is there anything to do? 15763 txmsg <% No macros, nothing to compact 15764 002200'01 200 01 0 00 000000# > ; Some minor scolding blat 15765 002201'01 104 00 0 00 000076 15766 002202'01 320 12 0 00 002203' 15767 000103'02 000000000000# 15768 001224'04 045 040 116 157 040 15769 15770 002203'01 263 17 0 00 000000 ret ; That all, we're done 15771 002204'01 endif. 15772 15773 002204'01 201 01 0 00 007000 movx t1, maclen ; Length of both .psect's 15774 dmove t2, [ macorg ; Source is first word of macro psect 15775 002205'01 120 02 0 00 002566' gcorg ] ; Destination is first word of gc psect 15776 002206'01 123 01 0 00 002501' xblt. t1 ; Copy entire macros psect to gc psect 15777 002207'01 600 00 0 00 000000 nop ; Ignore any skip nonsense 15778 002210'01 260 17 0 00 001424' call $mrese ; Now completely destroy the macros psect 15779 15780 002211'01 201 01 0 00 000001 movei t1, ^d1 ; Account for the header word 15781 002212'01 270 01 0 00 000005 add t1, q1 ; Only put back the TBLUK% entries 15782 dmove t2, [ gcorg ; Source is first word of gc psect (previous mactab 15783 002213'01 120 02 0 00 002610' macorg ] ; Destination is first word of macro psect 15784 002214'01 123 01 0 00 002501' xblt. t1 ; Only copy the in use part of the table 15785 002215'01 600 00 0 00 000000 nop ; Ignore any skip nonsense 15786 15787 002216'01 201 06 0 00 011001 movei q2, macorg+1 ; First slot in macro table 15788 dmove t1, [ gcorg ; Load first address of garbage collection 15789 002217'01 120 01 0 00 002610' macorg ] ; End first slot of macro table 15790 002220'01 317 01 0 00 000002 camg t1, t2 ; macros should be before garbage collection 15791 002221'01 250 01 0 00 000002 exch 1, t2 ; But they're not (??) 15792 002222'01 274 01 0 00 000002 sub t1, t2 ; Calculate address offset between tables 15793 002223'01 200 07 0 00 000001 move q3, t1 ; Store that 15794 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 45 K20MAC MAC 30-Jun-23 17:21 Garbage collection 15795 remark Get down to some serious byte banging 15796 15797 ; The garbage collection algorythm is trivial. We've copyed the entire 15798 ; macros psect to the gc psect, stomped the macros psect and then only 15799 ; copied the used entries in the keyword table back. 15800 ; 15801 ; Here, using the keyword table as a basis, we copy over each keyword 15802 ; and text that is pointed to by an entry and fix the pointers 15803 ; accordingly. Anything that doesn't get copied is orphaned data and 15804 ; is no longer necessary. Once this is done, we toss the gc psect. 15805 15806 002224'01 do. ; Enter loop 15807 002224'01 260 17 0 00 002321' call mkeycp ; Copy the keyword (macro name) 15808 002225'01 260 17 0 00 002336' call mtxtcp ; Copy the text of the macro over 15809 002226'01 271 06 0 00 000001 addi q2, ^d1 ; Step to next slot in macro table 15810 002227'01 367 05 0 00 002224' sojg q1, top. ; And do the remaining 15811 002230'01 enddo. ; End loop lexical context 15812 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 46 K20MAC MAC 30-Jun-23 17:21 Garbage collection 15813 remark Compact epilogue, displays more data 15814 15815 002230'01 201 01 0 00 000001 movx t1, .hprnt ; Request current CPU time 15816 002231'01 104 00 0 00 000501 HPTIM% ; now that we're done 15817 002232'01 320 12 0 00 002234' %jserr (,r) ; Fail and don't do anything more 15818 002233'01 254 00 0 00 002237' 15819 002234'01 265 01 0 00 002172* 15820 002235'01 000000 000000 15821 002236'01 254 00 0 00 002174* 15822 002237'01 315 01 0 00 000010 camge t1, q4 ; Did it wrap around 15823 002240'01 250 01 0 00 000010 exch t1, q4 ; It did, fix that 15824 002241'01 276 01 0 00 000010 subm t1, q4 ; Get and store the difference in HP ticks 15825 15826 002242'01 260 17 0 00 000000* call endtim ; Take a snapshot from right now 15827 002243'01 260 17 0 00 000000* call elptim ; Calculates elapsed time 15828 15829 002244'01 200 01 0 00 000000# txmsg ; Give interesting post blat 15830 002245'01 104 00 0 00 000076 15831 002246'01 320 12 0 00 002247' 15832 000104'02 000000000000# 15833 001233'04 101 146 164 145 162 15834 002247'01 260 17 0 00 002070' call $msumm ; Display macro table usage 15835 15836 002250'01 201 02 0 00 000000* movei t2, ewallt ; Load pointer to elapsed wall time 15837 002251'01 120 03 0 02 000017 dmove t3, .datus(t2) ; Load elapsed HPTIM% double word 15838 002252'01 434 03 0 00 000004 or t3, t4 ; Will print if either high or low order 15839 002253'01 322 03 0 00 002264' ifn. t3 ; Did this take any time, actually? 15840 002254'01 200 07 0 00 000003 move q3, t3 ; It did, so save as a talisman 15841 002255'01 200 01 0 00 000000# txmsg ; Seperate from characters cleared 15842 002256'01 104 00 0 00 000076 15843 002257'01 320 12 0 00 002260' 15844 000105'02 000000000000# 15845 001235'04 105 154 141 160 163 15846 002260'01 201 01 0 00 000101 movei t1, .priou ; Going to terminal 15847 002261'01 260 17 0 00 000000* call durtim ; Nicely print the duration 15848 002262'01 600 00 0 00 000000 nop ; Ignore any goofy return 15849 002263'01 254 00 0 00 002265' else. ; Else did nothing 15850 002264'01 400 07 0 00 000000 setz q3, ; So flag this 15851 002265'01 endif. ; End case positive elapsed time 15852 15853 ; Note a small hack for ehptim: it now takes a pointer to a signed 15854 ; double word instead a signed single word. It happens that we have 15855 ; the value in q4, that q3 is free, that there will never be any high 15856 ; order and that ehptim does not modify either one. Thus, we pass 15857 ; it a pointer to that double word accumulator pair and everything 15858 ; works fine. For the moment... Until something changes... 15859 15860 002265'01 323 10 0 00 002306' ifg. q4 ; Any CPU time taken? 15861 002266'01 322 07 0 00 002272' ifn. q3 ; Displayed any elapsed time? 15862 002267'01 200 01 0 00 000000# txmsg <, > ; Yes, space over 15863 002270'01 104 00 0 00 000076 15864 002271'01 320 12 0 00 002272' 15865 000106'02 000000000000# 15866 001237'04 054 040 000 000 000 15867 002272'01 endif. k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 46-1 K20MAC MAC 30-Jun-23 17:21 Garbage collection 15868 002272'01 200 01 0 00 000000# txmsg ; Introduce processor blat 15869 002273'01 104 00 0 00 000076 15870 002274'01 320 12 0 00 002275' 15871 000107'02 000000000000# 15872 001240'04 103 120 125 072 040 15873 002275'01 201 01 0 00 000101 movei t1, .priou ; Going to terminal 15874 002276'01 201 02 0 00 000000# movei t2, mecpu ; Load pointer to macro elapsed CPU 15875 remark .datet ;[221] Don't touch!! This should ALWAYS be zero 15876 002277'01 400 07 0 00 000000 setz q3, ;[221] Clear double word of HP ticks (q3 untouched) 15877 002300'01 124 07 0 02 000017 dmovem q3, .datus(t2) ;[221] Store elapsed DK10 15878 002301'01 201 10 0 02 000017 movei q4, .datus(t2) ;[221] Now point to it 15879 002302'01 250 02 0 00 000010 exch t2, q4 ;[221] Pass in pointer to DK10 ticks, actually 15880 002303'01 400 03 0 00 000000 setz t3, ;[221] Don't suppress leading seconds 15881 002304'01 260 17 0 00 000000* call ehptim ; Display elapsed HP ticks 15882 002305'01 600 00 0 00 000000 nop ;[221] Ignore non-fatal +1 15883 002306'01 endif. ; End CPU display 15884 15885 002306'01 561 01 0 00 002141* hrroi t1, crlf ; Tie off the line 15886 002307'01 104 00 0 00 000076 PSOUT% 15887 15888 remark ; Now that we're done, don't need the gc psect 15889 002310'01 474 01 0 00 000000 seto t1, ; Case IV, deleting process memory 15890 dmove t2, [ .fhslf,,gcpag ; This process, page number of gc psect 15891 002311'01 120 02 0 00 002561' pm%cnt!fld(gcpgs,pm%rpt) ] ; Number of pages to toss 15892 002312'01 104 00 0 00 000056 PMAP% ; Trim our working set 15893 002313'01 320 12 0 00 002315' %jserr (,) ; Odd... but continue 15894 002314'01 254 00 0 00 002320' 15895 002315'01 265 01 0 00 002234* 15896 002316'01 000000000000# 15897 002317'01 254 00 0 00 002320' 15898 001242'04 120 157 163 164 040 15899 15900 002320'01 263 17 0 00 000000 ret ; Don't forget to finally return 15901 15902 chgsec(code,data) ;;Some temporary storage 15903 000000'05 mecpu: XList ; Save a few trees 15904 List ; Turn the listing back on 15905 15906 retsec ;;Restore .PSECT assumptions 15907 15908 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 47 K20MAC MAC 30-Jun-23 17:21 String copy measurement, 9:10pm Thursday, 21 July 1920 15909 subttl String copy measurement, 9:10pm Thursday, 21 July 1920 15910 15911 ; A question had sometimes come up for debate as to whether the string 15912 ; instructions gave any real speed up, the concern being whether the 15913 ; set up cost of conditioning the register file and restoring it was 15914 ; worth using them. 15915 ; 15916 ; Three cases were set up, the first being a typical ildb/idpb loop 15917 ; with the second being a use of movst to move the string until a nul 15918 ; was detected. The third was a mixture; the keywords being moved 15919 ; with a loop and the macro expansions being moved with the movst. 15920 ; This was expected to be have the best performance as macro names 15921 ; (I.E., keywords) are typically not very long. 15922 ; 15923 ; 11 macros were defined, using a total of 80 characters of macro name 15924 ; space and 1365 characters of macro text space. The results are 15925 ; suprising: 15926 ; 15927 ; Case Elapsed CPU All 15928 ; 1 1.360 1.320 times 15929 ; *2 .340 .320 are in 15930 ; 3 1.020 .980 milliseconds 15931 ; 15932 ; By a considerable margin, using solely the movst won. This is why 15933 ; it is used exclusively, below. Going forward, other cases may be 15934 ; identified in Kermit where it can be used. 15935 15936 extern asczcp ; Extended instruction to move ASCIZ 15937 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 48 K20MAC MAC 30-Jun-23 17:21 Routine to copy keyword (macro name) data 15938 subttl Routine to copy keyword (macro name) data 15939 15940 ; Expects: 15941 ; 15942 ; q2/ Address of current keyword entry 15943 ; q3/ Word offset between tables 15944 ; 15945 ; Returns: 15946 ; 15947 ; +1, always 15948 15949 002321'01 mkeycp: remark ; Copy the keyword (macro name) 15950 002321'01 554 01 0 06 000000 hlrz t1, (q2) ; Pick up keyword address 15951 002322'01 270 01 0 00 000007 add t1, q3 ; add in offset 15952 002323'01 505 01 0 00 440700 hrli t1, (point 7,0) ; Now have a source pointer 15953 002324'01 200 02 0 00 000000# move t2, macbp ; Point to our (scrubbed) macro table 15954 002325'01 506 02 0 06 000000 hrlm t2, (q2) ; Stomp in as the new keyword address 15955 002326'01 260 17 0 00 000443* call asczcp ; Copy the ASCIZ string 15956 002327'01 554 04 0 00 000002 hlrz t4, t2 ; Load the destination pointer portion 15957 002330'01 306 04 0 00 440700 cain t4, 440700 ; On a word boundary? (1 in 5 chance) 15958 002331'01 254 00 0 00 002334' ifskp. ; Nope, fix 15959 002332'01 271 02 0 00 000001 addi t2, ^d1 ; Round up a word 15960 002333'01 505 02 0 00 440700 hrli t2, 440700 ; Stomp in the right magic 15961 002334'01 endif. ; Ready for any future usage 15962 002334'01 202 02 0 00 000000# movem t2, macbp ; Point to our (scrubbed) macro table 15963 002335'01 263 17 0 00 000000 ret ; All is well, return 15964 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 49 K20MAC MAC 30-Jun-23 17:21 Routine to copy macro text (macro expansion) data 15965 subttl Routine to copy macro text (macro expansion) data 15966 15967 ; Expects: 15968 ; 15969 ; q2/ Address of current keyword entry 15970 ; q3/ Word offset between tables 15971 ; 15972 ; Returns: 15973 ; 15974 ; +1, Always 15975 15976 extern asczcp ; Extended instruction to move ASCIZ 15977 15978 002336'01 mtxtcp: remark ; Copy the text of the macro over 15979 002336'01 550 01 0 06 000000 hrrz t1, (q2) ; Pick up expansion address 15980 002337'01 270 01 0 00 000007 add t1, q3 ; add in offset 15981 002340'01 505 01 0 00 440700 hrli t1, (point 7,0) ; Now have a source pointer 15982 002341'01 200 02 0 00 000000# move t2, macbp ; Point to our (scrubbed) macro text table 15983 002342'01 542 02 0 06 000000 hrrm t2, (q2) ; Stomp in as the new text address 15984 002343'01 260 17 0 00 002326* call asczcp ; Maybe will even save some cpu time 15985 002344'01 554 04 0 00 000002 hlrz t4, t2 ; Load the destination pointer portion 15986 002345'01 306 04 0 00 440700 cain t4, 440700 ; On a word boundary? (1 in 5 chance) 15987 002346'01 254 00 0 00 002351' ifskp. ; Nope, fix 15988 002347'01 271 02 0 00 000001 addi t2, ^d1 ; Round up a word 15989 002350'01 505 02 0 00 440700 hrli t2, 440700 ; Stomp in the right magic 15990 002351'01 endif. ; Ready for any future usage 15991 002351'01 202 02 0 00 000000# movem t2, macbp ; And update global storage 15992 002352'01 263 17 0 00 000000 ret ; All is well, return 15993 15994 .endps code 15995 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 50 K20MAC MAC 30-Jun-23 17:21 Additional writable storage areas 15996 subttl Additional writable storage areas 15997 15998 .psect data 15999 000021'05 000000 000000 onamp: 0 ;[77] Previous NAMP. 16000 000022'05 000000 000000 tbent: 0 ; TBLUK% entry of existing keyword 16001 000023'05 000000 000000 sintn: 0 ; Number of signal I/O traps we've seen 16002 16003 extern namlen,namatm,explen,expatm 16004 16005 remark definf,undeff ; Must be whacked on every parse 16006 000024'05 000000 000000 definf:: 0 ;[77] DEFINE flag nonzero if parsing DEFINE. 16007 000025'05 000000 000000 undeff:: 0 ;[77] UNDEFF flag nonzero if DEFINE x . 16008 000026'05 000000 000000 macptr:: 0 ;[77] Pointer to start of macro text in CSB. 16009 16010 .endps data 16011 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 51 K20MAC MAC 30-Jun-23 17:21 Macros storage areas 16012 subttl Macros storage areas 16013 16014 ;N.B, Do NOT put anything into this .PSECT without updating the 16015 ; calculations for maclen in k20unv!!! 16016 16017 .psect macros,macorg ; Storage for macros 16018 16019 ; The TBLUK% table, with one predefined macro for Columbia's IBM 16020 ; system. Users can remove this definition by typing "define ibm", or 16021 ; they can replace it. KERMIT-20 maintainers can remove it for their 16022 ; site by replacing the contents of MACTAB (first word) with 16023 ; 0,,MACMAX, or can change it to be anything they like. 16024 ; 16025 ; Kept for historical reasons and for any take files that depend on it. 16026 ; 16027 ; Be aware that the calculations for .psect size account for the IBM 16028 ; keyword and the cooresponding macro body. If you do change this to 16029 ; be something else, then take a look at calculations in k20unv that are 16030 ; driven off of macmax. 16031 ; 16032 ; You need only change the slop calculations that are done with adslop. 16033 ; 16034 ; mactab MUST be the first location in the .psect!! Garbage collection 16035 ; depends on this. 16036 16037 000000'06 mactab: intern mactab ;[194] 16038 000000'06 000001 000252 1,,macmax ;[77] Macro keyword TBLUK format table. 16039 000001'06 000255' 000256' ibmkey,,ibmmac ; Where is my 3276?? 16040 000002'06 block macmax-1 ;[77] Macro keyword table. 16041 000253'06 mactbx: block 1 ;[214] ; Tiny bit of slop 16042 16043 ; This pointer has to be in here so that /MAP restores them. No 16044 ; TBADD% should ever overwrite it because the maximum count (in the 16045 ; right halfword of TBLUK% table) can not be exceeded. 16046 16047 000254'06 44 07 0 00 000267' macbp: point 7, m1stf ; First free location in macro (expansion) table 16048 16049 ; Both macro names and bodies are allocated out of the same block of 16050 ; storage, which allows for more flexible management, Note that the 16051 ; macro buffer MUST be the last item in the .PSECT in order to get the 16052 ; benefit of guard page two, which follows. 16053 16054 000255'06 macbuf: remark ; Here are the macros 16055 000255'06 111 102 115 000 000 ibmkey:! asciz /IBM/ ; Macro name 16056 000256'06 160 141 162 151 164 ibmmac:! asciz/parity mark, duplex half, handshake xon 16057 / ; Yummy half duplex!! 16058 000267'06 m1stf:! .xcref m1stf ; Don't need this in the cross reference 16059 suppress m1stf ; Nor in the symbol table listing 16060 000267'06 block mnblen ; Space for the names 16061 001013'06 block mtblen ; Space for the expansions 16062 006777'06 macx: block 1 ;[77] End of macro text buffer, with padding. 16063 16064 if2 < purge m1stf > ; Not needed after second pass 16065 .endps macros 16066 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 51-1 K20MAC MAC 30-Jun-23 17:21 Macros storage areas 16067 .psect gc,gcorg ; psect for garbage collections 16068 000000'07 block maclen ; same size as for macros 16069 .endps gc 16070 16071 emacro < 16072 .psect medit,medorg ; psect for macro editing 16073 block maclen ; same size as for macros 16074 .endps medit ; Probably far too large 16075 >;;emacro 16076 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 52 K20MAC MAC 30-Jun-23 17:21 History and Motivation 16077 subttl History and Motivation 16078 16079 ; The is all part of edit 203 16080 16081 ;PS:KERMIT.MAC.288, 27-Oct-83 18:55:44, Frank 16082 ;[77] Add DEFINE command for SET macros. Remove hardwired SET IBM. 16083 16084 ; The DEFINE command for SET macros is quite old, having been added by 16085 ; Frank da Cruz as part of edit 77 on 27-Oct-83. It predates the 16086 ; availability of extended sections and read-only .psects (perhaps 16087 ; even .psects themselves) 16088 ; 16089 ; It's fine for what it does, meaning loading up a bunch of macros 16090 ; from a KERMIT.INI file, and clearly functioned fine for years, if 16091 ; not decades. 16092 ; 16093 ; However, during the DECnet NRT work, it became increasingly 16094 ; aggressively used, which revealed some limitations: 16095 ; 16096 ; DEFINE assumed that you are always creating a macro and thus copies 16097 ; whatever is in the atom buffer into the name table. This means 16098 ; that, in addition to not freeing up any name or macro space, 16099 ; undefining a macro would actually use *more* name space. 16100 ; 16101 ; Because this copy happened during the parse and not after the 16102 ; command had been confirmed, if the user started defining a macro, 16103 ; changed his mind and typed a ^U, space in the name table would still 16104 ; be usurped for each and every reparse. 16105 ; 16106 ; Thus, during the process of either learning the DEFINE command or 16107 ; trying different parameters, the user could run out of space without 16108 ; actually having accomplished anything. There was no remedy to this 16109 ; except to exit and run a fresh copy of Kermit. 16110 ; 16111 ; The out of space check was not reliable. First, it checked to see 16112 ; if the macro name and text space was already full at the beginning 16113 ; of the parse. These checks simply looked to see if the macro name 16114 ; and table space had started to go past the marked end of tables. 16115 ; Overwrites were prevented by having a certain amount of slop for the 16116 ; definition to expand into. 16117 ; 16118 ; However, once the check was passed, Kermit did no further checking, 16119 ; meaning the user could blithly continue typing, overwriting whatever 16120 ; happened to be after the tables. This, coupled with the reparse 16121 ; phenomena previously described could produce some pretty quirky 16122 ; behavior, if not downright crashes. 16123 ; 16124 ; Another non-critical limitation was that there was was no way to 16125 ; make modifications to a macro once it was defined. Any change meant 16126 ; that you had to basically type the whole macro in again. 16127 ; 16128 ; As a practical matter, while SET macros could be read in via the 16129 ; execution of a TAKE file, there was no way to write them out. 16130 ; 16131 ; Fixing the problems above and adding the extra functionality proved k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 52-1 K20MAC MAC 30-Jun-23 17:21 History and Motivation 16132 ; so massive an addition that all the code got moved into this 16133 ; seperate module. 16134 ; 16135 ; That being said, the original logic is largely kept, the bulk of the 16136 ; code being extra functionality. k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 Page 53 K20MAC MAC 30-Jun-23 17:21 History and Motivation 16137 16138 subttl Random Notes 16139 16140 ; Using a quoted strings allows an easy define of a name that is 16141 ; similar to an existing name by not selecting from the keyword table. 16142 ; 16143 ; Better, it allows for consistent use of escape recognition when 16144 ; specifying the SET commands. 16145 16146 .xcmsy ;[194] Ditch MACSYM junk 16147 16148 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:01.021 107P CORE USED k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 20:02 27-Nov-23 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 20:02 27-Nov-23 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 20:02 27-Nov-23 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 20:02 27-Nov-23 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 20:02 27-Nov-23 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 20:02 27-Nov-23 Page 1 K20IOC MAC 25-Nov-23 20:18 16149 Title K20IOC Kermit Input/Output statement Control 16150 16151 search monsym,macsym,cmd,k20unv ;[194] 16152 cmdacs ^ ; Clean up p1-p4 definitions 16153 cmdunv ^ ;[248] ; Externalize storage and constants 16154 16155 sall ; tidy listing, please 16156 .directive flblst ; We don't need to see all the ASCIZ bytes... 16157 16158 ;N.B., although this module is new with a large amount of rewrites, 16159 ; some attempt has been made to keep old edit numbers for cross- 16160 ; reference purposes. 16161 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 2 K20IOC MAC 25-Nov-23 20:18 External routines and storage 16162 subttl External routines and storage 16163 16164 remark common parsing external data 16165 16166 extern pars1 ; Data from first parse. 16167 extern pars2 ; Data from second parse. 16168 extern pars3 ; Data from third parse. 16169 extern pars4 ; Data from fourth parse. 16170 extern pars5 ;[41] ... 16171 extern pars6 ;[209] ; If $INPUT is not getting driven by .INPUT 16172 extern pars7 ;[229] ; If TRANSMIT is sending some kind of EOF 16173 extern pars8 ;[229] ; If $INPUT matching should not type anything 16174 extern buffer ; Used for foreign file names and string conversion 16175 16176 remark Linkages with the main and other parsers 16177 16178 extern chksec ; k20par: See if we got a silly floating point value 16179 extern definf ; k20mac: Set if we are defining a macro 16180 16181 remark Various JFN's and related control storage 16182 16183 extern netjfn ; Network JFN, if not a remote Kermit 16184 extern ttyjfn ; User's terminal JFN, if remote Kermit 16185 extern takjfn ; JFN of current TAKE file 16186 extern popjfn ; Routine to switch between takjfn's 16187 extern sesjfn ; JFN for session logging file 16188 extern sesflg ; Control flag for active usage of same 16189 extern filjfn ; Current open file 16190 extern cjfnbk ; COMND%'s GTJFN% block 16191 extern isnulj ; Determine if this JFN is on NUL: 16192 extern frclos ; Force a JFN to close (or release it) 16193 16194 remark Handshke, Parity and Duplex Handling 16195 16196 extern handsh ; Handshake character (if any) 16197 extern parity ; Points to whatever parity (routine) we're using 16198 extern duplex ; Who is doing the echoing remote host or us 16199 16200 remark User and Network terminal handling 16201 16202 extern chklin ; Check line (or NRT or PTY) status 16203 extern carier ; Line carrier (or good NRT or PTY JFN) 16204 extern doarpa ; Set up for network binary (if on a TVT) 16205 extern vtermf ; Virtual terminal flag (NRT, PTY, PIP eventually) 16206 extern ttyob ; Put local terminal in binary mode 16207 extern ttyou ; Put local terminal back in user mode 16208 extern dobits ; Set terminal line for transparent I/O 16209 extern unbits ; Undo effects of dobits 16210 16211 extern tvtflg ;[247] ; Whether doing binary on a TVT 16212 extern iaciac ;[247] ; Handle IAC doubling on a TVT in binary mode 16213 extern tvtbuf ;[247] ; Buffer where IAC doubling is done 16214 16215 remark Various performance counters for the interested 16216 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 2-1 K20IOC MAC 25-Nov-23 20:18 External routines and storage 16217 extern nbict ; Network BIN% count 16218 extern nsici ; Network SIN%'s count (total issued) 16219 extern nsimx ; Network SIN% maximum length 16220 extern nsitc ; Network SIN%'s total characters read 16221 16222 extern vsoct ; Virtual Terminal SOUTR%'s Issued 16223 extern vsotc ; Virtual Terminal SOUTR% Total Characters 16224 extern vsomx ; Virtual Terminal SOUTR% Maximum length 16225 16226 remark Terminal and TIMER% interrupt handling 16227 16228 extern ccon ; Turn ^C handling on 16229 extern ccoff2 ; FORCE ^C handling off 16230 extern cmpon ; Turn ^M and ^P handling on 16231 extern cmpoff ; Turn ^M and ^P handling off 16232 extern cmseen ; ^M seen 16233 extern cmloc ; Location transfer execution to on ^M 16234 extern cpseen ; ^P seen 16235 extern cploc ; Location transfer execution to on ^P 16236 repeat 0,< 16237 extern intpc ; PC to restore on timer interrupt. 16238 extern intstk ; Stack pointer to restore on timer interrupt. 16239 extern timchb ; TIMER% interrupt chanel bit 16240 > 16241 extern timeon ;[209] Set up a TIMER% 16242 extern timdel ;[209] Delete any pending TIMER%'s 16243 16244 remark Buffer and Strings 16245 16246 extern strc ; Counter for, and... 16247 extern strptr ; pointer into the... 16248 extern strbuf ; Gigantic string buffer (1,000 words!!) 16249 extern strbf2 ; Another one 16250 extern asczcp ;[248] ; Move a NUL terminated string and return its length 16251 16252 remark Networking Linkages and variables 16253 16254 extern clrest ;[209] Return estimate of available data 16255 extern clrbuf ;[209] Clear monitor buffers 16256 extern local ;[209] Non-zero if a local Kermit 16257 16258 remark Other random useful things 16259 16260 extern %%jser ; JSYS error handler (for %jserr macro) 16261 extern errptr ; Pointer to error text (for ermsg% macro) 16262 extern crlf ; byte (7) .chcrt, .chlfd, .chnul 16263 extern jobtab ; Result of GETJI%; used to determine batchness 16264 extern nul4 ; Negative counted pointer to "NUL:" 16265 16266 .psect code/ronly ; Pure code, pure heaven 16267 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 3 K20IOC MAC 25-Nov-23 20:18 SET INPUT command initial parsing 16268 subttl SET INPUT command initial parsing 16269 16270 000000'02 000000 000000 %table(sintab) 16271 000001'02 000000# 000000# %key3 , .sinca, incase 16272 000000'03 143 141 163 145 000 16273 000001'03 000000# 000000# 16274 000002'02 000000# 000000# %key3 , .sindt, indeft 16275 000002'03 144 145 146 141 165 16276 000006'03 000000# 000000# 16277 000003'02 000000# 000000# %key3 , .sinse, indefs ;[209] 16278 000007'03 163 145 141 162 143 16279 000012'03 000000# 000000# 16280 000004'02 000000# 000000# %key3 , .sinta, intima 16281 000013'03 164 151 155 145 157 16282 000016'03 000000# 000000# 16283 000000'02 000004 000004 %tbend 16284 16285 ; SET INPUT parsing, like SET SEND/RECEIVE -- an extra level of parsing. 16286 16287 chgsec(code,const) ;;FDB's go in const .psect 16288 000005'02 000000 000000 tinfdb: flddb. .cmkey,,sintab 16289 000006'02 000000 000000' 16290 retsec ;;Return to code .psect 16291 16292 000000'01 .setin: entry .setin ;[209] Invoked from k20par 16293 000000'01 201 01 0 00 000000# movei t1, tinfdb ;[209] 16294 000001'01 260 17 0 00 000000* call rfield ; Parse a keyword. 16295 000002'01 550 02 0 02 000000 hrrz t2, (t2) ; Get the command routine addresses. 16296 000003'01 202 02 0 00 000000* movem t2, pars3 ; Save into pars3. 16297 000004'01 554 01 0 02 000000 hlrz t1, (t2) ; Get the next level routine. 16298 000005'01 260 17 0 01 000000 call (t1) ; Call it. 16299 000006'01 263 17 0 00 000000 ret 16300 16301 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 4 K20IOC MAC 25-Nov-23 20:18 SET INPUT CASE parsing 16302 subttl SET INPUT CASE parsing 16303 16304 000007'02 000000 000000 %table(castab) ; Case table. 16305 000010'02 000000# 000000 %key2 , 0 16306 000017'03 151 147 156 157 162 16307 000011'02 000000# 000001 %key2 , 1 16308 000021'03 157 142 163 145 162 16309 000012'02 000000# 000001 %keyf3 , 1, cm%inv ;[212] Tom gets sleepy... 16310 000023'03 002000 000001 16311 000024'03 162 145 163 160 145 16312 000007'02 000003 000003 %tbend 16313 16314 chgsec(code,const) ;;FDB's go in const .psect 16315 000013'02 000000 000015' incfdb: flddb. .cmkey,,castab,,,incfd1 16316 000014'02 000000 000007' 16317 000015'02 010004 000000 incfd1: flddb. .cmcfm,,, 16318 000016'02 000000 000000 16319 000017'02 44 07 0 00 003535' 16320 retsec ;;Get back into code .psect 16321 cleans() ;;Clean out temporary symbols 16322 16323 000007'01 265 16 0 00 004003' .sinca: saveac ;[209] Need to remember function code 16324 000010'01 200 16 0 00 000000# guide ; SET INPUT CASE 16325 000011'01 260 17 0 00 000000* 16326 000020'02 000000000000# 16327 000000'04 146 157 162 040 155 16328 000012'01 201 01 0 00 000000# movei t1, incfdb 16329 000013'01 260 17 0 00 000001* call rfield ;[209] Parse a keyword or default 16330 16331 000014'01 135 05 0 00 004011' ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ;[209] Pick up function code 16332 000015'01 302 05 0 00 000010 caie q1, .cmcfm ;[209] Want's default? 16333 000016'01 254 00 0 00 000021' ifskp. ;[209] That's easy, give him the default 16334 000017'01 400 02 0 00 000000 setz t2, ;[209] This is the parse value for "ignore" 16335 000020'01 254 00 0 00 000022' else. ;[209] Otherwise, handle the keyword 16336 000021'01 550 02 0 02 000000 hrrz t2, (t2) ; Get the value for the keyword (0 or 1). 16337 000022'01 endif. ;[209] 16338 000022'01 202 02 0 00 000000* movem t2, pars4 ; Save into pars4. 16339 16340 000023'01 306 05 0 00 000010 cain q1, .cmcfm ;[209] Was default requested? 16341 000024'01 263 17 0 00 000000 ret ;[209] It was, so don't reconfirm a confirmation 16342 000025'01 336 00 0 00 000000* skipn definf ; In DEFINE? 16343 000026'01 260 17 0 00 000000* confrm ; No, get confirmation. 16344 000027'01 263 17 0 00 000000 ret 16345 16346 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 5 K20IOC MAC 25-Nov-23 20:18 SET INPUT DEFAULT-TIMEOUT parsing 16347 subttl SET INPUT DEFAULT-TIMEOUT parsing 16348 16349 ; N.B., When chksec succeeds, it succeeds completely, putting the 16350 ; calculated millisecond value in pars4 and the floating point 16351 ; seconds in pars5. Both are displayed by SHOW INPUT because the 16352 ; floating point is easier to read, the milliseconds perhaps being 16353 ; of interest to debuggers, mathematicians and the curious. 16354 16355 chgsec(code,const) ;;Chained FDB's go in const .psect 16356 000021'02 015004 000024' indfdb: flddb. .cmflt,,,,,indfd1 16357 000022'02 000000 000000 16358 000023'02 44 07 0 00 003544' 16359 000024'02 010004 000000 indfd1: flddb. .cmcfm,,,,, 16360 000025'02 000000 000000 16361 000026'02 44 07 0 00 003553' 16362 retsec ;;Get back into code .psect 16363 cleans() ;;Keep listing tidy 16364 16365 000030'01 265 16 0 00 004003' .sindt: saveac ;[209] Need to remember function code 16366 000031'01 200 16 0 00 000000# guide 16367 000032'01 260 17 0 00 000011* 16368 000027'02 000000000000# 16369 000003'04 146 157 162 040 111 16370 000033'01 201 01 0 00 000000# movei t1, indfdb ; Various alteratives 16371 000034'01 260 17 0 00 000013* call rfield ; Try to get one of them 16372 16373 000035'01 135 05 0 00 004011' ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ;[209] Pick up function code 16374 000036'01 302 05 0 00 000010 caie q1, .cmcfm ;[209] Want's default? 16375 000037'01 254 00 0 00 000042' ifskp. ;[209] That's easy, give him the default 16376 000040'01 205 02 0 00 204500 movx t2, <10.> ;[209] Ten seconds in floating point 16377 000041'01 254 00 0 00 000046' else. ;[209] Otherwise, better sanity check it 16378 000042'01 325 02 0 00 000046' ifl. t2 ;[209] Is the number deeply silly?? 16379 000043'01 200 01 0 00 000000# emsg ;[209] 16380 000044'01 104 00 0 00 000313 16381 000030'02 000000000000# 16382 000007'04 101 040 156 145 147 16383 000045'01 254 00 0 00 000000* jrst cmder1 ;[209] However, allow reparse 16384 000046'01 endif. ;[209] End non-default initial check 16385 000046'01 endif. ;[209] Either way, t2 has a floating point value 16386 16387 remark ;[212] When chksec works, it works completely 16388 000046'01 260 17 0 00 000000* call chksec ;[196] Ensure number is in correct range 16389 000047'01 254 00 0 00 000056' ifskp. ;[196] Check and convert OK? 16390 000050'01 306 05 0 00 000010 cain q1, .cmcfm ;[209] It did. Was default requested? 16391 000051'01 263 17 0 00 000000 ret ;[209] It was, so don't reconfirm a confirmation 16392 000052'01 336 00 0 00 000025* skipn definf ; In DEFINE? 16393 000053'01 260 17 0 00 000026* confrm ; No, get confirmation. 16394 000054'01 263 17 0 00 000000 ret ;[212] Either way, we're done 16395 000055'01 254 00 0 00 000061' else. ;[196] Otherwise, couldn't swallow something 16396 000056'01 200 01 0 00 000000# emsg ;[196] 16397 000057'01 104 00 0 00 000313 16398 000031'02 000000000000# 16399 000020'04 111 156 160 165 164 16400 000060'01 254 00 0 00 000045* jrst cmder1 ;[196] Allow reparse 16401 000061'01 endif. ;[196] End case checking and conversion K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 5-1 K20IOC MAC 25-Nov-23 20:18 SET INPUT DEFAULT-TIMEOUT parsing 16402 16403 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 6 K20IOC MAC 25-Nov-23 20:18 SET INPUT SEARCH-DEFAULT parsing 16404 subttl SET INPUT SEARCH-DEFAULT parsing 16405 16406 ;[209] Begin code insertion 16407 16408 ; Calls the string parsing portion (.INPU1) to get the string and 16409 ; build the appropriate storage. Then hijacks the rest of the parse 16410 ; to get our semantic action routine called instead of having a value 16411 ; be set. 16412 ; 16413 ; Because of the design of the main parser to allow macro definitions 16414 ; and to be compliant with that paradigm, this involves an extra level 16415 ; of indirection, as seen below 16416 16417 000061'01 000000 000067' $sinsi: $sinse ; Indirect call 16418 16419 000062'01 260 17 0 00 000211' .sinse: call .inpu1 ; Parse just as if it were typed to INPUT 16420 000063'01 510 01 1 00 000000* hllz t1, @pars2 ; Load invoking keyword (SET INPUT) 16421 000064'01 541 01 0 00 000061' hrri t1, $sinsi ; Load indirected address of our semantic action 16422 000065'01 202 01 0 00 000063* movem t1, pars2 ; and take over the rest of the parse 16423 000066'01 263 17 0 00 000000 ret ; Return below 16424 16425 000067'01 265 16 0 00 004012' $sinse: saveac ; Needs some registers 16426 000070'01 333 05 0 00 000000* skiple q1, strc ; Did it get any characters? 16427 000071'01 254 00 0 00 000074' ifskp. ; No, so go with old reliable 16428 000072'01 402 00 0 00 000000# setzm indefw ; Flag no default (nothing for xblt.) 16429 000073'01 263 17 0 00 000000 ret ; Done 16430 000074'01 endif. 16431 16432 000074'01 200 02 0 00 000005 move t2, q1 ; Load character count 16433 000075'01 400 01 0 00 000000 setz t1, ; Cast positive word to signed long 16434 000076'01 235 01 0 00 000005 divi t1, ^d5 ; Convert to word count, five characters per word 16435 000077'01 322 02 0 00 000102' ifn. t2 ; Any remainder? 16436 000100'01 350 06 0 00 000001 aos q2, t1 ; Round up a word and store 16437 000101'01 254 00 0 00 000103' else. ; Otherwise, it fit exactly 16438 000102'01 200 06 0 00 000001 move q2, t1 ; So no need to round 16439 000103'01 endif. 16440 16441 remark t1, ; Still has word count 16442 000103'01 550 02 0 00 000000* hrrz t2, strptr ; Load whatever address the string pointer points to 16443 000104'01 201 03 0 00 000000# movei t3, indefs ; And storing it in our defaulting buffer 16444 000105'01 123 01 0 00 004022' xblt. t1 ; Tuck away for when needed 16445 16446 000106'01 124 05 0 00 000000# dmovem q1, indefc ; Store character and word count 16447 000107'01 263 17 0 00 000000 ret ; Finally done 16448 16449 ;[209] End code insertion 16450 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 7 K20IOC MAC 25-Nov-23 20:18 SET INPUT TIMEOUT-ACTION parsing 16451 subttl SET INPUT TIMEOUT-ACTION parsing 16452 16453 000032'02 000000 000000 %table(itatab) ; INPUT timeout action table 16454 000033'02 000000# 000000 %keyf3 , 0, cm%inv ;[186] Tom gets sleepy... 16455 000026'03 002000 000001 16456 000027'03 143 157 156 164 151 16457 000034'02 000000# 000000 %key2 , 0 16458 000031'03 160 162 157 143 145 16459 000035'02 000000# 000001 %key2 , 1 16460 000033'03 161 165 151 164 000 16461 000036'02 000000# 000001 %keyf3 , 1, cm%inv ;[186] Tom gets sleepy... 16462 000034'03 002000 000001 16463 000035'03 163 164 157 160 000 16464 000032'02 000004 000004 %tbend 16465 16466 chgsec(code,const) ;;FDB's go in const psect 16467 000037'02 000000 000041' intfdb: flddb. .cmkey,,itatab,,,intfd1 16468 000040'02 000000 000032' 16469 000041'02 010004 000000 intfd1: flddb. .cmcfm,,,,, 16470 000042'02 000000 000000 16471 000043'02 44 07 0 00 003563' 16472 retsec 16473 cleans() 16474 16475 000110'01 265 16 0 00 004003' .sinta: saveac ;[209] Need to remember function code 16476 000111'01 200 16 0 00 000000# guide 16477 000112'01 260 17 0 00 000032* 16478 000044'02 000000000000# 16479 000027'04 146 157 162 040 143 16480 000113'01 201 01 0 00 000000# movei t1, intfdb ;[209] Load parse fdb address 16481 000114'01 260 17 0 00 000034* call rfield ;[209] And see what he wants 16482 16483 000115'01 135 05 0 00 004011' ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ;[209] Pick up function code 16484 000116'01 302 05 0 00 000010 caie q1, .cmcfm ;[209] Want's default? 16485 000117'01 254 00 0 00 000122' ifskp. ;[209] That's easy, give him the default 16486 000120'01 400 02 0 00 000000 setz t2, ;[209] This is the parse value for "proceed" 16487 000121'01 254 00 0 00 000123' else. ;[209] Otherwise, handle the keyword 16488 000122'01 550 02 0 02 000000 hrrz t2, (t2) ; Get the value for the keyword (0 or 1). 16489 000123'01 endif. ;[209] Either way, have something in t2 16490 16491 000123'01 202 02 0 00 000022* movem t2, pars4 ; Save into pars4. 16492 16493 000124'01 306 05 0 00 000010 cain q1, .cmcfm ;[209] Was default requested? 16494 000125'01 263 17 0 00 000000 ret ;[209] It was, so don't reconfirm a confirmation 16495 000126'01 336 00 0 00 000052* skipn definf ; In DEFINE? 16496 000127'01 260 17 0 00 000053* confrm ; No, get confirmation. 16497 000130'01 263 17 0 00 000000 ret 16498 16499 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 8 K20IOC MAC 25-Nov-23 20:18 INPUT command parsing 16500 subttl INPUT command parsing 16501 16502 ; The previous approach relied on defaulting a value to skip a field 16503 ; which limited the operation of question mark and escape recognition. 16504 ; The parsing logic now offers to directly go to textual input so that 16505 ; this option shows up in the question mark menu. 16506 ; 16507 ; It makes either learning the command or being reminded about it a 16508 ; more pleasing if not easier experience. It also cuts COMND% 16509 ; overhead down by a JSYS, which is probably not detectable in all but 16510 ; the most extreme of circumstances. 16511 ; 16512 ; This all works because we don't need to default the parse to know 16513 ; what the default values are. 16514 ; 16515 ; INPUT and OUTPUT were all revisited because making Kermit Batch 16516 ; compliant forced far greater usage for testing purposes. 16517 16518 remark Switch values for INPUT and TRANSMIT 16519 16520 000000 %eofsw==0 ;[229] We parsed the EOF switch 16521 000001 %silsw==1 ;[229] We parsed the 'silent' switch 16522 000002 %timsw==2 ;[229] We parsed the 'timeout' switch 16523 16524 ;[229] %table puts stuff in the correct .psect 16525 16526 000045'02 000000 000000 %table (inpswi) ;[229] The INPUT switch table 16527 000046'02 000000# 000001 %key2 , %silsw ;[229] Tells $input to shut up about matches 16528 000036'03 163 151 154 145 156 16529 000045'02 000001 000001 %tbend ;[229] End of table 16530 16531 chgsec(code,const) ;;Chained FDB's go in const 16532 000047'02 003000 000051' inpswf: flddb. .cmswi,,inpswi,,,inpfdb 16533 000050'02 000000 000045' 16534 000051'02 015004 000054' inpfdb: flddb. .cmflt,,^d10,,,txtfdb 16535 000052'02 000000 000012 16536 000053'02 44 07 0 00 003573' 16537 000054'02 010004 000057' txtfdb: flddb. .cmcfm,,,,,txtfd1 16538 000055'02 000000 000000 16539 000056'02 44 07 0 00 003603' 16540 000057'02 021004 000062' txtfd1: flddb. .cmqst,,,,,txtfd2 16541 000060'02 000000 000000 16542 000061'02 44 07 0 00 003611' 16543 000062'02 017004 000000 txtfd2: flddb. .cmtxt,,,,, 16544 000063'02 000000 000000 16545 000064'02 44 07 0 00 003621' 16546 retsec ;;Return to code .psect 16547 cleans() ;;Clean up the symbol table 16548 16549 000131'01 .input: entry .input ; Invoked from K20PAR 16550 000131'01 265 16 0 00 004003' saveac ;[212] Used for control flow 16551 remark buffer ;[209] Preserve buffer across calls!!! 16552 16553 000132'01 200 16 0 00 000000# guide 16554 000133'01 260 17 0 00 000112* K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 8-1 K20IOC MAC 25-Nov-23 20:18 INPUT command parsing 16555 000065'02 000000000000# 16556 000033'04 164 151 155 145 157 16557 16558 000134'01 403 01 0 00 000002 .inpu0: setzb t1, t2 ;[209] Cons up some .chnuls 16559 000135'01 124 01 0 00 000000* dmovem t1, atmbuf ;[209] Give the atom buffer a good scrub a dub 16560 000136'01 201 01 0 00 000000# movei t1, inpswf ;[212] Pointer to full menu 16561 000137'01 260 17 0 00 000114* call rfield ;[190] Finally parse something 16562 000140'01 135 05 0 00 004011' ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ;[212] Get function code. 16563 16564 000141'01 302 05 0 00 000003 caie q1, .cmswi ;[229] Did we get a switch? 16565 000142'01 254 00 0 00 000162' ifskp. ;[229] We did, handle it 16566 000143'01 415 16 0 00 000154' block. ;[229] Enter block for better control flow 16567 000144'01 261 17 0 00 000016 16568 000145'01 550 07 0 02 000000 hrrz q3, (t2) ;[229] Pick up the switch value 16569 000146'01 302 07 0 00 000001 caie q3, %silsw ;[229] Parsed the 'silent' switch? 16570 000147'01 254 00 0 00 000152' ifskp. ;[229] We did, so that should be easy enough 16571 000150'01 476 00 0 00 000000* setom pars8 ;[229] Just flag it in the parse block 16572 000151'01 254 00 0 00 000000* retskp ;[229] Return for next switch 16573 000152'01 endif. ;[229] End 'silent' switch case 16574 000152'01 263 17 0 00 000000 ret ;[229] Otherwise, some kind of bogus switch 16575 000153'01 263 17 0 00 000000 endbk. ;[229] End Block context 16576 000154'01 254 00 0 00 000157' ifskp. ;[229] Successful switch parse 16577 000155'01 254 00 0 00 000134' jrst .inpu0 ;[229] Go see if more switches (or device or file) 16578 000156'01 254 00 0 00 000162' else. ;[229] Otherwise, some kind of error 16579 000157'01 200 01 0 00 000000# emsg ;[229] This is an internal programming error 16580 000160'01 104 00 0 00 000313 16581 000066'02 000000000000# 16582 000035'04 125 156 153 156 157 16583 000161'01 254 00 0 00 000060* jrst cmder1 ;[229] However, allow reparse 16584 000162'01 endif. ;[229] End of switch block processing 16585 000162'01 endif. ;[229] End of .cmswi case 16586 16587 000162'01 302 05 0 00 000010 caie q1, .cmcfm ;[209] Confirmation? 16588 000163'01 254 00 0 00 000167' ifskp. ;[209] Yes, let's default everything 16589 000164'01 120 01 0 00 000000# dmove t1, indeft ;[209] Load default millisecond and floating values 16590 000165'01 124 01 0 00 000123* dmovem t1, pars4 ;[209] Store them as if they were parsed 16591 000166'01 254 00 0 00 000220' jrst .inpu2 ;[209] Go handle it as if we parsed this as a string 16592 000167'01 endif. ;[209] Either way, must 'recompile' the search 16593 16594 000167'01 302 05 0 00 000015 caie q1, .cmflt ;[212] Parsed a floating number? 16595 000170'01 254 00 0 00 000206' ifskp. ;[212] Yes, check it 16596 000171'01 325 02 0 00 000176' ifl. t2 ;[212] Is the number in the right range? 16597 000172'01 200 01 0 00 000000# emsg ;[212] Yah silly!! 16598 000173'01 104 00 0 00 000313 16599 000067'02 000000000000# 16600 000042'04 101 040 156 145 147 16601 000174'01 254 00 0 00 000161* jrst cmder1 ;[212] Allow reparse 16602 000175'01 254 00 0 00 000205' else. 16603 000176'01 260 17 0 00 000046* call chksec ;[212] Ensure number is in correct range 16604 000177'01 254 00 0 00 000202' ifskp. ;[212] Check and convert OK? Then side-effect variables 16605 000200'01 254 00 0 00 000211' jrst .inpu1 ;[212] Yes, then carry on to parse a string to find 16606 000201'01 254 00 0 00 000205' else. ;[212] Otherwise, couldn't swallow something 16607 000202'01 200 01 0 00 000000# emsg ;[212] 16608 000203'01 104 00 0 00 000313 16609 000070'02 000000000000# K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 8-2 K20IOC MAC 25-Nov-23 20:18 INPUT command parsing 16610 000052'04 111 156 160 165 164 16611 000204'01 254 00 0 00 000174* jrst cmder1 ;[212] Allow reparse 16612 000205'01 endif. ;[212] End case checking and conversion 16613 000205'01 endif. ;[212] End case special messaging check 16614 remark ;[212] Falls out to parse txtfdb 16615 000205'01 254 00 0 00 000211' else. ;[212] Else never got a number 16616 000206'01 120 01 0 00 000000# dmove t1, indeft ;[212] Load default millisecond and floating values 16617 000207'01 124 01 0 00 000165* dmovem t1, pars4 ;[212] Store them as if they were parsed 16618 000210'01 254 00 0 00 000220' jrst .inpu2 ;[212] Go handle the string we parsed 16619 000211'01 endif. ;[212] End case parsed a floating nuber (or not) 16620 16621 ;[208] Originally shut off indirection, but since quoted strings allow us 16622 ; to put in an at-sign (@) as well as escape sequences, this was 16623 ; removed to allow backward compatibility with any take files which 16624 ; rely on this. 16625 16626 000211'01 200 16 0 00 000000# .inpu1: guide ;[190] Guide us to type the next thing 16627 000212'01 260 17 0 00 000133* 16628 000071'02 000000000000# 16629 000061'04 163 164 162 151 156 16630 000213'01 403 01 0 00 000002 setzb t1, t2 ;[209] Cons up some .chnuls 16631 000214'01 124 01 0 00 000135* dmovem t1, atmbuf ;[209] Give the atom buffer a good scrub a dub 16632 000215'01 201 01 0 00 000000# movei t1, txtfdb ;[209] Parse some kind of input text 16633 000216'01 260 17 0 00 000137* call rfield ;[209] Get an input string 16634 000217'01 135 05 0 00 004011' ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ;[212] Get function code again 16635 16636 000220'01 .inpu2: remark ;[209] Here if .cmcfm was only thing typed 16637 000220'01 302 05 0 00 000010 caie q1, .cmcfm ;[209] Confirmation? 16638 000221'01 254 00 0 00 000232' ifskp. ;[209] Yes, let's default the search 16639 000222'01 333 01 0 00 000000# skiple t1, indefw ;[209] But!! Do we have a default string? 16640 000223'01 254 00 0 00 000227' ifskp. ;[209] No, so use wired default 16641 000224'01 205 01 0 00 064240 movx t1, < byte (7) .chcrt, .chlfd > ;[209] Which fits in 18 bits 16642 000225'01 202 01 0 00 000214* movem t1, atmbuf ;[209] Store NUL terminated bare CR-LF sequence 16643 000226'01 254 00 0 00 000231' else. ;[209] Otherwise, have a default, so drop that in 16644 dmove t2, [ indefs ;[209] Load address of default expanded string 16645 000227'01 120 02 0 00 004023' atmbuf] ;[209] Load address of match string buffer 16646 000230'01 123 01 0 00 004022' xblt. t1 ;[209] Stomp into place 16647 000231'01 endif. ;[209] End case hardwired default 16648 000231'01 202 05 0 00 000003* movem q1, pars3 ;[209] Let any caller know what we're doing 16649 000232'01 endif. ;[209] Continue with atom buffer properly conditioned 16650 16651 000232'01 403 01 0 00 000002 setzb t1, t2 ;[209] Cons up some NUL's 16652 000233'01 124 01 0 00 000000* dmovem t1, strbuf ;[209] Get string match buffer into a known state 16653 000234'01 200 02 0 00 004025' move t2,[point 7,atmbuf] ;[209] Let's see what's in the atom buffer 16654 000235'01 134 01 0 00 000002 ildb t1, t2 ;[209] Get the first byte 16655 000236'01 322 01 0 00 000244' ifn. t1 ;[209] Only if not .CHNUL 16656 000237'01 260 17 0 00 001236' call bsrchs ;[209] Build a search string from it 16657 000240'01 254 00 0 00 000204* jrst cmder1 ;[209] Failed, allow reparse 16658 000241'01 336 00 0 00 000233* skipn strbuf ;[209] Did anything go in there?? 16659 000242'01 254 00 0 00 000244' anskp. ;[209] Nope, maybe was a "\0" or some such 16660 000243'01 254 00 0 00 000245' else. ;[209] Otherwise, some bad thing 16661 000244'01 402 00 0 00 000070* setzm strc ;[209] We surely have no characters to match 16662 000245'01 endif. ;[209] Otherwise, not searching (sigh) 16663 000245'01 402 00 0 00 000000* setzm pars6 ;[209] Say we're handling the control-C 16664 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 20:02 27-Nov-23 Page 8-3 K20IOC MAC 25-Nov-23 20:18 INPUT command parsing 16665 000247'01 254 00 0 00 000253' ifskp. ;[209] Don't reconfirm, that's confusing 16666 000250'01 332 00 0 00 000126* skipe definf ;[209] BUT!! Are we defining a macro? 16667 000251'01 254 00 0 00 000253' anskp. ;[209] We are, let .define confirm for us 16668 000252'01 260 17 0 00 000127* confrm ;[209] Tie off the line 16669 000253'01 endif. ;[209] 16670 000253'01 263 17 0 00 000000 ret 16671 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 9 K20IOC MAC 25-Nov-23 20:18 INPUT command semantic action 16672 subttl INPUT command semantic action 16673 16674 ;N.B., Note the reordering of the timing JSYi in the routine. The 16675 ; purpose is to prevent us from getting caught with some stray 16676 ; TIMER% interrupt. So we clear timers BEFORE activating the timer 16677 ; channel and disable the channel BEFORE clearing any timers. 16678 16679 000254'01 $input: entry $input ;[194] 16680 16681 000254'01 337 02 0 00 000207* skipg t2, pars4 ;[212] Integer milliseconds 16682 000255'01 254 00 0 00 000262' ifskp. ;[212] Wants time outs, so set them 16683 000256'01 332 00 0 00 000245* skipe pars6 ;[229] Did we already do this? 16684 000257'01 254 00 0 00 000262' anskp. ;[229] Yes, so don't stomp TRANSMIT 16685 000260'01 201 01 0 00 000543' movei t1, looptm ;[209] Go to loop time out exit 16686 000261'01 260 17 0 00 000000* call timeon ;[209] Set the timer for it 16687 000262'01 endif. ;[212] 16688 16689 ; Condition line, set up Control-C trap 16690 16691 000262'01 332 00 0 00 000256* $inp4a: ifme. pars6 ;[209] Are we handling the ^C? 16692 000263'01 254 00 0 00 000266' 16693 000264'01 260 17 0 00 000000* call ccon ; Turn on ^C trap. 16694 000265'01 254 00 0 00 000410' jrst $inpuy ; If ^C typed, go to this place. 16695 000266'01 endif. ;[209] End case possible ^C override 16696 000266'01 332 00 0 00 000000* ifme. vtermf ;[194] Calls only make sense for terminals 16697 000267'01 254 00 0 00 000276' 16698 000270'01 332 00 0 00 000262* skipe pars6 ;[209] Is somebody else doing this? 16699 000271'01 254 00 0 00 000277' jrst $inpu5 ;[209] Yes, so leave the terminal alone 16700 000272'01 260 17 0 00 000000* call dobits ; Condition the line for i/o. 16701 000273'01 263 17 0 00 000000 ret ; Pass along any failure. 16702 000274'01 260 17 0 00 000000* call ttyob ; Put TTY in binary mode for output only. 16703 remark ;[209] Fall through to legacy code 16704 000275'01 254 00 0 00 000277' else. ;[209] Otherwise, use enhanced network I/O 16705 000276'01 254 00 0 00 000432' callret netins ;[209] Dispatch to Network Input Matcher 16706 000277'01 endif. ;[186] Otherwise, MTOPR%'s will blow up 16707 16708 000277'01 200 04 0 00 004026' $inpu5: move t4, [point 7, strbuf] ; Point to the search string. 16709 16710 000300'01 336 00 0 00 000244* $inpu6: skipn strc ; Is there a search string? 16711 000301'01 254 00 0 00 000304' jrst $inpu7 ; No, just go forever. 16712 000302'01 134 03 0 00 000004 ildb t3, t4 ; Get a character from search string. 16713 000303'01 322 03 0 00 000411' jumpe t3, $inpux ; If no more, then success. 16714 ;... K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 10 K20IOC MAC 25-Nov-23 20:18 INPUT command semantic action 16715 16716 ;...$INPUT, cont'd 16717 16718 ; Get & echo a character, compare with current position in search string. 16719 16720 ;[204] Maybe rethink this BIN% loop, it's got a high JSYS overhead 16721 ; In other words, when should we call netins? 16722 16723 000304'01 337 01 0 00 000000* $inpu7: skipg t1, netjfn ;[186] Now get a character from the line. 16724 000305'01 200 01 0 00 000000* move t1, ttyjfn ;[186] Not network, using local 16725 000306'01 400 02 0 00 000000 setz t2, 16726 000307'01 104 00 0 00 000050 BIN 16727 000310'01 320 12 0 00 000312' ifje. r ;[186] Failed?? 16728 000311'01 254 00 0 00 000321' 16729 000312'01 302 01 0 00 600220 caie t1, IOX4 ;[186] Unexpected end of file? 16730 000313'01 334 00 0 00 000000 %ermsg (,$inpux) ;[186] Something else, so just drop dead 16731 000314'01 254 00 0 00 000320' 16732 000315'01 265 01 0 00 000000* 16733 000316'01 000000 000000 16734 000317'01 254 00 0 00 000411' 16735 000320'01 254 00 0 00 000345' jrst $inpu9 ;[186] Handle like a time out 16736 000321'01 endif. ;[186] 16737 000321'01 405 02 0 00 000177 andi t2, ^o177 ; Strip any parity. 16738 000322'01 332 00 0 00 000150* ifme. pars8 ;[229] Only if not /SILENT 16739 000323'01 254 00 0 00 000326' 16740 000324'01 200 01 0 00 000002 move t1, t2 ; Echo the character. 16741 000325'01 104 00 0 00 000074 PBOUT 16742 000326'01 endif. ;[229] 16743 16744 000326'01 337 01 0 00 000000* skipg t1, sesjfn ;[195] Session logging? 16745 000327'01 254 00 0 00 000334' ifskp. ;[195] Some kind of JFN 16746 000330'01 336 00 0 00 000000* skipn sesflg ;[195] Is logging active? 16747 000331'01 254 00 0 00 000334' anskp. ;[195] No, so don't log it 16748 000332'01 104 00 0 00 000051 BOUT ; Yes, record the character in the log. 16749 000333'01 320 12 0 00 000334' erjmpr .+1 ;[195] Catch and ignore error 16750 000334'01 endif. ;[195] 16751 16752 000334'01 332 00 0 00 000000# ifme. incase ;[194] Case-INsensitive compare? 16753 000335'01 254 00 0 00 000342' 16754 000336'01 301 02 0 00 000141 cail t2, "a" ; No, is this a lower case letter? 16755 000337'01 303 02 0 00 000172 caile t2, "z" 16756 000340'01 254 00 0 00 000342' anskp. ;[194] Not lower case 16757 000341'01 620 02 0 00 000040 txz t2, 40 ; Yes, convert to upper. 16758 000342'01 endif. ;[194] 16759 16760 000342'01 316 02 0 00 000003 camn t2, t3 ; Compare OK? 16761 000343'01 254 00 0 00 000300' jrst $inpu6 ; Yes, get next from string and comm line. 16762 000344'01 254 00 0 00 000277' jrst $inpu5 ; No, rewind search string, get next from line. 16763 16764 ; Come here upon input timeout. 16765 16766 000345'01 332 00 0 00 000000# $inpu9: ifme. intima ;[187] Proceeding? 16767 000346'01 254 00 0 00 000353' 16768 txmsg < 16769 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 20:02 27-Nov-23 Page 10-1 K20IOC MAC 25-Nov-23 20:18 INPUT command semantic action 16770 000350'01 104 00 0 00 000076 16771 000351'01 320 12 0 00 000352' 16772 000072'02 000000000000# 16773 000065'04 015 012 045 113 105 16774 000352'01 254 00 0 00 000355' else. ;[187] Otherwise an error, so not proceeding 16775 000353'01 200 01 0 00 000000# emsg ;[187] ;" 16776 000354'01 104 00 0 00 000313 16777 000073'02 000000000000# 16778 000076'04 113 105 122 115 111 16779 000355'01 endif. ;[187] Error message if quitting (for batch) 16780 16781 000355'01 561 01 0 00 000241* hrroi t1, strbuf ; Tell what string we couldn't find. 16782 000356'01 104 00 0 00 000076 PSOUT 16783 16784 000357'01 332 00 0 00 000000# ifme. intima ;[187] Proceeding? 16785 000360'01 254 00 0 00 000365' 16786 txmsg <", proceeding... 16787 000361'01 200 01 0 00 000000# > ;" ;[187] Say what we're doing, proceeding 16788 000362'01 104 00 0 00 000076 16789 000363'01 320 12 0 00 000364' 16790 000074'02 000000000000# 16791 000107'04 042 054 040 160 162 16792 16793 000364'01 254 00 0 00 000411' jrst $inpux ; Proceeding, just exit from the INPUT command. 16794 000365'01 endif. ;[187] 16795 16796 remark ;[187] Otherwise, not going any further 16797 000365'01 200 01 0 00 000000# txmsg <", quitting > ;" ;[187] ... quitting. 16798 000366'01 104 00 0 00 000076 16799 000367'01 320 12 0 00 000370' 16800 000075'02 000000000000# 16801 000113'04 042 054 040 161 165 16802 16803 000370'01 337 02 0 00 000000* skipg t2, takjfn ;[209] Quitting, are we in a file? 16804 000371'01 254 00 0 00 000406' ifskp. ;[209] We are, so blat and close it 16805 000372'01 201 01 0 00 000101 movei t1, .priou ;[209] No matter what, all output to terminal 16806 000373'01 621 02 0 00 777777 tlz t2, -1 ;[209] Shut off any GTJFN% flags 16807 000374'01 302 02 0 00 377777 caie t2, .nulio ;[209] Just testing? 16808 000375'01 254 00 0 00 000403' ifskp. ;[209] Yes, so special case that 16809 000376'01 120 02 0 00 000000* dmove t2, nul4 ;[209] Load counted special string 16810 000377'01 400 04 0 00 000000 setz t4, ;[209] Just in case 16811 000400'01 104 00 0 00 000053 SOUT% ;[209] Write the NUL: device name 16812 000401'01 320 12 0 00 000402' erjmpr .+1 ;[209] Catch and quietly ignore error 16813 000402'01 254 00 0 00 000406' else. ;[209] Otherwise, a bona fide JFN 16814 000403'01 403 03 0 00 000004 setzb t3, t4 ;[209] No flags and no prefix (whatever that is) 16815 000404'01 104 00 0 00 000030 JFNS% ;[209] Type the actual file name 16816 000405'01 320 12 0 00 000406' erjmpr .+1 ;[209] Catch and quietly ignore error 16817 000406'01 endif. ;[209] End typing some kind of file name 16818 000406'01 endif. 16819 16820 000406'01 561 01 0 00 000000* hrroi t1,crlf ;[209] Tie off the line 16821 000407'01 104 00 0 00 000076 PSOUT% 16822 16823 000410'01 260 17 0 00 000000* $inpuy: call popjfn ; Pop the TAKE file JFN from the TAKE stack. 16824 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 10-2 K20IOC MAC 25-Nov-23 20:18 INPUT command semantic action 16825 ; Exit thru here, turning off timer, restore line to previous condition. 16826 16827 000411'01 332 00 0 00 000270* $inpux: ifme. pars6 ;[209] Am I handling the ^C? 16828 000412'01 254 00 0 00 000420' 16829 000413'01 260 17 0 00 000000* call ccoff2 ; Turn off ^C trap. 16830 000414'01 332 00 0 00 000266* ifme. vtermf ;[186] Calls only make sense if not virtual 16831 000415'01 254 00 0 00 000420' 16832 000416'01 260 17 0 00 000000* call unbits ; Restore the line 16833 000417'01 260 17 0 00 000000* call ttyou ; Restore controlling tty output. 16834 000420'01 endif. ;[186] Otherwise, MTOPR%'s will break 16835 000420'01 endif. ;[209] End case possible ^C override 16836 16837 000420'01 337 00 0 00 000254* skipg pars4 ;[212] Integer millisecond sleep? 16838 000421'01 254 00 0 00 000423' ifskp. ;[212] Yes, shut off the timers, etc 16839 000422'01 260 17 0 00 000000* call timdel ;[209] Whack any future timers 16840 000423'01 endif. ;[212] End case positive intervale 16841 16842 000423'01 332 00 0 00 000411* skipe pars6 ;[209] Repeated internal call from $TRANS? 16843 000424'01 263 17 0 00 000000 ret ;[209] We're done 16844 16845 000425'01 $inpcl: remark ;[209] Have to clean up post $input 16846 000425'01 403 01 0 00 000002 setzb t1, t2 ;[209] Cons up a double word of zeros 16847 000426'01 124 01 0 00 000300* dmovem t1, strc ;[209] No string, so no length 16848 remark strptr ;[209] Not pointing anywhere 16849 000427'01 124 01 0 00 000355* dmovem t1, strbuf ;[209] Stomp a bit of the search buffer and 16850 000430'01 124 01 0 00 000000* dmovem t1, strbf2 ;[209] also a bit of the translation buffer 16851 remark buffer ;[209] Preserve buffer across calls 16852 16853 000431'01 263 17 0 00 000000 ret 16854 16855 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 11 K20IOC MAC 25-Nov-23 20:18 Network Input Searcher 16856 subttl Network Input Searcher 16857 16858 ;[209] Begin Code Addition 16859 16860 ; Expects bsrchs to have been called for a search structure 16861 ; inpcnt and inpptr to have been kept up to date from last call 16862 16863 000432'01 265 16 0 00 004027' netins: saveac 16864 16865 000433'01 120 05 0 00 000000# dmove q1, inpcnt ; Load current place in input buffer 16866 000434'01 337 07 0 00 000304* skipg q3, netjfn ; Assume network (which can be a physical line) 16867 000435'01 200 07 0 00 000305* move q3, ttyjfn ; Not network, so using login terminal 16868 000436'01 621 07 0 00 777777 tlz q3, -1 ; Either way, no flags 16869 16870 000437'01 do. ; Enter loop context 16871 000437'01 305 05 0 00 005000 caige q1, strblc ; First of all, can we swallow anything else? 16872 000440'01 254 00 0 00 000451' ifskp. ; Nope, try to drain a little off 16873 000441'01 307 05 0 00 000000 caig q1,0 ; BUT!! Nothing read? 16874 000442'01 254 00 0 00 000451' anskp. ; Then go read something 16875 000443'01 200 10 0 00 000005 move q4, q1 ; Save current length 16876 000444'01 260 17 0 00 000563' call matchs ; See if we can match anything 16877 000445'01 334 00 0 00 000000 skipa ; Didn't... 16878 000446'01 254 00 0 00 000537' exit. ; Did!!!!! 16879 000447'01 301 05 0 00 000010 cail q1, q4 ; Was this helpful in any way? 16880 000450'01 254 00 0 00 000545' jrst loopov ; No, we're wedged and can't go any futher.. 16881 000451'01 endif. 16882 000451'01 415 16 0 00 000462' block. ; Kind of clunky, but needed for control flow 16883 000452'01 261 17 0 00 000016 16884 000453'01 do. ; Enter inner loop 16885 000453'01 322 05 0 00 000000* jumpe q1, R ; If nothing read, break out 16886 000454'01 315 05 0 00 000426* camge q1, strc ; Do we have enough to match? 16887 000455'01 263 17 0 00 000000 ret ; No, then get out of loop and block context 16888 000456'01 260 17 0 00 000563' call matchs ; See if we can match anything 16889 000457'01 254 00 0 00 000453' loop. ; Nope, see if we can try again 16890 000460'01 254 00 0 00 000151* retskp ; We did, so pass that on 16891 000461'01 enddo. ; Exit loop lexical context 16892 000461'01 263 17 0 00 000000 endbk. ; Exit Block Context 16893 000462'01 254 00 0 00 000464' ifskp. ; Handle +2 from inner loop 16894 000463'01 254 00 0 00 000537' exit. ; Exit out main loop success!! 16895 000464'01 endif. 16896 000464'01 200 01 0 00 000007 move t1, q3 ; Load JFN to read from 16897 000465'01 104 00 0 00 000050 BIN% ; Wait for something from somebody 16898 000466'01 320 12 0 00 000470' %jserr (,loopio) ;[186] No, die. 16899 000467'01 254 00 0 00 000473' 16900 000470'01 265 01 0 00 000315* 16901 000471'01 000000000000# 16902 000472'01 254 00 0 00 000541' 16903 000116'04 103 157 165 154 144 16904 000473'01 350 00 0 00 000000* aos nbict ;[204] Count a network BIN% 16905 000474'01 271 05 0 00 000001 addi q1, ^d1 ; Count a character to do 16906 000475'01 136 02 0 00 000006 idpb t2, q2 ; Drop into the output buffer 16907 000476'01 260 17 0 00 000000* call clrest ; Find out how much, if anything, remains 16908 000477'01 254 00 0 00 000541' jrst loopio ; Already complained, so break loop context 16909 000500'01 201 03 0 00 005000 movei t3, strblc ; Load maximum buffer length 16910 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 20:02 27-Nov-23 Page 11-1 K20IOC MAC 25-Nov-23 20:18 Network Input Searcher 16911 000502'01 274 03 0 00 000001 sub t3, t1 ; Next, subtract how much we could use 16912 000503'01 305 03 0 00 000000 caige t3, 0 ; Not enough buffer space? 16913 000504'01 270 01 0 00 000003 add t1, t3 ; 'Subtract' off the excess (add negative) 16914 000505'01 323 01 0 00 000532' ifg. t1 ; OK, is there anything for us to read? 16915 000506'01 270 05 0 00 000001 add q1, t1 ; Accumulate in total 16916 000507'01 313 01 0 00 000000* camle t1, nsimx ; Smaller than biggest? 16917 000510'01 202 01 0 00 000507* movem t1, nsimx ; Nope, we have a new winner 16918 000511'01 272 01 0 00 000000* addm t1, nsitc ; Update Network SIN% total characters read 16919 000512'01 350 00 0 00 000000* aos nsici ; Update Network SIN%'s Issued 16920 000513'01 210 03 0 00 000001 movn t3, t1 ; Load exact amount to read 16921 000514'01 200 01 0 00 000007 move t1, q3 ; Reload the JFN 16922 000515'01 200 02 0 00 000006 move t2, q2 ; Keep reading into the buffer 16923 000516'01 104 00 0 00 000052 SIN% ; Get that data! 16924 000517'01 320 12 0 00 000521' ifje. r ; Failed?? 16925 000520'01 254 00 0 00 000531' 16926 000521'01 200 06 0 00 000002 move q2, t2 ; Update what we did read 16927 000522'01 270 05 0 00 000003 add q1, t3 ; 'Subtract' from used (t3 is negative) 16928 000523'01 272 03 0 00 000511* addm t3, nsitc ; Correct Network SIN% total characters NOT read 16929 000524'01 334 00 0 00 000000 %ermsg (,loopio) ; No, go drop dead 16930 000525'01 254 00 0 00 000531' 16931 000526'01 265 01 0 00 000470* 16932 000527'01 000000000000# 16933 000530'01 254 00 0 00 000541' 16934 000125'04 103 157 165 154 144 16935 000531'01 endif. 16936 000531'01 200 06 0 00 000002 move q2, t2 ; Keep track of where we are in the buffer 16937 000532'01 endif. ; End data read 16938 000532'01 315 05 0 00 000454* camge q1, strc ; Do we have enough to match? 16939 000533'01 254 00 0 00 000437' loop. ; No, get some more goodies 16940 000534'01 260 17 0 00 000563' call matchs ; See if we can match the search string 16941 000535'01 254 00 0 00 000437' loop. ; Didn't match 16942 000536'01 254 00 0 00 000537' exit. ; We did, so we're done 16943 000537'01 enddo. ; Exit loop context 16944 16945 000537'01 124 05 0 00 000000# dmovem q1, inpcnt ; Store updated buffer count and position 16946 000540'01 254 00 0 00 000411' jrst $inpux ; Success!!! 16947 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 12 K20IOC MAC 25-Nov-23 20:18 Various loop error handlers 16948 subttl Various loop error handlers 16949 16950 000541'01 loopio: remark ; Here for an I/O error 16951 000541'01 124 05 0 00 000000# dmovem q1, inpcnt ; Store updated buffer count and position 16952 000542'01 254 00 0 00 000410' jrst $inpuy ; Pop any take JFN's, disable ^C, timers, Etc. 16953 16954 000543'01 looptm: remark ; Here for assumed timer errors 16955 000543'01 124 05 0 00 000000# dmovem q1, inpcnt ; Store updated buffer count and position 16956 000544'01 254 00 0 00 000345' jrst $inpu9 16957 16958 16959 remark Common Buffer overflow handler 16960 16961 000545'01 loopov: remark ;[209] Here for buffer buffer full 16962 000545'01 124 05 0 00 000000# dmovem q1, inpcnt ; Store updated buffer count and position 16963 000546'01 334 01 0 00 000000# ermsg%(,$inpux) ;[209] Gronk on buffer overflow 16964 000547'01 254 00 0 00 000553' 16965 000550'01 202 01 0 00 000000* 16966 000551'01 104 00 0 00 000313 16967 000552'01 254 00 0 00 000411' 16968 000076'02 000000000000# 16969 000133'04 113 105 122 115 111 16970 16971 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 13 K20IOC MAC 25-Nov-23 20:18 Match String Overview and String Instructions 16972 subttl Match String Overview and String Instructions 16973 16974 ; The purpose of the routine below is to change the former search 16975 ; search paradigm from a byte at a time comparison to support a 16976 ; buffered approach while also benefiting from the use of string 16977 ; instructions. 16978 ; 16979 ; It is not the overhead of a ildb/idpb loop that is being saved so 16980 ; much as the JSYS overhead. For every character, both a BIN% and a 16981 ; BOUT% were needed, which involves the maximum context switching 16982 ; overhead with all that implies. 16983 ; 16984 ; Here, the maximum JSYi that will be executed for any read and print 16985 ; will be 4 of them: BIN%, SIBE%, SIN% and SOUT% (both counted for 16986 ; speed). This means that if you read more than two characters, you 16987 ; are going to win. 16988 ; 16989 ; This code is driven by the main loop in netins, which reads as much 16990 ; input as it can get until the threshold of the length of the search 16991 ; string is hit. At that point, this routine is invoked to see if 16992 ; there is a match. 16993 ; 16994 ; Simply put, the code uses a MOVST to trigger on the first character 16995 ; of the string. If the character is never hit, then the search 16996 ; criteria are not met and we return +1. In this case, we have 16997 ; effectedly searched through the entire contents of the buffer and 16998 ; need merely print and reset it via the ntriger exit. If the 16999 ; character is hit, then a CMPSE instruction is used to determine if 17000 ; the rest of the string matches. 17001 ; 17002 ; Whatever does not match is printed and removed from the network 17003 ; buffer. This operation is known here as a 'pull up' and is done 17004 ; with a MOVSLJ. 17005 ; 17006 ; Some of the extra code here is to handle caseless compares. Because 17007 ; the string compare instructions are case sensitive, we have to 17008 ; uppercase everythingt we compare first. 17009 ; 17010 ; However, the bulk of the code is to handle buffer management and, in 17011 ; particular, all the edge cases: single character search strings, a 17012 ; single character the buffer, matching on the last character, but 17013 ; still having remaining characters to compare, Etc. 17014 17015 remark ; Various Extended Instructions 17016 17017 000553'01 015 00 0 00 000000# m1stch: movst 0, sertab ; Use constructed trigger table 17018 000554'01 000000 000000 .chnul ; No fill, acually 17019 17020 000555'01 016 00 0 00 000000 movsup: movslj 0,0 ; Move string left justified (fastest) 17021 000556'01 000000 000000 .chnul ; Fill character (never used in this case) 17022 17023 000557'01 cmprmn: intern cmprmn ; Also used in k20tim to double check parity 17024 000557'01 002 00 0 00 000000 cmpse 0,0 ; Compare and skip if equal 17025 000560'01 000000 000000 .chnul ; Fill character 1 17026 000561'01 000000 000000 .chnul ; Fill character 2 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 13-1 K20IOC MAC 25-Nov-23 20:18 Match String Overview and String Instructions 17027 17028 000562'01 44 07 0 00 000430* str2bp: point 7, strbf2 ; Handy place to dump translated data 17029 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 14 K20IOC MAC 25-Nov-23 20:18 Match String Routine 17030 subttl Match String Routine 17031 17032 ; Entry 17033 ; 17034 ; q1/ Count of characters in network buffer 17035 ; q2/ Pointer into network buffer 17036 ; 17037 ; Exit: 17038 ; 17039 ; +1/ Didn't find the search string 17040 ; +2/ Successfully found the first instance of it (there may be others) 17041 ; 17042 ; In both cases, return with: 17043 ; 17044 ; q1/ Updated count of characters in network buffer 17045 ; q2/ Updated pointer to the end network buffer 17046 ; 17047 ; These are are either directly returned by matchs or indirectly by 17048 ; ntrigr. 17049 ; 17050 ; Note, we always have to back the source pointer up before the match 17051 ; character so that we can match the entire string. If we've skipped 17052 ; the match character and just compare the suffix string (like we used 17053 ; to do...) and it is the last thing in the buffer, then we will do 17054 ; the wrong thing after we come back from refilling the buffer (like 17055 ; we did in an earlier version...) 17056 ; 17057 ; To do: Possibly some of the exit code is really replicated. Maybe 17058 ; see what could be reasonably combined. On the other hand, it 17059 ; finally works... 17060 ; 17061 ; If doing an exact match, could bum the second MOVST which is just 17062 ; then a MOVSLJ. Would need to fix up the linkages. And it 17063 ; finally works... 17064 17065 000563'01 327 05 0 00 000572' matchs: ifle. q1 ; First of all, is there anything to do? 17066 000564'01 334 01 0 00 000000# ermsg% (,r) ; Program logic error 17067 000565'01 254 00 0 00 000571' 17068 000566'01 202 01 0 00 000550* 17069 000567'01 104 00 0 00 000313 17070 000570'01 254 00 0 00 000453* 17071 000077'02 000000000000# 17072 000142'04 113 105 122 115 111 17073 17074 000571'01 254 00 0 00 000600' else. ; Otherwise, do we have enough to chew on? 17075 000572'01 315 05 0 00 000532* camge q1, strc ; Enough to match our search string? 17076 000573'01 334 01 0 00 000000# ermsg% (,r) ; Another bogon 17077 000574'01 254 00 0 00 000600' 17078 000575'01 202 01 0 00 000566* 17079 000576'01 104 00 0 00 000313 17080 000577'01 254 00 0 00 000570* 17081 000100'02 000000000000# 17082 000155'04 113 105 122 115 111 17083 17084 000600'01 endif. ; OK, so let's try to do something useful K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 14-1 K20IOC MAC 25-Nov-23 20:18 Match String Routine 17085 17086 000600'01 265 16 0 00 004041' saveac 17087 000601'01 120 07 0 00 000005 dmove q3, q1 ; Save current network buffer length and position 17088 17089 000602'01 210 02 0 00 000007 movn t2, q3 ; Load negative count of buffer contents 17090 000603'01 133 02 0 00 000010 adjbp t2, q4 ; Back source up to beginning of network data 17091 000604'01 200 11 0 00 000002 move q5, t2 ; Save beginning of network data for later 17092 000605'01 332 00 0 00 000572* ifme. strc ; But!! Anything to search for?? 17093 000606'01 254 00 0 00 000612' 17094 000607'01 400 01 0 00 000000 setz t1, ; Fine, say we looked through all of it 17095 000610'01 260 17 0 00 001026' call ntrigr ; Go ditch all of it 17096 000611'01 254 00 0 00 000460* retskp ; Return success; matching everying ... 17097 000612'01 endif. 17098 17099 000612'01 200 01 0 00 000007 move t1, q3 ; Length we'll look at; total contents 17100 000613'01 200 04 0 00 000001 move t4, t1 ; Force equal lengths so no filling occurs 17101 000614'01 200 14 0 00 000001 move p4, t1 ; Save this length for later 17102 000615'01 200 05 0 00 000562' move q1, str2bp ; Destination is the translation buffer 17103 000616'01 403 03 0 00 000006 setzb t3, q2 ; Force section local pointers 17104 000617'01 621 01 0 00 700000 txz t1, S!N!M ; No need to translate until we hit the match 17105 000620'01 123 01 0 00 000553' extend t1, m1stch ; Trigger on MOVST termination code 17106 000621'01 600 00 0 00 000000 nop ; Ignore any skip (which should never happen) 17107 000622'01 120 12 0 00 000001 dmove p2, t1 ; Save remaining characters and position 17108 000623'01 607 01 0 00 200000 txnn t1, N ; Did we find anything? 17109 000624'01 254 00 0 00 001026' callret ntrigr ; No, go blat, reset the network buffer and return 17110 17111 remark ; Hit trigger, was this the only thing we needed to find? 17112 000625'01 621 01 0 00 700000 txz t1, S!N!M ; Stomp any flags 17113 000626'01 621 12 0 00 700000 txz p2, S!N!M ; in the copy, too 17114 000627'01 200 04 0 00 000605* move t4, strc ; Load match length 17115 000630'01 302 04 0 00 000001 caie t4, ^d1 ; Search string was only one dinky character? 17116 000631'01 254 00 0 00 000665' ifskp. ; Yep, we're done 17117 000632'01 200 14 0 00 000007 move p4, q3 ; Load original length 17118 000633'01 274 14 0 00 000012 sub p4, p2 ; Compute consumed characters 17119 000634'01 332 00 0 00 000322* ifme. pars8 ;[229] Only if not /SILENT 17120 000635'01 254 00 0 00 000650' 17121 000636'01 201 01 0 00 000101 movei t1, .priou ; Typing on the terminal 17122 000637'01 200 02 0 00 000011 move t2, q5 ; Source is where we started 17123 000640'01 210 03 0 00 000014 movn t3, p4 ; How much we'll type 17124 000641'01 325 03 0 00 000650' ifl. t3 ; Don't print if we computed gubbish 17125 000642'01 104 00 0 00 000053 SOUT% ; Counted SOUT% to terminal 17126 000643'01 320 12 0 00 000645' %jserr (,) 17127 000644'01 254 00 0 00 000650' 17128 000645'01 265 01 0 00 000526* 17129 000646'01 000000000000# 17130 000647'01 254 00 0 00 000650' 17131 000172'04 120 162 151 156 164 17132 000650'01 endif. 17133 000650'01 endif. ;[229] 17134 000650'01 120 01 0 00 000012 dmove t1, p2 ; Source is where MOVST stopped 17135 000651'01 326 01 0 00 000655' ife. t1 ; Was this at the END of the buffer? 17136 000652'01 400 05 0 00 000000 setz q1, ; Yes, so just zero out the count 17137 000653'01 200 06 0 00 000011 move q2, q5 ; and reset to the beginning of the buffer 17138 000654'01 254 00 0 00 000611* retskp ; About as easy as it gets 17139 000655'01 endif. ; Otherwise, pull the string up K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 14-2 K20IOC MAC 25-Nov-23 20:18 Match String Routine 17140 000655'01 200 04 0 00 000001 move t4, t1 ; Force no filling to occur 17141 000656'01 200 05 0 00 000011 move q1, q5 ; Goes to top of buffer 17142 000657'01 403 03 0 00 000006 setzb t3, q2 ; Just in case 17143 000660'01 123 01 0 00 000555' extend t1, movsup ; Move the string up 17144 000661'01 600 00 0 00 000000 nop ; Ignore +1 (which should never happen) 17145 000662'01 200 06 0 00 000005 move q2, q1 ; Ending destination is where we can now append 17146 000663'01 200 05 0 00 000012 move q1, p2 ; And load characters remaining in buffer 17147 000664'01 254 00 0 00 000654* retskp ; Return success 17148 000665'01 endif. ; Otherwise, do the non-single character case 17149 17150 remark ; First, fix up the pointers to match the string 17151 000665'01 474 13 0 00 000000 seto p3, ; Back up before the skip character 17152 000666'01 133 13 0 00 000002 adjbp p3, t2 ; So we can match the entire string 17153 000667'01 350 12 0 00 000001 aos p2, t1 ; Account for an inconsumed character (preserves flags) 17154 remark p4, ; Still has original length from above 17155 000670'01 200 15 0 00 000562' move p5, str2bp ; Always reset the destination pointer 17156 17157 remark ; Calculate match position 17158 000671'01 200 04 0 00 000007 move t4, q3 ; Load original length 17159 000672'01 274 04 0 00 000001 sub t4, t1 ; Calculate total done 17160 17161 000673'01 323 04 0 00 000675' ifg. t4 ; Anything to print? 17162 000674'01 260 17 0 00 001060' call netprn ; Print what we've seen and what will get tossed 17163 000675'01 endif. ; End case of match being first character 17164 17165 remark ; What we've printed is no longer relevant, chuck it 17166 000675'01 316 07 0 00 000012 camn q3, p2 ; But!! Did we not match at the first character?? 17167 000676'01 254 00 0 00 000710' ifskp. ; We did not, so do the pull up 17168 000677'01 120 01 0 00 000012 dmove t1, p2 ; Source is the last thing we've looked at 17169 000700'01 200 04 0 00 000001 move t4, t1 ; Force no use of fill characters 17170 000701'01 200 05 0 00 000011 move q1, q5 ; Destination is top of buffer 17171 000702'01 403 03 0 00 000006 setzb t3, q2 ; Force section local pointers 17172 000703'01 123 01 0 00 000555' extend t1, movsup ; Move the string up 17173 000704'01 600 00 0 00 000000 nop ; Ignore +1 (which should never happen) 17174 000705'01 200 07 0 00 000012 move q3, p2 ; Update reduced number of characters in network buffer 17175 000706'01 200 10 0 00 000005 move q4, q1 ; New append is ending destination of MOVSLJ 17176 remark p2, ; Unchanged, same number of characters 17177 000707'01 200 13 0 00 000011 move p3, q5 ; But we can start looking at the top of the buffer 17178 000710'01 endif. ; End case of non-1st character in buffer 17179 17180 000710'01 200 01 0 00 000627* move t1, strc ; Load length of match string 17181 000711'01 317 01 0 00 000007 camg t1, q3 ; Is there enough space to do the compare? 17182 000712'01 254 00 0 00 000715' ifskp. ; Nope, so must get some more network data 17183 000713'01 120 05 0 00 000007 dmove q1, q3 ; Return updated pointers 17184 000714'01 263 17 0 00 000000 ret ; Return +1, no match 17185 000715'01 endif. 17186 17187 remark t1, ; Already has source comparsion base length 17188 000715'01 200 11 0 00 000001 move q5, t1 ; No more pull up, so q5 is free 17189 000716'01 200 02 0 00 000013 move t2, p3 ; Where to start translating from 17190 000717'01 200 04 0 00 000001 move t4, t1 ; Transferring or translating equal lengths 17191 000720'01 200 05 0 00 000015 move q1, p5 ; Where to translate to (in translation buffer) 17192 000721'01 403 03 0 00 000006 setzb t3, q2 ; Force local pointers 17193 17194 remark ; A small optmization K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 14-3 K20IOC MAC 25-Nov-23 20:18 Match String Routine 17195 000722'01 332 00 0 00 000000# ifme. incase ; Case insensitive? 17196 000723'01 254 00 0 00 000730' 17197 000724'01 661 01 0 00 400000 txo t1, S ; Immediately start translating 17198 000725'01 123 01 0 00 000000# extend t1, trnbas ; Move the remaining characters 17199 000726'01 600 00 0 00 000000 nop ; Ignore non-skip 17200 000727'01 254 00 0 00 000732' else. ; Otherwise, case sensitive 17201 000730'01 123 01 0 00 000555' extend t1, movsup ; So just copy them and do nothing further 17202 000731'01 600 00 0 00 000000 nop ; Ignore non-skip (which should never happen) 17203 000732'01 endif. 17204 17205 remark ; Set up for the string compare 17206 000732'01 200 01 0 00 000011 move t1, q5 ; Load source length 17207 000733'01 200 02 0 00 000103* move t2, strptr ; Load pointer to search string 17208 000734'01 200 04 0 00 000001 move t4, t1 ; substrings are same length 17209 000735'01 200 05 0 00 000015 move q1, p5 ; Where we wrote the (translated) network data 17210 remark t3, q2 ; These are still zero, forcing local pointers 17211 000736'01 474 00 0 00 000000 seto f, ; Let's assume a match 17212 000737'01 123 01 0 00 000557' extend t1, cmprmn ; Finally, let's compare something!! 17213 000740'01 400 00 0 00 000000 setz f, ; Not the same... 17214 17215 000741'01 326 00 0 00 000765' ife. f ; Didn't match? 17216 000742'01 200 01 0 00 000000# move t1, trgchr ; Load the original trigger character and 17217 000743'01 332 00 0 00 000634* ifme. pars8 ;[229] Not if /SILENT 17218 000744'01 254 00 0 00 000746' 17219 000745'01 104 00 0 00 000074 PBOUT% ; print only that because we're skipping it 17220 000746'01 endif. ;[229] 17221 000746'01 337 01 0 00 000326* skipg t1, sesjfn ; Session logging? 17222 000747'01 254 00 0 00 000753' ifskp. ; Yes, so let's put it in there, too 17223 000750'01 200 02 0 00 000000# move t2, trgchr ; Load the original trigger character again 17224 000751'01 104 00 0 00 000051 BOUT% ; And put it into the log 17225 000752'01 320 12 0 00 000753' erjmpr .+1 ; Catch and ignore error 17226 000753'01 endif. ; End case session logging 17227 000753'01 370 01 0 00 000012 sos t1, p2 ; Account for consumed match character 17228 000754'01 200 04 0 00 000001 move t4, t1 ; Prevent any filling 17229 000755'01 200 05 0 00 000013 move q1, p3 ; Destination is where we started translating from 17230 000756'01 201 02 0 00 000001 movei t2, ^d1 ; Source is one character after that so we 17231 000757'01 133 02 0 00 000005 adjbp t2, q1 ; Overwrite the match character 17232 remark t3, q2 ; These are still zero, forcing local pointers 17233 000760'01 123 01 0 00 000555' extend t1, movsup ; Shift them all up a byte 17234 000761'01 600 00 0 00 000000 nop ; Ignore non-skip (which should never happen) 17235 000762'01 200 06 0 00 000005 move q2, q1 ; Last destination address is where we can append 17236 000763'01 200 05 0 00 000012 move q1, p2 ; New total 17237 000764'01 263 17 0 00 000000 ret ; Return non-match, boo... 17238 000765'01 endif. 17239 ; Otherwise, matched!!! 17240 remark ; Must print the rest of the compared string 17241 000765'01 332 00 0 00 000743* ifme. pars8 ;[229] Only if not /SILENT 17242 000766'01 254 00 0 00 001000' 17243 000767'01 201 01 0 00 000101 movei t1, .priou ; User's terminal 17244 000770'01 200 02 0 00 000013 move t2, p3 ; Where the match started 17245 000771'01 210 03 0 00 000011 movn t3, q5 ; Rest of search string length 17246 000772'01 104 00 0 00 000053 SOUT% ; Counted SOUT% is faster 17247 000773'01 320 12 0 00 000775' %jserr (,) ; Odd but carry on 17248 000774'01 254 00 0 00 001000' 17249 000775'01 265 01 0 00 000645* K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 14-4 K20IOC MAC 25-Nov-23 20:18 Match String Routine 17250 000776'01 000000000000# 17251 000777'01 254 00 0 00 001000' 17252 000205'04 125 156 141 142 154 17253 001000'01 endif. ;[229] 17254 17255 001000'01 337 01 0 00 000746* skipg t1, sesjfn ; Session logging? 17256 001001'01 254 00 0 00 001006' ifskp. ; Yes, so let's put it in there, too 17257 001002'01 200 02 0 00 000013 move t2, p3 ; Where the match started 17258 001003'01 210 03 0 00 000011 movn t3, q5 ; Rest of search string length 17259 001004'01 104 00 0 00 000053 SOUT% ; Counted SOUT% is faster 17260 001005'01 320 12 0 00 001006' erjmpr .+1 ; Catch and ignore error 17261 001006'01 endif. ; End case session logging 17262 17263 remark ; Is this really correct? 17264 001006'01 274 12 0 00 000011 sub p2, q5 ; Account for characters consumed 17265 001007'01 327 12 0 00 001013' ifle. p2 ; Nothing left? 17266 001010'01 400 05 0 00 000000 setz q1, ; No characters in buffer 17267 001011'01 200 06 0 00 000013 move q2, p3 ; Start from where compared because that's gone now 17268 001012'01 254 00 0 00 000664* retskp ; Return success!!!!! 17269 001013'01 endif. 17270 17271 remark ; What we've done is no longer relevant for pull up 17272 001013'01 200 01 0 00 000012 move t1, p2 ; New length includes consumed characters 17273 001014'01 200 02 0 00 000011 move t2, q5 ; What we've consumed 17274 001015'01 133 02 0 00 000013 adjbp t2, p3 ; Source is post transfer 17275 001016'01 200 04 0 00 000001 move t4, t1 ; Same length 17276 001017'01 200 05 0 00 000013 move q1, p3 ; Destination is pretransfer 17277 001020'01 403 03 0 00 000006 setzb t3, q2 ; Force section local pointers 17278 001021'01 123 01 0 00 000555' extend t1, movsup ; Move the string up 17279 001022'01 600 00 0 00 000000 nop ; Ignore +1 (which should never happen) 17280 001023'01 200 06 0 00 000005 move q2, q1 ; Return new append position 17281 001024'01 200 05 0 00 000012 move q1, p2 ; Return existing characters 17282 17283 001025'01 254 00 0 00 001012* retskp ; Return success!!!!! 17284 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 15 K20IOC MAC 25-Nov-23 20:18 No trigger character seen 17285 subttl No trigger character seen 17286 17287 ; Entry: matchs register context 17288 ; 17289 ; AC block from movst 17290 ; 17291 ; t1/ Remaining characters in network input buffer 17292 ; t2/ Pointer to where the first character match happened in the input buffer 17293 ; *** OR *** where we ended (for a .CHNUL, for example) 17294 ; t3/ Zero, section local pointers 17295 ; t4/ Remaing characters in translation buffer 17296 ; q1/ Pointer to where we stopped in the translation buffer 17297 ; q2/ Zero, section local pointers 17298 ; 17299 ; N.B. Since we never hit the trigger character, t1 and t4 WILL be equal 17300 ; on entry because we stopped consuming source and storing in the 17301 ; destination translation area. 17302 ; 17303 ; Set by matchs at the time of calling 17304 ; 17305 ; q3/ Original buffer length of network data 17306 ; q4/ Original pointer to end of network data buffer 17307 ; q5/ Pointer to beginning of network data buffer 17308 ; p1/ Aliased from q5, don't use! 17309 ; p2/ Remaining source length 17310 ; p3/ Updated pointer, which was based on q5 17311 ; p4/ [Not in use, yet] 17312 ; p5/ [Not in use, yet] 17313 ; 17314 ; Exit: 17315 ; 17316 ; q1/ Updated count of characters in buffer 17317 ; q2/ Updated pointer into buffer 17318 17319 001026'01 ntrigr: remark ; Here if extend never hit the trigger character 17320 remark ; Assumes saved by matchs 17321 remark ; also saved by matchs 17322 17323 001026'01 621 01 0 00 700000 txz t1, S!N!M ; Shut off any flags from MOVST 17324 001027'01 200 04 0 00 000007 move t4, q3 ; Load original length 17325 001030'01 274 04 0 00 000001 sub t4, t1 ; Calculate total data done 17326 001031'01 327 04 0 00 001040' ifle. t4 ; Did we actually do anything or get anything odd? 17327 001032'01 120 05 0 00 000007 dmove q1, q3 ; Restore original buffer position 17328 001033'01 334 01 0 00 000000# ermsg% (<1st character MOVST doesn't appear to have done anything>,r) 17329 001034'01 254 00 0 00 001040' 17330 001035'01 202 01 0 00 000575* 17331 001036'01 104 00 0 00 000313 17332 001037'01 254 00 0 00 000577* 17333 000101'02 000000000000# 17334 000215'04 113 105 122 115 111 17335 17336 001040'01 endif. ; End sanity check 17337 17338 001040'01 260 17 0 00 001060' call netprn ; Print outstanding network data 17339 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 15-1 K20IOC MAC 25-Nov-23 20:18 No trigger character seen 17340 001041'01 312 04 0 00 000007 came t4, q3 ; Looked though everything? 17341 001042'01 254 00 0 00 001046' ifskp. ; We did, so reset count and pointer 17342 001043'01 400 05 0 00 000000 setz q1, ; Nothing left to look at 17343 001044'01 200 06 0 00 000011 move q2, q5 ; Load reset pointer 17344 001045'01 263 17 0 00 000000 ret ; And done, +1 17345 001046'01 endif. 17346 ; Otherwise, have to 'pull up' the data 17347 001046'01 621 12 0 00 700000 txz p2, S!N!M ; Don't want any flags from now on 17348 001047'01 120 01 0 00 000012 dmove t1, p2 ; Source is where we stopped in the buffer 17349 001050'01 200 04 0 00 000001 move t4, t1 ; Destination length is the same as source length 17350 001051'01 200 05 0 00 000011 move q1, q5 ; It's going to the top of the buffer 17351 001052'01 403 03 0 00 000006 setzb t3, q2 ; Force section local pointers 17352 001053'01 123 01 0 00 000555' extend t1, movsup ; Pull the rest of the string up 17353 001054'01 600 00 0 00 000000 nop ; Ignore non-skip return (should never happen) 17354 001055'01 200 06 0 00 000005 move q2, q1 ; Append position is wherever MOVSLJ left it 17355 001056'01 200 05 0 00 000012 move q1, p2 ; New length is whatever we didn't look at 17356 001057'01 263 17 0 00 000000 ret ; Returns +1 17357 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 16 K20IOC MAC 25-Nov-23 20:18 Network Print 17358 subttl Network Print 17359 17360 ; Entry: 17361 ; 17362 ; q5/ Pointer to start printing from 17363 ; t4/ Count of characters to print 17364 ; 17365 ; Returns: 17366 ; 17367 ; +1, always, no registers modified 17368 17369 001060'01 323 04 0 00 001037* netprn: jumple t4, r ; If nothing to do, don't do anything 17370 001061'01 265 16 0 00 004057' saveac ; Don't step on a single thing 17371 001062'01 332 00 0 00 000765* ifme. pars8 ;[229] Only if not /SILENT 17372 001063'01 254 00 0 00 001075' 17373 001064'01 210 03 0 00 000004 movn t3, t4 ; Load negative count of data 17374 001065'01 200 02 0 00 000011 move t2, q5 ; And the beginning of it 17375 001066'01 201 01 0 00 000101 movei t1, .priou ; Our happy terminal 17376 001067'01 104 00 0 00 000053 SOUT% ; Blat how much we've done so far 17377 001070'01 320 12 0 00 001072' %jserr (,) ; Odd but carry on 17378 001071'01 254 00 0 00 001075' 17379 001072'01 265 01 0 00 000775* 17380 001073'01 000000000000# 17381 001074'01 254 00 0 00 001075' 17382 000233'04 125 156 141 142 154 17383 001075'01 endif. ;[229] 17384 17385 001075'01 337 01 0 00 001000* skipg t1, sesjfn ; Session logging? 17386 001076'01 263 17 0 00 000000 ret ; No, we're done 17387 17388 remark ; Yes, so let's put it in there, too 17389 001077'01 200 02 0 00 000011 move t2, q5 ; And the beginning of it 17390 001100'01 210 03 0 00 000004 movn t3, t4 ; Load negative count of data 17391 001101'01 104 00 0 00 000053 SOUT% ; Counted SOUT% is faster 17392 001102'01 320 12 0 00 001103' erjmpr .+1 ; Catch and ignore error 17393 17394 001103'01 263 17 0 00 000000 ret 17395 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 17 K20IOC MAC 25-Nov-23 20:18 Clear Buffered Network Data 17396 subttl Clear Buffered Network Data 17397 17398 ; Returns number cleared 17399 17400 001104'01 inpclr: entry inpclr ; Used by k20net 17401 001104'01 265 16 0 00 004012' saveac ; Used by inpbfc 17402 17403 001105'01 120 05 0 00 000000# dmove q1, inpcnt ; Set calling context 17404 001106'01 260 17 0 00 001116' call inpbfc ; Check buffer constency 17405 001107'01 263 17 0 00 000000 ret ; Bad, don't touch 17406 001110'01 272 05 0 00 000000# addm q1, inpcbf ; Otherwise, count is good, add to tally 17407 001111'01 120 01 0 00 000000# dmove t1, inpini ; Load INPUT initialization data 17408 001112'01 124 01 0 00 000000# dmovem t1, inpcnt ; Whack the buffer 17409 001113'01 200 01 0 00 000005 move t1, q1 ; Return what we cleared 17410 001114'01 263 17 0 00 000000 ret 17411 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 18 K20IOC MAC 25-Nov-23 20:18 INPUT buffer checking and error handling 17412 subttl INPUT buffer checking and error handling 17413 17414 remark ; Input buffer check 17415 17416 ; Call 17417 ; 17418 ; q1/ Current inpcnt, count of characters in buffer 17419 ; q2 Current inpptr, append pointer 17420 ; 17421 ; +1, Something bad 17422 ; +2, Good 17423 ; t1/ Start of text 17424 ; 17425 ; Register usage 17426 ; 17427 ; q3/ Earliest possible byte pointer 17428 ; q4/ Last possible byte pointer 17429 ; q5/ Beginning of current text in buffer 17430 17431 001115'01 44 07 0 00 000000# bufbeg: point 7, inpbuf ; Assembled beginning of buffer 17432 17433 001116'01 inpbfc: entry inpbfc ; Called from k20par 17434 001116'01 265 16 0 00 004071' saveac ; Some internal storage 17435 remark ; Leave these alone!! 17436 001117'01 200 01 0 00 001115' move t1, bufbeg ; Load assembler beginning 17437 001120'01 200 02 0 00 000001 move t2,t1 ; Save a copy 17438 17439 001121'01 133 00 0 00 000001 ibp t1 ; Bump into the first word 17440 001122'01 474 07 0 00 000000 seto q3, ; Back up by one 17441 001123'01 133 07 0 00 000001 adjbp q3, t1 ; Puts it into previous word 17442 001124'01 201 10 0 00 005000 movx q4, strblc ; Load maximum count 17443 001125'01 133 10 0 00 000002 adjbp q4, t2 ; Puts past last word 17444 17445 remark ; First, check the length 17446 001126'01 305 05 0 00 000000 caige q1, 0 ; Bogus count?? 17447 001127'01 334 01 0 00 000000# ermsg% (,inpbfa) 17448 001130'01 254 00 0 00 001134' 17449 001131'01 202 01 0 00 001035* 17450 001132'01 104 00 0 00 000313 17451 001133'01 254 00 0 00 001233' 17452 000102'02 000000000000# 17453 000243'04 113 105 122 115 111 17454 17455 001134'01 303 05 0 00 005000 caile q1, strblc ; Absurdly large? 17456 001135'01 334 01 0 00 000000# ermsg% (,inpbfa) 17457 001136'01 254 00 0 00 001142' 17458 001137'01 202 01 0 00 001131* 17459 001140'01 104 00 0 00 000313 17460 001141'01 254 00 0 00 001233' 17461 000103'02 000000000000# 17462 000253'04 113 105 122 115 111 17463 17464 17465 remark ; Check append pointer 17466 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 20:02 27-Nov-23 Page 18-1 K20IOC MAC 25-Nov-23 20:18 INPUT buffer checking and error handling 17467 001143'01 550 04 0 00 000007 hrrz t4, q3 ; And the earliest possible address 17468 001144'01 313 03 0 00 000004 camle t3, t4 ; Before or at last? 17469 001145'01 254 00 0 00 001155' ifskp. ; Yes, could be bad 17470 001146'01 316 06 0 00 000007 camn q2, q3 ; Unless on exact address 17471 001147'01 254 00 0 00 001155' anskp. ; That's fine 17472 001150'01 334 01 0 00 000000# ermsg% (,inpbtc) 17473 001151'01 254 00 0 00 001155' 17474 001152'01 202 01 0 00 001137* 17475 001153'01 104 00 0 00 000313 17476 001154'01 254 00 0 00 001232' 17477 000104'02 000000000000# 17478 000263'04 113 105 122 115 111 17479 17480 001155'01 endif. 17481 17482 001155'01 550 04 0 00 000010 hrrz t4, q4 ; Load last possible address 17483 001156'01 315 03 0 00 000004 camge t3, t4 ; After or at last? 17484 001157'01 254 00 0 00 001167' ifskp. ; Yes, could be bad 17485 001160'01 316 06 0 00 000010 camn q2, q4 ; Unless on exact address 17486 001161'01 254 00 0 00 001167' anskp. ; That's fine 17487 001162'01 334 01 0 00 000000# ermsg% (,inpbtc) 17488 001163'01 254 00 0 00 001167' 17489 001164'01 202 01 0 00 001152* 17490 001165'01 104 00 0 00 000313 17491 001166'01 254 00 0 00 001232' 17492 000105'02 000000000000# 17493 000300'04 113 105 122 115 111 17494 17495 001167'01 endif. 17496 17497 001167'01 323 05 0 00 001220' ifg. q1 ; But!! Is there anything to do? 17498 remark ; Calculate and check start of text 17499 001170'01 210 11 0 00 000005 movn q5, q1 ; Load negative current buffer length 17500 001171'01 133 11 0 00 000006 adjbp q5, q2 ; Calculates beginning of input area 17501 17502 001172'01 550 03 0 00 000011 hrrz t3, q5 ; Load address of start of text 17503 001173'01 550 04 0 00 000007 hrrz t4, q3 ; And the earliest possible address 17504 001174'01 313 03 0 00 000004 camle t3, t4 ; Before or at last? 17505 001175'01 254 00 0 00 001205' ifskp. ; Yes, could be bad 17506 001176'01 316 11 0 00 000007 camn q5, q3 ; Unless on exact address 17507 001177'01 254 00 0 00 001205' anskp. ; That's fine 17508 001200'01 334 01 0 00 000000# ermsg% (,inpbtc) 17509 001201'01 254 00 0 00 001205' 17510 001202'01 202 01 0 00 001164* 17511 001203'01 104 00 0 00 000313 17512 001204'01 254 00 0 00 001232' 17513 000106'02 000000000000# 17514 000313'04 113 105 122 115 111 17515 17516 001205'01 endif. 17517 17518 001205'01 550 04 0 00 000010 hrrz t4, q4 ; Load last possible address 17519 001206'01 315 03 0 00 000004 camge t3, t4 ; After or at last? 17520 001207'01 254 00 0 00 001217' ifskp. ; Yes, could be bad 17521 001210'01 316 06 0 00 000010 camn q2, q4 ; Unless on exact address K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 18-2 K20IOC MAC 25-Nov-23 20:18 INPUT buffer checking and error handling 17522 001211'01 254 00 0 00 001217' anskp. ; That's fine 17523 001212'01 334 01 0 00 000000# ermsg% (,inpbtc) 17524 001213'01 254 00 0 00 001217' 17525 001214'01 202 01 0 00 001202* 17526 001215'01 104 00 0 00 000313 17527 001216'01 254 00 0 00 001232' 17528 000107'02 000000000000# 17529 000330'04 113 105 122 115 111 17530 17531 001217'01 endif. 17532 001217'01 254 00 0 00 001221' else. ; Otherwise, nothing to compute or check 17533 001220'01 200 11 0 00 000007 move q5, q3 ; Current append IS the start of text 17534 001221'01 endif. 17535 17536 remark ; Everything looks, good but can we get anything? 17537 001221'01 200 02 0 00 000011 move t2, q5 ; Load the start of buffer pointer 17538 001222'01 134 04 0 00 000002 ildb t4, t2 ; Pick up the first character 17539 001223'01 320 12 0 00 001225' %jserr (,inpbtc) 17540 001224'01 254 00 0 00 001230' 17541 001225'01 265 01 0 00 001072* 17542 001226'01 000000000000# 17543 001227'01 254 00 0 00 001232' 17544 000343'04 102 165 146 146 145 17545 17546 001230'01 200 01 0 00 000011 move t1, q5 ; Return current input position 17547 001231'01 254 00 0 00 001025* retskp ; Finally return success 17548 17549 17550 remark Error handler 17551 17552 001232'01 272 05 0 00 000000# inpbtc: addm q1, inpcbf ; Otherwise, count is good, add to tally 17553 001233'01 400 05 0 00 000000 inpbfa: setz q1, ; Whack the buffer; nothing in there 17554 001234'01 200 06 0 00 001115' move q2, bufbeg ; and point to the beginning 17555 001235'01 263 17 0 00 000000 ret ; Return the bad news 17556 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 19 K20IOC MAC 25-Nov-23 20:18 Debug Print, call with a JSP CX 17557 subttl Debug Print, call with a JSP CX 17558 17559 ; Was used to catch all the edge cases when doing buffered reads 17560 17561 repeat 0,< ; But it's debugged now. I hope... 17562 17563 debprn: push p, t1 17564 push p, t2 17565 push p, t3 17566 txmsg < 17567 Entry: > 17568 call prnbuf 17569 pop p, t3 17570 pop p, t2 17571 pop p, t1 17572 call (cx) ;;No arguments to skip 17573 ifskp. 17574 push p, t1 17575 push p, t2 17576 push p, t3 17577 txmsg < 17578 retskp: > 17579 call prnbuf 17580 pop p, t3 17581 pop p, t2 17582 pop p, t1 17583 aos (p) 17584 else. 17585 push p, t1 17586 push p, t2 17587 push p, t3 17588 txmsg < 17589 ret: > 17590 call prnbuf 17591 pop p, t3 17592 pop p, t2 17593 pop p, t1 17594 endif. 17595 ret 17596 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 20 K20IOC MAC 25-Nov-23 20:18 Debug Print, call with a JSP CX 17597 remark The symbol being displayed is what the buffer pointer is 17598 17599 prnbuf: movei t1, .priou 17600 move t2, q1 17601 movei t3, ^d10 17602 NOUT% 17603 erjmpr .+1 17604 txmsg <, > 17605 hrrz t1, q2 17606 push p, cx 17607 call symout## 17608 pop p, cx 17609 ifg. q1 17610 caile q1, strblc 17611 anskp. 17612 txmsg <,' 17613 '> 17614 movei t1, .priou 17615 movn t2, q1 17616 adjbp t2, q2 17617 movn t3, q1 17618 SOUT% 17619 erjmpr .+1 17620 txmsg <' 17621 17622 > 17623 else. 17624 ifn. q1 17625 txmsg <, *** absurd length *** 17626 17627 > 17628 else. 17629 txmsg < 17630 17631 > 17632 endif. 17633 endif. 17634 ret 17635 >;repeat 0 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 21 K20IOC MAC 25-Nov-23 20:18 Builds a Search String 17636 subttl Builds a Search String 17637 17638 ; Call: 17639 ; 17640 ; Something in the atom buffer to search for. Does the following, 17641 ; in order, 17642 ; 17643 ; 1) Translates C escape sequences to the indicated character 17644 ; 2) Builds search MOVST table 17645 ; 17646 ; Returns +1, If error 17647 ; +2. Success!! 17648 ; 17649 ; strbuf/ Converted 7-bit ASCIZ string 17650 ; strptr/ 7 bit pointer to the above 17651 ; strc/ Length of converted string 17652 ; sertab/ MOVST table to stop on first letter of search string 17653 ; 17654 ; Unlike getss, will not allow string buffer to be overwritten 17655 17656 001236'01 265 16 0 00 004103' bsrchs: saveac ; Needs some temporaries 17657 dmove t1, [ ; Set up for expansion 17658 point 7,strbuf ; Destination is string buffer 17659 001237'01 120 01 0 00 004115' point 7,atmbuf] ; Source is the typed in string 17660 001240'01 120 05 0 00 000001 dmove q1, t1 ; Save destination and source pointers 17661 001241'01 202 01 0 00 000733* movem t1, strptr ; Save destination pointer for later 17662 17663 001242'01 200 01 0 00 000002 move t1, t2 ;[248] ; Source and destination are the same 17664 001243'01 260 17 0 00 000000* call asczcp ;[248] ; Count what is in the atom buffer 17665 001244'01 377 00 0 00 000003 sosg t3 ;[248] ; Don't count the stupid NUL 17666 001245'01 400 03 0 00 000000 setz t3, ;[248] ; Normalize if went negative 17667 17668 001246'01 323 03 0 00 001263' ifg. t3 ;[248] ; Anything to do, actually? 17669 001247'01 120 01 0 00 000005 dmove t1, q1 ;[248] ; Reload destination and source 17670 remark t3, ;[248] ; Was set by asczcp, above 17671 001250'01 201 04 0 00 000000# movei t4, chrtup ;[248] Assume (common) case insensitive compare 17672 001251'01 332 00 0 00 000000# skipe incase ; But!! Case-INsensitive compare? 17673 001252'01 201 04 0 00 000000# movei t4, chrtab ; Ok, so case sensitive, then 17674 001253'01 260 17 0 00 003200' call cescxp ; Expand any escape characters 17675 001254'01 334 00 0 00 000000 %ermsg (,r) ; pass +1 up 17676 001255'01 254 00 0 00 001261' 17677 001256'01 265 01 0 00 001225* 17678 001257'01 000000000000# 17679 001260'01 254 00 0 00 001060* 17680 000351'04 105 162 162 157 162 17681 001261'01 202 03 0 00 000710* movem t3, strc ; Store the length of the target string 17682 001262'01 254 00 0 00 001267' else. ; Otherwise, nothing in there 17683 001263'01 402 00 0 00 001261* setzm strc ; So zero the string counter 17684 001264'01 403 02 0 00 000003 setzb t2, t3 ; And scrub a dub 17685 001265'01 124 02 0 00 000427* dmovem t2, strbuf ; the destination buffer 17686 001266'01 254 00 0 00 001231* retskp ; Nothing else to do 17687 001267'01 endif. ; End case something to do 17688 17689 001267'01 134 07 0 00 000005 ildb q3, q1 ; Pick up first expanded character 17690 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 20:02 27-Nov-23 Page 21-1 K20IOC MAC 25-Nov-23 20:18 Builds a Search String 17691 ; Otherwise, build a search translation table 17692 001271'01 201 01 0 00 000200 movx t1, sertln ; Length of search table in words 17693 dmove t2, [ btrnsu ; Uppercasing base table with no stop characters 17694 001272'01 120 02 0 00 004117' sertab ] ; Destination in writable storage to be modified 17695 001273'01 332 00 0 00 000000# skipe incase ; But!! Case-INsensitive compare? 17696 001274'01 201 02 0 00 000000# movei t2, btrnst ; No, so use exact matching table, then 17697 17698 001275'01 550 04 0 00 000002 hrrz t4, t2 ; Pick up address of base table 17699 001276'01 505 04 0 00 015000 hrli t4, (movst 0,0) ; Build instruction 17700 001277'01 202 04 0 00 000000# movem t4, trnbas ; Store as instructon to do 17701 001300'01 402 00 0 00 000000# setzm trnbas+1 ; Fill character is .chnul 17702 001301'01 123 01 0 00 004022' xblt. t1 ; Drop into place 17703 17704 001302'01 202 07 0 00 000000# movem q3, trgchr ; Might be the right character 17705 001303'01 200 01 0 00 000007 move t1, q3 ; Load the character 17706 001304'01 260 17 0 00 001324' call mrktab ; Mark the table to stop on this character 17707 001305'01 332 00 0 00 000000# skipe incase ; But!! Case-INsensitive compare? 17708 001306'01 254 00 0 00 001270* retskp ; No, so case sensitive and we're done 17709 17710 001307'01 200 01 0 00 000007 move t1, q3 ; Otherwise, load the character again 17711 001310'01 301 01 0 00 000141 cail t1, "a" ; Is this a lower case letter? 17712 001311'01 303 01 0 00 000172 caile t1, "z" 17713 001312'01 254 00 0 00 001316' jrst bsrch1 ; No, see if UPPER case 17714 001313'01 620 01 0 00 000040 txz t1, 40 ; Yes, convert to UPPER case 17715 001314'01 202 01 0 00 000000# movem t1, trgchr ; And save as the trigger character 17716 001315'01 254 00 0 00 001322' jrst bsrch2 ; Now go poke the table 17717 17718 001316'01 301 01 0 00 000101 bsrch1: cail t1, "A" ; No, is this an UPPER case letter? 17719 001317'01 303 01 0 00 000132 caile t1, "Z" ; If neither UPPER or lower, 17720 001320'01 254 00 0 00 001306* retskp ; we're done 17721 001321'01 660 01 0 00 000040 txo t1, 40 ; Yes, convert to lower case 17722 remark bsrch2 ; Falls through to tweak the table again 17723 17724 001322'01 260 17 0 00 001324' bsrch2: call mrktab ; Mark the table to stop on this character 17725 001323'01 254 00 0 00 001320* retskp ; Return success 17726 17727 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 22 K20IOC MAC 25-Nov-23 20:18 Given a character Mark a translate Table to stop on it 17728 subttl Given a character Mark a translate Table to stop on it 17729 17730 ; Call: 17731 ; 17732 ; t1/ Character to stop on 17733 ; 17734 ; Returns: +1, always 17735 ; 17736 ; Search table (sertab) with appropriate character pair updated 17737 ; 17738 ; To do, the indexed xct is extremely cute, but probably not really 17739 ; fast. Probably could just have done an txnn/ifskp./else./endif. 17740 ; and maybe even bummed the lsh. Even with all the extra jrst's, 17741 ; it would probably be faster. 17742 ; 17743 ; Vanity, vanity, vanity... 17744 17745 001324'01 265 16 0 00 004057' mrktab: saveac ; Don't touch the temporaries 17746 001325'01 246 01 0 00 777777 lshc t1, ^d<-1> ; Divide by two, shifting odd bit into bit zero 17747 001326'01 242 02 0 00 777735 lsh t2, ^d<-35> ; Shift remainder into bit zero 17748 001327'01 200 03 0 01 000000# move t3, sertab(t1) ; Load character pair 17749 xct [tlo t3,TRMCOD ; Even, pick up left half 17750 001330'01 256 00 0 02 004121' tro t3,TRMCOD](t2) ; Odd, pick up right half 17751 001331'01 202 03 0 01 000000# movem t3, sertab(t1) ; Store back into table 17752 001332'01 263 17 0 00 000000 ret ; Done 17753 17754 ;[209] End code insertion 17755 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 23 K20IOC MAC 25-Nov-23 20:18 OUTPUT command parsing 17756 subttl OUTPUT command parsing 17757 17758 ;[208] Originally shut off indirection, but since quoted strings allow 17759 ; us to put in an at-sign (@) as well as escape sequences, this was 17760 ; removed to allow backward compatibility with any take files which 17761 ; rely on this. 17762 17763 chgsec(code,const) ;;Chained FDB's go in const 17764 000110'02 010004 000113' outfdb: flddb. .cmcfm,,,,,outfd1 17765 000111'02 000000 000000 17766 000112'02 44 07 0 00 003631' 17767 000113'02 021004 000116' outfd1: flddb. .cmqst,,,,,outfd2 17768 000114'02 000000 000000 17769 000115'02 44 07 0 00 003640' 17770 000116'02 017004 000000 outfd2: flddb. .cmtxt,,,,, ;[208] 17771 000117'02 000000 000000 17772 000120'02 44 07 0 00 003647' 17773 retsec ;;Return to code psect 17774 cleans() ;;Clean up working symbols 17775 17776 17777 001333'01 .outpu: entry .output ; Invoked by k20par 17778 001333'01 200 16 0 00 000000# guide (string) ; Parse OUTPUT command. 17779 001334'01 260 17 0 00 000212* 17780 000121'02 000000000000# 17781 000360'04 163 164 162 151 156 17782 001335'01 201 01 0 00 000000# movei t1, outfdb ;[208] Load pointer to chained fdb's 17783 001336'01 260 17 0 00 000216* call rfield ;[208] Parse for something 17784 001337'01 135 03 0 00 004011' ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ;[208] Get what was parsed 17785 17786 001340'01 302 03 0 00 000010 caie t3, .cmcfm ;[208] Parsed a confirm? 17787 001341'01 254 00 0 00 001347' ifskp. ;[208] We did, so fix up the atom buffer 17788 001342'01 205 01 0 00 064000 movx t1, ;[208] Load a carriage return 17789 001343'01 202 01 0 00 000225* movem t1, atmbuf ;[208] Stomp the atom buffer 17790 dmove t2,[ point 7, atmbuf ;[248] Point to atom buffer 17791 001344'01 120 02 0 00 004123' ^d1 ] ;[248] And its single byte 17792 001345'01 124 02 0 00 000231* dmovem t2, pars3 ;[248] Pass over to semantic action 17793 001346'01 263 17 0 00 000000 ret ;[248] Done 17794 001347'01 endif. ;[248] End case defaulting input 17795 ;[208] Otherwise, the atom buffer is valid 17796 001347'01 260 17 0 00 000252* confrm ;[208] But must be confirmed 17797 17798 dmove t1, [ ;[248] Overwritting the atom buffer in place 17799 point 7, atmbuf ;[248] So the source is the atom buffer and 17800 001350'01 120 01 0 00 004125' point 7, atmbuf ] ;[248] the destination is the atom buffer 17801 001351'01 260 17 0 00 001243* call asczcp ;[248] Move the string on top of itself, returning count 17802 001352'01 200 02 0 00 004025' move t2,[point 7,atmbuf];[248] Load address of string to possibly expand 17803 001353'01 375 00 0 00 000003 sosge t3 ;[248] Don't count the NUL at the end!! 17804 001354'01 400 03 0 00 000000 setz t3, ;[248] Stomp if went negative 17805 001355'01 124 02 0 00 001345* dmovem t2, pars3 ;[248] Store for semantic action 17806 001356'01 263 17 0 00 000000 ret ;[248] Now go do something useful with it 17807 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 24 K20IOC MAC 25-Nov-23 20:18 OUTPUT command execution 17808 subttl OUTPUT command execution 17809 17810 remark pars3 ;[248] Pointer to buffer with characters parsed 17811 remark pars4 ;[248] Length of buffer 17812 17813 001357'01 $outpu: entry $output ;[209] Invoked by k20par 17814 001357'01 265 16 0 00 004127' saveac ;[247] Save registers for piggy MOVST 17815 17816 remark ;[209] Expand any C escape characters 17817 001360'01 200 01 0 00 004143' move t1, [point 8,strbuf] ;[248] Destination buffer is eight bit 17818 001361'01 120 02 0 00 001355* dmove t2, pars3 ;[248] Load source buffer point and length 17819 001362'01 322 03 0 00 001260* jumpe t3, R ;[248] If nothing to do, then don't do anything 17820 001363'01 201 04 0 00 000000# movei t4, chrtab ;[209] Respect case on expansion 17821 001364'01 200 12 0 00 000001 move p2, t1 ;[248] Save output buffer pointer 17822 001365'01 260 17 0 00 003200' call cescxp ;[209] Expand string into output buffer 17823 001366'01 334 00 0 00 000000 %ermsg (,r) ;[209] Don't go any further 17824 001367'01 254 00 0 00 001373' 17825 001370'01 265 01 0 00 001256* 17826 001371'01 000000000000# 17827 001372'01 254 00 0 00 001362* 17828 000362'04 105 162 162 157 162 17829 001373'01 200 11 0 00 000003 move p1, t3 ;[247] Save length of destination 17830 17831 001374'01 337 01 0 00 000434* $outp4: skipg t1, netjfn ;[186] Comm line designator. 17832 001375'01 200 01 0 00 000435* move t1, ttyjfn ;[186] Not remote, using local 17833 001376'01 260 17 0 00 000000* call chklin ; Whatever it is, check it 17834 001377'01 332 00 0 00 000000* ifme. carier ; No carrier? 17835 001400'01 254 00 0 00 001406' 17836 001401'01 334 00 0 00 000000 %ermsg (,r) 17837 001402'01 254 00 0 00 001406' 17838 001403'01 265 01 0 00 001370* 17839 001404'01 000000000000# 17840 001405'01 254 00 0 00 001372* 17841 000371'04 125 156 141 142 154 17842 001406'01 endif. 17843 001406'01 200 02 0 00 000012 move t2, p2 ;[247] Point to converted string 17844 001407'01 210 03 0 00 000011 movn t3, p1 ;[247] Counted string (gives length of record) 17845 001410'01 400 04 0 00 000000 setz t4, ;[186] Just in case still NUL terminated (isn't) 17846 001411'01 336 00 0 00 000000# skipn parpko ;[223] Don't do this if doing packets only 17847 001412'01 260 17 0 00 003655' call putpar ;[223] Otherwise, maybe put some parity on it 17848 001413'01 336 00 0 00 000000* ifmn. tvtflg ;[247] TVT-Binary? 17849 001414'01 254 00 0 00 001443' 17850 001415'01 415 16 0 00 001435' block. ;[247] Yes, let's see if we need any quoting 17851 001416'01 261 17 0 00 000016 17852 001417'01 265 16 0 00 004144' saveac ;[247] Save output designator, want an accumulator 17853 001420'01 200 07 0 00 004154' move q3, [point 8, tvtbuf] ;[247] Special buffer for IAC doubling 17854 001421'01 200 01 0 00 000011 move t1, p1 ;[247] Positive length 17855 001422'01 200 03 0 00 000007 move t3, q3 ;[247] Load output area 17856 001423'01 260 17 0 00 000000* call iaciac ;[247] Go double any IAC's 17857 001424'01 334 00 0 00 000000 %ermsg (,r) ;;[247] 17858 001425'01 254 00 0 00 001431' 17859 001426'01 265 01 0 00 001403* 17860 001427'01 000000000000# 17861 001430'01 254 00 0 00 001405* 17862 000402'04 117 125 124 120 125 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 24-1 K20IOC MAC 25-Nov-23 20:18 OUTPUT command execution 17863 001431'01 200 11 0 00 000004 move p1, t4 ;[247] Store updated length 17864 001432'01 200 12 0 00 000007 move p2, q3 ;[247] New output buffer 17865 001433'01 254 00 0 00 001323* retskp ;[247] Won! 17866 001434'01 263 17 0 00 000000 endbk. ;[247] End of block context 17867 001435'01 254 00 0 00 001442' ifskp. ;[247] Success 17868 001436'01 200 02 0 00 000012 move t2, p2 ;[247] Pass in to SOUTR% 17869 001437'01 210 03 0 00 000011 movn t3, p1 ;[247] New length 17870 001440'01 400 04 0 00 000000 setz t4, ;[247] Just in case still NUL terminated (isn't) 17871 001441'01 254 00 0 00 001443' else. ;[247] Otherwise, failed somehow 17872 001442'01 263 17 0 00 000000 ret ;[247] So get out of here 17873 001443'01 endif. ;[247] End case iaciac return handling 17874 001443'01 endif. ;[247] End TVT-binary handling 17875 001443'01 104 00 0 00 000532 SOUTR% ;[186] Push it over the network. 17876 001444'01 320 12 0 00 001446' %jserr (,) ;[186] Couldn't ... 17877 001445'01 254 00 0 00 001451' 17878 001446'01 265 01 0 00 001426* 17879 001447'01 000000000000# 17880 001450'01 254 00 0 00 001451' 17881 000410'04 103 141 156 047 164 17882 17883 001451'01 350 00 0 00 000000* aos vsoct ;[204] Count a SOUTR% done 17884 001452'01 272 11 0 00 000000* addm p1, vsotc ;[204] Update tally of SOUTR% bytes 17885 001453'01 313 11 0 00 000000* camle p1, vsomx ;[204] Length than or equal to the maximum seen? 17886 001454'01 202 11 0 00 001453* movem p1, vsomx ;[204] Nope, we have a new maximum! 17887 17888 001455'01 336 00 0 00 000000* ifmn. duplex ;[247] Half duplex connection? 17889 001456'01 254 00 0 00 001500' 17890 001457'01 201 01 0 00 000101 movei t1, .priou ; Yes, do it ourselves. 17891 001460'01 200 02 0 00 000012 move t2, p2 ;[247] Point to final string 17892 001461'01 210 03 0 00 000011 movn t3, p1 ;[247] Counted string (faster) 17893 001462'01 400 04 0 00 000000 setz t4, ;[186] Just in case (still NUL terminated) 17894 001463'01 104 00 0 00 000053 SOUT% 17895 001464'01 320 12 0 00 001465' erjmpr .+1 ;[195] 17896 remark ;[248] Only 'echo' in session log if half duplex 17897 001465'01 337 01 0 00 001075* skipg t1, sesjfn ;[195] Session logging? 17898 001466'01 254 00 0 00 001500' ifskp. ;[195] A JFN exists 17899 001467'01 336 00 0 00 000330* skipn sesflg ;[195] Is logging active? 17900 001470'01 254 00 0 00 001500' anskp. ;[195] No, so don't bother 17901 001471'01 306 01 0 00 377777 cain t1, .nulio ;[193] Just dumping it? 17902 001472'01 254 00 0 00 001500' anskp. ;[193] If so, we're done 17903 001473'01 200 02 0 00 000012 move t2, p2 ;[247] Otherwise, point again. 17904 001474'01 210 03 0 00 000011 movn t3, p1 ;[247] Counted string (faster) 17905 001475'01 400 04 0 00 000000 setz t4, ;[186] Just in case (still NUL terminated) 17906 001476'01 104 00 0 00 000053 SOUT 17907 001477'01 320 12 0 00 001500' erjmpr .+1 ;[195] 17908 001500'01 endif. ;[195] 17909 001500'01 endif. ;[247] End case half-duplex 17910 17911 001500'01 263 17 0 00 000000 ret ; Done. 17912 17913 ;[209] End code replacement 17914 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 25 K20IOC MAC 25-Nov-23 20:18 TRANSMIT [file] parsing [165] 17915 subttl TRANSMIT [file] parsing [165] 17916 17917 ;[209] Begin code replacement 17918 ; 17919 ; Moved here from k20mit and rewritten to be able drive buffered I/O. 17920 ; 17921 ; Tries for a device first as this is more efficient for NUL: and 17922 ; catches more errors earlier and more easily. Can sometimes make 17923 ; recognition not work intuitively by picking a bogus device over 17924 ; a non-existant file. 17925 ; 17926 ; Default command filespec fields for .CMFIL. These are only given 17927 ; so that we may get the flags returned by GTJFN% (which are currently 17928 ; unused) 17929 17930 chgsec(code,const) ;;GTJFN defaults are not in code, they're in const 17931 17932 000122'02 100020 000000 trnbk: gj%flg!gj%old!fld(.gjdef,.rhalf) ; .GJGEN 17933 000123'02 000100 000101 .priin,,.priou ; .GJSRC (ignored if COMND%) 17934 000124'02 000000 000000 0 ; .GJDEV (do not default the device) 17935 000125'02 000000 000000 0 ; .GJDIR (do not default the directory) 17936 000126'02 000000 000000 0 ; .GJNAM (do not default the name) 17937 000127'02 000000 000000 0 ; .GJEXT (do not default the extension) 17938 000130'02 000000 000000 0 ; .GJPRO (use system default protection) 17939 000131'02 000000 000000 0 ; .GJACT (use job's current account) 17940 000010 trnbkl==<.-trnbk> ; Length of this GTJFN argument block. 17941 retsec ;;[229] Back to where-ever we started from 17942 17943 ;[229] %table puts stuff in the correct .psect 17944 17945 000132'02 000000 000000 %table (trnswi) ;[229] The translate switch table 17946 000133'02 000000# 000000 %key2 , %eofsw ;[229] The EOF switch parses a restricted token set 17947 000040'03 105 117 106 000 000 17948 000134'02 000000# 000001 %key2 , %silsw ;[229] Tells $input to shut up about matches 17949 000041'03 163 151 154 145 156 17950 000135'02 000000# 000002 %key2 , %timsw ;[229] In case we don't want to wait forever ... 17951 000043'03 164 151 155 145 157 17952 000132'02 000003 000003 %tbend ;[229] End of table 17953 17954 remark Lifted from k20par 17955 17956 ;N.B., have to use literals here or flddb. will choke. Maybe rewrite 17957 ; this to special case .cmtok, like fldtk.? 17958 17959 define token (c) < ;;[217] Define token 17960 ;;[217] All these literals, yuck... 17961 >;;token ;;[217] 17962 17963 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 17964 000136'02 023004 000141' tranft: flddb. .cmtok,,token(<>),,,tranf1 17965 000137'02 440700 003653' 17966 000140'02 44 07 0 00 003654' 17967 000141'02 023004 000144' tranf1: flddb. .cmtok,,token(<>),,,tranf2 17968 000142'02 440700 003665' 17969 000143'02 44 07 0 00 003666' K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 25-1 K20IOC MAC 25-Nov-23 20:18 TRANSMIT [file] parsing [165] 17970 000144'02 023004 000147' tranf2: flddb. .cmtok,,token(<$>),,,tranf3 17971 000145'02 440700 003674' 17972 000146'02 44 07 0 00 003675' 17973 000147'02 023005 000000 tranf3: flddb. .cmtok,cm%sdh,token(<>),,, 17974 000150'02 440700 003706' 17975 000151'02 44 07 0 00 003707' 17976 17977 000152'02 003000 000154' tranfs: flddb. .cmswi,,trnswi,,,tranfd ;[229] Maybe get a transmit switch 17978 000153'02 000000 000132' 17979 000154'02 006000 000156' tranfd: flddb. .cmfil,,,,,tranf4 17980 000155'02 000000 000000 17981 000156'02 016001 000000 tranf4: flddb. .cmdev,cm%sdh,,,, ;[229] Catch bare device 17982 000157'02 000000 000000 17983 17984 000160'02 015006 000000 timfdb: flddb. .cmflt,,^d10,,<10>, 17985 000161'02 000000 000012 17986 000162'02 44 07 0 00 003573' 17987 000163'02 44 07 0 00 003720' 17988 retsec ;;[229] Back to where-ever we started from 17989 remark ;;[229] Punt temporary symbols 17990 cleans() 17991 17992 001501'01 .trans: entry .trans ; Invoked from k20par 17993 001501'01 265 16 0 00 004155' saveac ; Protect some registers 17994 17995 001502'01 200 01 0 00 004171' movx t1, cz%ncl!.fhslf ; Release non-open JFN's on reparse 17996 001503'01 104 00 0 00 000034 CLZFF% 17997 001504'01 320 12 0 00 001505' erjmpr .+1 ; Catch and ignore errors 17998 17999 001505'01 200 01 0 00 004172' move t1, [trnbk,,cjfnbk] ; Insert our file parsing defaults. 18000 001506'01 251 01 0 00 000000# blt t1, cjfnbk+trnbkl 18001 18002 001507'01 201 11 0 00 000000# movei q5, tranfs ;[229] Doing a full complement of switches 18003 18004 001510'01 200 16 0 00 000000# .tran0: guide 18005 001511'01 260 17 0 00 001334* 18006 000164'02 000000000000# 18007 000415'04 146 151 154 145 040 18008 001512'01 .tran1: remark ;[229] Here when looping on switches 18009 001512'01 201 01 0 00 000011 movei t1, q5 ;[229] Look for switch, device or file 18010 001513'01 260 17 0 00 001336* call rfield ;[229] Ask them to type something 18011 001514'01 200 06 0 00 000002 move q2, t2 ;[229] Save whatever parsed data we got 18012 001515'01 135 05 0 00 004011' ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ;[229] Pick up function code 18013 001516'01 302 05 0 00 000003 caie q1, .cmswi ;[229] Did we get a switch? 18014 001517'01 254 00 0 00 001572' jrst .tran2 ;[229] No, just go handle the device or file 18015 001520'01 415 16 0 00 001564' block. ;[229] Enter block for better control flow 18016 001521'01 261 17 0 00 000016 18017 001522'01 550 07 0 06 000000 hrrz q3, (q2) ;[229] Pick up the switch value 18018 001523'01 302 07 0 00 000000 caie q3, %eofsw ;[229] Parsed the EOF switch? 18019 001524'01 254 00 0 00 001537' ifskp. ;[229] We did, so pick up its argument 18020 001525'01 201 01 0 00 000000# movei t1, tranft ;[229] Look for an EOF token 18021 001526'01 260 17 0 00 001513* call rfield ;[229] Ask them to type one of them 18022 001527'01 621 03 0 00 777777 tlz t3, -1 ;[229] Isolate fdb we actually used 18023 001530'01 200 02 0 03 000001 move t2, .cmdat(t3) ;[229] Pick up the byte pointer to the character 18024 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 20:02 27-Nov-23 Page 25-2 K20IOC MAC 25-Nov-23 20:18 TRANSMIT [file] parsing [165] 18025 001532'01 306 01 0 00 000044 cain t1, "$" ;[229] Our goofy escape synonym? 18026 001533'01 201 01 0 00 000033 movei t1, .chesc ;[229] Yes, transmogrify it 18027 001534'01 260 17 1 00 000000* call @parity ;[229] And put parity on it (if doing parity) 18028 001535'01 202 01 0 00 000000* movem t1, pars7 ;[229] Save EOF character 18029 001536'01 254 00 0 00 001433* retskp ;[229] Return for next switch 18030 001537'01 endif. ;[229] End EOF switch case 18031 001537'01 302 07 0 00 000001 caie q3, %silsw ;[229] Parsed the 'silent' switch? 18032 001540'01 254 00 0 00 001543' ifskp. ;[229] We did, so that should be easy enough 18033 001541'01 476 00 0 00 001062* setom pars8 ;[229] Just flag it in the parse block 18034 001542'01 254 00 0 00 001536* retskp ;[229] Return for next switch 18035 001543'01 endif. ;[229] End 'silent' switch case 18036 001543'01 302 07 0 00 000002 caie q3, %timsw ;[229] Wants a timeout? 18037 001544'01 254 00 0 00 001562' ifskp. ;[229] Give him a time out 18038 001545'01 201 01 0 00 000000# movei t1, timfdb ;[229] Look for a time out number (floating) 18039 001546'01 260 17 0 00 001526* call rfield ;[229] Ask them to type one it 18040 001547'01 325 02 0 00 001553' ifl. t2 ;[229] Is the number in the right range? 18041 001550'01 200 01 0 00 000000# emsg ;[229] Must be superluminal... 18042 001551'01 104 00 0 00 000313 18043 000165'02 000000000000# 18044 000422'04 101 040 156 145 147 18045 001552'01 254 00 0 00 000240* jrst cmder1 ;[229] Yet allow reparse 18046 001553'01 endif. ;[229] End initial sanity checking 18047 001553'01 260 17 0 00 000176* call chksec ;[229] Ensure number is in correct range 18048 001554'01 254 00 0 00 001557' ifskp. ;[229] Check and convert OK? Then side-effect variables 18049 001555'01 254 00 0 00 001542* retskp ;[229] And get out of the parse block. 18050 001556'01 254 00 0 00 001562' else. ;[229] Otherwise, couldn't swallow something 18051 001557'01 200 01 0 00 000000# emsg ;[229] 18052 001560'01 104 00 0 00 000313 18053 000166'02 000000000000# 18054 000431'04 123 160 145 143 151 18055 001561'01 254 00 0 00 001552* jrst cmder1 ;[229] Yet allow reparse 18056 001562'01 endif. ;[229] End case checking and conversion 18057 001562'01 endif. ;[229] End case timeout switch 18058 001562'01 263 17 0 00 000000 ret ;[229] Otherwise, some kind of bogus switch 18059 001563'01 263 17 0 00 000000 endbk. ;[229] End Block context 18060 001564'01 254 00 0 00 001567' ifskp. ;[229] Successful switch parse 18061 001565'01 254 00 0 00 001512' jrst .tran1 ;[229] Go see if more switches (or device or file) 18062 001566'01 254 00 0 00 001572' else. ;[229] Otherwise, some kind of error 18063 001567'01 200 01 0 00 000000# emsg ;[229] An internal programming error.. 18064 001570'01 104 00 0 00 000313 18065 000167'02 000000000000# 18066 000442'04 125 156 153 156 157 18067 001571'01 254 00 0 00 001561* jrst cmder1 ;[229] However, allow reparse 18068 001572'01 endif. ;[229] End of switch block processing 18069 18070 001572'01 200 01 0 00 000006 .tran2: move t1, q2 ;[229] Load parsed data for DVCHR% 18071 001573'01 302 05 0 00 000016 caie q1, .cmdev ; Typed a bare device? 18072 001574'01 621 01 0 00 777777 tlz t1, -1 ; Shut off flags so DVCHR% doesn't choke 18073 001575'01 104 00 0 00 000117 DVCHR% ; and find out about it 18074 001576'01 320 12 0 00 001600' %jserr (,r) 18075 001577'01 254 00 0 00 001603' 18076 001600'01 265 01 0 00 001446* 18077 001601'01 000000000000# 18078 001602'01 254 00 0 00 001430* 18079 000451'04 125 156 141 142 154 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 25-3 K20IOC MAC 25-Nov-23 20:18 TRANSMIT [file] parsing [165] 18080 001603'01 135 07 0 00 004173' ldb q3, [pointr t2, dv%typ] ; Pick up the device type 18081 18082 001604'01 302 05 0 00 000016 caie q1, .cmdev ; Typed a bare device? 18083 001605'01 254 00 0 00 001632' ifskp. ; Yes, see what it is 18084 001606'01 302 07 0 00 000015 caie q3, .dvnul ; NUL:? 18085 001607'01 254 00 0 00 001612' ifskp. ; Yes, we can simulate that 18086 001610'01 200 06 0 00 004174' movx q2, ;Use special designator and flags 18087 001611'01 254 00 0 00 001647' jrst .tran3 ;[229] Done with this special case 18088 001612'01 endif. ; Any other device is NOT VALID 18089 18090 001612'01 302 07 0 00 000000 caie q3, .dvdsk ; Bare device? 18091 001613'01 254 00 0 00 001631' ifskp. ; Yes, but needs a file name 18092 001614'01 200 01 0 00 000000# emsg ; First part of blat 18093 001615'01 104 00 0 00 000313 18094 000170'02 000000000000# 18095 000464'04 124 150 145 040 000 18096 001616'01 200 02 0 00 000006 move t2, q2 ; Load whatever we parsed 18097 001617'01 201 01 0 00 000101 movei t1, .priou ; Output to the terminal 18098 001620'01 104 00 0 00 000121 DEVST% ; Write the device name into the AC's 18099 001621'01 320 12 0 00 001623' %jserr (,cmder1) 18100 001622'01 254 00 0 00 001626' 18101 001623'01 265 01 0 00 001600* 18102 001624'01 000000000000# 18103 001625'01 254 00 0 00 001571* 18104 000465'04 125 156 141 142 154 18105 001626'01 200 01 0 00 000000# sxtext (t1,<: structure needs a file specification>) 18106 000171'02 000000000000# 18107 000476'04 072 040 163 164 162 18108 001627'01 104 00 0 00 000076 PSOUT% ; Finish the informative blat 18109 001630'01 254 00 0 00 001625* jrst cmder1 ; Allow reparse 18110 001631'01 endif. ; Any other device is NOT VALID 18111 18112 001631'01 254 00 0 00 001670' jrst .trane ; Otherwise, handle as a general parse error 18113 001632'01 endif. ; End case .cmdev 18114 18115 remark .cmfil ; Everything else is a file 18116 18117 001632'01 302 07 0 00 000015 caie q3, .dvnul ; A JFN on NUL:?? 18118 001633'01 254 00 0 00 001645' ifskp. ; Yes, let's fix that up 18119 001634'01 200 01 0 00 000006 move t1, q2 ; Load parsed JFN 18120 001635'01 260 17 0 00 000000* call isnulj ; Convert it to a special JFN, releasing original 18121 001636'01 334 01 0 00 000000# ermsg% (,cmder1) ; Allow ^H 18122 001637'01 254 00 0 00 001643' 18123 001640'01 202 01 0 00 001214* 18124 001641'01 104 00 0 00 000313 18125 001642'01 254 00 0 00 001630* 18126 000172'02 000000000000# 18127 000506'04 113 105 122 115 111 18128 18129 001643'01 200 06 0 00 000001 move q2, t1 ; Store the JFN and original parse flags 18130 001644'01 254 00 0 00 001647' jrst .tran3 ; Done with this second special NUL: (JFN) case 18131 001645'01 endif. 18132 18133 001645'01 302 07 0 00 000000 caie q3, .dvdsk ; Was this a structure? 18134 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 20:02 27-Nov-23 Page 25-4 K20IOC MAC 25-Nov-23 20:18 TRANSMIT [file] parsing [165] 18135 18136 18137 001647'01 .tran3: remark ;[229] Otherwise, parse is OK so far 18138 001647'01 403 01 0 00 000002 setzb t1, t2 ; Cons up a couple of nice .chnul's 18139 001650'01 124 01 0 00 001343* dmovem t1, atmbuf ; Stomp the atom buffer 18140 18141 001651'01 260 17 0 00 000211' call .inpu1 ; Get the search string 18142 001652'01 302 05 0 00 000010 caie q1, .cmcfm ; Defaulted search? 18143 001653'01 254 00 0 00 001665' ifskp. ; Yes, maybe fix up for TRANSMIT defaults 18144 001654'01 333 00 0 00 000000# skiple indefw ; Had we set a default search string? 18145 001655'01 254 00 0 00 001665' anskp. ; We did, so we're done 18146 remark ; Otherwise, supply another appropriate default. 18147 001656'01 336 01 0 00 000000* skipn t1, handsh ; Handshaking? 18148 001657'01 201 01 0 00 000012 movei t1, .chlfd ; No, then use linefeed. 18149 001660'01 241 01 0 00 777771 rot t1, -^d7 ; Turn into an ASCIZ word 18150 001661'01 202 01 0 00 001265* movem t1, strbuf ; Stomp the string buffer 18151 001662'01 201 02 0 00 000001 movei t2, ^d1 ; Single character long 18152 001663'01 200 03 0 00 004026' move t3, [point 7, strbuf] ; Pointer to buffer 18153 001664'01 124 02 0 00 001263* dmovem t2, strc ; Stomp into search string parameters 18154 001665'01 endif. ; Carry on 18155 18156 001665'01 202 06 0 00 000065* movem q2, pars2 ; Store the JFN and flags 18157 001666'01 476 00 0 00 000423* setom pars6 ;[209] Override the ^C handling 18158 18159 001667'01 263 17 0 00 000000 ret ; Done with the parse 18160 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 26 K20IOC MAC 25-Nov-23 20:18 TRANSMIT [file] parsing [165] 18161 remark Here for common parse errors 18162 18163 001670'01 200 01 0 00 000000# .trane: emsg ; Begin whining 18164 001671'01 104 00 0 00 000313 18165 000173'02 000000000000# 18166 000520'04 124 150 145 040 000 18167 001672'01 201 01 0 00 000101 movei t1, .priou ; Output to terminal, always 18168 18169 remark ; N.B., JFNS% will choke on a device 18170 001673'01 302 05 0 00 000016 caie q1, .cmdev ; Device? 18171 001674'01 254 00 0 00 001705' ifskp. ; Yes, use DEVST% 18172 001675'01 200 02 0 00 000006 move t2, q2 ; Load whatever we parsed 18173 001676'01 104 00 0 00 000121 DEVST% ; Write the device name into the AC's 18174 001677'01 320 12 0 00 001701' %jserr (,cmder1) 18175 001700'01 254 00 0 00 001704' 18176 001701'01 265 01 0 00 001623* 18177 001702'01 000000000000# 18178 001703'01 254 00 0 00 001642* 18179 000521'04 125 156 141 142 154 18180 001704'01 254 00 0 00 001715' else. ; Otherwise, DEVST% will choke on the JFN 18181 001705'01 550 02 0 00 000006 hrrz t2, q2 ; Load just the JFN 18182 dmove t3, [ ; Just want the device name, no punctuation 18183 fld(.jsaof,js%dev) 18184 001706'01 120 03 0 00 004175' 0 ] ; No odd prefix, whatever that is 18185 001707'01 104 00 0 00 000030 JFNS% ; Convert to something readable 18186 001710'01 320 12 0 00 001712' %jserr (,cmder1) 18187 001711'01 254 00 0 00 001715' 18188 001712'01 265 01 0 00 001701* 18189 001713'01 000000000000# 18190 001714'01 254 00 0 00 001703* 18191 000531'04 125 156 141 142 154 18192 001715'01 endif. ; Either way, error should be more informative 18193 18194 001715'01 200 01 0 00 000000# txmsg <: device is not valid for TRANSMIT or CAPTURE> 18195 001716'01 104 00 0 00 000076 18196 001717'01 320 12 0 00 001720' 18197 000174'02 000000000000# 18198 000543'04 072 040 144 145 166 18199 001720'01 561 01 0 00 000406* hrroi t1, crlf ; Newline 18200 001721'01 104 00 0 00 000076 PSOUT% ; Tie off the blat 18201 001722'01 320 12 0 00 001723' erjmpr .+1 ; Catch and ignore that error, too 18202 18203 001723'01 302 05 0 00 000006 caie q1, .cmfil ; Had we parsed a file, actually? 18204 001724'01 254 00 0 00 001730' ifskp. ; Yes, then have a little clean up to do 18205 001725'01 550 01 0 00 000006 hrrz t1, q2 ; Load our poor JFN, sans flags 18206 001726'01 104 00 0 00 000023 RLJFN% ; Toss it; can't use it 18207 001727'01 320 12 0 00 001714* erjmpr cmder1 ; Ignore error and beat it 18208 001730'01 endif. 18209 18210 001730'01 254 00 0 00 001727* jrst cmder1 ; Allow ^H 18211 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 27 K20IOC MAC 25-Nov-23 20:18 TRANSMIT command execution. 18212 subttl TRANSMIT command execution. 18213 18214 ; To do: Instead of repeated SIN%'s, how about a moby-PMAP% and MOVST? 18215 18216 001731'01 $trans: entry $trans ; Called by k20par 18217 extern mycaps ;[223] Expose capability vector 18218 001731'01 265 16 0 00 004155' saveac ;[209] Needs much registers 18219 18220 001732'01 550 01 0 00 001665* hrrz t1, pars2 ;[209] First make sure we can open the file. 18221 001733'01 202 01 0 00 000000* movem t1, filjfn ;[209] Store in case we need to release 18222 001734'01 302 01 0 00 377777 caie t1, .nulio ;[209] Don't need to open .nulio 18223 001735'01 254 00 0 00 001741' ifskp. ;[229] But give it some fake data 18224 001736'01 403 01 0 00 000002 setzb t1, t2 ;[229] It will have a zero bytes and pages 18225 001737'01 124 01 0 00 000000# dmovem t1, fsized ;[229] Store in file size double word 18226 001740'01 254 00 0 00 002011' else. ;[209] Otherwise must open it 18227 001741'01 104 00 0 00 000036 SIZEF% ;[229] Find out how large the file is 18228 001742'01 320 12 0 00 001744' ifje. r ;[229] Failed?? 18229 001743'01 254 00 0 00 001756' 18230 001744'01 200 04 0 00 000001 move t4, t1 ;[229] Save error for debuggers 18231 001745'01 334 00 0 00 000000 %ermsg (,) ;[229] 18232 001746'01 254 00 0 00 001752' 18233 001747'01 265 01 0 00 001712* 18234 001750'01 000000000000# 18235 001751'01 254 00 0 00 001752' 18236 000555'04 125 156 141 142 154 18237 001752'01 403 02 0 00 000003 setzb t2, t3 ;[229] Cons up a set of zeros 18238 001753'01 124 02 0 00 000000# dmovem t2, fsized ;[229] Store in file size double word 18239 001754'01 200 01 0 00 001733* move t1, filjfn ;[229] Reload the JFN and hope for the best 18240 001755'01 254 00 0 00 001757' else. ;[229] Otherwise, worked!!!! 18241 001756'01 124 02 0 00 000000# dmovem t2, fsized ;[229] So store results in file size double word 18242 001757'01 endif. ;[229] End case JSYS handling 18243 dmove t2, [1,,.fbbyv ;[229] Let's have a look at the byte size 18244 001757'01 120 02 0 00 004177' t4 ] ;[229] Tuck it into t4 18245 001760'01 104 00 0 00 000063 GTFDB% ;[229] Try to pull from file descriptor block 18246 001761'01 320 12 0 00 001763' ifje. r ;[229] Failed?? 18247 001762'01 254 00 0 00 001767' 18248 001763'01 200 04 0 00 000001 move t4, t1 ;[229] Save the error for debuggers 18249 001764'01 201 03 0 00 000007 movei t3, ^d7 ;[229] Ignore it and pretend ASCII 18250 001765'01 550 01 0 00 001732* hrrz t1, pars2 ;[229] Reload JFN for OPENF% attempt 18251 001766'01 254 00 0 00 001770' else. ;[229] Otherwise, worked 18252 001767'01 135 03 0 00 004201' ldb t3,[ pointr(t4,fb%bsz) ] ;[229] Extract byte size from packed field 18253 001770'01 endif. ;[229] End case JSYS handling 18254 001770'01 200 02 0 00 004202' movx t2, fld(7,of%bsz)!of%rd ; Assume 7-bit (also handles 36 bit PA1050) 18255 001771'01 306 03 0 00 000010 cain t3, ^d8 ;[229] Is our assumption incorrect? 18256 001772'01 200 02 0 00 004203' movx t2, fld(8,of%bsz)!of%rd ;[223] Fine, it's eight bit 18257 001773'01 104 00 0 00 000021 OPENF% 18258 001774'01 320 12 0 00 001776' ifje. r ;[209] Failed?? 18259 001775'01 254 00 0 00 002011' 18260 001776'01 200 04 0 00 000001 move t4, t1 ;[209] Save error code for debugging 18261 001777'01 334 00 0 00 000000 %ermsg (,) ;[209] Squawk and continue 18262 002000'01 254 00 0 00 002004' 18263 002001'01 265 01 0 00 001747* 18264 002002'01 000000000000# 18265 002003'01 254 00 0 00 002004' 18266 000567'04 125 156 141 142 154 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 27-1 K20IOC MAC 25-Nov-23 20:18 TRANSMIT command execution. 18267 002004'01 402 00 0 00 001754* setzm filjfn ;[209] Stomp JFN global storage 18268 002005'01 550 01 0 00 001765* hrrz t1, pars2 ;[209] Reload the JFN 18269 002006'01 260 17 0 00 000000* call frclos ;[209] Force it closed 18270 002007'01 600 00 0 00 000000 nop ;[209] Ignore error and carry on 18271 002010'01 263 17 0 00 000000 ret ;[209] And return; we can't do anything else 18272 002011'01 endif. ;[209] End case OPENF% JSYS error handling 18273 002011'01 endif. ;[209] End case .nulio OPENF% decision 18274 18275 remark ;[209] .trans gets and decodes a prompt (search) string 18276 18277 002011'01 400 11 0 00 000000 $tran1: setz q5, ;[209] Assume not in a batch job that needs fixup 18278 002012'01 336 00 0 00 001664* skipn strc ;[209] Of couse, don't bother if no search string... 18279 002013'01 254 00 0 00 002056' jrst $tran2 ;[209] There won't be anything to fix up 18280 002014'01 332 00 0 00 001541* skipe pars8 ;[229] Nor if we were told to shut up 18281 002015'01 254 00 0 00 002056' jrst $tran2 ;[229] User typed a /SILENT 18282 002016'01 336 00 0 00 000000# skipn ;[209] Now then, are we a batch job? 18283 002017'01 254 00 0 00 002056' jrst $tran2 ;[209] No, so we don't care about BATCON confusion 18284 ;[209] Otherwise, REALLY long lines are bad ... 18285 002020'01 120 01 0 00 002012* dmove t1, strc ;[209] Load the search string count and pointer 18286 002021'01 415 16 0 00 002054' block. ;[209] Enter block context for better control flow 18287 002022'01 261 17 0 00 000016 18288 002023'01 306 01 0 00 000001 cain t1, ^d1 ;[209] A single character?? 18289 002024'01 254 00 0 00 001555* retskp ;[209] Whatever it is, it needs to get tied off 18290 ;[209] A tiny hack: ibp is faster than adjbp 18291 002025'01 302 01 0 00 000003 caie t1, ^d3 ;[209] Is it EXACTLY three characters in length? 18292 002026'01 254 00 0 00 002031' ifskp. ;[209] It is, so handle this more efficiently 18293 002027'01 133 00 0 00 000002 ibp t2 ;[209] Positions us to the first byte 18294 002030'01 275 01 0 00 000001 subi t1, ^d1 ;[209] So ildb in case two works right 18295 002031'01 endif. ;[209] Fall through to case two 18296 18297 002031'01 302 01 0 00 000002 caie t1, ^d2 ;[209] A two character sequence, then? 18298 002032'01 254 00 0 00 002042' ifskp. ;[209] Yes, let's see if that's OK 18299 002033'01 134 03 0 00 000002 ildb t3, t2 ;[209] Let's get the first character 18300 002034'01 302 03 0 00 000015 caie t3, .chcrt ;[209] Carriage return? 18301 002035'01 254 00 0 00 002024* retskp ;[209] Nope, then batch output needs a 18302 002036'01 134 03 0 00 000002 ildb t3, t2 ;[209] Let's get the second character 18303 002037'01 302 03 0 00 000012 caie t3, .chlfd ;[209] And was that a linefeed? 18304 002040'01 254 00 0 00 002035* retskp ;[209] Nope, then batch output needs a 18305 002041'01 263 17 0 00 000000 ret ;[209] ! Batch log will be tidy 18306 002042'01 endif. ;[209] End case, a search string of two characters 18307 ;[209] Note: ldb, ildb is faster than ildb, ildb 18308 002042'01 275 01 0 00 000001 subi t1, ^d1 ;[209] Going to look at the last two characters (!!) 18309 002043'01 133 01 0 00 000002 adjbp t1, t2 ;[209] Position right on the penultimate 18310 002044'01 135 03 0 00 000001 ldb t3, t1 ;[209] Let's get the penultimate character 18311 002045'01 302 03 0 00 000015 caie t3, .chcrt ;[209] Carriage return? 18312 002046'01 254 00 0 00 002040* retskp ;[209] Nope, then batch output needs a 18313 002047'01 134 03 0 00 000001 ildb t3, t1 ;[209] Let's get the final character 18314 002050'01 302 03 0 00 000012 caie t3, .chlfd ;[209] And was that a linefeed? 18315 002051'01 254 00 0 00 002046* retskp ;[209] Nope, then batch output needs a 18316 002052'01 263 17 0 00 000000 ret ;[209] Final two are ! Batch log will be tidy 18317 002053'01 263 17 0 00 000000 endbk. ;[209] End block context 18318 002054'01 254 00 0 00 002056' ifskp. ;[209] Skip return means needs a 18319 002055'01 474 11 0 00 000000 seto q5, ;[209] So flag that for down stream 18320 002056'01 endif. ;[209] End block skip stanza 18321 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 27-2 K20IOC MAC 25-Nov-23 20:18 TRANSMIT command execution. 18322 002056'01 260 17 0 00 000000* $tran2: call clrbuf ;[229] Clear out any crud before searching 18323 002057'01 254 00 0 00 002300' jrst $tranx ;[229] If failed, just stop doing this 18324 002060'01 337 02 0 00 000420* skipg t2, pars4 ;[229] Integer milliseconds 18325 002061'01 254 00 0 00 002064' ifskp. ;[229] Wants time outs, so set them 18326 002062'01 201 01 0 00 002357' movei t1, $trant ;[229] Where to go die on a time out 18327 002063'01 260 17 0 00 000261* call timeon ;[229] Set the timer for it 18328 002064'01 endif. ;[229] 18329 002064'01 260 17 0 00 000264* call ccon ; Turn on ^C trap 18330 002065'01 254 00 0 00 002300' jrst $tranx ; Where to go upon ^C. 18331 002066'01 332 00 0 00 000414* ifme. vtermf ;[186] Calls only make sense if not virtual 18332 002067'01 254 00 0 00 002074' 18333 002070'01 260 17 0 00 000000* call doarpa ;[186] If on a TVT, set up to allow binary 18334 002071'01 260 17 0 00 000272* call dobits ; Condition the line. 18335 002072'01 254 00 0 00 002300' jrst $tranx 18336 002073'01 260 17 0 00 000274* call ttyob ; Let controlling tty output binary. 18337 002074'01 endif. ;[186] Otherwise, MTOPR%'s might break! 18338 002074'01 201 01 0 00 002125' movei t1, $tran3 ; Where to go if ^M typed (send next) 18339 002075'01 202 01 0 00 000000* movem t1, cmloc ; ... 18340 002076'01 201 01 0 00 002163' movei t1, $tran4 ; Where to go if ^P typed (resend previous) 18341 002077'01 202 01 0 00 000000* movem t1, cploc ; ... 18342 002100'01 260 17 0 00 000000* call cmpon ; Enable interrupts on ^M, ^P. 18343 txmsg < 18344 002101'01 200 01 0 00 000000# [KERMIT-20: Transmitting > ; Tell user we're starting. 18345 002102'01 104 00 0 00 000076 18346 002103'01 320 12 0 00 002104' 18347 000175'02 000000000000# 18348 000575'04 015 012 133 113 105 18349 002104'01 201 01 0 00 000101 movei t1, .priou 18350 002105'01 200 02 0 00 002004* move t2, filjfn 18351 002106'01 403 03 0 00 000004 setzb t3, t4 ;[209] No screwy prefix... 18352 002107'01 104 00 0 00 000030 JFNS 18353 002110'01 320 12 0 00 002111' erjmpr .+1 18354 txmsg < 18355 If stuck, type: 18356 Carriage Return to send next line, 18357 ^P to resend current line, 18358 002111'01 200 01 0 00 000000# > ;[187] 18359 002112'01 104 00 0 00 000076 18360 002113'01 320 12 0 00 002114' 18361 000176'02 000000000000# 18362 000603'04 015 012 040 111 146 18363 18364 18365 18366 dmove t3, [ byte (7) .chspc, "^", "C", "^", "C" 18367 002114'01 120 03 0 00 004204' byte (7) .chspc, .chnul ] ;[187] Assume default 18368 002115'01 200 02 0 00 000000# move t2, mycaps+1 ;[187] Load enabled capabilities 18369 002116'01 607 02 0 00 400000 txnn t2, sc%ctc ;[187] Is Control-C turned on?? 18370 dmove t3, [ byte (7) .chspc, "^", "G", "^", "G" 18371 002117'01 120 03 0 00 004206' byte (7) .chspc, .chnul ] ;[187] Wasn't... 18372 002120'01 561 01 0 00 000003 hrroi t1, t3 ;[187] Point to proper text 18373 002121'01 104 00 0 00 000076 PSOUT% ;[187] Tell them what to type 18374 txmsg 18376 002123'01 104 00 0 00 000076 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 27-3 K20IOC MAC 25-Nov-23 20:18 TRANSMIT command execution. 18377 002124'01 320 12 0 00 002125' 18378 000177'02 000000000000# 18379 000625'04 164 157 040 143 141 18380 18381 ;... K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 28 K20IOC MAC 25-Nov-23 20:18 TRANSMIT command execution. 18382 18383 ; Get a line from the file. 18384 18385 002125'01 336 00 0 00 000000* $tran3: ifmn. cmseen ;[194] ^M typed? 18386 002126'01 254 00 0 00 002133' 18387 txmsg < Sending next...] 18388 002127'01 200 01 0 00 000000# > ; Yes, type msg 18389 002130'01 104 00 0 00 000076 18390 002131'01 320 12 0 00 002132' 18391 000200'02 000000000000# 18392 000633'04 040 123 145 156 144 18393 18394 002132'01 402 00 0 00 002125* setzm cmseen ; and unset flag. 18395 002133'01 endif. ;[194] 18396 18397 002133'01 200 01 0 00 002105* move t1, filjfn ; Input file pointer 18398 remark t2, *MAGIC* ;[229] N.B., Below converts 7 to 8 bit! 18399 002134'01 200 02 0 00 004210' move t2, [point 8, strbf2] ; Where to put the line 18400 dmove t3, [ strblc ;[209] Maximum characters to read, 18401 002135'01 120 03 0 00 004211' .chlfd ] ;[209] but preferably terminate on linefeed. 18402 002136'01 104 00 0 00 000052 SIN 18403 002137'01 320 12 0 00 002141' ifje. r. ;[194] Catch last error in t1 18404 002140'01 254 00 0 00 002152' 18405 002141'01 550 02 0 00 000001 hrrz t2,t1 ; Erase fork handle from left half. 18406 002142'01 302 02 0 00 600220 caie t2, iox4 ; Was error EOF? 18407 002143'01 334 00 0 00 000000 %ermsg (,$tranx) ; No, give message. 18408 002144'01 254 00 0 00 002150' 18409 002145'01 265 01 0 00 002001* 18410 002146'01 000000 000000 18411 002147'01 254 00 0 00 002300' 18412 002150'01 260 17 0 00 002401' call tranot ;[229] Notify us of transmit completion 18413 002151'01 254 00 0 00 002300' jrst $tranx ; But either way, we are done 18414 002152'01 endif. ;[194] 18415 18416 002152'01 323 03 0 00 002156' ifg. t3 ;[209] Did we hit the linefeed? 18417 002153'01 201 10 0 00 005000 movei q4, strblc ;[209] Yes, so need to do post calculations 18418 002154'01 274 10 0 00 000003 sub q4, t3 ;[209] Calculate amount done 18419 002155'01 254 00 0 00 002157' else. ;[209] Otherwise, don't need to do any math 18420 002156'01 201 10 0 00 005000 movei q4, strblc ;[209] Put in maximum length 18421 002157'01 endif. ;[209] 18422 18423 ; N.B., This code appears to assume a particular kind of Tops-20 18424 ; formatted text file in other words, the STANDARD kind that is 18425 ; used on *ALL* DEC operating systems and in many cases on DOS, 18426 ; OS/2 and Windows. That is, a series of variable length lines 18427 ; terminated by a carriage return and a line feed. 18428 ; 18429 ; However, if you have a Unix or Multics 18430 ; format file with bare linefeed, then this code does the wrong 18431 ; thing because it will strip them all out, giving one big long 18432 ; line. It may also do the wrong thing for consecutive linefeeds. 18433 ; This is very old behavior. 18434 ; 18435 ; If this is in fact a bug or misfeature, then the fix is 18436 ; straightforward in concept (yet not in implementation). We'd K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 28-1 K20IOC MAC 25-Nov-23 20:18 TRANSMIT command execution. 18437 ; need to PMAP% the file and then use a MOVST to trigger on a 18438 ; carriage return and check after it for a linefeed. If the 18439 ; linefeed existed, then we'd strip it, otherwise, this would be a 18440 ; case of overprinting, which still might work right. Bare 18441 ; linefeed's would be left alone. 18442 ; 18443 ; Leave alone for now until better understand the reason for 18444 ; swallowing trailing linefeeds. 18445 ; 18446 ; Changed to shorten the string length because we don't send NUL 18447 ; terminated strings, but rather counted ones. 18448 18449 repeat 0, < ;[229] Previous vestigial code 18450 ldb t1, t2 ;[209] Pick up the last character 18451 caie t1, .chlfd ;[209] Was it a LF? 18452 ibp t2 ;[209] No, so don't overwrite it. 18453 setz t1, ;[209] Deposit a null, overwriting 18454 call @parity ;[223] Put parity on this last dinky character 18455 dpb t1, t2 ; last char if it was a LF. 18456 > ;[229] 18457 18458 002157'01 135 01 0 00 000002 ldb t1, t2 ;[229] Pick up the final character 18459 002160'01 302 01 0 00 000012 caie t1, .chlfd ;[229] Was it a linefeed? 18460 002161'01 254 00 0 00 002163' ifskp. ;[229] It is, so don't send it 18461 002162'01 363 10 0 00 002125' sojle q4, $tran3 ;[229] Decrement the count and skip if nothing left 18462 002163'01 endif. ;[229] Still, positive, so something to do K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 29 K20IOC MAC 25-Nov-23 20:18 TRANSMIT command execution. 18463 18464 ; TRANSMIT, cont'd... Echo the string if necessary. 18465 18466 002163'01 336 00 0 00 000000* $tran4: ifmn. cpseen ;[194] ^P typed? 18467 002164'01 254 00 0 00 002171' 18468 txmsg < - Resending... 18469 002165'01 200 01 0 00 000000# > ; Yes, type msg 18470 002166'01 104 00 0 00 000076 18471 002167'01 320 12 0 00 002170' 18472 000201'02 000000000000# 18473 000637'04 040 055 040 122 145 18474 18475 002170'01 402 00 0 00 002163* setzm cpseen ; and unset flag. 18476 002171'01 endif. ;[194] 18477 18478 002171'01 $tran5: remark ;[223] Tack on desired parity, in place (if desired) 18479 002171'01 200 01 0 00 001534* move t1, parity ;[223] Pick up the parity 18480 002172'01 306 01 0 00 003452' cain t1, none ;[223] Doing any parity anyway? 18481 002173'01 254 00 0 00 002177' ifskp. ;[223] We are, so do some parity already ... 18482 002174'01 200 02 0 00 004210' move t2, [point 8, strbf2] ; Point to the string. 18483 002175'01 210 03 0 00 000010 movn t3, q4 ;[223] Load negative for SOUTR% 18484 002176'01 260 17 0 00 003655' call putpar ;[223] Stomp some parity into it 18485 002177'01 endif. ;[223] End case handling parity 18486 18487 002177'01 336 00 0 00 001455* skipn duplex ; Half duplex? 18488 002200'01 254 00 0 00 002206' jrst $tran6 ;[223] No. 18489 002201'01 200 01 0 00 004210' move t1, [point 8, strbf2] ; Point to the string. 18490 002202'01 104 00 0 00 000076 PSOUT ; Yes, display it at the tty. 18491 002203'01 201 01 0 00 000012 movei t1, .chlfd ; Also need to add linefeed. 18492 002204'01 260 17 1 00 002171* call @parity ; And any necessary parity 18493 002205'01 104 00 0 00 000074 PBOUT 18494 18495 002206'01 $tran6: remark ;[223] Finally send the string 18496 002206'01 337 01 0 00 001374* skipg t1, netjfn ;[186] ... out the communication line. 18497 002207'01 200 01 0 00 001375* move t1, ttyjfn ;[186] using local terminal 18498 002210'01 200 02 0 00 004210' move t2, [point 8, strbf2] 18499 002211'01 210 03 0 00 000010 movn t3, q4 ;[223] Load count 18500 18501 002212'01 336 00 0 00 001413* ifmn. tvtflg ;[247] TVT-Binary? 18502 002213'01 254 00 0 00 002244' 18503 002214'01 415 16 0 00 002233' block. ;[247] Yes, let's see if we need any quoting 18504 002215'01 261 17 0 00 000016 18505 002216'01 265 16 0 00 004144' saveac ;[247] Save output designator, want an accumulator 18506 002217'01 200 07 0 00 004154' move q3, [point 8, tvtbuf] ;[247] Special buffer for IAC doubling 18507 002220'01 200 01 0 00 000010 move t1, q4 ;[247] Positive length 18508 002221'01 200 03 0 00 000007 move t3, q3 ;[247] Load output area 18509 002222'01 260 17 0 00 001423* call iaciac ;[247] Go double any IAC's 18510 002223'01 334 00 0 00 000000 %ermsg (,r) ;;[247] 18511 002224'01 254 00 0 00 002230' 18512 002225'01 265 01 0 00 002145* 18513 002226'01 000000000000# 18514 002227'01 254 00 0 00 001602* 18515 000643'04 117 125 124 120 125 18516 002230'01 200 10 0 00 000004 move q4, t4 ;[247] Store updated length 18517 002231'01 200 02 0 00 000007 move t2, q3 ;[247] New output buffer K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 29-1 K20IOC MAC 25-Nov-23 20:18 TRANSMIT command execution. 18518 002232'01 263 17 0 00 000000 endbk. ;[247] End of block context 18519 002233'01 254 00 0 00 002237' ifskp. ;[247] Success 18520 002234'01 210 03 0 00 000010 movn t3, q4 ;[247] New length 18521 002235'01 400 04 0 00 000000 setz t4, ;[247] Just in case still NUL terminated (isn't) 18522 002236'01 254 00 0 00 002244' else. ;[247] Otherwise, failed somehow 18523 002237'01 334 00 0 00 000000 %ermsg (,r) 18524 002240'01 254 00 0 00 002244' 18525 002241'01 265 01 0 00 002225* 18526 002242'01 000000000000# 18527 002243'01 254 00 0 00 002227* 18528 000651'04 125 156 141 142 154 18529 002244'01 endif. ;[247] End case iaciac return handling 18530 002244'01 endif. ;[247] End TVT-binary handling 18531 18532 002244'01 332 00 0 00 002066* ifme. vtermf ;[186] Not a virtual terminal? 18533 002245'01 254 00 0 00 002255' 18534 002246'01 104 00 0 00 000053 SOUT ;[186] Isn't, so olde reliable is fine 18535 002247'01 320 12 0 00 002251' %jserr (,$tranx) 18536 002250'01 254 00 0 00 002254' 18537 002251'01 265 01 0 00 002241* 18538 002252'01 000000 000000 18539 002253'01 254 00 0 00 002300' 18540 002254'01 254 00 0 00 002264' else. ;[186] Otherwise, have to get out and push 18541 002255'01 350 00 0 00 001451* aos vsoct ;[209] Count a SOUTR% done 18542 002256'01 104 00 0 00 000532 SOUTR% ;[186] 18543 002257'01 320 12 0 00 002261' %jserr (,$tranx) ;[186] 18544 002260'01 254 00 0 00 002264' 18545 002261'01 265 01 0 00 002251* 18546 002262'01 000000 000000 18547 002263'01 254 00 0 00 002300' 18548 002264'01 endif. ;[186] 18549 18550 002264'01 336 00 0 00 002244* ifmn. vtermf ;[209] Only update virtual terminal totals 18551 002265'01 254 00 0 00 002271' 18552 002266'01 272 10 0 00 001452* addm q4, vsotc ;[204] Update tally of SOUTR% bytes 18553 002267'01 313 10 0 00 001454* camle q4, vsomx ;[204] Length than or equal to the maximum seen? 18554 002270'01 202 10 0 00 002267* movem q4, vsomx ;[204] Nope, we have a new maximum! 18555 002271'01 endif. ;[209] 18556 18557 ;[209] Now look for the prompt. Note that everything is echo'ed because 18558 ; this is what Kermit-20 has always done. However, since CAPTURE doesn't 18559 ; echo anything (for performance purposes), all we should see here is 18560 ; the prompt. Or an error... 18561 18562 002271'01 336 00 0 00 002020* $tran7: skipn strc ;[229] But!! Are we doing any recognition, anyway? 18563 002272'01 254 00 0 00 002125' jrst $tran3 ;[229] No, so just go on blatting 18564 002273'01 260 17 0 00 000254' call $input ;[209] Let $INPUT drive the bus now 18565 002274'01 322 11 0 00 002277' ifn. q5 ;[209] Batch log needs to get tied off? 18566 002275'01 561 01 0 00 001720* hrroi t1, crlf ;[209] Yes, so load that 18567 002276'01 104 00 0 00 000076 PSOUT% ;[209] and type it 18568 002277'01 endif. ;[209] End batch log line tie off 18569 002277'01 254 00 0 00 002125' jrst $tran3 ;[209] Returns on the prompt 18570 18571 ; Done, call terminal restore routines in reverse order. 18572 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 29-2 K20IOC MAC 25-Nov-23 20:18 TRANSMIT command execution. 18573 002300'01 260 17 0 00 000000* $tranx: call cmpoff ; ^M, ^P interrupts off. 18574 002301'01 260 17 0 00 000413* call ccoff2 ; ^C trap off. 18575 002302'01 336 01 0 00 001535* skipn t1, pars7 ;[229] Did we have an EOF character? 18576 002303'01 254 00 0 00 002337' ifskp. ;[229] We did, let's get it sent 18577 002304'01 241 01 0 00 777770 rot t1, -^d8 ;[229] Turn into an 8 bit ASCIZ string (heh) 18578 002305'01 200 05 0 00 000001 move q1, t1 ;[229] And get it out of SOUTR%'s way 18579 002306'01 201 01 0 00 000015 movei t1, .chcrt ;[229] Load a carriage return 18580 002307'01 260 17 1 00 002204* call @parity ;[229] Put parity on that (if doing parity) 18581 002310'01 241 01 0 00 777760 rot t1, -^d16 ;[229] Turn into 2nd byte of 8 bit ASCIZ string 18582 002311'01 434 05 0 00 000001 or q1, t1 ;[229] 'append' it (heh) 18583 002312'01 337 01 0 00 002206* skipg t1, netjfn ;[229] Will go out the network 18584 002313'01 200 01 0 00 002207* move t1, ttyjfn ;[229] or using the local terminal 18585 dmove t2, [ ;[229] Set up for SOUTR% 18586 point 8, q1 ;[229] Output string is in q1 18587 002314'01 120 02 0 00 004213' -2 ] ;[229] Just two dinky characters 18588 002315'01 400 04 0 00 000000 setz t4, ;[229] Should be ignored, but just in case 18589 002316'01 332 00 0 00 002264* ifme. vtermf ;[229] Going to a real terminal? 18590 002317'01 254 00 0 00 002331' 18591 002320'01 104 00 0 00 000053 SOUT% ;[229] Yes, so counted SOUT% will be fine 18592 002321'01 320 12 0 00 002323' %jserr (,) ;[229] Complain and carry on 18593 002322'01 254 00 0 00 002326' 18594 002323'01 265 01 0 00 002261* 18595 002324'01 000000 000000 18596 002325'01 254 00 0 00 002326' 18597 002326'01 260 17 0 00 000417* call ttyou ; Restore controlling tty. 18598 002327'01 260 17 0 00 000416* call unbits ; Put line back to previous state. 18599 002330'01 254 00 0 00 002337' else. ;[229] Otherwise, needs a 'push' 18600 002331'01 104 00 0 00 000532 SOUTR% ;[229] Counted string is faster 18601 002332'01 320 12 0 00 002334' %jserr (,) ;[229] Complain and carry on 18602 002333'01 254 00 0 00 002337' 18603 002334'01 265 01 0 00 002323* 18604 002335'01 000000 000000 18605 002336'01 254 00 0 00 002337' 18606 002337'01 endif. ;[229] End case appropriate output selection 18607 002337'01 endif. ;[229] End case sending the EOF 18608 18609 002337'01 260 17 0 00 002056* call clrbuf ; Flush any junk they may have typed 18610 002340'01 600 00 0 00 000000 nop ;[186] Ignore any complaints 18611 002341'01 332 00 0 00 002316* ifme. vtermf ;[186] Calls only make sense if not virtual 18612 002342'01 254 00 0 00 002345' 18613 002343'01 260 17 0 00 002326* call ttyou ; Restore controlling tty. 18614 002344'01 260 17 0 00 002327* call unbits ; Put line back to previous state. 18615 002345'01 endif. ;[186] Otherwise, MTOPR%'s might break! 18616 18617 002345'01 337 01 0 00 002133* skipg t1, filjfn ;[193] Close the file. 18618 002346'01 254 00 0 00 002354' ifskp. ;[193] If there was any 18619 002347'01 306 01 0 00 377777 cain t1, .nulio ;[193] Unless special NUL: 18620 002350'01 254 00 0 00 002354' anskp. ;[193] Which needs no releasing 18621 002351'01 621 01 0 00 777777 tlz t1, -1 ;[193] Turn off any bogus flags 18622 002352'01 260 17 0 00 002006* call frclos ;[209] Force the JFN to close 18623 002353'01 600 00 0 00 000000 nop ;[209] Ignore any errors 18624 002354'01 endif. ;[193] End case closing a real JFN 18625 002354'01 402 00 0 00 002345* setzm filjfn ; Zero the JFN holder. 18626 002355'01 260 17 0 00 000425' call $inpcl ;[229] Clean up $input's buffer 18627 002356'01 263 17 0 00 000000 ret K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 29-3 K20IOC MAC 25-Nov-23 20:18 TRANSMIT command execution. 18628 18629 002357'01 $trant: remark ;[229] Here on a time out 18630 002357'01 333 04 0 00 002271* skiple t4, strc ;[229] No search string, then? 18631 002360'01 254 00 0 00 002364' ifskp. ;[229] Nope, just generic complaint 18632 002361'01 200 01 0 00 000000# emsg ;[229] Suitably vague.. 18633 002362'01 104 00 0 00 000313 18634 000202'02 000000000000# 18635 000662'04 124 162 141 156 163 18636 002363'01 254 00 0 00 002376' else. ;[229] Otherwise, provide a more helpful message 18637 002364'01 200 01 0 00 000000# emsg ;[229] Begin whining 18638 002365'01 104 00 0 00 000313 18639 000203'02 000000000000# 18640 000666'04 124 162 141 156 163 18641 dmove t1, [ .priou ;[229] continue typing on terminal 18642 002366'01 120 01 0 00 004215' point 7,strbuf ] ;[229] Point to search string 18643 002367'01 210 03 0 00 000004 movn t3, t4 ;[229] Load exact count to do 18644 002370'01 104 00 0 00 000053 SOUT% ;[229] Counted SOUT% is faster 18645 002371'01 320 12 0 00 002373' %jsErr (,) ;[229] Can't win ... 18646 002372'01 254 00 0 00 002376' 18647 002373'01 265 01 0 00 002334* 18648 002374'01 000000 000000 18649 002375'01 254 00 0 00 002376' 18650 002376'01 endif. ;[229] End case no prompt 18651 18652 002376'01 561 01 0 00 002275* hrroi t1, crlf ;[229] Have to tie off the line 18653 002377'01 104 00 0 00 000076 PSOUT% ;[229] 18654 002400'01 254 00 0 00 002300' jrst $tranx ;[229] Go shut everything down 18655 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 30 K20IOC MAC 25-Nov-23 20:18 Notify of transmission completion 18656 subttl Notify of transmission completion 18657 18658 ;N.B., The byte count isn't what we actually sent; it's what the 18659 ; file should show up as. 18660 18661 tranot: txmsg < 18662 002401'01 200 01 0 00 000000# [KERMIT-20: Transmit of > ;[229] Begin to tell us about it 18663 002402'01 104 00 0 00 000076 18664 002403'01 320 12 0 00 002404' 18665 000204'02 000000000000# 18666 000675'04 015 012 133 113 105 18667 18668 002404'01 200 02 0 00 002354* move t2, filjfn ;[229] Let's get ready to print the file name 18669 002405'01 302 02 0 00 377777 caie t2, .nulio ;[229] Just dumping it? 18670 002406'01 254 00 0 00 002413' ifskp. ;[229] Yes, so bum the JFNS% 18671 002407'01 200 01 0 00 000000# txmsg ;[229] (which won't work, anyway) 18672 002410'01 104 00 0 00 000076 18673 002411'01 320 12 0 00 002412' 18674 000205'02 000000000000# 18675 000703'04 116 125 114 072 000 18676 002412'01 254 00 0 00 002423' else. ;[229] Otherwise, have a real file (I hope) 18677 002413'01 201 01 0 00 000101 movei t1, .priou ;[229] Continue to display on the terminal 18678 002414'01 403 03 0 00 000004 setzb t3, t4 ;[229] No special formatting or goofy prefix 18679 002415'01 104 00 0 00 000030 JFNS% ;[229] Let's see the file name 18680 002416'01 320 12 0 00 002420' %jsErr (,) ;[229] 18681 002417'01 254 00 0 00 002423' 18682 002420'01 265 01 0 00 002373* 18683 002421'01 000000000000# 18684 002422'01 254 00 0 00 002423' 18685 000704'04 103 157 165 154 144 18686 002423'01 endif. ;[229] End case displaying the file name 18687 18688 002423'01 200 01 0 00 000000# txmsg < complete> ;[229] Prepare to blat the file length 18689 002424'01 104 00 0 00 000076 18690 002425'01 320 12 0 00 002426' 18691 000206'02 000000000000# 18692 000714'04 040 143 157 155 160 18693 002426'01 337 02 0 00 000000# skipg t2, fsized ;[229] Load the size of the file in bytes 18694 002427'01 254 00 0 00 002447' ifskp. ;[229] Actually had some data 18695 002430'01 200 01 0 00 000000# txmsg <, > ;[229] Punctuate for some data 18696 002431'01 104 00 0 00 000076 18697 002432'01 320 12 0 00 002433' 18698 000207'02 000000000000# 18699 000716'04 054 040 000 000 000 18700 002433'01 201 01 0 00 000101 movei t1, .priou ;[229] Continue to display on the terminal 18701 002434'01 201 03 0 00 000012 movei t3, ^d10 ;[229] File sizes are always base 10 18702 002435'01 104 00 0 00 000224 NOUT% ;[229] Finally type our length 18703 002436'01 320 12 0 00 002440' %jsErr (,) ;[229] 18704 002437'01 254 00 0 00 002443' 18705 002440'01 265 01 0 00 002420* 18706 002441'01 000000000000# 18707 002442'01 254 00 0 00 002443' 18708 000717'04 103 157 165 154 144 18709 002443'01 200 01 0 00 000000# txmsg < characters> ;[229] However, we clipped a lot of linefeeds 18710 002444'01 104 00 0 00 000076 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 30-1 K20IOC MAC 25-Nov-23 20:18 Notify of transmission completion 18711 002445'01 320 12 0 00 002446' 18712 000210'02 000000000000# 18713 000727'04 040 143 150 141 162 18714 002446'01 254 00 0 00 002455' else. ;[229] Otherwise, nothing there 18715 002447'01 200 01 0 00 002404* move t1, filjfn ;[229] But!! Do we actually care? 18716 002450'01 306 01 0 00 377777 cain t1, .nulio ;[229] Just dumping stuff? 18717 002451'01 254 00 0 00 002455' anskp. ;[229] Yes, so NUL: really only has one size... 18718 002452'01 200 01 0 00 000000# txmsg <(empty file)> ;[229] Nothing there... 18719 002453'01 104 00 0 00 000076 18720 002454'01 320 12 0 00 002455' 18721 000211'02 000000000000# 18722 000732'04 050 145 155 160 164 18723 002455'01 endif. ;[229] End case 18724 18725 txmsg <] 18726 002455'01 200 01 0 00 000000# > ;[229] Finish reassuring user 18727 002456'01 104 00 0 00 000076 18728 002457'01 320 12 0 00 002460' 18729 000212'02 000000000000# 18730 000735'04 135 015 012 000 000 18731 002460'01 263 17 0 00 000000 ret ;[229] Finally done 18732 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 31 K20IOC MAC 25-Nov-23 20:18 CAPTURE Parsing logic 18733 subttl CAPTURE Parsing logic 18734 18735 ;[229] Begin code insertion 18736 18737 ;[229] %table puts stuff in the correct .psect 18738 18739 000213'02 000000 000000 %table (capswi) ; The capture switch table 18740 000214'02 000000# 000000 %key2 , %eofsw ; The EOF switch parses a restricted token set 18741 000045'03 105 117 106 000 000 18742 000215'02 000000# 000002 %key2 , %timsw ; In case we don't want to wait forever ... 18743 000046'03 164 151 155 145 157 18744 000213'02 000002 000002 %tbend ; End of table 18745 18746 002461'01 000000000000# captfs: flddb. .cmswi,,capswi,,,tranfd ; Maybe get a capture switch 18747 002462'01 000000000000# 18748 18749 ; Default command filespec fields for .CMFIL. These are only given 18750 ; so that we may get the flags returned by GTJFN% (which are currently 18751 ; unused) 18752 18753 chgsec(code,const) ;;GTJFN defaults are not in code, they're in const 18754 18755 000216'02 600020 777777 capbk: gj%flg!gj%fou!gj%new!fld(.gjnhg,.rhalf) ; .GJGEN 18756 000217'02 000100 000101 .priin,,.priou ; .GJSRC (ignored if COMND%) 18757 000220'02 000000 000000 0 ; .GJDEV (do not default the device) 18758 000221'02 000000 000000 0 ; .GJDIR (do not default the directory) 18759 000222'02 000000 000000 0 ; .GJNAM (do not default the name) 18760 000223'02 000000 000000 0 ; .GJEXT (do not default the extension) 18761 000224'02 000000 000000 0 ; .GJPRO (use system default protection) 18762 000225'02 000000 000000 0 ; .GJACT (use job's current account) 18763 000010 capbkl==<.-capbk> ; Length of this GTJFN argument block. 18764 retsec ;;Back to where-ever we started from 18765 18766 002463'01 .captu: entry .captu ; Linkage is from k20par 18767 002463'01 265 16 0 00 004155' saveac ; Protect some registers 18768 18769 002464'01 200 01 0 00 004171' movx t1, cz%ncl!.fhslf ; Release non-open JFN's on reparse 18770 002465'01 104 00 0 00 000034 CLZFF% 18771 002466'01 320 12 0 00 002467' erjmpr .+1 ; Catch and ignore errors 18772 18773 002467'01 200 01 0 00 004217' move t1, [capbk,,cjfnbk] ;Insert our file parsing 18774 002470'01 251 01 0 00 000000# blt t1, cjfnbk+capbkl ; defaults into the parse block 18775 18776 002471'01 201 11 0 00 002461' movei q5, captfs ; Load our initial parse file descriptor block 18777 002472'01 254 00 0 00 001510' callret .tran0 ; The rest of it parses exactly like TRANSMIT 18778 18779 ;[230] End code insertion 18780 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 32 K20IOC MAC 25-Nov-23 20:18 CAPTURE semantic action 18781 subttl CAPTURE semantic action 18782 18783 ;[230] Begin code insertion 18784 18785 003776 capmxl==<-2> ;;Maximum we can store, minus at end 18786 18787 remark ; Various linkages 18788 extern inilin ; Routine to condition line for capture 18789 extern rrslin ; Routine to decondition line 18790 extern ttipar ; Count of parity errors detected 18791 extern movchr ; Location of a movslj instruction 18792 18793 002473'01 $captu: entry $captu ; Linkage is from k20par 18794 002473'01 265 16 0 00 004220' saveac ; Protect a bunch of registers 18795 18796 002474'01 337 07 0 00 002312* skipg q3, netjfn ; Assuming getting a character from the network 18797 002475'01 200 07 0 00 002313* move q3, ttyjfn ; No network, so using local terminal 18798 002476'01 200 10 0 00 002302* move q4, pars7 ; Load EOF character (if any, which will have parity) 18799 002477'01 200 13 0 00 000010 move p3, q4 ; Make a 7 bit copy 18800 002500'01 405 13 0 00 000177 andi p3, ^o177 ; by stripping off any parity 18801 002501'01 201 01 0 00 000015 movei t1, .chcrt ; Load expected end of line 18802 002502'01 260 17 1 00 002307* call @parity ; Put parity on it (if doing parity) 18803 002503'01 200 12 0 00 000001 move p2, t1 ; and keep the result in p2 18804 ; Now set up to write the prompt easily 18805 002504'01 336 04 0 00 002357* skipn t4, strc ; Load the prompt length 18806 002505'01 254 00 0 00 002527' ifskp. ; If not zero, see about using it 18807 002506'01 316 07 0 00 002475* camn q3, ttyjfn ; Not going to the terminal? 18808 002507'01 254 00 0 00 002512' ifskp. ; No, so will be doing a SOUTR% 18809 002510'01 313 04 0 00 002270* camle t4, vsomx ; Length less than or equal to the maximum seen? 18810 002511'01 202 04 0 00 002510* movem t4, vsomx ; Nope, we have a new SOUTR% maximum! 18811 002512'01 endif. ; End case SOUTR% max update 18812 002512'01 200 01 0 00 002502* move t1, parity ; Load the parity 18813 002513'01 302 01 0 00 003452' caie t1, none ; But!! Not doing any parity? 18814 002514'01 254 00 0 00 002524' ifskp. ; No, so just 'expand' the byte width 18815 002515'01 200 01 0 00 000004 move t1, t4 ; The strings are the same length 18816 002516'01 403 03 0 00 000006 setzb t3, q2 ; Both are section zero local 18817 002517'01 200 02 0 00 004026' move t2, [point 7, strbuf] ; Source is 7 bit 18818 002520'01 200 05 0 00 004210' move q1, [point 8, strbf2] ; Destination is 8 bit 18819 002521'01 123 01 0 00 000000* extend t1, movchr ; Do the byte width expansion 18820 002522'01 600 00 0 00 000000 nop ; Ignore any odd non-skip 18821 002523'01 254 00 0 00 002527' else. ; Otherwise, have to do some real parity 18822 002524'01 210 03 0 00 000004 movn t3, t4 ; genpar wants a negative count (like SOUT%) 18823 002525'01 120 01 0 00 004236' dmove t1, [ exp , ] 18824 002526'01 260 17 0 00 003676' call genpar ; Rewrite the string as 8 bit (7 + 1 bit parity) 18825 002527'01 endif. ; End 7 to 8 bit conversion, possibly with parity 18826 002527'01 endif. ; End case network prompt length check 18827 18828 002527'01 550 01 0 00 002005* hrrz t1, pars2 ; Let's get the output file opened 18829 002530'01 202 01 0 00 002447* movem t1, filjfn ; Store JFN (sans flags) 18830 002531'01 306 01 0 00 377777 cain t1, .nulio ; Opening .nulio does work, but it's a waste of time 18831 002532'01 254 00 0 00 002552' ifskp. ; A real file, so let's get this thing open 18832 002533'01 200 02 0 00 004240' movx t2, fld(7,of%bsz)!of%wr ; 7-bit bytes, write-only (I.E., no append) 18833 002534'01 104 00 0 00 000021 OPENF% ; Try to create the file 18834 002535'01 320 12 0 00 002537' ifje. r ; Failed?? 18835 002536'01 254 00 0 00 002552' K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 32-1 K20IOC MAC 25-Nov-23 20:18 CAPTURE semantic action 18836 002537'01 200 04 0 00 000001 move t4, t1 ; Save error code for debugging 18837 002540'01 334 00 0 00 000000 %ermsg (,) ; Squawk and continue 18838 002541'01 254 00 0 00 002545' 18839 002542'01 265 01 0 00 002440* 18840 002543'01 000000000000# 18841 002544'01 254 00 0 00 002545' 18842 000736'04 125 156 141 142 154 18843 002545'01 402 00 0 00 002530* setzm filjfn ; Stomp JFN global storage 18844 002546'01 550 01 0 00 002527* hrrz t1, pars2 ; Reload the JFN 18845 002547'01 260 17 0 00 002352* call frclos ; Force it closed 18846 002550'01 600 00 0 00 000000 nop ; Ignore error and carry on 18847 002551'01 263 17 0 00 000000 ret ; And return; we can't do anything else 18848 002552'01 endif. ; End case OPENF% JSYS error handling 18849 002552'01 endif. ; End case skipping an OPENF% of .nulio 18850 18851 002552'01 260 17 0 00 002631' call caphrl ; Display the capture herald 18852 002553'01 260 17 0 00 002064* call ccon ; Turn on ^C trap 18853 002554'01 254 00 0 00 002625' jrst $capux ; Where to go upon ^C. 18854 002555'01 260 17 0 00 000000* call inilin ; Initialize the line for transfer 18855 18856 002556'01 do. ; Enter loop context 18857 002556'01 260 17 0 00 002772' call getcrt ; Get a carriage return terminated line of text 18858 002557'01 254 00 0 00 002625' jrst $capux ; On error, close the file and restore the line 18859 002560'01 260 17 0 00 003126' call eofovr ; Overwrite any EOF at the end of the string 18860 002561'01 200 01 0 00 002545* move t1, filjfn ; Load the file JFN 18861 002562'01 306 01 0 00 377777 cain t1, .nulio ; But!! Only going to toss it? 18862 002563'01 254 00 0 00 002575' ifskp. ; No, so do the write 18863 002564'01 323 14 0 00 002575' andg. p4 ; Unless we have nothing to write 18864 002565'01 200 02 0 00 004026' move t2,[point 7,strbuf] ;Source is the repacked string 18865 002566'01 210 03 0 00 000014 movn t3, p4 ; Load negative length because ... 18866 002567'01 104 00 0 00 000053 SOUT% ; Counted SOUT%'s are faster 18867 002570'01 320 12 0 00 002572' %jserr (,$capux) ; Complain and stop doing this 18868 002571'01 254 00 0 00 002575' 18869 002572'01 265 01 0 00 002542* 18870 002573'01 000000 000000 18871 002574'01 254 00 0 00 002625' 18872 002575'01 endif. ; End case writing the file (or tossing the data) 18873 002575'01 321 10 0 00 002625' jumpl q4, endlp. ; Break out of loop if allready hit EOF character 18874 002576'01 322 04 0 00 002556' jumpe t4, top. ; Don't print the prompt unless told to 18875 002577'01 336 05 0 00 002504* skipn q1, strc ; No search string, then? 18876 002600'01 254 00 0 00 002556' loop. ; No such luck, go get some more data 18877 002601'01 200 01 0 00 000007 move t1, q3 ; Load whatever transfer JFN we're using 18878 002602'01 200 02 0 00 004210' move t2,[point 8,strbf2] ;Point to search string 18879 002603'01 210 03 0 00 000005 movn t3, q1 ; Load exact count to do 18880 002604'01 312 01 0 00 002506* came t1, ttyjfn ; Going to the terminal? 18881 002605'01 254 00 0 00 002615' ifskp. ; Yes, that's easy enough 18882 002606'01 104 00 0 00 000053 SOUT% ; Boom, done 18883 002607'01 320 12 0 00 002611' %jserr (,$capux) ; or not... 18884 002610'01 254 00 0 00 002614' 18885 002611'01 265 01 0 00 002572* 18886 002612'01 000000 000000 18887 002613'01 254 00 0 00 002625' 18888 002614'01 254 00 0 00 002624' else. ; Otherwise, needs a poke to be on its way 18889 002615'01 104 00 0 00 000532 SOUTR% ; Write the network 18890 002616'01 320 12 0 00 002620' %jserr (,$capux) ; or not... K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 32-2 K20IOC MAC 25-Nov-23 20:18 CAPTURE semantic action 18891 002617'01 254 00 0 00 002623' 18892 002620'01 265 01 0 00 002611* 18893 002621'01 000000 000000 18894 002622'01 254 00 0 00 002625' 18895 002623'01 272 05 0 00 002266* addm q1, vsotc ; Update tally of SOUTR% bytes 18896 002624'01 endif. ; End case writing the terminal 18897 002624'01 254 00 0 00 002556' loop. ; Either way, go get some more goodies 18898 002625'01 enddo. ; Exit loop lexical context 18899 18900 002625'01 260 17 0 00 000000* $capux: call rrslin ; Turn ^C trap off, close file, clear buffer 18901 002626'01 561 01 0 00 002376* hrroi t1, crlf ;[229] Tie off line 18902 002627'01 104 00 0 00 000076 PSOUT% ;[229] So INPUT in Batch works 18903 002630'01 263 17 0 00 000000 ret ; Done 18904 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 33 K20IOC MAC 25-Nov-23 20:18 Display herald for capture command 18905 subttl Display herald for capture command 18906 18907 ; Call: 18908 ; 18909 ; strc/ Indicates we have a prompt string 18910 ; filjfn/ Wherever we're writing the captured data 18911 ; q4/ EOF character (if we have one) 18912 ; 18913 ; N.B., If we bum all the SOUT%'s with a movslj, it will have to get 18914 ; executed in section or the text will need to be in section zero 18915 18916 002631'01 201 01 0 00 000101 caphrl: movei t1, .priou ; Output is always the terminal 18917 dxtext (t2,< 18918 002632'01 120 02 0 00 000000# [KERMIT-20: Capturing to >) ;Tell user we're starting. 18919 000226'02 000000000000# 18920 000227'02 777777 777745 18921 000744'04 015 012 133 113 105 18922 002633'01 104 00 0 00 000053 SOUT% ; Counted SOUT% is faster 18923 002634'01 320 12 0 00 002636' %jsErr (,) ; Whine and continue 18924 002635'01 254 00 0 00 002641' 18925 002636'01 265 01 0 00 002620* 18926 002637'01 000000000000# 18927 002640'01 254 00 0 00 002641' 18928 000752'04 125 156 141 142 154 18929 002641'01 200 02 0 00 002561* move t2, filjfn ; Load the JFN 18930 002642'01 302 02 0 00 377777 caie t2, .nulio ; But!! Just tossing it? 18931 002643'01 254 00 0 00 002654' ifskp. ; Yes, can't JFNS% because it chokes on a device 18932 002644'01 120 02 0 00 000000# dxtext (t2,) ; Easy enough to 'translate' (heh) 18933 000230'02 000000000000# 18934 000231'02 777777 777774 18935 000762'04 116 125 114 072 000 18936 002645'01 104 00 0 00 000053 SOUT% ; Counted SOUT% is faster 18937 002646'01 320 12 0 00 002650' %jsErr (,) ; What? Eh? 18938 002647'01 254 00 0 00 002653' 18939 002650'01 265 01 0 00 002636* 18940 002651'01 000000000000# 18941 002652'01 254 00 0 00 002653' 18942 000763'04 125 156 141 142 154 18943 002653'01 254 00 0 00 002663' else. ; Otherwise, assume a bona fide JFN 18944 002654'01 403 03 0 00 000004 setzb t3, t4 ; Standard formatting, no goofball prefix... 18945 002655'01 104 00 0 00 000030 JFNS% ; Type it 18946 002656'01 320 12 0 00 002660' %jsErr (,) ; Whine & continue 18947 002657'01 254 00 0 00 002663' 18948 002660'01 265 01 0 00 002650* 18949 002661'01 000000000000# 18950 002662'01 254 00 0 00 002663' 18951 000772'04 125 156 141 142 154 18952 002663'01 endif. ; End case output device special casing 18953 18954 002663'01 322 10 0 00 002720' ifn. q4 ; Do we have an EOF character? 18955 002664'01 120 02 0 00 000000# dxtext (t2,<, EOF: >) ; We do, so load the herald 18956 000232'02 000000000000# 18957 000233'02 777777 777771 18958 001003'04 054 040 105 117 106 18959 002665'01 104 00 0 00 000053 SOUT% ; Counted SOUT is faster K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 33-1 K20IOC MAC 25-Nov-23 20:18 Display herald for capture command 18960 002666'01 320 12 0 00 002670' %jsErr (,) ; Whine and continue 18961 002667'01 254 00 0 00 002673' 18962 002670'01 265 01 0 00 002660* 18963 002671'01 000000000000# 18964 002672'01 254 00 0 00 002673' 18965 001005'04 125 156 141 142 154 18966 002673'01 200 02 0 00 000010 move t2, q4 ; Load the EOF character 18967 002674'01 405 02 0 00 000177 andi t2, ^o177 ; Stomp any parity 18968 002675'01 302 02 0 00 000033 caie t2, .chesc ; The escape character? 18969 002676'01 254 00 0 00 002701' ifskp. ; It is 18970 002677'01 201 02 0 00 000044 movei t2, "$" ; Replace it with our talisman 18971 002700'01 254 00 0 00 002712' else. ; Otherwise, it is a control character 18972 002701'01 201 03 0 02 000100 movei t3, <"A"-.chcna>(t2) ; Turn into ASCII and get out of the way 18973 002702'01 201 02 0 00 000136 movei t2, "^" ; Need the pointy up arrow 18974 002703'01 104 00 0 00 000051 BOUT% ; Type it 18975 002704'01 320 12 0 00 002706' %jsErr (,) ; Blat 18976 002705'01 254 00 0 00 002711' 18977 002706'01 265 01 0 00 002670* 18978 002707'01 000000000000# 18979 002710'01 254 00 0 00 002711' 18980 001013'04 125 156 141 142 154 18981 002711'01 200 02 0 00 000003 move t2, t3 ; Restore the character 18982 002712'01 endif. ; End case tweaking the EOF character for printing 18983 002712'01 104 00 0 00 000051 BOUT% ; Finally print whatever we made up 18984 002713'01 320 12 0 00 002715' %jsErr (,) ; Blat and continue 18985 002714'01 254 00 0 00 002720' 18986 002715'01 265 01 0 00 002706* 18987 002716'01 000000000000# 18988 002717'01 254 00 0 00 002720' 18989 001024'04 125 156 141 142 154 18990 002720'01 endif. ; End case printing EOF character 18991 18992 002720'01 336 00 0 00 002577* ifmn. strc ; Do we have a prompt string? 18993 002721'01 254 00 0 00 002741' 18994 002722'01 120 02 0 00 000000# dxtext (t2,<, prompt: >) ;we do, so type it 18995 000234'02 000000000000# 18996 000235'02 777777 777766 18997 001032'04 054 040 160 162 157 18998 002723'01 104 00 0 00 000053 SOUT% ; Counted SOUT% is faster 18999 002724'01 320 12 0 00 002726' %jsErr (,) ; Whine and continue 19000 002725'01 254 00 0 00 002731' 19001 002726'01 265 01 0 00 002715* 19002 002727'01 000000000000# 19003 002730'01 254 00 0 00 002731' 19004 001035'04 125 156 141 142 154 19005 002731'01 200 02 0 00 004210' move t2, [point 8, strbf2] ; Note, parity was put on the prompt 19006 002732'01 210 03 0 00 002720* movn t3, strc ; Load negative length because ... 19007 002733'01 104 00 0 00 000053 SOUT% ; a counted SOUT% is faster 19008 002734'01 320 12 0 00 002736' %jsErr (,); Whine and continue 19009 002735'01 254 00 0 00 002741' 19010 002736'01 265 01 0 00 002726* 19011 002737'01 000000000000# 19012 002740'01 254 00 0 00 002741' 19013 001045'04 125 156 141 142 154 19014 002741'01 endif. ; End case prompting K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 33-2 K20IOC MAC 25-Nov-23 20:18 Display herald for capture command 19015 19016 002741'01 120 02 0 00 000000# dxtext (t2,<, type: >) ; Note trailing space !! 19017 000236'02 000000000000# 19018 000237'02 777777 777770 19019 001055'04 054 040 164 171 160 19020 002742'01 104 00 0 00 000053 SOUT% ; Counted SOUT% is faster 19021 002743'01 320 12 0 00 002745' %jsErr (,); Whine and continue 19022 002744'01 254 00 0 00 002750' 19023 002745'01 265 01 0 00 002736* 19024 002746'01 000000000000# 19025 002747'01 254 00 0 00 002750' 19026 001057'04 125 156 141 142 154 19027 002750'01 120 02 0 00 000000# dxtext (t2,<^C^C>) ; Assume default 19028 000240'02 000000000000# 19029 000241'02 777777 777774 19030 001065'04 136 103 136 103 000 19031 002751'01 200 04 0 00 000000# move t4, mycaps+1 ; Load enabled capabilities 19032 002752'01 607 04 0 00 400000 txnn t4, sc%ctc ; Is Control-C on?? 19033 002753'01 120 02 0 00 000000# dxtext (t2,<^G^G>) ; Wasn't ... 19034 000242'02 000000000000# 19035 000243'02 777777 777774 19036 001066'04 136 107 136 107 000 19037 002754'01 104 00 0 00 000053 SOUT% ; Counted SOUT% is faster 19038 002755'01 320 12 0 00 002757' %jsErr (,) ; Whine and continue 19039 002756'01 254 00 0 00 002762' 19040 002757'01 265 01 0 00 002745* 19041 002760'01 000000000000# 19042 002761'01 254 00 0 00 002762' 19043 001067'04 125 156 141 142 154 19044 19045 dxtext (t2,< to finish] 19046 002762'01 120 02 0 00 000000# >) ; Note initial leading space !! 19047 000244'02 000000000000# 19048 000245'02 777777 777763 19049 001100'04 040 164 157 040 146 19050 19051 002763'01 104 00 0 00 000053 SOUT% ; Counted SOUT% is faster 19052 002764'01 320 12 0 00 002766' %jsErr (,) ; Whine and continue 19053 002765'01 254 00 0 00 002771' 19054 002766'01 265 01 0 00 002757* 19055 002767'01 000000000000# 19056 002770'01 254 00 0 00 002771' 19057 001103'04 125 156 141 142 154 19058 19059 002771'01 263 17 0 00 000000 ret ; Finally done 19060 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 34 K20IOC MAC 25-Nov-23 20:18 Get a carriage return terminated line of text 19061 subttl Get a carriage return terminated line of text 19062 19063 ; Call: 19064 ; 19065 ; q3/ JFN we're reading from, typically netjfn 19066 ; p2/ EOF character without parity 19067 ; q4/ EOF character, if doing EOF 19068 ; 19069 ; Return: 19070 ; 19071 ; +1/ Any kind of error 19072 ; +2/ Hit either carriage return or an EOF 19073 ; 19074 ; t4/ 0 if didn't hit a carriage return 19075 ; -1 if we did (a linefeed will be appended!!) 19076 ; q1/ Points to last character in seven bit stream 19077 ; q4/ -1 if hit the EOF character 19078 ; p2/ Preserved, always 19079 ; p4/ Total characters that have been buffered up 19080 19081 002772'01 265 16 0 00 004241' getcrt: saveac ; Used as scratch 19082 002773'01 403 14 0 00 000015 setzb p4, p5 ; Assume won't buffer anything or hit a CR 19083 002774'01 200 13 0 00 004143' move p3,[point 8,strbuf] ;Will be reading into the string buffer 19084 ; Loop reads until EOF, CR or buffer full 19085 002775'01 do. ; Enter loop context 19086 002775'01 301 14 0 00 003776 cail p4, capmxl ; Would the read overflow the buffer? 19087 002776'01 254 00 0 00 003074' exit. ; Then don't read another thing 19088 002777'01 200 01 0 00 000007 move t1, q3 ; Load the input JFN 19089 003000'01 104 00 0 00 000050 BIN% ; Wait for a byte 19090 003001'01 320 12 0 00 003003' %jsErr (,r) ; Whine and return 19091 003002'01 254 00 0 00 003006' 19092 003003'01 265 01 0 00 002766* 19093 003004'01 000000000000# 19094 003005'01 254 00 0 00 002243* 19095 001113'04 105 162 162 157 162 19096 003006'01 312 01 0 00 002604* came t1, ttyjfn ; Was this the local terminal? 19097 003007'01 350 00 0 00 000473* aos nbict ; No, so count a network BIN%, then 19098 003010'01 200 01 0 00 000002 move t1, t2 ; Check the parity on this poor character 19099 003011'01 260 17 1 00 002512* call @parity ; Calculate the parity (if any) 19100 003012'01 312 01 0 00 000002 came t1, t2 ; Is the parity the same?? 19101 003013'01 254 00 0 00 003030' ifskp. ; That's dandy, let's use it 19102 003014'01 136 02 0 00 000013 idpb t2, p3 ; Append the single byte we got 19103 003015'01 271 14 0 00 000001 addi p4, ^d1 ; and count it 19104 003016'01 322 10 0 00 003023' ifn. q4 ; Doing EOF?? 19105 003017'01 312 02 0 00 000010 came t2, q4 ; We are. Is this the EOF? 19106 003020'01 254 00 0 00 003023' anskp. ; Isn't, so just carry on 19107 003021'01 474 10 0 00 000000 seto q4, ; Flag hit EOF 19108 003022'01 254 00 0 00 003074' exit. ; Exit the loop 19109 003023'01 endif. ; End case possible EOF checking 19110 003023'01 312 02 0 00 000012 came t2, p2 ; Was the character a carriage return? 19111 003024'01 254 00 0 00 003027' ifskp. ; It was, so check and return this line 19112 003025'01 474 15 0 00 000000 seto p5, ; Flag hit carriage return 19113 003026'01 254 00 0 00 003074' exit. ; Get out of the loop 19114 003027'01 endif. ; End case checking for carriage return 19115 003027'01 254 00 0 00 003034' else. ; Not, so a parity error K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 34-1 K20IOC MAC 25-Nov-23 20:18 Get a carriage return terminated line of text 19116 003030'01 200 01 0 00 000000# emsg 19117 003031'01 104 00 0 00 000313 19118 000246'02 000000000000# 19119 001121'04 102 141 144 040 160 19120 003032'01 350 00 0 00 000000* aos ttipar ; Count a detected parity error 19121 003033'01 263 17 0 00 000000 ret ; And give an error return 19122 003034'01 endif. ; End case checking parity 19123 003034'01 260 17 0 00 000476* call clrest ; Find out how much, if anything, remains 19124 003035'01 263 17 0 00 000000 ret ; Failed somehow, just give up 19125 003036'01 322 01 0 00 002775' jumpe t1, top. ; If nothing to read, go wait for something 19126 remark ; Otherwise, get the rest of the goodies 19127 003037'01 200 02 0 00 000001 move t2, t1 ; Save a working copy 19128 003040'01 270 02 0 00 000014 add t2, p4 ; Calculate what would be the final total 19129 003041'01 307 02 0 00 003776 caig t2, capmxl ; Would this read overflow the buffer? 19130 003042'01 254 00 0 00 003045' ifskp. ; It would, so clip down to maximum 19131 003043'01 275 02 0 00 003776 subi t2, capmxl ; Calculate the overflow 19132 003044'01 274 01 0 00 000002 sub t1, t2 ; And reduce the read by that amount 19133 003045'01 endif. ; End case buffer overflow check 19134 003045'01 200 11 0 00 000001 move p1, t1 ; Save final maximum 19135 003046'01 200 01 0 00 000007 move t1, q3 ; Load whatever transfer JFN we're using 19136 003047'01 200 02 0 00 000013 move t2, p3 ; Load current position in buffer 19137 003050'01 120 03 0 00 000011 dmove t3, p1 ; Load maximum we'll read and terminator 19138 003051'01 104 00 0 00 000052 SIN% ; And grab whatever else is waiting for us 19139 003052'01 320 12 0 00 003054' %jsErr (,r) ; Whine and return 19140 003053'01 254 00 0 00 003057' 19141 003054'01 265 01 0 00 003003* 19142 003055'01 000000000000# 19143 003056'01 254 00 0 00 003005* 19144 001132'04 105 162 162 157 162 19145 003057'01 200 13 0 00 000002 move p3, t2 ; Update current position in buffer 19146 003060'01 274 11 0 00 000003 sub p1, t3 ; Subtract negative to get total characters transferred 19147 003061'01 316 07 0 00 003006* camn q3, ttyjfn ; Not using the local terminal? 19148 003062'01 254 00 0 00 003067' ifskp. ; No, so updates some more variables 19149 003063'01 350 00 0 00 000512* aos nsici ; Update Network SIN%'s Issued 19150 003064'01 313 11 0 00 000510* camle p1, nsimx ; Smaller than biggest? 19151 003065'01 202 11 0 00 003064* movem p1, nsimx ; Nope, we have a new winner 19152 003066'01 272 11 0 00 000523* addm p1, nsitc ; Update Network SIN% total characters read 19153 003067'01 endif. ; End case network tally updates 19154 003067'01 270 14 0 00 000011 add p4, p1 ; Compute total characters in strbuf 19155 003070'01 135 01 0 00 000002 ldb t1, t2 ; Pick up the last eight bit character 19156 003071'01 312 01 0 00 000012 came t1, p2 ; Was it a carriage return?? 19157 003072'01 254 00 0 00 002775' loop. ; Wasn't, so go get some more data 19158 003073'01 474 15 0 00 000000 seto p5, ; Otherwise, it was, so flag and fall out of the loop 19159 003074'01 enddo. ; End loop lexical context 19160 19161 remark ; Check parity and repack the string 19162 003074'01 200 02 0 00 004143' move t2,[point 8,strbuf] ;Point to network input buffer 19163 003075'01 210 03 0 00 000014 movn t3, p4 ; Pretend doing a SOUT% 19164 remark ; If no parity, chkpar will return +2 19165 003076'01 260 17 0 00 003721' call chkpar ; Check the parity 19166 003077'01 254 00 0 00 003110' ifskp. ; Everything is fine, so convert to 7 bit 19167 003100'01 200 01 0 00 000014 move t1, p4 ; Source length is the total characters gotten 19168 003101'01 200 02 0 00 004143' move t2,[point 8,strbuf] ;Which comes from the network data 19169 003102'01 403 03 0 00 000006 setzb t3, q2 ; Pointers are section zero local 19170 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 20:02 27-Nov-23 Page 34-2 K20IOC MAC 25-Nov-23 20:18 Get a carriage return terminated line of text 19171 003104'01 200 05 0 00 004026' move q1,[point 7,strbuf] ;Destination is same with smaller byte size 19172 003105'01 123 01 0 00 002521* extend t1, movchr ; Repack the string in place (which is safe) 19173 003106'01 600 00 0 00 000000 nop ; Ignore any odd non-skip 19174 003107'01 254 00 0 00 003114' else. ; Otherwise, badness 19175 003110'01 200 01 0 00 000000# emsg 19176 003111'01 104 00 0 00 000313 19177 000247'02 000000000000# 19178 001141'04 102 141 144 040 160 19179 003112'01 350 00 0 00 003032* aos ttipar ; Count a detected parity error 19180 003113'01 263 17 0 00 000000 ret ; And fail the call 19181 003114'01 endif. ; End parity check 19182 19183 003114'01 326 15 0 00 003121' ife. p5 ; If no CR, fix up the last pointer 19184 003115'01 474 02 0 00 000000 seto t2, ; movchr points PAST the last character 19185 003116'01 133 02 0 00 000005 adjbp t2, q1 ; So back up the 7 bit pointer by one 19186 003117'01 200 05 0 00 000002 move q1, t2 ; And pass that back 19187 003120'01 254 00 0 00 003124' else. ; Otherwise, we hit the carriage return!! 19188 003121'01 201 01 0 00 000012 movei t1, .chlfd ; So will need a line feed 19189 003122'01 136 01 0 00 000005 idpb t1, q1 ; Append it 19190 003123'01 271 14 0 00 000001 addi p4, ^d1 ; and acCOUNT for it (Boo...) 19191 003124'01 endif. ; End case carriage return fix up 19192 19193 003124'01 200 04 0 00 000015 move t4, p5 ; Pass back the carriage return flag 19194 003125'01 254 00 0 00 002051* retskp ; Return success 19195 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 35 K20IOC MAC 25-Nov-23 20:18 Check for and Overwrite EOF at the end of the string 19196 subttl Check for and Overwrite EOF at the end of the string 19197 19198 ; Assumes that the EOF is always within three characters of the last 19199 ; character, including that character. This is based on how the EOF 19200 ; logic sends the character in TRANSMIT and how the CAPTURE logic will 19201 ; append a linefeed to any carriage return it finds. In other words, 19202 ; the sequence we check for is . However, if we bump 19203 ; into the EOF before we've checked everything, that's fine, too. 19204 ; 19205 ; Call: 19206 ; 19207 ; q1/ Points to the last character in the seven bit stream 19208 ; q4/ EOF character with parity (if we're doing any parity) 19209 ; p3/ EOF character without parity (whether or not we're doing parity) 19210 ; p4/ Length of string we're just about to write 19211 ; 19212 ; Return: 19213 ; 19214 ; +1, always 19215 ; 19216 ; q1/ Unchanged, string will have EOF character stripped if q4 was -1 19217 ; q4/ Set to -1, if found the EOF character 19218 ; p3/ Unchanged 19219 ; p4/ Length will be less, depending on where we found the EOF 19220 ; 19221 ; All other registers are preserved 19222 ; 19223 ; N.B., EVERYTHING after the EOF is tossed, including the EOF!! 19224 19225 003126'01 322 13 0 00 003056* eofovr: jumpe p3, r ; If not checking EOF, we have nothing to do 19226 003127'01 323 14 0 00 003126* jumple p4, r ; Don't bother if funny length, either 19227 ; First do the trivial edge cases 19228 003130'01 325 10 0 00 003133' ifl. q4 ; So, did somebody else already flag this? 19229 003131'01 275 14 0 00 000001 subi p4, ^d1 ; They did, so don't write the EOF to the file 19230 003132'01 263 17 0 00 000000 ret ; After shortening length, we're done 19231 003133'01 endif. ; End trivial case of somebody already told us 19232 ; Next trivial case? Is it at the end? 19233 003133'01 135 01 0 00 000005 ldb t1, q1 ; Get the last character 19234 003134'01 312 01 0 00 000013 came t1, p3 ; EOF already? 19235 003135'01 254 00 0 00 003141' ifskp. ; That was easy, just reduce the length 19236 003136'01 474 10 0 00 000000 seto q4, ; Flag we hit EOF 19237 003137'01 275 14 0 00 000001 subi p4, ^d1 ; We're not writing EOF to the file 19238 003140'01 263 17 0 00 000000 ret ; and return; we're done 19239 003141'01 endif. ; End case checking last character 19240 ; Final trivial case, a single character string 19241 003141'01 306 14 0 00 000001 cain p4, ^d1 ; Just this one dinky character? 19242 003142'01 263 17 0 00 000000 ret ; Fine, we didn't hit the EOF ... 19243 ; Otherwise, this is about to get harder 19244 003143'01 265 16 0 00 004253' saveac 19245 003144'01 201 07 0 00 000003 movei q3, ^d3 ; Will assume sequence is 19246 003145'01 313 07 0 00 000014 camle q3, p4 ; BUT!! Do we have enough characters? 19247 003146'01 200 07 0 00 000014 move q3, p4 ; No, so clip it down to remaining 19248 003147'01 363 07 0 00 003127* sojle q3, R ; Account for character we just checked (in t1) 19249 ; Also double checks our arithmatic, above 19250 003150'01 474 06 0 00 000000 seto q2, ; Back up the pointer K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 35-1 K20IOC MAC 25-Nov-23 20:18 Check for and Overwrite EOF at the end of the string 19251 003151'01 133 06 0 00 000005 adjbp q2, q1 ; Now pointing at penultimate character 19252 003152'01 135 02 0 00 000006 ldb t2, q2 ; and load that character 19253 003153'01 312 02 0 00 000013 came t2, p3 ; Hit the EOF? 19254 003154'01 254 00 0 00 003161' ifskp. ; We did 19255 003155'01 474 10 0 00 000000 seto q4, ; Flag we hit EOF 19256 003156'01 275 14 0 00 000002 subi p4, ^d2 ; We punted two characters from the string 19257 003157'01 263 17 0 00 000000 ret ; and return; we're done 19258 003160'01 254 00 0 00 003163' else. ; We didn't hit the EOF 19259 003161'01 306 07 0 00 000001 cain q3, ^d1 ; Was it a two character string, then? 19260 003162'01 263 17 0 00 000000 ret ; Then we're done, no EOF found 19261 003163'01 endif. ; End case checking penultimate character 19262 003163'01 363 07 0 00 003147* sojle q3, R ; Account for this second character we just checked 19263 ; Checking last character, so can reuse q3 19264 003164'01 474 07 0 00 000000 seto q3, ; Back up the pointer one more 19265 003165'01 133 07 0 00 000006 adjbp q3, q2 ; Now pointing at the antipenultimate character 19266 003166'01 135 03 0 00 000007 ldb t3, q3 ; and load that character 19267 003167'01 312 03 0 00 000013 came t3, p3 ; Hit the EOF finally?? 19268 003170'01 263 17 0 00 000000 ret ; Nope, so wasn't in this string 19269 003171'01 474 10 0 00 000000 seto q4, ; It's the EOF! So flag we found it 19270 003172'01 275 14 0 00 000003 subi p4, ^d3 ; Punting three characters from the string 19271 003173'01 263 17 0 00 000000 ret ; and return; we're done 19272 19273 ;[230] End code insertion 19274 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 36 K20IOC MAC 25-Nov-23 20:18 Translation table for MOVST to not uppercase 19275 subttl Translation table for MOVST to not uppercase 19276 19277 ;[209] Begin code and table insertion 19278 19279 ; Inspired by my rewrite of SETNOD, SETND2 (ND2SUB.MAC) 19280 19281 chgsec(code,const) ;;Put tables in the constants .psect 19282 19283 000002 %ascii=.chcnb ; ASCII values start at Control-B 19284 19285 remark Character table simply moves characters until a backslash is hit 19286 19287 000250'02 chrtab: intern chrtab ; Also used by k20par 19288 000250'02 100000 000001 xwd eoscod,.chcna ; NUL is end of string, ^A is allowed 19289 xlist ; Don't need to see all this junk 19290 list ; Restart the blather 19291 19292 000350' %eochr=. ; Remember end of table 19293 000326'02 reloc chrtab+<<"\">_-1> ; Gets us to the corrct halfword pair 19294 000326'02 500134 000135 xwd >,135 ;Stop on a backslash, emit a right brocket 19295 000350'02 reloc %eochr ; Get to end of table 19296 19297 100200 %ascii=eoscod!200!.chnul ; Anything we translate with bit 8 is bad 19298 xlist ; Don't need to see all this junk 19299 list ; Restart the blather 19300 19301 000550' %eotup=. ; Remember end of table 19302 000526'02 reloc chrtup+<<"\">_-1> ; Gets us to the corrct halfword pair 19303 000526'02 500134 000135 xwd >,135 ;Stop on a backslash, emit a right brocket 19304 000530'02 reloc chrtup+<<"`">_-1> ; Gets us to the corrct halfword pair 19305 000530'02 000140 000101 xwd "`","A" ; Convert lowercase a to UPPERcase A 19306 000102 %ascus="B" ; Starting at lowercase b 19307 xlist ; Don't need to see all this junk 19308 list ; Restart the blather 19309 000545'02 000132 000173 xwd "Z",173 ; Last letter and Left brace 19310 19311 000550'02 reloc %eotup ; Get to end of table 19312 19313 remark For eight bit data, everything stops us 19314 19315 100200 %ascus=eoscod!200!.chnul ; Anything we translate with bit 8 is bad 19316 xlist ; Don't need to see all this junk 19317 list ; Restart the blather 19318 retsec ; Re-open executable code 19319 19320 cleans(<%ascus,%eotup>) ; Don't polute the symbol table 19321 19322 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 38 K20IOC MAC 25-Nov-23 20:18 cescxp C Escape Expansion 19323 subttl cescxp C Escape Expansion 19324 19325 ; Given a source and destination pointer, copies the string from the 19326 ; source to the destination, triggering C escape expansion where 19327 ; appropriate. The source string MUST be NUL terminated 19328 ; 19329 ; If case is being ignored, then the string is UPPERcased as it is 19330 ; copied to facilitate later usage of string comparison instructions. 19331 ; 19332 ; Returns updated pointers and length. The destination buffer can 19333 ; never fill before the input buffer empties because any expansion 19334 ; involves converting two or more characters to a single character. 19335 ; 19336 19337 ; Parity MUST be stripped before calling this routine. Although it is 19338 ; commonly called with a 7 bit pointer, it will accept 8 bit pointers 19339 ; PROVIDED that the parity bit has been removed. It will FAIL if it 19340 ; detects a character with bit 8 set. 19341 ; 19342 ; Assumes section local pointers, do not use OWGP as the wrong 19343 ; thing will be returned. 19344 19345 003174'01 015 00 0 00 000000# chrmov: movst 0,chrtab ; Moves string without UPPERcasing 19346 003175'01 000000 000000 .chnul ; Fill character is end of string 19347 19348 003176'01 015 00 0 00 000000# chrmup: movst 0,chrtup ; Translate table to UPPERcase 19349 003177'01 000000 000000 .chnul ; Fill character is end of string 19350 19351 ; Call: 19352 ; 19353 ; t1/ Destination string pointer 19354 ; t2/ Source string pointer 19355 ; t3/ Maximum length of destination 19356 ; t4/ Translation table to use (whether matching case or not) 19357 ; 19358 ; Returns: 19359 ; 19360 ; +1/ Something bad happened or did nothing 19361 ; +2/ Good return 19362 ; 19363 ; t1/ Updated destination string pointer 19364 ; t2/ Updated source string pointer 19365 ; t3/ Length we translated 19366 19367 003200'01 cescxp: entry cescxp ; Also used by k20par 19368 003200'01 265 16 0 00 004271' saveac ;[248] Save registers for piggy MOVST 19369 003201'01 550 11 0 00 000004 hrrz p1, t4 ; Save requested table 19370 003202'01 505 11 0 00 015000 hrli p1, (movst 0,) ; Load correct extended instruction opcode 19371 003203'01 400 12 0 00 000000 setz p2, ; .chnul is the fill character 19372 003204'01 200 05 0 00 000001 move q1, t1 ; Position destination for MOVST 19373 003205'01 200 01 0 00 000003 move t1, t3 ; Set source length 19374 003206'01 200 04 0 00 000003 move t4, t3 ; Same as destination (so no fill) 19375 003207'01 200 07 0 00 000003 move q3, t3 ; Save (original) length for later 19376 003210'01 403 03 0 00 000006 setzb t3, q2 ; Force local pointers 19377 003211'01 400 13 0 00 000000 setz p3, ;[248] Count of characters munched K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 38-1 K20IOC MAC 25-Nov-23 20:18 cescxp C Escape Expansion 19378 003212'01 621 01 0 00 300000 txz t1, N!M ; Clear translation flags 19379 19380 003213'01 do. ; Enter loop context 19381 003213'01 661 01 0 00 400000 txo t1,S ; Set significance flag (start translating) 19382 003214'01 123 01 0 00 000011 extend t1, p1 ; Move the string, testing for end and 19383 003215'01 320 12 0 00 003217' %jserr (, r) ; Pass any machine error back up 19384 003216'01 254 00 0 00 003222' 19385 003217'01 265 01 0 00 003054* 19386 003220'01 000000000000# 19387 003221'01 254 00 0 00 003163* 19388 001153'04 115 117 126 123 124 19389 003222'01 623 01 0 00 200000 txze t1, N ; Bumped into a backslash? 19390 003223'01 254 00 0 00 003230' ifskp. ; We did not and may not have exhausted source 19391 003224'01 621 01 0 00 700000 txz t1, S!N!M ; Clear all the flags 19392 003225'01 200 10 0 00 000002 move q4, t2 ; Keep stopping source pointer 19393 003226'01 322 01 0 00 003237' jumpe t1, endlp. ;[248] If source is exhausted, we're done 19394 003227'01 344 01 0 00 003237' aoja t1, endlp. ; Account that .chnul was not consumed 19395 003230'01 endif. ; and we are done with the string move 19396 003230'01 621 01 0 00 700000 txz t1, S!N!M ; Clear all the flags 19397 003231'01 323 01 0 00 003237' jumple t1, endlp. ;[248] Done if no more source 19398 003232'01 323 04 0 00 003237' jumple t4, endlp. ;[248] Done if no more destination 19399 003233'01 271 13 0 00 000001 addi p3, ^d1 ;[248] Account for a backslash skipped 19400 003234'01 260 17 0 00 003261' call escchr ; Otherwise, process an escape character 19401 003235'01 263 17 0 00 000000 ret ; Failed, just stop right now 19402 003236'01 327 01 0 00 003213' jumpg t1, top. ; Keep moving characters until no more 19403 003237'01 enddo. ; End loop context 19404 19405 remark t2, ; Still has source 19406 003237'01 200 03 0 00 000007 move t3, q3 ; Load original length 19407 003240'01 274 03 0 00 000013 sub t3, p3 ;[248] ; Calculate what we finally produced 19408 003241'01 200 04 0 00 000001 move t4, t1 ;[248] ; Save final source count: 19409 003242'01 200 01 0 00 000005 move t1, q1 ;[248] ; Restore updated destination BEFORE terminating it 19410 003243'01 136 06 0 00 000005 idpb q2, q1 ;[248] ; Tie off destination 19411 ; Stopped before the end of the string? 19412 003244'01 323 04 0 00 003255' ifg. t4 ;[248] ; Uh oh... Stopped early. What did that? 19413 003245'01 135 04 0 00 000010 ldb t4, q4 ; Load source character that stopped us 19414 003246'01 246 04 0 00 777777 lshc t4, ^d<-1> ; Divide by two, shifting odd bit into bit zero 19415 003247'01 242 05 0 00 777735 lsh q1, ^d<-35> ; Shift into bit zero 19416 xct [ hlrz q2,chrtab(t4) ; Even, pick up left half 19417 003250'01 256 00 0 05 004307' hrrz q2,chrtab(t4) ](q1) ; Even, pick up right half 19418 003251'01 626 06 0 00 100000 txzn q2, eoscod ; Had to be an end of string 19419 003252'01 254 00 0 00 003255' anskp. ; But wasn't, so we're done 19420 003253'01 622 06 0 00 000200 txze q2, 200 ; Any parity? 19421 003254'01 263 17 0 00 000000 ret ; Yes, so that's bad; return +1 19422 003255'01 endif. ; End eigth bit checking 19423 003255'01 323 03 0 00 003221* jumple t3, R ; Nothing to do if nothing read 19424 003256'01 254 00 0 00 003125* retskp ; Return +2 19425 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 39 K20IOC MAC 25-Nov-23 20:18 Escape table for escape character substitution 19426 subttl Escape table for escape character substitution 19427 19428 ; The translate table assumes that exactly a SINGLE character is to be 19429 ; translated, unless a number is being given. The logic coupled with 19430 ; it is as follows: 19431 ; 19432 ; 1) If the character count is zero, then a single character 19433 ; substitution was possible and we are done. 19434 ; 19435 ; 2) Any character that does not have a valid escape mapping will 19436 ; terminate with the N bit set (note TRMCOD opcode). 19437 ; 19438 ; 3) Any character that requires further processing will terminate 19439 ; processing (EOSCOD), but the count will not be zero. These 19440 ; characters are currenly upper and lower X and decimal digits. 19441 19442 chgsec(code,const) ;;Put table in the constants .psect 19443 19444 000000 %escha=0 ; Starts out at .CHNUL 19445 19446 000650'02 esctab: remark ; Appropriately trigger on escape values 19447 xlist ; Don't need to see all this junk 19448 list ; Restart the blather 19449 19450 000750' %eoesc=. ; Remember end of table 19451 19452 000700'02 reloc esctab+<<"0">_-1> ; Gets us to the correct halfword pair 19453 xlist ; Save the trees!!! 19454 list ; Restart the blather 19455 19456 define escsub(chr1,sub1,chr2,sub2) < 19457 reloc esctab+<<&177>_-1> ;;Gets us to the correct halfword pair 19458 xwd sub1,sub2 ;;Emit the appropriate pair 19459 >;;escsub 19460 19461 000677'02 000056 500057 escsub(".",<".">,"/",) ;;Tops-10 monitor prompt 19462 000710'02 000100 000007 escsub("@",<"@">,"A",.chbel) ;;I kept fat fingering \@ ... 19463 000711'02 000010 000003 escsub("B",.chbsp,"C",.chcnc) 19464 000712'02 000004 000033 escsub("D",.chcnd,"E",.chesc) 19465 000713'02 000014 500107 escsub("F",.chffd,"G",); 19466 19467 000717'02 000012 000177 escsub("N",.chlfd,"O",.chdel) ;;[246] Obliterate 19468 000720'02 500120 000042 escsub("P",,"Q",.chdbq) 19469 000721'02 000015 500123 escsub("R",.chcrt,"S",) 19470 000722'02 000011 000000 escsub("T",.chtab,"U",.chnul) ;;[246] NUL 19471 000723'02 000013 500127 escsub("V",.chvtb,"W",) 19472 000725'02 000032 500133 escsub("Z",.chcnz,"[",) ;;Left brocket 19473 19474 000730'02 500140 000007 escsub("`",,"a",.chbel) 19475 000731'02 000010 000003 escsub("b",.chbsp,"c",.chcnc) 19476 000732'02 000004 000033 escsub("d",.chcnd,"e",.chesc) 19477 000733'02 000014 500147 escsub("f",.chffd,"g",); 19478 19479 000737'02 000012 000177 escsub("n",.chlfd,"o",.chdel) ;;[246] Obliterate 19480 000740'02 500160 000042 escsub("p",,"q",.chdbq) K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 39-1 K20IOC MAC 25-Nov-23 20:18 Escape table for escape character substitution 19481 000741'02 000015 500163 escsub("r",.chcrt,"s",) 19482 000742'02 000011 000000 escsub("t",.chtab,"u",.chnul) ;;[246] NUL 19483 000743'02 000013 500167 escsub("v",.chvtb,"w",) 19484 000745'02 000032 500173 escsub("z",.chcnz,173,) ;;Left curly brace 19485 19486 000671'02 000042 500043 escsub(.chdbq,.chdbq,"#",) ;;Double quote 19487 000673'02 500046 000047 escsub("&",,"'","'") 19488 000707'02 500076 000077 escsub(76,,"?","?") ;;Left pointy bracket 19489 000726'02 000134 500135 escsub("\","\","]",) ;;Right broket 19490 19491 000750'02 reloc %eoesc ; Get to back to end of table 19492 retsec ;;Re-open executable code 19493 19494 cleans(<%escha,%eoesc>) ;;Don't polute the symbol table 19495 19496 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 40 K20IOC MAC 25-Nov-23 20:18 Handle escape character substitution and expansion 19497 subttl Handle escape character substitution and expansion 19498 19499 ; See esctab commentary above for this routine's logic summary. In 19500 ; this routine's case, the MOVST is not being used for the efficiency 19501 ; of moving a string but rather for the 'relative' ease of using a 19502 ; table driven approach. However, this would still probably be more 19503 ; efficient than a worst case skip chain. 19504 ; 19505 ; Call: 19506 ; 19507 ; t1/ Remaining bytes in source string 19508 ; t2/ Section local pointer to source 19509 ; t3/ 0 (and must be zero) 19510 ; t4/ Remaining bytes in destination string 19511 ; q1/ Section local pointer to destination 19512 ; q2/ 0 (and must be zero) 19513 ; p3/ Count of characters skipped in source (like backslash and octal digits) ;[248] 19514 ; 19515 ; Return: 19516 ; 19517 ; +1/ Failed somehow 19518 ; +2/ Escape character substituted or expanded 19519 ; 19520 ; t1 through q2 updates as appropriate. 19521 ; p3 updated if doing something like a \002 ;[248] 19522 ; 19523 ; Be aware of the following: 19524 ; 19525 ; While the routine is fairly defensively coded, it makes an 19526 ; assumption that the destination string is always at least as long as 19527 ; the source. If this is the case, then the destination storage space 19528 ; can NEVER be overflowed because the minimal substitution will remove 19529 ; two characters from the source while depositing a single character 19530 ; in the destination. 19531 19532 003257'01 015 00 0 00 000000# escmov: movst 0,esctab ; Actual extend instruction being executed 19533 003260'01 000000 000000 .chnul ; Fill character is end of string (never used) 19534 19535 003261'01 escchr: entry escchr ; Used in k20par 19536 003261'01 265 16 0 00 004071' saveac ;[248] Extend needs SO many registers... 19537 003262'01 621 01 0 00 700000 txz t1, N!M!S ; Stomp flags so math and EXTEND work 19538 003263'01 337 07 0 00 000001 skipg q3, t1 ; Save and check remaining source count 19539 003264'01 334 00 0 00 000000 %ermsg (,r) 19540 003265'01 254 00 0 00 003271' 19541 003266'01 265 01 0 00 003217* 19542 003267'01 000000000000# 19543 003270'01 254 00 0 00 003255* 19544 001156'04 105 163 143 141 160 19545 003271'01 200 10 0 00 000004 move q4, t4 ; Save current remaining destination count 19546 19547 003272'01 200 01 0 00 004311' move t1,[S!<^d1>] ; Only looking at a SINGLE character of source 19548 003273'01 201 04 0 00 000001 movei t4,^d1 ; Destination will be always be one character 19549 003274'01 123 01 0 00 003257' extend t1, escmov ; Try to expand the escape 19550 003275'01 320 12 0 00 003277' %jserr (, r) ; Pass any machine error back up 19551 003276'01 254 00 0 00 003302' K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 40-1 K20IOC MAC 25-Nov-23 20:18 Handle escape character substitution and expansion 19552 003277'01 265 01 0 00 003266* 19553 003300'01 000000000000# 19554 003301'01 254 00 0 00 003270* 19555 001167'04 105 163 143 141 160 19556 19557 003302'01 607 01 0 00 200000 ifxn. t1, N ; Invalid escape character?? 19558 003303'01 254 00 0 00 003314' 19559 003304'01 200 01 0 00 000000# emsg 19560 003305'01 104 00 0 00 000313 19561 000750'02 000000000000# 19562 001173'04 111 154 154 145 147 19563 003306'01 135 01 0 00 000002 ldb t1, t2 ; Pick up what didn't work 19564 003307'01 104 00 0 00 000074 PBOUT% ; Show us 19565 003310'01 561 01 0 00 002626* hrroi t1, crlf ; Load end of line 19566 003311'01 104 00 0 00 000076 PSOUT% ; Print it 19567 003312'01 263 17 0 00 000000 ret ; Return failure 19568 003313'01 254 00 0 00 003316' else. ;[248] ; Otherwise, valid translation 19569 003314'01 621 01 0 00 700000 txz t1, N!M!S ;[248] ; Stomp flags so math works 19570 003315'01 200 11 0 00 000001 move p1, t1 ;[248] ; Save source count 19571 003316'01 endif. ;[248] ; End case handling an invalid escape character 19572 19573 003316'01 326 04 0 00 003334' ife. t4 ; Was this a simple substitution? 19574 003317'01 375 01 0 00 000007 sosge t1, q3 ; Yes, account for source byte consumed 19575 003320'01 334 00 0 00 000000 %ermsg (,r) 19576 003321'01 254 00 0 00 003325' 19577 003322'01 265 01 0 00 003277* 19578 003323'01 000000000000# 19579 003324'01 254 00 0 00 003301* 19580 001201'04 105 163 143 141 160 19581 003325'01 375 04 0 00 000010 sosge t4, q4 ; Account for destination byte consumed 19582 003326'01 334 00 0 00 000000 %ermsg (,r) 19583 003327'01 254 00 0 00 003333' 19584 003330'01 265 01 0 00 003322* 19585 003331'01 000000000000# 19586 003332'01 254 00 0 00 003324* 19587 001212'04 105 163 143 141 160 19588 003333'01 254 00 0 00 003256* retskp ; Return success 19589 003334'01 endif. 19590 19591 remark ; Here if we hit a digit 0 through 9 19592 003334'01 200 01 0 00 000007 move t1, q3 ; Original remaining source bytes is fine 19593 003335'01 200 11 0 00 000007 move p1, q3 ;[248] ; Save for later calculations 19594 003336'01 474 03 0 00 000000 seto t3, ; But must back up the source pointer 19595 003337'01 133 03 0 00 000002 adjbp t3, t2 ; because it did not translate the byte 19596 003340'01 200 02 0 00 000003 move t2, t3 ; Overwrite current 19597 003341'01 400 03 0 00 000000 setz t3, ; Keep source pointer section local 19598 003342'01 200 04 0 00 000010 move t4, q4 ; Restore original remaining destination bytes 19599 003343'01 260 17 0 00 003370' call cvtoct ; Convert ASCII octal digits to binary 19600 003344'01 263 17 0 00 000000 ret ; Pass the error up 19601 003345'01 274 11 0 00 000001 sub p1, t1 ;[248] ; Calculate digits consumed 19602 003346'01 270 13 0 00 000011 add p3, p1 ;[248] ; Add those into running total 19603 ; Range check result 19604 003347'01 303 03 0 00 000177 caile t3, .chdel ; Over 7 bits? 19605 003350'01 334 00 0 00 000000 %ermsg (,r) 19606 003351'01 254 00 0 00 003355' K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 40-2 K20IOC MAC 25-Nov-23 20:18 Handle escape character substitution and expansion 19607 003352'01 265 01 0 00 003330* 19608 003353'01 000000000000# 19609 003354'01 254 00 0 00 003332* 19610 001224'04 123 160 145 143 151 19611 003355'01 136 03 0 00 000005 idpb t3, q1 ; Deposit in output buffer 19612 003356'01 400 03 0 00 000000 setz t3, ; Keep source string section local 19613 003357'01 375 00 0 00 000004 sosge t4 ; Account for destination byte consumed 19614 003360'01 334 00 0 00 000000 %ermsg (,r) 19615 003361'01 254 00 0 00 003365' 19616 003362'01 265 01 0 00 003352* 19617 003363'01 000000000000# 19618 003364'01 254 00 0 00 003354* 19619 001235'04 105 163 143 141 160 19620 003365'01 254 00 0 00 003333* retskp ; Worked! 19621 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 41 K20IOC MAC 25-Nov-23 20:18 ASCII Octal to Binary Octal Conversion table 19622 subttl ASCII Octal to Binary Octal Conversion table 19623 19624 chgsec(code,const) ;;Put the table in the constants .psect 19625 19626 000000 %octal=0 ; ASCII values start at .chnul 19627 19628 000751'02 octtab: xlist ; Save the trees!!! 19629 list ; Safe to look now, phew!!!! 19630 19631 001051' %eooct==. ; Remember the end of octal table 19632 19633 001001'02 reloc octtab+<<"0">_-1> ; Gets us to the corrct halfword pair 19634 000000 %octal=0 ; Starting octal digit VALUE 19635 19636 repeat ^d4,< ; Only doing 4 pairs of digits 0 through 7 19637 xwd %octal,%octal+1 ; Emit the octal value for the ASCII digit 19638 %octal==%octal+2 ;;Step to next character pair 19639 > 19640 001001'02 000000 000001 19641 001002'02 000002 000003 19642 001003'02 000004 000005 19643 001004'02 000006 000007 19644 19645 remark 8,9 ;;Fail on decimal digits!!!! 19646 001005'02 500070 500071 xwd trmcod!<"8">,trmcod!<"9"> 19647 19648 001051'02 reloc %eooct ; Get back to the end of octtab table 19649 retsec ;;Restore code psect 19650 cleans(<%octal,%eooct>) ;;Don't polute the symbol table 19651 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 42 K20IOC MAC 25-Nov-23 20:18 Octal Conversion 19652 subttl Octal Conversion 19653 19654 ; The purpose of the function is to bum a NIN%. This done for two 19655 ; reasons: 19656 ; 19657 ; 1) It's faster (no JSYS overhead) 19658 ; 2) It keeps counters straight. 19659 ; 19660 ; Done only in the context of a previous movst (see escchr, 19661 ; above), so has an odd register file to contend with. 19662 ; 19663 ; Although a 36 bit word will hold twelve 3 bit octal digits, we limit 19664 ; it to eleven digits so we don't wind up having to deal with any 19665 ; goofy numbers that look negative. 19666 ; 19667 ; However, the limit here is 12. This allows us to determine the 19668 ; difference between a number that is too long and a character that 19669 ; terminated the translation. 19670 ; 19671 ; The conversion code is trivial, we don't even use a cvtdbo (which is 19672 ; the wrong base, anyway), but rather take a seven bit ASCII digit, 19673 ; subtract ASCII zero ("0") from it and then deposit it in a register. 19674 ; This is all done with a single MOVST. 19675 ; 19676 ; Upon termination, that binary octal number is left-normalized and 19677 ; need merely be right-normalized with a lshc. 19678 ; 19679 ; Call: 19680 ; 19681 ; t1/ Remaining bytes in source string 19682 ; t2/ Section local pointer to source 19683 ; t3/ 0 (and must be zero) 19684 ; t4/ Remaining bytes in destination string 19685 ; q1/ Section local pointer to destination 19686 ; q2/ 0 (and must be zero) 19687 ; 19688 ; Return: 19689 ; 19690 ; +1 Some kind of failure 19691 ; +2 19692 ; t1/ Updated with bytes consumed 19693 ; t2/ Updated pointer past digits consumed 19694 ; t3/ Binary form of octal number 19695 ; t4/ Preserved 19696 ; q1/ Preserved 19697 ; q2/ Preserved 19698 ; 19699 ; N.B., Caller *MUST* rezero t3!!! 19700 19701 003366'01 015 00 0 00 000000# octmov: movst 0,octtab ; Actual extend instruction being executed 19702 003367'01 000000 000000 .chnul ; Fill character is end of string (never used) 19703 19704 003370'01 265 16 0 00 004312' cvtoct: saveac ; Preserve what we'll stomp 19705 003371'01 621 01 0 00 300000 txz t1, N!M ; Clear the number flags 19706 003372'01 661 01 0 00 400000 txo t1, S ; Start translating immediately K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 42-1 K20IOC MAC 25-Nov-23 20:18 Octal Conversion 19707 dmove t4,[ ^d12 ; Maximum of eleven octal digits (see above) 19708 003373'01 120 04 0 00 004324' point 3, q3 ] ; N.B., 3 bit bytes!! 19709 003374'01 403 03 0 00 000006 setzb t3, q2 ;[248] ; Maintain section local pointers 19710 003375'01 400 07 0 00 000000 setz q3, ; Give the destination a clean slate 19711 003376'01 123 01 0 00 003366' extend t1, octmov ; Convert Octal digits 19712 003377'01 320 12 0 00 003401' %jserr (,r) 19713 003400'01 254 00 0 00 003404' 19714 003401'01 265 01 0 00 003362* 19715 003402'01 000000000000# 19716 003403'01 254 00 0 00 003364* 19717 001246'04 106 141 151 154 145 19718 19719 003404'01 607 01 0 00 200000 ifxn. t1, N ; Invalid digit?? 19720 003405'01 254 00 0 00 003415' 19721 003406'01 200 01 0 00 000000# emsg 19722 003407'01 104 00 0 00 000313 19723 001051'02 000000000000# 19724 001255'04 111 154 154 145 147 19725 003410'01 135 01 0 00 000002 ldb t1, t2 ; Pick up what didn't work 19726 003411'01 104 00 0 00 000074 PBOUT% ; Show us 19727 003412'01 561 01 0 00 003310* hrroi t1, crlf ; Load end of line 19728 003413'01 104 00 0 00 000076 PSOUT% ; Print it 19729 003414'01 263 17 0 00 000000 ret ; Return failure 19730 003415'01 endif. 19731 19732 003415'01 327 04 0 00 003423' ifle. t4 ; Exhausted destination string? 19733 003416'01 334 00 0 00 000000 %ermsg (,r) 19734 003417'01 254 00 0 00 003423' 19735 003420'01 265 01 0 00 003401* 19736 003421'01 000000000000# 19737 003422'01 254 00 0 00 003403* 19738 001265'04 123 160 145 143 151 19739 003423'01 endif. 19740 19741 003423'01 250 04 0 00 000007 exch t4, q3 ; Position left-justified result in adjacent AC 19742 003424'01 201 06 0 00 000014 movei q2, ^d12 ; Load original (slightly bogus) limit 19743 003425'01 274 06 0 00 000007 sub q2, q3 ; Calculate log base 8 of final number (heh) 19744 003426'01 325 06 0 00 003434' ifl. q2 ; Complete gubbish? 19745 003427'01 334 00 0 00 000000 %ermsg (,r) 19746 003430'01 254 00 0 00 003434' 19747 003431'01 265 01 0 00 003420* 19748 003432'01 000000000000# 19749 003433'01 254 00 0 00 003422* 19750 001300'04 117 143 164 141 154 19751 003434'01 endif. 19752 003434'01 326 06 0 00 003442' ife. q2 ; Never did anything?? 19753 003435'01 334 00 0 00 000000 %ermsg (,r) 19754 003436'01 254 00 0 00 003442' 19755 003437'01 265 01 0 00 003431* 19756 003440'01 000000000000# 19757 003441'01 254 00 0 00 003433* 19758 001310'04 117 143 164 141 154 19759 003442'01 endif. ; Very puzzling 19760 19761 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 20:02 27-Nov-23 Page 42-2 K20IOC MAC 25-Nov-23 20:18 Octal Conversion 19762 003443'01 246 03 0 06 000000 lshc t3, (q2) ; Shift the bits into the right place 19763 19764 003444'01 621 01 0 00 700000 txz t1, S!N!M ; Clear the flags some more 19765 003445'01 271 01 0 00 000001 addi t1,^d1 ; Account for character we stopped on 19766 003446'01 474 06 0 00 000000 seto q2, ; But are now at, so back up the point 19767 003447'01 133 06 0 00 000002 adjbp q2, t2 ; so that an ildb works and the consequent 19768 003450'01 250 06 0 00 000002 exch q2, t2 ; Say this is the real pointer 19769 003451'01 254 00 0 00 003365* retskp ; And return with the correct register file 19770 19771 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 43 K20IOC MAC 25-Nov-23 20:18 Translation table for first character to search for 19772 subttl Translation table for first character to search for 19773 19774 ; Translate tables cannot be in extended text (non-zero section) 19775 ; because we need to use them to transfer a few characters for match 19776 ; purposes. 19777 ; 19778 ; N.B., a NUL character stops the search, but does NOT set the 'N' 19779 ; bit! ntrigr has to account for this because data that comes back 19780 ; from Tops-10 can have NUL's in it. Might be padding. 19781 19782 chgsec(code,const) ;;Put table in constants area 19783 19784 000002 %asc1c=.chcnb ; ASCII values start at Control-B 19785 19786 remark Base translate table passes all 7 bit data 19787 19788 001052'02 100000 000001 btrnst: xwd eoscod!.chnul,.chcna ;;NUL terminates 19789 xlist ; Don't need to see all this junk 19790 list ; Restart the blather 19791 19792 remark For eight bit data, everything stops us 19793 19794 100200 %asc1c=eoscod!200!.chnul ; Anything we translate with bit 8 is bad 19795 19796 xlist ; Don't need to see all this junk 19797 list ; Restart the blather 19798 000200 sertln==.-btrnst ; Calculate search table length 19799 ; After second pass, not needed at all 19800 cleans(<%asc1c>) ;;Don't polute the symbol table 19801 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 44 K20IOC MAC 25-Nov-23 20:18 Caseless Translation table for first character to search for 19802 subttl Caseless Translation table for first character to search for 19803 19804 ; N.B., a NUL character stops the search, but does NOT set the 'N' 19805 ; bit! ntrigr has to account for this because data that comes back 19806 ; from Tops-10 can have NUL's in it. 19807 19808 000002 %asc1u=.chcnb ; ASCII values start at Control-B 19809 19810 remark Base translate table passes all 7 bit data, uppercasing along the way 19811 19812 001252'02 100000 000001 btrnsu: xwd eoscod!.chnul,.chcna ;;NUL terminates 19813 xlist ; Don't need to see all this junk 19814 list ; Restart the blather 19815 19816 001352' %eotsu=. ; Remember end of table 19817 19818 001332'02 reloc btrnsu+<<"`">_-1> ; Gets us to the corrct halfword pair 19819 001332'02 000140 000101 xwd "`","A" ; Convert lowercase a to UPPERcase A 19820 19821 000102 %asc1u="B" ; Starting at lowercase b 19822 xlist ; Don't need to see all this junk 19823 list ; Restart the blather 19824 19825 001347'02 000132 000173 xwd "Z",173 ; Last letter and Left brace 19826 19827 001352'02 reloc %eotsu ; Get back to end of table 19828 19829 remark For eight bit data, everything stops us 19830 19831 100200 %asc1u==eoscod!200!.chnul ; Anything we translate with bit 8 is bad 19832 .xcref %asc1u ; Keep off cross reference 19833 19834 xlist ; Don't need to see all this junk 19835 list ; Restart the blather 19836 19837 cleans(<%asc1u,%eotsu>) ;;Punt working symbols 19838 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 45 K20IOC MAC 25-Nov-23 20:18 Macro to build a parity generating and checking tables 19839 subttl Macro to build a parity generating and checking tables 19840 19841 ; Inspired by PARBIT remote macro in TTYSRV (see CHITAB). buildp is 19842 ; a more generalized approach to handle both checking and generating 19843 ; any kind of a parity table, suitable for string instructions. 19844 ; 19845 ; To generate various parities: 19846 ; 19847 ; Mark buildp(200,200) ;;Sets both odd and even, always 19848 ; Space buildp(0,0) ;;N.B., can be optimized with movslj for 7 bit 19849 ; Even buildp(200,0) ;;Only emit even parity bit 19850 ; Odd buildp(0,200) ;;Only emit odd parity bit 19851 ; 19852 ; To double check the table, set the parity you want and run a timing test 19853 19854 define buildp(evn,odp) < ;;Builds a parity table 19855 xlist ;; Save us the blat, please ... 19856 odp!.chnul,,evn!.chcna ;; 0 ^@,, 1 ^A NULL,, 19857 evn!.chcnb,,odp!.chcnc ;; 2 ^B,, 3 ^C 19858 evn!.chcnd,,odp!.chcne ;; 4 ^D,, 5 ^E 19859 odp!.chcnf,,evn!.chbel ;; 6 ^F,, 7 ^G ,,Bell 19860 evn!.chbsp,,odp!.chtab ;; 10 ^H,, 11 ^I Backspace,,Tab 19861 odp!.chlfd,,evn!.chvtb ;; 12 ^J,, 13 ^K Line-Feed,,Vertical Tab 19862 odp!.chffd,,evn!.chcrt ;; 14 ^L,, 15 ^M Form Feed,,Carriage Return 19863 evn!.chcnn,,odp!.chcno ;; 16 ^N,, 17 ^O 19864 evn!.chcnp,,odp!.chcnq ;; 20 ^P,, 21 ^Q 19865 odp!.chcnr,,evn!.chcns ;; 22 ^R,, 23 ^S 19866 odp!.chcnt,,evn!.chcnu ;; 24 ^T,, 25 ^U 19867 evn!.chcnv,,odp!.chcnw ;; 26 ^V,, 27 ^W 19868 odp!.chcnx,,evn!.chcny ;; 30 ^X,, 31 ^Y 19869 evn!.chcnz,,odp!.chesc ;; 32 ^Z,, 33 ^[ ,,Escape Control 19870 evn!.chcbs,,odp!.chcrb ;; 34 ^\,, 35 ^] Control Backslash,,Right Bracket 19871 odp!.chccf,,evn!.chcun ;; 36 ^^,, 37 ^_ Control Cicumflex,,Underline 19872 evn!.chspc,,odp!"!" ;; 40 ,, 41 ! Space,, 19873 odp!.chdbq,,evn!"#" ;; 42 " ,, 43 # Double quote,, 19874 odp!"$",,evn!"%" ;; 44 $ ,, 45 % 19875 evn!"&",,odp!"'" ;; 46 & ,, 47 ' 19876 odp!"(",,evn!")" ;; 50 ( ,, 51 ) 19877 evn!"*",,odp!"+" ;; 52 * ,, 53 + 19878 evn!",",,odp!"-" ;; 54 , ,, 55 - Comma,,Dash (Minus Sign) 19879 odp!".",,evn!"/" ;; 56 . ,, 57 / Dot,,Forward Slash 19880 odp!"0",,evn!"1" ;; 60 0 ,, 61 1 19881 evn!"2",,odp!"3" ;; 62 2 ,, 63 3 19882 evn!"4",,odp!"5" ;; 64 4 ,, 65 5 19883 odp!"6",,evn!"7" ;; 66 6 ,, 67 7 19884 evn!"8",,odp!"9" ;; 70 8 ,, 71 9 19885 odp!":",,evn!";" ;; 72 : ,, 73 ; Colen,, Semicolen 19886 odp!.chlpt,,evn!"=" ;; 74 ,, 75 = Left pointy,, 19887 evn!.chrpt,,odp!"?" ;; 76 ,, 77 ? ,,Right pointy 19888 evn!"@",,odp!"A" ;; 100 @ ,,101 A 19889 odp!"B",,evn!"C" ;; 102 B ,,103 C 19890 odp!"D",,evn!"E" ;; 104 D ,,105 E 19891 evn!"F",,odp!"G" ;; 106 F ,,107 G 19892 odp!"H",,evn!"I" ;; 110 H ,,111 I 19893 evn!"J",,odp!"K" ;; 112 J ,,113 K K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 45-1 K20IOC MAC 25-Nov-23 20:18 Macro to build a parity generating and checking tables 19894 evn!"L",,odp!"M" ;; 114 L ,,115 M 19895 odp!"N",,evn!"O" ;; 116 N ,,117 O 19896 odp!"P",,evn!"Q" ;; 120 P ,,121 Q 19897 evn!"R",,odp!"S" ;; 122 R ,,123 S 19898 evn!"T",,odp!"U" ;; 124 T ,,125 U 19899 odp!"V",,evn!"W" ;; 126 V ,,127 W 19900 evn!"X",,odp!"Y" ;; 130 X ,,131 Y 19901 odp!"Z",,evn!"[" ;; 132 Z ,,133 [ ,,Open Broket 19902 odp!"\",,evn!"]" ;; 134 \ ,,135 ] Backslash,,Close Broket 19903 evn!"^",,odp!"_" ;; 136 ^ ,,137 _ Up arrow,,Underline 19904 odp!"`",,evn!"a" ;; 140 ` ,,141 a Backtic (accent grave) 19905 evn!"b",,odp!"c" ;; 142 b ,,143 c 19906 evn!"d",,odp!"e" ;; 144 d ,,145 e 19907 odp!"f",,evn!"g" ;; 146 f ,,147 g 19908 evn!"h",,odp!"i" ;; 150 h ,,151 i 19909 odp!"j",,evn!"k" ;; 152 j ,,153 k 19910 odp!"l",,evn!"m" ;; 154 l ,,155 m 19911 evn!"n",,odp!"o" ;; 156 n ,,157 o 19912 evn!"p",,odp!"q" ;; 160 p ,,161 q 19913 odp!"r",,evn!"s" ;; 162 r ,,163 s 19914 odp!"t",,evn!"u" ;; 164 t ,,165 u 19915 evn!"v",,odp!"w" ;; 166 v ,,167 w 19916 odp!"x",,evn!"y" ;; 170 x ,,171 y 19917 evn!"z",,odp!"{" ;; 172 z ,,173 { Open Curly Brace 19918 evn!"|",,odp!"}" ;; 174 | ,,175 } Vertical Bar,,Close Curley Brace 19919 odp!"~",,evn!.chdel ;; 176 ~ ,,177 $? HZ2000 Lead in (!),,Rubout 19920 list ;; Turn the blat back on 19921 >;;buildp 19922 19923 define badpar (b,%b,%c) < ;;Generates a table with bad parity 19924 ifb ,<%b=0> ;;If no bit specified, default to zero 19925 ifnb ,<%b=b> ;;Otherwise, use the bit 19926 %c=trmcod!%b!.chnul ;;Starts out with NUL character, which fails 19927 xlist ; Don't need to see all this junk 19928 repeat ^d<<128>_-1>,< ;;Fill table with one to one translations 19929 xwd %c,%c+1 ;;Properly fill half words, failing every single one 19930 %c=%c+2 ;;Step to next pair 19931 >;;repeat ^d64 ;;Do remaining 126 characters 19932 list ; Restart the blather 19933 cleans(<%b,%c>) ;;Punt working symbols 19934 > K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 46 K20IOC MAC 25-Nov-23 20:18 String based parity generating and checking tables 19935 subttl String based parity generating and checking tables 19936 19937 ;[223] Begin table insertions (still in const .psect) 19938 19939 remark Seven to Eight bit parity generating tables 19940 19941 ; N.B., as with single character routines, bit 8 is disregarded 19942 ; when generating parity 19943 19944 001452'02 spar7t: buildp(0,0) ; Space parity simply always clears bit 8 19945 buildp(0,0) ; Clear it for anything with bit 8 up 19946 001652'02 mpar7t: buildp(200,200) ; Mark parity simply always sets bit 8 19947 buildp(200,200) ; Set it for anthing with bit 8 up 19948 002052'02 epar7t: buildp(200,0) ; Build even parity generating table 19949 buildp(200,0) ; Ignore bit 8 and process as if it were zero 19950 002252'02 opar7t: buildp(0,200) ; Build odd parity generating table 19951 buildp(0,200) ; Ignore bit 8 and process as if it were zero 19952 19953 subttl Eight to Seven bit parity checking tables 19954 19955 002452'02 spar8t: buildp(0,0) ; For space, the 1st 128 do not have bit 8 set, so fine 19956 badpar(200) ; However, any with bit 8 up are BAD 19957 002652'02 mpar8t: badpar(0) ; For mark, the 1st 128 do not have bit 8 set, so BAD 19958 buildp(0,0) ; 2nd 128 have bit 8 up, so fine; strip off the parity 19959 003052'02 epar8t: buildp(trmcod,0) ; Anything with even parity should NOT be in lower 128 19960 buildp(0,trmcod) ; Otherwise, odd parity should not be in upper 128 19961 003252'02 opar8t: buildp(0,trmcod) ; Any odd parity set should not be in lower 128 19962 buildp(trmcod,0) ; Likewise, even parity should not be in upper 128 19963 19964 retsec ; Back into code .psect 19965 19966 ;[223] End table insertions 19967 19968 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 47 K20IOC MAC 25-Nov-23 20:18 Parity routines, used for a single byte and checking 19969 subttl Parity routines, used for a single byte and checking 19970 19971 ; All accept a character in t1, returning the same character with proper 19972 ; parity in t1. +1 always because nothing fails. Supposedly... 19973 19974 003452'01 none: remark ; Default, don't touch the eighth bit. 19975 entry none 19976 003452'01 263 17 0 00 000000 ret 19977 19978 003453'01 mark: remark ; Mark, bit 8 is always 1. 19979 entry mark 19980 003453'01 435 01 0 00 000200 ori t1, ^o200 ; Turn on the parity bit. 19981 003454'01 263 17 0 00 000000 ret 19982 19983 003455'01 space: remark ; Space, opposite of mark, bit 8 is always zero. 19984 entry space 19985 003455'01 405 01 0 00 000177 andi t1, ^o177 ; Turn off the parity bit. 19986 003456'01 263 17 0 00 000000 ret 19987 19988 003457'01 even: remark ; Even, the total number of one bits should be even. 19989 entry even 19990 003457'01 265 16 0 00 004326' saveac 19991 003460'01 405 01 0 00 000177 andi t1, ^o177 ; Start off with bit 8 = 0. 19992 003461'01 200 02 0 00 000001 move t2, t1 19993 003462'01 254 00 0 00 003466' jrst evnodd 19994 19995 003463'01 odd: remark ; Odd, the total number of one bits should be odd. 19996 entry odd 19997 003463'01 265 16 0 00 004326' saveac 19998 003464'01 405 01 0 00 000177 andi t1, ^o177 ; Turn off the parity bit. 19999 003465'01 201 02 0 01 000200 movei t2, ^o200(t1) ; Start off with bit 8 = 1. 20000 20001 003466'01 evnodd: remark ; The actual worker subroutine 20002 003466'01 242 02 0 00 777774 lsh t2, -4 ; Get high order 4 bits of character 20003 003467'01 431 02 0 01 000000 xori t2, (t1) ; Fold into 4 bits. 20004 003470'01 642 02 0 00 000014 trce t2, 14 ; Left two bits both 0 or 1? 20005 003471'01 606 02 0 00 000014 trnn t2, 14 ; or both 1? 20006 003472'01 431 01 0 00 000200 xori t1, 200 ; Yes, set parity 20007 003473'01 642 02 0 00 000003 trce t2, 3 ; Right two bits both 0? 20008 003474'01 606 02 0 00 000003 trnn t2, 3 ; or both 1? 20009 003475'01 431 01 0 00 000200 xori t1, 200 ; Yes, set parity. 20010 003476'01 263 17 0 00 000000 ret 20011 20012 ;[209] End code insertion 20013 20014 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 48 K20IOC MAC 25-Nov-23 20:18 SET PARITY parsing tables 20015 subttl SET PARITY parsing tables 20016 20017 ;[223] This code moved from k20par and updated 20018 20019 003452'02 000000 000000 %table(partab) ;[223] Values are all table offsets, below 20020 003453'02 000000# 000003 %key2 , .parev ;[223] 20021 000050'03 145 166 145 156 000 20022 003454'02 000000# 000002 %key2 , .parmk ;[223] 20023 000051'03 155 141 162 153 000 20024 003455'02 000000# 000000 %key2 , .parno ;[223] 20025 000052'03 156 157 156 145 000 20026 003456'02 000000# 003457' %keyf3 , %odd, ;[223] Abbreviate documented name 20027 000053'03 002000 000005 20028 000054'03 157 000 000 000 000 20029 003457'02 000000# 000004 %odd: %key2 , .parod ;[223] 20030 000055'03 157 144 144 000 000 20031 003460'02 000000# 000002 %keyf3 , .parmk, cm%inv ;[223] A common nickname for 'mark' 20032 000056'03 002000 000001 20033 000057'03 157 156 145 000 000 20034 003461'02 000000# 000001 %key2 , .parsp ;[223] 20035 000060'03 163 160 141 143 145 20036 003462'02 000000# 000001 %keyf3 , .parsp, cm%inv ;[223] A common nickname for 'space' 20037 000062'03 002000 000001 20038 000063'03 172 145 162 157 000 20039 003452'02 000010 000010 %tbend 20040 20041 ;[223] Begin Switch table insertion 20042 20043 comment " The plethora of invisible entries are a result of my being 20044 purely unable to come up with what I thought would be a good 20045 keyword, picking something to get on with it, becoming 20046 dissatisified or otherwise annoyed with that particular 20047 choice and then trying something else until things finally 20048 'looked right', both in a printed switch list and in the 20049 help text. Of course, then I would remember the old names 20050 and ... 20051 " 20052 20053 ; Define some mnemonic symbols to help us not to be confused... 20054 20055 define %Yes <;;> ;;There should only be four (4) documented entries 20056 000001 %No==cm%inv ;;Means not documented in k20hlp.mac 20057 20058 remark ; These are the parity switches 20059 20060 003463'02 000000 000000 %table(parswi) 20061 remark AC Value Documented? 20062 003464'02 000000# 000000# %keyf4 (, q3, 0, %No ) 20063 000064'03 002000 000001 20064 000065'03 141 154 154 055 143 20065 000070'03 000007 000000 20066 003465'02 000000# 000000# %key3 (, q4, -1) 20067 000071'03 143 150 145 143 153 20068 000075'03 000010 777777 20069 %Yes K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 48-1 K20IOC MAC 25-Nov-23 20:18 SET PARITY parsing tables 20070 003466'02 000000# 000000# %keyf4 (, q3, 0, %No ) 20071 000076'03 002000 000001 20072 000077'03 145 166 145 162 171 20073 000102'03 000007 000000 20074 003467'02 000000# 000000# %key3 (, q4, 0) 20075 000103'03 147 145 156 145 162 20076 000106'03 000010 000000 20077 %Yes 20078 003470'02 000000# 000000# %key3 (, q3, -1) 20079 000107'03 160 141 143 153 145 20080 000112'03 000007 777777 20081 %Yes 20082 003471'02 000000# 000000# %keyf4 (, q4, -1, %No ) 20083 000113'03 002000 000001 20084 000114'03 160 141 162 151 164 20085 000120'03 000010 777777 20086 003472'02 000000# 000000# %keyf4 (, q4, -1, %No ) 20087 000121'03 002000 000001 20088 000122'03 162 145 143 145 151 20089 000125'03 000010 777777 20090 003473'02 000000# 000000# %key3 (, q3, 0) 20091 000126'03 164 145 162 155 151 20092 000133'03 000007 000000 20093 %Yes 20094 003463'02 000010 000010 %tbend 20095 20096 cleans(<%Yes,%No>) ;;Clean up worker symbols 20097 20098 ;[223] End switch table insertion 20099 20100 chgsec(code,const) ;;[223] FDB's are not in code, they're in const 20101 20102 003474'02 schrpr: remark ;[223] Single character parity routines 20103 003474'02 000000000000# none ;[223] Don't do parity 20104 003475'02 000000000000# space ;[223] Bit 8 is always clear 20105 003476'02 000000000000# mark ;[223] Bit 8 is always set 20106 003477'02 000000000000# even ;[223] Even parity 20107 003500'02 000000000000# odd ;[223] Odd parity 20108 20109 003501'02 stpart: remark ;[223] String based parity tables 20110 003501'02 000 00 0 00 000000 Z ;[223] None means do nothing 20111 003502'02 001452' 002452' spar7t,,spar8t ;[223] Space parity generating and checking 20112 003503'02 001652' 002652' mpar7t,,mpar8t ;[223] Mark parity generating and checking 20113 003504'02 002052' 003052' epar7t,,epar8t ;[223] Even parity generating and checking 20114 003505'02 002252' 003252' opar7t,,opar8t ;[223] Odd parity generating and checking 20115 20116 003506'02 010004 003511' spafdb: flddb. .cmcfm,,,,,spafdd 20117 003507'02 000000 000000 20118 003510'02 44 07 0 00 003721' 20119 003511'02 000000 000000 spafdd: flddb. .cmkey,,partab,,,, ;;[223] If in a define 20120 003512'02 000000 003452' 20121 20122 003513'02 010004 003516' spwfdb: flddb. .cmcfm,,,,,spwfdd 20123 003514'02 000000 000000 20124 003515'02 44 07 0 00 003732' K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 48-2 K20IOC MAC 25-Nov-23 20:18 SET PARITY parsing tables 20125 003516'02 003002 000000 spwfdd: flddb. .cmswi,,parswi,,,, ;;[223] If in a define 20126 003517'02 000000 003463' 20127 003520'02 000000 000000 20128 003521'02 44 07 0 00 003737' 20129 20130 retsec ;;Back to where-ever we started from 20131 20132 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 49 K20IOC MAC 25-Nov-23 20:18 SET PARITY parsing 20133 subttl SET PARITY parsing 20134 20135 003477'01 .setpa: entry .setpa ;[223] Invoked from k20par 20136 003477'01 200 16 0 00 000000# guide 20137 003500'01 260 17 0 00 001511* 20138 003522'02 000000000000# 20139 001321'04 164 157 000 000 000 20140 003501'01 201 01 0 00 000000# movei t1, spafdb ;[223] Assume not defining a macro 20141 003502'01 332 00 0 00 000250* skipe definf ;[223] But!! Are we in a define? 20142 003503'01 201 01 0 00 000000# movei t1, spafdd ;[223] Indeed; don't parse a confirm 20143 003504'01 260 17 0 00 001546* call rfield ; Parse a keyword. 20144 003505'01 135 03 0 00 004011' ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ;[223] Get what was parsed 20145 20146 003506'01 302 03 0 00 000010 caie t3, .cmcfm ;[223] Parsed a confirm? 20147 003507'01 254 00 0 00 003514' ifskp. ;[223] We did, 20148 003510'01 403 02 0 00 000003 setzb t2, t3 ;[223] so load default values 20149 003511'01 202 02 0 00 001361* movem t2, pars3 ;[223] Offset zero is 'none' 20150 003512'01 124 02 0 00 002060* dmovem t2, pars4 ;[223] Parity on all I/O, sent--not checked 20151 003513'01 263 17 0 00 000000 ret ;[223] Nothing further to do; comand is confirmed 20152 003514'01 endif. ;[223] End requesting default values 20153 20154 003514'01 265 16 0 00 004027' saveac ;[223] Needs a few more registers 20155 003515'01 550 02 0 02 000000 hrrz t2, (t2) ; Get the value for the keyword. 20156 003516'01 120 05 0 00 000002 dmove q1, t2 ;[223] Save value and parse type 20157 003517'01 403 07 0 00 000010 setzb q3, q4 ;[223] Assume parity on all I/O, sent--not checked 20158 20159 003520'01 do. ;[223] Enter loop context 20160 003520'01 201 01 0 00 000000# movei t1, spwfdb ;[223] Assume we can confirm 20161 003521'01 332 00 0 00 003502* skipe definf ;[223] But!! Are we in a define? 20162 003522'01 201 01 0 00 000000# movei t1, spwfdd ;[223] We are; wait on the confirm 20163 003523'01 260 17 0 00 000000* call rflde ;[223] Try to parse something 20164 003524'01 254 00 0 00 003535' ifskp. ;[223] Worked!! 20165 003525'01 135 06 0 00 004011' ldb q2, [pointr (.cmfnp(t3),cm%fnc)] ;[223] Get function code. 20166 003526'01 306 06 0 00 000010 cain q2, .cmcfm ;[223] Finally finished typing switches? 20167 003527'01 254 00 0 00 003541' exit. ;[223] Yes, break out of the loop 20168 003530'01 550 01 0 02 000000 hrrz t1, (t2) ;[223] Get the value pair for the switch 20169 003531'01 554 02 0 01 000000 hlrz t2, (t1) ;[223] Pick up the address 20170 003532'01 570 03 0 01 000000 hrre t3, (t1) ;[223] Sign extend the value 20171 003533'01 202 03 0 02 000000 movem t3, (t2) ;[223] Side effect something 20172 003534'01 254 00 0 00 003540' else. ;[223] Otherwise, failed the parse 20173 003535'01 336 00 0 00 003521* skipn definf ;[223] In DEFINE? 20174 003536'01 254 00 0 00 000000* jrst cmderr ;[223] No, so a definite parse error; allow retry 20175 003537'01 263 17 0 00 000000 ret ;[223] Return into DEFINE and see if that chokes 20176 003540'01 endif. ;[223] End parse result handling 20177 003540'01 254 00 0 00 003520' loop. ;[223] Get another switch 20178 003541'01 enddo. ;[223] End loop lexical context 20179 20180 003541'01 202 05 0 00 003511* movem q1, pars3 ;[223] Store parity actions 20181 003542'01 124 07 0 00 003512* dmovem q3, pars4 ;[223] Store where to apply parity 20182 003543'01 263 17 0 00 000000 ret ;[223] Whether or not in a define, can return 20183 20184 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 50 K20IOC MAC 25-Nov-23 20:18 SET PARITY semantic action 20185 subttl SET PARITY semantic action 20186 20187 extern nrtflg ;[223] Tops-20/Tops-10 DECnet NRT? 20188 extern ptyflg ;[223] Talking to ourselves? 20189 extern lclpar ;[223] Whether local line will do parity 20190 extern opnpar ;[223] Whether open device will do parity 20191 extern parity ;[194] Parity routine we'll use 20192 extern ebq ;[194] Eight bit quoting character 20193 extern ebqr ;[194] We'll request eight bit quoting 20194 20195 chgsec(code,data) ;[223] Need writable storage 20196 000000'05 000 00 0 00 000000 genint:: Z ;[223] Constructed instruction to generate parity 20197 000001'05 000 00 0 00 000000 chkint:: Z ;[223] Constructed instruction to check parity 20198 000002'05 000 00 0 00 000000 parpko:: Z ;[223] Doing parity on packets, only 20199 000003'05 000 00 0 00 000000 parrck:: Z ;[223] Checking parity on recieve in addition to sending 20200 retsec ;[223] Get back into code psect 20201 20202 003544'01 $setpa: entry $setpa ;[223] Invoked from k20par 20203 extern ttfork ;[223] Parity change forces a fork-reset 20204 003544'01 265 16 0 00 004012' saveac ;[223] Needs a register 20205 20206 003545'01 120 01 0 00 003542* dmove t1, pars4 ;[223] Pick up parity domain parse results 20207 003546'01 124 01 0 00 000000# dmovem t1, parpko ;[223] Store in global variables 20208 20209 003547'01 200 05 0 00 003541* move q1, pars3 ;[223] What did they say? 20210 003550'01 200 06 0 05 000000# move q2, schrpr(q1) ;[223] Pick up single character parity routine 20211 003551'01 554 02 0 05 000000# hlrz t2, stpart(q1) ;[223] Load string based parity generation routine 20212 003552'01 322 02 0 00 003557' ifn. t2 ;[223] Do we have anything? 20213 003553'01 550 03 0 05 000000# hrrz t3, stpart(q1) ;[223] Yes, load string based parity checking routine 20214 003554'01 505 02 0 00 015000 hrli t2, (movst 0,0) ;[223] Drop in the 20215 003555'01 505 03 0 00 015000 hrli t3, (movst 0,0) ;[223] extended opcodes 20216 003556'01 254 00 0 00 003560' else. ;[223] Otherwise, this is 'none', which is special cased 20217 003557'01 400 03 0 00 000000 setz t3, ;[223] Nothing in t3 20218 003560'01 endif. ;[223] End case extended instruction construction 20219 003560'01 124 02 0 00 000000# dmovem t2, genint ;[223] Store both extended string instructions 20220 003561'01 202 06 0 00 003011* movem q2, parity ;[223] Store single character routines 20221 20222 003562'01 260 17 0 00 003645' call parchr ;[223] Recompute parity on important characters 20223 003563'01 336 01 0 00 000000* skipn t1, ttfork ;[223] Are we doing interactive communications? 20224 003564'01 254 00 0 00 003574' ifskp. ;[223] We are, must reset to use new parity 20225 003565'01 104 00 0 00 000153 KFORK% ;[223] Whack the communications fork 20226 003566'01 320 12 0 00 003570' %jsErr (,) ;[223] 20227 003567'01 254 00 0 00 003573' 20228 003570'01 265 01 0 00 003437* 20229 003571'01 000000000000# 20230 003572'01 254 00 0 00 003573' 20231 001322'04 125 156 141 142 154 20232 003573'01 402 00 0 00 003563* setzm ttfork ;[223] And force a recreate 20233 003574'01 endif. ;[223] End case resetting comunications fork 20234 20235 003574'01 302 06 0 00 003452' caie q2, none ;[194] Was the parity NONE? 20236 003575'01 254 00 0 00 003602' ifskp. ;[194] Yes, it was 20237 003576'01 201 01 0 00 000131 movei t1, "Y" ;[194] Just say we will do 8th-bit 20238 003577'01 202 01 0 00 000000* movem t1, ebq ;[95] prefixing if requested. 20239 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 20:02 27-Nov-23 Page 50-1 K20IOC MAC 25-Nov-23 20:18 SET PARITY semantic action 20240 003601'01 254 00 0 00 003644' else. ;[194] Otherwise, not NONE 20241 003602'01 476 00 0 00 003600* setom ebqr ;[194] So request 8th-bit prefixing. 20242 003603'01 201 02 0 00 000046 movei t2, dqbin ;[89] Use the default prefix. 20243 003604'01 202 02 0 00 003577* movem t2, ebq ;[89] 20244 003605'01 336 00 0 00 002474* ifmn. netjfn ;[223] Network connection? 20245 003606'01 254 00 0 00 003634' 20246 003607'01 332 00 0 00 000000* ifme. opnpar ;[223] Yes, does it NOT do parity? 20247 003610'01 254 00 0 00 003633' 20248 003611'01 336 00 0 00 000000* ifmn. nrtflg ;[223] DECnet connection? 20249 003612'01 254 00 0 00 003617' 20250 003613'01 200 01 0 00 000000# txmsg <%Network connection> ;[223] Yes, say as such 20251 003614'01 104 00 0 00 000076 20252 003615'01 320 12 0 00 003616' 20253 003523'02 000000000000# 20254 001335'04 045 116 145 164 167 20255 003616'01 254 00 0 00 003630' else. ;[223] Otherwise, it's something else 20256 003617'01 336 00 0 00 000000* ifmn. ptyflg ;[223] PTY? 20257 003620'01 254 00 0 00 003625' 20258 003621'01 200 01 0 00 000000# txmsg <%Pseudo-terminal> ;[223] 20259 003622'01 104 00 0 00 000076 20260 003623'01 320 12 0 00 003624' 20261 003524'02 000000000000# 20262 001341'04 045 120 163 145 165 20263 003624'01 254 00 0 00 003630' else. ;[223] Otherwise, physical line 20264 003625'01 200 01 0 00 000000# txmsg <%Terminal line> ;[223] 20265 003626'01 104 00 0 00 000076 20266 003627'01 320 12 0 00 003630' 20267 003525'02 000000000000# 20268 001345'04 045 124 145 162 155 20269 003630'01 endif. ;[223] End PTY decision 20270 003630'01 endif. ;[223] End NRT decision 20271 txmsg < does not support parity 20272 003630'01 200 01 0 00 000000# > ;[223] Remind terminal-and-packets ill-advised 20273 003631'01 104 00 0 00 000076 20274 003632'01 320 12 0 00 003633' 20275 003526'02 000000000000# 20276 001350'04 040 144 157 145 163 20277 20278 003633'01 endif. ;[223] End case parity on network device 20279 003633'01 254 00 0 00 003641' else. ;[223] Otherwise, using control terminal 20280 003634'01 332 00 0 00 000000* ifme. lclpar ;[223] Will local line will do parity? 20281 003635'01 254 00 0 00 003641' 20282 txmsg <%Control terminal line does not support parity 20283 003636'01 200 01 0 00 000000# > ;[223] Remind terminal-and-packets ill-advised 20284 003637'01 104 00 0 00 000076 20285 003640'01 320 12 0 00 003641' 20286 003527'02 000000000000# 20287 001356'04 045 103 157 156 164 20288 20289 003641'01 endif. ;[223] 20290 003641'01 endif. ;[223] End case checking device parity toleration 20291 txmsg <%Will request 8th-bit prefixing. 20292 If the other KERMIT doesn't agree, binary files cannot be sent correctly. 20293 003641'01 200 01 0 00 000000# > 20294 003642'01 104 00 0 00 000076 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 50-2 K20IOC MAC 25-Nov-23 20:18 SET PARITY semantic action 20295 003643'01 320 12 0 00 003644' 20296 003530'02 000000000000# 20297 001370'04 045 127 151 154 154 20298 20299 20300 003644'01 endif. ;[194] End case doing SOME kind of parity 20301 20302 003644'01 263 17 0 00 000000 ret 20303 20304 ;[223] End code move 20305 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 51 K20IOC MAC 25-Nov-23 20:18 If parity changes, side effect certain characters 20306 subttl If parity changes, side effect certain characters 20307 20308 ;[223] Begin code insertion 20309 20310 ; Parity had been computed on all characters in a sending packet 20311 ; except where a character might be outside of the packet proper. One 20312 ; such character would be padding, which is simply emitted before the 20313 ; packet itself is sent. 20314 ; 20315 ; Now the entire message is built including the padding, start-of- 20316 ; header and end-of-line characters and then putpar is called to apply 20317 ; parity in a single extended instruction. 20318 ; 20319 ; There are certain situations where the characters are looked for 20320 ; individually, so this code applies parity to all of them whenever 20321 ; parity changes. If the characters themselves change, then the 20322 ; routines doing the changes apply current parity. 20323 ; 20324 ; Note that we don't tweak the received characters because the chkpar 20325 ; routine is called before we ever get to checking them. Since it 20326 ; strips parity, we don't need to worry about it; when receiving... 20327 20328 remark ; Document what we'll be tweaking 20329 extern ssthdr ; Sending start of header character 20330 remark rsthdr ; Receiving start of header character 20331 extern spadch ; Sending padding character 20332 remark rpadch ; Receiving padding character 20333 extern seolch ; Sending End of Line character 20334 remark reolch ; Receiving End of Line character 20335 extern handsh ; Handshake character 20336 20337 chgsec(code,const) ; Table of addresses is constant data 20338 003531'02 000000000000# pchars: exp ssthdr,spadch,seolch,handsh 20339 000004 pcharl==.-pchars ; Number of entries in the table 20340 retsec ; Return to code psect 20341 20342 003645'01 265 16 0 00 004003' parchr: saveac ; Used as a counter 20343 003646'01 201 05 0 00 000003 movx q1, ; Load maximum offset 20344 20345 003647'01 do. ; Enter loop context 20346 003647'01 200 01 1 05 000000# move t1, @pchars(q1) ; Load the character 20347 003650'01 405 01 0 00 000177 andi t1, ^o177 ; Stomp any previous parity 20348 003651'01 260 17 0 06 000000 call (q2) ; Apply the appropriate parity 20349 003652'01 202 01 1 05 000000# movem t1, @pchars(q1) ; Store the proper character 20350 003653'01 365 05 0 00 003647' sojge q1, top. ; Do the next character until done 20351 003654'01 enddo. ; End of loop lexical context 20352 20353 003654'01 263 17 0 00 000000 ret ; Done fixing up everything 20354 20355 cleans () ; Clean up working symbol 20356 20357 ;[223] End code insertion 20358 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 52 K20IOC MAC 25-Nov-23 20:18 Put parity on an eight bit stream 20359 subttl Put parity on an eight bit stream 20360 20361 ;[223] Begin code insertion 20362 20363 ; The algorythm is actually straightforward; the routine is passed a 20364 ; pointer to a buffer that is almost ready to send, meaning we are the 20365 ; last operation directly before the SOUT%/SOUTR%. The buffer is 20366 ; assumed to contain 7 bit ASCII characters in 8 bit bytes, thus 20367 ; giving the routine a place to put the parity. 20368 ; 20369 ; It checks whether parity is being done and, if so, loads the single 20370 ; instruction that will perform the operation. This is a MOVST which 20371 ; has been constructed with the appropriate translate table. 20372 ; 20373 ; Again, although the byte pointer being passed is eight bits, the 20374 ; string is treated as a series of seven bit bytes in 8 bit fields 20375 ; where the current setting of the eigth bit is discarded. The string 20376 ; is overwritten in place with the correct parity, at which point, it 20377 ; will be completely ready to be sent. 20378 ; 20379 ; Once the MOVST is started, the whole process is effectively a series 20380 ; of table lookups with no computations involved at all. 20381 ; 20382 ; The routine is faster than calling the single character conversion 20383 ; routines, even for the shortest possible Kermit packet of three 20384 ; characters. In other words, even with all the register pushing and 20385 ; popping, it still always wins. 20386 ; 20387 ; Depending on your view, the amount of memory taken up by the 20388 ; translation tables is not flagrant: a single kiloword and it is 20389 ; shared. 20390 ; 20391 ; Call: (Expected to be just before SOUT%/SOUTR%) 20392 ; 20393 ; t2/ Pointer to eight bit data to overwrite 20394 ; t3/ Negative length of data to do 20395 ; 20396 ; Return: 20397 ; 20398 ; +1, always; appropriate parity, if parity is being done (I.E., not 'none') 20399 20400 003655'01 putpar: entry putpar ; Used by packet routines in k20mit 20401 003655'01 325 03 0 00 003441* jumpge t3, R ; Zero or gubbish? Just leave it alone... 20402 003656'01 200 16 0 00 003561* move cx, parity ; Load current parity setting 20403 003657'01 306 16 0 00 003452' cain cx, none ; Not doing anything? 20404 003660'01 263 17 0 00 000000 ret ; No, so don't do anything 20405 20406 003661'01 265 16 0 00 004334' saveac ; Otherwise, set up eight registers ... 20407 003662'01 210 01 0 00 000003 movn t1, t3 ; Source length 20408 003663'01 200 04 0 00 000001 move t4, t1 ; destination is the same length 20409 003664'01 200 05 0 00 000002 move q1, t2 ; String will be updated in place (I.E., overwritten) 20410 003665'01 403 03 0 00 000006 setzb t3, q2 ; Section local pointers 20411 003666'01 336 07 0 00 000000# skipn q3, genint ; Load and double check extended string instruction 20412 003667'01 263 17 0 00 000000 ret ; Very odd! We checked above, but ignore it 20413 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 20:02 27-Nov-23 Page 52-1 K20IOC MAC 25-Nov-23 20:18 Put parity on an eight bit stream 20414 003671'01 621 01 0 00 300000 txz t1, N!M ; Shut off Negative and Mark 20415 003672'01 661 01 0 00 400000 txo t1, S ; Have to dink the foolish significance bit... 20416 003673'01 123 01 0 00 000007 extend t1, q3 ; Get down to some serious string translating 20417 003674'01 600 00 0 00 000000 nop ; Can't happen 20418 003675'01 263 17 0 00 000000 ret ; Done 20419 20420 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 53 K20IOC MAC 25-Nov-23 20:18 Generate parity on a seven bit stream 20421 subttl Generate parity on a seven bit stream 20422 20423 ; Like the above, except creates a new eight stream from a seven bit 20424 ; stream instead of overwriting the eight bit stream in place. 20425 ; 20426 ; t1/ Pointer to eight bit destination data 20427 ; t2/ Pointer to seven bit source data 20428 ; t3/ Negative length of data to do 20429 ; 20430 ; If parity is being done, then t2 will be updated to the original 20431 ; value of t1, otherwise it is unchanged. t1 is always trashed, 20432 ; everything else is preserved. 20433 ; 20434 ; N.B., The above is fine and everything ...but... 20435 ; THE BYTE WIDTHS ARE *NOT* CHECKED!!!! 20436 20437 003676'01 genpar: entry genpar ; Used by k20dsp and k20net 20438 003676'01 325 03 0 00 003655* jumpge t3, R ; Zero or gubbish? Just leave it alone... 20439 003677'01 200 16 0 00 003656* move cx, parity ; Load current parity setting 20440 003700'01 306 16 0 00 003452' cain cx, none ; Not doing any parity? 20441 003701'01 263 17 0 00 000000 ret ; No, so don't do anything 20442 20443 003702'01 265 16 0 00 004352' saveac ; Otherwise, go hog wild on registers 20444 003703'01 200 11 0 00 000001 move q5, t1 ; Save original destination 20445 003704'01 200 05 0 00 000001 move q1, t1 ; and put it where movst wants to use it 20446 003705'01 210 01 0 00 000003 movn t1, t3 ; Source length is positive 20447 003706'01 200 04 0 00 000001 move t4, t1 ; destination is the same length 20448 003707'01 403 03 0 00 000006 setzb t3, q2 ; Section local pointers 20449 003710'01 336 07 0 00 000000# skipn q3, genint ; Load and double check extended string instruction 20450 003711'01 263 17 0 00 000000 ret ; Very odd! We checked above, but ignore it 20451 003712'01 400 10 0 00 000000 setz q4, ; Fill character is NUL (yet unused...) 20452 003713'01 621 01 0 00 300000 txz t1, N!M ; Shut off Negative and Mark 20453 003714'01 661 01 0 00 400000 txo t1, S ; Have to dink the foolish significance bit... 20454 003715'01 123 01 0 00 000007 extend t1, q3 ; Get down to some serious string translating 20455 003716'01 600 00 0 00 000000 nop ; Can't happen 20456 003717'01 200 02 0 00 000011 move t2, q5 ; Return new source for SOUT%/SOUTR% 20457 003720'01 263 17 0 00 000000 ret ; Done 20458 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 54 K20IOC MAC 25-Nov-23 20:18 Check Parity 20459 subttl Check Parity 20460 20461 ; Call: 20462 ; 20463 ; t2/ Pointer to eight bit data 20464 ; t3/ Negative length of data to do 20465 ; 20466 ; Return: 20467 ; 20468 ; +1, Bad parity, if parity is not none 20469 ; +2, Good parity or none or zero length 20470 ; 20471 ; The routine is faster than calling single character conversion 20472 ; routines for the shortest possible Kermit packet of three 20473 ; characters. In other words, even with all the register pushing and 20474 ; popping, it still always wins. 20475 20476 003721'01 chkpar: entry chkpar ; Used by k10mit 20477 003721'01 325 03 0 00 003451* jumpge t3, RSKP ; Zero or gubbish? Just leave it alone... 20478 003722'01 200 16 0 00 003677* move cx, parity ; Load current parity setting 20479 003723'01 306 16 0 00 003452' cain cx, none ; Not doing anything? 20480 003724'01 254 00 0 00 003721* retskp ; No, so don't do anything 20481 20482 003725'01 265 16 0 00 004334' saveac ; Otherwise, set up eight registers ... 20483 003726'01 210 01 0 00 000003 movn t1, t3 ; Source length 20484 003727'01 200 04 0 00 000001 move t4, t1 ; destination is the same length 20485 003730'01 200 05 0 00 000002 move q1, t2 ; String will be updated in place (I.E., overwritten) 20486 003731'01 403 03 0 00 000006 setzb t3, q2 ; Section local pointers 20487 003732'01 336 07 0 00 000000# skipn q3, chkint ; Load and double check extended string instruction 20488 003733'01 254 00 0 00 003724* retskp ; Very odd! We checked above, but ignore it 20489 003734'01 400 10 0 00 000000 setz q4, ; Fill character is NUL (yet unused...) 20490 003735'01 621 01 0 00 300000 txz t1, N!M ; Shut off Negative and Mark 20491 003736'01 661 01 0 00 400000 txo t1, S ; Have to dink the foolish significance bit... 20492 003737'01 123 01 0 00 000007 extend t1, q3 ; Get down to some serious string translating 20493 003740'01 600 00 0 00 000000 nop ; Can't happen 20494 003741'01 607 01 0 00 200000 txnn t1, N ; Bump into any bad parity? 20495 003742'01 254 00 0 00 003733* retskp ; Nope, we're done 20496 003743'01 263 17 0 00 000000 ret ; Otherwise, bad parity 20497 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 55 K20IOC MAC 25-Nov-23 20:18 padbuf - Generate a buffer of padding characters with correct parity 20498 subttl padbuf - Generate a buffer of padding characters with correct parity 20499 20500 ; Call: 20501 ; 20502 ; t1/ Number of padding characters 20503 ; t2/ 7 bit padding character 20504 ; t3/ Parity to form 20505 ; t4/ Address of buffer to put the padding with proper parity in 20506 ; 20507 ; Returns +1, always 20508 20509 003744'01 padbuf: entry padbuf ; Called from k10mit 20510 003744'01 265 16 0 00 004127' saveac ; Wants some scratch 20511 20512 003745'01 120 05 0 00 000001 dmove q1, t1 ; Save length and character 20513 003746'01 120 07 0 00 000003 dmove q3, t3 ; Save parity and buffer address 20514 003747'01 200 11 0 00 002212* move p1, tvtflg ;[247] ; If might need to do IAC doubling 20515 20516 003750'01 200 01 0 00 000002 move t1, t2 ; Load padding character 20517 003751'01 260 17 1 00 000007 call @q3 ; Calculate parity 20518 003752'01 200 12 0 00 000001 move p2, t1 ;[247] ; Save character with parity 20519 20520 003753'01 200 06 0 00 000001 move q2, t1 ; Make a copy 20521 repeat ^d3, < ; Construct the next four characters 20522 lsh q2, ^d8 ; Shift over an eight bit character 20523 or q2, t1 ; Or in the padding character 20524 > 20525 003754'01 242 06 0 00 000010 20526 003755'01 434 06 0 00 000001 20527 003756'01 242 06 0 00 000010 20528 003757'01 434 06 0 00 000001 20529 003760'01 242 06 0 00 000010 20530 003761'01 434 06 0 00 000001 20531 20532 003762'01 242 06 0 00 000004 lsh q2, ^d4 ; Left justify to make 8 bit ASCIZ 20533 003763'01 202 06 0 10 000000 movem q2,(q4) ; Stomp first word of buffer 20534 20535 003764'01 322 11 0 00 003770' ifn. p1 ;[247] ; TVT Binary? 20536 003765'01 302 12 0 00 000377 caie p2, IAC ;[247] ; Yes, is it an IAC? 20537 003766'01 254 00 0 00 003770' anskp. ;[247] ; No, it isn't, so nothing to double 20538 003767'01 242 05 0 00 000001 lsh q1, ^d1 ;[247] ; Otherwise, double it 20539 003770'01 endif. ;[247] ; End case using IAC as padding character 20540 20541 003770'01 200 01 0 00 000005 move t1, q1 ; Load original length 20542 003771'01 231 01 0 00 000004 idivi t1, ^d4 ; Four 8 bit characters per word 20543 003772'01 302 02 0 00 000000 caie t2, 0 ; No remainder? 20544 003773'01 271 01 0 00 000001 addi t1, ^d1 ; Round up a word 20545 003774'01 275 01 0 00 000001 subi t1, ^d1 ; Already did first word 20546 003775'01 323 01 0 00 003676* jumple t1, R ; Four characters or less? 20547 ; Otherwise, fill out the rest of the buffer 20548 003776'01 200 02 0 00 000010 move t2, q4 ; Starting address in buffer 20549 003777'01 201 03 0 02 000001 movei t3, 1(t2) ; Next address to fill out the rest of the necessary 20550 004000'01 123 01 0 00 004022' xblt. t1 ; words in the buffer (but not the whole buffer) 20551 004001'01 200 01 0 00 000005 move t1, q1 ;[247] ; Return possibly updated length 20552 004002'01 263 17 0 00 000000 ret ; Done K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 55-1 K20IOC MAC 25-Nov-23 20:18 padbuf - Generate a buffer of padding characters with correct parity 20553 20554 ;[223] End code insertion 20555 20556 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 56 K20IOC MAC 25-Nov-23 20:18 Close out Code section 20557 subttl Close out Code section 20558 20559 xlist ; Save the trees!!!!! 20560 list 20561 20562 .endps code ; End of code .psect 20563 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page 57 K20IOC MAC 25-Nov-23 20:18 Local storage 20564 subttl Local storage 20565 20566 .psect data ;Write-able area 20567 20568 000004'05 000000 000000 intima:: defita ;[160] Timeout action for INPUT search. 20569 000005'05 000000 000000 incase:: defics ;[160] Case conversion flag for INPUT search. 20570 000006'05 000000 011610 indeft:: defito ; ** DO NOT ;[194] Default timeout for INPUT search (milliseconds) 20571 000007'05 203500 000000 indeff:: defitf ; REORDER ** ;[212] Same value as floating point seconds 20572 20573 000010'05 000000 000000 indefc:: 0 ;[209] Default search string length in characters 20574 000011'05 000000 000000 indefw:: 0 ;[209] Same length in words 20575 000012'05 indefs:: block strblw ;[209] Storage for default search string (if set) 20576 20577 001012'05 trgchr: block 1 ;[209] The 'trigger' character 20578 001013'05 trnbas: block 2 ;[209] Translation base table we used 20579 001015'05 sertab: block sertln ;[209] Search table 20580 20581 ;[209] Handles register spill from searching routines 20582 20583 001215'05 ornetc: block 1 ; ** DO NOT ;[209] Original network count 20584 001216'05 ornetp: block 1 ; REORDER ** ;[209] Original network pointer (end of buffer) 20585 20586 ;[209] Next two variables are for cross INPUT calls with left over data 20587 20588 001217'05 000000 000000 inpcbf:: 0 ;[209] Number of characters we flushed 20589 001220'05 000000 000000 inpcnt:: 0 ;** DO NOT REORDER** ;[209] Number of characters in buffer 20590 001221'05 44 07 0 00 001222' inpptr: point 7, inpbuf ;[209] Current position in buffer 20591 001222'05 inpbuf:: block strblw ;[209] Area to read data into 20592 20593 002222'05 fsized: block 2 ;[229] File size double word 20594 20595 .endps data ; Close out storage area 20596 20597 .psect text ;[209] Read-only storage 20598 000134'03 inpini: intern inpini ;[209] Used by buffer clearing routines 20599 000134'03 000000 000000 0 ;[209] Nothing in INPUT command buffer 20600 000135'03 44 07 0 00 000000# point 7, inpbuf ;[209] So pointing at beginning 20601 .endps text ;[209] Close out section zero text 20602 20603 20604 .xcmsy ;[194] Ditch MACSYM junk 20605 20606 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:02.252 131P CORE USED K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page S-1 K20IOC MAC 25-Nov-23 20:18 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 20:02 27-Nov-23 Page S-2 K20IOC MAC 25-Nov-23 20:18 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 20:02 27-Nov-23 Page S-3 K20IOC MAC 25-Nov-23 20:18 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 20:02 27-Nov-23 Page S-4 K20IOC MAC 25-Nov-23 20:18 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 20:02 27-Nov-23 Page S-5 K20IOC MAC 25-Nov-23 20:18 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 20:02 27-Nov-23 Page S-6 K20IOC MAC 25-Nov-23 20:18 SYMBOL TABLE FOR PSECT TEXT INPINI 000134' int K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 20:02 27-Nov-23 Page S-7 K20IOC MAC 25-Nov-23 20:18 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 20:02 27-Nov-23 Page 1 K20DSP MAC 9-Nov-23 18:22 Preliminaries 20607 title k20dsp - Kermit-20 Display Routines 20608 20609 ; All display code was removed from k20mit and moved to this module as 20610 ; part of Edit 194 to address the issue of a very large single source 20611 ; file that unexpectedly began generating MCRNEC errors. 20612 ; 20613 ; During this time, some code was rewritten to decrease symbol table 20614 ; usage, to (hopefully) clean up control flow and provide for 20615 ; additional checking and better recovery. Speed ups were not avoided 20616 ; where possible, typically space being traded for time. However, 20617 ; this was not done at the expense of clarity, maintainability being 20618 ; of paramount concern. 20619 ; 20620 ; The code here should be differentiated from the extensive help text 20621 ; which is contained in k20hlp, which is constant, does not change 20622 ; during runtime and resides in its own .PSECT. The text here is 20623 ; dynamically generated. 20624 20625 subttl Preliminaries 20626 20627 search monsym,macsym,cmd,k20unv ;[194] 20628 cmdacs ^ ;Clean up p1-p4 definitions 20629 20630 sall ; Tidy listing 20631 .directive flblst ; We don't need to see all the ASCIZ bytes... 20632 20633 remark common parsing external data 20634 20635 extern pars1 ; Data from first parse. 20636 extern pars2 ; Data from second parse. 20637 extern pars3 ; Data from third parse. 20638 extern pars4 ; Data from fourth parse. 20639 extern pars5 ;[41] ... 20640 20641 remark for file handling 20642 20643 extern filjfn ; JFN of currently open file 20644 20645 remark other useful routines and data 20646 20647 extern qlog ; Quit logging 20648 extern %%jser ; Support for error macros 20649 extern %%smsg ; Support for smsg macro 20650 extern BOUTI% ;[216] BOUT% Internal 20651 extern errptr ; Pointer to error message 20652 extern getnti ; Get information about line 20653 extern ccon, ccoff ; Handle control-C, if we have it 20654 extern crlf ; Carriage return line feed 20655 extern crlflf ; As previous, but double line feed 20656 extern ttyjfn ; JFN on local terminal 20657 extern $priou ; Terminal primary output 20658 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 2 K20DSP MAC 9-Nov-23 18:22 Various NUL: ASCII strings and lengths 20659 subttl Various NUL: ASCII strings and lengths 20660 20661 .psect text ; Text goes in text psect 20662 000000'01 472531 435032 nulnam: byte (7) "N","U","L",":", .chcrt, .chlfd, .chlfd, .chnul 20663 000002'01 252352 546164 astnul: byte (7) "*","N","U","L",":", .chnul 20664 .endps text 20665 20666 .psect const ; Read-only constants go in constants psecn 20667 000000'02 44 07 0 00 000000# nulptr: point 7, nulnam ; Pointer to fixed "NUL:" string 20668 000001'02 777777 777770 -^d8 ; "NUL:" (4) + crlflf (4) 20669 000002'02 44 07 0 00 000000# nul5: point 7, astnul ; Pointer to fixed "*NUL:" ASCIZ 20670 000003'02 777777 777773 -^d5 ; Length of same 20671 .endps const ; End of constants 20672 20673 .psect code/ronly ; Don't allow stores 20674 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 3 K20DSP MAC 9-Nov-23 18:22 Clear Control-O, if set 20675 subttl Clear Control-O, if set 20676 20677 ; Preserves all registers, +1 always 20678 ; 20679 ; This is concerned about the local controlling terminal, not anything 20680 ; remote over a pseudo-terminal, network or (maybe) pipe. 20681 20682 000000'03 clrcno: entry clrcno 20683 000000'03 265 16 0 00 004357' saveac ; Just don't touch 20684 20685 000001'03 200 01 0 00 000000* move t1, $PRIOU ; Whatever is best to choose for primary output 20686 000002'03 104 00 0 00 000107 RFMOD% ; Find out about control-O 20687 000003'03 320 12 0 00 000005' ifje. r ; Failed?? 20688 000004'03 254 00 0 00 000010' 20689 000005'03 200 04 0 00 000001 move t4, t1 ; Save error, just in case 20690 000006'03 400 02 0 00 000000 setz t2, ; Assume ^O has not been typed 20691 000007'03 200 01 0 00 000001* move t1, $PRIOU ; Reload JFN or device, just in case 20692 000010'03 endif. 20693 20694 000010'03 627 02 0 00 400000 txzn t2, tt%osp ; Is Output suppress (^O) on? 20695 000011'03 263 17 0 00 000000 ret ; No, nothing to do 20696 000012'03 104 00 0 00 000110 SFMOD% ; Otherwise, turn it off 20697 000013'03 320 12 0 00 000015' ifje. r ; Failed?? But we just read it... 20698 000014'03 254 00 0 00 000017' 20699 000015'03 200 04 0 00 000001 move t4, t1 ; Save error, just in case 20700 000016'03 200 01 0 00 000007* move t1, $PRIOU ; Reload JFN or device, just in case 20701 000017'03 endif. 20702 20703 000017'03 263 17 0 00 000000 ret ; Done 20704 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 4 K20DSP MAC 9-Nov-23 18:22 typnam - Type a file name 20705 subttl typnam - Type a file name 20706 20707 ; t1/ Output JFN or designator 20708 ; t2/ JFN to render 20709 ; 20710 ; Updates t1, if string pointer 20711 ; 20712 ; +1/ If failed along the way (t1 unchanged) 20713 ; +2/ Succeeded 20714 20715 000020'03 typnam: entry typnam ;[220] 20716 000020'03 265 16 0 00 004371' saveac ; Save these anyway 20717 000021'03 200 05 0 00 000001 move q1, t1 ; Save output designator 20718 000022'03 400 04 0 00 000000 setz t4, ; No string prefix or stop character 20719 20720 000023'03 302 02 0 00 377777 caie t2, .nulio ;[193] NUL: talisman? 20721 000024'03 254 00 0 00 000035' ifskp. ;[193] Yes, that's easy 20722 000025'03 120 02 0 00 000000# dmove t2, nulptr ;[193] Point to equivalent string 20723 000026'03 104 00 0 00 000053 SOUT% ;[193] Counted SOUT% is faster 20724 000027'03 320 12 0 00 000031' ifje. r ;[194] Failed?? 20725 000030'03 254 00 0 00 000034' 20726 000031'03 200 04 0 00 000001 move t4, t1 ;[193] Save error for debuggers 20727 000032'03 200 01 0 00 000005 move t1, q1 ;[193] Restore output designator 20728 000033'03 263 17 0 00 000000 ret ;[194] Give error return 20729 000034'03 endif. ;]194] End SOUT% error handling 20730 000034'03 254 00 0 00 000053' else. ;[193] Otherwise, a real JFN 20731 000035'03 400 03 0 00 000000 setz t3, ; Default formatting 20732 000036'03 104 00 0 00 000030 JFNS% ; Type it someplace 20733 000037'03 320 12 0 00 000041' ifje. r ;[194] Failed?? 20734 000040'03 254 00 0 00 000044' 20735 000041'03 200 04 0 00 000001 move t4, t1 ;[194] Save error for debuggers 20736 000042'03 200 01 0 00 000005 move t1, q1 ;[194] Restore output designator 20737 000043'03 263 17 0 00 000000 ret ;[194] Give error return 20738 000044'03 endif. ;]194] End JFN% error handling 20739 dmove t2, [ point 7, crlflf ;[194] Double linefeed 20740 000044'03 120 02 0 00 004403' -^d4 ] ;[194] Four characters total in string 20741 000045'03 104 00 0 00 000053 SOUT% ;[193] Counted SOUT% is faster 20742 000046'03 320 12 0 00 000050' ifje. r ;[194] Failed?? 20743 000047'03 254 00 0 00 000053' 20744 000050'03 200 04 0 00 000001 move t4, t1 ;[193] Save error for debuggers 20745 000051'03 200 01 0 00 000005 move t1, q1 ;[193] Restore output designator 20746 000052'03 263 17 0 00 000000 ret ;[194] Give error return 20747 000053'03 endif. ;]194] End SOUT% error handling 20748 000053'03 endif. ;[193] End .nulio special casing 20749 20750 000053'03 254 00 0 00 000000* retskp ;[194] Won!! 20751 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 5 K20DSP MAC 9-Nov-23 18:22 Routine to type a file at the local terminal. 20752 subttl Routine to type a file at the local terminal. 20753 20754 ; Call: 20755 ; 20756 ; t1/ JFN of file to type 20757 ; t3/ Byte size 20758 ; 20759 ; Returns +1, If anything strange 20760 ; +2, Success 20761 ; 20762 ; Rewritten be a little more picky about the calling arguments and to 20763 ; use PMAP% instead of SIN%. Passing a HRROI in to a file opened in 8 20764 ; bit mode did the wrong thing, anyway. 20765 ; 20766 ; Will also generate parity for a seven bit file, if we're asked to 20767 ; to do that. That should normally never happen as the monitor should 20768 ; be handling this. The code here is largely for testing purposes. 20769 ; 20770 ; Note: The routine checks for a byte size between 1 and 36, however 20771 ; only a byte size of 7 or 8 are properly handled, everything 20772 ; but 8 being displayed as a seven bit (I.E., ASCII) file. This 20773 ; will properly type 36 bit listings generated by PA1050 and is 20774 ; no worse then the previous (incorrect) behavior. 20775 ; 20776 ; N.B., For an eight bit file, parity must be ignored--you're on your 20777 ; own... 20778 20779 000054'03 typfil: entry typfil ;[220] 20780 000054'03 265 16 0 00 004405' saveac 20781 20782 000055'03 514 05 0 00 000001 hrlz q1, t1 ; Save JFN, start at file page zero 20783 000056'03 621 01 0 00 777777 tlz t1, -1 ; Whack any flags left lying around 20784 000057'03 306 01 0 00 377777 cain t1, .nulio ; Asked to type NUL:? 20785 000060'03 254 00 0 00 000053* retskp ; That's easy; we're done already! 20786 20787 000061'03 323 03 0 00 000066' ifg. t3 ; Could the byte size be reasonable? 20788 000062'03 303 03 0 00 000044 caile t3, ^d36 ; Yes, but is it actually so? 20789 000063'03 254 00 0 00 000066' anskp. ; No, it's delusional 20790 000064'03 200 06 0 00 000003 move q2, t3 ; It's fine, so save the validated file byte size 20791 000065'03 254 00 0 00 000106' else. ; Otherwise, byte size is some kind of gubbish 20792 000066'03 200 01 0 00 000000# txmsg <% KERMIT-20 can not type a file with a byte size of: > 20793 000067'03 104 00 0 00 000076 20794 000070'03 320 12 0 00 000071' 20795 000004'02 000000000000# 20796 000000'04 045 040 113 105 122 20797 000071'03 201 01 0 00 000101 movei t1, .priou ; continue on this terminal 20798 000072'03 200 02 0 00 000003 move t2, t3 ; Load it where NOUT% wants it 20799 000073'03 201 03 0 00 000012 movei t3, ^d10 ; Base ten 20800 000074'03 104 00 0 00 000224 NOUT% ; Type the bogus byte size 20801 000075'03 320 12 0 00 000077' ifje. r ; Catch and ignore error 20802 000076'03 254 00 0 00 000103' 20803 000077'03 200 04 0 00 000001 move t4, t1 ; Store error for debugger 20804 000100'03 200 01 0 00 000000# txmsg <*ERROR*> ; About as good as we can do 20805 000101'03 104 00 0 00 000076 20806 000102'03 320 12 0 00 000103' k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 5-1 K20DSP MAC 9-Nov-23 18:22 Routine to type a file at the local terminal. 20807 000005'02 000000000000# 20808 000013'04 052 105 122 122 117 20809 000103'03 endif. ; End NOUT% error handling 20810 000103'03 561 01 0 00 000000* hrroi t1, crlf ; Tie off the line 20811 000104'03 104 00 0 00 000076 PSOUT% 20812 000105'03 263 17 0 00 000000 ret ; Return a failure 20813 000106'03 endif. ; End byte size checking 20814 20815 000106'03 104 00 0 00 000024 GTSTS% ; Otherwise, see if we can use the JFN at all 20816 000107'03 320 12 0 00 000111' ifje. r ; Failed?? 20817 000110'03 254 00 0 00 000131' 20818 000111'03 200 04 0 00 000001 move t4, t1 ; Store error for debugging 20819 000112'03 200 01 0 00 000000# emsg ;Begin complaining 20820 000113'03 104 00 0 00 000313 20821 000006'02 000000000000# 20822 000015'04 103 141 156 047 164 20823 000114'03 201 01 0 00 000101 movei t1, .priou ; continue on this terminal 20824 000115'03 554 02 0 00 000005 hlrz t2, q1 ; Load JFN, which was stored prepratory to PMAP%ing 20825 000116'03 201 03 0 00 000010 movei t3, ^d8 ; JFN's are base 8 20826 000117'03 104 00 0 00 000224 NOUT% ; Type it (or try to, anyway) 20827 000120'03 320 12 0 00 000122' ifje. r ; Catch and ignore error 20828 000121'03 254 00 0 00 000126' 20829 000122'03 200 04 0 00 000001 move t4, t1 ; Store error for debugger 20830 000123'03 200 01 0 00 000000# txmsg <*ERROR*> ; About as good as we can do 20831 000124'03 104 00 0 00 000076 20832 000125'03 320 12 0 00 000126' 20833 000007'02 000000000000# 20834 000022'04 052 105 122 122 117 20835 000126'03 endif. ; End NOUT% error handling 20836 000126'03 561 01 0 00 000103* hrroi t1, crlf ; And tie off the complaint 20837 000127'03 104 00 0 00 000076 PSOUT% 20838 000130'03 263 17 0 00 000000 ret ; And get out of here 20839 000131'03 endif. ; End case JSYS error handling 20840 20841 000131'03 603 02 0 00 000200 ifxe. t2, gs%nam ; So does anything in there smell like a JFN? 20842 000132'03 254 00 0 00 000154' 20843 000133'03 200 04 0 00 000001 move t4, t1 ; Store error for debugging 20844 000134'03 200 01 0 00 000000# emsg ;Begin complaining 20845 000135'03 104 00 0 00 000313 20846 000010'02 000000000000# 20847 000024'04 103 141 156 047 164 20848 000136'03 201 01 0 00 000101 movei t1, .priou ; continue on this terminal 20849 000137'03 554 02 0 00 000005 hlrz t2, q1 ; Load JFN, which was stored prepratory to PMAP%ing 20850 000140'03 201 03 0 00 000010 movei t3, ^d8 ; JFN's are base 8 20851 000141'03 104 00 0 00 000224 NOUT% ; Type it (or try to, anyway) 20852 000142'03 320 12 0 00 000144' ifje. r ; Catch and ignore error 20853 000143'03 254 00 0 00 000150' 20854 000144'03 200 04 0 00 000001 move t4, t1 ; Store error for debugger 20855 000145'03 200 01 0 00 000000# txmsg <*ERROR*> ; About as good as we can do 20856 000146'03 104 00 0 00 000076 20857 000147'03 320 12 0 00 000150' 20858 000011'02 000000000000# 20859 000031'04 052 105 122 122 117 20860 000150'03 endif. ; End NOUT% error handling 20861 000150'03 561 01 0 00 000126* hrroi t1, crlf ; And tie off the complaint k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 5-2 K20DSP MAC 9-Nov-23 18:22 Routine to type a file at the local terminal. 20862 000151'03 104 00 0 00 000076 PSOUT% 20863 000152'03 263 17 0 00 000000 ret ; And get out of here 20864 000153'03 254 00 0 00 000155' else. ; Otherwise, at least the JSYS worked 20865 000154'03 200 04 0 00 000002 move t4, t2 ; So save the status bits past the DVCHR% 20866 000155'03 endif. ; End case initial JFN check 20867 20868 000155'03 104 00 0 00 000117 DVCHR% ; Now let's have a look at the device 20869 000156'03 320 12 0 00 000160' ifje. r ; Failed?? 20870 000157'03 254 00 0 00 000162' 20871 000160'03 200 04 0 00 000001 move t4, t1 ; Get the error out of the way 20872 000161'03 477 02 0 00 000003 setob t2, t3 ; Assume no kind of device 20873 000162'03 endif. 20874 20875 000162'03 135 03 0 00 004423' load t3, dv%typ,t2 ; Pick up the device type 20876 000163'03 306 03 0 00 000015 cain t3, .dvnul ; Did this manage to slip through?? 20877 000164'03 254 00 0 00 000060* retskp ; Strangely, it did; silently ignore it 20878 20879 000165'03 306 03 0 00 000000 cain t3, .dvdsk ; Not a disk? 20880 000166'03 254 00 0 00 000207' ifskp. ; Won't be mapping it, then 20881 000167'03 200 01 0 00 000000# emsg 20882 000170'03 104 00 0 00 000313 20883 000012'02 000000000000# 20884 000033'04 103 141 156 047 164 20885 000171'03 201 01 0 00 000101 movei t1, .priou ; Carry on typing to the terminal 20886 000172'03 554 02 0 00 000005 hlrz t2, q1 ; Load the JFN (which we know is bound) 20887 000173'03 403 03 0 00 000004 setzb t3, t4 ; No special formatting or odd prefix 20888 000174'03 104 00 0 00 000030 JFNS% ; Tell us what we choked on 20889 000175'03 320 12 0 00 000177' ifje. r ; Catch and ignore error 20890 000176'03 254 00 0 00 000203' 20891 000177'03 200 04 0 00 000001 move t4, t1 ; Store error for debugger 20892 000200'03 200 01 0 00 000000# txmsg <*ERROR*> ; About as good as we can do 20893 000201'03 104 00 0 00 000076 20894 000202'03 320 12 0 00 000203' 20895 000013'02 000000000000# 20896 000041'04 052 105 122 122 117 20897 000203'03 endif. ; End NOUT% error handling 20898 000203'03 561 01 0 00 000150* hrroi t1, crlf ; And tie off the complaint 20899 000204'03 104 00 0 00 000076 PSOUT% 20900 000205'03 263 17 0 00 000000 ret ; And get out of here 20901 000206'03 254 00 0 00 000210' else. ; Ok to proceed 20902 000207'03 554 01 0 00 000005 hlrz t1, q1 ; Reload the JFN (which DVCHR% smashed) 20903 000210'03 endif. 20904 20905 000210'03 104 00 0 00 000036 SIZEF% ; Find the file size 20906 000211'03 320 16 0 00 000213' ifje. ; Failed?? 20907 000212'03 254 00 0 00 000216' 20908 000213'03 200 04 0 00 000001 move t4, t1 ; Get the error out of the way 20909 000214'03 403 02 0 00 000003 setzb t2, t3 ; Assume no kind of length 20910 000215'03 554 01 0 00 000005 hlrz t1, q1 ; Reload the JFN, just in case 20911 000216'03 endif. 20912 ; Investigate SIZEF% results 20913 000216'03 322 02 0 00 000164* jumpe t2, rskp ; If no bytes, nothing to do. 20914 000217'03 322 03 0 00 000216* jumpe t3, rskp ; No pages to map? Nothing to do... 20915 000220'03 120 07 0 00 000002 dmove q3, t2 ; Save quantities as loop counters 20916 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 5-3 K20DSP MAC 9-Nov-23 18:22 Routine to type a file at the local terminal. 20917 000221'03 321 04 0 00 000233' ifxe. t4, gs%opn ; Finally, is the file open? 20918 remark ; It isn't, but we can silently recover 20919 000222'03 200 02 0 00 004424' movx t2,fld(^d8,of%bsz)!of%rd ; Assume reading an 8 bit file 20920 000223'03 302 06 0 00 000010 caie q2, ^d8 ; But!! Not eight bit? 20921 000224'03 200 02 0 00 004425' movx t2,fld(^d7,of%bsz)!of%rd ; Everything else is 7 bit 20922 000225'03 104 00 0 00 000021 OPENF% ; Open it 20923 000226'03 320 12 0 00 000230' %jserr (,r) ; Punt 20924 000227'03 254 00 0 00 000233' 20925 000230'03 265 01 0 00 000000* 20926 000231'03 000000000000# 20927 000232'03 254 00 0 00 000000* 20928 000043'04 125 156 141 142 154 20929 000233'03 endif. ; End case trying to recover from an unopened file 20930 20931 000233'03 260 17 0 00 000427' call whakfp ; Whack anything left over 20932 000234'03 263 17 0 00 000000 ret ; Go no further if something failed 20933 000235'03 302 06 0 00 000007 caie q2, ^d7 ; 7 bit ASCII? 20934 000236'03 254 00 0 00 000242' ifskp. ; OK, routine type out 20935 000237'03 201 04 0 00 005000 movx t4,^d<512*<36/7>> ;Count of seven bit bytes in page 20936 000240'03 505 06 0 00 440700 hrli q2, () ;Using a seven bit pointer, then 20937 000241'03 254 00 0 00 000244' else. ; Otherwise, 8 bit ASCII 20938 000242'03 201 04 0 00 004000 movx t4,^d<512*<36/8>> ;So less bytes per page 20939 000243'03 505 06 0 00 441000 hrli q2, () ;and using an eight bit pointer 20940 000244'03 endif. 20941 000244'03 541 06 0 00 007000 hrri q2, maporg ; Either way, coming from same address 20942 20943 000245'03 do. ; Finally enter loop context 20944 000245'03 200 01 0 00 000005 move t1, q1 ; Case I, load JFN and file page 20945 000246'03 120 02 0 00 004426' dmove t2, [ exp <.fhslf,,mappag>, pm%rd ] 20946 000247'03 104 00 0 00 000056 PMAP% ; Map it in, read-only 20947 000250'03 320 12 0 00 000252' %jserr (,r) ; Punt 20948 000251'03 254 00 0 00 000255' 20949 000252'03 265 01 0 00 000230* 20950 000253'03 000000000000# 20951 000254'03 254 00 0 00 000232* 20952 000050'04 125 156 141 142 154 20953 000255'03 210 03 0 00 000004 movn t3, t4 ; Let's assume the maximum 20954 000256'03 313 04 0 00 000007 camle t4, q3 ; Unless we are within the end of file 20955 000257'03 210 03 0 00 000007 movn t3, q3 ; Otherwise, just do remainder 20956 000260'03 270 07 0 00 000003 add q3, t3 ; Subtract off remaining total 20957 000261'03 200 02 0 00 000006 move t2, q2 ; Load the source pointer 20958 000262'03 200 01 0 00 000000* move t1, parity ; But! Are we putting parity on this? 20959 000263'03 306 01 0 00 000000* cain t1, none ; Anything but none means we might be doing exactly that 20960 000264'03 254 00 0 00 000304' ifskp. ; OK, some some kind of parity being done, check further 20961 000265'03 554 01 0 00 000006 hlrz t1, q2 ; Pick up the default pointer fields 20962 000266'03 306 01 0 00 441000 cain t1, () ; Not doing eight bit? 20963 000267'03 254 00 0 00 000304' anskp. ; No, can't put parity on an eight bit file 20964 000270'03 332 00 0 00 000000* skipe parpko ; Just doing parity on packets? 20965 000271'03 254 00 0 00 000304' anskp. ; Yes, so don't muck up the type out 20966 000272'03 415 16 0 00 000304' block. ; Generate the parity then 20967 000273'03 261 17 0 00 000016 20968 000274'03 265 16 0 00 004430' saveac 20969 000275'03 211 01 0 00 010000 movni t1,^d<4*strblw*2> ; Load maximum count for combined buffers 20970 000276'03 313 01 0 00 000003 camle t1, t3 ; Overflow? (have to compare negative numbers backwards) 20971 000277'03 200 03 0 00 000001 move t3, t1 ; Clip down to maximum k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 5-4 K20DSP MAC 9-Nov-23 18:22 Routine to type a file at the local terminal. 20972 000300'03 201 01 0 00 000000* movei t1,strbuf ; Resolve address of string buffer 20973 000301'03 505 01 0 00 441000 hrli t1, <(point 8,0)> ;Finish building eight bit pointer 20974 000302'03 260 17 0 00 000000* call genpar ; Generate a new string with parity 20975 000303'03 263 17 0 00 000000 endbk. ; End block context 20976 000304'03 endif. ; End case parity handling 20977 000304'03 201 01 0 00 000101 movei t1, .priou ; Type it on whatever primary output is 20978 000305'03 104 00 0 00 000053 SOUT% ; Counted SOUT% is efficient 20979 000306'03 320 12 0 00 000310' %jserr (,r) ; Punt 20980 000307'03 254 00 0 00 000313' 20981 000310'03 265 01 0 00 000252* 20982 000311'03 000000000000# 20983 000312'03 254 00 0 00 000254* 20984 000055'04 125 156 141 142 154 20985 000313'03 323 07 0 00 000316' jumple q3, endlp. ; Exit if done with all the characters 20986 000314'03 271 05 0 00 000001 addi q1, ^d1 ; Bump to next file page 20987 000315'03 367 10 0 00 000245' sojg q4, top. ; Do it, if any pages left 20988 000316'03 enddo. ; Exit loop lexical context 20989 20990 000316'03 254 00 0 00 000427' jrst whakfp ; Whack any pages 20991 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 6 K20DSP MAC 9-Nov-23 18:22 Character echoing routine. 20992 subttl Character echoing routine. 20993 20994 ; Need to do this because having tty open in binary mode overrides ccoc 20995 ; settings. t2 contains character to echo. 20996 ; 20997 ;[151] 20998 20999 000317'03 echo: entry echo ;[196] 21000 000317'03 265 16 0 00 004357' saveac ;[186] Must save all ACs. 21001 21002 000320'03 620 02 0 00 000200 trz t2, 200 ; Strip any parity. 21003 000321'03 200 03 0 00 000002 move t3, t2 ; Make a copy of the character. 21004 21005 000322'03 301 03 0 00 000040 cail t3, 40 ;[18] Check most common case first, 21006 000323'03 303 03 0 00 000126 caile t3, 126 ;[18] namely, whether it's a printable 21007 000324'03 334 00 0 00 000000 skipa ;[18] character. 21008 000325'03 254 00 0 00 000402' jrst echo2 ;[18] If so, just go print it. 21009 21010 000326'03 307 03 0 00 000006 caig t3, 6 ; Check for control char, null thru ^F. 21011 000327'03 254 00 0 00 000354' jrst echo1 21012 000330'03 306 03 0 00 000013 cain t3, 13 ; ^K 21013 000331'03 254 00 0 00 000354' jrst echo1 21014 000332'03 301 03 0 00 000016 cail t3, 16 ; ^N-^Z 21015 000333'03 303 03 0 00 000032 caile t3, 32 21016 000334'03 334 00 0 00 000000 skipa 21017 000335'03 254 00 0 00 000354' jrst echo1 21018 000336'03 301 03 0 00 000034 cail t3, 34 ; ^\-^_ 21019 000337'03 303 03 0 00 000037 caile t3, 37 21020 000340'03 334 00 0 00 000000 skipa 21021 000341'03 254 00 0 00 000354' jrst echo1 21022 000342'03 302 03 0 00 000033 caie t3, 33 ;[194] ESC? 21023 000343'03 254 00 0 00 000346' ifskp. ;[194] Yes 21024 000344'03 201 02 0 00 000044 movei t2, "$" ; Echo as dollar sign 21025 000345'03 254 00 0 00 000402' jrst echo2 21026 000346'03 endif. ;[194] 21027 000346'03 302 03 0 00 000177 caie t3, 177 ;[194] DEL? 21028 000347'03 254 00 0 00 000352' ifskp. ;[194] Yes 21029 000350'03 474 03 0 00 000000 seto t3, ; So it echoes as ^? (100-1=77="?") 21030 000351'03 254 00 0 00 000354' jrst echo1 21031 000352'03 endif. ;[194] 21032 000352'03 200 02 0 00 000003 move t2, t3 ; Anything else, just type it. 21033 000353'03 254 00 0 00 000402' jrst echo2 21034 21035 000354'03 337 01 0 00 000000* echo1: skipg t1, ttyjfn ; Echo it on the tty. 21036 000355'03 201 01 0 00 000101 movei t1, .priou 21037 000356'03 201 02 0 00 000136 movei t2, "^" ; Print an uparrow 21038 000357'03 104 00 0 00 000051 BOUT 21039 000360'03 320 12 0 00 000362' %jserr (,) 21040 000361'03 254 00 0 00 000365' 21041 000362'03 265 01 0 00 000310* 21042 000363'03 000000 000000 21043 000364'03 254 00 0 00 000365' 21044 21045 000365'03 337 01 0 00 000000* skipg t1, sesjfn ;[195] Logging? 21046 000366'03 254 00 0 00 000401' ifskp. ;[195] Yes k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 6-1 K20DSP MAC 9-Nov-23 18:22 Character echoing routine. 21047 000367'03 336 00 0 00 000000* skipn sesflg ;[195] Active? 21048 000370'03 254 00 0 00 000401' anskp. ;[195] No 21049 000371'03 306 01 0 00 377777 cain t1, .nulio ;[193] Just dumping it? 21050 000372'03 254 00 0 00 000401' anskp. ;[195] Yeah, don't even bother then 21051 000373'03 104 00 0 00 000051 BOUT ; Yes, do that. 21052 000374'03 320 12 0 00 000376' %jserr (,qlog) ; Error, print msg, close log, rtn from there. 21053 000375'03 254 00 0 00 000401' 21054 000376'03 265 01 0 00 000362* 21055 000377'03 000000 000000 21056 000400'03 254 00 0 00 000000* 21057 000401'03 endif. ;[195] 21058 21059 000401'03 201 02 0 03 000100 movei t2, 100(t3) ; Convert to char to uncontrollified version. 21060 000402'03 337 01 0 00 000354* echo2: skipg t1, ttyjfn ; Back to TTY. 21061 000403'03 201 01 0 00 000101 movei t1, .priou 21062 000404'03 104 00 0 00 000051 BOUT ; Print the character itself. 21063 000405'03 320 12 0 00 000407' %jserr (,) 21064 000406'03 254 00 0 00 000412' 21065 000407'03 265 01 0 00 000376* 21066 000410'03 000000 000000 21067 000411'03 254 00 0 00 000412' 21068 21069 000412'03 337 01 0 00 000365* skipg t1, sesjfn ;[195] Logging? 21070 000413'03 254 00 0 00 000426' ifskp. ;[195] Yes 21071 000414'03 336 00 0 00 000367* skipn sesflg ;[195] Active? 21072 000415'03 254 00 0 00 000426' anskp. ;[195] No 21073 000416'03 306 01 0 00 377777 cain t1, .nulio ;[193] Just dumping it? 21074 000417'03 254 00 0 00 000426' anskp. ;[195] Yeah, don't even bother then 21075 000420'03 104 00 0 00 000051 BOUT ; Yes, do that. 21076 000421'03 320 12 0 00 000423' %jserr (,qlog) ; Error, print msg, close log, rtn from there. 21077 000422'03 254 00 0 00 000426' 21078 000423'03 265 01 0 00 000407* 21079 000424'03 000000 000000 21080 000425'03 254 00 0 00 000400* 21081 000426'03 endif. ;[195] 21082 21083 000426'03 263 17 0 00 000000 ret 21084 21085 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 7 K20DSP MAC 9-Nov-23 18:22 Whack a file page, if it exists 21086 subttl Whack a file page, if it exists 21087 21088 000427'03 whakfp: entry whakfp ;[220] 21089 remark RPACS% ; Could have used this, but didn't ... 21090 000427'03 200 01 0 00 007000 move t1, maporg ; Did anything get left lying around? 21091 000430'03 320 12 0 00 000432' ifje. r ; No, so that's fine 21092 000431'03 254 00 0 00 000435' 21093 000432'03 200 04 0 00 000001 move t4, t1 ; But save the error for the curious 21094 000433'03 254 00 0 00 000217* retskp ; Succeed (since nothing to do) 21095 000434'03 254 00 0 00 000445' else. ; Otherwise, ditch whatever is there 21096 000435'03 474 01 0 00 000000 seto t1, ; Case IV, whacking a process page 21097 000436'03 120 02 0 00 004444' dmove t2, [ exp <.fhslf,,mappag>, 0 ] ; From our address space 21098 000437'03 104 00 0 00 000056 PMAP% ; Kick the page into oblivion 21099 000440'03 320 12 0 00 000442' %jserr (,r) 21100 000441'03 254 00 0 00 000445' 21101 000442'03 265 01 0 00 000423* 21102 000443'03 000000000000# 21103 000444'03 254 00 0 00 000312* 21104 000062'04 125 156 141 142 154 21105 000445'03 endif. 21106 21107 000445'03 254 00 0 00 000433* retskp ; And done 21108 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 8 K20DSP MAC 9-Nov-23 18:22 STATISTICS external variables 21109 subttl STATISTICS external variables 21110 21111 extern nnak ; Number of NAK's seen 21112 extern ntimou ; Number of time outs 21113 extern pause ; Interpacket pause in milliseconds 21114 extern rpsiz ; Maximum receive packet size 21115 extern rtchr ; Total characters receieved 21116 extern rtot ; Received total characters 21117 extern sec ; Seconds (for figuring baud rate 21118 extern speed ; Line speed, if physical line 21119 extern spsiz ; Maximum send packet size 21120 extern statxt ; Status text 21121 extern stchr ; Total characters sent 21122 extern ewallt ;[207] Elapsed wall time block 21123 extern durtim ;[207] Prints a duration 21124 extern stot ; Sent total characters 21125 extern timerx ; Count of TIMER% JSYS errors 21126 extern ttibin ; BIN% counter 21127 extern ttildb ; ildb's over SIN%'ed data 21128 extern ttimax ; Maximum size a SIN% can do 21129 extern ttisin ; Largest SIN% we ever did 21130 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 9 K20DSP MAC 9-Nov-23 18:22 STATISTICS command 21131 subttl STATISTICS command 21132 21133 000446'03 $srvt: entry $srvt ;[194] 21134 000446'03 334 01 0 00 004446' skipa t1,[point 7, statxt] ;[216] Server statistics 21135 000447'03 $stat: entry $stat ;[194] 21136 000447'03 201 01 0 00 000101 movei t1,.priou ;[189] Otherwise local 21137 smsg < 21138 000450'03 120 02 0 00 000000# Maximum number of characters in packet: > ;[189] 21139 000451'03 260 17 0 00 000000* 21140 000014'02 000000000000# 21141 000015'02 777777 777724 21142 000072'04 015 012 040 115 141 21143 000452'03 200 02 0 00 000000* srvnum rpsiz ;[189] 21144 000453'03 201 03 0 00 000012 21145 000454'03 104 00 0 00 000224 21146 000455'03 320 14 0 00 000456' 21147 000456'03 120 02 0 00 000000# smsg < received: > ;[189] 21148 000457'03 260 17 0 00 000451* 21149 000016'02 000000000000# 21150 000017'02 777777 777765 21151 000103'04 040 162 145 143 145 21152 000460'03 200 02 0 00 000000* srvnum spsiz ;[189] 21153 000461'03 201 03 0 00 000012 21154 000462'03 104 00 0 00 000224 21155 000463'03 320 14 0 00 000464' 21156 smsg < sent 21157 000464'03 120 02 0 00 000000# > ;[189] 21158 000465'03 260 17 0 00 000457* 21159 000020'02 000000000000# 21160 000021'02 777777 777771 21161 000106'04 040 163 145 156 164 21162 21163 000466'03 415 16 0 00 000504' block. ;[207] Set up a stack frame for registers 21164 000467'03 261 17 0 00 000016 21165 000470'03 265 16 0 00 004447' saveac ;[207] Holds a pointer to elapsed DK10 ticks double word 21166 000471'03 201 05 0 00 000000* movei q1,ewallt ;[207] Resolve address of elapsted wall time block 21167 000472'03 120 02 0 05 000017 dmove t2, .datus(q1) ;[207] Load the actual value 21168 000473'03 434 02 0 00 000003 or t2, t3 ;[207] Checking for non-zero either word 21169 000474'03 322 02 0 00 000503' ifn. t2 ;[207] Did this take any time, actually? 21170 000475'03 120 02 0 00 000000# smsg < Communications duration: > ;[207] It did 21171 000476'03 260 17 0 00 000465* 21172 000022'02 000000000000# 21173 000023'02 777777 777746 21174 000110'04 040 103 157 155 155 21175 000477'03 200 02 0 00 000005 move t2, q1 ;[207] So load pointer to the value 21176 000500'03 260 17 0 00 000000* call durtim ;[207] Print the duration 21177 smsg <, analysis: 21178 000501'03 120 02 0 00 000000# > ;[207] Close off 21179 000502'03 260 17 0 00 000476* 21180 000024'02 000000000000# 21181 000025'02 777777 777763 21182 000116'04 054 040 141 156 141 21183 21184 000503'03 endif. ;[207] End case elapsed DK10 ticks 21185 000503'03 263 17 0 00 000000 endbk. ;[207] Restore stack frame k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 9-1 K20DSP MAC 9-Nov-23 18:22 STATISTICS command 21186 21187 smsg < 21188 000504'03 120 02 0 00 000000# Sent: > ;[189] 21189 000505'03 260 17 0 00 000502* 21190 000026'02 000000000000# 21191 000027'02 777777 777762 21192 000121'04 015 012 011 123 145 21193 000506'03 200 02 0 00 000000* srvnum stot ;[189] 21194 000507'03 201 03 0 00 000012 21195 000510'03 104 00 0 00 000224 21196 000511'03 320 14 0 00 000512' 21197 21198 000512'03 120 02 0 00 000000# smsg < Efficiency: > ;[189] 21199 000513'03 260 17 0 00 000505* 21200 000030'02 000000000000# 21201 000031'02 777777 777757 21202 000124'04 040 040 040 040 011 21203 000514'03 200 02 0 00 000000* move t2, stchr 21204 000515'03 200 03 0 00 000506* move t3, stot 21205 000516'03 260 17 0 00 004143' call peffif ;[189] Print Efficiency Factor 21206 smsg < 21207 000517'03 120 02 0 00 000000# Received: > ;[189] 21208 000520'03 260 17 0 00 000513* 21209 000032'02 000000000000# 21210 000033'02 777777 777762 21211 000130'04 015 012 011 122 145 21212 000521'03 200 02 0 00 000000* srvnum rtot ;[189] 21213 000522'03 201 03 0 00 000012 21214 000523'03 104 00 0 00 000224 21215 000524'03 320 14 0 00 000525' 21216 000525'03 120 02 0 00 000000# smsg < Efficiency: > ;[189] 21217 000526'03 260 17 0 00 000520* 21218 000034'02 000000000000# 21219 000035'02 777777 777757 21220 000133'04 040 040 040 040 011 21221 000527'03 200 02 0 00 000000* move t2, rtchr 21222 000530'03 200 03 0 00 000521* move t3, rtot 21223 000531'03 260 17 0 00 004143' call peffif ;[189] Print Efficiency Factor 21224 21225 smsg < 21226 000532'03 120 02 0 00 000000# Total: > ;[189] 21227 000533'03 260 17 0 00 000526* 21228 000036'02 000000000000# 21229 000037'02 777777 777762 21230 000137'04 015 012 011 124 157 21231 000534'03 200 02 0 00 000530* move t2, rtot 21232 000535'03 270 02 0 00 000515* add t2, stot 21233 000536'03 200 04 0 00 000002 move t4, t2 ; Save the total number of chars. 21234 000537'03 201 03 0 00 000012 movei t3, ^d10 ;[194] 21235 000540'03 104 00 0 00 000224 NOUT% ;[194] 21236 000541'03 320 14 0 00 000542' erjmps .+1 ;[194] 21237 21238 000542'03 120 02 0 00 000000# smsg < Efficiency: > ;[189] 21239 000543'03 260 17 0 00 000533* 21240 000040'02 000000000000# k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 9-2 K20DSP MAC 9-Nov-23 18:22 STATISTICS command 21241 000041'02 777777 777757 21242 000142'04 040 040 040 040 011 21243 000544'03 200 02 0 00 000004 move t2, t4 ;[189] Load total of all communications chars 21244 000545'03 200 03 0 00 000514* move t3, stchr ;[189] Load file characters sent 21245 000546'03 270 03 0 00 000527* add t3, rtchr ;[189] add total receieved 21246 000547'03 260 17 0 00 004143' call peffif ;[189] One or the other will not be zero 21247 21248 smsg < 21249 21250 000550'03 120 02 0 00 000000# Total characters per second: > ;[189] 21251 000551'03 260 17 0 00 000543* 21252 000042'02 000000000000# 21253 000043'02 777777 777736 21254 000146'04 015 012 015 012 040 21255 21256 000552'03 337 03 0 00 000004 skipg t3, t4 ;[207] Did we send anything. actually? 21257 000553'03 254 00 0 00 000557' ifskp. ;[207] Looks like it 21258 000554'03 260 17 0 00 004216' call gmkcps ;[207] Print characters per second 21259 000555'03 254 00 0 00 000557' anskp. ;[207] Unless some problem (like no time) 21260 000556'03 254 00 0 00 000561' else. ;[207] In either case, don't do any math 21261 000557'03 120 02 0 00 000000# smsg <[N/A]> ;[207] So say really can't do it 21262 000560'03 260 17 0 00 000551* 21263 000044'02 000000000000# 21264 000045'02 777777 777773 21265 000155'04 133 116 057 101 135 21266 000561'03 endif. ;[207] End handling characters per second 21267 21268 smsg < 21269 000561'03 120 02 0 00 000000# Effective data rate: > ;[189] 21270 000562'03 260 17 0 00 000560* 21271 000046'02 000000000000# 21272 000047'02 777777 777747 21273 000157'04 015 012 040 105 146 21274 000563'03 336 03 0 00 000545* skipn t3, stchr ;[189] Is the number of chars sent zero? 21275 000564'03 200 03 0 00 000546* move t3, rtchr ;[189] If so we were receiving. 21276 000565'03 322 03 0 00 000570' ifn. t3 ;[207] Was there any data? 21277 000566'03 260 17 0 00 004241' call gmkbps ;[189] Display a more readable baud rate 21278 000567'03 254 00 0 00 000572' else. ;[207] Otherwise, number makes no sense 21279 000570'03 120 02 0 00 000000# smsg <[N/A]> ;[207] So say it isn't applicable 21280 000571'03 260 17 0 00 000562* 21281 000050'02 000000000000# 21282 000051'02 777777 777773 21283 000165'04 133 116 057 101 135 21284 000572'03 endif. 21285 21286 000572'03 337 00 0 00 000000# skipg pvbaud ;[210] Do we have a virtual baud rate? 21287 000573'03 333 00 0 00 000000* skiple speed ;[207] or on a real terminal? 21288 000574'03 260 17 0 00 000703' call pspeef ;[207] Go print speed efficiency (maybe) 21289 ;[180]... 21290 smsg < 21291 000575'03 120 02 0 00 000000# ILDB: > ;[189] 21292 000576'03 260 17 0 00 000571* 21293 000052'02 000000000000# 21294 000053'02 777777 777767 21295 000167'04 015 012 040 111 114 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 9-3 K20DSP MAC 9-Nov-23 18:22 STATISTICS command 21296 000577'03 200 02 0 00 000000* srvnum ttildb ;[189] 21297 000600'03 201 03 0 00 000012 21298 000601'03 104 00 0 00 000224 21299 000602'03 320 14 0 00 000603' 21300 000603'03 120 02 0 00 000000# smsg < SIN: > ;[189] 21301 000604'03 260 17 0 00 000576* 21302 000054'02 000000000000# 21303 000055'02 777777 777770 21304 000171'04 040 040 123 111 116 21305 000605'03 200 02 0 00 000000* srvnum ttisin ;[189] 21306 000606'03 201 03 0 00 000012 21307 000607'03 104 00 0 00 000224 21308 000610'03 320 14 0 00 000611' 21309 000611'03 120 02 0 00 000000# smsg < SIN Max: > ;[189] 21310 000612'03 260 17 0 00 000604* 21311 000056'02 000000000000# 21312 000057'02 777777 777764 21313 000173'04 040 040 123 111 116 21314 000613'03 200 02 0 00 000000* srvnum ttimax ;[189] 21315 000614'03 201 03 0 00 000012 21316 000615'03 104 00 0 00 000224 21317 000616'03 320 14 0 00 000617' 21318 000617'03 120 02 0 00 000000# smsg < BIN: > ;[189] 21319 000620'03 260 17 0 00 000612* 21320 000060'02 000000000000# 21321 000061'02 777777 777770 21322 000176'04 040 040 102 111 116 21323 000621'03 200 02 0 00 000000* srvnum ttibin ;[189] 21324 000622'03 201 03 0 00 000012 21325 000623'03 104 00 0 00 000224 21326 000624'03 320 14 0 00 000625' 21327 ;...[180] 21328 21329 000625'03 336 00 0 00 000000* $stat4: skipn errptr ; Was there an error? 21330 000626'03 254 00 0 00 000640' jrst $statx ; If not, done. 21331 smsg < 21332 000627'03 120 02 0 00 000000# Canceled by error: > ;[189] 21333 000630'03 260 17 0 00 000620* 21334 000062'02 000000000000# 21335 000063'02 777777 777751 21336 000200'04 015 012 040 103 141 21337 000631'03 200 02 0 00 000625* move t2, errptr ;[189] 21338 000632'03 403 03 0 00 000004 setzb t3, t4 ;[189] 21339 000633'03 104 00 0 00 000053 SOUT% ;[189] ; If so output it. 21340 000634'03 320 14 0 00 000635' erjmps .+1 ;[189] 21341 000635'03 561 02 0 00 000203* hrroi t2, crlf ;[189] ;[50] 21342 000636'03 104 00 0 00 000053 SOUT% ;[189] 21343 000637'03 320 14 0 00 000640' erjmps .+1 ;[189] 21344 21345 ;[36] Interpacket pause. 21346 21347 $statx: smsg < 21348 000640'03 120 02 0 00 000000# Interpacket pause in effect: > 21349 000641'03 260 17 0 00 000630* 21350 000064'02 000000000000# k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 9-4 K20DSP MAC 9-Nov-23 18:22 STATISTICS command 21351 000065'02 777777 777740 21352 000205'04 015 012 040 111 156 21353 000642'03 200 02 0 00 000000* srvnum pause ;[196] 21354 000643'03 201 03 0 00 000012 21355 000644'03 104 00 0 00 000224 21356 000645'03 320 14 0 00 000646' 21357 smsg < ms 21358 21359 000646'03 120 02 0 00 000000# Timeouts: > ;[196] ;[54] How many timeouts and NAKs. 21360 000647'03 260 17 0 00 000641* 21361 000066'02 000000000000# 21362 000067'02 777777 777756 21363 000214'04 040 155 163 015 012 21364 21365 000650'03 200 02 0 00 000000* srvnum ntimou ;[189] 21366 000651'03 201 03 0 00 000012 21367 000652'03 104 00 0 00 000224 21368 000653'03 320 14 0 00 000654' 21369 smsg < 21370 000654'03 120 02 0 00 000000# NAKs: > ;[189] 21371 000655'03 260 17 0 00 000647* 21372 000070'02 000000000000# 21373 000071'02 777777 777764 21374 000220'04 015 012 040 116 101 21375 000656'03 200 02 0 00 000000* srvnum nnak ;[189] 21376 000657'03 201 03 0 00 000012 21377 000660'03 104 00 0 00 000224 21378 000661'03 320 14 0 00 000662' 21379 21380 ;[47][132] If debugging, tell most recent JSYS error. 21381 21382 000662'03 322 14 0 00 000700' jumpe debug, $statz ;[132] Debugging? 21383 $statj: smsg < 21384 000663'03 120 02 0 00 000000# Last JSYS error: > ;[189] ; Yes, tell about last error. 21385 000664'03 260 17 0 00 000655* 21386 000072'02 000000000000# 21387 000073'02 777777 777754 21388 000223'04 015 012 040 114 141 21389 000665'03 525 02 0 00 400000 hrloi t2, .fhslf 21390 000666'03 400 03 0 00 000000 setz t3, 21391 000667'03 104 00 0 00 000011 ERSTR 21392 000670'03 320 14 0 00 000672' erjmps .+2 ;[189] Ignore strange error 21393 000671'03 320 14 0 00 000672' erjmps .+1 ;[189] Ignore stranger error 21394 smsg < 21395 000672'03 120 02 0 00 000000# Timer errors: > ;[189] ;[132] Also, give hints if anything is 21396 000673'03 260 17 0 00 000664* 21397 000074'02 000000000000# 21398 000075'02 777777 777754 21399 000230'04 015 012 040 124 151 21400 000674'03 200 02 0 00 000000* srvnum timerx ;[189] ; going wrong with timers. 21401 000675'03 201 03 0 00 000012 21402 000676'03 104 00 0 00 000224 21403 000677'03 320 14 0 00 000700' 21404 21405 $statz: smsg < k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 9-5 K20DSP MAC 9-Nov-23 18:22 STATISTICS command 21406 21407 000700'03 120 02 0 00 000000# > ;[189] 21408 000701'03 260 17 0 00 000673* 21409 000076'02 000000000000# 21410 000077'02 777777 777774 21411 000235'04 015 012 015 012 000 21412 000702'03 263 17 0 00 000000 ret 21413 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 10 K20DSP MAC 9-Nov-23 18:22 Print Speed Efficiency (if we have some kind of baud rate) 21414 subttl Print Speed Efficiency (if we have some kind of baud rate) 21415 21416 ; Rewrite of previous code for nanosecond resolution 21417 21418 ; N.B., Code IGNORES split speed and uses only the recieve speed 21419 21420 extern dblscl ; Double integer scaling factor 21421 21422 chgsec(code,const) 21423 000100'02 207620 000000 percnt: 100. ; Factor to range up to a percent 21424 000101'02 000000 000000 0. ; Double floating multiplier!! 21425 retsec 21426 21427 000703'03 pspeef: remark t1 ; It is DEADLY to touch t1!! 21428 remark ; Assumes these may be smashed 21429 remark t5, q1 ; These are aliased 21430 000703'03 265 16 0 00 004447' saveac ; Play it safe 21431 000704'03 265 16 0 00 000000* trvar <,,,,,> 21432 000705'03 000000 000014 21433 ; Naming conventions for transient variables 21434 remark dichrs ; Double Integer characters 21435 remark dfchrs ; Double floating characters 21436 remark dietic ; Double Integer elapsed ticks 21437 remark dfetic ; Double floating elapsed ticks 21438 remark disped ; Double integer speed 21439 remark dfsped ; Double floating speed 21440 21441 000706'03 403 02 0 00 000003 setzb t2, t3 ; Let's assume we'll need to float 21442 000707'03 124 02 0 15 000011 dmovem t2, disped ; an integer 21443 000710'03 124 02 0 15 000013 dmovem t2, dfsped ; baud rate 21444 21445 000711'03 135 02 0 00 004455' ldb t2,[POINTR(,nttype)] ;[210] Maybe remote, so find out 21446 000712'03 135 03 0 00 004456' ldb t3,[POINTR(,ntline)] ;[210] about our local line 21447 000713'03 332 00 0 00 000000* ifme. ptyflg ; Not connected to a pseudo terminal? 21448 000714'03 254 00 0 00 000737' 21449 000715'03 332 00 0 00 000000* skipe nrtflg ; Network remote? 21450 000716'03 254 00 0 00 000737' anskp. ; So do that 21451 000717'03 302 02 0 00 000000 caie t2, nw%nnt ; Not a network transport? 21452 000720'03 254 00 0 00 000737' anskp. ; No, so either a front end or PTY 21453 000721'03 306 03 0 00 000002 cain t3, nw%pt ; But!! Are we on a pseudo-terminal?? 21454 000722'03 254 00 0 00 000737' anskp. ; No, so can only be the front-end case 21455 smsg < 21456 000723'03 120 02 0 00 000000# Efficiency: > ; Begin more blat 21457 000724'03 260 17 0 00 000701* 21458 000102'02 000000000000# 21459 000103'02 777777 777757 21460 000236'04 015 012 040 105 146 21461 000725'03 333 03 0 00 000573* skiple t3, speed ; Load and check speed 21462 000726'03 254 00 0 00 000732' ifskp. ; Is this absurd? 21463 000727'03 120 02 0 00 000000# smsg <[SPEED ERROR]> ;Report speed error 21464 000730'03 260 17 0 00 000724* 21465 000104'02 000000000000# 21466 000105'02 777777 777763 21467 000242'04 133 123 120 105 105 21468 000731'03 263 17 0 00 000000 ret ; Leave, can't do anything else k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 10-1 K20DSP MAC 9-Nov-23 18:22 Print Speed Efficiency (if we have some kind of baud rate) 21469 000732'03 endif. ; end speed load and check 21470 000732'03 400 02 0 00 000000 setz t2, ; Assume hardware baud is not an unsigned int 21471 000733'03 623 03 0 00 400000 tlze t3, (1b0) ; Cast unsigned to signed long 21472 000734'03 201 02 0 00 000001 movei t2, ^d1 ; Propagate to high order 21473 000735'03 124 02 0 15 000011 dmovem t2, disped ; And store as the speed 21474 000736'03 254 00 0 00 000761' else. ; Otherwise, might have done virtual timing 21475 000737'03 400 05 0 00 000000 setz q1, ;[210] Let's assume we don't know what to load 21476 000740'03 332 00 0 00 000713* skipe ptyflg ;[210] Connected to a PTY? 21477 000741'03 201 05 0 00 000000# movei q1, pvbaud ;[210] Address of its virtual baud rate 21478 000742'03 332 00 0 00 000715* skipe nrtflg ;[210] How about an NRT? 21479 000743'03 201 05 0 00 000000# movei q1, dnbaud ;[210] Address of DECnet virtual baud rate 21480 000744'03 326 05 0 00 000752' ife. q1 ;[210] Still don't know? 21481 000745'03 306 03 0 00 000002 cain t3, nw%pt ;[210] A pseudo-terminal? 21482 000746'03 201 05 0 00 000000# movei q1, pvbaud ;[210] Address of its virtual baud rate 21483 000747'03 306 03 0 00 000003 cain t3, nw%mc ;[210] An NRT? 21484 000750'03 201 05 0 00 000000# movei q1, dnbaud ;[210] Address of DECnet virtual baud rate 21485 000751'03 322 05 0 00 000444* jumpe q1, R ;[210] If still nothing, then done 21486 000752'03 endif. ;[210] Otherwise some valid address in q1 21487 000752'03 120 02 0 05 000000 dmove t2, (q1) ;[210] Load any timing test data 21488 000753'03 323 02 0 00 000751* jumple t2, R ;[210] No test or bad test 21489 000754'03 124 02 0 15 000013 dmovem t2, dfsped ; Store precomputed virtual rate 21490 000755'03 477 02 0 00 000003 setob t2, t3 ; Cons up an impossible double integer baud rate 21491 000756'03 124 02 0 15 000011 dmovem t2, disped ; And store as the speed 21492 smsg < 21493 000757'03 120 02 0 00 000000# Pseudo-efficiency: > ; Begin pseudo-blat 21494 000760'03 260 17 0 00 000730* 21495 000106'02 000000000000# 21496 000107'02 777777 777751 21497 000245'04 015 012 040 120 163 21498 000761'03 endif. ; End case local or remote instrumented PTY 21499 21500 000761'03 336 03 0 00 000563* skipn t3, stchr ; Nothing sent? 21501 000762'03 200 03 0 00 000564* move t3, rtchr ; No, so this was a recieve 21502 000763'03 326 03 0 00 000767' ife. t3 ; Or did nothing happen at all? 21503 000764'03 120 02 0 00 000000# smsg <[N/A]> ; So say it isn't applicable 21504 000765'03 260 17 0 00 000760* 21505 000110'02 000000000000# 21506 000111'02 777777 777773 21507 000252'04 133 116 057 101 135 21508 000766'03 263 17 0 00 000000 ret ; And get out of here 21509 000767'03 endif. 21510 21511 000767'03 400 02 0 00 000000 setz t2, ; Assume characters are not unsigned int 21512 000770'03 623 03 0 00 400000 tlze t3, (1b0) ; Cast unsigned to signed long 21513 000771'03 201 02 0 00 000001 movei t2, ^d1 ; Propagate to high order 21514 000772'03 124 02 0 15 000001 dmovem t2, dichrs ; And store signed long 21515 21516 000773'03 415 16 0 00 001001' block. ; Enter block context for better control flow 21517 000774'03 261 17 0 00 000016 21518 000775'03 120 02 0 00 000000# dmove t2,ewallt+.datus ;Load double elapsed DK10 ticks 21519 000776'03 327 02 0 00 000445* jumpg t2, RSKP ; Non-zero high order is good 21520 000777'03 327 03 0 00 000776* jumpg t3, RSKP ; Ditto low order 21521 001000'03 263 17 0 00 000000 endbk. ; End block context 21522 001001'03 254 00 0 00 001004' ifskp. ; Positive number? 21523 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 20:02 27-Nov-23 Page 10-2 K20DSP MAC 9-Nov-23 18:22 Print Speed Efficiency (if we have some kind of baud rate) 21524 001003'03 254 00 0 00 001007' else. ; Otherwise, zero or negative 21525 001004'03 120 02 0 00 000000# smsg <[TIME ERROR]> ; Report time error 21526 001005'03 260 17 0 00 000765* 21527 000112'02 000000000000# 21528 000113'02 777777 777764 21529 000254'04 133 124 111 115 105 21530 001006'03 263 17 0 00 000000 ret ; Leave, can't do anything else 21531 001007'03 endif. 21532 21533 001007'03 415 16 0 00 001034' block. ; Enter block context to double float everything 21534 001010'03 261 17 0 00 000016 21535 001011'03 265 16 0 00 004457' saveac ; Save precious T1 21536 001012'03 120 01 0 15 000011 dmove t1, disped ; Load integer baud 21537 001013'03 321 01 0 00 001017' ifge. t1 ; Already did this? 21538 001014'03 260 17 0 00 000000* call dfloat ; Convert to double floating point 21539 001015'03 263 17 0 00 000000 ret ; Or not 21540 001016'03 124 01 0 15 000013 dmovem t1, dfsped ; Store double floating speed 21541 001017'03 endif. ; Otherwise, already done 21542 21543 001017'03 120 01 0 15 000005 dmove t1, dietic ; Load double integer elapsed ticks 21544 001020'03 260 17 0 00 001014* call dfloat ; Convert to double floating point 21545 001021'03 263 17 0 00 000000 ret ; But couldn't... 21546 001022'03 124 01 0 15 000007 dmovem t1, dfetic ; Store double floating elapsed ticks 21547 001023'03 120 01 0 15 000001 dmove t1, dichrs ; Load double integer characters 21548 001024'03 116 01 0 00 000000* dmul t1, dblscl ; Scale up by nanosecond ratio 21549 001025'03 124 03 0 15 000001 dmovem t3, dichrs ; Store scaled double integer elapsed ticks 21550 21551 001026'03 120 01 0 00 000003 dmove t1, t3 ; Load same for double floating 21552 001027'03 260 17 0 00 001020* call dfloat ; Convert to double floating point 21553 001030'03 263 17 0 00 000000 ret ; Yet failed 21554 001031'03 124 01 0 15 000003 dmovem t1, dfchrs ; Store double floating characters 21555 001032'03 254 00 0 00 000777* retskp ; Indicate complete double floating success 21556 001033'03 263 17 0 00 000000 endbk. ; End block context, release frame 21557 001034'03 254 00 0 00 001040' ifskp. ; Worked 21558 001035'03 120 02 0 15 000003 dmove t2, dfchrs ; Load double floating characters 21559 001036'03 112 02 0 00 004237' dfmp t2, baud ; Convert to bits for baud rate 21560 001037'03 254 00 0 00 001043' else. ; Something went wrong... 21561 001040'03 120 02 0 00 000000# smsg <[DFLOAT ERROR]> ; Yes, whine about it 21562 001041'03 260 17 0 00 001005* 21563 000114'02 000000000000# 21564 000115'02 777777 777762 21565 000257'04 133 104 106 114 117 21566 001042'03 263 17 0 00 000000 ret ; Return, can't go any further 21567 001043'03 endif. 21568 21569 001043'03 113 02 0 15 000007 dfdv t2, dfetic ; Compute effective baud rate 21570 001044'03 112 02 0 00 000000# dfmp t2, percnt ; Scale to percentage 21571 001045'03 113 02 0 15 000013 dfdv t2, dfsped ; Divide by line rate to get efficiency 21572 001046'03 260 17 0 00 004203' call peffi0 ; Print it 21573 001047'03 120 02 0 00 000000# smsg < per cent> ;[189] 21574 001050'03 260 17 0 00 001041* 21575 000116'02 000000000000# 21576 000117'02 777777 777767 21577 000262'04 040 160 145 162 040 21578 001051'03 263 17 0 00 000000 ret k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 10-3 K20DSP MAC 9-Nov-23 18:22 Print Speed Efficiency (if we have some kind of baud rate) 21579 21580 endtv. ; End lexical context transient variables 21581 21582 ;[207] End code insertion 21583 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 11 K20DSP MAC 9-Nov-23 18:22 Print real or virtual baud rate 21584 subttl Print real or virtual baud rate 21585 21586 extern ntiblk ;[210] NTINF% of local line 21587 21588 001052'03 332 00 0 00 000740* prntbd: skipe ptyflg ;[210] Connected to a PTY? 21589 001053'03 254 00 0 00 001107' jrst prntbv ;[210] Yes, show the virtual baud rate 21590 001054'03 332 00 0 00 000742* skipe nrtflg ;[210] How about an NRT? 21591 001055'03 254 00 0 00 001107' jrst prntbv ;[210] Yes, show the virtual baud rate 21592 remark pipflg ;[210] Connected via a pipe? 21593 remark prntbv ;[210] Yes, show the virtual baud rate 21594 ;[210] Load network and line type of local terminal 21595 001056'03 135 01 0 00 004465' ldb t1,[POINTR(,nttype)] ;[210] 21596 001057'03 135 02 0 00 004466' ldb t2,[POINTR(,ntline)] ;[210] 21597 001060'03 302 01 0 00 000000 caie t1, nw%nnt ;[210] Not a 'network' terminal? 21598 001061'03 254 00 0 00 001101' jrst prntnv ;[210] No see if it has a network virtual baud rate 21599 001062'03 306 02 0 00 000002 cain t2, nw%pt ;[210] But!! Are we on a pseudo-terminal?? 21600 001063'03 254 00 0 00 001101' jrst prntnv ;[210] We are, see if we did a speed test 21601 remark ;[210] Only other non-network terminal is FE: 21602 21603 001064'03 337 02 0 00 000725* prntbs: skipg t2,speed ; If negative, we don't really know it. 21604 001065'03 254 00 0 00 001100' ifskp. ;[194] We know it 21605 txmsg < 21606 001066'03 200 01 0 00 000000# Speed: > ; Line speed. 21607 001067'03 104 00 0 00 000076 21608 001070'03 320 12 0 00 001071' 21609 000120'02 000000000000# 21610 000264'04 015 012 040 040 123 21611 001071'03 201 01 0 00 000101 movei t1, .priou 21612 001072'03 201 03 0 00 000012 movei t3, ^d10 21613 001073'03 104 00 0 00 000224 NOUT% 21614 001074'03 320 14 0 00 001075' erjmps .+1 21615 001075'03 200 01 0 00 000000# txmsg < Bd> ;[210] Recognized suffix for "baud" 21616 001076'03 104 00 0 00 000076 21617 001077'03 320 12 0 00 001100' 21618 000121'02 000000000000# 21619 000270'04 040 102 144 000 000 21620 001100'03 endif. ;[194] 21621 001100'03 263 17 0 00 000000 ret ;[210] Either way, done 21622 21623 001101'03 400 01 0 00 000000 prntnv: setz t1, ;[210] Let's assume we don't know what to load 21624 001102'03 306 02 0 00 000002 cain t2, nw%pt ;[210] A pseudo-terminal? 21625 001103'03 201 01 0 00 000000# movei t1, pvbaud ;[210] Address of its virtual baud rate 21626 001104'03 306 02 0 00 000003 cain t2, nw%mc ;[210] An NRT? 21627 001105'03 201 01 0 00 000000# movei t1, dnbaud ;[210] Address of DECnet virtual baud rate 21628 001106'03 254 00 0 00 001114' jrst prntcm ;[210] See if anything to print 21629 21630 001107'03 400 01 0 00 000000 prntbv: setz t1, ;[210] Let's assume we don't know what to load 21631 001110'03 332 00 0 00 001052* skipe ptyflg ;[210] Connected to a PTY? 21632 001111'03 201 01 0 00 000000# movei t1, pvbaud ;[210] Address of its virtual baud rate 21633 001112'03 332 00 0 00 001054* skipe nrtflg ;[210] How about an NRT? 21634 001113'03 201 01 0 00 000000# movei t1, dnbaud ;[210] Address of DECnet virtual baud rate 21635 remark pipflg ;[210] Connected via a pipe? 21636 remark t1, pibaud ;[210] Address of its virtual baud rate 21637 21638 001114'03 prntcm: remark ;[210] Common virtual speed k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 11-1 K20DSP MAC 9-Nov-23 18:22 Print real or virtual baud rate 21639 001114'03 322 01 0 00 000753* jumpe t1, r ;[210] Return if nobody is volunteering anything 21640 001115'03 265 16 0 00 004447' saveac ;[210] Preserve for proper return xct 21641 remark t5, q1 ;[210] Because t4:t5 pair used 21642 001116'03 120 04 0 01 000000 dmove t4, (t1) ;[210] Load virtual baud rate 21643 001117'03 323 04 0 00 001114* jumple t4, r ;[210] If nothing, then don't print anything 21644 txmsg < 21645 001120'03 200 01 0 00 000000# Pseudo Speed: > ;[210] Instrumented PTY speed 21646 001121'03 104 00 0 00 000076 21647 001122'03 320 12 0 00 001123' 21648 000122'02 000000000000# 21649 000271'04 015 012 040 040 120 21650 001123'03 201 01 0 00 000101 movei t1, .priou ;[210] Display it on terminal 21651 001124'03 254 00 0 00 004256' callret gmkbp1 ;[210] Print the baud rate 21652 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 12 K20DSP MAC 9-Nov-23 18:22 Print real or virtual baud rate 21653 remark Test command semantic action 21654 21655 ;[210] Begin Code Insertion 21656 21657 extern dptybd ; Discover PTY: virtual baud rate 21658 extern dnulbd ; Discover NUL: virtual baud rate 21659 extern dpipbd ; Discover PIP: virtual baud rate 21660 extern dsrvbd ; Discover DECnet (DCN:/SRV:) virtual baud rate 21661 extern timdev ; Device being timed 21662 21663 001125'03 $time: intern $time ; Called from k20par 21664 001125'03 265 16 0 00 004447' saveac ; Just in case anybody might needit 21665 001126'03 331 01 0 00 000000* skipl t1, pars2 ; Pick up the device to test 21666 001127'03 254 00 0 00 001151' ifskp. ; Special return?? 21667 001130'03 316 01 0 00 004467' camn t1, [-1] ; Error that somebody else blatted? 21668 001131'03 263 17 0 00 000000 ret ; We're done 21669 001132'03 554 02 0 00 000001 hlrz t2, t1 ; Reposition source device type 21670 001133'03 620 02 0 00 600000 trz t2, .dvdes ; Now have a device number 21671 001134'03 200 01 0 00 000000# txmsg 21672 001135'03 104 00 0 00 000076 21673 001136'03 320 12 0 00 001137' 21674 000123'02 000000000000# 21675 000276'04 103 157 160 151 145 21676 001137'03 200 01 0 00 000002 move t1, t2 ; Position for conversion to text 21677 001140'03 260 17 0 00 001262' call ascdev ; Do so 21678 001141'03 104 00 0 00 000076 PSOUT% ; Type the text 21679 001142'03 200 01 0 00 000000# txmsg < to > ; Where it's going 21680 001143'03 104 00 0 00 000076 21681 001144'03 320 12 0 00 001145' 21682 000124'02 000000000000# 21683 000304'04 040 164 157 040 000 21684 001145'03 200 02 0 00 000000* move t2, pars3 ; Load destination device 21685 001146'03 202 02 0 00 001126* movem t2, pars2 ; Put where downstream wants it 21686 001147'03 120 04 0 00 000000* dmove t4, pars4 ; Load the timing results 21687 001150'03 254 00 0 00 001323' callret $time1 ; And go type something 21688 001151'03 endif. 21689 21690 001151'03 202 01 0 00 000000* movem t1, timdev ; Remember device being timed 21691 001152'03 302 01 0 00 000013 caie t1, .dvpty ; Pseudo-terminal? 21692 001153'03 254 00 0 00 001172' ifskp. ; Yep, so let's run that test 21693 001154'03 476 00 0 00 000000# setom pvbaud ; Say no PTY virtual baud rate 21694 001155'03 476 00 0 00 000000# setom pvbaud+1 ; It's a double 21695 001156'03 260 17 0 00 000000* call dptybd ; Found in k20net 21696 001157'03 254 00 0 00 001165' ifskp. 21697 001160'03 327 04 0 00 001164' ifle. t4 ; Did it work? 21698 001161'03 200 01 0 00 000000# emsg 21699 001162'03 104 00 0 00 000313 21700 000125'02 000000000000# 21701 000305'04 120 163 145 165 144 21702 001163'03 263 17 0 00 000000 ret ; Can't do anything further 21703 001164'03 endif. ; Otherwise, have a valid number 21704 001164'03 254 00 0 00 001170' else. 21705 001165'03 200 01 0 00 000000# emsg 21706 001166'03 104 00 0 00 000313 21707 000126'02 000000000000# k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 12-1 K20DSP MAC 9-Nov-23 18:22 Print real or virtual baud rate 21708 000316'04 120 163 145 165 144 21709 001167'03 263 17 0 00 000000 ret ; Can't do anything further 21710 001170'03 endif. 21711 21712 001170'03 124 04 0 00 000000# dmovem t4, pvbaud ; Side-effect virtual baud rate 21713 001171'03 254 00 0 00 001323' callret $time1 ; And display it 21714 001172'03 endif. ; End case pseudo-terminal 21715 21716 001172'03 302 01 0 00 000015 caie t1, .dvnul ; NUL: device? 21717 001173'03 254 00 0 00 001212' ifskp. ; OK, so let's see how fast we can dump stuff 21718 001174'03 476 00 0 00 000000# setom nlbaud ; Assume fails 21719 001175'03 476 00 0 00 000000# setom nlbaud+1 ; It's a double word 21720 001176'03 260 17 0 00 000000* call dnulbd ; Go do some nanosecond timing 21721 001177'03 254 00 0 00 001205' ifskp. 21722 001200'03 327 04 0 00 001204' ifle. t4 ; Did it work? 21723 001201'03 200 01 0 00 000000# emsg 21724 001202'03 104 00 0 00 000313 21725 000127'02 000000000000# 21726 000327'04 104 141 164 141 040 21727 001203'03 263 17 0 00 000000 ret ; Can't do anything further 21728 001204'03 endif. ; Otherwise, have a valid number 21729 001204'03 254 00 0 00 001210' else. 21730 001205'03 200 01 0 00 000000# emsg 21731 001206'03 104 00 0 00 000313 21732 000130'02 000000000000# 21733 000337'04 104 141 164 141 040 21734 001207'03 263 17 0 00 000000 ret ; Can't do anything further 21735 001210'03 endif. 21736 21737 001210'03 124 04 0 00 000000# dmovem t4, nlbaud ; Store NUL's virtual baud rate 21738 001211'03 254 00 0 00 001323' callret $time1 ; Hit display epilogue 21739 001212'03 endif. 21740 21741 001212'03 302 01 0 00 000403 caie t1, .dvpip ; Pipe device? 21742 001213'03 254 00 0 00 001232' ifskp. ; Yep, so let's run that test 21743 001214'03 476 00 0 00 000000# setom pibaud ; Assume fails 21744 001215'03 476 00 0 00 000000# setom pibaud+1 ; It's a double word 21745 001216'03 260 17 0 00 000000* call dpipbd ; Found in k20net 21746 001217'03 254 00 0 00 001225' ifskp. 21747 001220'03 327 04 0 00 001224' ifle. t4 ; Did it work? 21748 001221'03 200 01 0 00 000000# emsg 21749 001222'03 104 00 0 00 000313 21750 000131'02 000000000000# 21751 000347'04 120 151 160 145 040 21752 001223'03 263 17 0 00 000000 ret ; Can't do anything further 21753 001224'03 endif. ; Otherwise, have a valid number 21754 001224'03 254 00 0 00 001230' else. 21755 001225'03 200 01 0 00 000000# emsg 21756 001226'03 104 00 0 00 000313 21757 000132'02 000000000000# 21758 000356'04 120 151 160 145 040 21759 001227'03 263 17 0 00 000000 ret ; Can't do anything further 21760 001230'03 endif. 21761 21762 001230'03 124 04 0 00 000000# dmovem t4, pibaud ; Store the calculated baud rate k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 12-2 K20DSP MAC 9-Nov-23 18:22 Print real or virtual baud rate 21763 001231'03 254 00 0 00 001323' callret $time1 ; Hit display epilogue 21764 001232'03 endif. ; End case pseudo-terminal 21765 21766 001232'03 306 01 0 00 000022 cain t1, .dvdcn ; DECnet active component? 21767 001233'03 201 01 0 00 000023 movei t1, .dvsrv ; Replace with DECnet passive component 21768 21769 001234'03 302 01 0 00 000023 caie t1, .dvsrv ; DECnet? 21770 001235'03 254 00 0 00 001254' ifskp. ; Yep, so let's run that test 21771 001236'03 476 00 0 00 000000# setom dnbaud ; Assume no DECnet baud rate detected 21772 001237'03 476 00 0 00 000000# setom dnbaud+1 ; It's a double 21773 001240'03 260 17 0 00 000000* call dsrvbd ; Found in k20net 21774 001241'03 254 00 0 00 001247' ifskp. 21775 001242'03 327 04 0 00 001246' ifle. t4 ; Did it work? 21776 001243'03 200 01 0 00 000000# emsg 21777 001244'03 104 00 0 00 000313 21778 000133'02 000000000000# 21779 000365'04 104 105 103 156 145 21780 001245'03 263 17 0 00 000000 ret ; Can't do anything further 21781 001246'03 endif. ; Otherwise, have a valid number 21782 001246'03 254 00 0 00 001252' else. 21783 001247'03 200 01 0 00 000000# emsg 21784 001250'03 104 00 0 00 000313 21785 000134'02 000000000000# 21786 000375'04 104 105 103 156 145 21787 001251'03 263 17 0 00 000000 ret ; Can't do anything further 21788 001252'03 endif. 21789 21790 001252'03 124 04 0 00 000000# dmovem t4, dnbaud ; Store the calculated baud rate 21791 001253'03 254 00 0 00 001323' callret $time1 ; Hit display epilogue 21792 001254'03 endif. ; End case pseudo-terminal 21793 21794 001254'03 260 17 0 00 001262' call ascdev ; Turn device number in t1 into a name 21795 001255'03 104 00 0 00 000313 ESOUT% ; Begin whining 21796 txmsg < does not have a timing routine 21797 001256'03 200 01 0 00 000000# > ; Complete whining 21798 001257'03 104 00 0 00 000076 21799 001260'03 320 12 0 00 001261' 21800 000135'02 000000000000# 21801 000404'04 040 144 157 145 163 21802 21803 001261'03 263 17 0 00 000000 ret ; Beat it 21804 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 13 K20DSP MAC 9-Nov-23 18:22 Handle unknown and known timing devices 21805 subttl Handle unknown and known timing devices 21806 21807 ; Call: 21808 ; 21809 ; t1/ Device number to translate 21810 ; 21811 ; Return: +1 always 21812 ; 21813 ; t1/ pointer to constructed device text 21814 ; (even if unknown device) 21815 21816 chgsec(code,data) ; Need some writable storage 21817 000000'05 devtxt: block 4 ; Space for ASCII device name 21818 retsec ; Close off writable storage 21819 21820 chgsec(code,text) ; Emit some program text 21821 000004'01 125 156 153 156 157 unktxt: asciz "Unknown:" ; if we have no clue 21822 000006'01 000000 000072 dvpunc: exp ":", .chnul ; Device punctuation 21823 retsec ; Close off program text 21824 21825 001262'03 ascdev: intern ascdev ; In case K20TIM wants to directly use it 21826 001262'03 265 16 0 00 004470' saveac ; Needs some registers 21827 001263'03 200 05 0 00 000001 move q1, t1 ; Save device number 21828 21829 001264'03 260 17 0 00 001310' call devunt ; If device has units, use that 21830 001265'03 326 01 0 00 001117* jumpn t1, r ; Was transformed 21831 ; OK, not a device with units 21832 001266'03 525 02 0 05 600000 hrloi t2, .dvdes(q1) ; Turn back into a real device 21833 001267'03 201 01 0 00 000000# movei t1, devtxt ; Writable to put ASCII device name 21834 001270'03 403 03 0 00 000004 setzb t3, t4 ; Ten .chnul's of device name (6 max) 21835 001271'03 124 03 0 01 000000 dmovem t3, 0(t1) ; Stomp area 21836 001272'03 124 03 0 01 000002 dmovem t3, 2(t1) ; Plus extra for good measure 21837 001273'03 661 01 0 00 777777 tlo t1, -1 ; Now have a Tops-20 JSYS pointer 21838 21839 001274'03 104 00 0 00 000121 DEVST% ; Turn into a string 21840 001275'03 320 12 0 00 001277' ifje. r ; Catch error 21841 001276'03 254 00 0 00 001302' 21842 001277'03 200 02 0 00 000001 move t2, t1 ; And keep for a debugger 21843 001300'03 561 01 0 00 000000# hrroi t1, unktxt ; Say we don't know... 21844 001301'03 254 00 0 00 001307' else. ; Otherwise, have some text 21845 001302'03 120 02 0 00 000000# dmove t2, dvpunc ; Load device punctuation 21846 001303'03 136 02 0 00 000001 idpb t2, t1 ; Drop in the colon 21847 001304'03 200 02 0 00 000001 move t2, t1 ; Copy the pointer 21848 001305'03 136 03 0 00 000002 idpb t3, t2 ; Close off string, allowing append 21849 001306'03 561 01 0 00 000000# hrroi t1, devtxt ; Return pointer to constructed text 21850 001307'03 endif. 21851 21852 001307'03 263 17 0 00 000000 ret ; Finally return, something... 21853 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 14 K20DSP MAC 9-Nov-23 18:22 devunt Turns a device with unit numbers into generic 21854 subttl devunt Turns a device with unit numbers into generic 21855 21856 ;Can't use chgsec here, doesn't nest 21857 21858 define gendev(d,t,%a) < 21859 xwd d,%a ;;Create an entry for this device 21860 .endps const ;;Out of constants 21861 .psect text ;;Program text 21862 %a: asciz "'t:" ;;Emit the text, no output to DDT 21863 .endps text ;;Close of text 21864 .psect const ;;Back in constants 21865 cleans(<%a>) 21866 >;;gendev 21867 21868 ; Build table of generic device text for unit based devices 21869 21870 ; The first three currently exist on PANDA and can be entered to .cmdev 21871 21872 chgsec(code,const) 21873 000136'02 000013 000000# gentab: gendev(.dvpty,PTY) ;;Pseudo-terminal (most common) 21874 000010'01 120 124 131 072 000 21875 000137'02 000012 000000# gendev(.dvtty,TTY) ;;Terminal (second most common) 21876 000011'01 124 124 131 072 000 21877 000140'02 000011 000000# gendev(.dvfe,FE) ;;Front end (may get noticed) 21878 000012'01 106 105 072 000 000 21879 remark ;;Otherwise, do in numeric order 21880 000141'02 000002 000000# gendev(.dvmta,MTA) ;;Physical magnetic tape 21881 000013'01 115 124 101 072 000 21882 000142'02 000003 000000# gendev(.dvdta,DTA) ;;1031 had these as does MOUNTR 21883 000014'01 104 124 101 072 000 21884 000143'02 000004 000000# gendev(.dvptr,PTR) ;;Paper tape reader 21885 000015'01 120 124 122 072 000 21886 000144'02 000005 000000# gendev(.dvptp,PTP) ;;Paper tape punch 21887 000016'01 120 124 120 072 000 21888 000145'02 000006 000000# gendev(.dvdsp,DIS) ;;Display 21889 000017'01 104 111 123 072 000 21890 000146'02 000007 000000# gendev(.dvlpt,LPT) ;;Line printer 21891 000020'01 114 120 124 072 000 21892 000147'02 000010 000000# gendev(.dvcdr,CDR) ;;Card reader 21893 000021'01 103 104 122 072 000 21894 000150'02 000017 000000# gendev(.dvplt,PLT) ;;Plotter 21895 000022'01 120 114 124 072 000 21896 000151'02 000021 000000# gendev(.dvcdp,CDP) ;;Card punch 21897 000023'01 103 104 120 072 000 21898 remark ; N.B., .dvats usurped by .dvnft 21899 ; gendev(.dvats,ATS) ;;Applications terminal SERVICE 21900 000152'02 000025 000000# gendev(.dvads,ADS) ;;Aydin display 21901 000024'01 101 104 123 072 000 21902 000153'02 000000000000# 0 ; Mark end of table 21903 retsec 21904 21905 ; Call: t1/ Device number, as per MONSYM 21906 ; Return: t1/ Maybe a pointer if a unit based device 21907 21908 001310'03 265 16 0 00 004502' devunt: saveac ; Just in case we get careless k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 14-1 K20DSP MAC 9-Nov-23 18:22 devunt Turns a device with unit numbers into generic 21909 001311'03 200 03 0 00 000001 move t3, t1 ; Move device number to someplace safer 21910 001312'03 400 01 0 00 000000 setz t1, ; Let's assume not a unit based device 21911 001313'03 201 04 0 00 000000# movei t4, gentab ; Load address of generics table 21912 21913 001314'03 do. ; Enter loop context 21914 001314'03 554 02 0 04 000000 hlrz t2, (t4) ; Load candidate device number 21915 001315'03 322 02 0 00 001265* jumpe t2, r ; If empty, none of the above 21916 001316'03 316 02 0 00 000003 camn t2, t3 ; Hit our device, yet? 21917 001317'03 254 00 0 00 001321' exit. ; Hot zing! Have a string to return 21918 001320'03 344 04 0 00 001314' aoja t4, top. ; Otherwise, next device 21919 001321'03 enddo. ; Exit loop context 21920 21921 001321'03 560 01 0 04 000000 hrro t1, (t4) ; Pick up address of text 21922 001322'03 263 17 0 00 000000 ret ; Return as a Tops-20 pointer 21923 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 15 K20DSP MAC 9-Nov-23 18:22 Common Display Epilogue 21924 subttl Common Display Epilogue 21925 21926 ; T4/T5 Baud rate to display 21927 21928 001323'03 200 01 0 00 001146* $time1: move t1, pars2 ; Load device number 21929 001324'03 260 17 0 00 001262' call ascdev ; Turn into a reasonable string 21930 001325'03 104 00 0 00 000076 PSOUT% ; Type it 21931 001326'03 120 01 0 00 004514' dmove t1, [exp .priou, .chspc] 21932 001327'03 104 00 0 00 000051 BOUT% ; And space over 21933 21934 001330'03 254 00 0 00 004256' callret gmkbp1 ; Print the baud rate 21935 001331'03 561 01 0 00 000635* hrroi t1, crlf ; Tie off the line 21936 001332'03 104 00 0 00 000076 PSOUT% 21937 001333'03 263 17 0 00 000000 ret ; And done 21938 21939 ;[210] End code insertion 21940 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 16 K20DSP MAC 9-Nov-23 18:22 SHOW VERSION 21941 subttl SHOW VERSION 21942 21943 extern $verno ;[194] Major version 21944 extern $mnver ;[194] Minor version 21945 extern $edno ;[194] Edit number 21946 extern $who ;[194] Who last edited 21947 21948 001334'03 $shtop: entry $shtop ;[194] ;[39] Top of SHOW command. 21949 001334'03 $shver: entry $shver ;[194] 21950 001334'03 200 01 0 00 000000# txmsg 21951 001335'03 104 00 0 00 000076 21952 001336'03 320 12 0 00 001337' 21953 000154'02 000000000000# 21954 000413'04 124 117 120 123 055 21955 21956 001337'03 201 01 0 00 000101 movei t1, .priou ;[194] 21957 dmove t2, [ $verno ;[197] major version 21958 001340'03 120 02 0 00 004516' ^d10 ] ;[197] Using decimal versions 21959 001341'03 104 00 0 00 000224 NOUT% ;[194] 21960 001342'03 320 14 0 00 001343' erjmps .+1 ;[194] 21961 21962 001343'03 336 02 0 00 004520' skipn t2, [$mnver] ;[197] 21963 001344'03 254 00 0 00 001353' ifskp. ;[197] minor version 21964 001345'03 201 01 0 00 000056 movei t1, "." ;[95] Use new decimal notation 21965 001346'03 104 00 0 00 000074 PBOUT ;[95] 21966 001347'03 320 14 0 00 001350' erjmps .+1 ;[194] 21967 001350'03 201 01 0 00 000101 movei t1, .priou ;[194] 21968 001351'03 104 00 0 00 000224 NOUT% ;[194] 21969 001352'03 320 14 0 00 001353' erjmps .+1 ;[194] 21970 001353'03 endif. ;[194] 21971 21972 001353'03 336 02 0 00 004521' skipn t2, [$edno] ;[197] edit 21973 001354'03 254 00 0 00 001366' ifskp. ;[197] 21974 001355'03 201 01 0 00 000050 movei t1, "(" 21975 001356'03 104 00 0 00 000074 PBOUT 21976 001357'03 320 14 0 00 001360' erjmps .+1 ;[194] 21977 001360'03 201 01 0 00 000101 movei t1, .priou ;[194] 21978 001361'03 104 00 0 00 000224 NOUT% ;[194] 21979 001362'03 320 14 0 00 001363' erjmps .+1 ;[194] 21980 001363'03 201 01 0 00 000051 movei t1, ")" 21981 001364'03 104 00 0 00 000074 PBOUT 21982 001365'03 320 14 0 00 001366' erjmps .+1 ;[194] 21983 001366'03 endif. ;[194] 21984 21985 001366'03 336 02 0 00 004522' skipn t2, [$who] ;[197] who 21986 001367'03 254 00 0 00 001376' ifskp. ;[197] 21987 001370'03 201 01 0 00 000055 movei t1, "-" 21988 001371'03 104 00 0 00 000074 PBOUT 21989 001372'03 320 14 0 00 001373' erjmps .+1 ;[194] 21990 001373'03 201 01 0 00 000101 movei t1, .priou ;[194] 21991 001374'03 104 00 0 00 000224 NOUT% ;[194] 21992 001375'03 320 14 0 00 001376' erjmps .+1 ;[194] 21993 001376'03 endif. ;[194] 21994 21995 001376'03 561 01 0 00 000000* hrroi t1, crlflf ;[194] k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 16-1 K20DSP MAC 9-Nov-23 18:22 SHOW VERSION 21996 001377'03 104 00 0 00 000076 PSOUT% ;[194] 21997 001400'03 256 00 0 00 000005 xct q1 ;[39] return or proceed... 21998 remark ;[194] May fall through .. 21999 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 17 K20DSP MAC 9-Nov-23 18:22 SHOW DAYTIME 22000 subttl SHOW DAYTIME 22001 22002 001401'03 $shday: entry $shday ;[194] 22003 001401'03 120 01 0 00 004523' dmove t1, [ exp .priou, -1 ] ;[194] Current date and time. 22004 001402'03 205 03 0 00 336001 movx t3, ot%day!ot%fdy!ot%fmn!ot%4yr!ot%dam!ot%spa!ot%scl 22005 001403'03 104 00 0 00 000220 ODTIM% 22006 001404'03 320 12 0 00 001405' erjmpr .+1 ;[194] Catch and ignore error 22007 001405'03 260 17 0 00 003434' call moon ; Phase of the moon. 22008 22009 001406'03 561 01 0 00 001376* hrroi t1, crlflf ;[194] 22010 001407'03 104 00 0 00 000076 PSOUT% ;[194] 22011 001410'03 256 00 0 00 000005 xct q1 ;[39] return or proceed... 22012 remark ;[194] May fall through .. 22013 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 18 K20DSP MAC 9-Nov-23 18:22 SHOW LINE external variable usage (all [194]) 22014 subttl SHOW LINE external variable usage (all [194]) 22015 22016 extern rosnpt ; Remote operating system name pointer 22017 extern brk ; Number of NUL's to send to simulate a break 22018 extern carier ; On a modem line, set if have carrier 22019 extern duplex ; Line duplex setting 22020 extern escape ; Escape character 22021 extern flow ; Type of flow control, if any 22022 extern handsh ; Handshake character 22023 extern local ; Set if in local mode 22024 extern mdmlin ; Set if dial-up line 22025 extern mytty ; Current logged in line (if not detached) 22026 extern nbict ; Network BIN% count 22027 extern netjfn ; Network JFN (even if we're remote...) 22028 extern nodnam ; Remote DECnet node name 22029 extern nodnum ; Remote DECnet node number (if monitor supports this) 22030 extern nrtflg ; Set if a valid Network Remote Terminal 22031 extern ptyflg ; Set if doing pseudo-terminal I/O 22032 extern ptynam ; ASCII device name 22033 extern sesflg ; Set if session logging is active 22034 extern sesjfn ; Contains session logging jfn 22035 extern ttynum ; Number of terminal being used 22036 extern tvtchk ; Set if doing TVT discovery 22037 extern tvtflg ; Set if must negotiate binary mode on TVT 22038 extern vbict ; Virtual Terminal BIN% Count 22039 extern vchrcn ; Total characters flushed virtual terminal 22040 extern inpcbf ; INPUT network Characters Buffer Flushed 22041 extern vtermf ; Set if virtual line (I.E., PTY or NRT) 22042 22043 remark ;[223] Parity storage 22044 extern parity ; Type of parity in use 22045 extern none ;[223] No parity being enforced 22046 extern space ; Space parity routine (0, always) 22047 extern mark ; Mark parity routine (1, always) 22048 extern even ; Even parity routine 22049 extern odd ; Odd parity routine 22050 extern parpko ;[223] Non-zero if doing parity on packets, only 22051 extern parrck ;[223] Checking parity on recieve in addition to sending 22052 extern ttipar ;[223] Total parity errors for session 22053 extern genpar ;[223] Use string instructions to generate a new string 22054 extern strc ;[223] Count of characters in temporary buffer 22055 extern strptr ;[223] Appropriate pointer to same 22056 extern strbuf ;[223] Global address of string buffer 22057 remark strbf2 ;[223] Flows into this, too 22058 22059 remark ; DECnet information (is in k20net) 22060 extern mynode ; Number of local executor (us) 22061 extern myname ; Local executor name 22062 extern ndvfxp ; If monitor has extended node verify (T79) 22063 22064 remark Some support routines 22065 22066 extern chklin ; Checks a line's status, physical, network, Etc. 22067 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 19 K20DSP MAC 9-Nov-23 18:22 SHOW LINE display 22068 subttle SHOW LINE display 22069 22070 001411'03 $shlin: entry $shlin ;[194] Also used in command loop 22071 001411'03 336 00 0 00 001112* ifmn. nrtflg ;[186] DECnet NRT? 22072 001412'03 254 00 0 00 001502' 22073 001413'03 200 01 0 00 000000# txmsg ;[186] 22074 001414'03 104 00 0 00 000076 22075 001415'03 320 12 0 00 001416' 22076 000155'02 000000000000# 22077 000420'04 122 145 155 157 164 22078 001416'03 561 01 0 00 000000* hrroi t1, nodnam ;[186] Point to the node 22079 001417'03 104 00 0 00 000076 PSOUT% ;[186] Type it 22080 001420'03 200 01 0 00 000000# txmsg <::> ;[186] Trailing punctuation 22081 001421'03 104 00 0 00 000076 22082 001422'03 320 12 0 00 001423' 22083 000156'02 000000000000# 22084 000427'04 072 072 000 000 000 22085 22086 remark ;[186] If we don't have T79, see if we can fake it 22087 001423'03 332 00 0 00 000000* ifme. ndvfxp ;[186] Does the monitor NOT have extended node verify? 22088 001424'03 254 00 0 00 001441' 22089 001425'03 120 01 0 00 000000* dmove t1, myname ;[186] Load only node name we really know about 22090 001426'03 415 16 0 00 001436' block. ;[186] Enter block context for easier decisioning 22091 001427'03 261 17 0 00 000016 22092 001430'03 312 01 0 00 001416* came t1, nodnam ;[186] DECnet node name is maximum of six ASCII bytes 22093 001431'03 263 17 0 00 000000 ret ;[186] First 5 characters didn't match 22094 001432'03 312 02 0 00 000000# came t2, nodnam+1 ;[186] How about the last character? 22095 001433'03 263 17 0 00 000000 ret ;[186] Didn't match ... 22096 001434'03 254 00 0 00 001032* retskp ;[186] Connection is to local node! 22097 001435'03 263 17 0 00 000000 endbk. ;[186] Tear down block frame 22098 001436'03 254 00 0 00 001441' ifskp. ;[186] +2 means we knew the node inately 22099 001437'03 200 03 0 00 000000* move t3, mynode ;[186] Load number of local executor (that's us!) 22100 001440'03 202 03 0 00 000000* movem t3, nodnum ;[186] Stomp into connection data 22101 001441'03 endif. ;[186] End case attempted node recognition 22102 001441'03 endif. ;[186] End case monitor does not have T79 22103 22104 remark ;[186] N.B., requires monitor edit T79 22105 001441'03 337 04 0 00 001440* skipg t4, nodnum ;[186] Do we know the node number? 22106 001442'03 254 00 0 00 001464' ifskp. ;[186] We do, let's type it 22107 001443'03 200 01 0 00 000000# txmsg ( [) ;[186] Appropriately open broket it 22108 001444'03 104 00 0 00 000076 22109 001445'03 320 12 0 00 001446' 22110 000157'02 000000000000# 22111 000430'04 040 133 000 000 000 22112 001446'03 201 01 0 00 000101 movei t1, .priou ;[186] Still going to terminal 22113 001447'03 201 03 0 00 000012 movei t3, ^d10 ;[186] Node numbers are in octal 22114 001450'03 135 02 0 00 004525' ldb t2,[pointr t4,n%area] ;[186] Load DECnet Area Number 22115 001451'03 322 02 0 00 001457' ifn. t2 ;[186] If none, may be phase II ... 22116 001452'03 104 00 0 00 000224 NOUT% ;[186] Otherwise, type it 22117 001453'03 320 14 0 00 001454' erjmps .+1 ;[186] Catch and suppress error 22118 001454'03 201 02 0 00 000056 movei t2, "." ;[186] Punctuation suffix for areas 22119 001455'03 104 00 0 00 000051 BOUT% ;[186] Punctuate the node number 22120 001456'03 320 14 0 00 001457' erjmps .+1 ;[186] Catch and suppress error 22121 001457'03 endif. ;[186] End case non-zero area 22122 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 20:02 27-Nov-23 Page 19-1 K20DSP MAC 9-Nov-23 18:22 SHOW LINE display 22123 001460'03 104 00 0 00 000224 NOUT% ;[186] Type it 22124 001461'03 320 14 0 00 001462' erjmps .+1 ;[186] Catch and suppress error 22125 001462'03 201 02 0 00 000135 movei t2, "]" ;[186] Close broket 22126 001463'03 104 00 0 00 000051 BOUT% ;[186] Trailing punctuation on DECnet node number 22127 001464'03 endif. ;[186] End case known node number 22128 22129 001464'03 200 04 0 00 000000* move t4, rosnpt ;[186] Load remote operating system name pointer 22130 001465'03 316 04 0 00 004467' camn t4, [-1] ;[186] Not our special bogon talisman? 22131 001466'03 254 00 0 00 001476' ifskp. ;[186] No, it's a valid text pointer 22132 001467'03 200 01 0 00 000000# txmsg < (> ;[186] Put it in parenthesis 22133 001470'03 104 00 0 00 000076 22134 001471'03 320 12 0 00 001472' 22135 000160'02 000000000000# 22136 000431'04 040 050 000 000 000 22137 001472'03 200 01 0 00 000004 move t1, t4 ;[186] Load pointer to the remote os name 22138 001473'03 104 00 0 00 000076 PSOUT% ;[186] Type it 22139 001474'03 201 01 0 00 000051 movei t1, ")" ;[186] Closing parenthesis 22140 001475'03 104 00 0 00 000074 PBOUT% ;[186] Tie off the operating system name 22141 001476'03 endif. ;[186] End case known remote operating system 22142 22143 txmsg < 22144 001476'03 200 01 0 00 000000# (Network Remote Terminal, KERMIT-20 is LOCAL)> ;[186] Not using any local TTY 22145 001477'03 104 00 0 00 000076 22146 001500'03 320 12 0 00 001501' 22147 000161'02 000000000000# 22148 000432'04 015 012 040 050 116 22149 001501'03 254 00 0 00 001575' jrst $show3 ;[186] Skip the modem control 22150 001502'03 endif. ;[186] End case DECnet NRT 22151 22152 001502'03 200 01 0 00 000000# txmsg 22153 001503'03 104 00 0 00 000076 22154 001504'03 320 12 0 00 001505' 22155 000162'02 000000000000# 22156 000444'04 124 124 131 040 146 22157 001505'03 201 01 0 00 000101 numout ttynum, 8 22158 001506'03 200 02 0 00 000000* 22159 001507'03 201 03 0 00 000010 22160 001510'03 104 00 0 00 000224 22161 001511'03 320 14 0 00 001512' 22162 001512'03 312 02 0 00 000000# came t2, ctynum ;[223] Is this the console? 22163 001513'03 254 00 0 00 001517' ifskp. ;[223] Yes, remark about that 22164 001514'03 200 01 0 00 000000# txmsg < [Console]> ;[223] A discrete indicator 22165 001515'03 104 00 0 00 000076 22166 001516'03 320 12 0 00 001517' 22167 000163'02 000000000000# 22168 000451'04 040 133 103 157 156 22169 001517'03 endif. ;[223] 22170 22171 001517'03 332 00 0 00 001110* ifme. ptyflg ;[186] Physical line? 22172 001520'03 254 00 0 00 001534' 22173 001521'03 200 04 0 00 000000* move t4, mytty ; See whether we're local or remote... 22174 001522'03 312 04 0 00 001506* came t4, ttynum ; If it's us 22175 001523'03 254 00 0 00 001530' ifskp. ; Then we are the remote 22176 txmsg < 22177 001524'03 200 01 0 00 000000# (job's controlling terminal, KERMIT-20 is REMOTE)> k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 19-2 K20DSP MAC 9-Nov-23 18:22 SHOW LINE display 22178 001525'03 104 00 0 00 000076 22179 001526'03 320 12 0 00 001527' 22180 000164'02 000000000000# 22181 000454'04 015 012 040 050 152 22182 001527'03 254 00 0 00 001533' else. ; Anything else means we're local 22183 txmsg < 22184 001530'03 200 01 0 00 000000# (assigned TTY line, KERMIT-20 is LOCAL)> 22185 001531'03 104 00 0 00 000076 22186 001532'03 320 12 0 00 001533' 22187 000165'02 000000000000# 22188 000467'04 015 012 040 050 141 22189 001533'03 endif. 22190 001533'03 254 00 0 00 001554' else. ;[186] Otherwise, it's a pseudo terminal 22191 001534'03 200 01 0 00 000000# txmsg (< [>) ;[186] Type opening broket 22192 001535'03 104 00 0 00 000076 22193 001536'03 320 12 0 00 001537' 22194 000166'02 000000000000# 22195 000500'04 040 133 000 000 000 22196 001537'03 561 01 0 00 000000* hrroi t1, ptynam ;[186] Load the name of the pseudo-terminal 22197 001540'03 104 00 0 00 000076 PSOUT% ;[186] Type the punctuated device 22198 001541'03 201 01 0 00 000135 movei t1, "]" ;[186] Load closing broket 22199 001542'03 104 00 0 00 000074 PBOUT% ;[186] and type that 22200 txmsg < 22201 001543'03 200 01 0 00 000000# (pseudo-terminal loopback to > ;[186] 22202 001544'03 104 00 0 00 000076 22203 001545'03 320 12 0 00 001546' 22204 000167'02 000000000000# 22205 000501'04 015 012 040 050 160 22206 001546'03 561 01 0 00 001425* hrroi t1, myname ;[186] Name of local node 22207 001547'03 104 00 0 00 000076 PSOUT% ;[186] Type that 22208 001550'03 200 01 0 00 000000# txmsg <::, KERMIT-20 is LOCAL)> ;[186] 22209 001551'03 104 00 0 00 000076 22210 001552'03 320 12 0 00 001553' 22211 000170'02 000000000000# 22212 000510'04 072 072 054 040 113 22213 001553'03 254 00 0 00 001575' jrst $show3 ;[186] PTY never has modem control 22214 001554'03 endif. ;[186] End case terminal check 22215 22216 001554'03 337 01 0 00 000000* skipg t1, netjfn ;[186] Tell about modem control & carrier. 22217 001555'03 200 01 0 00 000402* move t1, ttyjfn ;[186] Unless using local terminal 22218 001556'03 260 17 0 00 000000* call chklin 22219 001557'03 336 00 0 00 000000* ifmn. mdmlin ;[194] 22220 001560'03 254 00 0 00 001575' 22221 txmsg < 22222 Line has modem control 22223 001561'03 200 01 0 00 000000# Carrier: > 22224 001562'03 104 00 0 00 000076 22225 001563'03 320 12 0 00 001564' 22226 000171'02 000000000000# 22227 000515'04 015 012 040 040 114 22228 22229 001564'03 336 00 0 00 000000* ifmn. carier ; Is it? 22230 001565'03 254 00 0 00 001572' 22231 001566'03 200 01 0 00 000000# txmsg ; Say it's on. 22232 001567'03 104 00 0 00 000076 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 19-3 K20DSP MAC 9-Nov-23 18:22 SHOW LINE display 22233 001570'03 320 12 0 00 001571' 22234 000172'02 000000000000# 22235 000526'04 117 156 000 000 000 22236 001571'03 254 00 0 00 001575' else. ; Otherwise... 22237 001572'03 200 01 0 00 000000# txmsg ; No. 22238 001573'03 104 00 0 00 000076 22239 001574'03 320 12 0 00 001575' 22240 000173'02 000000000000# 22241 000527'04 117 146 146 000 000 22242 001575'03 endif. 22243 001575'03 endif. ;[194] 22244 22245 $show3: txmsg < 22246 001575'03 200 01 0 00 000000# Handshake: > ;[76] Handshake 22247 001576'03 104 00 0 00 000076 22248 001577'03 320 12 0 00 001600' 22249 000174'02 000000000000# 22250 000530'04 015 012 040 040 110 22251 001600'03 332 01 0 00 000000* skipe t1, handsh ;[194] Any? 22252 001601'03 254 00 0 00 001606' ifskp. ;[194] Blew up the front end, anyway 22253 001602'03 200 01 0 00 000000# txmsg 22254 001603'03 104 00 0 00 000076 22255 001604'03 320 12 0 00 001605' 22256 000175'02 000000000000# 22257 000534'04 116 157 156 145 000 22258 001605'03 254 00 0 00 001607' else. ;[194] Otherwise, type it 22259 001606'03 260 17 0 00 003765' call putc 22260 001607'03 endif. ;[194] 22261 22262 txmsg < 22263 001607'03 200 01 0 00 000000# Flow-Control: > ;[143] 22264 001610'03 104 00 0 00 000076 22265 001611'03 320 12 0 00 001612' 22266 000176'02 000000000000# 22267 000535'04 015 012 040 040 106 22268 001612'03 336 00 0 00 000000* ifmn. flow 22269 001613'03 254 00 0 00 001620' 22270 001614'03 200 01 0 00 000000# txmsg 22271 001615'03 104 00 0 00 000076 22272 001616'03 320 12 0 00 001617' 22273 000177'02 000000000000# 22274 000542'04 130 117 116 055 130 22275 001617'03 254 00 0 00 001623' else. 22276 001620'03 200 01 0 00 000000# txmsg 22277 001621'03 104 00 0 00 000076 22278 001622'03 320 12 0 00 001623' 22279 000200'02 000000000000# 22280 000544'04 116 157 156 145 000 22281 001623'03 endif. 22282 22283 001623'03 336 00 0 00 000000* ifmn. local ;[194] Don't confuse them with this 22284 001624'03 254 00 0 00 001632' 22285 txmsg < 22286 001625'03 200 01 0 00 000000# Escape Character: > ;[217] Present the escape character 22287 001626'03 104 00 0 00 000076 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 19-4 K20DSP MAC 9-Nov-23 18:22 SHOW LINE display 22288 001627'03 320 12 0 00 001630' 22289 000201'02 000000000000# 22290 000545'04 015 012 040 040 105 22291 001630'03 200 01 0 00 000000* move t1, escape 22292 001631'03 260 17 0 00 003765' call putc 22293 001632'03 endif. ;[194] 22294 22295 22296 $show4: txmsg < 22297 001632'03 200 01 0 00 000000# Parity: > 22298 001633'03 104 00 0 00 000076 22299 001634'03 320 12 0 00 001635' 22300 000202'02 000000000000# 22301 000552'04 015 012 040 040 120 22302 001635'03 200 02 0 00 000262* move t2, parity 22303 001636'03 415 01 0 00 000000# xmovei t1, enone ; None 22304 001637'03 306 02 0 00 000000* cain t2, space ; Space 22305 001640'03 415 01 0 00 000000# xmovei t1, espac 22306 001641'03 306 02 0 00 000000* cain t2, mark ; Mark 22307 001642'03 415 01 0 00 000000# xmovei t1, emark 22308 001643'03 306 02 0 00 000000* cain t2, odd ; Odd 22309 001644'03 415 01 0 00 000000# xmovei t1, eodd 22310 001645'03 306 02 0 00 000000* cain t2, even ; Even 22311 001646'03 415 01 0 00 000000# xmovei t1, eeven 22312 001647'03 661 01 0 00 610001 txo t1, .px7 ; Turn into a OWGP 22313 001650'03 104 00 0 00 000076 PSOUT% ; Finally type something 22314 22315 001651'03 306 02 0 00 000263* cain t2, none ;[223] Doing any parity at all? 22316 001652'03 254 00 0 00 001714' jrst $sho4a ;[223] No, skip domains 22317 001653'03 120 02 0 00 000270* dmove t2, parpko ;[223] Load parity domains 22318 001654'03 200 04 0 00 000002 move t4, t2 ;[223] See if doing either 22319 001655'03 434 04 0 00 000003 or t4, t3 ;[223] by seeing if either were set 22320 001656'03 322 04 0 00 001714' jumpe t4, $sho4a ;[223] If zero, no domain modification 22321 22322 001657'03 200 04 0 00 000002 move t4, t2 ;[223] See if doing both 22323 001660'03 404 04 0 00 000003 and t4, t3 ;[223] by seeing if both set 22324 001661'03 201 01 0 00 000040 movei t1, .chspc ;[223] Space over 22325 001662'03 104 00 0 00 000074 PBOUT% ;[223] 22326 001663'03 201 01 0 00 000133 movei t1, "[" ;[223] Open broket 22327 001664'03 104 00 0 00 000074 PBOUT% ;[223] 22328 001665'03 322 02 0 00 001671' ifn. t2 ;[223] Packets Only? 22329 001666'03 200 01 0 00 000000# txmsg () ;[223] 22330 001667'03 104 00 0 00 000076 22331 001670'03 320 12 0 00 001671' 22332 000203'02 000000000000# 22333 000556'04 120 141 143 153 145 22334 001671'03 endif. ;[223] 22335 001671'03 322 04 0 00 001674' ifn. t4 ;[223] Plural? 22336 001672'03 201 01 0 00 000054 movei t1, "," ;[223] Yes, wants a comma, then 22337 001673'03 104 00 0 00 000074 PBOUT% ;[223] 22338 001674'03 endif. ;[223] 22339 001674'03 322 03 0 00 001700' ifn. t3 ;[223] Not just generating parity? 22340 001675'03 200 01 0 00 000000# txmsg () ;[223] 22341 001676'03 104 00 0 00 000076 22342 001677'03 320 12 0 00 001700' k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 19-5 K20DSP MAC 9-Nov-23 18:22 SHOW LINE display 22343 000204'02 000000000000# 22344 000561'04 122 145 143 145 151 22345 001700'03 endif. ;[223] 22346 001700'03 201 01 0 00 000135 movei t1, "]" ;[223] Close broket 22347 001701'03 104 00 0 00 000074 PBOUT% ;[223] 22348 001702'03 336 04 0 00 000000* skipn t4, ttipar ;[223] Any parity errors?? 22349 001703'03 254 00 0 00 001714' ifskp. ;[223] Yes, type these 22350 txmsg < 22351 001704'03 200 01 0 00 000000# Parity Errors: > ;[223] 22352 001705'03 104 00 0 00 000076 22353 001706'03 320 12 0 00 001707' 22354 000205'02 000000000000# 22355 000565'04 015 012 040 040 120 22356 001707'03 201 01 0 00 000101 numout t4 ;[223] Type how many 22357 001710'03 200 02 0 00 000004 22358 001711'03 201 03 0 00 000012 22359 001712'03 104 00 0 00 000224 22360 001713'03 320 14 0 00 001714' 22361 001714'03 endif. ;[223] Done or nothing to do 22362 22363 $sho4a: txmsg < 22364 001714'03 200 01 0 00 000000# Duplex: > ;[18] 22365 001715'03 104 00 0 00 000076 22366 001716'03 320 12 0 00 001717' 22367 000206'02 000000000000# 22368 000572'04 015 012 040 040 104 22369 001717'03 200 02 0 00 000000* move t2, duplex 22370 001720'03 302 02 0 00 000000 caie t2, dxfull 22371 001721'03 254 00 0 00 001726' ifskp. 22372 001722'03 200 01 0 00 000000# txmsg 22373 001723'03 104 00 0 00 000076 22374 001724'03 320 12 0 00 001725' 22375 000207'02 000000000000# 22376 000576'04 106 165 154 154 000 22377 001725'03 254 00 0 00 001731' else. 22378 001726'03 200 01 0 00 000000# txmsg 22379 001727'03 104 00 0 00 000076 22380 001730'03 320 12 0 00 001731' 22381 000210'02 000000000000# 22382 000577'04 110 141 154 146 000 22383 001731'03 endif. 22384 22385 001731'03 337 02 0 00 001064* skipg t2,speed ; If negative, we don't really know it. 22386 001732'03 254 00 0 00 001742' ifskp. ;[194] We know it 22387 txmsg < 22388 001733'03 200 01 0 00 000000# Speed: > ; Line speed. 22389 001734'03 104 00 0 00 000076 22390 001735'03 320 12 0 00 001736' 22391 000211'02 000000000000# 22392 000600'04 015 012 040 040 123 22393 001736'03 201 01 0 00 000101 movei t1, .priou 22394 001737'03 201 03 0 00 000012 movei t3, ^d10 22395 001740'03 104 00 0 00 000224 NOUT% 22396 001741'03 320 14 0 00 001742' erjmps .+1 22397 001742'03 endif. ;[194] k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 19-6 K20DSP MAC 9-Nov-23 18:22 SHOW LINE display 22398 22399 txmsg < 22400 001742'03 200 01 0 00 000000# Break Simulation: > 22401 001743'03 104 00 0 00 000076 22402 001744'03 320 12 0 00 001745' 22403 000212'02 000000000000# 22404 000604'04 015 012 040 040 102 22405 001745'03 337 00 0 00 001731* ifmg. speed 22406 001746'03 254 00 0 00 001763' 22407 001747'03 200 01 0 00 000000# txmsg 22408 001750'03 104 00 0 00 000076 22409 001751'03 320 12 0 00 001752' 22410 000213'02 000000000000# 22411 000611'04 105 156 141 142 154 22412 001752'03 201 01 0 00 000101 numout brk 22413 001753'03 200 02 0 00 000000* 22414 001754'03 201 03 0 00 000012 22415 001755'03 104 00 0 00 000224 22416 001756'03 320 14 0 00 001757' 22417 001757'03 200 01 0 00 000000# txmsg < NULs at 50 baud> 22418 001760'03 104 00 0 00 000076 22419 001761'03 320 12 0 00 001762' 22420 000214'02 000000000000# 22421 000613'04 040 116 125 114 163 22422 001762'03 254 00 0 00 001766' else. 22423 001763'03 200 01 0 00 000000# txmsg 22424 001764'03 104 00 0 00 000076 22425 001765'03 320 12 0 00 001766' 22426 000215'02 000000000000# 22427 000617'04 104 151 163 141 142 22428 001766'03 endif. 22429 22430 001766'03 336 00 0 00 000000* skipn vtermf ;[186] Virtual terminal? 22431 001767'03 254 00 0 00 002022' jrst $sho4e ;[186] No, then this makes no sense 22432 22433 001770'03 332 00 0 00 001517* ifme. ptyflg ;[186] Unless loopback 22434 001771'03 254 00 0 00 001776' 22435 txmsg < 22436 001772'03 200 01 0 00 000000# NRT Connection: > ;[186] Status of connection 22437 001773'03 104 00 0 00 000076 22438 001774'03 320 12 0 00 001775' 22439 000216'02 000000000000# 22440 000621'04 015 012 040 040 116 22441 001775'03 254 00 0 00 002001' else. 22442 txmsg < 22443 001776'03 200 01 0 00 000000# PTY Connection: > ;[186] Status of connection 22444 001777'03 104 00 0 00 000076 22445 002000'03 320 12 0 00 002001' 22446 000217'02 000000000000# 22447 000626'04 015 012 040 040 120 22448 002001'03 endif. ;[186] 22449 22450 002001'03 337 01 0 00 001554* skipg t1,netjfn ;[186] Load line to check 22451 002002'03 200 01 0 00 001555* move t1, ttyjfn ;[186] Unless using local terminal 22452 002003'03 260 17 0 00 001556* call chklin ;[186] Check 'line' status k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 19-7 K20DSP MAC 9-Nov-23 18:22 SHOW LINE display 22453 002004'03 336 00 0 00 001564* ifmn. carier ;[186] However, is it? 22454 002005'03 254 00 0 00 002012' 22455 002006'03 200 01 0 00 000000# txmsg ;[186] Assume good news 22456 002007'03 104 00 0 00 000076 22457 002010'03 320 12 0 00 002011' 22458 000220'02 000000000000# 22459 000633'04 117 156 154 151 156 22460 002011'03 254 00 0 00 002015' else. 22461 002012'03 200 01 0 00 000000# txmsg ;[186] It isn't, sigh... 22462 002013'03 104 00 0 00 000076 22463 002014'03 320 12 0 00 002015' 22464 000221'02 000000000000# 22465 000635'04 104 162 157 160 160 22466 002015'03 endif. ;[186] Either way, tell us 22467 22468 002015'03 260 17 0 00 001052' call prntbd ;[210] Print some kind of baud rate maybe 22469 22470 002016'03 200 01 0 00 000000* move t1, vbict ;[186] Ever connected? 22471 002017'03 270 01 0 00 000000* add t1, nbict ;[186] any network output 22472 002020'03 322 01 0 00 002022' ifn. t1 ;[186] Yes to either one means display something 22473 002021'03 260 17 0 00 003543' call disper ;[186] Display information concerning performance 22474 002022'03 endif. 22475 22476 remark $sho4e ;[186] Falls through 22477 22478 002022'03 337 04 0 00 000412* $sho4e: skipg t4, sesjfn ;[195] Are we logging? 22479 002023'03 254 00 0 00 002115' ifskp. ;[195] Well, are we? 22480 002024'03 336 00 0 00 000414* ifmn. sesflg ;[195] BUT!! Are we actively logging right now? 22481 002025'03 254 00 0 00 002032' 22482 txmsg < 22483 002026'03 200 01 0 00 000000# Log: (Enabled) > ;[220] 22484 002027'03 104 00 0 00 000076 22485 002030'03 320 12 0 00 002031' 22486 000222'02 000000000000# 22487 000637'04 015 012 040 040 114 22488 002031'03 254 00 0 00 002035' else. ;[220] Otherwise, not ACTIVELY logging 22489 txmsg < 22490 002032'03 200 01 0 00 000000# Log: (Disabled) > ;[220] 22491 002033'03 104 00 0 00 000076 22492 002034'03 320 12 0 00 002035' 22493 000223'02 000000000000# 22494 000644'04 015 012 040 040 114 22495 002035'03 endif. ;[220] 22496 002035'03 200 02 0 00 000004 move t2, t4 ;[220] Reload the logging JFN 22497 002036'03 201 01 0 00 000101 movei t1, .priou ;[220] Typing on the terminal? 22498 002037'03 302 02 0 00 377777 caie t2, .nulio ;[193] Efficiently dumping it? 22499 002040'03 254 00 0 00 002051' ifskp. ;[193] Yes, that's a constant string 22500 002041'03 120 02 0 00 000000# dmove t2, nul5 ;[193] Point to said string 22501 002042'03 104 00 0 00 000053 SOUT% ;[193] Counted SOUT% is faster 22502 002043'03 320 12 0 00 002045' %jserr (,) ;[193] ?? 22503 002044'03 254 00 0 00 002050' 22504 002045'03 265 01 0 00 000442* 22505 002046'03 000000000000# 22506 002047'03 254 00 0 00 002050' 22507 000651'04 125 156 141 142 154 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 19-8 K20DSP MAC 9-Nov-23 18:22 SHOW LINE display 22508 002050'03 254 00 0 00 002115' else. ;[193] Otherwise, a 'real' JFN 22509 002051'03 201 02 0 00 000040 movx t2, .chspc ;[193] Space over 22510 002052'03 104 00 0 00 000051 BOUT% ;[193] So columns line up 22511 002053'03 320 12 0 00 002055' %jserr (,) ;[194] ??? 22512 002054'03 254 00 0 00 002060' 22513 002055'03 265 01 0 00 002045* 22514 002056'03 000000000000# 22515 002057'03 254 00 0 00 002060' 22516 000657'04 125 156 141 142 154 22517 002060'03 200 02 0 00 000004 move t2, t4 ;[193] Restore the logging JFN 22518 002061'03 403 03 0 00 000004 setzb t3, t4 ;[193] Use default formatting, no prefix 22519 002062'03 104 00 0 00 000030 JFNS ; Say what it is. 22520 002063'03 320 12 0 00 002065' %jserr (,) ;[194] 22521 002064'03 254 00 0 00 002070' 22522 002065'03 265 01 0 00 002055* 22523 002066'03 000000000000# 22524 002067'03 254 00 0 00 002070' 22525 000666'04 125 156 141 142 154 22526 002070'03 200 01 0 00 000002 move t1, t2 ;[240] Load the file JFN 22527 002071'03 104 00 0 00 000043 RFPTR% ;[240] Get the current position in the file 22528 002072'03 320 12 0 00 002074' ifje. r ;[240] Couldn't ... 22529 002073'03 254 00 0 00 002076' 22530 002074'03 200 04 0 00 000001 move t4, t1 ;[240] Save the error for debugging heros 22531 002075'03 474 02 0 00 000000 seto t2, ;[240] Flag an error for downstream 22532 002076'03 endif. ;[240] End case JSYS error handling 22533 002076'03 323 02 0 00 002115' ifg. t2 ;[240] Only display if we've written something 22534 002077'03 200 01 0 00 000000# txmsg <, > ;[240] Punctuate and space over 22535 002100'03 104 00 0 00 000076 22536 002101'03 320 12 0 00 002102' 22537 000224'02 000000000000# 22538 000675'04 054 040 000 000 000 22539 002102'03 201 01 0 00 000101 movei t1, .priou ;[240] Still going to terminal 22540 002103'03 201 03 0 00 000012 movx t3, fld(^d10,no%rdx) ;[240] Byte count is decimal 22541 002104'03 104 00 0 00 000224 NOUT% ;[240] Type it 22542 002105'03 320 12 0 00 002107' %jserr (,) ;[240] 22543 002106'03 254 00 0 00 002112' 22544 002107'03 265 01 0 00 002065* 22545 002110'03 000000000000# 22546 002111'03 254 00 0 00 002112' 22547 000676'04 125 156 141 142 154 22548 002112'03 200 01 0 00 000000# txmsg < Bytes Written> ;[240] 22549 002113'03 104 00 0 00 000076 22550 002114'03 320 12 0 00 002115' 22551 000225'02 000000000000# 22552 000707'04 040 102 171 164 145 22553 002115'03 endif. ;[240] End case displaying file offset 22554 002115'03 endif. ;[193] End .nulio special casing 22555 002115'03 endif. ;[194] End case session logging JFN open 22556 22557 002115'03 332 00 0 00 001411* $sho4f: ifme. nrtflg ;[223] Not if NRT; line number is meaningless 22558 002116'03 254 00 0 00 002124' 22559 002117'03 200 01 0 00 001522* move t1, ttynum ;[223] Load line number (FE or TTY# of PTY, if PTY) 22560 002120'03 260 17 0 00 000000* call getnti ;[223] Get network information on this line 22561 002121'03 254 00 0 00 002124' anskp. ;[223] Failed, so better skip the line characteristics 22562 remark t1, ;[223] Network Type from NTINF% k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 19-9 K20DSP MAC 9-Nov-23 18:22 SHOW LINE display 22563 remark t2, ;[223] Line Type from NTINF% 22564 002122'03 200 03 0 00 002117* move t3, ttynum ;[223] Load line number 22565 002123'03 260 17 0 00 004012' call linchr ;[186] Show some things 22566 002124'03 endif. ;[223] 22567 22568 002124'03 $sho4h: remark ;put next one here... 22569 22570 002124'03 561 01 0 00 001406* $sho4x: hrroi t1, crlflf ;[194] Double line feed 22571 002125'03 104 00 0 00 000076 PSOUT% ;[194] Tie off the blat 22572 002126'03 256 00 0 00 000005 xct q1 ;[39] return or proceed... 22573 remark ;[194] May fall through .. 22574 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 20 K20DSP MAC 9-Nov-23 18:22 SHOW FILE-INFO external variables 22575 subttl SHOW FILE-INFO external variables 22576 22577 extern abtfil ; Set if keeping a file, zero to discard 22578 extern autbyt ; Set if doing auto-bytesize detection 22579 extern ebtflg ; Set if forcing 8-bit mode 22580 extern tbtflg ;[223] ; Set if forcing 36-bit mode 22581 extern expung ; Set if deletes are expunging 22582 extern itsflg ; Flag for handling ITS-binary format files 22583 extern tlgjfn ; Transaction log JFN 22584 extern xfnflg ; Flag for filename conversion 22585 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 21 K20DSP MAC 9-Nov-23 18:22 SHOW FILE-INFO display logic 22586 subttl SHOW FILE-INFO display logic 22587 22588 002127'03 $shfil: entry $shfil 22589 22590 002127'03 200 01 0 00 000000# txmsg 22591 002130'03 104 00 0 00 000076 22592 002131'03 320 12 0 00 002132' 22593 000226'02 000000000000# 22594 000712'04 102 171 164 145 040 22595 002132'03 332 00 0 00 000000* ifme. autbyt ;[194] Not auto-byte 22596 002133'03 254 00 0 00 002154' 22597 002134'03 332 00 0 00 000000* ifme. tbtflg ;[232] Not 36 bit 22598 002135'03 254 00 0 00 002150' 22599 002136'03 332 00 0 00 000000* ifme. ebtflg 22600 002137'03 254 00 0 00 002144' 22601 002140'03 200 01 0 00 000000# txmsg 22602 002141'03 104 00 0 00 000076 22603 002142'03 320 12 0 00 002143' 22604 000227'02 000000000000# 22605 000717'04 123 145 166 145 156 22606 002143'03 254 00 0 00 002147' else. 22607 002144'03 200 01 0 00 000000# txmsg 22608 002145'03 104 00 0 00 000076 22609 002146'03 320 12 0 00 002147' 22610 000230'02 000000000000# 22611 000721'04 105 151 147 150 164 22612 002147'03 endif. 22613 002147'03 254 00 0 00 002153' else. ;[232] Really post-processed 7 bit mode 22614 002150'03 200 01 0 00 000000# txmsg 22615 002151'03 104 00 0 00 000076 22616 002152'03 320 12 0 00 002153' 22617 000231'02 000000000000# 22618 000723'04 124 150 151 162 164 22619 002153'03 endif. ;[232] 22620 002153'03 254 00 0 00 002157' else. 22621 002154'03 200 01 0 00 000000# txmsg 22622 002155'03 104 00 0 00 000076 22623 002156'03 320 12 0 00 002157' 22624 000232'02 000000000000# 22625 000730'04 101 165 164 157 000 22626 002157'03 endif. ;[194] 22627 txmsg < 22628 002157'03 200 01 0 00 000000# File name conversion: > ;[84] 22629 002160'03 104 00 0 00 000076 22630 002161'03 320 12 0 00 002162' 22631 000233'02 000000000000# 22632 000731'04 015 012 040 040 106 22633 002162'03 332 00 0 00 000000* ifme. xfnflg ;[84] 22634 002163'03 254 00 0 00 002170' 22635 002164'03 200 01 0 00 000000# txmsg ;[84] 22636 002165'03 104 00 0 00 000076 22637 002166'03 320 12 0 00 002167' 22638 000234'02 000000000000# 22639 000737'04 117 146 146 000 000 22640 002167'03 254 00 0 00 002173' else. ;[84] k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 21-1 K20DSP MAC 9-Nov-23 18:22 SHOW FILE-INFO display logic 22641 002170'03 200 01 0 00 000000# txmsg ;[84] 22642 002171'03 104 00 0 00 000076 22643 002172'03 320 12 0 00 002173' 22644 000235'02 000000000000# 22645 000740'04 117 156 000 000 000 22646 002173'03 endif. ;[84] 22647 txmsg < 22648 002173'03 200 01 0 00 000000# ITS-binary-format file recognition: > ;[75] 22649 002174'03 104 00 0 00 000076 22650 002175'03 320 12 0 00 002176' 22651 000236'02 000000000000# 22652 000741'04 015 012 040 040 111 22653 002176'03 336 00 0 00 000000* ifmn. itsflg ;[75] 22654 002177'03 254 00 0 00 002204' 22655 002200'03 200 01 0 00 000000# txmsg ;[75] 22656 002201'03 104 00 0 00 000076 22657 002202'03 320 12 0 00 002203' 22658 000237'02 000000000000# 22659 000752'04 145 156 141 142 154 22660 002203'03 254 00 0 00 002207' else. ;[75] 22661 002204'03 200 01 0 00 000000# txmsg ;[75] 22662 002205'03 104 00 0 00 000076 22663 002206'03 320 12 0 00 002207' 22664 000240'02 000000000000# 22665 000754'04 144 151 163 141 142 22666 002207'03 endif. ;[75] 22667 txmsg < 22668 002207'03 200 01 0 00 000000# Disposition for incomplete incoming files: > ;[42] 22669 002210'03 104 00 0 00 000076 22670 002211'03 320 12 0 00 002212' 22671 000241'02 000000000000# 22672 000756'04 015 012 040 040 104 22673 002212'03 332 00 0 00 000000* ifme. abtfil ;[42] 22674 002213'03 254 00 0 00 002220' 22675 002214'03 200 01 0 00 000000# txmsg ;[42] 22676 002215'03 104 00 0 00 000076 22677 002216'03 320 12 0 00 002217' 22678 000242'02 000000000000# 22679 000770'04 104 151 163 143 141 22680 002217'03 254 00 0 00 002223' else. ;[42] 22681 002220'03 200 01 0 00 000000# txmsg ;[42] 22682 002221'03 104 00 0 00 000076 22683 002222'03 320 12 0 00 002223' 22684 000243'02 000000000000# 22685 000772'04 113 145 145 160 040 22686 002223'03 endif. ;[42] 22687 txmsg < 22688 002223'03 200 01 0 00 000000# Deleted files are > ;[143] 22689 002224'03 104 00 0 00 000076 22690 002225'03 320 12 0 00 002226' 22691 000244'02 000000000000# 22692 001000'04 015 012 040 040 104 22693 002226'03 332 00 0 00 000000* ifme. expung ;[194] 22694 002227'03 254 00 0 00 002233' 22695 002230'03 200 01 0 00 000000# txmsg ;[194] k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 21-2 K20DSP MAC 9-Nov-23 18:22 SHOW FILE-INFO display logic 22696 002231'03 104 00 0 00 000076 22697 002232'03 320 12 0 00 002233' 22698 000245'02 000000000000# 22699 001005'04 116 117 124 040 000 22700 002233'03 endif. ;[194] 22701 txmsg ;[126] 22703 002234'03 104 00 0 00 000076 22704 002235'03 320 12 0 00 002236' 22705 000246'02 000000000000# 22706 001006'04 145 170 160 165 156 22707 22708 22709 002236'03 337 02 0 00 000000* skipg t2, tlgjfn ; Any transaction log? 22710 002237'03 254 00 0 00 002311' ifskp. ;[194] Yes 22711 002240'03 201 01 0 00 000101 movei t1, .priou ; Yes, a real file, 22712 002241'03 400 04 0 00 000000 setz t4, ;[193] Let's assume no prefix or stop character 22713 002242'03 302 02 0 00 377777 caie t2, .nulio ;[193] Efficiently dumping it? 22714 002243'03 254 00 0 00 002254' ifskp. ;[193] Yes, that's a constant string 22715 002244'03 120 02 0 00 000000# dmove t2, nul5 ;[193] Point to said string 22716 002245'03 104 00 0 00 000053 SOUT% ;[193] Counted SOUT% is faster 22717 002246'03 320 12 0 00 002250' %jserr (,) ;[193] ?? 22718 002247'03 254 00 0 00 002253' 22719 002250'03 265 01 0 00 002107* 22720 002251'03 000000000000# 22721 002252'03 254 00 0 00 002253' 22722 001020'04 125 156 141 142 154 22723 002253'03 254 00 0 00 002310' else. ;[193] Otherwise, a 'real' JFN 22724 002254'03 400 03 0 00 000000 setz t3, ;[194] Use default formatting 22725 002255'03 104 00 0 00 000030 JFNS ; Say what it is. 22726 002256'03 320 12 0 00 002260' %jserr (,) ;[194] 22727 002257'03 254 00 0 00 002263' 22728 002260'03 265 01 0 00 002250* 22729 002261'03 000000000000# 22730 002262'03 254 00 0 00 002263' 22731 001026'04 125 156 141 142 154 22732 002263'03 200 01 0 00 000002 move t1, t2 ;[240] Load the file JFN 22733 002264'03 104 00 0 00 000043 RFPTR% ;[240] Get the current position in the file 22734 002265'03 320 12 0 00 002267' ifje. r ;[240] Couldn't ... 22735 002266'03 254 00 0 00 002271' 22736 002267'03 200 04 0 00 000001 move t4, t1 ;[240] Save the error for debugging heros 22737 002270'03 474 02 0 00 000000 seto t2, ;[240] Flag an error for downstream 22738 002271'03 endif. ;[240] End case JSYS error handling 22739 002271'03 323 02 0 00 002310' ifg. t2 ;[240] Only display if we've written something 22740 002272'03 200 01 0 00 000000# txmsg <, > ;[240] Punctuate and space over 22741 002273'03 104 00 0 00 000076 22742 002274'03 320 12 0 00 002275' 22743 000247'02 000000000000# 22744 001036'04 054 040 000 000 000 22745 002275'03 201 01 0 00 000101 movei t1, .priou ;[240] Still going to terminal 22746 002276'03 201 03 0 00 000012 movx t3, fld(^d10,no%rdx) ;[240] Byte count is decimal 22747 002277'03 104 00 0 00 000224 NOUT% ;[240] Type it 22748 002300'03 320 12 0 00 002302' %jserr (,) ;[240] 22749 002301'03 254 00 0 00 002305' 22750 002302'03 265 01 0 00 002260* k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 21-3 K20DSP MAC 9-Nov-23 18:22 SHOW FILE-INFO display logic 22751 002303'03 000000000000# 22752 002304'03 254 00 0 00 002305' 22753 001037'04 125 156 141 142 154 22754 002305'03 200 01 0 00 000000# txmsg < Bytes Written> ;[240] 22755 002306'03 104 00 0 00 000076 22756 002307'03 320 12 0 00 002310' 22757 000250'02 000000000000# 22758 001050'04 040 102 171 164 145 22759 002310'03 endif. ;[240] End case displaying file offset 22760 002310'03 endif. ;[193] End .nulio special casing 22761 002310'03 254 00 0 00 002314' else. ;[194] Otherwise, don't have one 22762 002311'03 200 01 0 00 000000# txmsg <(none)> 22763 002312'03 104 00 0 00 000076 22764 002313'03 320 12 0 00 002314' 22765 000251'02 000000000000# 22766 001053'04 050 156 157 156 145 22767 002314'03 endif. ;[194] 22768 22769 002314'03 561 01 0 00 002124* hrroi t1, crlflf ;[194] 22770 002315'03 104 00 0 00 000076 PSOUT% ;[194] 22771 002316'03 256 00 0 00 000005 xct q1 ;[39] return or proceed... 22772 remark ;[194] May fall through .. 22773 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 22 K20DSP MAC 9-Nov-23 18:22 SHOW DEBUG 22774 subttl SHOW DEBUG 22775 22776 extern logbsz ;[41] Log file byte size. 22777 extern logjfn ; Log file JFN 22778 extern pdcodf ;[221] If Packet Debug is also doing decoding 22779 extern mhptod ;[239] If monitor supports high precision 22780 22781 002317'03 $shdeb: entry $shdeb 22782 002317'03 200 01 0 00 000000# txmsg 22783 002320'03 104 00 0 00 000076 22784 002321'03 320 12 0 00 002322' 22785 000252'02 000000000000# 22786 001055'04 104 145 142 165 147 22787 002322'03 200 01 0 14 000000# move t1, debtab(debug) 22788 002323'03 104 00 0 00 000076 PSOUT% 22789 22790 002324'03 302 14 0 00 000002 caie debug, 2 ;[221] Are we debugging packets (I.E., dumping them?)? 22791 002325'03 254 00 0 00 002353' ifskp. ;[221] Indeed we are 22792 002326'03 336 00 0 00 000000* ifmn. pdcodf ;[239] Yes; are we decoding them? 22793 002327'03 254 00 0 00 002342' 22794 002330'03 336 00 0 00 000000* ifmn. mhptod ;[239] Some extra-soothing blat 22795 002331'03 254 00 0 00 002336' 22796 002332'03 200 01 0 00 000000# txmsg < [Decoding, 10 microsecond resolution]> ;[239] 22797 002333'03 104 00 0 00 000076 22798 002334'03 320 12 0 00 002335' 22799 000253'02 000000000000# 22800 001060'04 040 133 104 145 143 22801 002335'03 254 00 0 00 002341' else. ;[239] Otherwise, monitor doesn't have HPTIM% .HPTOD 22802 002336'03 200 01 0 00 000000# txmsg < [Decoding, 1 millisecond resolution]> ;[239] 22803 002337'03 104 00 0 00 000076 22804 002340'03 320 12 0 00 002341' 22805 000254'02 000000000000# 22806 001070'04 040 133 104 145 143 22807 002341'03 endif. ;[239] End case reporting decoding granularity 22808 002341'03 254 00 0 00 002353' else. ;[239] Not decoding, so don't remark about that 22809 002342'03 336 00 0 00 002330* ifmn. mhptod ;[239] Some extra-soothing blat 22810 002343'03 254 00 0 00 002350' 22811 002344'03 200 01 0 00 000000# txmsg < [10 microsecond resolution]> ;[239] 22812 002345'03 104 00 0 00 000076 22813 002346'03 320 12 0 00 002347' 22814 000255'02 000000000000# 22815 001100'04 040 133 061 060 040 22816 002347'03 254 00 0 00 002353' else. ;[239] Otherwise, monitor doesn't have HPTIM% .HPTOD 22817 002350'03 200 01 0 00 000000# txmsg < [1 millisecond resolution]> ;[239] 22818 002351'03 104 00 0 00 000076 22819 002352'03 320 12 0 00 002353' 22820 000256'02 000000000000# 22821 001106'04 040 133 061 040 155 22822 002353'03 endif. ;[239] End case reporting non-decoding granularity 22823 002353'03 endif. ;[239] End case granularity reporting 22824 002353'03 endif. ;[221] End special case debugging packets 22825 22826 002353'03 322 14 0 00 002445' ifn. debug ;[194] Only if actually debugging something 22827 txmsg < 22828 002354'03 200 01 0 00 000000# Debugging log file: > ;[38] k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 22-1 K20DSP MAC 9-Nov-23 18:22 SHOW DEBUG 22829 002355'03 104 00 0 00 000076 22830 002356'03 320 12 0 00 002357' 22831 000257'02 000000000000# 22832 001114'04 015 012 040 040 104 22833 002357'03 337 02 0 00 000000* skipg t2, logjfn ;[198] Load debugging log file JFN (if there is one) 22834 002360'03 254 00 0 00 002442' ifskp. ;[194] There is, let's type something 22835 002361'03 201 01 0 00 000101 movei t1, .priou ; Yes, a real file, 22836 002362'03 400 04 0 00 000000 setz t4, ;[193] Let's assume no prefix or stop character 22837 002363'03 302 02 0 00 377777 caie t2, .nulio ;[193] Efficiently dumping it? 22838 002364'03 254 00 0 00 002375' ifskp. ;[193] Yes, that's a constant string 22839 002365'03 120 02 0 00 000000# dmove t2, nul5 ;[193] Point to said string 22840 002366'03 104 00 0 00 000053 SOUT% ;[193] Counted SOUT% is faster 22841 002367'03 320 12 0 00 002371' %jserr (,) ;[193] ?? 22842 002370'03 254 00 0 00 002374' 22843 002371'03 265 01 0 00 002302* 22844 002372'03 000000000000# 22845 002373'03 254 00 0 00 002374' 22846 001121'04 125 156 141 142 154 22847 002374'03 254 00 0 00 002431' else. ;[193] Otherwise, a 'real' JFN 22848 002375'03 400 03 0 00 000000 setz t3, ;[194] Use default formatting 22849 002376'03 104 00 0 00 000030 JFNS ; Say what it is. 22850 002377'03 320 12 0 00 002401' %jserr (,) ;[194] 22851 002400'03 254 00 0 00 002404' 22852 002401'03 265 01 0 00 002371* 22853 002402'03 000000000000# 22854 002403'03 254 00 0 00 002404' 22855 001127'04 125 156 141 142 154 22856 002404'03 200 01 0 00 000002 move t1, t2 ;[240] Load the file JFN 22857 002405'03 104 00 0 00 000043 RFPTR% ;[240] Get the current position in the file 22858 002406'03 320 12 0 00 002410' ifje. r ;[240] Couldn't ... 22859 002407'03 254 00 0 00 002412' 22860 002410'03 200 04 0 00 000001 move t4, t1 ;[240] Save the error for debugging heros 22861 002411'03 474 02 0 00 000000 seto t2, ;[240] Flag an error for downstream 22862 002412'03 endif. ;[240] End case JSYS error handling 22863 002412'03 323 02 0 00 002431' ifg. t2 ;[240] Only display if we've written something 22864 002413'03 200 01 0 00 000000# txmsg <, > ;[240] 22865 002414'03 104 00 0 00 000076 22866 002415'03 320 12 0 00 002416' 22867 000260'02 000000000000# 22868 001136'04 054 040 000 000 000 22869 002416'03 201 01 0 00 000101 movei t1, .priou ;[240] Still going to terminal 22870 002417'03 201 03 0 00 000012 movx t3, fld(^d10,no%rdx) ;[240] Byte count is decimal 22871 002420'03 104 00 0 00 000224 NOUT% ;[240] Type it 22872 002421'03 320 12 0 00 002423' %jserr (,) ;[240] 22873 002422'03 254 00 0 00 002426' 22874 002423'03 265 01 0 00 002401* 22875 002424'03 000000000000# 22876 002425'03 254 00 0 00 002426' 22877 001137'04 125 156 141 142 154 22878 002426'03 200 01 0 00 000000# txmsg < Bytes Written> ;[240] 22879 002427'03 104 00 0 00 000076 22880 002430'03 320 12 0 00 002431' 22881 000261'02 000000000000# 22882 001150'04 040 102 171 164 145 22883 002431'03 endif. ;[240] End case displaying file offset k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 22-2 K20DSP MAC 9-Nov-23 18:22 SHOW DEBUG 22884 002431'03 endif. ;[198] End .nulio special casing 22885 002431'03 200 01 0 00 000000# txmsg <, Byte Size >;[240] 22886 002432'03 104 00 0 00 000076 22887 002433'03 320 12 0 00 002434' 22888 000262'02 000000000000# 22889 001153'04 054 040 102 171 164 22890 002434'03 201 01 0 00 000101 numout logbsz ;[41] 22891 002435'03 200 02 0 00 000000* 22892 002436'03 201 03 0 00 000012 22893 002437'03 104 00 0 00 000224 22894 002440'03 320 14 0 00 002441' 22895 002441'03 254 00 0 00 002445' else. ;[194] Otherwise, don't have a debugging log file 22896 002442'03 200 01 0 00 000000# txmsg < (none)> ;[38] None. 22897 002443'03 104 00 0 00 000076 22898 002444'03 320 12 0 00 002445' 22899 000263'02 000000000000# 22900 001156'04 040 050 156 157 156 22901 002445'03 endif. ;[194] End log file printing decision 22902 002445'03 endif. ;[194] End case debugging 22903 22904 002445'03 561 01 0 00 002314* hrroi t1, crlflf ;[194] 22905 002446'03 104 00 0 00 000076 PSOUT% ;[194] 22906 002447'03 256 00 0 00 000005 xct q1 ;[39] return or proceed... 22907 remark ;[194] May fall through .. 22908 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 23 K20DSP MAC 9-Nov-23 18:22 SHOW PACKET-INFO external variables (all [194]) 22909 subttl SHOW PACKET-INFO external variables (all [194]) 22910 22911 extern bctr ; Block check type requested (character). 22912 extern bctu ; Block check type in use (number). 22913 extern ebq ; 8th-bit-on prefix. 22914 extern ebqflg ; 8th-bit prefixing flag. 22915 extern ebqr ; 8th-bit prefix field for Send-Init. 22916 extern reolch ; EOL character Tops-20 needs. 22917 extern rpadch ; Padding character Tops-20 wants. 22918 extern rpadn ; Number of padding characters for Tops-20. 22919 extern rptflg ; Repeat count processing flag. 22920 extern rptq ; Repeat count prefix. 22921 extern rquote ; Quote character Tops-20 wants. 22922 extern rsthdr ; Start of header character to receive. 22923 extern seolch ; EOL character micro needs. 22924 extern spadch ; Padding character micro wants. 22925 extern spadn ; Number of padding characters for micro. 22926 extern squote ; Quote character micro wants. 22927 extern ssthdr ; Start of header character to send. 22928 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 24 K20DSP MAC 9-Nov-23 18:22 SHOW PACKET-INFO display code 22929 subttl SHOW PACKET-INFO display code 22930 22931 ;[100] New headings, less confusing. 22932 22933 002450'03 $shpkt: entry $shpkt 22934 txmsg 22938 002451'03 104 00 0 00 000076 22939 002452'03 320 12 0 00 002453' 22940 000264'02 000000000000# 22941 001160'04 120 141 143 153 145 22942 22943 22944 22945 002453'03 201 01 0 00 000101 numout rpsiz 22946 002454'03 200 02 0 00 000452* 22947 002455'03 201 03 0 00 000012 22948 002456'03 104 00 0 00 000224 22949 002457'03 320 14 0 00 002460' 22950 002460'03 200 01 0 00 000000# txmsg < > 22951 002461'03 104 00 0 00 000076 22952 002462'03 320 12 0 00 002463' 22953 000265'02 000000000000# 22954 001176'04 011 011 000 000 000 22955 002463'03 201 01 0 00 000101 numout spsiz 22956 002464'03 200 02 0 00 000460* 22957 002465'03 201 03 0 00 000012 22958 002466'03 104 00 0 00 000224 22959 002467'03 320 14 0 00 002470' 22960 22961 002470'03 200 01 0 00 000000* move t1, rpadn ;[194] Load receive padding count 22962 002471'03 270 01 0 00 000000* add t1, spadn ;[194] Add sending padding count 22963 002472'03 323 01 0 00 002525' ifg. t1 ;[194] Only print characters if actually padding 22964 txmsg < characters 22965 002473'03 200 01 0 00 000000# Padding: > 22966 002474'03 104 00 0 00 000076 22967 002475'03 320 12 0 00 002476' 22968 000266'02 000000000000# 22969 001177'04 040 143 150 141 162 22970 22971 002476'03 201 01 0 00 000101 numout rpadn 22972 002477'03 200 02 0 00 002470* 22973 002500'03 201 03 0 00 000012 22974 002501'03 104 00 0 00 000224 22975 002502'03 320 14 0 00 002503' 22976 002503'03 200 01 0 00 000000# txmsg < > 22977 002504'03 104 00 0 00 000076 22978 002505'03 320 12 0 00 002506' 22979 000267'02 000000000000# 22980 001205'04 011 011 000 000 000 22981 002506'03 201 01 0 00 000101 numout spadn 22982 002507'03 200 02 0 00 002471* 22983 002510'03 201 03 0 00 000012 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 24-1 K20DSP MAC 9-Nov-23 18:22 SHOW PACKET-INFO display code 22984 002511'03 104 00 0 00 000224 22985 002512'03 320 14 0 00 002513' 22986 txmsg < 22987 002513'03 200 01 0 00 000000# Pad Character: > 22988 002514'03 104 00 0 00 000076 22989 002515'03 320 12 0 00 002516' 22990 000270'02 000000000000# 22991 001206'04 015 012 040 040 120 22992 002516'03 200 01 0 00 000000* move t1, rpadch 22993 002517'03 260 17 0 00 003765' call putc 22994 002520'03 200 01 0 00 000000# txmsg < > 22995 002521'03 104 00 0 00 000076 22996 002522'03 320 12 0 00 002523' 22997 000271'02 000000000000# 22998 001213'04 011 011 000 000 000 22999 002523'03 200 01 0 00 000000* move t1, spadch 23000 002524'03 260 17 0 00 003765' call putc 23001 002525'03 endif. ;[194] 23002 23003 txmsg < 23004 002525'03 200 01 0 00 000000# End-Of-Line: > 23005 002526'03 104 00 0 00 000076 23006 002527'03 320 12 0 00 002530' 23007 000272'02 000000000000# 23008 001214'04 015 012 040 040 105 23009 002530'03 200 01 0 00 000000* move t1, reolch 23010 002531'03 260 17 0 00 003765' call putc 23011 002532'03 200 01 0 00 000000# txmsg < > 23012 002533'03 104 00 0 00 000076 23013 002534'03 320 12 0 00 002535' 23014 000273'02 000000000000# 23015 001221'04 011 011 000 000 000 23016 002535'03 200 01 0 00 000000* move t1, seolch 23017 002536'03 260 17 0 00 003765' call putc 23018 txmsg < 23019 002537'03 200 01 0 00 000000# Control Prefix: > 23020 002540'03 104 00 0 00 000076 23021 002541'03 320 12 0 00 002542' 23022 000274'02 000000000000# 23023 001222'04 015 012 040 040 103 23024 002542'03 200 01 0 00 000000* move t1, rquote 23025 002543'03 260 17 0 00 003765' call putc 23026 002544'03 200 01 0 00 000000# txmsg < > 23027 002545'03 104 00 0 00 000076 23028 002546'03 320 12 0 00 002547' 23029 000275'02 000000000000# 23030 001227'04 011 011 000 000 000 23031 002547'03 200 01 0 00 000000* move t1, squote 23032 002550'03 260 17 0 00 003765' call putc 23033 23034 txmsg < 23035 002551'03 200 01 0 00 000000# Start-Of-Packet: > 23036 002552'03 104 00 0 00 000076 23037 002553'03 320 12 0 00 002554' 23038 000276'02 000000000000# k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 24-2 K20DSP MAC 9-Nov-23 18:22 SHOW PACKET-INFO display code 23039 001230'04 015 012 040 040 123 23040 002554'03 200 01 0 00 000000* move t1, ssthdr ;[18] 23041 002555'03 260 17 0 00 003765' call putc 23042 002556'03 200 01 0 00 000000# txmsg < > 23043 002557'03 104 00 0 00 000076 23044 002560'03 320 12 0 00 002561' 23045 000277'02 000000000000# 23046 001235'04 011 011 000 000 000 23047 002561'03 200 01 0 00 000000* move t1, rsthdr ;[18] 23048 002562'03 260 17 0 00 003765' call putc 23049 23050 ;[100] New headings for this stuff. 23051 23052 txmsg < 23053 23054 Requested Used 23055 002563'03 200 01 0 00 000000# 8th-bit Prefix: > ;[88] Begin addition 23056 002564'03 104 00 0 00 000076 23057 002565'03 320 12 0 00 002566' 23058 000300'02 000000000000# 23059 001236'04 015 012 015 012 011 23060 23061 23062 002566'03 336 00 0 00 000000* ifmn. ebqr ;[194] Did our user request 8th bit prefix? 23063 002567'03 254 00 0 00 002576' 23064 002570'03 200 01 0 00 000000* move t1, ebq ; Yes. 23065 002571'03 260 17 0 00 003765' call putc ; Say what it is. 23066 002572'03 200 01 0 00 000000# txmsg < > 23067 002573'03 104 00 0 00 000076 23068 002574'03 320 12 0 00 002575' 23069 000301'02 000000000000# 23070 001251'04 011 011 000 000 000 23071 002575'03 254 00 0 00 002601' else. ;[194] Otherwise, don't have one 23072 002576'03 200 01 0 00 000000# txmsg <(none) > ; Just say we'll do it if asked. 23073 002577'03 104 00 0 00 000076 23074 002600'03 320 12 0 00 002601' 23075 000302'02 000000000000# 23076 001252'04 050 156 157 156 145 23077 002601'03 endif. ;[194] 23078 23079 002601'03 336 00 0 00 000000* ifmn. ebqflg ;[194] Was it used during last transfer? 23080 002602'03 254 00 0 00 002606' 23081 002603'03 200 01 0 00 002570* move t1, ebq ; Looks like it, say what prefix. 23082 002604'03 260 17 0 00 003765' call putc 23083 002605'03 254 00 0 00 002611' else. ;[194] Wasn't used 23084 002606'03 200 01 0 00 000000# txmsg <(none)> ; Just say we would have done it if asked. 23085 002607'03 104 00 0 00 000076 23086 002610'03 320 12 0 00 002611' 23087 000303'02 000000000000# 23088 001254'04 050 156 157 156 145 23089 002611'03 endif. ;[194] 23090 23091 txmsg < 23092 002611'03 200 01 0 00 000000# Repeat Prefix: > ;[92] Begin addition 23093 002612'03 104 00 0 00 000076 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 24-3 K20DSP MAC 9-Nov-23 18:22 SHOW PACKET-INFO display code 23094 002613'03 320 12 0 00 002614' 23095 000304'02 000000000000# 23096 001256'04 015 012 040 040 122 23097 002614'03 200 01 0 00 000000* move t1, rptq ; What we would use to flag repeat counts. 23098 002615'03 260 17 0 00 003765' call putc 23099 002616'03 200 01 0 00 000000# txmsg < > 23100 002617'03 104 00 0 00 000076 23101 002620'03 320 12 0 00 002621' 23102 000305'02 000000000000# 23103 001263'04 011 011 000 000 000 23104 23105 002621'03 336 00 0 00 000000* ifmn. rptflg ;[194] Was it actually used? 23106 002622'03 254 00 0 00 002626' 23107 002623'03 200 01 0 00 002614* move t1, rptq ;[194] Show it 23108 002624'03 260 17 0 00 003765' call putc 23109 002625'03 254 00 0 00 002631' else. ;[194] Otherwise didn't use it 23110 002626'03 200 01 0 00 000000# txmsg <(none)> ; Just say we would have done it if asked. 23111 002627'03 104 00 0 00 000076 23112 002630'03 320 12 0 00 002631' 23113 000306'02 000000000000# 23114 001264'04 050 156 157 156 145 23115 002631'03 endif. ;[194] 23116 23117 txmsg < 23118 002631'03 200 01 0 00 000000# Block Check: > ;[98] Block check type. 23119 002632'03 104 00 0 00 000076 23120 002633'03 320 12 0 00 002634' 23121 000307'02 000000000000# 23122 001266'04 015 012 040 040 102 23123 002634'03 200 01 0 00 000000* move t1, bctr 23124 002635'03 260 17 0 00 003765' call putc 23125 002636'03 200 01 0 00 000000# txmsg < > 23126 002637'03 104 00 0 00 000076 23127 002640'03 320 12 0 00 002641' 23128 000310'02 000000000000# 23129 001273'04 011 011 000 000 000 23130 002641'03 201 01 0 00 000101 numout bctu ;[98] 23131 002642'03 200 02 0 00 000000* 23132 002643'03 201 03 0 00 000012 23133 002644'03 104 00 0 00 000224 23134 002645'03 320 14 0 00 002646' 23135 23136 002646'03 561 01 0 00 002445* hrroi t1, crlflf ;[194] Tie off the line 23137 002647'03 104 00 0 00 000076 PSOUT% 23138 002650'03 256 00 0 00 000005 xct q1 ;[39] return or proceed... 23139 remark ;[194] May fall through .. 23140 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 25 K20DSP MAC 9-Nov-23 18:22 SHOW TIMING-INFO external variable usage 23141 subttl SHOW TIMING-INFO external variable usage 23142 23143 extern delay ; Milliseconds to wait before sending first packet 23144 extern delayf ; Same number as floating point seconds 23145 extern imxtry ; Maximum retries in send initiate. 23146 extern maxtry ; Maximum retries for an ordinary packet. 23147 extern rpause ; Pause before ACKing data packet. 23148 extern rpausf ; Same number as floating point 23149 extern rtimou ; Minimum timeout interval Tops-20 needs. 23150 extern spause ; Pause before sending data packet. 23151 extern spausf ; Same number as floating point 23152 extern srvtim ; Server command wait timeout interval. 23153 extern stimou ; Interval for current timer 23154 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 26 K20DSP MAC 9-Nov-23 18:22 SHOW TIMING-INFO numeric output flags 23155 subttl SHOW TIMING-INFO numeric output flags 23156 23157 ;[212] Begin code Insertion 23158 23159 remark Complex flag usage set up 23160 23161 ; Integer and floating output flags to line up columns. 23162 ; The hairy floating flags can be found in DOC:JSYS_REFERENCE.MEM, 23163 ; section 2.9.1.2, table xx, pages 2-87, 88. 23164 23165 ; Integer flags 23166 120006 000012 int%f== 23167 .xcref int%f ; Don't need on cross reference 23168 suppress int%f ; Don't want in symbol table listing 23169 120006 000012 show. (int%f) ; Show final word 23170 23171 ; Floating point flags 23172 000000 flt%f==0 ; Floating output flags; no output to DDT 23173 .xcref flt%f ; No need on the cross reference 23174 suppress flt%f ; No need in symbol table listing 23175 23176 define fltf (v,f) < ;;Define a macro to build floating flag word 23177 ifnb ,< ;;Non-blank field specified? 23178 flt%f==> ;; OR in the value in the field 23179 >;; ifnb 23180 ifb ,< ;;Blank field? 23181 flt%f==> ;;OR in the bit 23182 >;; ifb 23183 .xcref flt%f ;;Still don't need on cross reference 23184 >;; fltf 23185 23186 fltf(.flspc,fl%sgn) ;;First character is a space 23187 fltf(.fllsp,fl%jus) ;;Right justify, leading spaces 23188 fltf(fl%one) ;;Output at least one digit 23189 fltf(fl%pnt) ;;Output the decimal point, always 23190 fltf(.flexn,fl%exp) ;;Don't output an exponent 23191 fltf(fl%ovl) ;;Output on overflow 23192 fltf(^d6,fl%fst) ;;Properly justify integral portion 23193 fltf(^d4,fl%snd) ;;Digits in second field 23194 23195 224100 060400 show. (flt%f) ;;Finally show what we got 23196 23197 ;[212] End code insertion 23198 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 27 K20DSP MAC 9-Nov-23 18:22 SHOW TIMING-INFO code 23199 subttl SHOW TIMING-INFO code 23200 23201 remark Timeout in floating seconds and integral milliseconds 23202 23203 002651'03 $shtim: entry $shtim 23204 002651'03 474 04 0 00 000000 seto t4, ;[212] Let's suppose no time outs 23205 txmsg ;[212] 23209 002653'03 104 00 0 00 000076 23210 002654'03 320 12 0 00 002655' 23211 000311'02 000000000000# 23212 001274'04 124 151 155 151 156 23213 23214 23215 23216 002655'03 120 01 0 00 000000* dmove t1,rtimou ;[212] Load timeout int ms and floating seconds 23217 002656'03 322 01 0 00 002667' ifn. t1 ;[212] Prefer int (because of a parser fluke) 23218 002657'03 201 01 0 00 000101 movei t1, .priou ;[212] 23219 002660'03 120 03 0 00 004527' dmove t3, [exp flt%f,0] ;[212] Special columnar formatting, flag non-zero 23220 002661'03 104 00 0 00 000233 FLOUT% ;[212] 23221 002662'03 320 14 0 00 002663' erjmps .+1 ;[212] 23222 002663'03 200 01 0 00 000000# txmsg < > ;[212] Two spaces to send column 23223 002664'03 104 00 0 00 000076 23224 002665'03 320 12 0 00 002666' 23225 000312'02 000000000000# 23226 001310'04 040 040 000 000 000 23227 002666'03 254 00 0 00 002672' else. ;[186] Otherwise, special case it 23228 002667'03 200 01 0 00 000000# txmsg < (none) > ;[186] Make it STAND OUT 23229 002670'03 104 00 0 00 000076 23230 002671'03 320 12 0 00 002672' 23231 000313'02 000000000000# 23232 001311'04 040 040 040 040 040 23233 002672'03 endif. ;[186] End special casing recieved 23234 23235 23236 002672'03 120 01 0 00 000000* dmove t1,stimou ;[212] Load timeout int ms and floating seconds 23237 002673'03 322 01 0 00 002701' ifn. t1 ;[212] Prefer int (because of a parser fluke) 23238 002674'03 201 01 0 00 000101 movei t1, .priou ;[212] 23239 002675'03 120 03 0 00 004527' dmove t3, [exp flt%f,0] ;[212] special columnar formatting, flag non-zero 23240 002676'03 104 00 0 00 000233 FLOUT ;[212] 23241 002677'03 320 14 0 00 002700' erjmps .+1 ;[212] 23242 002700'03 254 00 0 00 002704' else. ;[194] Otherwise, who knows? 23243 002701'03 200 01 0 00 000000# txmsg < (none)> ;[212] Five spaces 23244 002702'03 104 00 0 00 000076 23245 002703'03 320 12 0 00 002704' 23246 000314'02 000000000000# 23247 001314'04 040 040 040 040 040 23248 002704'03 endif. ;[194] 23249 23250 remark ;[212] If never printed a time out, suppress ms's 23251 002704'03 326 04 0 00 002756' ife. t4 ;[212] Ever do anthing? 23252 002705'03 200 01 0 00 000000# txmsg < sec (> ;[212] Yes, so label the seconds field 23253 002706'03 104 00 0 00 000076 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 27-1 K20DSP MAC 9-Nov-23 18:22 SHOW TIMING-INFO code 23254 002707'03 320 12 0 00 002710' 23255 000315'02 000000000000# 23256 001317'04 040 163 145 143 040 23257 002710'03 201 01 0 00 000101 numout [maxtim/^d1000] ;[212] 23258 002711'03 200 02 0 00 004531' 23259 002712'03 201 03 0 00 000012 23260 002713'03 104 00 0 00 000224 23261 002714'03 320 14 0 00 002715' 23262 txmsg < max) 23263 002715'03 200 01 0 00 000000# > ;[212] 23264 002716'03 104 00 0 00 000076 23265 002717'03 320 12 0 00 002720' 23266 000316'02 000000000000# 23267 001321'04 040 155 141 170 051 23268 23269 002720'03 337 02 0 00 002655* skipg t2,rtimou ;[212] Non-zero receive timeout? 23270 002721'03 254 00 0 00 002732' ifskp. ;[212] Yes,display it 23271 002722'03 200 01 0 00 000000# txmsg < > ;[212] One tab, seven spaces to recieve field 23272 002723'03 104 00 0 00 000076 23273 002724'03 320 12 0 00 002725' 23274 000317'02 000000000000# 23275 001323'04 011 040 040 040 040 23276 002725'03 201 01 0 00 000101 movei t1, .priou ;[194] 23277 002726'03 200 03 0 00 004532' movx t3, int%f ;[212] Special integer formatting 23278 002727'03 104 00 0 00 000224 NOUT% ;rtimou ;[186] Not rrtimo ... 23279 002730'03 320 14 0 00 002731' erjmps .+1 ;[194] 23280 002731'03 254 00 0 00 002735' else. ;[212] Otherwise, blank the field 23281 002732'03 200 01 0 00 000000# txmsg < > ;[212] 2 tabs, 7 spaces to end of recieve 23282 002733'03 104 00 0 00 000076 23283 002734'03 320 12 0 00 002735' 23284 000320'02 000000000000# 23285 001325'04 011 011 040 040 040 23286 002735'03 endif. ;[212] Done printing 23287 23288 002735'03 337 02 0 00 002672* skipg t2,stimou ;[212] Non-zero receive timeout? 23289 002736'03 254 00 0 00 002747' ifskp. ;[212] Yes,display it 23290 002737'03 200 01 0 00 000000# txmsg < > ;[212] One tab, four spaces 23291 002740'03 104 00 0 00 000076 23292 002741'03 320 12 0 00 002742' 23293 000321'02 000000000000# 23294 001327'04 011 040 040 040 040 23295 002742'03 201 01 0 00 000101 movei t1, .priou ;[194] 23296 002743'03 200 03 0 00 004532' movx t3, int%f ;[212] Special integer formatting 23297 002744'03 104 00 0 00 000224 NOUT% ;[186] 23298 002745'03 320 14 0 00 002746' erjmps .+1 ;[194] 23299 002746'03 254 00 0 00 002752' else. ;[212] Otherwise, no send timeout 23300 002747'03 200 01 0 00 000000# txmsg < > ;[212] Two tabs, two spaces 23301 002750'03 104 00 0 00 000076 23302 002751'03 320 12 0 00 002752' 23303 000322'02 000000000000# 23304 001331'04 011 011 040 040 000 23305 002752'03 endif. ;[212] Either should be in correct column now 23306 txmsg < ms 23307 002752'03 200 01 0 00 000000# > ;[212] Must always label non-zero milliseconds 23308 002753'03 104 00 0 00 000076 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 27-2 K20DSP MAC 9-Nov-23 18:22 SHOW TIMING-INFO code 23309 002754'03 320 12 0 00 002755' 23310 000323'02 000000000000# 23311 001332'04 040 155 163 015 012 23312 002755'03 254 00 0 00 002761' else. ;[212] Otherwise, no time outs at all, ever 23313 txmsg < 23314 002756'03 200 01 0 00 000000# > ;[212] So just tie off the line 23315 002757'03 104 00 0 00 000076 23316 002760'03 320 12 0 00 002761' 23317 000324'02 000000000000# 23318 001334'04 015 012 000 000 000 23319 002761'03 endif. ;[212] End whether ever printed anything 23320 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 28 K20DSP MAC 9-Nov-23 18:22 Pause in floating seconds and integral milliseconds 23321 subttl Pause in floating seconds and integral milliseconds 23322 23323 002761'03 400 04 0 00 000000 setz t4, ;[212] Assume nothing printed 23324 txmsg < 23325 002762'03 200 01 0 00 000000# Pause: > ;[196] 23326 002763'03 104 00 0 00 000076 23327 002764'03 320 12 0 00 002765' 23328 000325'02 000000000000# 23329 001335'04 015 012 040 040 120 23330 002765'03 200 03 0 00 004527' movx t3, ;[212] Special columnar formatting, always 23331 23332 002766'03 337 02 0 00 000000* skipg t2, rpausf ;[212] Load and check floating component 23333 002767'03 254 00 0 00 002775' ifskp. ;[212] Non-zero, type it 23334 002770'03 201 01 0 00 000101 movei t1, .priou ;[212] This terminal 23335 002771'03 104 00 0 00 000233 FLOUT ;[36] 23336 002772'03 320 14 0 00 002773' erjmps .+1 ;[212] Catch and suppress errors 23337 002773'03 474 04 0 00 000000 seto t4, ;[212] Flag printed something 23338 002774'03 254 00 0 00 003000' else. ;[212] Otherwise, special case zero 23339 002775'03 200 01 0 00 000000# txmsg < (none)> ;[212] with plain text 23340 002776'03 104 00 0 00 000076 23341 002777'03 320 12 0 00 003000' 23342 000326'02 000000000000# 23343 001340'04 040 040 040 040 040 23344 003000'03 endif. 23345 23346 003000'03 337 02 0 00 000000* skipg t2, spausf ;[212] Load and check floating component 23347 003001'03 254 00 0 00 003012' ifskp. ;[212] Non-zero, type it 23348 003002'03 200 01 0 00 000000# txmsg < > ;[212] Two spaces 23349 003003'03 104 00 0 00 000076 23350 003004'03 320 12 0 00 003005' 23351 000327'02 000000000000# 23352 001343'04 040 040 000 000 000 23353 003005'03 201 01 0 00 000101 movei t1, .priou ;[36] 23354 003006'03 104 00 0 00 000233 FLOUT ;[36] 23355 003007'03 320 14 0 00 003010' erjmps .+1 ;[194] 23356 003010'03 474 04 0 00 000000 seto t4, ;[212] Flag printed something 23357 003011'03 254 00 0 00 003015' else. ;[212] Otherwise, special case zero 23358 003012'03 200 01 0 00 000000# txmsg < (none)> ;[212] with plain text 23359 003013'03 104 00 0 00 000076 23360 003014'03 320 12 0 00 003015' 23361 000330'02 000000000000# 23362 001344'04 040 040 040 040 040 23363 003015'03 endif. 23364 23365 003015'03 322 04 0 00 003052' ifn. t4 ;[212] Printed any numbers? 23366 txmsg < sec 23367 003016'03 200 01 0 00 000000# > ;[212] Yes; one tab, seven spaces to recieve field 23368 003017'03 104 00 0 00 000076 23369 003020'03 320 12 0 00 003021' 23370 000331'02 000000000000# 23371 001347'04 040 163 145 143 015 23372 23373 003021'03 200 03 0 00 004532' movx t3, ;[212] Special integer formatting 23374 23375 003022'03 337 02 0 00 000000* skipg t2, rpause ;[212] Integer millisecond recieve pause k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 28-1 K20DSP MAC 9-Nov-23 18:22 Pause in floating seconds and integral milliseconds 23376 003023'03 254 00 0 00 003033' ifskp. ;[212] A real number, print it 23377 003024'03 201 01 0 00 000101 movei t1, .priou ;[212] Going to primary output 23378 003025'03 104 00 0 00 000224 NOUT% ;[212] Output it (but nicely) 23379 003026'03 320 14 0 00 003027' erjmps .+1 ;[212] Catch and suppress error 23380 003027'03 200 01 0 00 000000# txmsg < > ;[212] One tab, four spaces 23381 003030'03 104 00 0 00 000076 23382 003031'03 320 12 0 00 003032' 23383 000332'02 000000000000# 23384 001352'04 011 040 040 040 040 23385 003032'03 254 00 0 00 003036' else. ;[212] Otherwise, suppress completely 23386 003033'03 200 01 0 00 000000# txmsg < > ;[212] Two tabs, four spaces 23387 003034'03 104 00 0 00 000076 23388 003035'03 320 12 0 00 003036' 23389 000333'02 000000000000# 23390 001354'04 011 011 040 040 040 23391 003036'03 endif. ;[212] End suppression decision 23392 23393 003036'03 337 02 0 00 000000* skipg t2, spause ;[212] Integer millisecond send pause 23394 003037'03 254 00 0 00 003044' ifskp. ;[212] A real number, print it 23395 003040'03 201 01 0 00 000101 movei t1, .priou ;[212] Going to primary output 23396 003041'03 104 00 0 00 000224 NOUT% ;[212] Output it (but nicely) 23397 003042'03 320 14 0 00 003043' erjmps .+1 ;[212] Catch and suppress error 23398 003043'03 254 00 0 00 003047' else. ;[212] Otherwise, suppress number entirely 23399 003044'03 200 01 0 00 000000# txmsg < > ;[212] One tab, four spaces 23400 003045'03 104 00 0 00 000076 23401 003046'03 320 12 0 00 003047' 23402 000334'02 000000000000# 23403 001356'04 011 040 040 000 000 23404 003047'03 endif. ;[212] End suppression decision 23405 23406 003047'03 200 01 0 00 000000# txmsg < ms> ;[196] 23407 003050'03 104 00 0 00 000076 23408 003051'03 320 12 0 00 003052' 23409 000335'02 000000000000# 23410 001357'04 040 155 163 000 000 23411 003052'03 endif. ;[212] 23412 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 29 K20DSP MAC 9-Nov-23 18:22 Delay in floating seconds and integral milliseconds 23413 subttl Delay in floating seconds and integral milliseconds 23414 23415 txmsg < 23416 23417 003052'03 200 01 0 00 000000# Delay before sending first packet: > ;[196] 23418 003053'03 104 00 0 00 000076 23419 003054'03 320 12 0 00 003055' 23420 000336'02 000000000000# 23421 001360'04 015 012 015 012 040 23422 23423 003055'03 336 00 0 00 001623* ifmn. local ;[194] Local? 23424 003056'03 254 00 0 00 003063' 23425 003057'03 200 01 0 00 000000# txmsg ;[194] Never waits for anybody 23426 003060'03 104 00 0 00 000076 23427 003061'03 320 12 0 00 003062' 23428 000337'02 000000000000# 23429 001371'04 116 157 156 145 000 23430 003062'03 254 00 0 00 003116' else. ;[194] Remote, actually 23431 003063'03 332 02 0 00 000000* skipe t2, delayf ;[194] Do we have any delay, then? 23432 003064'03 254 00 0 00 003071' ifskp. ;[194] No, so special case that 23433 003065'03 200 01 0 00 000000# txmsg ;[194] A little different from local 23434 003066'03 104 00 0 00 000076 23435 003067'03 320 12 0 00 003070' 23436 000340'02 000000000000# 23437 001372'04 132 145 162 157 040 23438 003070'03 254 00 0 00 003116' else. 23439 003071'03 201 01 0 00 000101 movei t1, .priou ;[194] 23440 003072'03 400 03 0 00 000000 setz t3, ;[194] Default flags 23441 003073'03 104 00 0 00 000233 FLOUT% ;[194] Type it 23442 003074'03 320 12 0 00 003075' erjmpr .+1 ;[194] 23443 003075'03 312 02 0 00 004533' came t2,[1.0] ;[212] Exactly one second? 23444 003076'03 254 00 0 00 003103' ifskp. ;[212] Yes, inflect for singular case 23445 003077'03 200 01 0 00 000000# txmsg < sec (> ;[212] Label and punctuate 23446 003100'03 104 00 0 00 000076 23447 003101'03 320 12 0 00 003102' 23448 000341'02 000000000000# 23449 001375'04 040 163 145 143 040 23450 003102'03 254 00 0 00 003106' else. ;[212] Otherwise, use plural inflection 23451 003103'03 200 01 0 00 000000# txmsg < secs (> ;[212] Label and punctuate 23452 003104'03 104 00 0 00 000076 23453 003105'03 320 12 0 00 003106' 23454 000342'02 000000000000# 23455 001377'04 040 163 145 143 163 23456 003106'03 endif. ;[212] End grammatical analysis 23457 003106'03 201 01 0 00 000101 movei t1, .priou ;[194] 23458 003107'03 200 02 0 00 000000* move t2, delay ;[194] Load milliseconds 23459 003110'03 201 03 0 00 000012 movei t3, ^d10 ;[194] 23460 003111'03 104 00 0 00 000224 NOUT% ;[194] 23461 003112'03 320 12 0 00 003113' erjmpr .+1 ;[194] 23462 003113'03 200 01 0 00 000000# txmsg < ms)> ;[194] 23463 003114'03 104 00 0 00 000076 23464 003115'03 320 12 0 00 003116' 23465 000343'02 000000000000# 23466 001401'04 040 155 163 051 000 23467 003116'03 endif. ;[194] k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 29-1 K20DSP MAC 9-Nov-23 18:22 Delay in floating seconds and integral milliseconds 23468 003116'03 endif. ;[194] End delay listing 23469 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 30 K20DSP MAC 9-Nov-23 18:22 Retries, Pause and other Misc 23470 subttl Retries, Pause and other Misc 23471 23472 txmsg < 23473 003116'03 200 01 0 00 000000# Packet retries before timeout: > 23474 003117'03 104 00 0 00 000076 23475 003120'03 320 12 0 00 003121' 23476 000344'02 000000000000# 23477 001402'04 015 012 040 040 120 23478 003121'03 201 01 0 00 000101 numout maxtry 23479 003122'03 200 02 0 00 000000* 23480 003123'03 201 03 0 00 000012 23481 003124'03 104 00 0 00 000224 23482 003125'03 320 14 0 00 003126' 23483 23484 txmsg < 23485 003126'03 200 01 0 00 000000# Number of retries for init packet: > 23486 003127'03 104 00 0 00 000076 23487 003130'03 320 12 0 00 003131' 23488 000345'02 000000000000# 23489 001413'04 015 012 040 040 116 23490 003131'03 201 01 0 00 000101 numout imxtry 23491 003132'03 200 02 0 00 000000* 23492 003133'03 201 03 0 00 000012 23493 003134'03 104 00 0 00 000224 23494 003135'03 320 14 0 00 003136' 23495 23496 remark in floating seconds and integral milliseconds 23497 23498 003136'03 336 00 0 00 000000* ifmn. srvtim ;[194] Any NAK'ing? 23499 003137'03 254 00 0 00 003173' 23500 txmsg < 23501 003140'03 200 01 0 00 000000# Server sends NAKs every > ;[212] Yes, begin the blat 23502 003141'03 104 00 0 00 000076 23503 003142'03 320 12 0 00 003143' 23504 000346'02 000000000000# 23505 001424'04 015 012 040 040 123 23506 003143'03 201 01 0 00 000101 movei t1, .priou ;[212] Output to terminal 23507 003144'03 200 02 0 00 000000# move t2, ;[212] Pick up floating component 23508 003145'03 200 04 0 00 000002 move t4, t2 ;[212] Save a copy 23509 003146'03 400 03 0 00 000000 setz t3, ;[212] Default (non-columnar) formatting 23510 003147'03 104 00 0 00 000233 FLOUT% ;[212] Type it 23511 003150'03 320 14 0 00 003151' erjmps .+1 ;[212] Catch and suppress error 23512 003151'03 312 04 0 00 004533' came t4,[1.0] ;[212] Exactly one second? 23513 003152'03 254 00 0 00 003157' ifskp. ;[212] Yes, inflect for singular case 23514 003153'03 200 01 0 00 000000# txmsg < sec (> ;[212] Label and punctuate 23515 003154'03 104 00 0 00 000076 23516 003155'03 320 12 0 00 003156' 23517 000347'02 000000000000# 23518 001432'04 040 163 145 143 040 23519 003156'03 254 00 0 00 003162' else. ;[212] Otherwise, use plural inflection 23520 003157'03 200 01 0 00 000000# txmsg < secs (> ;[212] Label and punctuate 23521 003160'03 104 00 0 00 000076 23522 003161'03 320 12 0 00 003162' 23523 000350'02 000000000000# 23524 001434'04 040 163 145 143 163 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 30-1 K20DSP MAC 9-Nov-23 18:22 Retries, Pause and other Misc 23525 003162'03 endif. ;[212] End grammatical analysis 23526 003162'03 201 01 0 00 000101 movei t1, .priou ;[212] NOUT% goes to terminal, too 23527 003163'03 200 02 0 00 003136* move t2, srvtim ;[212] Load milliseconds 23528 003164'03 201 03 0 00 000012 movx t3, fld(^d10,no%rdx) ;[212] Base ten, but free format 23529 003165'03 104 00 0 00 000224 NOUT% ;[212] Type equivalent milliseconds 23530 003166'03 320 14 0 00 003167' erjmps .+1 ;[212] Catch and suppress error 23531 003167'03 200 01 0 00 000000# txmsg < ms)> ;[212] Abbreviation needs no inflection 23532 003170'03 104 00 0 00 000076 23533 003171'03 320 12 0 00 003172' 23534 000351'02 000000000000# 23535 001436'04 040 155 163 051 000 23536 003172'03 254 00 0 00 003176' else. ;[212] 23537 txmsg < 23538 003173'03 200 01 0 00 000000# Server will not NAK the communications line> 23539 003174'03 104 00 0 00 000076 23540 003175'03 320 12 0 00 003176' 23541 000352'02 000000000000# 23542 001437'04 015 012 040 040 123 23543 003176'03 endif. ;[212] 23544 23545 remark Other misc 23546 23547 003176'03 332 00 0 00 000014 ifme. debug ;[194] No blips if debugging. 23548 003177'03 254 00 0 00 003215' 23549 003200'03 336 00 0 00 003055* skipn local ; Or if not local. 23550 003201'03 254 00 0 00 003215' anskp. ;[194] 23551 txmsg < 23552 23553 003202'03 200 01 0 00 000000# "." for every > ;[4] 23554 003203'03 104 00 0 00 000076 23555 003204'03 320 12 0 00 003205' 23556 000353'02 000000000000# 23557 001451'04 015 012 015 012 040 23558 003205'03 201 01 0 00 000101 numout [blip] ;[9] 23559 003206'03 200 02 0 00 004534' 23560 003207'03 201 03 0 00 000012 23561 003210'03 104 00 0 00 000224 23562 003211'03 320 14 0 00 003212' 23563 003212'03 200 01 0 00 000000# txmsg < packets, "%" for each NAK.> 23564 003213'03 104 00 0 00 000076 23565 003214'03 320 12 0 00 003215' 23566 000354'02 000000000000# 23567 001456'04 040 160 141 143 153 23568 003215'03 endif. ;[194] 23569 23570 003215'03 561 01 0 00 002646* hrroi t1, crlflf ;[194] 23571 003216'03 104 00 0 00 000076 PSOUT% ;[194] 23572 003217'03 256 00 0 00 000005 xct q1 23573 remark ;[194] May fall through .. 23574 23575 if2 < purge int%f,flt%f,fltf > ;[212] Don't need symbols or macro after pass 2 23576 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 31 K20DSP MAC 9-Nov-23 18:22 Show INPUT parameters 23577 subttl Show INPUT parameters 23578 23579 extern incase ; Case conversion flag for INPUT search. 23580 extern indeft ; Default timeout for INPUT search, floating seconds 23581 extern indeff ; Same value as milliseconds 23582 extern intima ; Timeout action for INPUT search. 23583 23584 extern indefc ;[209] Default search string length in characters 23585 extern indefw ;[209] Same thing in words (for xblt) 23586 extern indefs ;[209] Expanded search string 23587 23588 ;[160] 23589 23590 003220'03 $shinp: entry $shinp 23591 txmsg 23594 003221'03 104 00 0 00 000076 23595 003222'03 320 12 0 00 003223' 23596 000355'02 000000000000# 23597 001464'04 120 141 162 141 155 23598 23599 003223'03 332 00 0 00 000000* ifme. incase 23600 003224'03 254 00 0 00 003231' 23601 003225'03 200 01 0 00 000000# txmsg 23602 003226'03 104 00 0 00 000076 23603 003227'03 320 12 0 00 003230' 23604 000356'02 000000000000# 23605 001477'04 111 147 156 157 162 23606 003230'03 254 00 0 00 003234' else. ;[209] In case set means case sensitive 23607 003231'03 200 01 0 00 000000# txmsg 23608 003232'03 104 00 0 00 000076 23609 003233'03 320 12 0 00 003234' 23610 000357'02 000000000000# 23611 001503'04 117 142 163 145 162 23612 003234'03 endif. 23613 23614 txmsg < 23615 003234'03 200 01 0 00 000000# Default Timeout: > 23616 003235'03 104 00 0 00 000076 23617 003236'03 320 12 0 00 003237' 23618 000360'02 000000000000# 23619 001510'04 015 012 040 040 104 23620 003237'03 337 02 0 00 000000* skipg t2, indeff ;[194] Load default value, if exists 23621 003240'03 254 00 0 00 003261' ifskp. ;[194] Doing time outs 23622 003241'03 201 01 0 00 000101 movei t1, .priou ;[194] 23623 003242'03 400 03 0 00 000000 setz t3, ;[194] Default flags 23624 003243'03 104 00 0 00 000233 FLOUT% ;[194] Type it 23625 003244'03 320 12 0 00 003245' erjmpr .+1 ;[194] 23626 003245'03 200 01 0 00 000000# txmsg < sec, > ;[194] 23627 003246'03 104 00 0 00 000076 23628 003247'03 320 12 0 00 003250' 23629 000361'02 000000000000# 23630 001515'04 040 163 145 143 054 23631 003250'03 201 01 0 00 000101 movei t1, .priou ;[194] k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 31-1 K20DSP MAC 9-Nov-23 18:22 Show INPUT parameters 23632 003251'03 200 02 0 00 000000* move t2, indeft ;[194] Load milliseconds 23633 003252'03 201 03 0 00 000012 movei t3, ^d10 ;[194] 23634 003253'03 104 00 0 00 000224 NOUT% ;[194] 23635 003254'03 320 12 0 00 003255' erjmpr .+1 ;[194] 23636 003255'03 200 01 0 00 000000# txmsg < ms> ;[194] 23637 003256'03 104 00 0 00 000076 23638 003257'03 320 12 0 00 003260' 23639 000362'02 000000000000# 23640 001517'04 040 155 163 000 000 23641 003260'03 254 00 0 00 003264' else. ;[194] Otherwise, not timing out 23642 003261'03 200 01 0 00 000000# txmsg ;[194] 23643 003262'03 104 00 0 00 000076 23644 003263'03 320 12 0 00 003264' 23645 000363'02 000000000000# 23646 001520'04 111 156 146 151 156 23647 003264'03 endif. ;[194] 23648 23649 txmsg < 23650 003264'03 200 01 0 00 000000# Timeout Action: > ;[209] 23651 003265'03 104 00 0 00 000076 23652 003266'03 320 12 0 00 003267' 23653 000364'02 000000000000# 23654 001522'04 015 012 040 040 124 23655 003267'03 332 00 0 00 000000* ifme. intima ;[209] 23656 003270'03 254 00 0 00 003275' 23657 003271'03 200 01 0 00 000000# txmsg ;[209] 23658 003272'03 104 00 0 00 000076 23659 003273'03 320 12 0 00 003274' 23660 000365'02 000000000000# 23661 001527'04 120 162 157 143 145 23662 003274'03 254 00 0 00 003300' else. ;[209] 23663 003275'03 200 01 0 00 000000# txmsg ;[209] 23664 003276'03 104 00 0 00 000076 23665 003277'03 320 12 0 00 003300' 23666 000366'02 000000000000# 23667 001535'04 121 165 151 164 040 23668 003300'03 endif. ;[209] 23669 23670 txmsg < 23671 003300'03 200 01 0 00 000000# Default Search: > ;[209] 23672 003301'03 104 00 0 00 000076 23673 003302'03 320 12 0 00 003303' 23674 000367'02 000000000000# 23675 001542'04 015 012 040 040 104 23676 23677 003303'03 332 00 0 00 000000* ifme. indefw ;[209] Anything set? 23678 003304'03 254 00 0 00 003311' 23679 003305'03 200 01 0 00 000000# txmsg <*Carriage Return Line Feed*> ;[209] Nope, so point that out 23680 003306'03 104 00 0 00 000076 23681 003307'03 320 12 0 00 003310' 23682 000370'02 000000000000# 23683 001547'04 052 103 141 162 162 23684 003310'03 254 00 0 00 003333' else. ;[209] Otherwise, something there 23685 003311'03 201 01 0 00 000040 movei t1, .chspc ;[209] Load a space 23686 003312'03 104 00 0 00 000074 PBOUT% ;[209] Line up the text k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 31-2 K20DSP MAC 9-Nov-23 18:22 Show INPUT parameters 23687 003313'03 201 01 0 00 000042 movei t1, .chdbq ;[209] Load Double quote 23688 003314'03 104 00 0 00 000074 PBOUT% ;[209] Type it 23689 003315'03 201 01 0 00 000101 movei t1, .priou ;[209] Output to terminal 23690 003316'03 561 02 0 00 000000* hrroi t2, indefs ;[209] Point to default string 23691 003317'03 210 03 0 00 000000* movn t3, indefc ;[209] Load negative count of characters 23692 003320'03 400 04 0 00 000000 setz t4, ;[209] Stop on NUL, just in case 23693 003321'03 104 00 0 00 000053 SOUT% ;[209] Type it (counted SOUT% faster) 23694 003322'03 320 12 0 00 003324' ifje. r ;[209] Catch any JSYS error 23695 003323'03 254 00 0 00 003331' 23696 003324'03 200 04 0 00 000001 move t4, t1 ;[209] Save error for debuggers 23697 003325'03 200 01 0 00 000000# txmsg <*** ERROR ***> ;[209] Something obvious, I guess 23698 003326'03 104 00 0 00 000076 23699 003327'03 320 12 0 00 003330' 23700 000371'02 000000000000# 23701 001555'04 052 052 052 040 105 23702 003330'03 201 01 0 00 000101 movei t1, .priou ;[209] Reload primary output 23703 003331'03 endif. ;[209] 23704 003331'03 201 01 0 00 000042 movei t1, .chdbq ;[209] Load Double quote 23705 003332'03 104 00 0 00 000074 PBOUT% ;[209] Type it 23706 003333'03 endif. ;[209] End case displaying search string 23707 23708 003333'03 561 01 0 00 003215* hrroi t1, crlflf ;[209] Tie off the line 23709 003334'03 104 00 0 00 000076 PSOUT% ;[209] 23710 23711 003335'03 256 00 0 00 000005 xct q1 23712 remark ;[194] May fall through .. 23713 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 32 K20DSP MAC 9-Nov-23 18:22 SHOW MACRO DEFINITIONS 23714 subttl SHOW MACRO DEFINITIONS 23715 23716 ;[77] SHOW MACRO DEFINITIONS 23717 23718 extern mactab ;[194] Macro table 23719 23720 003336'03 $shmac: entry $shmac 23721 003336'03 554 04 0 00 000000* hlrz t4, mactab ; Anything in macro table? 23722 003337'03 327 04 0 00 003344' ifle. t4 ;[194] If don't have any 23723 txmsg <%No macros defined 23724 003340'03 200 01 0 00 000000# > ;[203] Then say that 23725 003341'03 104 00 0 00 000076 23726 003342'03 320 12 0 00 003343' 23727 000372'02 000000000000# 23728 001560'04 045 116 157 040 155 23729 23730 003343'03 254 00 0 00 003433' jrst $shmax ;[194] And we're all done 23731 003344'03 endif. ;[203] Otherwise, have some blat 23732 ;[203] So dump the macros 23733 003344'03 201 01 0 00 000101 movei t1,.priou ;[203] Still going to terminal 23734 003345'03 200 02 0 00 000004 move t2,t4 ;[203] Load how many used 23735 003346'03 201 03 0 00 000012 movei t3,^d10 ;[203] Humans grok base 10 23736 003347'03 104 00 0 00 000224 NOUT% ;[203] Convert to external and display 23737 003350'03 320 12 0 00 003351' erjmpr .+1 ;[203] Catch and ignore error 23738 003351'03 200 01 0 00 000000# txmsg < macro> ;[203] Begin description 23739 003352'03 104 00 0 00 000076 23740 003353'03 320 12 0 00 003354' 23741 000373'02 000000000000# 23742 001565'04 040 155 141 143 162 23743 003354'03 201 01 0 00 000163 movei t1,"s" ;[203] Load inflection 23744 003355'03 302 04 0 00 000001 caie t4,^d1 ;[203] Singular case? 23745 003356'03 104 00 0 00 000074 PBOUT% ;[203] No, must inflect it 23746 003357'03 200 01 0 00 000000# txmsg < used, > ;[203] Continue description 23747 003360'03 104 00 0 00 000076 23748 003361'03 320 12 0 00 003362' 23749 000374'02 000000000000# 23750 001567'04 040 165 163 145 144 23751 23752 003362'03 201 01 0 00 000101 movei t1,.priou ;[203] Still going to terminal 23753 003363'03 550 02 0 00 003336* hrrz t2, mactab ;[203] Load maximum number of macros 23754 003364'03 274 02 0 00 000004 sub t2,t4 ;[203] Subtract off used 23755 003365'03 104 00 0 00 000224 NOUT% ;[203] Convert to external and display 23756 003366'03 320 12 0 00 003367' erjmpr .+1 ;[203] Catch and ignore error 23757 003367'03 200 01 0 00 000000# txmsg < available. Remaining storage: > 23758 003370'03 104 00 0 00 000076 23759 003371'03 320 12 0 00 003372' 23760 000375'02 000000000000# 23761 001571'04 040 141 166 141 151 23762 003372'03 260 17 0 00 000000* call $mchrs## ;[203] Get remaining space 23763 003373'03 200 02 0 00 000001 move t2, t1 ;[203] Load remaining characters 23764 003374'03 200 04 0 00 000001 move t4, t1 ;[203] Save a copy 23765 003375'03 201 01 0 00 000101 movei t1, .priou ;[203] This terminal 23766 003376'03 201 03 0 00 000012 movei t3, ^d10 ;[203] Base ten 23767 003377'03 104 00 0 00 000224 NOUT% ;[203] Convert to external and display 23768 003400'03 320 12 0 00 003401' erjmpr .+1 ;[203] Catch and ignore error k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 32-1 K20DSP MAC 9-Nov-23 18:22 SHOW MACRO DEFINITIONS 23769 003401'03 200 01 0 00 000000# txmsg < character> ;[203] 23770 003402'03 104 00 0 00 000076 23771 003403'03 320 12 0 00 003404' 23772 000376'02 000000000000# 23773 001600'04 040 143 150 141 162 23774 003404'03 201 01 0 00 000163 movei t1,"s" ;[203] Load inflection 23775 003405'03 302 04 0 00 000001 caie t4,^d1 ;[203] Singular case? 23776 003406'03 104 00 0 00 000074 PBOUT% ;[203] No, must inflect it 23777 txmsg < 23778 23779 Definitions: 23780 23781 003407'03 200 01 0 00 000000# > ;[203] 23782 003410'03 104 00 0 00 000076 23783 003411'03 320 12 0 00 003412' 23784 000377'02 000000000000# 23785 001603'04 015 012 015 012 104 23786 23787 003412'03 554 04 0 00 003363* hlrz t4, mactab ;[203] Reload macro table length 23788 003413'03 201 03 0 00 000001 movei t3, 1 ;[194] Point at first entry of TBLUK% tabke 23789 ;[194] Fall through to loop context 23790 003414'03 do. ;[194] Enter loop lexical context 23791 003414'03 200 01 0 00 000000# txmsg < > ;[194] Space over twice 23792 003415'03 104 00 0 00 000076 23793 003416'03 320 12 0 00 003417' 23794 000400'02 000000000000# 23795 001610'04 040 040 000 000 000 23796 003417'03 564 01 0 03 003412* hlro t1, mactab(t3) ; Point to macro name. 23797 003420'03 104 00 0 00 000076 PSOUT ; Print it. 23798 003421'03 200 01 0 00 000000# txmsg < = > 23799 003422'03 104 00 0 00 000076 23800 003423'03 320 12 0 00 003424' 23801 000401'02 000000000000# 23802 001611'04 040 075 040 000 000 23803 003424'03 560 01 0 03 003417* hrro t1, mactab(t3) ; Same deal for macro body. 23804 003425'03 104 00 0 00 000076 PSOUT 23805 003426'03 260 17 0 00 003743' call ifcrlf ;[194] See if it wants a CRLF 23806 003427'03 350 00 0 00 000003 aos t3 ; Bump TBLUK% index. 23807 003430'03 367 04 0 00 003414' sojg t4, top. ; Do for all macros in table. 23808 003431'03 enddo. ;[194] 23809 23810 003431'03 561 01 0 00 001331* hrroi t1, crlf ;[194] 23811 003432'03 104 00 0 00 000076 PSOUT% 23812 23813 003433'03 263 17 0 00 000000 $shmax: ret ;[83] Last one, always want to return. 23814 remark q1 ; Last show command always returns 23815 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 33 K20DSP MAC 9-Nov-23 18:22 ITS Phase of Moon 23816 subttl ITS Phase of Moon 23817 23818 ;[6] (this whole routine, just for fun...) 23819 ; 23820 ; This code stolen from MOON.MAC (anybody know who wrote it?). 23821 ; Just changed OUTCHR's to PBOUT%'s via a macro. - Frank. 23822 ; 23823 ; The code is from MIT and may have been named in jest after famed MIT 23824 ; hacker David A. Moon. Also, see below. - Tom. 23825 ; 23826 ;[190] Change OUTCHR macro to not store in write-protected area 23827 ;[194] Slight rework to reduce symbol table 23828 23829 003434'03 265 16 0 00 004535' moon: saveac <5,6> 23830 003435'03 403 03 0 00 000004 setzb 3,4 23831 003436'03 474 02 0 00 000000 seto 2, 23832 003437'03 104 00 0 00 000222 ODCNV% 23833 003440'03 320 16 0 00 001315* erjmp r 23834 003441'03 621 04 0 00 000077 tlz 4,77 23835 003442'03 104 00 0 00 000223 IDCNV% 23836 003443'03 320 16 0 00 003440* erjmp r ; Return upon any error. 23837 003444'03 200 01 0 00 000000# txmsg <, Moon: > ; OK so far, say what we're doing. 23838 003445'03 104 00 0 00 000076 23839 003446'03 320 12 0 00 003447' 23840 000402'02 000000000000# 23841 001612'04 054 040 115 157 157 23842 23843 ; AC2= Universal time adjusted for time zone. 23844 23845 003447'03 200 01 0 00 000002 move 1,2 ; Right place. 23846 003450'03 274 01 0 00 000000# sub 1,newmn ; Sub off base new moon 23847 003451'03 230 01 0 00 000000# idiv 1,period ; Divide by the period 23848 003452'03 230 02 0 00 000000# idiv 2,perio4 ; Get fractions of a period 23849 003453'03 317 03 0 00 000000# camg 3,perio8 ; Check for phase + or - 23850 003454'03 254 00 0 00 003461' ifskp. ;[194] ; Not more than 3+ days 23851 003455'03 274 03 0 00 000000# sub 3,perio4 ; Make it next phase -n days 23852 003456'03 306 02 0 00 000003 cain 2,3 ; Is it LQ+3D+? 23853 003457'03 634 02 0 00 000002 tdza 2,2 ; It is 23854 003460'03 340 02 0 00 000000 aoj 2, ; Increment phase 23855 003461'03 endif. 23856 23857 003461'03 510 01 0 02 000000# hllz 1,table(2) ; Get SIXBIT phase 23858 003462'03 335 00 0 00 000003 skipge 3 ; 3 < 0 then minus phase output 23859 003463'03 665 01 0 00 000015 tloa 1,'-' ; - 23860 003464'03 665 01 0 00 000013 tloa 1,'+' ; + 23861 003465'03 217 00 0 00 000003 movms 3 ; Fix mag of 3 23862 003466'03 200 02 0 00 004545' move 2,[point 6,1] ; Byte pointer 23863 003467'03 201 05 0 00 000002 movei 5,2 ; Loop 3 times 23864 23865 003470'03 do. ;[194] Enter loop context 23866 003470'03 134 04 0 00 000002 ildb 4,2 ; Get a character 23867 003471'03 271 04 0 00 000040 addi 4," " ; Make ASCII 23868 003472'03 261 17 0 00 000001 OUTCHR 4 ; Type it 23869 003473'03 200 01 0 00 000004 23870 003474'03 104 00 0 00 000074 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 33-1 K20DSP MAC 9-Nov-23 18:22 ITS Phase of Moon 23871 003475'03 320 12 0 00 003476' 23872 003476'03 262 17 0 00 000001 23873 003477'03 365 05 0 00 003470' sojge 5,top. ;[194] ; Loop 23874 003500'03 enddo. 23875 23876 003500'03 205 04 0 00 777774 movsi 4,-4 ; Make aobjn pointer 23877 23878 003501'03 do. ;[194] Enter loop context 23879 003501'03 550 02 0 04 000000# hrrz 2,table(4) ; Get a multiplier 23880 003502'03 620 02 0 00 774000 trz 2,774000 ; Strip off ascii character 23881 003503'03 221 03 0 02 000000 imuli 3,(2) ; Get the value decoded 23882 003504'03 554 01 0 00 000003 hlrz 1,3 ; Get value 23883 003505'03 621 03 0 00 777777 tlz 3,-1 ; Zap old LH 23884 003506'03 200 05 0 00 000001 move 5,1 ; Use 5 & 6 here 23885 003507'03 231 05 0 00 000012 idivi 5,12 ; Radix 10 23886 003510'03 271 05 0 00 000060 addi 5,60 ; Make ASCII 23887 003511'03 307 05 0 00 000060 caig 5,60 ;[194] Check for leading zero 23888 003512'03 254 00 0 00 003520' ifskp. ;[194] Not a leading zero 23889 003513'03 261 17 0 00 000001 OUTCHR 5 ; Type it. 23890 003514'03 200 01 0 00 000005 23891 003515'03 104 00 0 00 000074 23892 003516'03 320 12 0 00 003517' 23893 003517'03 262 17 0 00 000001 23894 003520'03 endif. ;[194] 23895 003520'03 271 06 0 00 000060 addi 6,60 ; Make ASCII 23896 003521'03 261 17 0 00 000001 OUTCHR 6 23897 003522'03 200 01 0 00 000006 23898 003523'03 104 00 0 00 000074 23899 003524'03 320 12 0 00 003525' 23900 003525'03 262 17 0 00 000001 23901 003526'03 135 05 0 00 004546' ldb 5,[point 7,table(4),24] ; Get d/h/m/s 23902 003527'03 261 17 0 00 000001 OUTCHR 5 ; Type it. 23903 003530'03 200 01 0 00 000005 23904 003531'03 104 00 0 00 000074 23905 003532'03 320 12 0 00 003533' 23906 003533'03 262 17 0 00 000001 23907 003534'03 261 17 0 00 000001 OUTCHR ["."] ; Follow with a dot. 23908 003535'03 200 01 0 00 004547' 23909 003536'03 104 00 0 00 000074 23910 003537'03 320 12 0 00 003540' 23911 003540'03 262 17 0 00 000001 23912 003541'03 253 04 0 00 003501' aobjn 4, top. ;[194] ; Loop. 23913 003542'03 enddo. ;[194] 23914 23915 003542'03 263 17 0 00 000000 ret ; Done, return. 23916 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 34 K20DSP MAC 9-Nov-23 18:22 Pure data for MOON 23917 subttl Pure data for MOON 23918 23919 ; 12:47am Monday, 1 August 2022 23920 ; 23921 ; This routine uses a lunar period of 29 days, 12 hours, 53 minutes 23922 ; and 19 seconds. 23923 ; 23924 ; After 43 years, 6 months, 3 days, 23 hours, 29 minutes and 12 23925 ; seconds, it might be of interest to see how accurate this still is; 23926 ; meaning, has the period changed (I.E., increased) to the extent 23927 ; that we are accumulating a detectable difference. 23928 ; 23929 ; Wikipedia reports that a lunation, or synodic month, is the time 23930 ; period from one new moon to the next. In the J2000. 0 epoch, the 23931 ; average length of a lunation is 29.53059 days (or 29 days, 12 hours, 23932 ; 44 minutes, and 3 seconds). That is quite a difference. 23933 ; 23934 ; And it might be irrelevant. 23935 ; 23936 ; Since Earth's orbit around the Sun is elliptical and not circular, 23937 ; the speed of Earth's progression around the Sun varies during the 23938 ; year. Thus, the angular rate is faster nearer periapsis and slower 23939 ; near apoapsis. 23940 ; 23941 ; The same is also true for the Moon's orbit around the Earth. 23942 ; Because of these variations in angular rate, the actual time between 23943 ; lunations may vary from about 29.18 to about 29.93 days. The 23944 ; average duration in modern times is 29.53059 days with up to seven 23945 ; hours variation about the mean in any given year. 23946 23947 chgsec(code,const) ;;Constants go in CONST .PSECT 23948 23949 000403'02 125575 034343 newmn: 125575,,34343 ; 28-jan-79 0120 est 23950 000035 422752 per==35,,422752 ; 29d.12h.53m.19s 23951 000404'02 000035 422752 period: per 23952 000405'02 000007 304572 perio4: per/4 23953 000406'02 000003 542275 perio8: per/10 23954 23955 000407'02 565500 144 0001 table: byte(18)'NM '(7)"d"(11)^D1 ; New moon - days - 1 23956 000410'02 466100 150 0030 byte(18)'FQ '(7)"h"(11)^D24 ; First quarter - hours - 24 23957 000411'02 465500 155 0074 byte(18)'FM '(7)"m"(11)^D60 ; Full moon - minutes - 60 23958 000412'02 546100 163 0074 byte(18)'LQ '(7)"s"(11)^D60 ; Last quarter - seconds - 60 23959 23960 retsec ;;Return to previous .PSECT 23961 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 35 K20DSP MAC 9-Nov-23 18:22 Display line performance external variables 23962 subttl Display line performance external variables 23963 23964 extern nsici ; Network SIN%'s Issued 23965 extern nsimx ; Network SIN% maximum length 23966 extern nsitc ; Network SIN% total characters 23967 extern vboct ; Virtual Terminal BOUT% Count (simulated) 23968 extern vsict ; Virtual Terminal SIN% Count (number done) 23969 extern vsimx ; Virtual Terminal SIN% Maximum length 23970 extern vsitc ; Virtual Terminal total characters SIN%'ed 23971 extern vsoct ; Virtual Terminal SOUTR%'s Issued 23972 extern vsotc ; Virtual Terminal SOUTR% Total Characters 23973 extern vsomx ; Virtual Terminal SOUTR% Maximum length 23974 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 36 K20DSP MAC 9-Nov-23 18:22 Display information concerning line performance 23975 subttl Display information concerning line performance 23976 23977 ; Previous code from TELNET used BIN%/BOUT% loops in two forks to 23978 ; input data from the terminal and display results asynchronously. In 23979 ; terms of computational overhead, using a BIN% and a BOUT% for each 23980 ; character is the most expensive way to do it. 23981 ; 23982 ; It's also a certain way to become unpopular on a heavily loaded 23983 ; system or otherwise adversely impact other activities. On the other 23984 ; hand, data can not be left in the buffer in the case of a real front 23985 ; end, as this will crash RSX20F. 23986 ; 23987 ; The code was rewritten to wait for a character and then determine 23988 ; after the read whether more data existed in the buffer. If this was 23989 ; the case, then the remaining data was read. This also occurs on 23990 ; output. A Virtual BOUT% in this case is a SOUTR% of one character 23991 ; to get it pushed over the network. 23992 23993 003543'03 265 16 0 00 004357' disper: saveac ; Not called with anything, doesn't touch AC's 23994 23995 remark ; transmission fork keep these 23996 003544'03 336 00 0 00 002016* ifmn. vbict 23997 003545'03 254 00 0 00 003556' 23998 txmsg < 23999 003546'03 200 01 0 00 000000# Terminal BIN%'s: > 24000 003547'03 104 00 0 00 000076 24001 003550'03 320 12 0 00 003551' 24002 000413'02 000000000000# 24003 001614'04 015 012 040 040 124 24004 003551'03 201 01 0 00 000101 numout vbict ; Virtual Terminal BIN% Count 24005 003552'03 200 02 0 00 003544* 24006 003553'03 201 03 0 00 000012 24007 003554'03 104 00 0 00 000224 24008 003555'03 320 14 0 00 003556' 24009 003556'03 endif. 24010 003556'03 336 00 0 00 000000* ifmn. vchrcn 24011 003557'03 254 00 0 00 003570' 24012 txmsg < 24013 003560'03 200 01 0 00 000000# Virtual CFIBF%'s: > 24014 003561'03 104 00 0 00 000076 24015 003562'03 320 12 0 00 003563' 24016 000414'02 000000000000# 24017 001621'04 015 012 040 040 126 24018 003563'03 201 01 0 00 000101 numout vchrcn ; Virtual CHaRcters flushed CouNt 24019 003564'03 200 02 0 00 003556* 24020 003565'03 201 03 0 00 000012 24021 003566'03 104 00 0 00 000224 24022 003567'03 320 14 0 00 003570' 24023 003570'03 endif. 24024 003570'03 336 00 0 00 000000* ifmn. inpcbf 24025 003571'03 254 00 0 00 003602' 24026 txmsg < 24027 003572'03 200 01 0 00 000000# Buffer CFIBF%'s: > 24028 003573'03 104 00 0 00 000076 24029 003574'03 320 12 0 00 003575' k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 36-1 K20DSP MAC 9-Nov-23 18:22 Display information concerning line performance 24030 000415'02 000000000000# 24031 001626'04 015 012 040 040 040 24032 003575'03 201 01 0 00 000101 numout inpcbf ; INPUT network Buffer characters flushed 24033 003576'03 200 02 0 00 003570* 24034 003577'03 201 03 0 00 000012 24035 003600'03 104 00 0 00 000224 24036 003601'03 320 14 0 00 003602' 24037 003602'03 endif. 24038 003602'03 336 00 0 00 000000* ifmn. vboct 24039 003603'03 254 00 0 00 003614' 24040 txmsg < 24041 003604'03 200 01 0 00 000000# Virtual BOUT%'s: > 24042 003605'03 104 00 0 00 000076 24043 003606'03 320 12 0 00 003607' 24044 000416'02 000000000000# 24045 001633'04 015 012 040 040 126 24046 003607'03 201 01 0 00 000101 numout vboct ; Virtual Terminal BOUT% Count (simulated) 24047 003610'03 200 02 0 00 003602* 24048 003611'03 201 03 0 00 000012 24049 003612'03 104 00 0 00 000224 24050 003613'03 320 14 0 00 003614' 24051 003614'03 endif. 24052 003614'03 336 00 0 00 000000* ifmn. vsict 24053 003615'03 254 00 0 00 003646' 24054 txmsg < 24055 003616'03 200 01 0 00 000000# SIN%'s Issued: > 24056 003617'03 104 00 0 00 000076 24057 003620'03 320 12 0 00 003621' 24058 000417'02 000000000000# 24059 001640'04 015 012 040 040 123 24060 003621'03 201 01 0 00 000101 numout vsict ; Virtual Terminal SIN% Count 24061 003622'03 200 02 0 00 003614* 24062 003623'03 201 03 0 00 000012 24063 003624'03 104 00 0 00 000224 24064 003625'03 320 14 0 00 003626' 24065 txmsg < 24066 003626'03 200 01 0 00 000000# SIN% Bytes Total: > 24067 003627'03 104 00 0 00 000076 24068 003630'03 320 12 0 00 003631' 24069 000420'02 000000000000# 24070 001645'04 015 012 040 040 123 24071 003631'03 201 01 0 00 000101 numout vsitc ; Virtual Terminal total characters SIN%'ed 24072 003632'03 200 02 0 00 000000* 24073 003633'03 201 03 0 00 000012 24074 003634'03 104 00 0 00 000224 24075 003635'03 320 14 0 00 003636' 24076 txmsg < 24077 003636'03 200 01 0 00 000000# Max SIN% Length: > 24078 003637'03 104 00 0 00 000076 24079 003640'03 320 12 0 00 003641' 24080 000421'02 000000000000# 24081 001652'04 015 012 040 040 115 24082 003641'03 201 01 0 00 000101 numout vsimx ; Maximum length SIN% ever did 24083 003642'03 200 02 0 00 000000* 24084 003643'03 201 03 0 00 000012 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 36-2 K20DSP MAC 9-Nov-23 18:22 Display information concerning line performance 24085 003644'03 104 00 0 00 000224 24086 003645'03 320 14 0 00 003646' 24087 003646'03 endif. 24088 24089 003646'03 336 00 0 00 000000* ifmn. vsoct 24090 003647'03 254 00 0 00 003700' 24091 txmsg < 24092 003650'03 200 01 0 00 000000# SOUTR%'s Issued: > 24093 003651'03 104 00 0 00 000076 24094 003652'03 320 12 0 00 003653' 24095 000422'02 000000000000# 24096 001657'04 015 012 040 040 123 24097 003653'03 201 01 0 00 000101 numout vsoct ; Virtual Terminal SOUTR% Count 24098 003654'03 200 02 0 00 003646* 24099 003655'03 201 03 0 00 000012 24100 003656'03 104 00 0 00 000224 24101 003657'03 320 14 0 00 003660' 24102 txmsg < 24103 003660'03 200 01 0 00 000000# SOUTR% Bytes: > 24104 003661'03 104 00 0 00 000076 24105 003662'03 320 12 0 00 003663' 24106 000423'02 000000000000# 24107 001664'04 015 012 040 040 123 24108 003663'03 201 01 0 00 000101 numout vsotc ; Virtual Terminal SOUTR% Bytes Total 24109 003664'03 200 02 0 00 000000* 24110 003665'03 201 03 0 00 000012 24111 003666'03 104 00 0 00 000224 24112 003667'03 320 14 0 00 003670' 24113 txmsg < 24114 003670'03 200 01 0 00 000000# Max SOUTR% Len: > 24115 003671'03 104 00 0 00 000076 24116 003672'03 320 12 0 00 003673' 24117 000424'02 000000000000# 24118 001671'04 015 012 040 040 115 24119 003673'03 201 01 0 00 000101 numout vsomx ; Virtual Terminal SOUTR% Maximum length 24120 003674'03 200 02 0 00 000000* 24121 003675'03 201 03 0 00 000012 24122 003676'03 104 00 0 00 000224 24123 003677'03 320 14 0 00 003700' 24124 003700'03 endif. 24125 24126 remark ; Network input fork updates these 24127 003700'03 336 00 0 00 002017* ifmn. nbict ; Did any network input? 24128 003701'03 254 00 0 00 003742' 24129 txmsg < 24130 003702'03 200 01 0 00 000000# Network BIN%'s: > 24131 003703'03 104 00 0 00 000076 24132 003704'03 320 12 0 00 003705' 24133 000425'02 000000000000# 24134 001676'04 015 012 040 040 116 24135 003705'03 201 01 0 00 000101 numout nbict ; Network BIN% count 24136 003706'03 200 02 0 00 003700* 24137 003707'03 201 03 0 00 000012 24138 003710'03 104 00 0 00 000224 24139 003711'03 320 14 0 00 003712' k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 36-3 K20DSP MAC 9-Nov-23 18:22 Display information concerning line performance 24140 txmsg < 24141 003712'03 200 01 0 00 000000# Network SIN%'s: > 24142 003713'03 104 00 0 00 000076 24143 003714'03 320 12 0 00 003715' 24144 000426'02 000000000000# 24145 001703'04 015 012 040 040 116 24146 003715'03 201 01 0 00 000101 numout nsici ; Network SIN%'s Issued 24147 003716'03 200 02 0 00 000000* 24148 003717'03 201 03 0 00 000012 24149 003720'03 104 00 0 00 000224 24150 003721'03 320 14 0 00 003722' 24151 txmsg < 24152 003722'03 200 01 0 00 000000# Network SIN% Cnt: > 24153 003723'03 104 00 0 00 000076 24154 003724'03 320 12 0 00 003725' 24155 000427'02 000000000000# 24156 001710'04 015 012 040 040 116 24157 003725'03 201 01 0 00 000101 numout nsitc ; Network SIN% total characters 24158 003726'03 200 02 0 00 000000* 24159 003727'03 201 03 0 00 000012 24160 003730'03 104 00 0 00 000224 24161 003731'03 320 14 0 00 003732' 24162 txmsg < 24163 003732'03 200 01 0 00 000000# Network SIN% Max: > 24164 003733'03 104 00 0 00 000076 24165 003734'03 320 12 0 00 003735' 24166 000430'02 000000000000# 24167 001715'04 015 012 040 040 116 24168 003735'03 201 01 0 00 000101 numout nsimx ; Network SIN% maximum length 24169 003736'03 200 02 0 00 000000* 24170 003737'03 201 03 0 00 000012 24171 003740'03 104 00 0 00 000224 24172 003741'03 320 14 0 00 003742' 24173 003742'03 endif. 24174 24175 003742'03 263 17 0 00 000000 ret 24176 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 37 K20DSP MAC 9-Nov-23 18:22 ifcrlf -- maybe type a carriage return line feed 24177 subttl ifcrlf -- maybe type a carriage return line feed 24178 24179 ; Call: t1/ Updated point of PSOUT%'ed macro body 24180 ; 24181 ; [194] fixed a case of a macro not being terminated with a carriage 24182 ; return. This is unlikely, but could happen. That being the 24183 ; the case, when displaying the macros, we now have to check to 24184 ; see if we need to print a crlf. 24185 24186 003743'03 ifcrlf: entry ifcrlf ; Inform LINK of our location 24187 remark t1, t2 ; Smashes these 24188 003743'03 265 16 0 00 004550' saveac ; Holds counter and pointers!! 24189 ; Last three characters should be 24190 remark .chcrt, .chlfd, .chnul 24191 003744'03 211 02 0 00 000003 movni t2, ^d3 ; Check the end of the macro string 24192 003745'03 133 02 0 00 000001 adjbp t2, t1 ; May not have a CRLF ... 24193 003746'03 134 03 0 00 000002 ildb t3, t2 ; Pick up penultimate character 24194 003747'03 134 04 0 00 000002 ildb t4, t2 ; Pick up last character 24195 24196 003750'03 306 03 0 00 000015 cain t3, .chcrt ; Did they tie off the line? 24197 003751'03 254 00 0 00 003756' ifskp. ; Apparently not 24198 003752'03 306 04 0 00 000015 cain t4, .chcrt ; Unless they did it backwards 24199 003753'03 254 00 0 00 003756' anskp. ; Odd, but be happy... 24200 003754'03 201 01 0 00 000015 movei t1, .chcrt ; Otherwise, do the carriage return 24201 003755'03 104 00 0 00 000074 PBOUT% 24202 003756'03 endif. 24203 24204 003756'03 306 04 0 00 000012 cain t4, .chlfd ; Did they scroll the carriage? 24205 003757'03 254 00 0 00 003764' ifskp. ; Perhaps not 24206 003760'03 306 03 0 00 000012 cain t3, .chlfd ; Unless they did it backwards 24207 003761'03 254 00 0 00 003764' anskp. ; Odd, but be happy ... 24208 003762'03 201 01 0 00 000012 movei t1, .chlfd ; Otherwise, do the line feed 24209 003763'03 104 00 0 00 000074 PBOUT% 24210 003764'03 endif. 24211 24212 003764'03 263 17 0 00 000000 ret 24213 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 38 K20DSP MAC 9-Nov-23 18:22 PUTC -- Print a single character, using ^X notation, DEL, etc. 24214 subttl PUTC -- Print a single character, using ^X notation, DEL, etc. 24215 24216 ; Call with t1/ character to print. 24217 ; 24218 ;[223] Modifies no registers 24219 24220 003765'03 putc: entry putc ;[194] Inform LINK of our location 24221 003765'03 261 17 0 00 000001 push p, t1 ;[223] Save the character 24222 003766'03 405 01 0 00 000177 andi t1, ^o177 ;[223] Stomp the parity 24223 24224 003767'03 302 01 0 00 000177 caie t1, .chdel ;[194] A rubout? 24225 003770'03 254 00 0 00 004000' ifskp. ;[194] It is 24226 003771'03 261 17 0 00 000002 push p, t2 ;[194] Don't bump into anything 24227 003772'03 200 01 0 00 000000# txmsg ;[194] type this 24228 003773'03 104 00 0 00 000076 24229 003774'03 320 12 0 00 003775' 24230 000431'02 000000000000# 24231 001722'04 104 105 114 000 000 24232 003775'03 262 17 0 00 000002 pop p, t2 ;[194] Restore in case somebody cared 24233 003776'03 262 17 0 00 000001 pop p, t1 ;[223] Restore the original character 24234 003777'03 263 17 0 00 000000 ret 24235 004000'03 endif. ;[194] 24236 24237 004000'03 301 01 0 00 000040 cail t1, .chspc ;[194] Is it a control char? 24238 004001'03 254 00 0 00 004007' ifskp. ;[194] It is 24239 004002'03 261 17 0 00 000001 push p, t1 ; Save the char. 24240 004003'03 201 01 0 00 000136 movei t1, "^" ; Get the control quote. 24241 004004'03 104 00 0 00 000074 PBOUT% 24242 004005'03 262 17 0 00 000001 pop p, t1 24243 004006'03 435 01 0 00 000100 ori t1, ^o100 ; Turn on the non-control bit. 24244 004007'03 endif. ;[194] 24245 24246 004007'03 104 00 0 00 000074 PBOUT% 24247 004010'03 262 17 0 00 000001 pop p, t1 ;[223] Restore the original character 24248 004011'03 263 17 0 00 000000 ret 24249 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 39 K20DSP MAC 9-Nov-23 18:22 show a line's characteristics 24250 subttl show a line's characteristics 24251 24252 ; Says some interesting things about the line that is passed in t1 24253 ; 24254 ; Such information does not effect the protocol, per se. It is rather 24255 ; used for debugging and as part of a heuristic as to what kind of 24256 ; performance could be expected. As there are a rather large number 24257 ; of other factors that can impact performance, what is displayed can 24258 ; in no way be assumed to be determinative. 24259 ; 24260 ; All part of 186, plus some 223 flavoring 24261 24262 ;[223] Line type names 24263 24264 chgsec(code,const) ;[223] Table goes in const psect 24265 000432'02 000000000000# ltname: cascii() ;[223] NW%UND Undefined 24266 001723'04 125 156 144 145 146 24267 000433'02 000000000000# cascii() ;[223] NW%FW Front end (RSX-20F) 24268 001725'04 106 105 000 000 000 24269 000434'02 000000000000# cascii() ;[223] NW%PT Pseudo-terminal 24270 001726'04 120 124 131 000 000 24271 000435'02 000000000000# cascii() ;[223] NW%MC Network Remote Terminal (MCB) 24272 001727'04 116 122 124 000 000 24273 000436'02 000000000000# Cascii() ;[223] NW%TV Telnet Virtual Terminal 24274 001730'04 124 126 124 000 000 24275 000437'02 000000000000# cascii() ;[223] NW%CH CTERM 24276 001731'04 103 124 105 122 115 24277 000440'02 000000000000# cascii() ;[223] NW%LH Local Area Terminal 24278 001733'04 114 101 124 000 000 24279 000441'02 ltneot: remark ;[223] Mark end of table 24280 000007 nw%mx== ;[223] Maximum type 24281 retsec ;[223] Back into code 24282 cleans() ;[223] 24283 24284 ; Call: 24285 ; 24286 ; t1/ Network Type 24287 ; t2/ Line Type 24288 ; t3/ Line number 24289 24290 extern lclpar ;[223] Whether local line will do parity 24291 extern opnpar ;[223] Whether open device will do parity 24292 24293 004012'03 265 16 0 00 004560' linchr: saveac 24294 ;[223] Does not overwrite any register 24295 004013'03 200 05 0 00 000003 move q1, t3 ;[223] Save line number 24296 004014'03 301 02 0 00 000000 cail t2, 0 ;[223] Negative line type? 24297 004015'03 301 02 0 00 000007 cail t2, nw%mx ;[223] or over the maximum? 24298 004016'03 400 02 0 00 000000 setz t2, ;[223] Yes to either, reset to NW%UND 24299 004017'03 120 06 0 00 000001 dmove q2, t1 ;[223] Store network and line type 24300 24301 004020'03 326 07 0 00 004031' ife. q3 ;[223] Undefined line type? (NW%UND) 24302 txmsg < 24303 004021'03 200 01 0 00 000000# Unknown Line: > ; So do error blat 24304 004022'03 104 00 0 00 000076 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 39-1 K20DSP MAC 9-Nov-23 18:22 show a line's characteristics 24305 004023'03 320 12 0 00 004024' 24306 000441'02 000000000000# 24307 001734'04 015 012 040 125 156 24308 004024'03 201 01 0 00 000101 numout q1, ^d8 ; Type whatever we did get passed 24309 004025'03 200 02 0 00 000005 24310 004026'03 201 03 0 00 000010 24311 004027'03 104 00 0 00 000224 24312 004030'03 320 14 0 00 004031' 24313 004031'03 endif. ;[223] Try the rest of it 24314 24315 txmsg < 24316 004031'03 200 01 0 00 000000# Controlling Type: > 24317 004032'03 104 00 0 00 000076 24318 004033'03 320 12 0 00 004034' 24319 000442'02 000000000000# 24320 001741'04 015 012 040 040 103 24321 004034'03 200 01 0 07 000000# move t1, ltname(q3) ;[223] Pick up address of the correct string 24322 004035'03 104 00 0 00 000076 PSOUT% ;[223] And type it 24323 004036'03 320 12 0 00 004037' erjmpr .+1 24324 24325 004037'03 200 04 0 00 000000* move t4, lclpar ;[223] Assume we're doing the controlling terminal 24326 004040'03 312 05 0 00 001521* came q1, mytty ;[223] BUT!! Is this the controlling terminal? 24327 004041'03 200 04 0 00 000000* move t4, opnpar ;[223] Parity tolerated will be set by k20net 24328 004042'03 322 04 0 00 004046' ifn. t4 ;[223] So, does the thing do parity? 24329 004043'03 200 01 0 00 000000# txmsg < [Parity]> ;[223] Yes, somebody will generate it, if asked 24330 004044'03 104 00 0 00 000076 24331 004045'03 320 12 0 00 004046' 24332 000443'02 000000000000# 24333 001746'04 040 133 120 141 162 24334 004046'03 endif. ;[223] Otherwise, nothing to say 24335 24336 004046'03 260 17 0 00 001052' call prntbd ;[210] Print some kind of baud rate maybe 24337 24338 004047'03 302 07 0 00 000004 caie q3, nw%tv ;[223] A TCP Virtual Terminal (TVT)? 24339 004050'03 254 00 0 00 004101' ifskp. ;[223] Yes, then let's display those specifics 24340 txmsg < 24341 004051'03 200 01 0 00 000000# TVT Binary: > ;[129] ARPAnet TVT binary mode. 24342 004052'03 104 00 0 00 000076 24343 004053'03 320 12 0 00 004054' 24344 000444'02 000000000000# 24345 001750'04 015 012 040 040 124 24346 004054'03 332 00 0 00 000000* ifme. tvtflg 24347 004055'03 254 00 0 00 004062' 24348 004056'03 200 01 0 00 000000# txmsg 24349 004057'03 104 00 0 00 000076 24350 004060'03 320 12 0 00 004061' 24351 000445'02 000000000000# 24352 001755'04 117 146 146 000 000 24353 004061'03 254 00 0 00 004065' else. 24354 004062'03 200 01 0 00 000000# txmsg 24355 004063'03 104 00 0 00 000076 24356 004064'03 320 12 0 00 004065' 24357 000446'02 000000000000# 24358 001756'04 117 156 000 000 000 24359 004065'03 endif. k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 39-2 K20DSP MAC 9-Nov-23 18:22 show a line's characteristics 24360 txmsg < 24361 004065'03 200 01 0 00 000000# TVT Negotiate: > ;[182] ARPAnet TVT discovery 24362 004066'03 104 00 0 00 000076 24363 004067'03 320 12 0 00 004070' 24364 000447'02 000000000000# 24365 001757'04 015 012 040 040 124 24366 004070'03 332 00 0 00 000000* ifme. tvtchk 24367 004071'03 254 00 0 00 004076' 24368 004072'03 200 01 0 00 000000# txmsg 24369 004073'03 104 00 0 00 000076 24370 004074'03 320 12 0 00 004075' 24371 000450'02 000000000000# 24372 001764'04 117 166 145 162 162 24373 004075'03 254 00 0 00 004101' else. 24374 004076'03 200 01 0 00 000000# txmsg 24375 004077'03 104 00 0 00 000076 24376 004100'03 320 12 0 00 004101' 24377 000451'02 000000000000# 24378 001766'04 101 165 164 157 155 24379 004101'03 endif. 24380 004101'03 endif. ;[223] End case TCP Virtual Terminal? 24381 24382 004101'03 200 01 0 00 000005 move t1, q1 ; Load line number 24383 004102'03 660 01 0 00 400000 txo t1, .ttdes ; Turn into a terminal designator (if not already one) 24384 004103'03 104 00 0 00 000303 GTTYP% ; Odd that buffers are returned here... 24385 004104'03 320 12 0 00 004106' %jsErr (,r) 24386 004105'03 254 00 0 00 004111' 24387 004106'03 265 01 0 00 002423* 24388 004107'03 000000000000# 24389 004110'03 254 00 0 00 003443* 24390 001770'04 125 156 141 142 154 24391 004111'03 200 04 0 00 000003 move t4, t3 ; Get the buffer counts out of the way 24392 24393 txmsg < 24394 004112'03 200 01 0 00 000000# Input Buffers: > ; Present the input buffer count 24395 004113'03 104 00 0 00 000076 24396 004114'03 320 12 0 00 004115' 24397 000452'02 000000000000# 24398 002000'04 015 012 040 040 111 24399 004115'03 201 01 0 00 000101 movei t1, .priou ; On the terminal 24400 004116'03 554 02 0 00 000004 hlrz t2, t4 ; Load input buffer count 24401 004117'03 201 03 0 00 000012 movei t3, ^d10 ; Is in base ten 24402 004120'03 104 00 0 00 000224 NOUT% 24403 004121'03 320 12 0 00 004123' %jsErr (,) 24404 004122'03 254 00 0 00 004126' 24405 004123'03 265 01 0 00 004106* 24406 004124'03 000000000000# 24407 004125'03 254 00 0 00 004126' 24408 002005'04 125 156 141 142 154 24409 24410 txmsg < 24411 004126'03 200 01 0 00 000000# Output Buffers: > ; Present the output buffer count 24412 004127'03 104 00 0 00 000076 24413 004130'03 320 12 0 00 004131' 24414 000453'02 000000000000# k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 39-3 K20DSP MAC 9-Nov-23 18:22 show a line's characteristics 24415 002017'04 015 012 040 040 117 24416 004131'03 201 01 0 00 000101 movei t1, .priou ; On the terminal 24417 004132'03 550 02 0 00 000004 hrrz t2,t4 ; Load output buffer count 24418 004133'03 201 03 0 00 000012 movei t3, ^d10 ; Is in base ten 24419 004134'03 104 00 0 00 000224 NOUT% 24420 004135'03 320 12 0 00 004137' %jsErr (,) 24421 004136'03 254 00 0 00 004142' 24422 004137'03 265 01 0 00 004123* 24423 004140'03 000000000000# 24424 004141'03 254 00 0 00 004142' 24425 002024'04 125 156 141 142 154 24426 24427 004142'03 263 17 0 00 000000 ret 24428 24429 cleans() 24430 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 40 K20DSP MAC 9-Nov-23 18:22 Print Efficiency Factor 24431 subttl Print Efficiency Factor 24432 24433 ; Overhead calculations 24434 ; 24435 ; T1/ Output JFN or pointer, sacred 24436 ; T2/ Total characters in file(s) 24437 ; T3/ Total characters transferred, every single one 24438 ; 24439 ; In other words, t3 has what was necessary to communicate t2 24440 ; 24441 ; A factor over 1, how much compression is winning you 24442 ; under 1, how much the prefixing is costing you 24443 ; 24444 ; Describe various totals kept for $stat 24445 ; 24446 ; stot - total characters sent, including everything 24447 ; stchr - total characters all files 24448 ; rtot - total characters received, every single one of them 24449 ; rtchr - total characters all files 24450 ; 24451 ; Question, do we really need DOUBLE floating point? fltr will 'only' 24452 ; lose precision for a communications or combined file character total 24453 ; that is greater than 134,217,728 (2**27). 24454 ; 24455 ; This would be a file in excess of 52,429 pages, which is over 2/3's 24456 ; of an RP06. Even if some transfers happened over weekends, it is 24457 ; doubtful that this much data could have been sent--it was more 24458 ; common to just send a magnetic tape. Besides, disk space was 24459 ; EXPENSIVE. If you could afford the platters, you could certainly 24460 ; afford the cost of a tape, the tape mount, the mount time and the 24461 ; postage. 24462 ; 24463 ; Disk space is now effectively free, most structures being double 24464 ; RP07's, having a (then) gargantuan storage capability of over a 24465 ; gigabyte of ASCII text. However, since Kermit speeds are now in 24466 ; the megabyte range, a transfer of multiple large files could 24467 ; exceed 35 bit integer precision. This is certainly possibly if 24468 ; you are using your 20 to store .jpeg's or digital audio. 24469 24470 extern dfloat ; In k20sub (originally from eftpsa) 24471 24472 004143'03 265 16 0 00 004470' peffif: saveac ; Don't touch other temporaries 24473 ; First handle some simple cases 24474 004144'03 327 02 0 00 004150' ifle. t2 ; Is this a zero length file (or balony?) 24475 004145'03 120 02 0 00 000000# smsg <[100% Overhead]> ;Make it stand out 24476 004146'03 260 17 0 00 001050* 24477 000454'02 000000000000# 24478 000455'02 777777 777761 24479 002036'04 133 061 060 060 045 24480 004147'03 263 17 0 00 000000 ret ; That was easy ... 24481 004150'03 endif. 24482 ; Have a non-zero length file here? 24483 004150'03 326 03 0 00 004154' ife. t3 ; Zero length file (like NUL:)? 24484 004151'03 120 02 0 00 000000# smsg <[ZERO]> ; Make it stand out 24485 004152'03 260 17 0 00 004146* k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 40-1 K20DSP MAC 9-Nov-23 18:22 Print Efficiency Factor 24486 000456'02 000000000000# 24487 000457'02 777777 777772 24488 002042'04 133 132 105 122 117 24489 004153'03 263 17 0 00 000000 ret ; That was easy ... 24490 004154'03 endif. 24491 24492 004154'03 325 03 0 00 004160' ifl. t3 ; Impossible communications count? 24493 004155'03 120 02 0 00 000000# smsg <[ERROR]> ; Make it stand out 24494 004156'03 260 17 0 00 004152* 24495 000460'02 000000000000# 24496 000461'02 777777 777771 24497 002044'04 133 105 122 122 117 24498 004157'03 263 17 0 00 000000 ret ; That was easy ... 24499 004160'03 endif. 24500 ; Guess we have some real work to do 24501 004160'03 415 16 0 00 004202' block. ; Set up a stack frame for easier return 24502 004161'03 261 17 0 00 000016 24503 004162'03 265 16 0 00 004576' saveac ; Preserve some more registers 24504 remark t1,t2,t3,t4,t5 ; Can use these for this block 24505 004163'03 200 05 0 00 000002 move t5, t2 ; Save total characters in files 24506 004164'03 400 01 0 00 000000 setz t1, ; No integer high order 24507 004165'03 200 02 0 00 000003 move t2, t3 ; Load total characters communicated 24508 004166'03 260 17 0 00 001027* call dfloat ; Double float the double integer 24509 004167'03 263 17 0 00 000000 ret ; But couldn't 24510 004170'03 250 02 0 00 000005 exch t2, t5 ; Store floating low order and restore 24511 004171'03 200 04 0 00 000001 move t4, t1 ; Store floating high order 24512 004172'03 400 01 0 00 000000 setz t1, ; No integer high order 24513 004173'03 260 17 0 00 004166* call dfloat ; Double float the double integer 24514 004174'03 263 17 0 00 000000 ret ; But couldn't 24515 004175'03 200 03 0 00 000002 move t3, t2 ; Reposition low order 24516 004176'03 200 02 0 00 000001 move t2, t1 ; Reposition high order 24517 004177'03 113 02 0 00 000004 dfdv t2,t4 ; Divide extremely slowly 24518 004200'03 254 00 0 00 001434* retskp ; Win 24519 004201'03 263 17 0 00 000000 endbk. ; End block context, restore registers 24520 004202'03 263 17 0 00 000000 ret ; Passing any error up 24521 24522 004203'03 200 04 0 00 000000# peffi0: move t4,fmcntl ; Load format control 24523 004204'03 104 00 0 00 000235 DFOUT% ; Show us a nice number 24524 004205'03 320 14 0 00 004206' erjmps .+1 ; Don't touch precious t1!! 24525 24526 004206'03 316 04 0 00 000000# camn t4,fmcntl ; Overwritten with error? 24527 004207'03 263 17 0 00 000000 ret ; Nope, we're fine 24528 004210'03 334 00 0 00 000000 %ermsg (,r) 24529 004211'03 254 00 0 00 004215' 24530 004212'03 265 01 0 00 004137* 24531 004213'03 000000000000# 24532 004214'03 254 00 0 00 004110* 24533 002046'04 125 156 141 142 154 24534 004215'03 263 17 0 00 000000 ret ; Finally done 24535 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 41 K20DSP MAC 9-Nov-23 18:22 Define hairy DFOUT% control word 24536 subttl Define hairy DFOUT% control word 24537 24538 000000 fmcntw==0 ; Initialize format control word 24539 24540 define blcntl (value,field,format) < 24541 ifnb , 24542 ifb , 24543 > 24544 24545 blcntl(.fldig,fl%sgn) ;;Sign control is start with a digit 24546 blcntl(.fllsp,fl%jus) ;;Justification is leading spaces 24547 blcntl(fl%one) ;;Output at least one digit, even if zero 24548 blcntl(fl%pnt) ;;Always print a decimal point 24549 blcntl(.flexn,fl%exp) ;;No exponent (too confusing) 24550 blcntl(fl%ovl) ;;Output any overflow 24551 blcntl(-1,fl%rnd) ;;Don't do any rounding 24552 blcntl(^d4,fl%fst) ;;Allow 9,999 improvement 24553 blcntl(^d4,fl%snd) ;;Allow .0001 degradation 24554 24555 chgsec(code,const) ;;This is a constant 24556 000462'02 024137 040400 fmcntl: fmcntw ; Final control word 24557 retsec ;;Back to previous .PSECT 24558 24559 if2 < purge blcntl > ;;Not needed after pass 2 24560 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 42 K20DSP MAC 9-Nov-23 18:22 Calculate Giga, Mega, Kilo character rate 24561 subttl Calculate Giga, Mega, Kilo character rate 24562 24563 ; Uses double floating point to print a more readable, accurate byte rate. 24564 ; 24565 ; t3/ Total characters sent or received 24566 ; 24567 ; +1 - Some odd thing happened 24568 ; +2 - The math worked, at least 24569 24570 004216'03 gmkcps: extern dblcal ; Found with other math routines in k20tim 24571 004216'03 265 16 0 00 004610' saveac ; Need some more scratch 24572 24573 004217'03 415 16 0 00 004230' block. ;[207] Enter block context for better control flow 24574 004220'03 261 17 0 00 000016 24575 004221'03 265 16 0 00 004371' saveac ;[207] Used for DK10 double word 24576 004222'03 201 05 0 00 000471* movei q1, ewallt ;[207] Construct pointer to elapsed wall time 24577 004223'03 201 02 0 05 000017 movei t2, .datus(q1) ;[207] Load pointer to DK10 double word 24578 004224'03 120 03 0 02 000000 dmove t3, (t2) ;[207] Load DK10 tick wall time 24579 004225'03 327 03 0 00 004200* jumpg t3, RSKP ;[207] Non-zero high order is OK 24580 004226'03 327 04 0 00 004225* jumpg t4, RSKP ;[207] Ditto low order 24581 004227'03 263 17 0 00 000000 endbk. ;[207] End block context, restore registers 24582 004230'03 263 17 0 00 000000 ret ;[207] Zero ticks?? Uh, forget it 24583 004231'03 260 17 0 00 000000* call dblcal ; Calculate double floating character rate 24584 004232'03 263 17 0 00 000000 ret ; Failed 24585 004233'03 260 17 0 00 004264' call ranger ; Put result into kilo, mega or giga range 24586 004234'03 260 17 0 00 004203' call peffi0 ; Type it 24587 004235'03 260 17 0 00 004320' call chrsfx ; Puts in the right character suffix 24588 24589 004236'03 254 00 0 00 004226* retskp ; Worked!! 24590 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 43 K20DSP MAC 9-Nov-23 18:22 Calculate Giga, Mega, Kilo baud rate 24591 subttl Calculate Giga, Mega, Kilo baud rate 24592 24593 ; Uses double floating point to print a more readable, accurate byte rate. 24594 ; 24595 ; t3/ Total characters sent or received 24596 24597 ; t4/ High order floating point bit rate (unranged) 24598 ; t5/ Low order, ditto 24599 24600 004237'03 204500 000000 baud: exp 10. ; Assume ten bits per character 24601 004240'03 000000 000000 0 ; Which is not valid for 110 baud 24602 24603 004241'03 gmkbps: extern dblcal ; Found with math routines in k20sub 24604 004241'03 265 16 0 00 004610' saveac ; Need some more scratch 24605 24606 004242'03 415 16 0 00 004252' block. ;[207] Enter block context for better control flow 24607 004243'03 261 17 0 00 000016 24608 004244'03 265 16 0 00 004550' saveac ;[207] Used for DK10 double word 24609 004245'03 201 02 0 00 000000# movei t2,.datus+ewallt;[207] Construct pointer to elapsed DK10 tick wall time 24610 004246'03 120 03 0 02 000000 dmove t3, (t2) ;[207] Load DK10 tick wall time 24611 004247'03 327 03 0 00 004236* jumpg t3, RSKP ;[207] Non-zero high order is OK 24612 004250'03 327 04 0 00 004247* jumpg t4, RSKP ;[207] Ditto low order 24613 004251'03 263 17 0 00 000000 endbk. ;[207] End block context, restore registers 24614 004252'03 263 17 0 00 000000 ret ;[207] Zero ticks?? Uh, forget it 24615 24616 004253'03 260 17 0 00 004231* call dblcal ; Calculate double floating character rate 24617 004254'03 263 17 0 00 000000 ret ; Failed 24618 004255'03 112 04 0 00 004237' dfmp t4, baud ; Scale to baud rate 24619 24620 004256'03 gmkbp1: remark ; Common exit epilogue 24621 004256'03 260 17 0 00 004264' call ranger ; Put result into kilo, mega or giga range 24622 004257'03 260 17 0 00 004203' call peffi0 ; Type it 24623 004260'03 260 17 0 00 004330' call baudsf ; Puts in the right suffix 24624 24625 004261'03 263 17 0 00 000000 ret 24626 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 44 K20DSP MAC 9-Nov-23 18:22 Put result into kilo, mega, giga or tera range 24627 subttl Put result into kilo, mega, giga or tera range 24628 24629 ; Call: 24630 ; 24631 ; t1/ Output designator, unused, but preserved, anyway 24632 ; t4/ High order floating point bit rate (unranged) 24633 ; t5/ Low order, ditto 24634 ; 24635 ; Returns: +1, always 24636 ; 24637 ; t1/ Unmodified output designator 24638 ; t2/ High order, possibly ranged 24639 ; t3/ Low order, ditto 24640 ; t5/ Rate prefix (K, M, G, T), if any 24641 ; 24642 ; N.B., Since we are checking for less than 1,024 in the high 24643 ; order. It is unnecessary to compare the low order word, 24644 ; so we can bum a DCAM. 24645 ; 24646 ; A 'T' prefix means terabaud and is probably either wrong or 24647 ; otherwise delusional in some way. It should be doubted. 24648 24649 004262'03 213400 000000 kilo: 1024. ; Used for ranging (floating!!!) 24650 004263'03 000000 000000 0 ; Also used as double floating divisor 24651 24652 004264'03 265 16 0 00 004457' ranger: saveac ; Let's just leave that alone 24653 004265'03 311 04 0 00 004262' caml t4,kilo ; Into kilobaud already?? 24654 004266'03 254 00 0 00 004272' ifskp. ; Nope, not even, so not much to do, then 24655 004267'03 120 02 0 00 000004 dmove t2,t4 ; Load puny hundreds of baud rate (yech) 24656 004270'03 400 05 0 00 000000 setz t5, ; Not even a prefix character, sniff 24657 004271'03 263 17 0 00 000000 ret ; Well, that was easy 24658 004272'03 endif. ; Otherwise, at least in kilobaud 24659 24660 004272'03 113 04 0 00 004262' dfdv t4,kilo ; Reduce by ten orders of binary magnitude 24661 004273'03 311 04 0 00 004262' caml t4,kilo ; Into Megabaud? 24662 004274'03 254 00 0 00 004300' ifskp. ; No, but respectable anyway (or used to be) 24663 004275'03 120 02 0 00 000004 dmove t2,t4 ; Load kilobaud rate 24664 004276'03 201 05 0 00 000113 movei t5,"K" ; Load the Kilobaud prefix 24665 004277'03 263 17 0 00 000000 ret ; Return kilo or greater, but less than mega 24666 004300'03 endif. ; Otherwise, at least in megabaud 24667 24668 004300'03 113 04 0 00 004262' dfdv t4,kilo ; Reduce by ten orders of binary magnitude 24669 004301'03 311 04 0 00 004262' caml t4,kilo ; Into Gigabaud? 24670 004302'03 254 00 0 00 004306' ifskp. ; No, but at NI/CI speeds! 24671 004303'03 120 02 0 00 000004 dmove t2,t4 ; Load Megabaud rate 24672 004304'03 201 05 0 00 000115 movei t5,"M" ; Load the Megabaud prefix 24673 004305'03 263 17 0 00 000000 ret ; Return mega or greater, but less than giga 24674 004306'03 endif. ; Otherwise, at least in Gigabaud 24675 24676 004306'03 113 04 0 00 004262' dfdv t4,kilo ; Reduce by ten orders of binary magnitude 24677 004307'03 311 04 0 00 004262' caml t4,kilo ; Into Terabaud?? 24678 004310'03 254 00 0 00 004314' ifskp. ; No, but 1000BaseT is nothing to sneeze at! 24679 004311'03 120 02 0 00 000004 dmove t2,t4 ; Load Gigabaud rate 24680 004312'03 201 05 0 00 000107 movei t5,"G" ; Load the Gigabaud prefix 24681 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 20:02 27-Nov-23 Page 44-1 K20DSP MAC 9-Nov-23 18:22 Put result into kilo, mega, giga or tera range 24682 004314'03 endif. ; Otherwise, some kind of incredible rate 24683 24684 remark Dude!! ; What kind of com gear are you using? 24685 004314'03 113 04 0 00 004262' dfdv t4,kilo ; Reduce by ten orders of binary magnitude 24686 004315'03 120 02 0 00 000004 dmove t2,t4 ; Load Terabaud rate 24687 004316'03 201 05 0 00 000124 movei t5,"T" ; Load Terabaud prefix 24688 004317'03 263 17 0 00 000000 ret ; Return from ...Fantasy Island... 24689 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 45 K20DSP MAC 9-Nov-23 18:22 Print correct character suffix 24690 subttle Print correct character suffix 24691 24692 ; Call: 24693 ; 24694 ; t1/ Output designator (updated, if string) 24695 ; t5/ character prefix character (if any) 24696 24697 004320'03 201 02 0 00 000040 chrsfx: movei t2,.chspc ; Load a space 24698 004321'03 260 17 0 00 000000* call BOUTI% ;[216] Properly emit 24699 24700 004322'03 336 02 0 00 000005 skipn t2,t5 ; Load prefix character 24701 004323'03 254 00 0 00 004325' ifskp. ; If there is one, then type it 24702 004324'03 260 17 0 00 004321* call BOUTI% ;[216] Properly emit it 24703 004325'03 endif. 24704 24705 004325'03 120 02 0 00 000000# smsg 24706 004326'03 260 17 0 00 004156* 24707 000463'02 000000000000# 24708 000464'02 777777 777775 24709 002057'04 103 057 163 000 000 24710 004327'03 263 17 0 00 000000 ret 24711 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 46 K20DSP MAC 9-Nov-23 18:22 Print correct baud suffix 24712 subttle Print correct baud suffix 24713 24714 ; Call: 24715 ; 24716 ; t1/ Output designator (updated, if string) 24717 ; t5/ character prefix character (if any) 24718 24719 004330'03 201 02 0 00 000040 baudsf: movei t2,.chspc ; Load a space 24720 004331'03 260 17 0 00 004324* call BOUTI% ;[216] Seperate number from text 24721 004332'03 336 02 0 00 000005 skipn t2,t5 ; Load prefix character 24722 004333'03 254 00 0 00 004335' ifskp. ; If there is one, then type it 24723 004334'03 260 17 0 00 004331* call BOUTI% ;[216] 24724 004335'03 endif. 24725 24726 004335'03 120 02 0 00 000000# smsg ; Accepted abbreviation for Baud 24727 004336'03 260 17 0 00 004326* 24728 000465'02 000000000000# 24729 000466'02 777777 777776 24730 002060'04 102 144 000 000 000 24731 004337'03 263 17 0 00 000000 ret 24732 24733 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 47 K20DSP MAC 9-Nov-23 18:22 Determine the console's line number 24734 subttl Determine the console's line number 24735 24736 ;[223] Begin code insertion 24737 24738 ; Want to know this because the CTY is not a good line to use as you 24739 ; can't control what a front end might type as well as Tops-20's own 24740 ; needs. Using it can cause messages to never get seen, being simply 24741 ; thrown away as a packet resend. 24742 ; 24743 ; It is for this reason that the PANDA access control job (ACJ) will 24744 ; not allow the CTY to be assigned (either explicitly with ASND% or 24745 ; implicitly with an OPENF%) by anything else than an enabled WHEEL or 24746 ; OPERATOR. 24747 24748 chgsec(code,data) ; Need to store the data... 24749 000004'05 ctyerr: block 1 ; Any STDEV% error 24750 000005'05 ctydev: block 1 ;** DO NOT ; Console in 'device' format 24751 000006'05 ctynum: block 1 ; REORDER ** ; Bare line number of console 24752 retsec ; Restore psect assumptions 24753 24754 chgsec(code,const) ; The device name of the console is eternal 24755 000467'02 103 124 131 000 000 ctynam: asciz /CTY/ ; Note, NO device punctuation! 24756 retsec ; Restore psect assumptions 24757 24758 004340'03 inicty: entry inicty ; Called at program start up 24759 004340'03 265 16 0 00 004357' saveac ; Let's not touch anything 24760 24761 004341'03 561 01 0 00 000000# hrroi t1, ctynam ; Tops-20 pointer to CTY device name 24762 004342'03 104 00 0 00 000120 STDEV% ; Turn the string into a device 24763 004343'03 320 12 0 00 004345' ifje. r ; This is REALLY supposed to be defined... 24764 004344'03 254 00 0 00 004351' 24765 004345'03 202 01 0 00 000000# movem t1, ctyerr ; Store error for the curious 24766 004346'03 477 02 0 00 000003 setob t2, t3 ; Cons up a pair bogus talismen 24767 004347'03 124 02 0 00 000000# dmovem t2, ctydev ; Flag that they are useless 24768 004350'03 263 17 0 00 000000 ret ; Go no further 24769 004351'03 endif. ; End STDEV% error handling 24770 24771 remark ; Otherwise, worked!! 24772 004351'03 202 02 0 00 000000# movem t2, ctydev ; Save in device format for ASND% check 24773 004352'03 620 02 0 00 400000 txz t2, .ttdes ; Shut off terminal designator if half word 24774 004353'03 552 02 0 00 000000# hrrzm t2, ctynum ; Save just the line number 24775 004354'03 201 04 0 00 601405 movx t4, lstrx1 ; Say it worked fine 24776 004355'03 202 04 0 00 000000# movem t4, ctyerr ; Store (lack of) error for the curious 24777 24778 004356'03 263 17 0 00 000000 ret ; Finally done 24779 24780 ;[223] End code insertion 24781 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 48 K20DSP MAC 9-Nov-23 18:22 Finishing items 24782 subttl Finishing items 24783 24784 xlist ; Save the trees!! 24785 list ; Resume listing 24786 24787 .endps code ; Close the code .psect 24788 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 49 K20DSP MAC 9-Nov-23 18:22 Extended Text for Display 24789 subttl Extended Text for Display 24790 24791 .psect etext ;[209] Need to put some things in extended text 24792 24793 remark Various types of parity 24794 24795 002061'04 116 157 156 145 000 enone: asciz/None/ 24796 002062'04 123 160 141 143 145 espac: asciz/Space/ 24797 002064'04 115 141 162 153 000 emark: asciz/Mark/ 24798 002065'04 117 144 144 000 000 eodd: asciz/Odd/ 24799 002066'04 105 166 145 156 000 eeven: asciz/Even/ 24800 24801 remark Various states of debugging 24802 24803 002067'04 117 146 146 000 000 deboff: asciz/Off/ 24804 002070'04 123 164 141 164 145 debsts: asciz/States/ 24805 002072'04 120 141 143 153 145 debpks: asciz/Packets/ 24806 24807 .endps etext ; Close out section 1 text 24808 24809 remark Pointers to extended text which MUST be in section zero 24810 24811 .psect const ; Constants 24812 24813 000470'02 000000000000# debtab: .px7!deboff 24814 000471'02 000000000000# .px7!debsts 24815 000472'02 000000000000# .px7!debpks 24816 24817 .endps const 24818 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 50 K20DSP MAC 9-Nov-23 18:22 Display Module local storage 24819 subttl Display Module local storage 24820 24821 .psect data ; Writable storage 24822 000007'05 000000 000000 pvbaud:: exp 0,0 ; PTY: virtual baud rate 24823 000011'05 000000 000000 pibaud:: exp 0,0 ; PIP: virtual baud rate 24824 000013'05 000000 000000 nlbaud:: exp 0,0 ; NUL: virtual baud rate 24825 000015'05 000000 000000 dnbaud:: exp 0,0 ; DECnet virtual baud rate 24826 24827 .endps data ; End of data psect 24828 24829 .xcmsy ;[194] Ditch MACSYM junk 24830 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:02.166 137P CORE USED k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 20:02 27-Nov-23 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 20:02 27-Nov-23 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 20:02 27-Nov-23 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 20:02 27-Nov-23 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 20:02 27-Nov-23 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 20:02 27-Nov-23 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 20:02 27-Nov-23 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 20:02 27-Nov-23 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 20:02 27-Nov-23 Page 1 K20PDC MAC 24-Nov-23 17:16 24831 title k20pdc - Kermit (Visual) Packet Decoding 24832 24833 ; All display code was removed from k20mit and moved to the k20dsp 24834 ; module as part of Edit 194 to address the issue of a very large 24835 ; single source file that unexpectedly began generating MCRNEC errors. 24836 ; 24837 ; With the exception the 'main' k20mit module, any time a module gets 24838 ; near 50 pages, a code split happens. Thus far, this has happened 24839 ; with: 24840 ; 24841 ; k20ioc - Kermit INPUT/OUTPUT/TRANSMIT support 24842 ; k20mac - Kermit Macros (DEFINE command) 24843 ; k20srv - Kermit Server Commands 24844 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 20:02 27-Nov-23 Page 2 K20PDC MAC 24-Nov-23 17:16 Preliminaries 24845 subttl Preliminaries 24846 24847 search monsym,macsym,cmd,k20unv ;[194] 24848 cmdacs ^ ;Clean up p1-p4 definitions 24849 24850 sall ; Tidy listing 24851 .directive flblst ; We don't need to see all the ASCIZ bytes... 24852 24853 extern rquote ; Receive quote character 24854 extern squote ; Send quote character 24855 24856 extern $closd ; Close debugging log 24857 extern logjfn ; Debugging log JFN 24858 extern BOUTI% ; Byte output to JFN or append to string 24859 extern %%smsg ; smsg macro support 24860 remark ; N.B., %%smsg *ONLY* handles OWGP's!!!!! 24861 24862 repeat 0,< remark ;;;; ; Put these in later to bum a BOUT% 24863 extern s8ccv7 ; String eight controlified convert to seven 24864 extern trnbuf ; Where it leaves this 24865 > 24866 .psect code/ronly ; Pure code. Pure Heaven 24867 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 20:02 27-Nov-23 Page 3 K20PDC MAC 24-Nov-23 17:16 DIAMSG Print packet type and number if debugging "states" 24868 subttl DIAMSG Print packet type and number if debugging "states" 24869 24870 ;[114] DIAMSG 24871 ; 24872 ; Enter with: 24873 ; t1/ packet type 24874 ; t2/ packet number 24875 ; t4/ pointer to data 24876 ; logjfn/ debugging log file jfn 24877 ; Returns +1 always, with all ACs unchanged. 24878 24879 000000'01 diamsg: entry diamsg ;[221] Moved here from k20mit 24880 000000'01 306 14 0 00 000001 cain debug, 1 ; Only for protocol debugging. 24881 000001'01 336 00 0 00 000000* skipn logjfn ; Got a log JFN? 24882 000002'01 263 17 0 00 000000 ret ; Nope, forget it. 24883 24884 000003'01 265 16 0 00 001007' saveac ; Save these. 24885 000004'01 405 01 0 00 000177 andi t1, 177 ;[235] Strip off any parity 24886 000005'01 261 17 0 00 000001 push p, t1 ; Save packet type for sec. 24887 000006'01 200 01 0 00 000001* move t1, logjfn ; Get debugging log file JFN. 24888 000007'01 201 03 0 00 000010 movei t3, ^d8 ;[194] Tops-20 displays ASCII numeric as Octal 24889 000010'01 104 00 0 00 000224 NOUT% 24890 000011'01 320 12 0 00 000013' ifje. r ;[194] Catch and ignore error 24891 000012'01 254 00 0 00 000016' 24892 000013'01 262 17 0 00 000002 pop p, t2 ;[194] Keep the stack straight!!!!! 24893 000014'01 254 00 0 00 000031' jrst deberr ;[174] 24894 000015'01 254 00 0 00 000017' else. ;[194] Otherwise, worked 24895 000016'01 262 17 0 00 000002 pop p, t2 ; Pop packet type 24896 000017'01 endif. ;[194] 24897 000017'01 260 17 0 00 000000* call BOUTI% 24898 000020'01 302 02 0 00 000107 caie t2, "G" ; Generic command? 24899 000021'01 254 00 0 00 000026' ifskp. ;[194] Yes, first character of one 24900 000022'01 200 03 0 00 000004 move t3, t4 ; Log the first character of the data packet. 24901 000023'01 134 02 0 00 000003 ildb t2, t3 24902 000024'01 405 02 0 00 000177 andi t2, 177 ;[235] Strip off any parity 24903 000025'01 260 17 0 00 000017* call BOUTI% ;[174] 24904 000026'01 endif. ;[194] 24905 24906 000026'01 201 02 0 00 000040 diamsz: movei t2, " " ; A space for delimitation. 24907 000027'01 260 17 0 00 000025* call BOUTI% ;[174] 24908 000030'01 263 17 0 00 000000 ret 24909 24910 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 20:02 27-Nov-23 Page 4 K20PDC MAC 24-Nov-23 17:16 Handle I/O errors writing to debugging log file. 24911 subttl Handle I/O errors writing to debugging log file. 24912 24913 ;[174] 24914 24915 000031'01 deberr: entry deberr ;[221] Moved here from k20mit 24916 txmsg < 24917 000031'01 200 01 0 00 000000# %KERMIT-20: Error writing debug log file - > 24918 000032'01 104 00 0 00 000076 24919 000033'01 320 12 0 00 000034' 24920 000000'02 000000000000# 24921 000000'03 015 012 045 113 105 24922 000034'01 201 01 0 00 000101 movei t1, .priou 24923 000035'01 525 02 0 00 400000 hrloi t2, .fhslf 24924 000036'01 400 03 0 00 000000 setz t3, 24925 000037'01 104 00 0 00 000011 ERSTR% 24926 000040'01 320 14 0 00 000042' erjmps .+2 ; Ignore its strange return 24927 000041'01 320 14 0 00 000042' erjmps .+1 ; Ignore its stranger return 24928 txmsg < 24929 000042'01 200 01 0 00 000000# > 24930 000043'01 104 00 0 00 000076 24931 000044'01 320 12 0 00 000045' 24932 000001'02 000000000000# 24933 000012'03 015 012 000 000 000 24934 000045'01 400 01 0 00 000000 setz t1, ; Close the log file if possible 24935 000046'01 260 17 0 00 000000* call $closd ;[194] ; and turn off debug log. 24936 000047'01 263 17 0 00 000000 ret 24937 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 20:02 27-Nov-23 Page 5 K20PDC MAC 24-Nov-23 17:16 Packet Decode 24938 subttl Packet Decode 24939 24940 ; t1/ LH, "S" or "R" (Sending or Receiving 24941 ; RH, Debugging log JFN or terminal device id 24942 ; t2/ Point 8, packet to send or packet we got 24943 24944 000050'01 pdecod: entry pdecod ; Called by k10mit packet routines 24945 remark ; *MUST* be saved by caller!!!! 24946 000050'01 265 16 0 00 001021' saveac ; Needs some more registers 24947 24948 000051'01 337 13 0 00 000006* skipg p3, logjfn ; Do we have a logging JFN? (can be .priou) 24949 000052'01 263 17 0 00 000000 ret ; No, so don't log anything 24950 000053'01 554 11 0 00 000001 hlrz p1, t1 ; Load the packet context 24951 000054'01 621 01 0 00 777777 tlz t1, -1 ; And stomp it out of the register 24952 000055'01 120 05 0 00 000001 dmove q1, t1 ; Let's save these for a moment 24953 000056'01 120 07 0 00 000003 dmove q3, t3 ; all of the temporaries 24954 24955 000057'01 415 16 0 00 000067' block. ; Carefully review the context character 24956 000060'01 261 17 0 00 000016 24957 000061'01 306 11 0 00 000122 cain p1, "R" ; Receiving? 24958 000062'01 254 00 0 00 000000* retskp ; Yes, this is valid 24959 000063'01 306 11 0 00 000123 cain p1, "S" ; Sending? 24960 000064'01 254 00 0 00 000062* retskp ; Yes, that's valid, too 24961 000065'01 263 17 0 00 000000 ret ; Otherwise, some kind of bad 24962 000066'01 263 17 0 00 000000 endbk. ; End of block context 24963 000067'01 254 00 0 00 000076' ifskp. ; +2 means we thought it was fine 24964 000070'01 306 11 0 00 000122 cain p1, "R" ; Receiving? 24965 000071'01 254 00 0 00 000107' callret rpdecd ; Yes, go do something about that 24966 000072'01 306 11 0 00 000123 cain p1, "S" ; Receiving? 24967 000073'01 254 00 0 00 000152' callret spdecd ; Yes, go do something about that, too 24968 000074'01 254 00 0 00 000076' anskp. ; ??? Shouldn't happen--we just checked 24969 000075'01 254 00 0 00 000106' else. ; Otherwise, unknown context 24970 000076'01 200 01 0 00 000013 move t1, p3 ; Pick up the log JFN 24971 000077'01 120 02 0 00 000000# smsg <% "> ; Begin confusion blat 24972 000100'01 260 17 0 00 000000* 24973 000002'02 000000000000# 24974 000003'02 777777 777775 24975 000013'03 045 040 042 000 000 24976 000101'01 200 11 0 00 000011 move p1, p1 ; Pick up the unknown context character 24977 000102'01 260 17 0 00 000027* call BOUTI% ; Put it into the log file 24978 smsg <" is not a known transmission context 24979 000103'01 120 02 0 00 000000# > ; Finish the blat and close off the line 24980 000104'01 260 17 0 00 000100* 24981 000004'02 000000000000# 24982 000005'02 777777 777731 24983 000014'03 042 040 151 163 040 24984 24985 000105'01 263 17 0 00 000000 ret ; Get out of here and don't risk bogosity 24986 000106'01 endif. ; End case context character scrub 24987 24988 000106'01 263 17 0 00 000000 ret ; Superstition... 24989 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 20:02 27-Nov-23 Page 6 K20PDC MAC 24-Nov-23 17:16 Receive Context 24990 subttl Receive Context 24991 24992 ; Invoked at the end of the receive 24993 ; 24994 ; AC's: 24995 ; 24996 ; t1/ Packet type 24997 ; t2/ Packet number 24998 ; t3/ Length of data field 24999 ; t4/ 8-bit byte pointer to data field 25000 25001 extern rsthdr ; Start of Packet 25002 extern num ; Packet Number 25003 extern type ; Message Type 25004 extern datlen ; Data length 25005 extern pktlen ; Packet length 25006 extern islong ; Set if a long packet 25007 extern datptr ; Pointer to data area of packet 25008 extern pktbct ; Block check type for this packet on receive 25009 extern blkchk ; Final computed block check 25010 extern fintim ; Fine grained time of day (in K20TIM) 25011 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 20:02 27-Nov-23 Page 7 K20PDC MAC 24-Nov-23 17:16 Decode a received packet 25012 subttl Decode a received packet 25013 25014 000107'01 rpdecd: remark ; Saved by original external caller 25015 remark ; Saved by internal control linkage 25016 repeat 0,< 25017 setzb t1, t2 ; Cons up some .CHNUL's 25018 dmovem t1, sop8st ; Start of Packet character as an 8 bit ASCII string 25019 dmovem t1, trnbuf ; Same character as expanded 7 bit ASCIZ 25020 > 25021 000107'01 200 01 0 00 000013 move t1, p3 ; Load the log file JFN 25022 000110'01 120 02 0 00 000000# smsg () ; "R" for Receive 25023 000111'01 260 17 0 00 000104* 25024 000006'02 000000000000# 25025 000007'02 777777 777776 25026 000024'03 122 054 000 000 000 25027 000112'01 260 17 0 00 000000* call fintim ; Print Time of Day down to HP ticks 25028 000113'01 254 00 0 00 000031' jrst deberr ; Something went wrong, stop doing this 25029 000114'01 201 04 0 00 000122 movei t4, "R" ; Flag that we're receiving 25030 000115'01 260 17 0 00 000731' call pkthdr ; Display packet head 25031 000116'01 254 00 0 00 000031' jrst deberr ; Failed somehow 25032 25033 000117'01 200 02 0 00 000000* move t2, datptr ; Load what receieve sets up 25034 000120'01 202 02 0 00 000000* movem t2, sdatpt ; Pretend we're sending it for code re-use 25035 25036 000121'01 200 04 0 00 000000* move t4, type ; Reload the type 25037 000122'01 405 04 0 00 000177 andi t4, 177 ;[235] Strip off any parity 25038 000123'01 301 04 0 00 000101 cail t4, "A" ; Before "A"? 25039 000124'01 303 04 0 00 000132 caile t4, "Z" ; or after "Z"? 25040 000125'01 254 00 0 00 000213' jrst invsnd ; Can't do the jump table 25041 25042 000126'01 415 16 0 00 000136' block. ; Enter block context for better control flow 25043 000127'01 261 17 0 00 000016 25044 000130'01 306 04 0 00 000131 cain t4, "Y" ; An acknowledge? 25045 000131'01 263 17 0 00 000000 ret ; Don't overwrite what ACK is ack'ing 25046 000132'01 306 04 0 00 000116 cain t4, "N" ; A negative acknowledge? 25047 000133'01 263 17 0 00 000000 ret ; Don't overwrite what NAK is nak'ing 25048 000134'01 254 00 0 00 000064* retskp ; Otherwise, OK to update context 25049 000135'01 263 17 0 00 000000 endbk. ; End of block context 25050 000136'01 254 00 0 00 000140' ifskp. ; +2 means OK to overwrite 25051 000137'01 202 04 0 00 000000# movem t4, lstpkt ; Remember last packet type 25052 000140'01 endif. 25053 25054 000140'01 265 16 0 00 001037' saveac ; Needs some scratch 25055 000141'01 200 05 0 00 000120* move q1, sdatpt ; Load the pointer to the packet's data field 25056 000142'01 200 07 0 00 000000* move q3, datlen ; Number of initialization bytes 25057 25058 000143'01 200 03 0 00 000004 move t3, t4 ; Save a working copy 25059 000144'01 275 03 0 00 000101 subi t3, "A" ; Bring into offset range 25060 000145'01 260 17 1 03 000000# call @sndpkt(t3) ; Call the right routine 25061 000146'01 263 17 0 00 000000 ret ; Pass the error back up 25062 25063 smsg < 25064 000147'01 120 02 0 00 000000# > ; Tie off the log file line 25065 000150'01 260 17 0 00 000111* 25066 000010'02 000000000000# k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 20:02 27-Nov-23 Page 7-1 K20PDC MAC 24-Nov-23 17:16 Decode a received packet 25067 000011'02 777777 777776 25068 000025'03 015 012 000 000 000 25069 000151'01 263 17 0 00 000000 ret ; +1, always 25070 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 20:02 27-Nov-23 Page 8 K20PDC MAC 24-Nov-23 17:16 Decode a sent packet 25071 subttl Decode a sent packet 25072 25073 extern sseqn ; Sending Sequence Number 25074 extern sdatpt ; Sending Data Pointer (points inside the packet) 25075 extern spakpt ; Sending packet pointer 25076 25077 000152'01 spdecd: remark ; Saved by original external caller 25078 remark ; Saved by internal control linkage 25079 repeat 0,< 25080 setzb t1, t2 ; Cons up some .CHNUL's 25081 dmovem t1, sop8st ; Start of Packet character as an 8 bit ASCII string 25082 dmovem t1, trnbuf ; Same character as expanded 7 bit ASCIZ 25083 > 25084 000152'01 200 01 0 00 000013 move t1, p3 ; Load the log file JFN 25085 000153'01 120 02 0 00 000000# smsg () ; "S" for Send 25086 000154'01 260 17 0 00 000150* 25087 000012'02 000000000000# 25088 000013'02 777777 777776 25089 000026'03 123 054 000 000 000 25090 000155'01 260 17 0 00 000112* call fintim ; Print Time of Day down to HP ticks 25091 000156'01 254 00 0 00 000031' jrst deberr ; Something went wrong, stop doing this 25092 000157'01 201 04 0 00 000123 movei t4, "S" ; Flag that we're sending 25093 000160'01 260 17 0 00 000731' call pkthdr ; Dump basic packet headers 25094 000161'01 254 00 0 00 000031' jrst deberr ; Failed somehow 25095 25096 000162'01 200 04 0 00 000121* move t4, type ; Reload the type 25097 000163'01 405 04 0 00 000177 andi t4, 177 ;[235] Strip off any parity 25098 000164'01 301 04 0 00 000101 cail t4, "A" ; Before "A"? 25099 000165'01 303 04 0 00 000132 caile t4, "Z" ; or after "Z"? 25100 000166'01 254 00 0 00 000213' jrst invsnd ; Can't do the jump table 25101 25102 000167'01 415 16 0 00 000177' block. ; Enter block context for better control flow 25103 000170'01 261 17 0 00 000016 25104 000171'01 306 04 0 00 000131 cain t4, "Y" ; An acknowledge? 25105 000172'01 263 17 0 00 000000 ret ; Don't overwrite what ACK is ack'ing 25106 000173'01 306 04 0 00 000116 cain t4, "N" ; A negative acknowledge? 25107 000174'01 263 17 0 00 000000 ret ; Don't overwrite what NAK is nak'ing 25108 000175'01 254 00 0 00 000134* retskp ; Otherwise, OK to update context 25109 000176'01 263 17 0 00 000000 endbk. ; End of block context 25110 000177'01 254 00 0 00 000201' ifskp. ; +2 means OK to overwrite 25111 000200'01 202 04 0 00 000000# movem t4, lstpkt ; Remember last packet type 25112 000201'01 endif. 25113 25114 000201'01 265 16 0 00 001037' saveac ; Needs some scratch 25115 000202'01 200 05 0 00 000141* move q1, sdatpt ; Load the pointer to the packet's data field 25116 000203'01 200 07 0 00 000142* move q3, datlen ; Number of initialization bytes 25117 25118 000204'01 200 03 0 00 000004 move t3, t4 ; Save a working copy 25119 000205'01 275 03 0 00 000101 subi t3, "A" ; Bring into offset range 25120 000206'01 260 17 1 03 000000# call @sndpkt(t3) ; Call the right routine 25121 000207'01 263 17 0 00 000000 ret ; Pass the error back up 25122 smsg < 25123 000210'01 120 02 0 00 000000# > ; Otherwise, tie off the log file line 25124 000211'01 260 17 0 00 000154* 25125 000014'02 000000000000# k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 20:02 27-Nov-23 Page 8-1 K20PDC MAC 24-Nov-23 17:16 Decode a sent packet 25126 000015'02 777777 777776 25127 000027'03 015 012 000 000 000 25128 000212'01 263 17 0 00 000000 ret ; Returns +1, always 25129 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 20:02 27-Nov-23 Page 9 K20PDC MAC 24-Nov-23 17:16 Jump table for sent packet types 25130 subttl Jump table for sent packet types 25131 25132 .endps code ; Constant tables don't go in code 25133 .psect const ; they go into the constants psect 25134 25135 000016'02 000000000000# sndpkt: INVSND ; "A" - Attributes 25136 000017'02 000000000000# sndeot ; "B" - EOT 25137 000020'02 000000000000# INVSND ; "C" - Largely unimplemented host command 25138 000021'02 000000000000# sndata ; "D" - Data 25139 000022'02 000000000000# snderr ; "E" - Error packet 25140 000023'02 000000000000# sndfil ; "F" - File Header 25141 000024'02 000000000000# sndgen ; "G" - Sending a generic command 25142 000025'02 000000000000# INVSND ; "H" - Undefined 25143 000026'02 000000000000# sndinz ; "I" - Info Packet 25144 000027'02 000000000000# INVSND ; "J" - Undefined 25145 000030'02 000000000000# INVSND ; "K" - Undefined 25146 000031'02 000000000000# INVSND ; "L" - Undefined 25147 000032'02 000000000000# INVSND ; "M" - Undefined 25148 000033'02 000000000000# sndnak ; "N" - Negative Acknowledge (NAK) 25149 000034'02 000000000000# INVSND ; "O" - Undefined 25150 000035'02 000000000000# INVSND ; "P" - Undefined 25151 000036'02 000000000000# INVSND ; "Q" - Undefined 25152 000037'02 000000000000# sndrec ; "R" - Receive (GET) 25153 000040'02 000000000000# sndini ; "S" - Send 25154 000041'02 000000000000# INVSND ; "T" - Specially handled, somehow 25155 000042'02 000000000000# INVSND ; "U" - Undefined 25156 000043'02 000000000000# INVSND ; "V" - Undefined 25157 000044'02 000000000000# INVSND ; "W" - Undefined 25158 000045'02 000000000000# sndtxt ; "X" - Text Header 25159 000046'02 000000000000# sndack ; "Y" - Acknowledge (ACK) 25160 000047'02 000000000000# sndeof ; "Z" - EOF 25161 25162 .endps const ; Done with constants 25163 .psect code ; Back to generating code 25164 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 20:02 27-Nov-23 Page 10 K20PDC MAC 24-Nov-23 17:16 Invalid Send Packet 25165 subttl Invalid Send Packet 25166 25167 000213'01 200 01 0 00 000013 INVSND: move t1, p3 ; Load log file 25168 000214'01 120 02 0 00 000000# smsg (<, Invalid packet type: ">) ;" Fool font crock mode 25169 000215'01 260 17 0 00 000211* 25170 000050'02 000000000000# 25171 000051'02 777777 777750 25172 000030'03 054 040 111 156 166 25173 000216'01 200 02 0 00 000004 invsn1: move t2, t4 ; Load it 25174 000217'01 260 17 0 00 000102* call BOUTI% ; Put it in the log 25175 000220'01 201 02 0 00 000042 invsn2: movei t2, .chdbq ; Load closing double quote 25176 000221'01 260 17 0 00 000217* call BOUTI% ; Put it in the log 25177 000222'01 361 07 0 00 000175* sojl q3, RSKP ; Nothing here? That's fine 25178 000223'01 254 00 0 00 000233' callret sndata ; Dump any data that came along with it 25179 000224'01 254 00 0 00 000222* retskp ; Successfully whined ... 25180 25181 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 20:02 27-Nov-23 Page 11 K20PDC MAC 24-Nov-23 17:16 Various Commands, many mostly dinky 25182 subttl Various Commands, many mostly dinky 25183 25184 000225'01 sndeot: remark Sending a "B" - End of Transmission 25185 000225'01 120 02 0 00 000000# smsg (<, End of Transmission>) 25186 000226'01 260 17 0 00 000215* 25187 000052'02 000000000000# 25188 000053'02 777777 777753 25189 000035'03 054 040 105 156 144 25190 000227'01 361 07 0 00 000224* sojl q3, RSKP ; Nothing here? That's fine 25191 000230'01 120 02 0 00 000000# smsg <: > ; Shouldn't have anything in it, but... 25192 000231'01 260 17 0 00 000226* 25193 000054'02 000000000000# 25194 000055'02 777777 777776 25195 000042'03 072 040 000 000 000 25196 000232'01 254 00 0 00 000250' callret sndat1 ; Dump it 25197 25198 25199 000233'01 sndata: remark Sending a "D" - Data Packet 25200 000233'01 120 02 0 00 000000# smsg <, Data: > ; The packet data 25201 000234'01 260 17 0 00 000231* 25202 000056'02 000000000000# 25203 000057'02 777777 777770 25204 000043'03 054 040 104 141 164 25205 000235'01 337 02 0 00 000203* skipg t2,datlen ;[241] ; typing anything? 25206 000236'01 254 00 0 00 000250' ifskp. ;[241] ; Yes, say how long 25207 000237'01 201 03 0 00 000012 movx t3,fld(^d10,no%rdx) ;[241] 25208 000240'01 104 00 0 00 000224 NOUT% ;[241] ; Length is in decimal 25209 000241'01 320 14 0 00 000243' ifje. s ;[241] ; Catch and suppress error 25210 000242'01 254 00 0 00 000246' 25211 000243'01 120 02 0 00 000000# smsg ();[241] ; Flag an error 25212 000244'01 260 17 0 00 000234* 25213 000060'02 000000000000# 25214 000061'02 777777 777775 25215 000045'03 077 054 040 000 000 25216 000245'01 254 00 0 00 000250' else. ;[241] ; Otherwise, worked fine 25217 000246'01 120 02 0 00 000000# smsg (<, >) ;[241] ; space over 25218 000247'01 260 17 0 00 000244* 25219 000062'02 000000000000# 25220 000063'02 777777 777776 25221 000046'03 054 040 000 000 000 25222 000250'01 endif. ;[241] ; End case NOUT% result handling 25223 000250'01 endif. ;[241] ; End case data packet 25224 25225 000250'01 200 02 0 00 000202* sndat1: move t2, sdatpt ; Load pointer to data area of packet 25226 000251'01 210 03 0 00 000235* movn t3, datlen ; Length of same 25227 000252'01 322 03 0 00 000256' ifn. t3 ; Ditch the SOUT% if nothing there 25228 000253'01 104 00 0 00 000053 SOUT% ; Spew that 25229 000254'01 320 12 0 00 000031' erjmpr deberr ; Or didn't 25230 000255'01 254 00 0 00 000260' else. ; That's odd 25231 000256'01 120 02 0 00 000000# smsg (<(null)>) ; Blat about it 25232 000257'01 260 17 0 00 000247* 25233 000064'02 000000000000# 25234 000065'02 777777 777772 25235 000047'03 050 156 165 154 154 25236 000260'01 endif. ; End case non-zero data k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 20:02 27-Nov-23 Page 11-1 K20PDC MAC 24-Nov-23 17:16 Various Commands, many mostly dinky 25237 000260'01 254 00 0 00 000227* retskp 25238 25239 25240 000261'01 snderr: remark Sending an "E" - Error (Fatal) 25241 000261'01 120 02 0 00 000000# smsg (<, Error>) 25242 000262'01 260 17 0 00 000257* 25243 000066'02 000000000000# 25244 000067'02 777777 777771 25245 000051'03 054 040 105 162 162 25246 000263'01 361 07 0 00 000260* sojl q3, RSKP ; Nothing here? That's fine 25247 000264'01 254 00 0 00 000233' callret sndata ; Dump it 25248 25249 25250 000265'01 sndfil: remark Sending a "F" - (Fetch or Name this File) 25251 000265'01 120 02 0 00 000000# smsg <, File: > ; The packet name 25252 000266'01 260 17 0 00 000262* 25253 000070'02 000000000000# 25254 000071'02 777777 777770 25255 000053'03 054 040 106 151 154 25256 000267'01 254 00 0 00 000250' callret sndat1 ; Dump it 25257 25258 25259 000270'01 sndinz: remark Sending an "I" - Initialization (here are my parameters) 25260 smsg (<, Initialization 25261 000270'01 120 02 0 00 000000# >) 25262 000271'01 260 17 0 00 000266* 25263 000072'02 000000000000# 25264 000073'02 777777 777752 25265 000055'03 054 040 111 156 151 25266 25267 000272'01 254 00 0 00 000524' callret params ; Break out the parameters 25268 25269 000273'01 sndnak: remark Sending an "N" - Negative acknowledgement 25270 000273'01 120 02 0 00 000000# smsg (<, Negative Acknowledge>) 25271 000274'01 260 17 0 00 000271* 25272 000074'02 000000000000# 25273 000075'02 777777 777752 25274 000062'03 054 040 116 145 147 25275 000275'01 254 00 0 00 000263* retskp 25276 25277 000276'01 sndrec: remark Sending an "R" - Receive (this file) 25278 000276'01 120 02 0 00 000000# smsg <, Receive: > ; The packet name 25279 000277'01 260 17 0 00 000274* 25280 000076'02 000000000000# 25281 000077'02 777777 777765 25282 000067'03 054 040 122 145 143 25283 000300'01 254 00 0 00 000250' callret sndat1 ; Dump it 25284 25285 25286 000301'01 sndini: remark Sending an "S" - Send Initiation 25287 smsg (<, Send Initiation 25288 000301'01 120 02 0 00 000000# >) 25289 000302'01 260 17 0 00 000277* 25290 000100'02 000000000000# 25291 000101'02 777777 777751 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 20:02 27-Nov-23 Page 11-2 K20PDC MAC 24-Nov-23 17:16 Various Commands, many mostly dinky 25292 000072'03 054 040 123 145 156 25293 25294 000303'01 254 00 0 00 000524' callret params ; Break out the parameters 25295 25296 000304'01 sndtxt: remark Sending an "X" - Display this data on terminal 25297 000304'01 120 02 0 00 000000# smsg <, Text: > ; ; The packet name 25298 000305'01 260 17 0 00 000302* 25299 000102'02 000000000000# 25300 000103'02 777777 777770 25301 000077'03 054 040 124 145 170 25302 000306'01 254 00 0 00 000250' callret sndat1 ; Dump it 25303 25304 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 20:02 27-Nov-23 Page 12 K20PDC MAC 24-Nov-23 17:16 Sending Acknowledgement table 25305 subttl Sending Acknowledgement table 25306 25307 .endps code ; Constant tables don't go in code 25308 .psect const ; they go into the constants psect 25309 25310 000104'02 000000000000# acktab: defack ; "A" - Attributes 25311 000105'02 000000000000# defack ; "B" - EOT 25312 000106'02 000000000000# defack ; "C" - Largely unimplemented host command 25313 000107'02 000000000000# defack ; "D" - Data 25314 000110'02 000000000000# errack ; "E" - Error packet 25315 000111'02 000000000000# defack ; "F" - File Header 25316 000112'02 000000000000# defack ; "G" - Sending a generic command 25317 000113'02 000000000000# defack ; "H" - Undefined 25318 000114'02 000000000000# inzack ; "I" - Info Packet 25319 000115'02 000000000000# UNDACK ; "J" - Undefined 25320 000116'02 000000000000# UNDACK ; "K" - Undefined 25321 000117'02 000000000000# UNDACK ; "L" - Undefined 25322 000120'02 000000000000# UNDACK ; "M" - Undefined 25323 000121'02 000000000000# errack ; "N" - Negative Acknowledge (NAK) 25324 000122'02 000000000000# UNDACK ; "O" - Undefined 25325 000123'02 000000000000# UNDACK ; "P" - Undefined 25326 000124'02 000000000000# UNDACK ; "Q" - Undefined 25327 000125'02 000000000000# defack ; "R" - Receive (GET) 25328 000126'02 000000000000# iniack ; "S" - Send 25329 000127'02 000000000000# defack ; "T" - Specially handled, somehow 25330 000130'02 000000000000# UNDACK ; "U" - Undefined 25331 000131'02 000000000000# UNDACK ; "V" - Undefined 25332 000132'02 000000000000# UNDACK ; "W" - Undefined 25333 000133'02 000000000000# defack ; "X" - Text Header 25334 000134'02 000000000000# errack ; "Y" - Acknowledge (ACK) 25335 000135'02 000000000000# defack ; "Z" - EOF 25336 25337 .endps const ; Done with constants 25338 .psect code ; Back to generating code 25339 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 20:02 27-Nov-23 Page 13 K20PDC MAC 24-Nov-23 17:16 Acknowledgement dispatch 25340 subttl Acknowledgement dispatch 25341 25342 000307'01 265 16 0 00 001037' sndack: saveac ; Needs some scratch 25343 000310'01 200 05 0 00 000250* move q1, sdatpt ; Load the pointer to the packet's data field 25344 000311'01 200 07 0 00 000251* move q3, datlen ; Number of initialization bytes 25345 25346 000312'01 200 04 0 00 000000# move t4, lstpkt ; Load what we should be acknowledging 25347 000313'01 405 04 0 00 000177 andi t4, 177 ;[235] Strip off any parity 25348 000314'01 200 03 0 00 000004 move t3, t4 ; Save a working copy 25349 000315'01 275 03 0 00 000101 subi t3, "A" ; Bring into offset range 25350 000316'01 254 00 1 03 000000# callret @acktab(t3) ; Continue the right routine 25351 25352 25353 000317'01 UNDACK: remark ; Packet type the Kermit-20 does not do 25354 000317'01 120 02 0 00 000000# smsg (<, Undefined Acknowlege for packet type: ">) ;" Fool font crock mode 25355 000320'01 260 17 0 00 000305* 25356 000136'02 000000000000# 25357 000137'02 777777 777727 25358 000101'03 054 040 125 156 144 25359 000321'01 254 00 0 00 000216' callret invsn1 ; Finish logging it 25360 25361 000322'01 errack: remark ; Shouldn't acknowledge "Y", "N" or "E" 25362 000322'01 120 02 0 00 000000# smsg (<, ERROR: should not be acknowledging a packet type: ">) ;" Fool 25363 000323'01 260 17 0 00 000320* 25364 000140'02 000000000000# 25365 000141'02 777777 777713 25366 000112'03 054 040 105 122 122 25367 000324'01 254 00 0 00 000216' callret invsn1 ; Finish logging it 25368 25369 000325'01 iniack: remark ; Response to "S" 25370 smsg (<, Send Initiation Acknowledgement 25371 000325'01 120 02 0 00 000000# >) 25372 000326'01 260 17 0 00 000323* 25373 000142'02 000000000000# 25374 000143'02 777777 777731 25375 000125'03 054 040 123 145 156 25376 25377 000327'01 254 00 0 00 000524' callret params ; Break out the parameters 25378 25379 000330'01 inzack: remark ; Response to "I" 25380 smsg (<, Initialization Acknowledgement 25381 000330'01 120 02 0 00 000000# >) 25382 000331'01 260 17 0 00 000326* 25383 000144'02 000000000000# 25384 000145'02 777777 777732 25385 000135'03 054 040 111 156 151 25386 25387 000332'01 254 00 0 00 000524' callret params ; Break out the parameters 25388 25389 000333'01 defack: remark ; All others is to print any contents 25390 000333'01 326 07 0 00 000351' ife. q3 ; If none, then nothing further to do 25391 000334'01 120 02 0 00 000000# smsg (<, Acknowledged packet type ">) ;" Fool font crock mode 25392 000335'01 260 17 0 00 000331* 25393 000146'02 000000000000# 25394 000147'02 777777 777744 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 20:02 27-Nov-23 Page 13-1 K20PDC MAC 24-Nov-23 17:16 Acknowledgement dispatch 25395 000145'03 054 040 101 143 153 25396 000336'01 200 02 0 00 000004 move t2, t4 ; Load what we're acknowledging 25397 000337'01 405 02 0 00 000177 andi t2, 177 ;[235] Strip off any parity 25398 000340'01 260 17 0 00 000221* call BOUTI% ; Append to log 25399 000341'01 302 02 0 00 000107 caie t2, "G" ; Was this a generic command? 25400 000342'01 254 00 0 00 000346' ifskp. ; It was, so provide a little more clarity 25401 000343'01 200 02 0 00 000000# move t2, lstgen ; Load the kind of last generic 25402 000344'01 405 02 0 00 000177 andi t2, 177 ;[235] Strip off any parity 25403 000345'01 260 17 0 00 000340* call BOUTI% ; Append to log 25404 000346'01 endif. 25405 000346'01 201 02 0 00 000042 movei t2, .chdbq ; Closing double quote 25406 000347'01 260 17 0 00 000345* call BOUTI% ; Append that, too 25407 000350'01 254 00 0 00 000275* retskp ; Worked, wonderfully... 25408 000351'01 endif. 25409 25410 000351'01 120 02 0 00 000000# smsg (<, Ack(>) ; Short acknowledgement 25411 000352'01 260 17 0 00 000335* 25412 000150'02 000000000000# 25413 000151'02 777777 777772 25414 000153'03 054 040 101 143 153 25415 000353'01 200 02 0 00 000004 move t2, t4 ; Load what we're acknowledging 25416 000354'01 405 02 0 00 000177 andi t2, 177 ;[235] Strip off any parity 25417 000355'01 260 17 0 00 000347* call BOUTI% ; Append to log 25418 000356'01 302 02 0 00 000107 caie t2, "G" ; Was this a generic command? 25419 000357'01 254 00 0 00 000363' ifskp. ; It was, so provide a little more clarity 25420 000360'01 200 02 0 00 000000# move t2, lstgen ; By getting the last generic command 25421 000361'01 405 02 0 00 000177 andi t2, 177 ;[235] Strip off any parity 25422 000362'01 260 17 0 00 000355* call BOUTI% ; Append to log 25423 000363'01 endif. 25424 000363'01 120 02 0 00 000000# smsg (<), >) ; Close and space over 25425 000364'01 260 17 0 00 000352* 25426 000152'02 000000000000# 25427 000153'02 777777 777775 25428 000155'03 051 054 040 000 000 25429 25430 000365'01 200 02 0 00 000005 move t2, q1 ; Load the pointer to the data area 25431 000366'01 210 03 0 00 000007 movn t3, q3 ; Negative length of data area 25432 000367'01 104 00 0 00 000053 SOUT% ; Get the response into the log 25433 000370'01 320 12 0 00 000031' erjmpr deberr ; Or didn't... 25434 000371'01 254 00 0 00 000350* retskp ; Worked!! 25435 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 20:02 27-Nov-23 Page 14 K20PDC MAC 24-Nov-23 17:16 Sending a "Z" - End of File 25436 subttl Sending a "Z" - End of File 25437 25438 000372'01 120 02 0 00 000000# sndeof: smsg (<, End of File>) 25439 000373'01 260 17 0 00 000364* 25440 000154'02 000000000000# 25441 000155'02 777777 777763 25442 000156'03 054 040 105 156 144 25443 000374'01 200 05 0 00 000310* move q1, sdatpt ; Load the pointer the packet's data field 25444 000375'01 200 07 0 00 000311* move q3, datlen ; Number of initialization bytes 25445 ; See if being told to discard file 25446 000376'01 361 07 0 00 000371* sojl q3, RSKP ; But only if there is a character 25447 000377'01 134 06 0 00 000005 ildb q2, q1 ; Load the action character 25448 000400'01 405 06 0 00 000177 andi q2, 177 ;[235] Strip off any parity 25449 000401'01 302 06 0 00 000104 caie q2, "D" ; Got told to discard? 25450 000402'01 254 00 0 00 000406' ifskp. ; We did 25451 000403'01 120 02 0 00 000000# smsg (<, Discarding>) ; Blat about it 25452 000404'01 260 17 0 00 000373* 25453 000156'02 000000000000# 25454 000157'02 777777 777764 25455 000161'03 054 040 104 151 163 25456 000405'01 254 00 0 00 000411' else. ; Otherwise, something odd 25457 000406'01 120 02 0 00 000000# smsg (<, >) ; So blat about that 25458 000407'01 260 17 0 00 000404* 25459 000160'02 000000000000# 25460 000161'02 777777 777776 25461 000164'03 054 040 000 000 000 25462 000410'01 254 00 0 00 000250' callret sndat1 ; and put into the log 25463 000411'01 endif. ; End of Discard decision 25464 25465 000411'01 254 00 0 00 000376* retskp ; Successfully decode the packet 25466 25467 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 20:02 27-Nov-23 Page 15 K20PDC MAC 24-Nov-23 17:16 Generic Send Packet Types 25468 subttl Generic Send Packet Types 25469 25470 .endps code ; Constant tables don't go in code 25471 .psect const ; they go into the constants psect 25472 25473 000162'02 000000000000# sgenpt: genpwd ; A - PWD 25474 000163'02 000000000000# INVGEN ; B - Undefined 25475 000164'02 000000000000# gencwd ; C - CWD 25476 000165'02 000000000000# gendir ; D - Directory 25477 000166'02 000000000000# gendel ; E - Erase (delete) 25478 000167'02 000000000000# genfin ; F - Finish 25479 000170'02 000000000000# INVGEN ; G - Undefined 25480 000171'02 000000000000# genhlp ; H - Help 25481 000172'02 000000000000# INVGEN ; I - Login (not yet implemented) 25482 000173'02 000000000000# INVGEN ; J - Journal control (nyi) 25483 000174'02 000000000000# INVGEN ; K - Copy (nyi) 25484 000175'02 000000000000# genbye ; L - Logout, Bye 25485 000176'02 000000000000# INVGEN ; M - Undefined 25486 000177'02 000000000000# INVGEN ; N - Undefined 25487 000200'02 000000000000# INVGEN ; O - Undefined 25488 000201'02 000000000000# INVGEN ; P - Program invocation (nyi) 25489 000202'02 000000000000# gensta ; Q - Server status query 25490 000203'02 000000000000# INVGEN ; R - Rename (nyi) 25491 000204'02 000000000000# INVGEN ; S - Undefined 25492 000205'02 000000000000# INVGEN ; T - Type 25493 000206'02 000000000000# gendsk ; U - Disk Usage 25494 000207'02 000000000000# INVGEN ; V - Variable Set/Query 25495 000210'02 000000000000# INVGEN ; W - Who (Finger) 25496 000211'02 000000000000# INVGEN ; X - Undefined 25497 000212'02 000000000000# INVGEN ; Y - Undefined 25498 000213'02 000000000000# INVGEN ; Z - Undefined 25499 25500 .endps const ; Done with constants 25501 .psect code ; Back to generating code 25502 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 20:02 27-Nov-23 Page 16 K20PDC MAC 24-Nov-23 17:16 Send Generic Command 25503 subttl Send Generic Command 25504 25505 000412'01 sndgen: remark t1, p3 ; Already loaded with JFN 25506 000412'01 120 02 0 00 000000# smsg <, Generic, > ; A generic packet type 25507 000413'01 260 17 0 00 000407* 25508 000214'02 000000000000# 25509 000215'02 777777 777765 25510 000165'03 054 040 107 145 156 25511 25512 000414'01 371 00 0 00 000007 sosl q3 ; Malformed? 25513 000415'01 254 00 0 00 000421' ifskp. ; It is 25514 000416'01 120 02 0 00 000000# smsg (<(% No action character)>) 25515 000417'01 260 17 0 00 000413* 25516 000216'02 000000000000# 25517 000217'02 777777 777751 25518 000170'03 050 045 040 116 157 25519 000420'01 254 00 0 00 000411* retskp ; Handled malformed character OK 25520 000421'01 endif. 25521 25522 000421'01 134 04 0 00 000005 ildb t4, q1 ; Pick up the generic command character 25523 000422'01 405 04 0 00 000177 andi t4, 177 ;[235] Strip off any parity 25524 000423'01 301 04 0 00 000101 cail t4, "A" ; Before "A"? 25525 000424'01 303 04 0 00 000132 caile t4, "Z" ; or after "Z"? 25526 000425'01 254 00 0 00 000432' jrst invgen ; Can't do the jump table 25527 000426'01 202 04 0 00 000000# movem t4, lstgen ; Set last generic 25528 25529 000427'01 200 03 0 00 000004 move t3, t4 ; Save a copy in case of error 25530 000430'01 275 03 0 00 000101 subi t3, "A" ; Bring into offset range 25531 000431'01 254 00 1 03 000000# callret @sgenpt(t3) ; Invoke the correct decoding routine 25532 25533 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 20:02 27-Nov-23 Page 17 K20PDC MAC 24-Nov-23 17:16 Invalid Generic message type 25534 subttl Invalid Generic message type 25535 25536 000432'01 120 02 0 00 000000# INVGEN: smsg () ;" Fool font crock mode 25537 000433'01 260 17 0 00 000417* 25538 000220'02 000000000000# 25539 000221'02 777777 777751 25540 000175'03 111 156 166 141 154 25541 000434'01 254 00 0 00 000216' callret invsn1 ; Finish logging it 25542 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 20:02 27-Nov-23 Page 18 K20PDC MAC 24-Nov-23 17:16 Trivial Generic Requests 25543 subttl Trivial Generic Requests 25544 25545 000435'01 genpwd: remark "A" 25546 000435'01 120 02 0 00 000000# smsg () 25547 000436'01 260 17 0 00 000433* 25548 000222'02 000000000000# 25549 000223'02 777777 777751 25550 000202'03 120 162 151 156 164 25551 000437'01 254 00 0 00 000420* retskp 25552 25553 000440'01 gencwd: remark "C" 25554 000440'01 120 02 0 00 000000# smsg () 25555 000441'01 260 17 0 00 000436* 25556 000224'02 000000000000# 25557 000225'02 777777 777750 25558 000207'03 103 150 141 156 147 25559 000442'01 260 17 0 00 000472' call genarg ; Print the working directory, if any 25560 000443'01 600 00 0 00 000000 nop ; Ignore error 25561 000444'01 254 00 0 00 000437* retskp 25562 25563 000445'01 gendir: remark "D" 25564 000445'01 120 02 0 00 000000# smsg () 25565 000446'01 260 17 0 00 000441* 25566 000226'02 000000000000# 25567 000227'02 777777 777767 25568 000214'03 104 151 162 145 143 25569 000447'01 254 00 0 00 000472' callret genarg 25570 25571 000450'01 gendel: remark "E" 25572 000450'01 120 02 0 00 000000# smsg () 25573 000451'01 260 17 0 00 000446* 25574 000230'02 000000000000# 25575 000231'02 777777 777773 25576 000216'03 105 162 141 163 145 25577 000452'01 254 00 0 00 000472' callret genarg 25578 25579 000453'01 genfin: remark "F" 25580 000453'01 120 02 0 00 000000# smsg () 25581 000454'01 260 17 0 00 000451* 25582 000232'02 000000000000# 25583 000233'02 777777 777772 25584 000220'03 106 151 156 151 163 25585 000455'01 254 00 0 00 000444* retskp 25586 25587 000456'01 genhlp: remark "H" 25588 000456'01 120 02 0 00 000000# smsg () 25589 000457'01 260 17 0 00 000454* 25590 000234'02 000000000000# 25591 000235'02 777777 777774 25592 000222'03 110 145 154 160 000 25593 000460'01 254 00 0 00 000455* retskp 25594 25595 000461'01 genbye: remark "L" 25596 000461'01 120 02 0 00 000000# smsg () 25597 000462'01 260 17 0 00 000457* k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 20:02 27-Nov-23 Page 18-1 K20PDC MAC 24-Nov-23 17:16 Trivial Generic Requests 25598 000236'02 000000000000# 25599 000237'02 777777 777772 25600 000223'03 114 157 147 157 165 25601 000463'01 254 00 0 00 000460* retskp 25602 25603 000464'01 gensta: remark "Q" 25604 000464'01 120 02 0 00 000000# smsg () 25605 000465'01 260 17 0 00 000462* 25606 000240'02 000000000000# 25607 000241'02 777777 777755 25608 000225'03 123 145 162 166 145 25609 000466'01 254 00 0 00 000463* retskp 25610 25611 000467'01 gendsk: remark "U" 25612 000467'01 120 02 0 00 000000# smsg () 25613 000470'01 260 17 0 00 000465* 25614 000242'02 000000000000# 25615 000243'02 777777 777766 25616 000231'03 104 151 163 153 040 25617 000471'01 254 00 0 00 000466* retskp 25618 25619 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 20:02 27-Nov-23 Page 19 K20PDC MAC 24-Nov-23 17:16 Generic Argument Decode 25620 subttl Generic Argument Decode 25621 25622 000472'01 361 07 0 00 000471* genarg: sojl q3, RSKP ; If nothing left, we're done 25623 000473'01 134 04 0 00 000005 ildb t4, q1 ; Pick up the length of the argument 25624 000474'01 405 04 0 00 000177 andi t4, 177 ;[235] Strip off any parity 25625 25626 000475'01 200 12 0 00 000000* move p2, rquote ; Let's assume we are receiving 25627 000476'01 302 11 0 00 000122 caie p1, "R" ; However, are we? 25628 000477'01 200 12 0 00 000000* move p2, squote ; Nope, we are sending 25629 25630 000500'01 do. ; Enter loop context for each argument 25631 000500'01 312 12 0 00 000004 came p2, t4 ; Is the length the same as the quote 25632 000501'01 254 00 0 00 000505' ifskp. ; They are, so then the length has to be quoted 25633 000502'01 361 07 0 00 000472* sojl q3, RSKP ; If nothing left, we're done 25634 000503'01 134 04 0 00 000005 ildb t4, q1 ; Pick up the length of this argument 25635 000504'01 405 04 0 00 000177 andi t4, 177 ;[235] Strip off any parity 25636 000505'01 endif. ; End case quoted length 25637 000505'01 275 04 0 00 000040 subi t4, .chspc ; Bring into numeric range 25638 000506'01 323 04 0 00 000502* jumple t4, RSKP ; No argument, depart 25639 000507'01 120 02 0 00 000000# smsg (<, >) ; Punctuate the argument 25640 000510'01 260 17 0 00 000470* 25641 000244'02 000000000000# 25642 000245'02 777777 777776 25643 000234'03 054 040 000 000 000 25644 000511'01 200 02 0 00 000005 move t2, q1 ; Load the properly advanced pointer 25645 000512'01 210 03 0 00 000004 movn t3, t4 ; Load the negative length 25646 000513'01 104 00 0 00 000053 SOUT% ; Put into the log 25647 000514'01 320 14 0 00 000000* erjmps r ; Shouldn't happen, JFN was fine 25648 000515'01 200 05 0 00 000002 move q1, t2 ; Update packet pointer 25649 000516'01 274 07 0 00 000004 sub q3, t4 ; Count off the characters we did 25650 000517'01 361 07 0 00 000506* sojl q3, RSKP ; See if we have another field and exit if not 25651 000520'01 134 04 0 00 000005 ildb t4, q1 ; Pick up the length of the argument 25652 000521'01 405 04 0 00 000177 andi t4, 177 ;[235] Strip off any parity 25653 000522'01 254 00 0 00 000500' loop. ; And go take care of that 25654 000523'01 enddo. ; End loop lexical context 25655 25656 000523'01 254 00 0 00 000517* retskp ; Superstition 25657 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 20:02 27-Nov-23 Page 20 K20PDC MAC 24-Nov-23 17:16 Break out parameters for S and I packets 25658 subttl Break out parameters for S and I packets 25659 25660 ; Call: 25661 ; 25662 ; q1/ Pointer to packet's data field 25663 ; *q2/ Used internally for packet characters 25664 ; q3/ Number of bytes in packet's data field 25665 ; 25666 ; Return: 25667 ; 25668 ; +1 Some kind of failure 25669 ; +2 Successfully decoded 25670 25671 000524'01 120 02 0 00 000000# params: smsg () 25672 000525'01 260 17 0 00 000510* 25673 000246'02 000000000000# 25674 000247'02 777777 777770 25675 000235'03 120 141 162 141 155 25676 000526'01 200 02 0 00 000375* move t2, datlen 25677 000527'01 201 03 0 00 000012 movei t3, ^d10 25678 000530'01 104 00 0 00 000224 NOUT% 25679 000531'01 320 12 0 00 000514* erjmpr r 25680 25681 000532'01 361 07 0 00 000523* sojl q3, RSKP ; Only if there 25682 000533'01 134 06 0 00 000005 ildb q2, q1 ; Load the maximum length 25683 000534'01 405 06 0 00 000177 andi q2, 177 ;[235] Strip off any parity 25684 000535'01 120 02 0 00 000000# smsg (<, MaxL: >) 25685 000536'01 260 17 0 00 000525* 25686 000250'02 000000000000# 25687 000251'02 777777 777770 25688 000237'03 054 040 115 141 170 25689 000537'01 200 02 0 00 000006 move t2, q2 25690 000540'01 275 02 0 00 000040 subi t2, .chspc 25691 000541'01 201 03 0 00 000012 movei t3, ^d10 25692 000542'01 104 00 0 00 000224 NOUT% ; 1 Packet size 25693 000543'01 320 12 0 00 000531* erjmpr r 25694 25695 000544'01 361 07 0 00 000532* sojl q3, RSKP ; Only if there 25696 000545'01 134 06 0 00 000005 ildb q2, q1 ; Load the time out 25697 000546'01 405 06 0 00 000177 andi q2, 177 ;[235] Strip off any parity 25698 000547'01 120 02 0 00 000000# smsg (<, TimO: >) 25699 000550'01 260 17 0 00 000536* 25700 000252'02 000000000000# 25701 000253'02 777777 777770 25702 000241'03 054 040 124 151 155 25703 000551'01 200 02 0 00 000006 move t2, q2 25704 000552'01 275 02 0 00 000040 subi t2, .chspc 25705 000553'01 201 03 0 00 000012 movei t3, ^d10 25706 000554'01 104 00 0 00 000224 NOUT% ; 2 Time out 25707 000555'01 320 12 0 00 000543* erjmpr r 25708 25709 000556'01 361 07 0 00 000544* sojl q3, RSKP ; Only if there 25710 000557'01 134 06 0 00 000005 ildb q2, q1 ; Load the number of padding characters 25711 000560'01 405 06 0 00 000177 andi q2, 177 ;[235] Strip off any parity 25712 000561'01 120 02 0 00 000000# smsg (<, Npad: >) k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 20:02 27-Nov-23 Page 20-1 K20PDC MAC 24-Nov-23 17:16 Break out parameters for S and I packets 25713 000562'01 260 17 0 00 000550* 25714 000254'02 000000000000# 25715 000255'02 777777 777770 25716 000243'03 054 040 116 160 141 25717 000563'01 200 02 0 00 000006 move t2, q2 25718 000564'01 275 02 0 00 000040 subi t2, .chspc 25719 000565'01 201 03 0 00 000012 movei t3, ^d10 25720 000566'01 104 00 0 00 000224 NOUT% ; 3 Padding (character count) 25721 000567'01 320 12 0 00 000555* erjmpr r 25722 25723 000570'01 361 07 0 00 000556* sojl q3, RSKP ; Only if there 25724 000571'01 134 06 0 00 000005 ildb q2, q1 ; Load the padding character 25725 000572'01 405 06 0 00 000177 andi q2, 177 ;[235] Strip off any parity 25726 000573'01 120 02 0 00 000000# smsg (<, PadC: >) ; 4 25727 000574'01 260 17 0 00 000562* 25728 000256'02 000000000000# 25729 000257'02 777777 777770 25730 000245'03 054 040 120 141 144 25731 000575'01 200 02 0 00 000006 move t2, q2 25732 000576'01 271 02 0 00 000100 addi t2, ^o100 ; It's in excess 64 (decimal) 25733 000577'01 405 02 0 00 000177 andi t2, ^o177 ; Clip if it went to eight bits 25734 000600'01 260 17 0 00 000771' call outc ; Output as a control character 25735 25736 000601'01 361 07 0 00 000570* sojl q3, RSKP ; Only if there 25737 000602'01 134 06 0 00 000005 ildb q2, q1 ; Load the packet terminator 25738 000603'01 405 06 0 00 000177 andi q2, 177 ;[235] Strip off any parity 25739 000604'01 120 02 0 00 000000# smsg (<, EOL: >) ; 5 25740 000605'01 260 17 0 00 000574* 25741 000260'02 000000000000# 25742 000261'02 777777 777771 25743 000247'03 054 040 105 117 114 25744 000606'01 200 02 0 00 000006 move t2, q2 25745 000607'01 275 02 0 00 000040 subi t2, .chspc ; Bring into control range 25746 000610'01 260 17 0 00 000771' call outc ; Output as a control character 25747 25748 000611'01 361 07 0 00 000601* sojl q3, RSKP ; Only if there 25749 000612'01 134 06 0 00 000005 ildb q2, q1 ; Load the control prefix 25750 000613'01 405 06 0 00 000177 andi q2, 177 ;[235] Strip off any parity 25751 000614'01 120 02 0 00 000000# smsg (<, Qctl: >) ; 6 25752 000615'01 260 17 0 00 000605* 25753 000262'02 000000000000# 25754 000263'02 777777 777770 25755 000251'03 054 040 121 143 164 25756 000616'01 200 02 0 00 000006 move t2, q2 25757 000617'01 260 17 0 00 000771' call outc ; Output as a control character 25758 25759 000620'01 361 07 0 00 000611* sojl q3, RSKP ; Only if there 25760 000621'01 134 06 0 00 000005 ildb q2, q1 ; Load the eight bit quote 25761 000622'01 405 06 0 00 000177 andi q2, 177 ;[235] Strip off any parity 25762 000623'01 120 02 0 00 000000# smsg (<, Qbin: >) ; 7 25763 000624'01 260 17 0 00 000615* 25764 000264'02 000000000000# 25765 000265'02 777777 777770 25766 000253'03 054 040 121 142 151 25767 000625'01 200 02 0 00 000006 move t2, q2 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 20:02 27-Nov-23 Page 20-2 K20PDC MAC 24-Nov-23 17:16 Break out parameters for S and I packets 25768 000626'01 302 02 0 00 000131 caie t2, "Y" ; Am I agreeing? 25769 000627'01 254 00 0 00 000633' ifskp. ; I'm agreeable 25770 000630'01 120 02 0 00 000000# smsg 25771 000631'01 260 17 0 00 000624* 25772 000266'02 000000000000# 25773 000267'02 777777 777775 25774 000255'03 131 145 163 000 000 25775 000632'01 254 00 0 00 000641' else. ; Otherwise, could be other things 25776 000633'01 302 02 0 00 000116 caie t2, "N" ; Am I refusing 8 bit 25777 000634'01 254 00 0 00 000640' ifskp. ; I'm disagreeble 25778 000635'01 120 02 0 00 000000# smsg 25779 000636'01 260 17 0 00 000631* 25780 000270'02 000000000000# 25781 000271'02 777777 777776 25782 000256'03 116 157 000 000 000 25783 000637'01 254 00 0 00 000641' else. ; Neither one is the 8 bit quote character 25784 000640'01 260 17 0 00 000771' call outc ; Output as a possible control character 25785 000641'01 endif. ; End case No or actual character 25786 000641'01 endif. ; End case Yes or something else 25787 25788 000641'01 361 07 0 00 000620* sojl q3, RSKP ; Only if there 25789 000642'01 134 06 0 00 000005 ildb q2, q1 ; Load the block check type 25790 000643'01 405 06 0 00 000177 andi q2, 177 ;[235] Strip off any parity 25791 000644'01 120 02 0 00 000000# smsg (<, ChkT: >) ; 8 25792 000645'01 260 17 0 00 000636* 25793 000272'02 000000000000# 25794 000273'02 777777 777770 25795 000257'03 054 040 103 150 153 25796 000646'01 200 04 0 00 000006 move t4, q2 25797 000647'01 120 02 0 00 000000# dxtext (t2, ) 25798 000274'02 000000000000# 25799 000275'02 777777 777761 25800 000261'03 040 074 117 165 164 25801 000650'01 306 04 0 00 000061 cain t4, "1" 25802 000651'01 120 02 0 00 000000# dxtext (t2,<6-bit>) 25803 000276'02 000000000000# 25804 000277'02 777777 777773 25805 000265'03 066 055 142 151 164 25806 000652'01 306 04 0 00 000062 cain t4, "2" 25807 000653'01 120 02 0 00 000000# dxtext (t2,<12-bit>) 25808 000300'02 000000000000# 25809 000301'02 777777 777772 25810 000267'03 061 062 055 142 151 25811 000654'01 306 04 0 00 000063 cain t4, "3" 25812 000655'01 120 02 0 00 000000# dxtext (t2,<16-bit CRC>) 25813 000302'02 000000000000# 25814 000303'02 777777 777766 25815 000271'03 061 066 055 142 151 25816 000656'01 260 17 0 00 000645* call %%smsg ; Handle as if I did an smsg 25817 25818 000657'01 361 07 0 00 000641* sojl q3, RSKP ; Only if there 25819 000660'01 134 06 0 00 000005 ildb q2, q1 ; Load the repeat count prefix 25820 000661'01 405 06 0 00 000177 andi q2, 177 ;[235] Strip off any parity 25821 000662'01 120 02 0 00 000000# smsg (<, Rept: >) ; 9 25822 000663'01 260 17 0 00 000656* k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 20:02 27-Nov-23 Page 20-3 K20PDC MAC 24-Nov-23 17:16 Break out parameters for S and I packets 25823 000304'02 000000000000# 25824 000305'02 777777 777770 25825 000274'03 054 040 122 145 160 25826 000664'01 200 02 0 00 000006 move t2, q2 25827 000665'01 260 17 0 00 000362* call BOUTI% 25828 25829 remark Extended capabilities 25830 25831 000666'01 361 07 0 00 000657* sojl q3, RSKP ; If nothing left, we're done 25832 000667'01 134 06 0 00 000005 ildb q2, q1 ; Otherwise, pick up first capability mask 25833 000670'01 405 06 0 00 000177 andi q2, 177 ;[235] Strip off any parity 25834 000671'01 275 06 0 00 000040 subi q2, .chspc ; Bring into numeric range 25835 000672'01 606 06 0 00 000002 trnn q2, 2 ; Is the Long Packets capability bit on? 25836 000673'01 254 00 0 00 000666* retskp ; No, we can't do anything else 25837 000674'01 120 02 0 00 000000# smsg (<, Long: >) ; 10 25838 000675'01 260 17 0 00 000663* 25839 000306'02 000000000000# 25840 000307'02 777777 777770 25841 000276'03 054 040 114 157 156 25842 25843 000676'01 415 16 0 00 000720' block. ; Enter block context for better control flow 25844 000677'01 261 17 0 00 000016 25845 000700'01 361 07 0 00 000567* sojl q3, r ; Stop if Sliding Windows isn't there 25846 000701'01 134 06 0 00 000005 ildb q2, q1 ; Yet ignore it because we don't do it 25847 000702'01 405 06 0 00 000177 andi q2, 177 ;[235] Strip off any parity 25848 000703'01 361 07 0 00 000700* sojl q3, r ; Stop if high order is not there 25849 000704'01 134 02 0 00 000005 ildb t2, q1 ; Load the high order 25850 000705'01 405 02 0 00 000177 andi t2, 177 ;[235] Strip off any parity 25851 000706'01 275 02 0 00 000040 subi t2, .chspc ; Bring into numeric range 25852 000707'01 221 02 0 00 000137 imuli t2, ^d95 ; High digit is base 94 25853 000710'01 361 07 0 00 000703* sojl q3, r ; Fail if low order is not there 25854 000711'01 134 03 0 00 000005 ildb t3, q1 ; It's there, load it 25855 000712'01 405 03 0 00 000177 andi t3, 177 ;[235] Strip off any parity 25856 000713'01 275 03 0 00 000040 subi t3, .chspc ; Bring into numeric range 25857 000714'01 270 02 0 00 000003 add t2, t3 ; Combine with high order 25858 000715'01 201 03 0 00 000012 movei t3, ^d10 ; Base 10 25859 000716'01 254 00 0 00 000673* retskp ; Flag we're actually doing long windows 25860 000717'01 263 17 0 00 000000 endbk. ; End block context 25861 000720'01 254 00 0 00 000725' ifskp. ; Have a number to type 25862 000721'01 104 00 0 00 000224 NOUT% ; Type it 25863 000722'01 320 12 0 00 000710* erjmpr r ; Or not 25864 000723'01 254 00 0 00 000716* retskp ; Succeed 25865 000724'01 254 00 0 00 000730' else. ; Otherwise, this is a request 25866 000725'01 120 02 0 00 000000# smsg () ; Say we'll accept it 25867 000726'01 260 17 0 00 000675* 25868 000310'02 000000000000# 25869 000311'02 777777 777767 25870 000300'03 101 166 141 151 154 25871 000727'01 254 00 0 00 000723* retskp ; This is OK, too 25872 000730'01 endif. 25873 25874 000730'01 254 00 0 00 000727* retskp ; This is superstition 25875 25876 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 20:02 27-Nov-23 Page 21 K20PDC MAC 24-Nov-23 17:16 Packet Header 25877 subttl Packet Header 25878 25879 ; t4/ "R" or "S", depending on what we're doing 25880 25881 000731'01 200 01 0 00 000013 pkthdr: move t1, p3 ; Load the logging JFN 25882 000732'01 120 02 0 00 000000# smsg <, type: > ; The packet type 25883 000733'01 260 17 0 00 000726* 25884 000312'02 000000000000# 25885 000313'02 777777 777770 25886 000302'03 054 040 164 171 160 25887 000734'01 200 02 0 00 000162* move t2, type ; Message Type 25888 000735'01 405 02 0 00 000177 andi t2, 177 ;[235] Strip off any parity 25889 000736'01 260 17 0 00 000665* call BOUTI% ; Will further expand downstream 25890 000737'01 200 04 0 00 000002 move t4, t2 ; Save a copy of the type 25891 25892 000740'01 120 02 0 00 000000# smsg <, seq: > ; The sequence number 25893 000741'01 260 17 0 00 000733* 25894 000314'02 000000000000# 25895 000315'02 777777 777771 25896 000304'03 054 040 163 145 161 25897 000742'01 200 02 0 00 000000* move t2, sseqn ; Load the Sending Packet Number 25898 000743'01 302 04 0 00 000123 caie t4, "S" ; But are we? 25899 000744'01 200 02 0 00 000000* move t2, num ; No, so load the received Packet Number 25900 000745'01 201 03 0 00 000012 movei t3, ^d10 ; It's in base 10 25901 000746'01 104 00 0 00 000224 NOUT% ; Type that 25902 000747'01 320 12 0 00 000031' erjmpr deberr ; Or not... 25903 25904 000750'01 120 02 0 00 000000# smsg <, len: > ; Total packet length 25905 000751'01 260 17 0 00 000741* 25906 000316'02 000000000000# 25907 000317'02 777777 777771 25908 000306'03 054 040 154 145 156 25909 000752'01 200 02 0 00 000000* move t2, pktlen ; Includes the checksum 25910 000753'01 201 03 0 00 000012 movei t3, ^d10 ; It's in base 10 25911 000754'01 104 00 0 00 000224 NOUT% ; Type that 25912 000755'01 320 12 0 00 000031' erjmpr deberr ; Or not... 25913 25914 000756'01 336 00 0 00 000000* ifmn. islong ; Was this a long packet? 25915 000757'01 254 00 0 00 000762' 25916 000760'01 201 02 0 00 000114 movei t2, "L" ; Load flag for long packet 25917 000761'01 260 17 0 00 000736* call BOUTI% ; Append it as a c-like suffix 25918 000762'01 endif. ; End case long packet 25919 25920 000762'01 120 02 0 00 000000# smsg <, Blk: > ; Computed block check 25921 000763'01 260 17 0 00 000751* 25922 000320'02 000000000000# 25923 000321'02 777777 777771 25924 000310'03 054 040 102 154 153 25925 000764'01 200 02 0 00 000000* move t2, blkchk ; Load it 25926 000765'01 201 03 0 00 000012 movei t3, ^d10 ; We'll just use base 10 25927 000766'01 104 00 0 00 000224 NOUT% ; Type it 25928 000767'01 320 12 0 00 000031' erjmpr deberr ; Or not 25929 25930 000770'01 254 00 0 00 000730* retskp ; Worked 25931 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 20:02 27-Nov-23 Page 22 K20PDC MAC 24-Nov-23 17:16 outc -- Output a single character, using ^X notation, DEL, etc. 25932 subttl outc -- Output a single character, using ^X notation, DEL, etc. 25933 25934 ; Call: 25935 ; 25936 ; t1/ JFN 25937 ; t2/ Character to frobinicate 25938 25939 extern BOUTI% ; In case this is going into a string 25940 25941 000771'01 405 02 0 00 000177 outc: andi t2, 177 ;[235] Strip off any parity 25942 000772'01 302 02 0 00 000177 caie t2, .chdel ; A rubout? 25943 000773'01 254 00 0 00 000777' ifskp. ; It is 25944 000774'01 120 02 0 00 000000# smsg ; Show it this way (^? being confusing?) 25945 000775'01 260 17 0 00 000763* 25946 000322'02 000000000000# 25947 000323'02 777777 777775 25948 000312'03 104 105 114 000 000 25949 000776'01 263 17 0 00 000000 ret ; Succeed 25950 000777'01 endif. 25951 25952 000777'01 301 02 0 00 000040 cail t2, .chspc ; Is it a control character? 25953 001000'01 254 00 0 00 001006' ifskp. ; It is 25954 001001'01 261 17 0 00 000002 push p, t2 ; Save the character 25955 001002'01 201 02 0 00 000136 movei t2, "^" ; Load the control quote 25956 001003'01 260 17 0 00 000761* call BOUTI% ; Output that 25957 001004'01 262 17 0 00 000002 pop p, t2 ; Restore original character 25958 001005'01 435 02 0 00 000100 ori t2, ^o100 ; Bring into printable range 25959 001006'01 endif. 25960 25961 001006'01 254 00 0 00 001003* callret BOUTI% ; Output possibly controlified character 25962 25963 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 20:02 27-Nov-23 Page 23 K20PDC MAC 24-Nov-23 17:16 Vestigial Code found to be largely uninformative 25964 subttl Vestigial Code found to be largely uninformative 25965 25966 repeat 0,< ; Mark character doesn't change 25967 move t1, p3 ; Load the logging JFN 25968 smsg < 25969 sop: > ; Indicate what should start the packet 25970 move t1, rsthdr ; Load Receive Start of Packet character 25971 rot t1, -^d8 ; Position as an eight bit ASCII string 25972 movem t1, sop8st ; And store it 25973 25974 dmove t1, [ ^d1 ; We are only doing one dinky character 25975 point 8, sop8st ] ; And the source is what we just built 25976 call s8ccv7 ; String eight controlified convert to seven 25977 ret ; Shouldn't fail, but better give up 25978 >;;repeat 0 25979 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 20:02 27-Nov-23 Page 24 K20PDC MAC 24-Nov-23 17:16 Code .psect close out 25980 subttl Code .psect close out 25981 25982 xlist ; Save the trees!! 25983 list ; Resume listing 25984 25985 .endps code ; Close the code .psect 25986 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 20:02 27-Nov-23 Page 25 K20PDC MAC 24-Nov-23 17:16 Module local working storage 25987 subttl Module local working storage 25988 25989 .psect data ; Open data storage 25990 000000'04 lstpkt: block 1 ; Last packet type 25991 000001'04 lstgen: block 1 ; Last generic type 25992 repeat 0,< 25993 sop8st: block 2 ; Start of Packet character as an 8 bit ASCII string 25994 > 25995 .endps data ; Close out the data .psect 25996 25997 .xcmsy ; Ditch any superfluous MACSYM junk 25998 end ; End of module NO ERRORS DETECTED PROGRAM BREAK IS 000000 PSECT 1 BREAK IS 001051 FOR CODE PSECT 2 BREAK IS 000324 FOR CONST PSECT 3 BREAK IS 000313 FOR ETEXT PSECT 4 BREAK IS 000002 FOR DATA CPU TIME USED 00:00.403 93P CORE USED k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 20:02 27-Nov-23 Page S-1 K20PDC MAC 24-Nov-23 17:16 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 20:02 27-Nov-23 Page S-2 K20PDC MAC 24-Nov-23 17:16 SYMBOL TABLE FOR PSECT CODE BLKCHK 000764' ext SPDECD 000152' BOUTI% 001006' ext SQUOTE 000477' ext DATLEN 000526' ext SSEQN 000742' ext DATPTR 000117' ext TYPE 000734' ext DEBERR 000031' ent UNDACK 000317' DEFACK 000333' $CLOSD 000046' ext DIAMSG 000000' ent %%SMSG 000775' ext DIAMSZ 000026' ..0005 000013' spd ERRACK 000322' ..0006 000016' spd FINTIM 000155' ext ..0007 000017' spd GENARG 000472' ..0014 000026' spd GENBYE 000461' ..0023 000067' spd GENCWD 000440' ..0030 000076' spd GENDEL 000450' ..0031 000106' spd GENDIR 000445' ..0044 000136' spd GENDSK 000467' ..0051 000140' spd GENFIN 000453' ..0062 000177' spd GENHLP 000456' ..0067 000201' spd GENPWD 000435' ..0114 000250' spd GENSTA 000464' ..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 000756' ext ..0233 000363' spd LOGJFN 000051' ext ..0247 000406' spd NUM 000744' ext ..0250 000411' spd OUTC 000771' ..0266 000421' spd PARAMS 000524' ..0336 000500' spd PDECOD 000050' ent ..0337 000523' spd PKTBCT 000000 ext ..0344 000505' spd PKTHDR 000731' ..0405 000633' spd PKTLEN 000752' ext ..0406 000641' spd R 000722' ext ..0416 000640' spd RPDECD 000107' ..0417 000641' spd RQUOTE 000475' ext ..0451 000720' spd RSKP 000770' ext ..0456 000725' spd RSTHDR 000000 ext ..0457 000730' spd SDATPT 000374' ext ..0474 000762' spd SNDACK 000307' ..0511 000777' spd SNDAT1 000250' ..0522 001006' 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' SPAKPT 000000 ext k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 20:02 27-Nov-23 Page S-3 K20PDC MAC 24-Nov-23 17:16 SYMBOL TABLE FOR PSECT CONST ACKTAB 000104' SGENPT 000162' SNDPKT 000016' k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 20:02 27-Nov-23 Page S-4 K20PDC MAC 24-Nov-23 17:16 SYMBOL TABLE FOR PSECT DATA LSTGEN 000001' LSTPKT 000000' k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 1 K20NET MAC 15-Nov-23 19:11 Preliminaries 25999 title k20net - Kermit-20 Network Support 26000 remark Moved to seperate module as part of 194 to address MCRNEC 26001 remark Originally part of [186] 26002 26003 subttl Preliminaries 26004 26005 search monsym,macsym,cmd,k20unv ;[194] 26006 cmdacs ^ ;Clean up p1-p4 definitions 26007 26008 sall ; Tidy listing 26009 .directive flblst ; We don't need to see all the ASCIZ bytes... 26010 26011 extern ttyjfn ; JFN for controlling terminal 26012 extern ttyini ; Condition local terminal for connection 26013 extern savlnw ; Save terminal length and width 26014 extern rstlnw ; Restore terminal length and width 26015 extern netjfn ; Holds any kind of communications JFN 26016 extern netflg ; Flags returned from GTJFN% (unused) 26017 extern nodnam ; Parsed node name 26018 extern nodnum ; Converted node number, if we have it 26019 extern asgflg ; Flags that we have assigned a device 26020 extern asgdev ; Device we assigned (always a PTY) 26021 extern srvflg ; If running as a server 26022 extern myjob ; My current logged in job 26023 extern mytty ; My current attached terminal 26024 extern ttynum ; Line number of current connection 26025 extern mycaps ; This process' capability vector 26026 extern crlf ; Handy way to save two bytes 26027 extern %%jser ; JSYS error handler 26028 extern errptr ; Pointer to copies of error messages 26029 extern symout ; Given an address, types an associated symbol 26030 26031 remark Common parsing external data 26032 26033 extern pars3 ; Data from third parsed item 26034 extern pars4 ; Data from fourth parsed item 26035 extern pars5 ; Data from fifth parsed item (rarely used) 26036 extern pars6 ;[218] Data from six parsed item (even more rare) 26037 extern pars7 ;[236] Whether we're doing .MOSNH 26038 extern atmbuf ; The atom buffer 26039 26040 remark External linkages for INPUT/OUTPUT 26041 26042 extern inpclr ;[209] Clear the buffer 26043 extern handsh ;[190] Handshake character 26044 26045 remark External Parity routines and working storage (all 233) 26046 26047 extern parity ; Type of parity in use 26048 extern none ; No parity being enforced 26049 extern space ; Space parity routine (0, always) 26050 extern mark ; Mark parity routine (1, always) 26051 extern even ; Even parity routine 26052 extern odd ; Odd parity routine 26053 extern parpko ; Non-zero if doing parity on packets, only k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 1-1 K20NET MAC 15-Nov-23 19:11 Preliminaries 26054 extern parrck ; Checking parity on recieve in addition to sending 26055 extern ttipar ; Total parity errors for session 26056 extern movchr ; Translates between 7 and 8 bit 26057 extern genpar ; Use string instructions generate a new string 26058 extern chkpar ; Use string instructions to check parity 26059 extern strc ; Count of characters in temporary buffer 26060 extern strptr ; Appropriate pointer to same 26061 extern strbuf ; Global address of string buffer 26062 remark strbf2 ; Flows into this, too 26063 26064 .psect code/ronly ; Pure code, pure heaven 26065 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 2 K20NET MAC 15-Nov-23 19:11 Acquire information about local node 26066 subttl Acquire information about local node 26067 26068 ; Double checks if the system even has DECnet, just in case. It is 26069 ; possible to configure a system without DECnet; in fact, *all* Toad's 26070 ; are thus because they can't change the MAC address of their network 26071 ; adaptor. 26072 ; 26073 ; A remarkable oversight, if it was one, but DEC's decision to just 26074 ; snag part of the global MAC address space always seemed questionable 26075 ; to some. 26076 ; 26077 ; So we have to do this in order to not break on either a Toad, which 26078 ; can never have DECnet (see above) or a monitor built without it. 26079 ; 26080 ; Code lifted from my rewrite of SETNOD (SETND2) and properly Kermit 26081 ; cased... 26082 26083 000000'01 lclnod: entry lclnod 26084 000000'01 265 16 0 00 005273' saveac ; Wants a few extra registers 26085 remark q1, t5 ; Note, t5 aliases q1 26086 26087 000001'01 402 00 0 00 000000# setzm ndvfxp ; Assume doesn't have extended verify 26088 000002'01 201 07 0 00 000000# movei q3, cnfigd ; Resolve area to 18 bit address 26089 000003'01 201 01 0 00 000010 movx t1, .cfiln ; Length (maximum) 26090 26091 000004'01 403 02 0 00 000003 setzb t2, t3 ; Create two handy zeros 26092 000005'01 124 01 0 07 000000 dmovem t1, .cflen(q3) ; Set length, clear processor type 26093 000006'01 124 02 0 07 000002 dmovem t2, .cfise(q3) ; Clear serial number and microcode 26094 000007'01 124 02 0 07 000004 dmovem t2, .cfiho(q3) ; Clear hardware and microcode options 26095 000010'01 124 02 0 07 000006 dmovem t2, .cfiso(q3) ; Clear software options and version 26096 26097 000011'01 124 02 0 00 000000# dmovem t2, mynode ; Zero local executor and NDVFXP 26098 000012'01 124 02 0 00 000000# dmovem t2, myname ; Scrub the node name area 26099 26100 000013'01 201 01 0 00 000000 movx t1, .cfinf ; Want basic configuration 26101 000014'01 200 02 0 00 000007 move t2, q3 ; Where to put the goodies 26102 000015'01 104 00 0 00 000627 CNFIG% ; See what this monitor has 26103 000016'01 320 12 0 00 000000* erjmpr r ; Nothing, forget about the whole thing 26104 26105 000017'01 554 03 0 07 000000 load t3, cf%wdp,.cflen(q3) ;Load words returned 26106 000020'01 275 03 0 00 000001 subi t3, ^d1 ; Convert count to offset 26107 000021'01 305 03 0 00 000007 caige t3, .cfivr ; Need Tops-20 version 26108 000022'01 263 17 0 00 000000 ret ; Unable to determine Tops-20 version 26109 26110 000023'01 135 03 0 00 005305' load t3, vi%maj,.cfivr(q3) ;Load Tops-20 major release 26111 000024'01 305 03 0 00 000007 caige t3, 7 ; Needs Phase IV 26112 000025'01 254 00 0 00 000034' ifskp. ; So far, so good 26113 000026'01 302 03 0 00 000007 caie T3, 7 ; Exactly version seven? 26114 000027'01 254 00 0 00 000033' ifskp. ; Have to check minor version 26115 000030'01 135 03 0 00 005306' load t3, vi%min,.cfivr(q3) ;Load Tops-20 minor release 26116 000031'01 305 03 0 00 000001 caige t3, 1 ; Needs .NDINT 26117 000032'01 263 17 0 00 000000 ret ; Requires Tops-20 minor version one 26118 000033'01 endif. ; Otherwise, OK or after 7 (!) 26119 000033'01 254 00 0 00 000035' else. ; Otherwise, won't work 26120 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 20:02 27-Nov-23 Page 2-1 K20NET MAC 15-Nov-23 19:11 Acquire information about local node 26121 000035'01 endif. 26122 26123 000035'01 200 04 0 07 000006 move t4, .cfiso(q3) ; Load software options 26124 000036'01 607 04 0 00 200000 txnn t4, cf%dcn ; So, do we have DECnet? 26125 000037'01 263 17 0 00 000000 ret ; Nope, System is not configured for DECnet 26126 26127 000040'01 120 01 0 00 005307' dmove t1, [exp .ndgnm,t3] ;Get local node number 26128 000041'01 104 00 0 00 000567 NODE% ; In t3 26129 000042'01 320 12 0 00 000016* erjmpr r ; Give up, shouldn't ever fail.. 26130 000043'01 306 03 0 00 000000 cain t3, 0 ; Is DECnet running? 26131 000044'01 263 17 0 00 000000 ret ; System DECnet node number not configured 26132 000045'01 202 03 0 00 000000# movem t3, mynode ; Store away my local node number 26133 26134 000046'01 120 01 0 00 005311' dmove t1, [exp .ndgln,t3] ;Get local node name 26135 000047'01 561 03 0 00 000000# hrroi t3, myname ; Point to storage 26136 000050'01 104 00 0 00 000567 NODE% ; In t3 26137 000051'01 320 12 0 00 000053' ifje. r ; Failed?? 26138 000052'01 254 00 0 00 000055' 26139 000053'01 403 02 0 00 000003 setzb t2, t3 ; Cons up a couple of NUL's 26140 000054'01 124 02 0 00 000000# dmovem t2 ,myname ; Make sure no name 26141 000055'01 endif. 26142 26143 000055'01 332 00 0 00 000000# ifme. myname ; Get anything? 26144 000056'01 254 00 0 00 000061' 26145 000057'01 402 00 0 00 000000# setzm mynode ; Whack the executor node number 26146 000060'01 263 17 0 00 000000 ret ; System DECnet node name not configured 26147 000061'01 endif. 26148 ; At this point, we know we have DECnet 26149 remark ; See if monitor has extended verify (T79) 26150 000061'01 120 01 0 00 005313' dmove t1, [exp .ndvfx,t3] ;Node name verify, extended 26151 000062'01 561 03 0 00 000000# hrroi t3, myname ; Point to local node name 26152 000063'01 104 00 0 00 000567 NODE% ; See if .NDVFX exists 26153 000064'01 320 12 0 00 000066' ifje. r ; Oh dear, doesn't look promising 26154 000065'01 254 00 0 00 000071' 26155 000066'01 302 01 0 00 601713 caxe t1, argx02 ; Monitor doesn't have winning .NDVFX? 26156 000067'01 263 17 0 00 000000 ret ; That's fine, so don't use it 26157 000070'01 403 04 0 00 000005 setzb t4, t5 ; Zap flags and so forth 26158 000071'01 endif. ; End node processing 26159 26160 000071'01 607 04 0 00 020000 txnn t4, nd%num ; Better have gotten a number (as it is us) 26161 000072'01 263 17 0 00 000000 ret ; .NDVFX response did not get local node number 26162 000073'01 312 05 0 00 000000# came t5, mynode ; Yes, but is it in fact the local executor? 26163 000074'01 263 17 0 00 000000 ret ; Inconsistent local node number results 26164 000075'01 350 00 0 00 000000# aos ndvfxp ; Mark that it fully works 26165 000076'01 263 17 0 00 000000 ret ; We're done 26166 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 3 K20NET MAC 15-Nov-23 19:11 Get the 'name' of the local system 26167 subttl Get the 'name' of the local system 26168 26169 ; Because one can be going from one DECSYSTEM-20 to another, the 26170 ; message, "Returning to DEC20" might be confusing, particularly if 26171 ; one is so lucky as to have multiple parallel transfers happening to 26172 ; foreign systems. While uncommon, there is nothing preventing this 26173 ; scenario. 26174 ; 26175 ; Therefore, we pull the system name. We prefer GETAB% over NODE% 26176 ; because this should always work, whereas NODE% will give you 26177 ; something like "TOPS20" on a non-DECnet site that hasn't configured 26178 ; the name in SETSPD. 26179 ; 26180 ; If, for some reason, we can't do the GETAB% (as in some fascist ACJ 26181 ; prevents it on a truly locked down system), we will use NODE%. 26182 ; NODE% is supposed to work whether or not DECnet is in monitor (see 26183 ; STG). 26184 ; 26185 ; N.B., Since using GETAB%, we have to do a little parsing of SYSVER 26186 ; 26187 ; The problem is that SYSVER has too much blather in it and sometimes 26188 ; also includes propaganda and system version information. Since the 26189 ; first part is simply SYSTEM:MONNAM.TXT (which is supposed to be 26190 ; there), we parse the return up to the comma and use that. 26191 ; 26192 ; Code adapted from UPTIME; expects to be called AFTER lclnod in case 26193 ; SYSGT% and/or GETAB% either can't work (because no SC%GTB) or fail. 26194 ; 26195 ; Counts the string in case somebody needs it, later 26196 26197 000077'01 getnam: entry getnam 26198 000077'01 265 16 0 00 005273' saveac ; Needs some extra registers 26199 000100'01 403 01 0 00 000002 setzb t1,t2 ; Cons up a nice long zero 26200 000101'01 124 01 0 00 000000# dmovem t1,syscnt ; Stomp count and a few characters 26201 26202 000102'01 205 03 0 00 200000 movx t3,sc%gtb ; GETAB% capability? 26203 000103'01 616 03 0 00 000000# tdnn t3,mycaps+1 ; We have it, right? 26204 000104'01 254 00 0 00 000145' jrst getnod ; Most unusual! 26205 26206 000105'01 200 01 0 00 005315' movx t1,'SYSVER' ; Want system version information 26207 000106'01 104 00 0 00 000016 SYSGT% ; Pull out first word and table metadata 26208 000107'01 320 12 0 00 000145' erjmpr getnod ; Gronked?? Try something else 26209 000110'01 202 02 0 00 000000# movem t2,sysver ; Save table length and index (just in case) 26210 000111'01 550 06 0 00 000002 hrrz q2,t2 ; Cache the index in a fast place 26211 000112'01 515 05 0 00 000001 hrlzi q1,^d1 ; Put the table increment in the right place 26212 ; Now decide how long to loop 26213 000113'01 564 02 0 00 000002 hlro t2,t2 ; Turn into a fullword negative number 26214 000114'01 213 07 0 00 000002 movns q3,t2 ; Positivize it (note arcane use of self) 26215 000115'01 303 02 0 00 000011 caxle t2,syslen ; Will the table fit? 26216 000116'01 201 07 0 00 000011 movx q3,syslen ; Sadly, no. Clip it down 26217 000117'01 120 03 0 00 005316' dmove t3,[exp sysnam,0] ; Address of where to store text, nothing seen 26218 ; Fall through with first word 26219 000120'01 do. ; Enter loop context 26220 000120'01 202 01 0 03 000000 movem t1,(t3) ; Stomp the whole word into memory 26221 000121'01 334 02 0 00 000001 skipa t2,t1 ; Set up for correct shift k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 3-1 K20NET MAC 15-Nov-23 19:11 Get the 'name' of the local system 26222 000122'01 do. ; Inner loop to check characters 26223 000122'01 322 02 0 00 000130' jumpe t2,endlp. ; Processed everything? 26224 000123'01 400 01 0 00 000000 setz t1, ; clear a 'linked' register for a shift pair 26225 000124'01 246 01 0 00 000007 lshc t1,^d7 ; Peel off a character (faster than an ILDB) 26226 000125'01 306 01 0 00 000054 cain t1,"," ; A comma? 26227 000126'01 254 00 0 00 000137' jrst postab ; Yes, we've finally gone past the name 26228 000127'01 344 04 0 00 000122' aoja t4,top. ; Otherwise, count the character and inner loop 26229 000130'01 enddo. ; End inner loop to check characters 26230 000130'01 363 07 0 00 000137' sojle q3,endlp. ; Account for a full word done, maybe terminate 26231 000131'01 270 06 0 00 000005 add q2,q1 ; Bump to next GETAB% index 26232 000132'01 200 01 0 00 000006 move t1,q2 ; Load next requested word 26233 000133'01 104 00 0 00 000010 GETAB% ; Ask for it 26234 000134'01 320 12 0 00 000137' erjmpr postab ; Failed, just use what we have 26235 000135'01 322 01 0 00 000137' jumpe t1,postab ; If end, head off for post table processing 26236 000136'01 344 03 0 00 000120' aoja t3,top. ; Otherwise, handle this word 26237 000137'01 enddo. ; End of GETAB% loop context 26238 26239 000137'01 202 04 0 00 000000# postab: movem t4,syscnt ; We know the length of the system name!! 26240 000140'01 271 04 0 00 000001 addi t4,^d1 ; Get past last character (faster than ILDB) 26241 000141'01 133 04 0 00 005320' adjbp t4,[point 7,sysnam] ; Point to where we stored everything 26242 000142'01 400 01 0 00 000000 setz t1, ; Cons up a .CHNUL 26243 000143'01 137 01 0 00 000004 dpb t1,t4 ; Tie off the string (faster than ILDB) 26244 000144'01 263 17 0 00 000000 ret ; And down 26245 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 4 K20NET MAC 15-Nov-23 19:11 Get the 'name' of the local system 26246 remark Handle case of no SC%GTB or SYSGT%/GETAB% failure 26247 26248 ; NODE% should always work and one assumes that DECnet is set up on 26249 ; all modern systems. However, many systems had no DECnet and only 26250 ; ran ARPA code. That is less common as Galaxy assumes DECnet and 26251 ; parts of CFS seem to. 26252 ; 26253 ; As there were also systems with no ARPA code, we use a very old- 26254 ; fashioned method for getting the name and are highly defensively 26255 ; coded. 26256 ; 26257 ; Code lifted from my rewrite of SETNOD (SETND2) and properly Kermit 26258 ; cased... 26259 26260 000145'01 120 02 0 00 000000# getnod: dmove t2,myname ; Load what DECnet thinks 26261 000146'01 322 02 0 00 000170' jumpe t2,niente ; Didn't think much! Just default it 26262 000147'01 312 02 0 00 005321' came t2,[ascii "TOPS2"] ; First five of standard default? 26263 000150'01 254 00 0 00 000153' ifskp. ; Yep, let's look at the 2nd word 26264 000151'01 316 03 0 00 005322' camn t3,[ascii "0"] ; Really standard default?? 26265 000152'01 254 00 0 00 000170' jrst niente ; Default it to something nicer 26266 000153'01 endif. ; Otherwise, fall through 26267 26268 dmove t4,[point 7,sysnam ;Point to text to spew 26269 000153'01 120 04 0 00 005323' 0 ] ; Zero counter 26270 000154'01 do. ; Enter outer loop context 26271 000154'01 do. ; Enter inner loop context 26272 000154'01 400 01 0 00 000000 setz t1, ; whack the character accumulator 26273 000155'01 246 01 0 00 000007 lshc t1,^d7 ; Peel off a character (faster than an ILDB) 26274 000156'01 322 01 0 00 000161' jumpe t1,endlp. ; End of string? Do next word 26275 000157'01 136 01 0 00 000004 idpb t1,t4 ; Deposit into target string 26276 000160'01 344 05 0 00 000154' aoja q1,top. ; Next character 26277 000161'01 enddo. ; End of inner loop context 26278 000161'01 336 02 0 00 000003 skipn t2,t3 ; Position second word 26279 000162'01 254 00 0 00 000165' exit. ; Unless we're done 26280 000163'01 400 03 0 00 000000 setz t3, ; Set a talsiman 26281 000164'01 254 00 0 00 000154' jrst top. ; Peel a few more characters off 26282 000165'01 enddo. ; End of outer loop context 26283 26284 000165'01 202 05 0 00 000000# movem q1,syscnt ; Update string length count 26285 000166'01 136 03 0 00 000004 idpb t3,t4 ; Tie off the string 26286 000167'01 263 17 0 00 000000 ret ; Done 26287 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 5 K20NET MAC 15-Nov-23 19:11 Get the 'name' of the local system 26288 remark Here if we are just not having any luck with the local system name 26289 26290 chgsec(code,text) 26291 000000'02 104 105 103 055 062 defnam: asciz "DEC-20" ; Clear up where we are 26292 000002'02 000 00 0 00 000000 Z ; Historically what we called ourselves 26293 retsec 26294 26295 000170'01 120 01 0 00 000000# niente: dmove t1,defnam ; Load default name 26296 000171'01 124 01 0 00 000000# dmovem t1,sysnam ; Store default name 26297 000172'01 402 00 0 00 000000# setzm sysnam+2 ; Tie of the string 26298 000173'01 201 03 0 00 000006 movei t3,^d6 ; Length of unterminated string 26299 000174'01 202 03 0 00 000000# movem t3,syscnt ; Store the count 26300 26301 000175'01 263 17 0 00 000000 ret ; And done 26302 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 6 K20NET MAC 15-Nov-23 19:11 Set default prompt if doing network 26303 subttl Set default prompt if doing network 26304 26305 ; Sets a default prompt to use when we are NRT'ing in case it 26306 ; it is asked for by SET PROMPT (see .setpr: in k20par) 26307 26308 000176'01 setdef: entry setdef ; Called once at startup 26309 dmove t1,[point 7,myprom ; Default prompt, if needed 26310 000176'01 120 01 0 00 005325' point 7,sysnam] ; Source is local system name 26311 000177'01 200 04 0 00 000000# move t4,syscnt ; Length 26312 26313 000200'01 201 03 0 00 000042 movei t3, .chdbq ; Load a double quote 26314 000201'01 136 03 0 00 000001 idpb t3,t1 ; Deposit it in prompt 26315 26316 000202'01 do. ; Enter loop context. 26317 000202'01 134 03 0 00 000002 ildb t3,t2 ; Load source from local system name 26318 000203'01 136 03 0 00 000001 idpb t3,t1 ; Deposit it in prompt 26319 000204'01 367 04 0 00 000202' sojg t4,top. ; All of it 26320 000205'01 enddo. ; Exit loop context. 26321 26322 dmove t3,[ .chrpt ; Load right pointy bracket 26323 000205'01 120 03 0 00 005327' .chdbq ] ; And a double quote 26324 000206'01 136 03 0 00 000001 idpb t3,t1 ; Make prompt obvious 26325 000207'01 136 04 0 00 000001 idpb t4,t1 ; Close out default for .cmqst 26326 26327 000210'01 400 03 0 00 000000 setz t3, ; Cons up a .chnul 26328 000211'01 136 03 0 00 000001 idpb t3,t1 ; Close out the string 26329 000212'01 263 17 0 00 000000 ret 26330 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 7 K20NET MAC 15-Nov-23 19:11 Perform network connect and initial NRT negotiation 26331 subttl Perform network connect and initial NRT negotiation 26332 26333 ; Call: 26334 ; 26335 ; nodnam has result of .CMNOD 26336 ; 26337 ; Return: 26338 ; 26339 ; +1/ Couldn't open connection 26340 ; +2/ Connection open and negotiated with a remote NRT 26341 ; t1/ Network JFN we got 26342 26343 000213'01 decnct: entry decnct ; Called by k20mit, also 26344 000213'01 402 00 0 00 000000# setzm binflg ; Assume we don't have binary 26345 000214'01 402 00 0 00 000000# setzm nrtflg ; And that we don't have an NRT, either 26346 000215'01 260 17 0 00 000236' call chknrt ; First see if node itself exists 26347 000216'01 254 00 0 00 003224' callret clscln ; Failed, scrub storage 26348 000217'01 202 01 0 00 000000* movem t1,ttynum ; Store node number as line number 26349 000220'01 260 17 0 00 000262' call openrt ; Perform initial open activities 26350 000221'01 254 00 0 00 003044' callret clsjfn ; Unless build and open fail 26351 000222'01 260 17 0 00 000330' call waitcn ; Now wait for NSP negotiation 26352 000223'01 263 17 0 00 000000 ret ; Return +1, waitcn cleans up correctly 26353 000224'01 260 17 0 00 000603' call fixnam ; Rewrite remote node name 26354 000225'01 260 17 0 00 000627' call chktop ; Ensure it suppors Tops-10/20 NRT's 26355 000226'01 263 17 0 00 000000 ret ; It does't ... chktop cleans up correctly 26356 000227'01 201 03 0 00 000022 movei t3, .dvdcn ; Opened a DECnet NRT! 26357 000230'01 202 03 0 00 000000# movem t3, opndev ; Store opened device type 26358 000231'01 476 00 0 00 000000* setom vtermf ; Set the virtual terminal flag 26359 000232'01 476 00 0 00 000000* setom local ; We're the local Kermit 26360 remark gndpar ;[223] Can't get parity from a network JFN 26361 000233'01 402 00 0 00 000000# setzm opnpar ;[223] Either way, NRT's do not support parity 26362 000234'01 550 01 0 00 000000* hrrz t1, netjfn ;[223] Return JFN, no flags 26363 000235'01 254 00 0 00 000000* retskp ; Connected and ready to go! 26364 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 8 K20NET MAC 15-Nov-23 19:11 Checks that the candidate node exists 26365 subttl Checks that the candidate node exists 26366 26367 ; Verifies parsed node and attempts to extract some useful 26368 ; information. This should not be necessary, because unless CM%PO 26369 ; (parse-only) is set, when doing a .CMNOD, Tops-20 itself verifies 26370 ; that whats in the atom buffer exists in the monitor's data base. 26371 ; 26372 ; However we have to do the call to get the node number, which we 26373 ; pretend is a terminal number. 26374 ; 26375 ; Call: 26376 ; 26377 ; nodnam has ... something (see above) 26378 ; 26379 ; Return: 26380 ; 26381 ; +1/ Wasn't a valid DECnet node 26382 ; +2/ Valid DECnet node, t1 has node number if monitor supports this 26383 26384 000236'01 265 16 0 00 005331' chknrt: saveac ; Alias t5 26385 000237'01 120 01 0 00 005313' dmove t1,[exp .ndvfx,t3] ;Node name verify, extended 26386 000240'01 336 00 0 00 000000# skipn ndvfxp ; Has extended verify? 26387 000241'01 201 01 0 00 000015 movx t1, .ndvfy ; Pity, but still usable 26388 000242'01 561 03 0 00 000000* hrroi t3, nodnam ; Point to whatever .CMNOD got 26389 000243'01 104 00 0 00 000567 NODE% ; Get some information 26390 000244'01 320 12 0 00 000246' ifje. r ; Catch the error 26391 000245'01 254 00 0 00 000250' 26392 000246'01 200 02 0 00 000001 move t2, t1 ; Save for debugging 26393 000247'01 403 04 0 00 000005 setzb t4, t5 ; Zap flags and so forth 26394 000250'01 endif. ; 26395 000250'01 477 01 0 00 000000* setob t1, nodnum ; Let's assume nothing works 26396 000251'01 607 04 0 00 200000 txnn t4, nd%lgl ; Double check COMND% .CMNOD, just in case 26397 000252'01 263 17 0 00 000000 ret ; Then how did it get parsed?? 26398 000253'01 607 04 0 00 400000 txnn t4, nd%exm ; Legal, but do we know it? 26399 000254'01 263 17 0 00 000000 ret ; No, we do not 26400 26401 000255'01 607 04 0 00 020000 txnn t4, nd%num ; Did we get a number? 26402 000256'01 254 00 0 00 000235* retskp ; Oh well, maybe old monitor 26403 26404 000257'01 202 05 0 00 000250* movem t5, nodnum ; Save a node number, if we have it 26405 000260'01 200 01 0 00 000005 move t1, t5 ; Return a number to caller 26406 000261'01 254 00 0 00 000256* retskp ; And we are out of here! 26407 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 9 K20NET MAC 15-Nov-23 19:11 Open DECnet connect to NRT object 26408 subttl Open DECnet connect to NRT object 26409 26410 ; Here to actually open the connect. Check to see if the remote 26411 ; system is Tops-10 or Tops-20, in which case we can directly use 26412 ; it as if it were a terminal. This is not possible with a CTERM 26413 ; or TVT because there would be meta-data to process. 26414 ; 26415 ; Note, current behavior is that the OPENF% will succeed whether 26416 ; or not GJ%FLG is set, but strangely, NO traffic will be possible 26417 ; if is not used! If GJ%FLG is issued, then the following flags 26418 ; are returned: 26419 ; 26420 ; Bit Name Comment 26421 ; === ====== ================================================ 26422 ; 6 GJ%UHV The file used has the highest generation number 26423 ; because a generation number of 0 was given in the 26424 ; call. This is clearly false because no generation 26425 ; number nor extension (type) is supplied. 26426 ; 26427 ; 12 GJ%GND Files marked for deletion were not considered when 26428 ; assigning JFNs. 26429 ; 26430 ; 17 GJ%GIV Invisible files were not considerd when assigning 26431 ; JFNs. 26432 ; 26433 ; Why this makes it work is anybody's guess... 26434 ; 26435 ; Call: 26436 ; 26437 ; nodnam has validated foreign node name 26438 ; 26439 ; Return: 26440 ; 26441 ; +1/ Failed to create a JFN to the remote NRT 26442 ; +2/ JFN exists for remote object and is open 26443 26444 chgsec(code,const) ; Constants 26445 000000'03 000000000000# nrtadr: nrtobj ; Where to build network file spec to MCBNRT 26446 000001'03 623075 635000 nrtdev: byte (7) "d","c","n",":",.chnul ;Device name for client connections 26447 000002'03 000003 154455 nrtnum: byte (1) 0 (7) .chnul,.chnul,"3","2",.chdas 26448 retsec 26449 26450 000262'01 402 00 0 00 000000* openrt: setzm asgflg ; Certainly will not be assigning DCN:! 26451 000263'01 402 00 0 00 000000* setzm asgdev ; So don't put it there 26452 000264'01 120 01 0 00 000000# dmove t1,nrtadr ; Load address of object and device name 26453 000265'01 202 02 0 01 000000 movem t2, (t1) ; Start with "DCN:" 26454 000266'01 505 01 0 00 100700 hrli t1,(point 7,0,27) ; Point to ":" 26455 26456 000267'01 201 03 0 00 000242* movei t3,nodnam ; Resolve address of parsed node name 26457 000270'01 505 03 0 00 440700 hrli t3,() ; Turn into a local ASCII pointer 26458 ; And append the node name 26459 000271'01 do. ; Enter loop lexical context 26460 000271'01 134 02 0 00 000003 ildb t2,t3 ; Load node name byte 26461 000272'01 322 02 0 00 000275' jumpe t2,endlp. ; Exit if at end of string 26462 000273'01 136 02 0 00 000001 idpb t2,t1 ; Append to file specification k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 9-1 K20NET MAC 15-Nov-23 19:11 Open DECnet connect to NRT object 26463 000274'01 254 00 0 00 000271' loop. ; Go get some more 26464 000275'01 enddo. ; end loop lexical context 26465 ; Append MCBNRT's object type 26466 000275'01 200 02 0 00 000000# move t2, nrtnum ; Complete NRT number portion 26467 000276'01 136 02 0 00 000001 idpb t2,t1 ; Drop in the dash 26468 000277'01 242 02 0 00 777771 lsh t2,-^d7 ; Shift the "2" into place 26469 000300'01 136 02 0 00 000001 idpb t2,t1 ; Drop in the "2" 26470 000301'01 242 02 0 00 777771 lsh t2,-^d7 ; Shift the "3" into place 26471 000302'01 136 02 0 00 000001 idpb t2,t1 ; Drop in the "3" 26472 000303'01 400 02 0 00 000000 setz t2, ; Cons up a NUL 26473 000304'01 136 02 0 00 000001 idpb t2,t1 ; Tie off the line 26474 26475 000305'01 205 01 0 00 000021 movx t1,gj%sht!gj%flg ; Do a short form GTJFN with flags 26476 000306'01 561 02 0 00 000000# hrroi t2,nrtobj ; Using the spec just built 26477 000307'01 104 00 0 00 000020 GTJFN% ; Get DCN connection 26478 000310'01 320 12 0 00 000312' %jserr (,clscln) ; Scrub storage 26479 000311'01 254 00 0 00 000315' 26480 000312'01 265 01 0 00 000000* 26481 000313'01 000000000000# 26482 000314'01 254 00 0 00 003224' 26483 000000'04 125 156 141 142 154 26484 26485 000315'01 552 01 0 00 000234* hrrzm t1,netjfn ; Save JFN for the connection 26486 000316'01 512 01 0 00 000000* hllzm t1,netflg ; Save returned flags 26487 000317'01 621 01 0 00 777777 tlz t1,-1 ; But shut them off for downstream 26488 ; 8 bit bytes, small buffers and read/write 26489 000320'01 200 02 0 00 005337' move t2,[fld(^d8,of%bsz)!fld(.gssmb,of%mod)!of%rd!of%wr] 26490 000321'01 104 00 0 00 000021 OPENF% ; Open the network connection 26491 000322'01 320 12 0 00 000324' %jserr (,clsjfn) ; Toss the JFN 26492 000323'01 254 00 0 00 000327' 26493 000324'01 265 01 0 00 000312* 26494 000325'01 000000000000# 26495 000326'01 254 00 0 00 003044' 26496 000005'04 125 156 141 142 154 26497 000327'01 254 00 0 00 000261* retskp ; Return success 26498 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 10 K20NET MAC 15-Nov-23 19:11 Wait for DECnet connection completion 26499 subttl Wait for DECnet connection completion 26500 26501 ; Once we are done building the connection string and have successfully 26502 ; done the OPENF%, we must wait a bit for DECnet to complete network 26503 ; level negotiations. 26504 26505 ; This was is done by sitting in a loop, waiting a quarter second, 26506 ; checking the connection status and, if connected, returning. 26507 ; Otherwise we'd go around and do it again for the specified number of 26508 ; times. 26509 ; 26510 ; The new code sets a connection interrupt (mo%cdn) which results in a 26511 ; lot snappier response. Moral of the Story: Don't Poll. 26512 26513 ;[218] Rewritten for connection interrupts 26514 26515 extern dnchb ; DECnet channel bit, defined in k20sub 26516 extern dncfld,dndfld ; DECnet channal assignment/deassignment field 26517 extern timeon,timdel ; Force a specific time, force a timer delete 26518 extern ccon,ccoff2 ; Set up Control-C handler 26519 extern cyon, cyoff ; Set up Control-Y handler 26520 extern cyseen ; Set if Control-Y typed 26521 extern delay ; Default connect time out 26522 26523 000330'01 200 01 0 00 000315* waitcn: move t1, netjfn ; Load the network JFN 26524 dmove t2, [ .moacn ; Code to enable interrupts 26525 000331'01 120 02 0 00 005340' dncfld ] ; Channel to enable on 26526 000332'01 104 00 0 00 000077 MTOPR% ; Enable the interrupt 26527 000333'01 320 12 0 00 000335' %jserr (,clsnet) 26528 000334'01 254 00 0 00 000340' 26529 000335'01 265 01 0 00 000324* 26530 000336'01 000000000000# 26531 000337'01 254 00 0 00 003047' 26532 000013'04 104 105 103 156 145 26533 dmove t1, [ .fhslf ; This process 26534 000340'01 120 01 0 00 005342' dnchb ] ; DECnet connection channel 26535 000341'01 104 00 0 00 000131 AIC% ; Turn the channel on 26536 000342'01 320 12 0 00 000344' %jserr (,clsnet) ;?? 26537 000343'01 254 00 0 00 000347' 26538 000344'01 265 01 0 00 000335* 26539 000345'01 000000000000# 26540 000346'01 254 00 0 00 003047' 26541 000024'04 104 105 103 156 145 26542 000347'01 260 17 0 00 000000* call ccon ; Turn on Control-C interrupt 26543 000350'01 254 00 0 00 000512' jrst waitcc ; Go to the wait Control-C handler 26544 000351'01 260 17 0 00 000000* call cyon ; Fielding ^Y inquires 26545 000352'01 334 00 0 00 000000 %ermsg (,) 26546 000353'01 254 00 0 00 000357' 26547 000354'01 265 01 0 00 000344* 26548 000355'01 000000000000# 26549 000356'01 254 00 0 00 000357' 26550 000034'04 103 157 165 154 144 26551 000357'01 201 01 0 00 000522' movei t1, waitmo ; Address to go to on time out 26552 000360'01 337 02 0 00 000000* skipg t2, pars6 ; Use /timeout, if specified 26553 000361'01 200 02 0 00 000000* move t2, delay ; Otherwise use default k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 10-1 K20NET MAC 15-Nov-23 19:11 Wait for DECnet connection completion 26554 000362'01 323 02 0 00 000364' ifg. t2 ; Have any reasonable delay? 26555 000363'01 260 17 0 00 000000* call timeon ; Yes, set connection expiration time 26556 000364'01 endif. ; Otherwise, we are truly patient... 26557 26558 000364'01 do. ; Enter loop context 26559 000364'01 104 00 0 00 000306 WAIT% ; Wait forever and ever (and ever) 26560 000365' $waitj==:. ; Location of JSYS as reported 26561 000365'01 336 00 0 00 000000* skipn cyseen ; Should only happen for ^Y 26562 000366'01 254 00 0 00 000503' jrst waitun ; But didn't! Unknown!! 26563 000367'01 260 17 0 00 000407' call waitpr ; Print something nice 26564 000370'01 254 00 0 00 000373' ifskp. ; Link is still healthy 26565 000371'01 402 00 0 00 000365* setzm cyseen ; Stomp ^Y seen 26566 000372'01 254 00 0 00 000402' else. ; Otherwise, we are ill 26567 000373'01 415 16 0 00 000400' block. ; Will need a frame 26568 000374'01 261 17 0 00 000016 26569 000375'01 265 16 0 00 005344' saveac ; Save temporaries 26570 000376'01 260 17 0 00 000441' call shutdn ; Turn off the interrupts 26571 000377'01 263 17 0 00 000000 endbk. ; Exit block, restoring temporaries 26572 000400'01 260 17 0 00 000544' call decerr ; Complain and close 26573 000401'01 254 00 0 00 003047' callret clsnet ; Toss JFN and return 26574 000402'01 endif. 26575 000402'01 603 03 0 00 400000 txne t3, mo%con ; Connected?? Must have missed the interrupt 26576 000403'01 254 00 0 00 000405' exit. ; Break out and return success 26577 000404'01 254 00 0 00 000364' loop. ; And go catatonic again 26578 000405'01 enddo. ; End loop lexical context 26579 26580 000405'01 waitdn: remark ; Forced here by connection interrupt 26581 000405'01 260 17 0 00 000441' call shutdn ; Get rid of all our interrupts 26582 000406'01 254 00 0 00 000327* retskp ; Return success 26583 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 11 K20NET MAC 15-Nov-23 19:11 Print Connection Information 26584 subttl Print Connection Information 26585 26586 ; Returns +1 if connection went bad, t2 having the DECnet abort code 26587 ; +2 if the connection is still good and we continue to wait 26588 26589 000407'01 200 01 0 00 000330* waitpr: move t1,netjfn ; Load the JFN 26590 000410'01 201 02 0 00 000025 movx t2,.morls ; Function to read link status 26591 000411'01 104 00 0 00 000077 MTOPR% ; Do the status read 26592 000412'01 320 12 0 00 000042* erjmpr r ; Handle error, getting it in t1 26593 000413'01 603 03 0 00 400000 txne t3, mo%con ; Connected?? 26594 000414'01 254 00 0 00 000406* retskp ; Must have missed the interrupt 26595 000415'01 603 03 0 00 010000 txne t3, mo%abt ; Link aborted?? 26596 000416'01 263 17 0 00 000000 ret ; Fail and return blat 26597 000417'01 603 03 0 00 004000 txne t3, mo%syn ; A normal close? 26598 000420'01 263 17 0 00 000000 ret ; Already? That's pecular... 26599 000421'01 607 03 0 00 100000 ifxn. t3, mo%wfc ; Still healthy and waiting? 26600 000422'01 254 00 0 00 000427' 26601 txmsg <% Waiting for connection 26602 000423'01 200 01 0 00 000000# > 26603 000424'01 104 00 0 00 000076 26604 000425'01 320 12 0 00 000426' 26605 000003'03 000000000000# 26606 000044'04 045 040 127 141 151 26607 26608 000426'01 254 00 0 00 000414* retskp 26609 000427'01 endif. 26610 000427'01 607 03 0 00 040000 ifxn. t3, mo%wcc ; Just about done, actually? 26611 000430'01 254 00 0 00 000435' 26612 txmsg <% Waiting for connection confirmation 26613 000431'01 200 01 0 00 000000# > 26614 000432'01 104 00 0 00 000076 26615 000433'01 320 12 0 00 000434' 26616 000004'03 000000000000# 26617 000052'04 045 040 127 141 151 26618 26619 000434'01 254 00 0 00 000426* retskp 26620 000435'01 endif. 26621 26622 txmsg <% Unknown status 26623 000435'01 200 01 0 00 000000# > 26624 000436'01 104 00 0 00 000076 26625 000437'01 320 12 0 00 000440' 26626 000005'03 000000000000# 26627 000062'04 045 040 125 156 153 26628 26629 000440'01 254 00 0 00 000434* retskp ; Still OK to wait 26630 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 12 K20NET MAC 15-Nov-23 19:11 Connection interrupt time out and shutdown 26631 subttl Connection interrupt time out and shutdown 26632 26633 000441'01 201 01 0 00 400000 shutdn: movx t1, .fhslf ; This process 26634 000442'01 104 00 0 00 000130 DIR% ; Shut off the entire interrupt system 26635 000443'01 320 12 0 00 000445' %jserr (,) 26636 000444'01 254 00 0 00 000450' 26637 000445'01 265 01 0 00 000354* 26638 000446'01 000000000000# 26639 000447'01 254 00 0 00 000450' 26640 000066'04 111 156 164 145 162 26641 000450'01 260 17 0 00 000000* call ccoff2 ; Force off Control-C handler 26642 000451'01 260 17 0 00 000000* call timdel ; Delete the timer 26643 000452'01 260 17 0 00 000000* call cyoff ; Release ^Y 26644 dmove t1, [ .fhslf ; This process 26645 000453'01 120 01 0 00 005356' dnchb ] ; DECnet connection channel 26646 000454'01 104 00 0 00 000133 DIC% ; Shut the channel off 26647 000455'01 320 12 0 00 000457' %jserr (,) ; Carry on 26648 000456'01 254 00 0 00 000462' 26649 000457'01 265 01 0 00 000445* 26650 000460'01 000000000000# 26651 000461'01 254 00 0 00 000462' 26652 000075'04 104 105 103 156 145 26653 000462'01 200 01 0 00 000407* move t1, netjfn ; Load the network JFN 26654 dmove t2, [ .moacn ; Code to enable interrupts 26655 000463'01 120 02 0 00 005360' dndfld ] ; Take the interrupt off this channel 26656 000464'01 104 00 0 00 000077 MTOPR% ; Enable the interrupt 26657 000465'01 320 12 0 00 000467' %jserr (,) ; Carry on 26658 000466'01 254 00 0 00 000472' 26659 000467'01 265 01 0 00 000457* 26660 000470'01 000000000000# 26661 000471'01 254 00 0 00 000472' 26662 000105'04 104 105 103 156 145 26663 000472'01 104 00 0 00 000141 CIS% ; Clear out any other interrupt crud 26664 000473'01 201 01 0 00 400000 movx t1, .fhslf ; This process 26665 000474'01 104 00 0 00 000126 EIR% ; Turn the interrupt back on 26666 000475'01 320 12 0 00 000477' %jserr (,) ; Uh oh... 26667 000476'01 254 00 0 00 000502' 26668 000477'01 265 01 0 00 000467* 26669 000500'01 000000000000# 26670 000501'01 254 00 0 00 000502' 26671 000116'04 111 156 164 145 162 26672 000502'01 263 17 0 00 000000 ret 26673 26674 000503'01 waitun: remark ; Here if we don't know why we broke out 26675 000503'01 260 17 0 00 000441' call shutdn ; Get rid of all our interrupts 26676 emsg ; Inform 26678 000505'01 104 00 0 00 000313 26679 000006'03 000000000000# 26680 000125'04 125 156 153 156 157 26681 26682 000506'01 505 02 0 00 000007 hrli t2, .DCX7 ; Code is unspecified error 26683 000507'01 200 03 0 00 000000# sxtext (t3,) 26684 000007'03 000000000000# 26685 000133'04 125 156 153 156 157 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 12-1 K20NET MAC 15-Nov-23 19:11 Connection interrupt time out and shutdown 26686 000510'01 201 04 0 00 000020 movei t4,^d16 ; Length of reject message 26687 000511'01 254 00 0 00 000530' jrst waitm1 ; Join common code 26688 26689 000512'01 waitcc: remark ; ^C event 26690 000512'01 260 17 0 00 000441' call shutdn ; Get rid of all our interrupts 26691 txmsg <% aborting connection attempt 26692 000513'01 200 01 0 00 000000# > ; Inform 26693 000514'01 104 00 0 00 000076 26694 000515'01 320 12 0 00 000516' 26695 000010'03 000000000000# 26696 000137'04 045 040 141 142 157 26697 26698 000516'01 505 02 0 00 000011 hrli t2, .DCX9 ; Code is forced explicit disconnect 26699 000517'01 200 03 0 00 000000# sxtext (t3,) 26700 000011'03 000000000000# 26701 000146'04 101 142 141 156 144 26702 000520'01 201 04 0 00 000017 movei t4,^d15 ; Length of reject message 26703 000521'01 254 00 0 00 000530' jrst waitm1 ; Join common code 26704 26705 000522'01 waitmo: remark ; Time-out event 26706 000522'01 260 17 0 00 000441' call shutdn ; Get rid of all our interrupts 26707 emsg ; Whine 26709 000524'01 104 00 0 00 000313 26710 000012'03 000000000000# 26711 000152'04 122 145 155 157 164 26712 26713 000525'01 505 02 0 00 000046 hrli t2, .DCX38 ; Code is no response 26714 000526'01 200 03 0 00 000000# sxtext (t3,) 26715 000013'03 000000000000# 26716 000160'04 101 164 164 145 155 26717 000527'01 201 04 0 00 000020 movei t4,^d16 ; Length of reject message 26718 26719 000530'01 200 01 0 00 000462* waitm1: move t1,netjfn ; Load DCN: JFN 26720 000531'01 541 02 0 00 000040 hrri t2, .moclz ; Function to close 26721 000532'01 104 00 0 00 000077 MTOPR% ; Notify NSP that we are giving up 26722 000533'01 320 12 0 00 000544' erjmpr decerr ; We can't say "No"? 26723 000534'01 254 00 0 00 003130' callret clscom ; Toss whatever is left 26724 26725 ;[218] End rewrite for connection interrupts 26726 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 13 K20NET MAC 15-Nov-23 19:11 Asynchronous DECnet connection event 26727 subttl Asynchronous DECnet connection event 26728 26729 ;[218] Begin code insertion 26730 26731 ; Purpose is to break us out of any jsys we might be in (probably the 26732 ; WAIT%) and redirect the path of execution to the successful return. 26733 26734 000535'01 dntrap: entry dntrap ; chntab is in k20sub 26735 000535'01 261 17 0 00 000001 push p, t1 ; Save an accumulator 26736 000536'01 201 01 0 00 000405' movei t1, waitdn ; Load the connection success address 26737 000537'01 500 01 0 00 000000* hll t1, pc3 ; Load interrupted PC's flags 26738 000540'01 661 01 0 00 010000 txo t1, pc%usr ; Force user mode to break out of any JSYS 26739 000541'01 202 01 0 00 000537* movem t1, pc3 ; Restore as if we came from there 26740 000542'01 262 17 0 00 000001 pop p, t1 ; Restore the accumulator 26741 000543'01 104 00 0 00 000136 DEBRK% ; Done with interrupt 26742 26743 ;[218] End code insertion 26744 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 14 K20NET MAC 15-Nov-23 19:11 Handle a DECnet connection error of some type 26745 subttl Handle a DECnet connection error of some type 26746 26747 ; Takes two kinds of errors and honks accordingly 26748 ; 26749 ; Note assumption: if t1 still has netjfn in it, then it couldn't 26750 ; possibly have gotten stomped with an erjmpr 26751 ; 26752 ; Call: 26753 ; 26754 ; t1/ JFN or error code 26755 ; 26756 ; Return: 26757 ; 26758 ; +1, always, having typed some kind of blat 26759 26760 000544'01 decerr: entry decerr ; Also hit by other modules 26761 000544'01 550 02 0 00 000001 hrrz t2,t1 ; Save a possible error 26762 000545'01 200 01 0 00 000000# emsg ;[187] 26763 000546'01 104 00 0 00 000313 26764 000014'03 000000000000# 26765 000164'04 103 157 156 156 145 26766 000547'01 316 02 0 00 000530* camn t2,netjfn ; JSYS error? 26767 000550'01 254 00 0 00 000562' ifskp. ; Yes, that's easy enough to complain about 26768 000551'01 201 01 0 00 000101 movei t1,.priou ; Continue on primary output 26769 000552'01 505 02 0 00 400000 hrli t2,.fhslf ; Wants this for explicit error 26770 000553'01 400 03 0 00 000000 setz t3, ; Don't limit length of text 26771 000554'01 104 00 0 00 000011 ERSTR% ; Type the JSYS failure reason text 26772 000555'01 320 12 0 00 000557' erjmpr .+2 ; Ignore strange error 26773 000556'01 320 12 0 00 000557' erjmpr .+1 ; Ignore stranger error 26774 000557'01 561 01 0 00 000000* hrroi t1, crlf ; Tie off the line 26775 000560'01 104 00 0 00 000076 PSOUT% 26776 000561'01 263 17 0 00 000000 ret ; And return 26777 000562'01 endif. ; End JSYS error handling 26778 26779 000562'01 400 01 0 00 000000 setz t1, ; Let's assume we never found anything 26780 000563'01 621 03 0 00 777777 tlz t3,-1 ; Scrub to just the bare error 26781 000564'01 201 04 0 00 000000# movei t4,nsptab ; Load address of error table 26782 000565'01 505 04 0 00 777744 hrli t4,-nspcnt ; Load negative number of items in table 26783 26784 000566'01 do. ; Enter loop context 26785 000566'01 554 02 0 04 000000 hlrz t2,(t4) ; Load Disconnect Code Table 26786 000567'01 312 02 0 00 000003 came t2,t3 ; Did we find the code? 26787 000570'01 254 00 0 00 000574' ifskp. ; Yes, set up the pointer 26788 000571'01 550 01 0 04 000000 hrrz t1, (t4) ; Pick up in-section case 26789 000572'01 661 01 0 00 610001 txo t1, .px7 ; Turn into a OWGP to ASCII text in ETEXT 26790 000573'01 254 00 0 00 000575' exit. ; Break out of the loop 26791 000574'01 endif. 26792 000574'01 253 04 0 00 000566' aobjn t4,top. ; Nope, try the next error code 26793 000575'01 enddo. ; End loop context 26794 26795 000575'01 326 01 0 00 000577' ife. t1 ; Did we find anything? 26796 000576'01 200 01 0 00 000000# sxtext (t1,) 26797 000015'03 000000000000# 26798 000171'04 125 156 153 156 157 26799 000577'01 endif. ; Other, can provide extra information k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 14-1 K20NET MAC 15-Nov-23 19:11 Handle a DECnet connection error of some type 26800 000577'01 104 00 0 00 000313 ESOUT% ; Give us the bad news 26801 000600'01 561 01 0 00 000557* hrroi t1, crlf ; Tie off the line and return 26802 000601'01 104 00 0 00 000076 PSOUT% 26803 000602'01 254 00 0 00 003121' callret clsnrt ; Close the NRT object (or what's left) 26804 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 15 K20NET MAC 15-Nov-23 19:11 DECnet Disconnect Code Table (from MONSYM) 26805 subttl DECnet Disconnect Code Table (from MONSYM) 26806 26807 .endps code ; Pointers to extended text don't go in code 26808 26809 ; Note that the codes are stipulated by the NSP specification and 26810 ; may have meanings that are not directly implied by the comments 26811 26812 define nsperr(e,t,%et) < 26813 xwd e,%et ;;DECnet error code and in-section address 26814 chgsec(const,etext) ;;Text goes in extended section 26815 %et: asciz\'t\ ;;Drop text into extended section 26816 retsec ;;Gets back into const .psect 26817 cleans(<%et>) ;;Don't clutter listings with generated symbol 26818 >;;nsperr 26819 26820 .psect const ; Pointer table to extended text goes in const .psect 26821 26822 000016'03 000000 000000# nsptab: nsperr(.DCX0,) 26823 000201'04 122 145 152 145 143 26824 000017'03 000001 000000# nsperr(.DCX1,) 26825 000210'04 122 145 163 157 165 26826 000020'03 000002 000000# nsperr(.DCX2,) 26827 000216'04 104 145 163 164 151 26828 000021'03 000003 000000# nsperr(.DCX3,) 26829 000225'04 122 145 155 157 164 26830 000022'03 000004 000000# nsperr(.DCX4,) 26831 000233'04 104 145 163 164 151 26832 000023'03 000005 000000# nsperr(.DCX5,) 26833 000242'04 111 156 166 141 154 26834 000024'03 000006 000000# nsperr(.DCX6,) 26835 000250'04 117 142 152 145 143 26836 000025'03 000007 000000# nsperr(.DCX7,) 26837 000253'04 125 156 163 160 145 26838 000026'03 000010 000000# nsperr(.DCX8,) 26839 000257'04 101 142 157 162 164 26840 000027'03 000011 000000# nsperr(.DCX9,) 26841 000263'04 101 142 157 162 164 26842 000030'03 000012 000000# nsperr(.DCX10,) 26843 000267'04 111 156 166 141 154 26844 000031'03 000013 000000# nsperr(.DCX11,) 26845 000273'04 114 157 143 141 154 26846 000032'03 000025 000000# nsperr(.DCX21,) 26847 000277'04 103 157 156 156 145 26848 000033'03 000026 000000# nsperr(.DCX22,) 26849 000311'04 103 157 156 156 145 26850 000034'03 000027 000000# nsperr(.DCX23,) 26851 000323'04 103 157 156 156 145 26852 000035'03 000030 000000# nsperr(.DCX24,) 26853 000340'04 106 154 157 167 040 26854 000036'03 000040 000000# nsperr(.DCX32,) 26855 000345'04 124 157 157 040 155 26856 000037'03 000041 000000# nsperr(.DCX33,) 26857 000353'04 124 157 157 040 155 26858 000040'03 000042 000000# nsperr(.DCX34,) 26859 000364'04 101 143 143 145 163 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 15-1 K20NET MAC 15-Nov-23 19:11 DECnet Disconnect Code Table (from MONSYM) 26860 000041'03 000043 000000# nsperr(.DCX35,) 26861 000371'04 114 157 147 151 143 26862 000042'03 000044 000000# nsperr(.DCX36,) 26863 000400'04 111 156 166 141 154 26864 000043'03 000045 000000# nsperr(.DCX37,) 26865 000404'04 123 145 147 155 145 26866 000044'03 000046 000000# nsperr(.DCX38,) 26867 000411'04 116 157 040 162 145 26868 000045'03 000047 000000# nsperr(.DCX39,) 26869 000421'04 116 157 144 145 040 26870 000046'03 000050 000000# nsperr(.DCX40,) 26871 000425'04 114 151 156 153 040 26872 000047'03 000051 000000# nsperr(.DCX41,) 26873 000433'04 104 145 163 164 151 26874 000050'03 000052 000000# nsperr(.DCX42,) 26875 000442'04 103 157 156 146 151 26876 000051'03 000053 000000# nsperr(.DCX43,) 26877 000452'04 111 155 141 147 145 26878 000000000000# nspcnt==.-nsptab ; Number of items in table 26879 cleans() ; No need for symbol in listings, Etc. 26880 .psect code ; Back in code 26881 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 16 K20NET MAC 15-Nov-23 19:11 Canonicalize remote node name 26882 subttl Canonicalize remote node name 26883 26884 ; Rewrite the node name in case it was aliased. At least get it into 26885 ; UPPER case, which is what everybody wants. Also keeps gross CaMel 26886 ; case input from offending the sensitive 26887 26888 000603'01 337 02 0 00 000547* fixnam: skipg t2, netjfn ; Load JFN 26889 000604'01 263 17 0 00 000000 ret ; Unless there isn't one 26890 26891 000605'01 336 00 0 00 000000# ifmn. ndvfxp ; Have .ndvfx? 26892 000606'01 254 00 0 00 000611' 26893 000607'01 200 03 0 00 000257* move t3, nodnum ; Load previous node number 26894 000610'01 202 03 0 00 000000# movem t3, oldnum ; Store as old number 26895 000611'01 endif. ; Otherwise, will have to compare characters... 26896 26897 000611'01 120 03 0 00 000267* dmove t3, nodnam ; Load connected node name 26898 000612'01 124 03 0 00 000000# dmovem t3, oldnam ; Save (will hold six characters plus .chnul) 26899 000613'01 403 03 0 00 000004 setzb t3, t4 ; Cons up 10 .chnul's 26900 000614'01 124 03 0 00 000611* dmovem t3, nodnam ; Scrub storage enough 26901 26902 000615'01 561 01 0 00 000614* hrroi t1, nodnam ; Rewriting the node nam 26903 dmove t3, [ fld(.jsaof,js%nam) ; Just the file name 26904 000616'01 120 03 0 00 005362' 0 ] ; No strange prefix 26905 000617'01 104 00 0 00 000030 JFNS% ; Rewrite the node name 26906 000620'01 320 12 0 00 000412* erjmpr r ; ?? 26907 26908 000621'01 211 02 0 00 000003 movni t2,^d3 ; Getting before the dash 26909 000622'01 133 02 0 00 000001 adjbp t2,t1 ; back the pointer up 26910 000623'01 136 04 0 00 000002 idpb t4,t2 ; Stomp the dash, tying off the string 26911 000624'01 136 04 0 00 000002 idpb t4,t2 ; Also stomp the "2" and the ... 26912 000625'01 136 04 0 00 000002 idpb t4,t2 ; ... "3" to allow word compares 26913 000626'01 263 17 0 00 000000 ret ; Return everything all pretty 26914 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 17 K20NET MAC 15-Nov-23 19:11 Check if a connecting to a machine that supports Tops-20 NRT 26915 subttl Check if a connecting to a machine that supports Tops-20 NRT 26916 26917 ; Only these support a meta-data free NRT that we can use 26918 26919 ; N.B., These aren't just Tops-10 or Tops-20 machines! Ultrix-32 implements 26920 ; Tops-20 NRT. 26921 26922 000200 cnflen==200 ; Maximum characters allowed 26923 26924 000627'01 265 16 0 00 005364' chktop: saveac ; Fiddling with raw DECnet byte order 26925 000630'01 403 01 0 00 000002 setzb t1,t2 ; Cons up some zeros 26926 000631'01 124 01 0 00 000000# dmovem t1, nrtros ; Initialize unknown OS types 26927 000632'01 124 01 0 00 000000# dmovem t1, nrtflg ; and also NRT and network binary flags 26928 000633'01 402 00 0 00 000000# setzm nrtprt ; and also the NRT protocol 26929 26930 000634'01 337 01 0 00 000603* skipg t1, netjfn ; Load network JFN 26931 000635'01 263 17 0 00 000000 ret ; Unless there isn't one 26932 26933 000636'01 120 02 0 00 005374' dmove t2,[exp .morls,0] ; Read link status 26934 000637'01 104 00 0 00 000077 MTOPR% ; Request from the monitor 26935 000640'01 320 12 0 00 000544' erjmpr decerr ; Handle error 26936 26937 000641'01 607 03 0 00 020000 ifxn. t3,mo%eom ; Has an entire message? 26938 000642'01 254 00 0 00 000653' 26939 000643'01 400 02 0 00 000000 setz 2, ; Assume it's a lie 26940 000644'01 104 00 0 00 000102 SIBE% ; See what the deal is 26941 000645'01 334 00 0 00 000000 skipa ; Have some goodies to read, actually 26942 000646'01 254 00 0 00 000653' anskp. ; Or doesn't 26943 000647'01 303 02 0 00 000200 caile t2,cnflen ; Exceeds buffer length? 26944 000650'01 254 00 0 00 000653' anskp. ; clip it down 26945 000651'01 210 03 0 00 000002 movn t3,t2 ; Load exact length to read 26946 000652'01 254 00 0 00 000654' else. ; Otherwise use default length 26947 000653'01 211 03 0 00 000200 movni t3,cnflen ; Default maximum characters allowed 26948 000654'01 endif. 26949 26950 000654'01 200 02 0 00 005376' move t2,[point ^d8,cnfmsg] ;Note 8 bit pointer to config message 26951 000655'01 104 00 0 00 000531 SINR% ; Read Configuration message 26952 000656'01 320 12 0 00 000544' erjmpr decerr ; Gronked?? 26953 26954 remark ; Begin configuration message parsing 26955 000657'01 135 01 0 00 005377' ldb t1,[point ^D8,cnfmsg,7] 26956 000660'01 306 01 0 00 000001 cain t1,^d1 ; Is this a configuration message, actually? 26957 000661'01 254 00 0 00 000675' ifskp. ; No, so let's type it 26958 000662'01 200 01 0 00 000000# emsg 26959 000663'01 104 00 0 00 000313 26960 000052'03 000000000000# 26961 000460'04 077 040 111 154 154 26962 000664'01 201 01 0 00 000101 movei t1,.priou ; Output to primary 26963 000665'01 200 02 0 00 005400' move t2,[point ^d8,cnfmsg] ; Pointer to data from remote host 26964 000666'01 201 04 0 03 000200 movei t4,cnflen(t3) ; Get count received-1 26965 000667'01 210 03 0 00 000004 movn t3,t4 ; Now have output count 26966 000670'01 104 00 0 00 000053 SOUT% ; Type data on users terminal 26967 000671'01 320 12 0 00 000672' erjmpr .+1 ; Too bad for user, but ignore it 26968 000672'01 561 01 0 00 000600* hrroi t1, crlf ; Tie off 26969 000673'01 104 00 0 00 000076 PSOUT% ; the line k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 17-1 K20NET MAC 15-Nov-23 19:11 Check if a connecting to a machine that supports Tops-20 NRT 26970 000674'01 254 00 0 00 003121' callret clsnrt ; Close the connection 26971 000675'01 endif. ; End case connection message 26972 repeat 0,< ;;We don't look at the next two 26973 ldb t3,[point ^d8,cnfmsg,15] ; DEC ECO 26974 ldb t3,[point ^d8,cnfmsg,23] ; Customer ECO 26975 > 26976 000675'01 135 03 0 00 005401' ldb t3,[point ^d8,cnfmsg,34] ; Operating System type, high order byte 26977 000676'01 242 03 0 00 000010 lsh t3, ^d8 ; shift over and load the low order byte 26978 000677'01 135 04 0 00 005402' ldb t4,[point ^d8,cnfmsg+1,7] 26979 000700'01 200 05 0 00 000004 move q1, t4 ; Save constructed OS type 26980 26981 000701'01 200 01 0 00 000000# txmsg <[Remote system > ; Begin connection banner 26982 000702'01 104 00 0 00 000076 26983 000703'01 320 12 0 00 000704' 26984 000053'03 000000000000# 26985 000467'04 133 122 145 155 157 26986 000704'01 561 01 0 00 000615* hrroi t1,nodnam ; Remote system 26987 000705'01 104 00 0 00 000076 PSOUT% ; Type it 26988 000706'01 200 01 0 00 000000# txmsg <:: is running > 26989 000707'01 104 00 0 00 000076 26990 000710'01 320 12 0 00 000711' 26991 000054'03 000000000000# 26992 000473'04 072 072 040 151 163 26993 26994 000711'01 415 16 0 00 000723' block. ; Enter block context for easier control flow 26995 000712'01 261 17 0 00 000016 26996 000713'01 305 04 0 00 000000 caige t4, 0 ; Negative OS number?? 26997 000714'01 263 17 0 00 000000 ret ; That will never work 26998 000715'01 303 04 0 00 000022 caile t4, hsttyn ; Out of range? 26999 000716'01 263 17 0 00 000000 ret ; Don't know that, either 27000 000717'01 336 00 0 04 000763' skipn hsttyp(t4) ; But!! Is this entry 'known'? 27001 000720'01 263 17 0 00 000000 ret ; Nope (note table has 'reserved' gaps) 27002 000721'01 254 00 0 00 000440* retskp ; Otherwise, it's fine 27003 000722'01 263 17 0 00 000000 endbk. ; Return out of block context, one way or another 27004 000723'01 254 00 0 00 000730' ifskp. ; Skip means we know the remote OS code 27005 000724'01 200 01 0 04 000763' move t1, hsttyp(t4) ; Load OWGP to OS type string 27006 000725'01 202 01 0 00 000000# movem t1, rosnpt ; Save it for k20dsp 27007 000726'01 104 00 0 00 000076 PSOUT% ; Print it 27008 000727'01 254 00 0 00 000742' else. ; Non-skip means we didn't know it 27009 000730'01 200 01 0 00 000000# sxtext (t1,) ; Give it something to type 27010 000055'03 000000000000# 27011 000476'04 125 156 153 156 157 27012 000731'01 202 01 0 00 000000# movem t1, rosnpt ; if it wants something to type 27013 000732'01 200 01 0 00 000000# txmsg < an unknown operating system type: > ; Begin the blat 27014 000733'01 104 00 0 00 000076 27015 000734'01 320 12 0 00 000735' 27016 000056'03 000000000000# 27017 000500'04 040 141 156 040 165 27018 000735'01 201 01 0 00 000101 movei t1, .priou ; Still going to the terminal 27019 000736'01 200 02 0 00 000004 move t2, t4 ; Load the code we got 27020 000737'01 201 03 0 00 000012 movei t3, ^d10 ; These are in base 10 27021 000740'01 104 00 0 00 000224 NOUT% ; Blat the code 27022 000741'01 320 12 0 00 000742' erjmpr .+1 ; Catch and ignore the error 27023 000742'01 endif. ; End OS tyoe check 27024 txmsg <] k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 17-2 K20NET MAC 15-Nov-23 19:11 Check if a connecting to a machine that supports Tops-20 NRT 27025 000742'01 200 01 0 00 000000# > 27026 000743'01 104 00 0 00 000076 27027 000744'01 320 12 0 00 000745' 27028 000057'03 000000000000# 27029 000510'04 135 015 012 000 000 27030 000745'01 135 06 0 00 005403' ldb q2,[point ^d16,cnfmsg+1,23] ; Supported protocol types bit field 27031 000746'01 602 06 0 00 000010 ifxe. q2, TOPNRT ; Anything we understand? 27032 000747'01 254 00 0 00 000756' 27033 000750'01 561 01 0 00 000704* hrroi t1, nodnam ; Begin complaining 27034 000751'01 104 00 0 00 000313 ESOUT% ; about the node 27035 txmsg <:: does not support Tops-10/Tops-20 Network Remote Terminal protocol 27036 000752'01 200 01 0 00 000000# > 27037 000753'01 104 00 0 00 000076 27038 000754'01 320 12 0 00 000755' 27039 000060'03 000000000000# 27040 000511'04 072 072 040 144 157 27041 27042 000755'01 254 00 0 00 003121' callret clsnrt ; Close the connection 27043 000756'01 endif. 27044 27045 000756'01 202 05 0 00 000000# movem q1, nrtros ; If NRT, remote operating system type 27046 000757'01 202 06 0 00 000000# movem q2, nrtprt ; Save NRT protocols offered by remote 27047 27048 000760'01 476 00 0 00 000000# setom nrtflg ; Flag this is a valid NRT 27049 000761'01 476 00 0 00 000000# setom binflg ; Flag we will do binary 27050 000762'01 254 00 0 00 000721* retskp ; Won!! 27051 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 18 K20NET MAC 15-Nov-23 19:11 List of known DECnet host operating system types 27052 subttl List of known DECnet host operating system types 27053 27054 ; The base list comes from the venerable SETHOS (hence the similar 27055 ; variable names), but it has been updated with additional systems 27056 ; from the fine folks on HECnet. 27057 ; 27058 ; Be aware that these is not the same list as the DAP list!! 27059 ; (naturally...) They're not even the same between CTerm and NRT! 27060 27061 000763'01 hsttyp: intern hsttyp ; Used by k20dsp, twoo 27062 000763'01 000000000000# eascii ;^d0 27063 000530'04 122 123 124 123 000 27064 000764'01 000000000000# eascii ;^d1 27065 000531'04 122 124 055 061 061 27066 000765'01 000000000000# eascii ;^d2 27067 000533'04 122 123 124 123 057 27068 000766'01 000000000000# eascii ;^d3 27069 000535'04 122 123 130 055 061 27070 000767'01 000000000000# eascii ;^d4 27071 000537'04 122 123 130 055 061 27072 000770'01 000000000000# eascii ;^d5 27073 000541'04 122 123 130 055 061 27074 000771'01 000000000000# eascii ;^d6 27075 000543'04 111 101 123 000 000 27076 000772'01 000000000000# eascii ;^d7 27077 000544'04 126 115 123 000 000 27078 000773'01 000000000000# eascii ;^d8 (TOPS20) 27079 000545'04 124 117 120 123 055 27080 000774'01 000000000000# eascii ;^d9 (TOPS10) 27081 000547'04 124 117 120 123 055 27082 000775'01 000000000000# eascii ;^d10 27083 000551'04 122 124 123 055 070 27084 000776'01 000000000000# eascii ;^d11 (!!) 27085 000553'04 117 123 055 070 000 27086 000777'01 000000000000# eascii ;^d12 27087 000554'04 122 123 130 055 061 27088 001000'01 000000000000# eascii ;^d13 (the DN20!!) 27089 000556'04 115 103 102 000 000 27090 001001'01 000000000000# 0 ;^d14 Reserved 27091 001002'01 000000 000000 0 ;^d15 Reserved 27092 001003'01 000000 000000 0 ;^d16 Reserved 27093 001004'01 000000 000000 0 ;^d17 Reserved 27094 001005'01 000000000000# eascii ;^d18 27095 000557'04 125 114 124 122 111 27096 000000000000# hsttyn=.-hsttyp-1 ; Number of defined operating system types 27097 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 19 K20NET MAC 15-Nov-23 19:11 DECnet interrupt message processing (unused by Kermit) 27098 subttl DECnet interrupt message processing (unused by Kermit) 27099 27100 ; Gets an prints a DECnet interrupt message (which should never happen) 27101 ; and prints it on the user's terminal. No interrupt is enabled for 27102 ; this and the condition is checked for most irregularly. 27103 27104 001006'01 intmsg: entry intmsg 27105 001006'01 265 16 0 00 005344' saveac ; Be transparent 27106 dmove t2, [ .morim ; Read interrupt message 27107 001007'01 120 02 0 00 005404' point 7,intbuf] ; Use this area 27108 001010'01 104 00 0 00 000077 MTOPR% ; Grab the message 27109 001011'01 320 12 0 00 001013' %jserr (,r) 27110 001012'01 254 00 0 00 001016' 27111 001013'01 265 01 0 00 000477* 27112 001014'01 000000000000# 27113 001015'01 254 00 0 00 000620* 27114 000561'04 125 156 141 142 154 27115 001016'01 200 01 0 00 000000# txmsg <[KERMIT-20: DECnet Interrupt Message: > 27116 001017'01 104 00 0 00 000076 27117 001020'01 320 12 0 00 001021' 27118 000061'03 000000000000# 27119 000570'04 133 113 105 122 115 27120 dmove t1, [ .priou ; Typing on terminal 27121 001021'01 120 01 0 00 005406' point 7,intbuf] ; Point where we read this foolishness 27122 001022'01 210 03 0 00 000004 movn t3,t4 ; Doing a counted print 27123 001023'01 104 00 0 00 000053 SOUT% ; Display what we got 27124 001024'01 320 12 0 00 001026' %jserr (,r) 27125 001025'01 254 00 0 00 001031' 27126 001026'01 265 01 0 00 001013* 27127 001027'01 000000000000# 27128 001030'01 254 00 0 00 001015* 27129 000600'04 125 156 141 142 154 27130 txmsg <] 27131 001031'01 200 01 0 00 000000# > ; Close alert and tie off line 27132 001032'01 104 00 0 00 000076 27133 001033'01 320 12 0 00 001034' 27134 000062'03 000000000000# 27135 000607'04 135 015 012 000 000 27136 001034'01 263 17 0 00 000000 ret ; Return with a clean register file 27137 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 20 K20NET MAC 15-Nov-23 19:11 Initialize PTY parameters (adapted from BATCON) 27138 subttl Initialize PTY parameters (adapted from BATCON) 27139 27140 001035'01 inipty: entry inipty 27141 001035'01 200 01 0 00 005410' movx t1, 'TTYJOB' ; Terminal line to job number and 'hungry' 27142 001036'01 104 00 0 00 000016 SYSGT% ; Get the values 27143 001037'01 320 12 0 00 001041' ifje. r ; Fetch error for debugger 27144 001040'01 254 00 0 00 001043' 27145 001041'01 403 02 0 00 000000# setzb t2, ttygtb ; Set an impossible value 27146 001042'01 254 00 0 00 001044' else. ; Otherwise, JSYS worked 27147 001043'01 202 02 0 00 000000# movem t2, ttygtb ; So store something useful 27148 001044'01 endif. ; End case JSYS error handling 27149 27150 001044'01 200 01 0 00 005411' movx t1, 'PTYPAR' ; pseudo terminal configuration info 27151 001045'01 104 00 0 00 000016 SYSGT% ; Get the values 27152 001046'01 320 12 0 00 001050' ifje. r ; Fetch error for debugger 27153 001047'01 254 00 0 00 001052' 27154 001050'01 200 03 0 00 000001 move t3,t1 ; Save error 27155 001051'01 477 01 0 00 000002 setob t1,t2 ; Load a impossible values 27156 001052'01 endif. ; End case JSYS error handling 27157 27158 001052'01 572 01 0 00 000000# hrrem t1,pty1st ; Save TTY number of first PTY 27159 001053'01 576 01 0 00 000000# hlrem t1,ptycnt ; Save count of pseudo-terminals 27160 001054'01 202 02 0 00 000000# movem t2,ptygtb ; GETAB% index (which we'll never use) 27161 27162 001055'01 263 17 0 00 000000 ret ; Done 27163 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 21 K20NET MAC 15-Nov-23 19:11 PTY acquisition 27164 subttl PTY acquisition 27165 27166 ; Assign a PTY to use. This is necessary because, between the time we 27167 ; find a free PTY and the time we actually OPENF% it, somebody else may 27168 ; have already grabbed it. 27169 ; 27170 ; Another way to 'lock' the PTY for exclusive use is simply to open it. 27171 ; The approach of doing an ASND% is superior to this because the PTY 27172 ; can be opened as convenient and, if closed, can still be reused. 27173 ; Otherwise we'd have to go through this whole rigmarole again. 27174 ; 27175 ; Adapted from BATCON, which does an assign by ASND% as apposed to Phase 27176 ; II NRTSRV which assigns by OPENF%. 27177 ; 27178 ; Returns: 27179 ; 27180 ; t1/ Loopback terminal line 27181 ; t2/ Assigned PTY designator 27182 ; 27183 ; N.B., Always have to start with the first PTY and go through all of 27184 ; them because one of them may have become free. 27185 ; 27186 ; Be aware that, if you have more than one Kermit fork in a job doing 27187 ; pseudo-terminal based transfers, then this code will do the wrong 27188 ; thing because a single PTY is assumed to be used per job. There is 27189 ; no expectation of any problem as pseudo-terminals are only used for 27190 ; debugging, testing and prototyping. 27191 27192 001056'01 asipty: entry asipty ; Called by k20mit, also 27193 001056'01 265 16 0 00 005412' saveac ; Leave the registers alone 27194 27195 001057'01 402 00 0 00 000000# setzm ptyflg ; Not doing pseudo-terminals 27196 001060'01 402 00 0 00 000000# setzm binflg ; Not doing binary 27197 001061'01 336 00 0 00 000262* ifmn. asgflg ; Did we have an assigned device? 27198 001062'01 254 00 0 00 001105' 27199 001063'01 336 01 0 00 000263* skipn t1,asgdev ; That is, if we still know it 27200 001064'01 254 00 0 00 001105' anskp. ; Shouldn't happen, but... 27201 001065'01 104 00 0 00 000117 DVCHR% ; Pull the device characteristics 27202 001066'01 320 12 0 00 001070' ifje. r ; Trap error, record it 27203 001067'01 254 00 0 00 001072' 27204 001070'01 200 04 0 00 000001 move t4,t1 ; Get the error out of the way 27205 001071'01 403 01 0 00 000002 setzb t1,t2 ; Claim impossible values 27206 001072'01 endif. ; End JSYS error trap 27207 001072'01 312 01 0 00 001063* came t1,asgdev ; Double check; it's the same, right? 27208 001073'01 254 00 0 00 001105' anskp. ; Different somehow, so don't try to reuse it 27209 001074'01 135 04 0 00 005426' ldb t4,[pointr t2,dv%typ] ;Load the device type 27210 001075'01 302 04 0 00 000013 caie t4,.dvpty ; Is it a pseudo-terminal? 27211 001076'01 254 00 0 00 001105' anskp. ; No, so it is useless for loop back 27212 001077'01 574 04 0 00 000003 hlre t4,t3 ; Pick up the assigned job 27213 001100'01 312 04 0 00 000000* came t4,myjob ; Is it me? 27214 001101'01 254 00 0 00 001105' anskp. ; No, get our own, then 27215 remark t1,t2 ; Device designator and charteristics words loaded 27216 001102'01 476 00 0 00 000000# setom ptyflg ; Flag we have a pseudo-terminal 27217 001103'01 476 00 0 00 000000# setom binflg ; And that it will do binary 27218 001104'01 254 00 0 00 000762* retskp ; Return success, device string already built k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 21-1 K20NET MAC 15-Nov-23 19:11 PTY acquisition 27219 001105'01 endif. ; End case attempting device reu-se 27220 27221 001105'01 402 00 0 00 001061* setzm asgflg ; Nothing assigned 27222 001106'01 402 00 0 00 001072* setzm asgdev ; So no assigned device 27223 001107'01 337 05 0 00 000000# skipg q1,ptycnt ; Load and check count of ptys 27224 001110'01 263 17 0 00 000000 ret ; Give up right now 27225 001111'01 335 06 0 00 000000# skipge q2,pty1st ; Load line number associated with 1st PTY 27226 001112'01 263 17 0 00 000000 ret ; Don't work with junk from SYSGT% 27227 001113'01 400 07 0 00 000000 setz q3, ; Initial pseudo-terminal is PTY0: 27228 27229 001114'01 do. ; Enter loop context 27230 001114'01 205 01 0 00 600013 movsi t1,.dvdes+.dvpty ;Load pseudo-terminal device designator 27231 001115'01 540 01 0 00 000007 hrr t1,q3 ; Load the current PTY number 27232 001116'01 104 00 0 00 000117 DVCHR% ; Get device characteristics for this PTY 27233 001117'01 320 12 0 00 001121' ifje. r ; Pick up error for debugger 27234 001120'01 254 00 0 00 001122' 27235 001121'01 400 02 0 00 000000 setz t2, ; Default to not available 27236 001122'01 endif. ; End case device 27237 001122'01 607 02 0 00 010000 ifxn. t2,dv%av ; Free? (available) 27238 001123'01 254 00 0 00 001133' 27239 001124'01 120 03 0 00 000001 dmove t3,t1 ; Save designator words 27240 001125'01 104 00 0 00 000070 ASND% ; Quick! Assign it!! 27241 001126'01 320 16 0 00 001133' annje. ; Failed, do next PTY 27242 001127'01 124 03 0 00 000000# dmovem t3, ndvchr ; Save network device characteristics 27243 001130'01 476 00 0 00 001105* setom asgflg ; Assigned it. Set this flag to remember. 27244 001131'01 202 03 0 00 001106* movem t3, asgdev ; save assigned device 27245 001132'01 254 00 0 00 001136' exit. ; Got it! We're done 27246 001133'01 endif. ; End availibility/assignment attempt 27247 001133'01 114 06 0 00 005427' dadd q2,[exp 1,1] ; Bump both PTY and TTY numbers (clever) 27248 001134'01 367 05 0 00 001114' sojg q1,top. ; Try next pty 27249 001135'01 263 17 0 00 000000 ret ; Otherwise, couldn't get anything, fail 27250 001136'01 enddo. ; Exit loop context 27251 27252 001136'01 200 07 0 00 000001 move q3,t1 ; Save assigned PTY device 27253 001137'01 200 02 0 00 000001 move t2,t1 ; Use it here, too 27254 001140'01 561 01 0 00 000000# hrroi t1,ptynam ; Point to area to write PTY specification 27255 001141'01 104 00 0 00 000121 DEVST% ; Turn device into string 27256 001142'01 320 12 0 00 001030* erjmpr r ; Fail, we just assigned the device! 27257 27258 001143'01 201 02 0 00 000072 movei t2,":" ; Load terminating device punctuation 27259 001144'01 136 02 0 00 000001 idpb t2,t1 ; Complete device syntax 27260 001145'01 400 02 0 00 000000 setz t2, ; Load .chnul 27261 001146'01 136 02 0 00 000001 idpb t2,t1 ; Tie off the string 27262 27263 001147'01 205 02 0 00 600012 movsi t2,.dvdes+.dvtty ; Load terminal device designator 27264 001150'01 540 02 0 00 000006 hrr t2,q2 ; Build complete terminal designator 27265 001151'01 202 02 0 00 000000# movem t2,ptytty ; Store in case we need to manipulate it 27266 27267 001152'01 561 01 0 00 000000# hrroi t1,ttynam ; Point to area to write TTY specification 27268 001153'01 104 00 0 00 000121 DEVST% ; Turn device into string 27269 001154'01 320 12 0 00 001142* erjmpr r ; Fail, we just assigned the device! 27270 27271 001155'01 201 02 0 00 000072 movei t2,":" ; Load terminating device punctuation 27272 001156'01 136 02 0 00 000001 idpb t2,t1 ; Complete device syntax 27273 001157'01 400 02 0 00 000000 setz t2, ; Load .chnul k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 21-2 K20NET MAC 15-Nov-23 19:11 PTY acquisition 27274 001160'01 136 02 0 00 000001 idpb t2,t1 ; Tie off the string 27275 27276 001161'01 476 00 0 00 000000# setom ptyflg ; Flag we have a pseudo-terminal 27277 001162'01 476 00 0 00 000000# setom binflg ; And that it will do binary 27278 001163'01 120 01 0 00 000006 dmove t1,q2 ; Load terminal number and PTY designator 27279 001164'01 254 00 0 00 001104* retskp ; Done 27280 27281 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 22 K20NET MAC 15-Nov-23 19:11 Externals for Alternate Network Code 27282 subttl Externals for Alternate Network Code 27283 27284 extern doesc ; Label of main loop for escape character handling 27285 extern duplex ; Whether we're echoing or not 27286 extern echo ; Routine for local echoing 27287 extern escape ; Escape character for connecting (default ^\) 27288 extern vtermf ; Not running on real copper 27289 extern netlgx ; Label to continue error log handling 27290 extern ttfork ; Fork number of the connect receive fork. 27291 extern ttinch ; Label of main keyboard input loop 27292 extern tter1 ; Label for terminal error handling 27293 extern carier ; Carrier flag (also means connected) 27294 extern $connx ; Close connection for a physical line 27295 extern frkchn ; Fork channel interrupt number 27296 extern mdmlin ; -1 = modem-controlled line, 0 = not. 27297 extern sesjfn ; Session log file JFN. 27298 extern sesflg ; Whether the session log is active 27299 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 23 K20NET MAC 15-Nov-23 19:11 Execute the SET LINE command 27300 subttl Execute the SET LINE command 27301 27302 ; SET LINE is almost exactly like CONNECT, except that confirming a 27303 ; CONNECT with no arguments reconnects to an existing connection 27304 ; whereas confirming a SET LINE with no arguments CLOSES the 27305 ; connection. A subtle difference... 27306 ; 27307 ; $CONNE now has all the hairy connection logic, no matter the 27308 ; connection type, PTY, line, NRT, Etc. This routine is simply taking 27309 ; care of a historical special case. 27310 ; 27311 ;Call: 27312 ; 27313 ;pars3/ Parse type: .cmkey, .cmnod, .cmnum, Etc. 27314 ;pars4/ Device information: type, unit, line number, Etc. 27315 27316 001165'01 $setln: entry $setln 27317 001165'01 265 16 0 00 005273' saveac ;[218] Parse item 27318 001166'01 120 05 0 00 000000* dmove q1, pars3 ;[218] Load parse type and unit 27319 001167'01 302 05 0 00 000010 caie q1, .cmcfm ;[218] Wanted to close? 27320 001170'01 254 00 0 00 001203' ifskp. ;[218] We did, so let's do that 27321 001171'01 333 07 0 00 000634* skiple q3, netjfn ;[218] Umm, do we have a connection? 27322 001172'01 254 00 0 00 001176' ifskp. ;[218] We do not, so nothing to do 27323 001173'01 200 01 0 00 000000# emsg ;[218] 27324 001174'01 104 00 0 00 000313 27325 000063'03 000000000000# 27326 000610'04 116 157 040 157 160 27327 001175'01 263 17 0 00 000000 ret ;[218] Nothing further to do 27328 001176'01 endif. ;[218] Otherwise, something is up 27329 001176'01 260 17 0 00 003044' call clsjfn ;[218] Stomp the network connection 27330 txmsg <[Connection closed] 27331 001177'01 200 01 0 00 000000# > ;[218] Say it's all over 27332 001200'01 104 00 0 00 000076 27333 001201'01 320 12 0 00 001202' 27334 000064'03 000000000000# 27335 000616'04 133 103 157 156 156 27336 27337 001202'01 263 17 0 00 000000 ret ;[218] End we're done 27338 001203'01 endif. ;[218] End case confirming to close 27339 27340 001203'01 254 00 0 00 001204' callret $conne ;[218] The rest is just like CONNECT 27341 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 24 K20NET MAC 15-Nov-23 19:11 CONNECT command 27342 subttl CONNECT command 27343 27344 ;[151] CONNECT code totally rewritten as Edit 151. Formerly, CONNECT was 27345 ; accomplished by running a program TTLINK in a lower fork. Now, the 27346 ; code is integrated into this program. This was done for two reasons: 27347 ; 27348 ; 1. V6 of TOPS-20 doesn't allow multiple JFNs on the same TTY device. 27349 ; [V7 has yet to be vetted] 27350 ; 2. TTLINK was interrupt-driven and therefore did not work under batch. 27351 ; 27352 ; This method, similar to that used in Mark Crispin's TELNET program, uses 27353 ; separate input and output forks. It works under batch because the "pty" 27354 ; is always "hungry". 27355 ; 27356 ;[187] This isn't quite true. TELNET can't run well under Batch precisely 27357 ; BECAUSE of the asynchronous forks. Actually, it really doesn't work 27358 ; at all. 27359 ; 27360 ; The Batch paradigm is fundamentally line half-duplex. This means 27361 ; that a line of input is pushed into a PTY and a response is checked 27362 ; for. The PTY may, in fact, NOT be hungry because the program is 27363 ; busy performing the requested command. 27364 ; 27365 ; When running asynchronously, the PTY will ALWAYS look hungry since 27366 ; the fork that is waiting for the input may not even be on the same 27367 ; system. This means that BATCON will continuously stuff input until 27368 ; something goes wrong. If a command fails, then a number of commands 27369 ; will have been typed ahead with unpredictable (or even catastrophic) 27370 ; results. 27371 ; 27372 ; A local modification to BATCON implements a Batch WAIT command, 27373 ; which causes BATCON to ignore PTY hungry for the indicated number of 27374 ; seconds to give whatever is on the other side of the PTY time to 27375 ; type something. It is, at best, a hack. 27376 ; 27377 ; It's best to not use the fork at all and go with a CONNECT/STAY and 27378 ; from there user use the INPUT and OUTPUT commands. 27379 ; 27380 ; Parse results usage: 27381 ; 27382 ; pars3/ COMND% parse type (.cmkey, .cmcfm,.cmnod, Etc.) 27383 ; pars4/ COMND% parsed value (number, node, device or fork handle) 27384 ; pars5/ Whether connecting immediately or staying at local host 27385 ; pars6/ Value of /TIMEOUT parameter, if given 27386 ; pars7/ Whether using MTOPR% .MOSNH or handling communications in user mode 27387 27388 001204'01 $conne: entry $conne ;[186] Invoked from k20mit 27389 extern ttsfrk ;[186] Joins k20mit here 27390 27391 001204'01 335 01 0 00 001166* skipge t1, pars3 ;[186] Load the parse type 27392 001205'01 201 01 0 00 000010 movx t1, .cmcfm ;[186] If junk, use confirm 27393 27394 001206'01 302 01 0 00 000010 caie t1, .cmcfm ;[186] Confirmed (reconnect)? 27395 001207'01 254 00 0 00 001254' ifskp. ;[186] Yes, let's see if that makes sense 27396 001210'01 333 02 0 00 000000# skiple t2, opndev ;[186] Load currently connected device k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 24-1 K20NET MAC 15-Nov-23 19:11 CONNECT command 27397 001211'01 254 00 0 00 001215' ifskp. ;[186] Junk?? 27398 emsg ;[186] Shouldn't happen. Ever 27400 001213'01 104 00 0 00 000313 27401 000065'03 000000000000# 27402 000623'04 116 157 164 150 151 27403 27404 001214'01 263 17 0 00 000000 ret ;[186] Do not continue 27405 001215'01 endif. ;[186] End case absurd open device 27406 27407 001215'01 332 00 0 00 000232* ifme. local ;[186] Remote? 27408 001216'01 254 00 0 00 001223' 27409 001217'01 201 01 0 00 000001 movei t1, .cmnum ;[186] Can't connect to ourself 27410 001220'01 200 02 0 00 000000* move t2, mytty ;[186] So pretend we tried 27411 001221'01 124 01 0 00 001204* dmovem t1, pars3 ;[186] Stomp the parse 27412 001222'01 254 00 0 00 001254' jrst $conn1 ;[186] and carry on, eventualy to fail 27413 001223'01 endif. ;[186] End case remote reconnect 27414 27415 001223'01 302 02 0 00 000013 caie t2, .dvpty ;[186] Reconnect a PTY? 27416 001224'01 254 00 0 00 001230' ifskp. ;[186] Yes, fake that out 27417 001225'01 201 01 0 00 000000 movei t1, .cmkey ;[186] Pretend we parsed a keyword 27418 001226'01 124 01 0 00 001221* dmovem t1, pars3 ;[186] Stomp that in 27419 001227'01 254 00 0 00 001254' jrst $conn1 ;[186] Continue (re)connect 27420 001230'01 endif. ;[186] End case PTY reconnection 27421 27422 001230'01 302 02 0 00 000012 caie t2, .dvtty ;[186] Reconnect a physical terminal? 27423 001231'01 254 00 0 00 001236' ifskp. ;[186] Yes, fake that out 27424 001232'01 201 01 0 00 000001 movei t1, .cmnum ;[186] Pretend we parsed a number 27425 001233'01 200 02 0 00 000217* move t2, ttynum ;[186] Which is the currently open terminal 27426 001234'01 124 01 0 00 001226* dmovem t1, pars3 ;[186] Stomp that in and continue 27427 001235'01 254 00 0 00 001254' jrst $conn1 ;[186] Continue (re)connect 27428 001236'01 endif. ;[186] End case terminal reconnection 27429 27430 001236'01 302 02 0 00 000022 caie t2, .dvdcn ;[186] Reconnect an NRT? 27431 001237'01 254 00 0 00 001247' ifskp. ;[186] Yes, fake that out 27432 001240'01 201 01 0 00 000026 movei t1, .cmnod ;[186] Pretend we parsed a node 27433 001241'01 124 01 0 00 001234* dmovem t1, pars3 ;[186] Stomp that in 27434 001242'01 332 00 0 00 000000# skipe forkls ;[236] Wasn't in a forkless connect? 27435 001243'01 476 00 0 00 000000* setom pars7 ;[236] Pretend we parsed the /FORKLESS switch 27436 001244'01 120 03 0 00 000750* dmove t3, nodnam ;[186] Load current node name 27437 001245'01 124 03 0 00 000000* dmovem t3, atmbuf ;[186] Pretend we parsed it 27438 001246'01 254 00 0 00 001254' jrst $conn1 ;[186] Continue (re)connect 27439 001247'01 endif. ;[186] End case NRT reconnection 27440 27441 001247'01 334 01 0 00 000000# ermsg% (, r) 27442 001250'01 254 00 0 00 001254' 27443 001251'01 202 01 0 00 000000* 27444 001252'01 104 00 0 00 000313 27445 001253'01 254 00 0 00 001154* 27446 000066'03 000000000000# 27447 000632'04 113 105 122 115 111 27448 27449 001254'01 endif. ;[186] End case ,cmcfm 27450 27451 001254'01 302 01 0 00 000001 $conn1: caie t1, .cmnum ;[186] Parsed a number? k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 24-2 K20NET MAC 15-Nov-23 19:11 CONNECT command 27452 001255'01 254 00 0 00 001273' ifskp. ;[186] Yes, wants a physical line 27453 001256'01 331 02 0 00 000000* skipl t2, pars4 ;[186] Sanity check the number 27454 001257'01 254 00 0 00 001263' ifskp. ;[186] Don't let's be silly... 27455 emsg ;[186] An appropriate Vulcan response 27457 001261'01 104 00 0 00 000313 27458 000067'03 000000000000# 27459 000642'04 116 145 147 141 164 27460 27461 001262'01 263 17 0 00 000000 ret ;[186] And get out of here 27462 001263'01 endif. ;[186] End case negative number 27463 27464 001263'01 312 02 0 00 001220* came t2, mytty ;[186] Is the requested line the same as ours? 27465 001264'01 254 00 0 00 001270' ifskp. ;[186] It is silly to connect to ourselves 27466 emsg ;[187] Advise user of their confusion 27469 001266'01 104 00 0 00 000313 27470 000070'03 000000000000# 27471 000653'04 131 157 165 040 143 27472 27473 27474 001267'01 263 17 0 00 000000 ret ;[186] And get out of here 27475 001270'01 endif. ;[186] End case self-connect 27476 remark ;[186] Fine, let's try to use it 27477 001270'01 505 01 0 00 000012 hrli t1, .dvtty ;[186] Requesting a terminal 27478 001271'01 540 01 0 00 000002 hrr t1, t2 ;[186] This line 27479 001272'01 254 00 0 00 001431' jrst $conn2 ;[186] Go blat about the connection 27480 001273'01 endif. ;[186] End case physical line 27481 27482 001273'01 302 01 0 00 000000 caie t1, .cmkey ;[186] Parsed a keyword? 27483 001274'01 254 00 0 00 001346' ifskp. ;[186] Yes, let's see about that 27484 001275'01 550 01 0 00 001256* hrrz t1, pars4 ;[186] Load the requested device 27485 27486 001276'01 302 01 0 00 000015 caie t1, .dvnul ;[186] Wants to close out? 27487 001277'01 254 00 0 00 001312' ifskp. ;[186] Yes, so break the connection 27488 001300'01 332 00 0 00 001215* ifme. local ;[186] Already remote? 27489 001301'01 254 00 0 00 001305' 27490 emsg 27492 001303'01 104 00 0 00 000313 27493 000071'03 000000000000# 27494 000677'04 116 157 040 156 145 27495 27496 001304'01 263 17 0 00 000000 ret ;[186] Nothing to do, bye 27497 001305'01 endif. ;[186] End case not local 27498 001305'01 260 17 0 00 003047' call clsnet ;[186] Close whatever might be open 27499 txmsg <[Connection closed] 27500 001306'01 200 01 0 00 000000# > ;[186] Should say connection with what... 27501 001307'01 104 00 0 00 000076 27502 001310'01 320 12 0 00 001311' 27503 000072'03 000000000000# 27504 000706'04 133 103 157 156 156 27505 27506 001311'01 263 17 0 00 000000 ret ;[186] Proceed no further k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 24-3 K20NET MAC 15-Nov-23 19:11 CONNECT command 27507 001312'01 endif. ;[186] End case closure 27508 27509 001312'01 302 01 0 00 000013 caie t1, .dvpty ;[186] Wants local loopback, differet job? 27510 001313'01 254 00 0 00 001316' ifskp. ;[186] Fine, let's try to use it 27511 001314'01 525 01 0 00 000013 hrloi t1, .dvpty ;[186] We don't specify the pseudo terminal 27512 001315'01 254 00 0 00 001431' jrst $conn2 ;[186] Go blat about the connection 27513 001316'01 endif. ;[186] 27514 27515 001316'01 302 01 0 00 000403 caie t1, .dvpip ;[186] Local connection, same job? 27516 001317'01 254 00 0 00 001323' ifskp. ;[186] Ok, handle that 27517 emsg () 27519 001321'01 104 00 0 00 000313 27520 000073'03 000000000000# 27521 000713'04 123 141 155 145 040 27522 27523 001322'01 263 17 0 00 000000 ret ;[186] Nothing to do, bye 27524 001323'01 endif. ;[186] End case doing a pipe 27525 27526 001323'01 302 01 0 00 777774 caie t1, .fhinf ;[205] Wants to get rid of the terminal fork? 27527 001324'01 254 00 0 00 001341' ifskp. ;[205] Does, so no 'network' activity 27528 001325'01 333 01 0 00 000000* skiple t1, ttfork ;[205] Load the fork handle 27529 001326'01 254 00 0 00 001332' ifskp. ;[205] Unless there isn't one 27530 emsg ;[205] Blat about it 27532 001330'01 104 00 0 00 000313 27533 000074'03 000000000000# 27534 000727'04 116 157 040 162 145 27535 27536 001331'01 254 00 0 00 001337' else. ;[205] Otherwise, get rid of it 27537 001332'01 104 00 0 00 000153 KFORK% ;[205] BYE!! 27538 001333'01 320 12 0 00 001334' erjmpr .+1 ;[205] Ignore error and carry on 27539 txmsg <[Killed remote terminal fork] 27540 001334'01 200 01 0 00 000000# > ;[205] 27541 001335'01 104 00 0 00 000076 27542 001336'01 320 12 0 00 001337' 27543 000075'03 000000000000# 27544 000736'04 133 113 151 154 154 27545 27546 001337'01 endif. ;[205] End fork determination actions 27547 001337'01 402 00 0 00 001325* setzm ttfork ;[205] Remember its demise 27548 001340'01 263 17 0 00 000000 ret ;[205] And we're done 27549 001341'01 endif. ;[205] End case terminal fork management 27550 27551 001341'01 334 01 0 00 000000# ermsg% (,r) ;[186] 27552 001342'01 254 00 0 00 001346' 27553 001343'01 202 01 0 00 001251* 27554 001344'01 104 00 0 00 000313 27555 001345'01 254 00 0 00 001253* 27556 000076'03 000000000000# 27557 000745'04 113 105 122 115 111 27558 27559 001346'01 endif. ;[186] End case .cmkey 27560 27561 001346'01 302 01 0 00 000026 caie t1, .cmnod ;[186] Parsed a node? k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 24-4 K20NET MAC 15-Nov-23 19:11 CONNECT command 27562 001347'01 254 00 0 00 001424' ifskp. ;[186] Yes, wants to have excitement and adventure! 27563 001350'01 415 16 0 00 001374' block. ;[186] Allocate an anonymous stkvar 27564 001351'01 261 17 0 00 000016 27565 001352'01 265 16 0 00 000000* anstkv(t4,<.ndnum+1>);[186] Allocate a block for NODE% 27566 001353'01 000000 000003 27567 001354'01 415 04 0 17 777774 27568 001355'01 561 01 0 00 001245* hrroi t1, atmbuf ;[186] Point to whatever user typed 27569 001356'01 202 01 0 04 000000 movem t1, .ndnod(t4) ;[186] Store in block 27570 001357'01 403 01 0 00 000002 setzb t1, t2 ;[186] Cons up some zeros 27571 001360'01 124 01 0 04 000001 dmovem t1, .ndflg(t4) ;[186] Stomp flags and number 27572 001361'01 201 01 0 00 000023 movei t1, .ndvfx ;[186] Node name verify, extended 27573 001362'01 336 00 0 00 000000# skipn ndvfxp ;[186] Has extended verify? 27574 001363'01 201 01 0 00 000015 movx t1, .ndvfy ;[186] Unfortunate, but still doable 27575 001364'01 200 02 0 00 000004 move t2, t4 ;[186] Load base of block 27576 001365'01 104 00 0 00 000567 NODE% ;[186] Should work because .cmnod validates 27577 001366'01 320 12 0 00 001370' ifje. r ;[186] Failed?? 27578 001367'01 254 00 0 00 001372' 27579 001370'01 403 02 0 00 000003 setzb t2, t3 ;[186] Whack any supposed flags 27580 001371'01 254 00 0 00 001373' else. ;[186] Otherwise, worked 27581 001372'01 120 02 0 04 000001 dmove t2, .ndflg(t4) ;[186] Load flags and maybe number 27582 001373'01 endif. ;[186] End JSYS error processing 27583 001373'01 263 17 0 00 000000 endbk. ;[186] End block, restore stack 27584 001374'01 603 02 0 00 200000 ifxe. t2, nd%lgl ;[186] Illegal in some way? 27585 001375'01 254 00 0 00 001405' 27586 001376'01 200 01 0 00 000000# emsg ;[186] Blat about it 27587 001377'01 104 00 0 00 000313 27588 000077'03 000000000000# 27589 000756'04 111 154 154 145 147 27590 001400'01 561 01 0 00 001355* hrroi t1, atmbuf ;[186] Point to what was typed 27591 001401'01 104 00 0 00 000076 PSOUT% ;[186] Type it 27592 001402'01 561 01 0 00 000672* hrroi t1, crlf ;[186] Tie off the line 27593 001403'01 104 00 0 00 000076 PSOUT% ;[186] Type it 27594 001404'01 263 17 0 00 000000 ret ;[186] Proceed no further 27595 001405'01 endif. 27596 001405'01 321 02 0 00 001415' ifxe. t2, nd%exm ;[186] Syntax correct, but do we know about it? 27597 001406'01 200 01 0 00 000000# emsg ;[186] Blat about it 27598 001407'01 104 00 0 00 000313 27599 000100'03 000000000000# 27600 000764'04 125 156 153 156 157 27601 001410'01 561 01 0 00 001400* hrroi t1, atmbuf ;[186] Point to what was typed 27602 001411'01 104 00 0 00 000076 PSOUT% ;[186] Type it 27603 001412'01 561 01 0 00 001402* hrroi t1, crlf ;[186] Tie off the line 27604 001413'01 104 00 0 00 000076 PSOUT% ;[186] Type it 27605 001414'01 263 17 0 00 000000 ret ;[186] Proceed no further 27606 001415'01 endif. 27607 001415'01 603 02 0 00 020000 txne t2, nd%num ;[186] Did T79 give us a number? 27608 001416'01 202 03 0 00 000607* movem t3, nodnum ;[186] Yes, store it 27609 001417'01 120 01 0 00 001410* dmove t1, atmbuf ;[186] Grab the atom buffer 27610 001420'01 124 01 0 00 001244* dmovem t1, nodnam ;[186] Pass to openrt 27611 001421'01 505 01 0 00 000022 hrli t1, .dvdcn ;[186] Outgoing DECnet connection 27612 001422'01 540 01 0 00 000003 hrr t1, t3 ;[186] Use node number, if we have it 27613 001423'01 254 00 0 00 001431' jrst $conn2 ;[186] And open the connection 27614 001424'01 endif. ;[186] End case node:: typed 27615 27616 001424'01 334 01 0 00 000000# ermsg% (,r) ;[186] k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 24-5 K20NET MAC 15-Nov-23 19:11 CONNECT command 27617 001425'01 254 00 0 00 001431' 27618 001426'01 202 01 0 00 001343* 27619 001427'01 104 00 0 00 000313 27620 001430'01 254 00 0 00 001345* 27621 000101'03 000000000000# 27622 000772'04 113 105 122 115 111 27623 27624 27625 ; Set up controlling TTY for talk mode, issue connect message. 27626 27627 001431'01 260 17 0 00 003377' $conn2: call openet ;[186] Go open (or reopen) the connection 27628 001432'01 263 17 0 00 000000 ret ;[186] Couldn't; proceed no further 27629 001433'01 202 01 0 00 001171* movem t1, netjfn ;[186] Store as network JFN 27630 001434'01 336 00 0 00 000000* skipn pars5 ;[205] Don't init terminal if staying 27631 001435'01 260 17 0 00 000000* call ttyini ;[186] Init controlling TTY. 27632 27633 001436'01 200 01 0 00 000000# txmsg <[KERMIT-20: > 27634 001437'01 104 00 0 00 000076 27635 001440'01 320 12 0 00 001441' 27636 000102'03 000000000000# 27637 001005'04 133 113 105 122 115 27638 001441'01 336 00 0 00 000000# ifmn. nrtflg ;[186] Active NRT connection? 27639 001442'01 254 00 0 00 001454' 27640 001443'01 200 01 0 00 000000# txmsg 27641 001444'01 104 00 0 00 000076 27642 001445'01 320 12 0 00 001446' 27643 000103'03 000000000000# 27644 001010'04 103 157 156 156 145 27645 001446'01 561 01 0 00 001420* hrroi t1,nodnam ;[186] and don't claim it is a terminal 27646 001447'01 104 00 0 00 000076 PSOUT% ;[186] instead, type the node name 27647 001450'01 200 01 0 00 000000# txmsg <::> ;[211] DECnet node punctuation 27648 001451'01 104 00 0 00 000076 27649 001452'01 320 12 0 00 001453' 27650 000104'03 000000000000# 27651 001016'04 072 072 000 000 000 27652 001453'01 254 00 0 00 001511' else. ;[186] Otherwise, use the physical line 27653 001454'01 336 00 0 00 000000# ifmn. ptyflg ;[186] Unless using a pseudo-terminal 27654 001455'01 254 00 0 00 001474' 27655 001456'01 200 01 0 00 000000# txmsg ;[186] 27656 001457'01 104 00 0 00 000076 27657 001460'01 320 12 0 00 001461' 27658 000105'03 000000000000# 27659 001017'04 114 157 157 160 142 27660 001461'01 561 01 0 00 000000# hrroi t1,sysnam ;[186] Load local node name 27661 001462'01 104 00 0 00 000076 PSOUT% ;[186] Remind us of where we are 27662 001463'01 200 01 0 00 000000# txmsg <:: via > ;[186] some more details 27663 001464'01 104 00 0 00 000076 27664 001465'01 320 12 0 00 001466' 27665 000106'03 000000000000# 27666 001024'04 072 072 040 166 151 27667 001466'01 561 01 0 00 000000# hrroi t1,ptynam ;[186] Give pseudo-terminal number 27668 001467'01 104 00 0 00 000076 PSOUT% ;[186] Type that 27669 001470'01 200 01 0 00 000000# txmsg < as > ;[186] load final clause 27670 001471'01 104 00 0 00 000076 27671 001472'01 320 12 0 00 001473' k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 24-6 K20NET MAC 15-Nov-23 19:11 CONNECT command 27672 000107'03 000000000000# 27673 001026'04 040 141 163 040 000 27674 001473'01 254 00 0 00 001477' else. ;[186] Otherwise, physical line 27675 001474'01 200 01 0 00 000000# txmsg ;[186] 27676 001475'01 104 00 0 00 000076 27677 001476'01 320 12 0 00 001477' 27678 000110'03 000000000000# 27679 001027'04 103 157 156 156 145 27680 001477'01 endif. ;[186] End case pseudo-terminal 27681 001477'01 200 01 0 00 000000# txmsg ;[186] Type message. 27682 001500'01 104 00 0 00 000076 27683 001501'01 320 12 0 00 001502' 27684 000111'03 000000000000# 27685 001036'04 124 124 131 000 000 27686 001502'01 201 01 0 00 000101 numout ttynum,^d8 ;[186] 27687 001503'01 200 02 0 00 001233* 27688 001504'01 201 03 0 00 000010 27689 001505'01 104 00 0 00 000224 27690 001506'01 320 14 0 00 001507' 27691 001507'01 201 01 0 00 000072 movei t1,":" ;[186] Extra colon to punctuate 27692 001510'01 104 00 0 00 000074 PBOUT% ;[186] DECnet node name 27693 001511'01 endif. ;[186] 27694 001511'01 332 00 0 00 001434* ifme. pars5 ;[205] Staying at remote? 27695 001512'01 254 00 0 00 001534' 27696 001513'01 200 01 0 00 000000# txmsg <, type > ;[205] No, normal blat 27697 001514'01 104 00 0 00 000076 27698 001515'01 320 12 0 00 001516' 27699 000112'03 000000000000# 27700 001037'04 054 040 164 171 160 27701 001516'01 201 01 0 00 000074 movei t1, 74 ; Left pointy bracket... 27702 001517'01 104 00 0 00 000074 PBOUT 27703 001520'01 200 01 0 00 000000# txmsg 27704 001521'01 104 00 0 00 000076 27705 001522'01 320 12 0 00 001523' 27706 000113'03 000000000000# 27707 001041'04 103 124 122 114 055 27708 001523'01 200 01 0 00 000000* move t1, escape ; (tell escape character) 27709 001524'01 271 01 0 00 000100 addi t1, "A"-1 27710 001525'01 104 00 0 00 000074 PBOUT 27711 001526'01 201 01 0 00 000076 movei t1, 76 ; ...Right pointy bracket 27712 001527'01 104 00 0 00 000074 PBOUT 27713 001530'01 200 01 0 00 000000# txmsg < to return.] > ; Tell about session log, if any. 27714 001531'01 104 00 0 00 000076 27715 001532'01 320 12 0 00 001533' 27716 000114'03 000000000000# 27717 001043'04 040 164 157 040 162 27718 001533'01 254 00 0 00 001536' else. ;[205] No, staying, so different blat 27719 001534'01 201 01 0 00 000135 movei t1, "]" ;[205] Not much blat 27720 001535'01 104 00 0 00 000074 PBOUT% ;[205] But say what there is of it... 27721 001536'01 endif. ;[205] 27722 27723 001536'01 337 02 0 00 000000* skipg t2, sesjfn ;[195] Logging? 27724 001537'01 254 00 0 00 001576' ifskp. ;[186] No, just tie off the line 27725 txmsg < 27726 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 20:02 27-Nov-23 Page 24-7 K20NET MAC 15-Nov-23 19:11 CONNECT command 27727 001541'01 104 00 0 00 000076 27728 001542'01 320 12 0 00 001543' 27729 000115'03 000000000000# 27730 001046'04 015 012 133 113 105 27731 001543'01 201 01 0 00 000101 movei t1, .priou ; Type the filename. 27732 001544'01 302 02 0 00 377777 caie t2, .nulio ;[195] Just dumping it? 27733 001545'01 254 00 0 00 001556' ifskp. ;[195] Yep that's easy 27734 001546'01 120 02 0 00 000000* dmove t2, nul4## ;[195] In k20dsp 27735 001547'01 104 00 0 00 000053 SOUT% ;[195] 27736 001550'01 320 12 0 00 001552' %jserr (,) ;[195] 27737 001551'01 254 00 0 00 001555' 27738 001552'01 265 01 0 00 001026* 27739 001553'01 000000 000000 27740 001554'01 254 00 0 00 001555' 27741 001555'01 254 00 0 00 001565' else. ;[195] Otherwise, a real file 27742 001556'01 403 03 0 00 000004 setzb t3, t4 ;[195] 27743 001557'01 104 00 0 00 000030 JFNS% 27744 001560'01 320 12 0 00 001562' %jserr (,) 27745 001561'01 254 00 0 00 001565' 27746 001562'01 265 01 0 00 001552* 27747 001563'01 000000 000000 27748 001564'01 254 00 0 00 001565' 27749 001565'01 endif. ;[195] 27750 27751 001565'01 332 00 0 00 000000* ifme. sesflg ;[195] Active? 27752 001566'01 254 00 0 00 001572' 27753 001567'01 200 01 0 00 000000# txmsg < (Disabled)> ;[195] Nyet 27754 001570'01 104 00 0 00 000076 27755 001571'01 320 12 0 00 001572' 27756 000116'03 000000000000# 27757 001055'04 040 050 104 151 163 27758 001572'01 endif. ;[195] 27759 txmsg <] 27760 001572'01 200 01 0 00 000000# > ;[195] 27761 001573'01 104 00 0 00 000076 27762 001574'01 320 12 0 00 001575' 27763 000117'03 000000000000# 27764 001060'04 135 015 012 000 000 27765 001575'01 254 00 0 00 001600' else. ;[195] Otherwise just 27766 001576'01 561 01 0 00 001412* hrroi t1,crlf ;[195] tie off the line 27767 001577'01 104 00 0 00 000076 PSOUT% 27768 001600'01 endif. ;[195] 27769 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 25 K20NET MAC 15-Nov-23 19:11 CONNECT command 27770 remark Connection is open, determine what else to do with the terminal 27771 27772 001600'01 402 00 0 00 000000# setzm forkls ;[236] Clear /FORKLESS connect unless explicitly set 27773 001601'01 336 00 0 00 001243* ifmn. pars7 ;[236] Wants /FORKLESS? 27774 001602'01 254 00 0 00 001616' 27775 001603'01 332 00 0 00 000000# ifme. nrtflg ;[236] Yes, BUT!! Are we an active NRT connection? 27776 001604'01 254 00 0 00 001612' 27777 001605'01 402 00 0 00 001601* setzm pars7 ;[236] Force parse of normal connect 27778 txmsg <% /FORKLESS is only valid for DECnet connections 27779 001606'01 200 01 0 00 000000# > ;[236] Gently advise that this won't work... 27780 001607'01 104 00 0 00 000076 27781 001610'01 320 12 0 00 001611' 27782 000120'03 000000000000# 27783 001061'04 045 040 057 106 117 27784 27785 001611'01 254 00 0 00 001616' jrst $conn3 ;[236] And get on with it the olde-fashioned way 27786 001612'01 endif. ;[236] End case clearing /FORKLESS for non-NRT 27787 remark ;[236] Otherwise, flag other code we're doing /FORKLESS 27788 001612'01 476 00 0 00 000000# setom forkls ;[236] Flag doing a forkless NRT connect 27789 001613'01 332 00 0 00 001511* skipe pars5 ;[236] But! Doesn't actually want to connect yet? 27790 001614'01 263 17 0 00 000000 ret ;[236] We're done 27791 001615'01 254 00 0 00 001621' callret frklsc ;[236] Falls into the below (but saves a JRST 27792 001616'01 endif. ;[236] End case handling a /FORKLESS connection 27793 27794 001616'01 332 00 0 00 001613* $conn3: skipe pars5 ;[218] Doesn't want to connect terminal yet? 27795 001617'01 263 17 0 00 000000 ret ;[218] We're done 27796 001620'01 254 00 0 00 000000* callret ttsfrk ;[218] Otherwise, set up the forks and terminal 27797 27798 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 26 K20NET MAC 15-Nov-23 19:11 Forkless terminal connect 27799 subttl Forkless terminal connect 27800 27801 001621'01 frklsc: entry frklsc ;[236] Invoked by K20MIT, also 27802 001621'01 415 16 0 00 001735' block. ;[236] Otherwise, connect terminal via the monitor!! 27803 001622'01 261 17 0 00 000016 27804 001623'01 265 16 0 00 001352* anstkv(t4,.shlen) ;[236] Allocate a block for the MTOPR% 27805 001624'01 000000 000003 27806 001625'01 415 04 0 17 777774 27807 27808 remark ;[236] Construct block items 27809 001626'01 201 01 0 00 000003 movx t1, .shlen ;[236] Load length of argument block 27810 001627'01 550 02 0 00 000000* hrrz t2, ttyjfn ;[236] Only connecting our controlling terminal 27811 001630'01 550 03 0 00 001523* hrrz t3, escape ;[236] Load the escape character 27812 001631'01 332 00 0 00 000000* skipe flow ;[236] Doing flow control? 27813 001632'01 661 03 0 00 400000 txo t3, sh%lpm ;[236] Yes, turn on local page mode 27814 27815 remark ;[236] Populate the block 27816 001633'01 124 01 0 04 000000 dmovem t1, .sharg(t4) ;[236] Set first two words of the argument block 27817 001634'01 202 03 0 04 000002 movem t3, .shesc(t4) ;[236] Third word is escape character and flags 27818 27819 remark ;[236] Finally do the connect!!! 27820 001635'01 550 01 0 00 001433* hrrz t1, netjfn ;[236] Load the network JFN 27821 001636'01 201 02 0 00 000044 movx t2, .mosnh ;[236] Function is monitor NRT connect 27822 001637'01 200 03 0 00 000004 move t3, t4 ;[236] Load address of argument block 27823 001640'01 104 00 0 00 000077 MTOPR% ;[236] Do the connect 27824 001641'01 320 12 0 00 001643' %jserr (,r) ;[236] 27825 001642'01 254 00 0 00 001646' 27826 001643'01 265 01 0 00 001562* 27827 001644'01 000000000000# 27828 001645'01 254 00 0 00 001430* 27829 001074'04 125 156 141 142 154 27830 27831 001646'01 550 01 0 04 000001 hrrz t1, .shtty(t4) ;[236] Load terminal identifier we used 27832 001647'01 104 00 0 00 000050 BIN% ;[236] Swallow escape character it leaves in buffer 27833 001650'01 320 12 0 00 001652' %jserr (,r) ;[236] 27834 001651'01 254 00 0 00 001655' 27835 001652'01 265 01 0 00 001643* 27836 001653'01 000000000000# 27837 001654'01 254 00 0 00 001645* 27838 001104'04 125 156 141 142 154 27839 27840 001655'01 550 01 0 00 001635* hrrz t1, netjfn ;[236] Load the network JFN 27841 001656'01 260 17 0 00 004126' call chkdcn ;[236] Returned; get link status 27842 001657'01 332 00 0 00 000000* ifme. carier ;[236] Got disconnected? 27843 001660'01 254 00 0 00 001733' 27844 001661'01 607 03 0 00 004000 ifxn. t3,mo%syn ;[236] Normal close and 27845 001662'01 254 00 0 00 001677' 27846 001663'01 603 03 0 00 010000 andxe. t3,mo%abt ;[236] not aborted? 27847 001664'01 254 00 0 00 001677' 27848 001665'01 400 04 0 00 000000 setz t4, ;[236] Flag a normal close 27849 001666'01 200 01 0 00 000000# txmsg (<[KERMIT-20: >) ;[236] Yes, begin blat ']' (emacs) 27850 001667'01 104 00 0 00 000076 27851 001670'01 320 12 0 00 001671' 27852 000121'03 000000000000# 27853 001116'04 133 113 105 122 115 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 26-1 K20NET MAC 15-Nov-23 19:11 Forkless terminal connect 27854 001671'01 561 01 0 00 001446* hrroi t1,nodnam ;[236] Point to the remote node 27855 001672'01 104 00 0 00 000076 PSOUT% ;[236] Type it 27856 001673'01 200 01 0 00 000000# txmsg <:: has closed> ;[236] 27857 001674'01 104 00 0 00 000076 27858 001675'01 320 12 0 00 001676' 27859 000122'03 000000000000# 27860 001121'04 072 072 040 150 141 27861 001676'01 254 00 0 00 001707' else. ;[236] Otherwise, abnormal close 27862 001677'01 474 04 0 00 000000 seto t4, ;[236] Flag an ABNORMAL close 27863 001700'01 200 01 0 00 000000# emsg () ;[236] Begin an error message 27864 001701'01 104 00 0 00 000313 27865 000123'03 000000000000# 27866 001124'04 113 105 122 115 111 27867 001702'01 561 01 0 00 001671* hrroi t1,nodnam ;[236] Point to the remote node 27868 001703'01 104 00 0 00 000076 PSOUT% ;[236] Type it 27869 001704'01 200 01 0 00 000000# txmsg <:: has aborted> ;[236] 27870 001705'01 104 00 0 00 000076 27871 001706'01 320 12 0 00 001707' 27872 000124'03 000000000000# 27873 001127'04 072 072 040 150 141 27874 001707'01 endif. ;[236] End case link closure analysis 27875 001707'01 200 01 0 00 000000# txmsg (< the NRT connection because: >) ;[236] 27876 001710'01 104 00 0 00 000076 27877 001711'01 320 12 0 00 001712' 27878 000125'03 000000000000# 27879 001132'04 040 164 150 145 040 27880 001712'01 260 17 0 00 002330' call gdscpt ;[236] Get pointer to disconnect reason 27881 001713'01 104 00 0 00 000076 PSOUT% ;[236] Type it 27882 001714'01 200 01 0 00 000000# txmsg <. Returning to > ;[236] Emphasize we're not there anymore 27883 001715'01 104 00 0 00 000076 27884 001716'01 320 12 0 00 001717' 27885 000126'03 000000000000# 27886 001140'04 056 040 122 145 164 27887 001717'01 561 01 0 00 000000# hrroi t1,sysnam ;[236] Load local node name 27888 001720'01 104 00 0 00 000076 PSOUT% ;[236] and type it 27889 001721'01 200 01 0 00 000000# txmsg <::> ;[236] Punctuate the local node name 27890 001722'01 104 00 0 00 000076 27891 001723'01 320 12 0 00 001724' 27892 000127'03 000000000000# 27893 001144'04 072 072 000 000 000 27894 001724'01 326 04 0 00 001727' ife. t4 ;[236] Did it close normally? 27895 001725'01 201 01 0 00 000135 movx t1,135 ;[236] It did, so load a closing brocket 27896 001726'01 104 00 0 00 000074 PBOUT% ;[236] Type it to close off the message 27897 001727'01 endif. ;[236] End case properly formating informative message 27898 001727'01 561 01 0 00 001576* hrroi t1, crlf ;[236] Tie off the line 27899 001730'01 104 00 0 00 000076 PSOUT% ;[236] 27900 001731'01 260 17 0 00 003121' call clsnrt ;[236] Toss the NRT connection 27901 001732'01 263 17 0 00 000000 ret ;[236] Either way, return; we're done 27902 001733'01 endif. ;[236] End case disconnected 27903 27904 001733'01 254 00 0 00 001164* retskp ;[236] Otherwise, worked and they typed the escape 27905 001734'01 263 17 0 00 000000 endbk. ;[236] End block context 27906 001735'01 254 00 0 00 001740' ifskp. ;[236] Worked? 27907 001736'01 254 00 0 00 000000* callret doesc ;[236] It did, and the user typed the escape character 27908 001737'01 254 00 0 00 001741' else. ;[236] Something failed k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 26-2 K20NET MAC 15-Nov-23 19:11 Forkless terminal connect 27909 001740'01 263 17 0 00 000000 ret ;[236] Just get out of here 27910 001741'01 endif. ;[236] 27911 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 27 K20NET MAC 15-Nov-23 19:11 BOUTR% - BOUT% a Record 27912 subttl BOUTR% - BOUT% a Record 27913 27914 ; Necessary when doing DECnet to get a character pushed 27915 ; 27916 ; t1/ Network JFN 27917 ; t2/ Character to send 27918 ; 27919 ; Inefficient, you say? Clearly you haven't seen the code in the 27920 ; monitor that does a 'push'... 27921 ; 27922 ; Note use of anonymous stkvar to enable full re-entrancy while 27923 ; limiting symbol table usage. 27924 ; 27925 ; To do: Is a ROT and movem faster? Probably 27926 27927 001741'01 BOUTR%: entry BOUTR% ; Used in mainline 27928 001741'01 332 00 0 00 000231* ifme. vtermf ; Not a Virtual Terminal? 27929 001742'01 254 00 0 00 001752' 27930 001743'01 104 00 0 00 000051 BOUT% ; Just send the character out 27931 001744'01 320 12 0 00 001746' %jserr (,r) 27932 001745'01 254 00 0 00 001751' 27933 001746'01 265 01 0 00 001652* 27934 001747'01 000000000000# 27935 001750'01 254 00 0 00 001654* 27936 001145'04 102 117 125 124 122 27937 001751'01 254 00 0 00 001733* retskp ; Otherwise, worked!! 27938 001752'01 endif. ; End case regular line 27939 ; Otherwise, need to push it out the door 27940 remark t1,t2 ; t1 has JFN, t2 has character 27941 001752'01 265 16 0 00 005431' saveac ; Save a few things 27942 001753'01 265 16 0 00 001623* anstkv (t4,^d1) ; Allocate a one word anonymous stack variable 27943 001754'01 000000 000001 27944 001755'01 415 04 0 17 777776 27945 ; Now have something for SOUTR% to use 27946 001756'01 402 00 0 04 000000 setzm (t4) ; Clear memory (unnecessary for counted SOUTR%) 27947 001757'01 505 04 0 00 441000 hrli t4,(point 8,) ; Convert to an eight bit pointer 27948 001760'01 200 03 0 00 000004 move t3, t4 ; Make a copy of it 27949 001761'01 136 02 0 00 000003 idpb t2, t3 ; Pop the character at BEGINNING of word 27950 001762'01 200 02 0 00 000004 move t2, t4 ; Load pristine pointer for I/O 27951 001763'01 477 03 0 00 000004 setob t3, t4 ; Doing one character, no stop character 27952 001764'01 104 00 0 00 000532 SOUTR% ; Output, setting PSH 27953 001765'01 320 12 0 00 001767' ifje. r ; Catch error 27954 001766'01 254 00 0 00 001777' 27955 001767'01 200 04 0 00 000001 move t4, t1 ; Put this someplace for debuggers 27956 001770'01 334 00 0 00 000000 %ermsg (,) ; Whine 27957 001771'01 254 00 0 00 001775' 27958 001772'01 265 01 0 00 001746* 27959 001773'01 000000000000# 27960 001774'01 254 00 0 00 001775' 27961 001151'04 102 117 125 124 122 27962 001775'01 260 17 0 00 003244' call netvtx ; Whine some more 27963 001776'01 263 17 0 00 000000 ret ; Return failure 27964 001777'01 endif. ; End case JSYS error 27965 001777'01 254 00 0 00 001751* retskp ; Return success 27966 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 28 K20NET MAC 15-Nov-23 19:11 Alternate network input code (assumes upper fork context) 27967 subttl Alternate network input code (assumes upper fork context) 27968 27969 ; Special cased for NRT's in order to 'push' data on DECnet. Tested 27970 ; on PTY's, also. 27971 ; 27972 ; Characters are sent out with a 'push' by doing a record out, which 27973 ; gets them over to the remote NRT host immediately. Checks to see 27974 ; if we can bum BIN%'s with a SIN%. PTY code uses this, too. 27975 ; 27976 ; SIBE% is fine because we are looking at the local TTY 27977 ; 27978 ; N.B., We ALWAYS read 7-bit ASCII from our control terminal and may or 27979 ; may not put parity on it in for output 27980 27981 002000'01 vtmpsh: entry vtmpsh ; Jumped to by ttinch: 27982 remark q1, ; Have to validate that q1 is not in flight here 27983 27984 002000'01 do. ; Enter loop context. 27985 002000'01 200 01 0 00 001627* move t1, ttyjfn ; Wait for data on TTY 27986 002001'01 104 00 0 00 000050 BIN% ; Wakes up on anything 27987 002002'01 320 12 0 00 002004' %jserr (,tter1) ; What could happen? 27988 002003'01 254 00 0 00 002007' 27989 002004'01 265 01 0 00 001772* 27990 002005'01 000000000000# 27991 002006'01 254 00 0 00 000000* 27992 001156'04 103 141 156 047 164 27993 002007'01 350 00 0 00 000000# aos vbict ; Count a BIN% on a virtual terminal 27994 002010'01 201 04 0 00 000177 movei t4,177 ; 7 bit mask 27995 002011'01 407 02 0 00 000004 andb t2,t4 ; Stomp any foolish parity everywhere 27996 002012'01 316 02 0 00 001630* camn t2, escape ; Is it the escape character? 27997 002013'01 254 00 0 00 001736* jrst doesc ; Yes, go process single-char command. 27998 002014'01 104 00 0 00 000102 SIBE% ; Any more data to read maybe? 27999 002015'01 254 00 0 00 002043' ifskp. ; Nope, then just had this poor character 28000 002016'01 322 02 0 00 002024' ifn. t2 ; If zero, then no error and nothing to do 28001 002017'01 334 00 0 00 000000 %ermsg (,) ; But continue 28002 002020'01 254 00 0 00 002024' 28003 002021'01 265 01 0 00 002004* 28004 002022'01 000000000000# 28005 002023'01 254 00 0 00 002024' 28006 001163'04 125 156 141 142 154 28007 002024'01 endif. ; End case t2 having JSYS error code 28008 remark ; Yet contribute nothing to total 28009 002024'01 200 02 0 00 000004 move t2,t4 ; Load the character for duplex 28010 002025'01 332 00 0 00 000000* skipe duplex ; Have to echo locally? 28011 002026'01 260 17 0 00 000000* call echo ; Yes, do. 28012 002027'01 200 01 0 00 000004 move t1, t4 ;[223] Load in case parity 28013 002030'01 260 17 1 00 000000* call @parity ;[223] Do parity if asked 28014 002031'01 200 02 0 00 000001 move t2, t1 ;[223] Put whatever parity did in the right place 28015 002032'01 200 01 0 00 001655* move t1, netjfn ; Load JFN of our DCN: connection 28016 002033'01 260 17 0 00 001741' call BOUTR% ; Write and push to network 28017 002034'01 334 00 0 00 000000 %ermsg (,tter1) ; If error, go check. 28018 002035'01 254 00 0 00 002041' 28019 002036'01 265 01 0 00 002021* 28020 002037'01 000000000000# 28021 002040'01 254 00 0 00 002006* k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 28-1 K20NET MAC 15-Nov-23 19:11 Alternate network input code (assumes upper fork context) 28022 001174'04 103 141 156 047 164 28023 002041'01 350 00 0 00 000000# aos vboct ; Count it as a BOUT% 28024 002042'01 254 00 0 00 002067' else. ; Otherwise, maybe save us a few BIN%'s 28025 002043'01 301 02 0 00 002000 cail t2,linlen ; Rolling buffer plus BIN%? 28026 002044'01 201 02 0 00 001777 movei t2, ;Clip it down to fit the character we got 28027 002045'01 200 03 0 00 000002 move t3,t2 ; Load amount to read (positive!!) 28028 002046'01 200 05 0 00 000002 move t5,t2 ; Save a handy copy 28029 002047'01 272 05 0 00 000000# addm t5,vsitc ; Number of characters slurping up 28030 002050'01 313 05 0 00 000000# camle t5,vsimx ; Larger than largest we ever saw? 28031 002051'01 202 05 0 00 000000# movem t5,vsimx ; Yes, remember that 28032 002052'01 350 00 0 00 000000# aos vsict ; Count a SIN% 28033 002053'01 200 02 0 00 005441' move t2,[point 7,nrtbuf] ;Seven bit traffic 28034 002054'01 136 04 0 00 000002 idpb t4,t2 ; Deposit the BIN%'ed character 28035 002055'01 200 04 0 00 002012* move t4,escape ; Stop reading on escape character 28036 002056'01 104 00 0 00 000052 SIN% ; Slurp in a bunch of characters from user 28037 002057'01 320 12 0 00 002061' %jserr (,tter1) ; Handle any errors. 28038 002060'01 254 00 0 00 002064' 28039 002061'01 265 01 0 00 002036* 28040 002062'01 000000000000# 28041 002063'01 254 00 0 00 002040* 28042 001200'04 103 141 156 047 164 28043 002064'01 260 17 0 00 002071' call vtmout ; Output it 28044 002065'01 254 00 0 00 002063* jrst tter1 ; Failed somehow 28045 002066'01 326 05 0 00 002013* jumpn t5,doesc ; Use talisman to handle escape 28046 002067'01 endif. ; Done handling results from SIBE% 28047 002067'01 254 00 0 00 002000' loop. ; Go back and do it some more 28048 002070'01 enddo. ; Exit loop context 28049 ; Should never get here, but... 28050 002070'01 254 00 0 00 000000* jrst ttinch ; Go back and do it again from the top 28051 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 29 K20NET MAC 15-Nov-23 19:11 Network fork data writer 28052 subttl Network fork data writer 28053 28054 ; Write whatever data we have to the network, type it, log it, Etc. 28055 ; 28056 ; On entry: 28057 ; 28058 ; t1/ ttyjfn 28059 ; t2/ Updated byte pointer (buffer will have at least the BIN%'ed character) 28060 ; t3/ Remaining characters in buffer 28061 ; t4/ Escape character that may have stopped us 28062 ; t5/ Original buffer length 28063 ; 28064 ; AC usage: 28065 ; 28066 ; t5/ 0, Complete buffer written 28067 ; -1, Wasn't (hit an escape) 28068 ; 28069 ; q2/ Copy of orginal t3 (remaining characters) 28070 ; q3/ Number of characters we're actually writing 28071 ; q4/ Parity (if doing parity) 28072 28073 002071'01 265 16 0 00 005442' vtmout: saveac ; Save misc. things 28074 002072'01 200 10 0 00 002030* move q4, parity ;[223] Load parity 28075 002073'01 336 00 0 00 000000* skipn parpko ;[223] Not if packets-only 28076 002074'01 306 10 0 00 000000* cain q4, none ;[223] But!! Doing anything at all, really? 28077 002075'01 400 10 0 00 000000 setz q4, ;[223] No, so make it easier to do nothing 28078 28079 002076'01 350 07 0 00 000005 aos q3,t5 ; Store original count + BIN% 28080 002077'01 400 05 0 00 000000 setz t5, ; Let's assume didn't hit the escape 28081 002100'01 332 06 0 00 000003 skipe q2,t3 ; Save and check remaining count 28082 002101'01 474 05 0 00 000000 seto t5, ; Hit an escape... 28083 002102'01 277 03 0 00 000007 subb t3,q3 ; Calculate complete buffer size 28084 002103'01 322 07 0 00 001750* jumpe q3,r ; Don't do a push of an empty buffer 28085 28086 002104'01 210 01 0 00 000007 movn t1,q3 ; Pick up POSITIVE count of characters 28087 002105'01 272 01 0 00 000000# addm t1,vsotc ; Add in total 28088 002106'01 313 01 0 00 000000# camle t1,vsomx ; Greater than max? 28089 002107'01 202 01 0 00 000000# movem t1,vsomx ; Update maximum 28090 002110'01 350 00 0 00 000000# aos vsoct ; Count a SOUTR% 28091 28092 002111'01 200 02 0 00 005454' move t2,[point 7,nrtbuf] ;Seven bit traffic 28093 002112'01 322 10 0 00 002115' ifn. q4 ;[223] Parity? 28094 002113'01 200 01 0 00 005455' move t1,[point 8,parbuf] ;[223] Eight bit traffic 28095 002114'01 260 17 0 00 000000* call genpar ;[223] Generate a new string with parity 28096 002115'01 endif. ;[223] End case generating parity 28097 28098 002115'01 200 01 0 00 002032* move t1, netjfn ; Load JFN of our DCN: connection 28099 002116'01 104 00 0 00 000532 SOUTR% ; Write and 'push' 28100 002117'01 320 12 0 00 002121' %jserr (,r) ; If error, return +1 28101 002120'01 254 00 0 00 002124' 28102 002121'01 265 01 0 00 002061* 28103 002122'01 000000000000# 28104 002123'01 254 00 0 00 002103* 28105 001205'04 103 141 156 047 164 28106 002124'01 336 00 0 00 002025* skipn duplex ; Half duplex? k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 29-1 K20NET MAC 15-Nov-23 19:11 Network fork data writer 28107 002125'01 263 17 0 00 000000 ret ; No, nothing to echo 28108 ; Ugh... Let's get to it 28109 002126'01 265 16 0 00 005456' saveac ; Wants another register 28110 002127'01 200 06 0 00 005464' move q2,[point 7,nrtbuf] ;Load a pointer to the buffer 28111 002130'01 210 10 0 00 000007 movn q4,q3 ; Do a positive counter (unnecessary) 28112 28113 002131'01 do. ; Enter loop lexical context 28114 002131'01 134 02 0 00 000006 ildb t2,q2 ; Pick up a character from the buffer 28115 002132'01 260 17 0 00 002026* call echo ; Type it 28116 002133'01 367 10 0 00 002131' sojg q4,top. ; Do all of them 28117 002134'01 enddo. ; Exit loop lexical context 28118 28119 002134'01 263 17 0 00 000000 ret ; Done, finally 28120 28121 ; To do, this is an awful lot of instructions just to echo. 28122 ; Could temporarily restore the COC's and PSOUT%. Also could 28123 ; do a MOVST from from an eight byte buffer and overwrite it 28124 ; with a seven bit buffer with the control characters? 28125 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 30 K20NET MAC 15-Nov-23 19:11 Code for receive fork. 28126 subttl Code for receive fork. 28127 28128 ; Rewritten for efficiency to use less JSYI and avoid stack clash 28129 ; 28130 ; Runs forever, asynchronously, till killed. 28131 ; 28132 ; The algorithm is to wait for a character and then slurp up anything 28133 ; that might be in the monitor's input buffer for the line (or NRT). 28134 ; This can substantially cut down on BIN%/BOUT% overhead while still 28135 ; maintaining performance because the fork is effectively always waiting 28136 ; for remote output. 28137 ; 28138 ; Partially adapted from a much modified SETNOD. 28139 ; 28140 ; Be aware of a subtle Tops-20 bug! Once created, the terminal fork 28141 ; should NEVER be killed, but rather frozen. Previous Kermit behavior 28142 ; was to always kill the fork on a close, keeping the network JFN open, 28143 ; recreating the fork on every connect. While this was inefficient 28144 ; (fork creation being expensive), it was fine for a pseudo-terminal. 28145 ; 28146 ; However, killing the fork while it was waiting for NRT data caused 28147 ; Tops-20 DECnet to lose track of the buffers, the result being that 28148 ; whatever was last in the buffer was read again when the fork was 28149 ; recreated. 28150 ; 28151 ; Trying to force the monitor buffers to be correct with SINR% only 28152 ; partially worked. Output was not repeated, but a timing anomaly was 28153 ; then exposed that the result of a SIBE% was less than what was 28154 ; available, the consequence being that the SINR% would fail with 28155 ; a IOX10 error (Record is longer than user requested), the extra 28156 ; data then being dumped (into oblivion). 28157 ; 28158 ; Freezing and resuming the terminal fork prevents this situation and 28159 ; is more efficient, anyway. Therefore, make certain that the FFORK% 28160 ; at $CONX2+5 is NEVER changed back to a KFORK%! 28161 ; 28162 ; However, this does not fix the problem of output getting repeated 28163 ; into the main fork once the subfork is frozen. In particular, 28164 ; suppose the user does something very reasonable and connects to a 28165 ; remote system to sign on. Escaping back will now work fine, but if 28166 ; before this happens, the user runs a Kermit and puts it into server 28167 ; mode, the main fork will now see all the junk that the recreated 28168 ; inferior used to see plus a large pile of NUL's thrown in to boot!! 28169 ; 28170 ; Therefore, whenever we escape back, a clrbuf is done for an NRT. 28171 28172 002000 linlen==^d1024 ; Maximum characters we'll swallow at once 28173 28174 002135'01 netin: entry netin ; Jumped to by main character read loop 28175 remark q1,q2,q3,q4,p1,p2,p3 ;No need to save these in seperate fork 28176 002135'01 200 17 0 00 005465' move p,[iowd pdlsiz,frkpdl] ; Can't share stacks... 28177 002136'01 201 01 0 00 003345' movei t1, netinh ; Load Address of a halt routine 28178 002137'01 261 17 0 00 000001 push p, t1 ; Just in case we want to return over the top 28179 28180 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 20:02 27-Nov-23 Page 30-1 K20NET MAC 15-Nov-23 19:11 Code for receive fork. 28181 002141'01 200 01 0 00 002072* move t1, parity ;[223] Load parity setting 28182 002142'01 306 01 0 00 002074* cain t1, none ;[223] Are we doing anything? 28183 002143'01 254 00 0 00 002153' ifskp. ;[223] Some kind of parity being done, so check further 28184 002144'01 332 00 0 00 002073* skipe parpko ;[223] Only doing parity on packets? 28185 002145'01 254 00 0 00 002153' anskp. ;[223] Yes, so better leave this alone 28186 002146'01 336 00 0 00 000000* skipn parrck ;[223] Checking parity on receive and not just sending? 28187 002147'01 254 00 0 00 002153' anskp. ;[223] No, so don't pay any attention 28188 002150'01 200 13 0 00 000001 move p3, t1 ;[223] Set the flag with the parity value 28189 002151'01 505 05 0 00 441000 hrli q1,<(point 8,0)> ;[223] Do it all 7 bit ASCII with a parity bit 28190 002152'01 254 00 0 00 002155' else. ;[223] Otherwise, not doing anything special 28191 002153'01 400 13 0 00 000000 setz p3, ;[223] So clear the flag 28192 002154'01 505 05 0 00 440700 hrli q1,<(point 7,0)> ;[223] And do it all straight 7 bit ASCII 28193 002155'01 endif. ;[223] End case parity determination 28194 28195 002155'01 do. ; Enter loop context 28196 002155'01 474 06 0 00 000000 seto q2, ; Assume we get at least one chracter 28197 002156'01 550 01 0 00 002115* hrrz t1, netjfn ; Always prefer a network JFN 28198 002157'01 326 01 0 00 002161' ife. t1 ; Unless there isn't one 28199 002160'01 550 01 0 00 002000* hrrz t1, ttyjfn ; Use terminal if nothing else 28200 002161'01 endif. ; End case no network JFN 28201 002161'01 104 00 0 00 000050 BIN% ; Wait for input 28202 002162'01 320 12 0 00 002164' %jserr (,neterr) ; Handle any errors. 28203 002163'01 254 00 0 00 002167' 28204 002164'01 265 01 0 00 002121* 28205 002165'01 000000000000# 28206 002166'01 254 00 0 00 002351' 28207 001211'04 103 141 156 047 164 28208 002167'01 350 00 0 00 000000# aos nbict ; Network BIN% count 28209 002170'01 200 07 0 00 000002 move q3, t2 ; Tuck that character safely away for now 28210 002171'01 200 04 0 00 000001 move t4, t1 ; Get the PTY JFN out of the way 28211 002172'01 260 17 0 00 002625' call clrest ; Find out what awaits us 28212 002173'01 254 00 0 00 002176' ifskp. ; Worked!! 28213 002174'01 200 11 0 00 000001 move p1, t1 ; Save the count (which might be zero) 28214 002175'01 254 00 0 00 002203' else. ; Failed?? 28215 002176'01 334 00 0 00 000000 %ermsg (,neterr) 28216 002177'01 254 00 0 00 002203' 28217 002200'01 265 01 0 00 002164* 28218 002201'01 000000000000# 28219 002202'01 254 00 0 00 002351' 28220 001216'04 125 156 141 142 154 28221 002203'01 endif. 28222 002203'01 326 11 0 00 002215' ife. p1 ; Nothing but one dinky character? 28223 002204'01 322 13 0 00 002211' ifn. p3 ;[223] Are we doing parity? 28224 002205'01 200 01 0 00 000007 move t1, q3 ;[223] Yes, so load the character 28225 002206'01 260 17 0 13 000000 call (p3) ;[223] Do some kind of parity 28226 002207'01 312 01 0 00 000007 came t1, q3 ;[223] Does it check? 28227 002210'01 260 17 0 00 002342' call parier ;[223] No, go complain 28228 002211'01 endif. ;[223] End case parity checking 28229 002211'01 200 02 0 00 000005 move t2, q1 ; Load the pointer 28230 002212'01 136 07 0 00 000002 idpb q3, t2 ; Drop the character in 28231 002213'01 260 17 0 00 002250' call ntecho ; Finally echo it 28232 002214'01 254 00 0 00 002247' else. ; Otherwise, save us many BIN%'s!! 28233 002215'01 do. ; Enter read/write loop 28234 002215'01 200 02 0 00 000011 move t2, p1 ; Load the total from clrest 28235 002216'01 301 02 0 00 002000 cail t2, linlen ; Rolling buffer plus BIN%? k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 30-2 K20NET MAC 15-Nov-23 19:11 Code for receive fork. 28236 002217'01 201 02 0 00 001777 movei t2, ;Clip it down to fit the character we got 28237 002220'01 313 02 0 00 000000# camle t2, nsimx ; Smaller than biggest? 28238 002221'01 202 02 0 00 000000# movem t2, nsimx ; Nope, update total 28239 002222'01 272 02 0 00 000000# addm t2, nsitc ; Network SIN% total characters 28240 002223'01 210 03 0 00 000002 movn t3, t2 ; Calculate amount to read 28241 002224'01 274 11 0 00 000002 sub p1, t2 ; Subtract from total known 28242 002225'01 274 06 0 00 000002 sub q2, t2 ; Account for previous byte in write total 28243 002226'01 200 02 0 00 000005 move t2, q1 ; Load the pointer 28244 002227'01 136 07 0 00 000002 idpb q3, t2 ; Drop the character in 28245 002230'01 325 03 0 00 002241' Ifl. t3 ; BUT!! Are we actualy going to do anything? 28246 002231'01 350 00 0 00 000000# aos nsici ; Network SIN%'s Issued 28247 002232'01 200 01 0 00 000004 move t1, t4 ; Load the network JFN 28248 002233'01 104 00 0 00 000052 SIN% ; Get that data! 28249 002234'01 320 12 0 00 002236' %jserr (,neterr) ;Handle any errors 28250 002235'01 254 00 0 00 002241' 28251 002236'01 265 01 0 00 002200* 28252 002237'01 000000000000# 28253 002240'01 254 00 0 00 002351' 28254 001226'04 103 141 156 047 164 28255 002241'01 endif. ; End sanity check 28256 002241'01 322 13 0 00 002245' ifn. p3 ;[223] Doing any kind of parity? 28257 002242'01 120 02 0 00 000005 dmove t2, q1 ;[223] Load what will be passed to ntecho 28258 002243'01 260 17 0 00 000000* call chkpar ;[223] Check the parity 28259 002244'01 260 17 0 00 002342' call parier ;[223] Bad, go complain 28260 002245'01 endif. ;[223] End case parity checking 28261 002245'01 260 17 0 00 002250' call ntecho ; Go echo the output 28262 002246'01 327 11 0 00 002215' jumpg p1, top. ; Still more data pending, read it 28263 002247'01 enddo. ; End inner input/output loop 28264 002247'01 endif. ; End decision to read more than one character 28265 002247'01 254 00 0 00 002155' loop. ; Otherwise, go to the top and wait for more 28266 002250'01 enddo. ; End outer loop 28267 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 31 K20NET MAC 15-Nov-23 19:11 echo what we read from the network 28268 subttl echo what we read from the network 28269 28270 ; Called from various places in netin lower fork code to display data 28271 ; 28272 ; Expects: 28273 ; 28274 ; ttyjfn/ Valid JFN or terminal designator 28275 ; q1/ Pointer to beginning of data read 28276 ; q2/ Negative count of data (I.E., counted SOUT% ready 28277 ; p3/ Parity scrubber flag 28278 ; 28279 ; +1, always 28280 ; 28281 ; Trashes t1, t2 and t3. 28282 ; 28283 ; If doing parity, we have a buffer with eight bit bytes in it which 28284 ; must have the parity bit stripped off. If this is not done, then 28285 ; Tops-20 is going to write in 'image' mode, which can produce funny 28286 ; output on terminal emulators. 28287 ; 28288 ; The routine simply picks up an eight bit byte and replaces it with a 28289 ; seven bit byte, overwriting the storage in place. Since the 7 bit 28290 ; ASCII stream will always trail the 8 bit stream, we will never run 28291 ; out of space nor clobber anything. 28292 28293 002250'01 322 13 0 00 002304' ntecho: jumpe p3,ntech2 ;[223] Any parity to strip off? 28294 002251'01 322 06 0 00 002123* jumpe q2, r ;[223] If nothing to do, we're done! 28295 002252'01 554 01 0 00 000005 hlrz t1, q1 ;[223] A quick sanity check of the pointer width 28296 002253'01 306 01 0 00 440700 cain t1, <(point 7,0)> ;[223] Is this a waste of time, anyway? 28297 002254'01 254 00 0 00 002304' jrst ntech2 ;[223] It is, so skip all of this 28298 28299 002255'01 315 06 0 00 005466' caxge q2,-^d4 ;[223] Characters at which movslj wins (we think) 28300 002256'01 254 00 0 00 002270' jrst ntech1 ;[223] Go win big with extended instruction! 28301 28302 002257'01 265 16 0 00 005467' ntech0: saveac ;[223] Doesn't need quite so many registers... 28303 002260'01 200 02 0 00 000005 move t2, q1 ;[223] Load 8 bit source 28304 002261'01 505 05 0 00 440700 hrli q1, <(point 7,0)> ;[223] Stomp in the right pointer width 28305 002262'01 200 03 0 00 000005 move t3, q1 ;[223] Load 7 bit destination 28306 002263'01 210 04 0 00 000006 movn t4, q2 ;[223] We get less confused by positive numbers ... 28307 28308 002264'01 do. ;[223] Enter loop context 28309 002264'01 134 01 0 00 000002 ildb t1, t2 ;[223] Pick up an 8 bit byte 28310 002265'01 136 01 0 00 000003 idpb t1, t3 ;[223] And deposit as 7 bit, stripping parity 28311 002266'01 367 04 0 00 002264' sojg t4, top. ;[223] Do the rest of them 28312 002267'01 enddo. ;[223] End loop lexical context 28313 002267'01 254 00 0 00 002304' jrst ntech2 ;[223] And go type something 28314 28315 002270'01 265 16 0 00 005477' ntech1: saveac ;[223] Convert from 8 to 7 bit ASCII 28316 002271'01 120 07 0 00 000005 dmove q3, q1 ;[223] Save original arguments 28317 002272'01 210 01 0 00 000006 movn t1, q2 ;[223] movslj wants positive counts 28318 002273'01 200 04 0 00 000001 move t4, t1 ;[223] Smaller width can never overflow 28319 002274'01 200 02 0 00 000005 move t2, q1 ;[223] Section local eight bit pointer 28320 002275'01 550 05 0 00 000002 hrrz q1, t2 ;[223] Same starting address 28321 002276'01 505 05 0 00 440700 hrli q1, <(point 7,0)> ;[223] Stomp in the right pointer 28322 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 20:02 27-Nov-23 Page 31-1 K20NET MAC 15-Nov-23 19:11 echo what we read from the network 28323 002300'01 403 03 0 00 000006 setzb t3, q2 ;[223] Section local pointers 28324 002301'01 123 01 0 00 000000* extend t1, movchr ;[223] Repack the string in place (which is safe) 28325 002302'01 600 00 0 00 000000 nop ;[223] Ignore any odd non-skip 28326 002303'01 120 05 0 00 000007 dmove q1, q3 ;[223] Restore updated calling arguments 28327 28328 002304'01 200 01 0 00 002160* ntech2: move t1, ttyjfn ;[223] ; Load local terminal 28329 002305'01 120 02 0 00 000005 dmove t2,q1 ; Load pointer and length 28330 002306'01 104 00 0 00 000053 SOUT% ; Display incoming characters on screen. 28331 002307'01 320 12 0 00 002311' %jserr (,) 28332 002310'01 254 00 0 00 002314' 28333 002311'01 265 01 0 00 002236* 28334 002312'01 000000000000# 28335 002313'01 254 00 0 00 002314' 28336 001233'04 103 141 156 047 164 28337 002314'01 337 01 0 00 001536* skipg t1, sesjfn ; Logging? 28338 002315'01 254 00 0 00 002327' ifskp. ;[195] Possibly doing it 28339 002316'01 336 00 0 00 001565* skipn sesflg ;[195] Unless not active 28340 002317'01 254 00 0 00 002327' anskp. ;[195] In which case, skip it 28341 002320'01 120 02 0 00 000005 dmove t2,q1 ; Load buffer pointer and length 28342 002321'01 104 00 0 00 000053 SOUT% ; Write it to the log 28343 002322'01 320 12 0 00 002324' %jserr (,netlgx) ;[195] 28344 002323'01 254 00 0 00 002327' 28345 002324'01 265 01 0 00 002311* 28346 002325'01 000000000000# 28347 002326'01 254 00 0 00 000000* 28348 001242'04 103 141 156 047 164 28349 002327'01 endif. ;[195] End case logging 28350 002327'01 263 17 0 00 000000 ret ; Done 28351 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 32 K20NET MAC 15-Nov-23 19:11 Table to map DECnet close reason code to text 28352 subttl Table to map DECnet close reason code to text 28353 28354 ;[238] Begin table insertion 28355 28356 ; Handle all the .psect stuff by hand. Have to be careful because we 28357 ; are going to the outermost .psect, which will have the wrong location 28358 ; counter. Also, getting this wrong will cause LINK to fail with a 28359 ; most informative message of "Illegal memory WRITE at SY.FP5+1", which 28360 ; is almost--but not quite--completely and utterly useless. 28361 28362 .endps code ; Get out of code .psect 28363 28364 000053 .dcxmx==.dcx43 ; Maximum code 28365 28366 .psect const ; Put all the constants in the const .psect 28367 000130'03 dsctab: remark ; Just create a label in .psect 28368 .endps const ; End of const .psect 28369 28370 define dsctxt (n,t,%et) < ;;Macro to put pointers to messages in the right place 28371 .psect const ;;Assume in const .psect 28372 reloc dsctab+n ;;Get to correct location in table 28373 .px7!%et ;;Emit pointer to text in extended text section 28374 .endps const ;;Get out of const .psect 28375 .psect etext ;;Get into extended text .psect 28376 %et: asciz \'t\ ;;Emit the actual text of the disconnect reason 28377 .endps etext ;;Close out extended text .psect 28378 cleans(<%et>) ;;Clean up generated symbol on second pass 28379 >;;dsctxt 28380 28381 000130'03 000000000000# dsctxt(.dcx0,) 28382 001247'04 122 145 152 145 143 28383 000131'03 000000000000# dsctxt(.dcx1,) 28384 001256'04 122 145 163 157 165 28385 000132'03 000000000000# dsctxt(.dcx2,) 28386 001264'04 104 145 163 164 151 28387 000133'03 000000000000# dsctxt(.dcx3,) 28388 001273'04 122 145 155 157 164 28389 000134'03 000000000000# dsctxt(.dcx4,) 28390 001301'04 104 145 163 164 151 28391 000135'03 000000000000# dsctxt(.dcx5,) 28392 001310'04 111 156 166 141 154 28393 000136'03 000000000000# dsctxt(.dcx6,) 28394 001316'04 117 142 152 145 143 28395 000137'03 000000000000# dsctxt(.dcx7,) 28396 001321'04 125 156 163 160 145 28397 000140'03 000000000000# dsctxt(.dcx8,) 28398 001325'04 124 150 151 162 144 28399 000141'03 000000000000# dsctxt(.dcx9,) 28400 001331'04 101 163 171 156 143 28401 000142'03 000000000000# dsctxt(.dcx10,) 28402 001336'04 111 156 166 141 154 28403 000143'03 000000000000# dsctxt(.dcx11,) 28404 001342'04 114 157 143 141 154 28405 000155'03 000000000000# dsctxt(.dcx21,) 28406 001347'04 103 157 156 156 145 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 32-1 K20NET MAC 15-Nov-23 19:11 Table to map DECnet close reason code to text 28407 000156'03 000000000000# dsctxt(.dcx22,) 28408 001361'04 103 157 156 156 145 28409 000157'03 000000000000# dsctxt(.dcx23,) 28410 001373'04 103 157 156 156 145 28411 000160'03 000000000000# dsctxt(.dcx24,) 28412 001406'04 106 154 157 167 040 28413 000170'03 000000000000# dsctxt(.dcx32,) 28414 001413'04 124 157 157 040 155 28415 000171'03 000000000000# dsctxt(.dcx33,) 28416 001421'04 124 157 157 040 155 28417 000172'03 000000000000# dsctxt(.dcx34,) 28418 001432'04 101 143 143 145 163 28419 000173'03 000000000000# dsctxt(.dcx35,) 28420 001437'04 114 157 147 151 143 28421 000174'03 000000000000# dsctxt(.dcx36,) 28422 001446'04 111 156 166 141 154 28423 000175'03 000000000000# dsctxt(.dcx37,) 28424 001452'04 123 145 147 155 145 28425 000176'03 000000000000# dsctxt(.dcx38,) 28426 001457'04 116 157 040 162 145 28427 000177'03 000000000000# dsctxt(.dcx39,) 28428 001467'04 116 157 040 160 141 28429 000200'03 000000000000# dsctxt(.dcx40,) 28430 001475'04 114 151 156 153 040 28431 000201'03 000000000000# dsctxt(.dcx41,) 28432 001503'04 104 145 163 164 151 28433 000202'03 000000000000# dsctxt(.dcx42,) 28434 001512'04 103 157 156 146 151 28435 000203'03 000000000000# dsctxt(.dcx43,) 28436 001522'04 111 155 141 147 145 28437 28438 .psect const ; Put all the constants in the const .psect 28439 000204'03 reloc dsctab+.dcxmx+1 ; Back to end of dsctab 28440 .endps const ; End of const .psect 28441 28442 ;[238] End table insertion 28443 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 33 K20NET MAC 15-Nov-23 19:11 convert DECnet close reason code to text 28444 subttl convert DECnet close reason code to text 28445 28446 remark Given a disconnect code, return a pointer to descriptive text 28447 28448 ;[238] Begin code insertion 28449 28450 ; Call: 28451 ; 28452 ; T3/ Contains result of .MORLS 28453 ; 28454 ; Return: 28455 ; 28456 ; T1/ OWGP to informative text 28457 28458 .psect etext ; Get to extended text .psect 28459 001530'04 125 156 153 156 157 unkdec: asciz "Unknown disconnect code" 28460 .endps etext ; Close out extended text .psect 28461 28462 .psect code ;;Get back into the code .psect 28463 28464 002330'01 550 02 0 00 000003 gdscpt: hrrz t2, t3 ; Pick up disconnect code 28465 002331'01 303 02 0 00 000053 caile t2, .dcxmx ; Out of range? 28466 002332'01 254 00 0 00 002337' ifskp. ; No, it's fine 28467 002333'01 336 01 0 02 000000# skipn t1, dsctab(t2) ; Load OWGP to informative text 28468 002334'01 254 00 0 00 002337' anskp. ; Unless there isn't any 28469 002335'01 263 17 0 00 000000 ret ; Otherwise, return it 28470 002336'01 254 00 0 00 002341' else. ; Otherwise, out of range or no text 28471 002337'01 200 01 0 00 005513' move t1,[.px7!unkdec] ; Say as much 28472 002340'01 263 17 0 00 000000 ret ; Return at least something 28473 002341'01 endif. ; End case range and pointer check 28474 28475 28476 ;[238] End code insertion 28477 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 34 K20NET MAC 15-Nov-23 19:11 Parity Error Handler 28478 subttl Parity Error Handler 28479 28480 002341'01 007 000 00000000 honk: byte (7) .chbel, .chnul ;[223] Just honk the terminal 28481 28482 002342'01 261 17 0 00 000001 parier: push p, t1 ;[223] Save the accumulator 28483 002343'01 561 01 0 00 002341' hrroi t1, honk ;[223] Point to the alert 28484 002344'01 104 00 0 00 000313 ESOUT% ;[223] Beep the terminal 28485 002345'01 320 12 0 00 002346' erjmpr .+1 ;[223] Catch and ignore error 28486 002346'01 350 00 0 00 000000* aos ttipar ;[223] Count a parity error 28487 002347'01 262 17 0 00 000001 pop p, t1 ;[223] Restore the accumulator 28488 002350'01 263 17 0 00 000000 ret ;[223] Done 28489 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 35 K20NET MAC 15-Nov-23 19:11 Error handler for network TTY. 28490 subttl Error handler for network TTY. 28491 28492 002351'01 336 00 0 00 001741* neterr: ifmn. vtermf ;[186] Virtual terminal? 28493 002352'01 254 00 0 00 002357' 28494 002353'01 200 01 0 00 002156* move t1, netjfn ;[186] Load network JFN 28495 002354'01 260 17 0 00 003773' call chklin ;[186] Get network status 28496 002355'01 336 00 0 00 001657* skipn carier ;[186] dropped carrier? 28497 002356'01 260 17 0 00 003244' call netvtx ;[186] Yep, we're down 28498 002357'01 endif. ;[186] End special case for non-physical line 28499 28500 002357'01 336 00 0 00 000000* skipn mdmlin ; Modem controlled line? 28501 002360'01 254 00 0 00 002135' jrst netin ; No, go back. 28502 002361'01 260 17 0 00 003773' call chklin ; Go check for carrier. 28503 002362'01 336 00 0 00 002355* skipn carier ; Still have it? 28504 002363'01 254 00 0 00 000000* jrst $connx ;[186] No, close the connection. 28505 002364'01 254 00 0 00 002135' jrst netin ; Yes, keep plugging away till they disconnect. 28506 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 36 K20NET MAC 15-Nov-23 19:11 Handles signal of failure of network input fork 28507 subttl Handles signal of failure of network input fork 28508 28509 002365'01 frtrap: entry frtrap 28510 extern pc3 ; Level we interrupt on 28511 28512 002365'01 261 17 0 00 000001 push p, t1 ; Save any AC we touch 28513 002366'01 261 17 0 00 000002 push p, t2 28514 002367'01 261 17 0 00 000003 push p, t3 28515 28516 002370'01 336 01 0 00 001337* skipn t1,ttfork ; Load the handle of network input fork 28517 002371'01 254 00 0 00 002375' ifskp. ; If there is one.... 28518 002372'01 104 00 0 00 000153 KFORK% ; Ditch it 28519 002373'01 320 12 0 00 002374' erjmpr .+1 ; Ignore the error 28520 002374'01 402 00 0 00 002370* setzm ttfork ; Forget about the handle; it's gone 28521 002375'01 endif. ; End case fork handler 28522 28523 002375'01 260 17 0 00 003047' call clsnet ; Whack any kind of network connection 28524 28525 002376'01 205 01 0 00 010000 movx t1,pc%usr ; Get into user mode. 28526 002377'01 436 01 0 00 000541* iorm t1,pc3 ; Resume at previous PC 28527 28528 002400'01 262 17 0 00 000003 pop p, t3 ; Restore AC's and beat it 28529 002401'01 262 17 0 00 000002 pop p, t2 28530 002402'01 262 17 0 00 000001 pop p, t1 28531 002403'01 104 00 0 00 000136 DEBRK% 28532 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 37 K20NET MAC 15-Nov-23 19:11 Sends a DECnet interrupt message when BREAK is requested 28533 subttl Sends a DECnet interrupt message when BREAK is requested 28534 28535 002404'01 110 145 171 041 040 nrtmsg: bldmsg () 28536 28537 002407'01 nrtbrk: entry nrtbrk ; Experimental; not really used 28538 002407'01 263 17 0 00 000000 ret ; This hangs a Tops-10 connection, don't do it 28539 28540 002410'01 265 16 0 00 005344' saveac ; Save just because we don't know 28541 002411'01 200 01 0 00 002353* move t1,netjfn ; Load network JFN 28542 002412'01 201 02 0 00 000036 movei t2,.mosim ; Function to send DECnet interrupt message 28543 dmove t3,[point 7,nrtmsg ;Point to interrupt message 28544 002413'01 120 03 0 00 005514' nrtlen ] ; Length of same 28545 002414'01 104 00 0 00 000077 MTOPR% ; Bombs away! 28546 002415'01 320 12 0 00 002417' %jserr(,r) 28547 002416'01 254 00 0 00 002422' 28548 002417'01 265 01 0 00 002324* 28549 002420'01 000000000000# 28550 002421'01 254 00 0 00 002251* 28551 001535'04 125 156 141 142 154 28552 002422'01 263 17 0 00 000000 ret 28553 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 38 K20NET MAC 15-Nov-23 19:11 clrbuf Clear Line Input Buffer 28554 subttl clrbuf Clear Line Input Buffer 28555 28556 ;[211] All rewritten and enhanced for non-physical terminals 28557 28558 ; Call: 28559 ; 28560 ; Nothing: appropriate thing is done based on connection context. 28561 ; 28562 ; Returns: 28563 ; 28564 ; +1/ Some problem 28565 ; +2/ Success 28566 ; t1/ Total characters chewed 28567 ; 28568 ; N.B., While SIBE% and SOBE% will work on any JFN, CFIBF% and 28569 ; CFOBF%'s will *ONLY* work with terminal lines. For PTY's 28570 ; and NRT's, we have to read the input (and toss it). 28571 28572 000310 flushc==^d200 ; Maximum characters to swallow 28573 28574 002423'01 clrbuf: entry clrbuf ; Inform link of our location 28575 002423'01 260 17 0 00 000000* call inpclr ;[209] Chuck any waiting input 28576 28577 002424'01 332 00 0 00 000000# skipe ptyflg ; Pseudo-terminal? 28578 002425'01 254 00 0 00 002527' callret ptyfls ; Yes, that has to be flushed from both sides 28579 002426'01 332 00 0 00 000000# skipe nrtflg ; DECnet NRT? 28580 002427'01 254 00 0 00 002457' callret dcnfls ; Yes, CFIBF% won't work 28581 ; Otherwise, a physical line on an FE!!!! 28582 002430'01 550 01 0 00 002411* hrrz t1, netjfn ; Although a real line, prefer network JFN 28583 002431'01 326 01 0 00 002433' ife. t1 ; Unless there isn't one 28584 002432'01 550 01 0 00 002304* hrrz t1, ttyjfn ; Use terminal if nothing else 28585 002433'01 endif. ; End case no network JFN 28586 002433'01 403 02 0 00 000003 setzb t2, t3 ; No current read, no accumulated read 28587 28588 002434'01 do. ; Enter loop context 28589 002434'01 104 00 0 00 000102 SIBE% ; Skip if input buffer empty 28590 002435'01 254 00 0 00 002445' ifskp. ; Empty? 28591 002436'01 322 02 0 00 002455' jumpe t2, endlp. ; If zero, then no error; exit loop 28592 002437'01 334 00 0 00 000000 %ermsg (,r) ;[211] 28593 002440'01 254 00 0 00 002444' 28594 002441'01 265 01 0 00 002417* 28595 002442'01 000000000000# 28596 002443'01 254 00 0 00 002421* 28597 001544'04 125 156 141 142 154 28598 002444'01 254 00 0 00 002455' else. ; Otherwise, have some junk in there 28599 002445'01 270 03 0 00 000002 add t3, t2 ; Add to total cleared 28600 002446'01 104 00 0 00 000100 CFIBF% ; Chuck the input 28601 002447'01 320 12 0 00 002451' %jserr (,r) ; Boo... 28602 002450'01 254 00 0 00 002454' 28603 002451'01 265 01 0 00 002441* 28604 002452'01 000000000000# 28605 002453'01 254 00 0 00 002443* 28606 001553'04 125 156 141 142 154 28607 002454'01 254 00 0 00 002434' loop. ; See if anything else shows up 28608 002455'01 endif. ; End of SIBE% action logic k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 38-1 K20NET MAC 15-Nov-23 19:11 clrbuf Clear Line Input Buffer 28609 002455'01 enddo. ; End flush loop 28610 28611 002455'01 200 01 0 00 000003 move t1, t3 ; Load grand total flushed 28612 002456'01 254 00 0 00 001777* retskp ; Return success!!! 28613 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 39 K20NET MAC 15-Nov-23 19:11 DECnet flush 28614 subttl DECnet flush 28615 28616 ; Somewhat similar logic to physical terminal, except that 28617 ; CFIBF% won't work, so we have to read (and toss) the data. 28618 ; 28619 ; N.B., Can't use SINR% because it will discard an unknown number 28620 ; of characters. Sigh... 28621 28622 002457'01 265 16 0 00 005516' dcnfls: saveac 28623 002460'01 550 01 0 00 002430* hrrz t1, netjfn ; Pick up the network JFN 28624 002461'01 326 01 0 00 002467' ife. t1 ; Have to have this for an NRT! 28625 002462'01 334 01 0 00 000000# ermsg% (,r) 28626 002463'01 254 00 0 00 002467' 28627 002464'01 202 01 0 00 001426* 28628 002465'01 104 00 0 00 000313 28629 002466'01 254 00 0 00 002453* 28630 000204'03 000000000000# 28631 001561'04 113 105 122 115 111 28632 28633 002467'01 endif. ; End of that particular sanity check 28634 002467'01 200 05 0 00 000001 move q1, t1 ; Save whatever JFN we're using (q1 unused) 28635 002470'01 400 07 0 00 000000 setz q3, ; No initial grand tally 28636 28637 002471'01 do. ; Enter loop context 28638 002471'01 104 00 0 00 000102 SIBE% ; Skip if input buffer empty 28639 002472'01 254 00 0 00 002502' ifskp. ; Empty? 28640 002473'01 322 02 0 00 002524' jumpe t2, endlp. ; If zero, then no error; exit loop 28641 002474'01 334 00 0 00 000000 %ermsg (,r) 28642 002475'01 254 00 0 00 002501' 28643 002476'01 265 01 0 00 002451* 28644 002477'01 000000000000# 28645 002500'01 254 00 0 00 002466* 28646 001575'04 125 156 141 142 154 28647 002501'01 254 00 0 00 002523' else. ; Otherwise, have some junk in there 28648 002502'01 200 06 0 00 000002 move q2, t2 ; Load for inner loop 28649 002503'01 do. ; Enter inner loop context 28650 002503'01 336 04 0 00 000006 skipn t4, q2 ; Load remaining characters 28651 002504'01 254 00 0 00 002523' exit. ; If no more, then we're done 28652 002505'01 303 04 0 00 000310 caile t4, flushc ; More than maximum we can swallow at once? 28653 002506'01 201 04 0 00 000310 movx t4, flushc ; Yep, well just take a mouthful 28654 remark t1, q1 ; JFN is still in there 28655 002507'01 200 02 0 00 005532' move t2, [point 8,flushb] ; Load pointer to the 'flush' buffer 28656 002510'01 210 03 0 00 000004 movn t3, t4 ; Reading exactly that much 28657 002511'01 104 00 0 00 000052 SIN% ; Swallow whatever junk is in there 28658 002512'01 320 12 0 00 002514' %jserr (,r) 28659 002513'01 254 00 0 00 002517' 28660 002514'01 265 01 0 00 002476* 28661 002515'01 000000000000# 28662 002516'01 254 00 0 00 002500* 28663 001606'04 125 156 141 142 154 28664 002517'01 270 04 0 00 000003 add t4, t3 ; Keep track of what we didn't read 28665 002520'01 274 06 0 00 000004 sub q2, t4 ; Subtract from remaining 28666 002521'01 270 07 0 00 000004 add q3, t4 ; And add to total done 28667 002522'01 327 06 0 00 002503' jumpg q2, top. ; Loop if anything left to do 28668 002523'01 enddo. ; End context inner loop k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 39-1 K20NET MAC 15-Nov-23 19:11 DECnet flush 28669 002523'01 endif. ; End SIBE% results handling 28670 002523'01 254 00 0 00 002471' loop. ; See if anything else there 28671 002524'01 enddo. ; End loop lexical context 28672 28673 002524'01 272 07 0 00 000000# addm q3, vchrcn ; Update grand total characters ever flushed 28674 002525'01 200 01 0 00 000007 move t1, q3 ; Return total characters whacked this time 28675 002526'01 254 00 0 00 002456* retskp ; Return success 28676 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 40 K20NET MAC 15-Nov-23 19:11 DECnet flush 28677 remark Special actions to flush a PTY 28678 28679 ; Note that while a CFIBF% will not work on the PTY JFN, a CFOBF% 28680 ; *WILL* work on the terminal side for which we have the device 28681 ; designator. Since we assigned the PTY which maps to the TTY, we 28682 ; retain certain rights to the terminal, one of which is that a CFOBF% 28683 ; will work and we don't have to read anything. 28684 ; 28685 ; None the less, we check to see if anything made it over to the PTY 28686 ; buffer so we can toss that. 28687 ; 28688 ; Does not return until *both* the SOBE% and SIBE% produce zero. 28689 28690 002527'01 ptyfls: remark ; Has to work both sides of the device 28691 002527'01 265 16 0 00 005533' saveac 28692 28693 002530'01 514 05 0 00 002460* hrlz q1, netjfn ; Pick up the network JFN 28694 002531'01 326 05 0 00 002537' ife. q1 ; Have to have this for a PTY!! 28695 002532'01 334 01 0 00 000000# ermsg% (,r) 28696 002533'01 254 00 0 00 002537' 28697 002534'01 202 01 0 00 002464* 28698 002535'01 104 00 0 00 000313 28699 002536'01 254 00 0 00 002516* 28700 000205'03 000000000000# 28701 001616'04 113 105 122 115 111 28702 28703 002537'01 endif. ; End of that particular sanity check 28704 002537'01 540 05 0 00 000000# hrr q1, ptytty ; Load this PTY's associated terminal line 28705 002540'01 660 05 0 00 400000 txo q1, .ttdes ; Force alternate form of terminal designator 28706 002541'01 403 06 0 00 000007 setzb q2, q3 ; Zero working read and grand total 28707 28708 002542'01 do. ; Enter loop context 28709 002542'01 550 01 0 00 000005 hrrz t1, q1 ; Load terminal designator 28710 002543'01 104 00 0 00 000103 SOBE% ; Skip if output buffer empty 28711 002544'01 254 00 0 00 002555' ifskp. ; Empty? 28712 002545'01 322 02 0 00 002553' ifn. t2 ; If zero, then no error and nothing to do 28713 002546'01 334 00 0 00 000000 %ermsg (,r) 28714 002547'01 254 00 0 00 002553' 28715 002550'01 265 01 0 00 002514* 28716 002551'01 000000000000# 28717 002552'01 254 00 0 00 002536* 28718 001632'04 125 156 141 142 154 28719 002553'01 endif. ; End case t2 having JSYS error code 28720 002553'01 400 10 0 00 000000 setz q4, ; Whack this round's output 28721 002554'01 254 00 0 00 002565' else. ; Otherwise, have some junk in there 28722 002555'01 270 07 0 00 000002 add q3, t2 ; Accumulate in grand tally 28723 002556'01 200 10 0 00 000002 move q4, t2 ; Flag non-zero buffer, this round 28724 002557'01 104 00 0 00 000101 CFOBF% ; Clear out any blocked up crud 28725 002560'01 320 12 0 00 002562' %jserr (,r) 28726 002561'01 254 00 0 00 002565' 28727 002562'01 265 01 0 00 002550* 28728 002563'01 000000000000# 28729 002564'01 254 00 0 00 002552* 28730 001643'04 103 157 165 154 144 28731 002565'01 endif. ; End SOBE% results handling k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 40-1 K20NET MAC 15-Nov-23 19:11 DECnet flush 28732 002565'01 554 01 0 00 000005 hlrz t1, q1 ; Load the PTY side 28733 002566'01 104 00 0 00 000102 SIBE% ; Skip if input buffer empty 28734 002567'01 254 00 0 00 002577' ifskp. ; Empty? 28735 002570'01 322 02 0 00 002576' ifn. t2 ; If zero, then no error; carry on 28736 002571'01 334 00 0 00 000000 %ermsg (,r) 28737 002572'01 254 00 0 00 002576' 28738 002573'01 265 01 0 00 002562* 28739 002574'01 000000000000# 28740 002575'01 254 00 0 00 002564* 28741 001653'04 125 156 141 142 154 28742 002576'01 endif. ; End case empty input buffer 28743 002576'01 254 00 0 00 002621' else. ; Otherwise, have some junk in there 28744 002577'01 270 10 0 00 000002 add q4, t2 ; Add to this round's tally 28745 002600'01 200 06 0 00 000002 move q2, t2 ; Load for inner loop 28746 002601'01 do. ; Enter inner loop context 28747 002601'01 337 04 0 00 000006 skipg t4, q2 ; Load remaining characters 28748 002602'01 254 00 0 00 002621' exit. ; If no more, then we're done 28749 002603'01 303 04 0 00 000310 caile t4, flushc ; More than maximum we can swallow at once? 28750 002604'01 201 04 0 00 000310 movx t4, flushc ; Yep, well just take a mouthful 28751 remark t1, q1 ; JFN is still in there 28752 002605'01 200 02 0 00 005551' move t2, [point 8,flushb] ; Load pointer to 'flush' buffer 28753 002606'01 210 03 0 00 000004 movn t3, t4 ; Reading exactly that much 28754 002607'01 104 00 0 00 000052 SIN% ; Swallow whatever junk is in there 28755 002610'01 320 12 0 00 002612' %jsErr (,r) ;[211] 28756 002611'01 254 00 0 00 002615' 28757 002612'01 265 01 0 00 002573* 28758 002613'01 000000000000# 28759 002614'01 254 00 0 00 002575* 28760 001662'04 125 156 141 142 154 28761 002615'01 270 04 0 00 000003 add t4, t3 ; Keep track of what we didn't read 28762 002616'01 270 07 0 00 000004 add q3, t4 ; And add to total done 28763 002617'01 274 06 0 00 000004 sub q2, t4 ; Subtract from remaining 28764 002620'01 327 06 0 00 002601' jumpg q2, top. ; Loop if anything left 28765 002621'01 enddo. ; End context inner loop 28766 002621'01 endif. ; End SIBE% results handling 28767 002621'01 327 10 0 00 002542' jumpg q4, top. ; If got anything, take another look 28768 002622'01 enddo. ; End of loop lexical context 28769 28770 002622'01 272 07 0 00 000000# addm q3, vchrcn ; Update grand total characters ever flushed 28771 002623'01 200 01 0 00 000007 move t1, q3 ; Return total characters whacked this time 28772 002624'01 254 00 0 00 002526* retskp ; Return success 28773 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 41 K20NET MAC 15-Nov-23 19:11 clrest Give an estimate of characters in input buffer 28774 subttl clrest Give an estimate of characters in input buffer 28775 28776 ; Call: 28777 ; 28778 ; Nothing: appropriate thing is done based on connection context. 28779 ; 28780 ; Returns: 28781 ; 28782 ; +1/ Some problem 28783 ; +2/ Success 28784 ; t1/ Total characters in various buffers 28785 ; 28786 ; N.B., A pseudo terminal can have characters on 'both sides', that 28787 ; is, the character's in the PTY's input buffer *AND* the 28788 ; characters in the associated TTY's output buffer that have not be 28789 ; transferred into the PTY's input buffer, yet. 28790 ; 28791 ; Thus, the use of SOBE% for pseudo-terminals in addition to the 28792 ; expected SIBE%. 28793 28794 002625'01 clrest: entry clrest ; World callable 28795 002625'01 265 16 0 00 005552' saveac ; Needs a few accumulators 28796 002626'01 550 04 0 00 002530* hrrz t4, netjfn ; Always prefer a network JFN 28797 002627'01 326 04 0 00 002631' ife. t4 ; Unless there isn't one 28798 002630'01 550 04 0 00 002432* hrrz t4, ttyjfn ; Use terminal if nothing else 28799 002631'01 endif. ; End case no network JFN 28800 002631'01 403 02 0 00 000003 setzb t2, t3 ; Clear all totals 28801 28802 002632'01 336 00 0 00 000000# ifmn. ptyflg ; If pseudo-terminal, look at both sides 28803 002633'01 254 00 0 00 002651' 28804 002634'01 550 01 0 00 000000# hrrz t1, ptytty ; Load this PTY's associated terminal line 28805 002635'01 660 01 0 00 400000 txo t1, .ttdes ; Force alternate form of terminal designator 28806 002636'01 104 00 0 00 000103 SOBE% ; Skip if output buffer empty 28807 002637'01 254 00 0 00 002647' ifskp. ; Empty? 28808 002640'01 322 02 0 00 002646' ifn. t2 ; If zero, then no error and nothing to do 28809 002641'01 334 00 0 00 000000 %ermsg (,r) 28810 002642'01 254 00 0 00 002646' 28811 002643'01 265 01 0 00 002612* 28812 002644'01 000000000000# 28813 002645'01 254 00 0 00 002614* 28814 001672'04 125 156 141 142 154 28815 002646'01 endif. ; End case t2 having JSYS error code 28816 002646'01 254 00 0 00 002651' else. ; Otherwise, have some junk in there 28817 002647'01 200 03 0 00 000002 move t3, t2 ; Keep track of TTY's output side 28818 002650'01 400 02 0 00 000000 setz t2, ; Keep nice and tidy for SIBE% 28819 002651'01 endif. ; End SOBE% results handling 28820 002651'01 endif. ; End PTY special case 28821 28822 002651'01 200 01 0 00 000004 move t1, t4 ; Load whatever JFN we decided to use 28823 002652'01 104 00 0 00 000102 SIBE% ; Skip if input buffer empty 28824 002653'01 254 00 0 00 002663' ifskp. ; Empty? 28825 002654'01 322 02 0 00 002662' ifn. t2 ; If zero, then no error and nothing to do 28826 002655'01 334 00 0 00 000000 %ermsg (,r) 28827 002656'01 254 00 0 00 002662' 28828 002657'01 265 01 0 00 002643* k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 41-1 K20NET MAC 15-Nov-23 19:11 clrest Give an estimate of characters in input buffer 28829 002660'01 000000000000# 28830 002661'01 254 00 0 00 002645* 28831 001703'04 125 156 141 142 154 28832 002662'01 endif. ; End case t2 having JSYS error code 28833 002662'01 254 00 0 00 002664' else. ; Otherwise, have some junk in there 28834 002663'01 270 03 0 00 000002 add t3, t2 ; Add to any running tally 28835 002664'01 endif. ; End SIBE% results handling 28836 28837 002664'01 200 01 0 00 000003 move t1, t3 ; Return grand total seen 28838 002665'01 254 00 0 00 002624* retskp ; Return success 28839 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 42 K20NET MAC 15-Nov-23 19:11 clread Return buffer of what we cleared 28840 subttl clread Return buffer of what we cleared 28841 28842 ; Call: 28843 ; 28844 ; Nothing: appropriate thing is done based on connection context. 28845 ; 28846 ; Returns: 28847 ; 28848 ; +1/ Some problem 28849 ; +2/ Success 28850 ; t1/ Total characters read 28851 ; t2/ (Eight bit) pointer to buffer 28852 ; 28853 ; N.B., be aware of the following: 28854 ; 28855 ; 1) clread should be repeatedly called until it returns zero as 28856 ; there may be more data than we can read. 28857 ; 28858 ; 2) Can't use SINR% because it will discard an unknown number of 28859 ; characters. Sigh... 28860 28861 002666'01 clread: entry clread ; Called from K20PAR 28862 002666'01 265 16 0 00 005564' saveac 28863 remark call ;[209] Display something 28864 002667'01 260 17 0 00 002423* call inpclr ;[209] Chuck any waiting input 28865 28866 002670'01 514 05 0 00 002626* hrlz q1, netjfn ; Prefer the network JFN 28867 002671'01 326 05 0 00 002673' ife. q1 ; But!! Do we have one? 28868 002672'01 514 05 0 00 002630* hrlz q1, ttyjfn ; Use terminal if nothing else 28869 002673'01 endif. ; End case no network JFN 28870 28871 002673'01 336 00 0 00 000000# ifmn. ptyflg ; Pseudo-terminal? 28872 002674'01 254 00 0 00 002677' 28873 002675'01 540 05 0 00 000000# hrr q1, ptytty ; Load this PTY's associated terminal line 28874 002676'01 660 05 0 00 400000 txo q1, .ttdes ; Force alternate form of terminal designator 28875 002677'01 endif. ; End case pseudo-terminal 28876 28877 dmove q4, [ flushc ; Load total remaining in buffer 28878 002677'01 120 10 0 00 005602' point 8, flushb ] ; Load pointer to 'flush' buffer 28879 28880 002700'01 do. ; Enter loop context 28881 002700'01 322 10 0 00 002757' jumpe q4, endlp. ; If buffer full, then return 28882 002701'01 550 01 0 00 000005 hrrz t1, q1 ; Load terminal designator 28883 002702'01 322 01 0 00 002717' ifn. t1 ; But did we ever have one? 28884 002703'01 104 00 0 00 000103 SOBE% ; Skip if output buffer empty 28885 002704'01 254 00 0 00 002715' ifskp. ; Empty? 28886 002705'01 322 02 0 00 002713' ifn. t2 ; If zero, then no error and nothing to do 28887 002706'01 334 00 0 00 000000 %ermsg (,r) 28888 002707'01 254 00 0 00 002713' 28889 002710'01 265 01 0 00 002657* 28890 002711'01 000000000000# 28891 002712'01 254 00 0 00 002661* 28892 001712'04 125 156 141 142 154 28893 002713'01 endif. ; End case t2 having JSYS error code 28894 002713'01 400 04 0 00 000000 setz t4, ; Whack this round's PTY portion k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 42-1 K20NET MAC 15-Nov-23 19:11 clread Return buffer of what we cleared 28895 002714'01 254 00 0 00 002716' else. ; Otherwise, have some junk in there 28896 002715'01 200 04 0 00 000002 move t4, t2 ; Flag non-zero buffer, this round 28897 002716'01 endif. ; End SOBE% results handling 28898 002716'01 254 00 0 00 002720' else. ; Otherwise no PTY 28899 002717'01 400 04 0 00 000000 setz t4, ; So no PTY contribution 28900 002720'01 endif. ; End special case for pseudo-termina 28901 002720'01 554 01 0 00 000005 hlrz t1, q1 ; Now load whatever JFN we have 28902 002721'01 104 00 0 00 000102 SIBE% ; Skip if input buffer empty 28903 002722'01 254 00 0 00 002732' ifskp. ; Empty? 28904 002723'01 322 02 0 00 002731' ifn. t2 ; If zero, then no error; carry on 28905 002724'01 334 00 0 00 000000 %ermsg (,r) 28906 002725'01 254 00 0 00 002731' 28907 002726'01 265 01 0 00 002710* 28908 002727'01 000000000000# 28909 002730'01 254 00 0 00 002712* 28910 001723'04 125 156 141 142 154 28911 002731'01 endif. ; End case empty input buffer 28912 002731'01 254 00 0 00 002733' else. ; Otherwise, have some junk in there 28913 002732'01 270 04 0 00 000002 add t4, t2 ; Add to this round's tally 28914 002733'01 endif. ; End SOBE% results handling 28915 002733'01 322 04 0 00 002757' jumpe t4, endlp. ; If nothing there, we're done 28916 002734'01 313 04 0 00 000010 camle t4, q4 ; More than what we have left? 28917 002735'01 200 04 0 00 000010 move t4, q4 ; Yep, don't overflow the buffer 28918 002736'01 200 06 0 00 000004 move q2, t4 ; Position for inner loop 28919 002737'01 400 07 0 00 000000 setz q3, ; Zero inner loop tally 28920 002740'01 do. ; Enter inner loop context 28921 remark t1, q1 ; JFN is still in there from SIBE% 28922 002740'01 200 02 0 00 000011 move t2, q5 ; Load updated pointer 28923 002741'01 210 03 0 00 000004 movn t3, t4 ; Reading exactly that much 28924 002742'01 104 00 0 00 000052 SIN% ; Swallow whatever junk is in there 28925 002743'01 320 12 0 00 002745' %jsErr (,r) 28926 002744'01 254 00 0 00 002750' 28927 002745'01 265 01 0 00 002726* 28928 002746'01 000000000000# 28929 002747'01 254 00 0 00 002730* 28930 001732'04 125 156 141 142 154 28931 002750'01 270 04 0 00 000003 add t4, t3 ; Keep track of what we did NOT read 28932 002751'01 270 07 0 00 000004 add q3, t4 ; And add to loop total done 28933 002752'01 274 06 0 00 000004 sub q2, t4 ; Subtract from remaining 28934 002753'01 327 06 0 00 002740' jumpg q2, top. ; Loop if anything left 28935 002754'01 enddo. ; End context inner loop 28936 002754'01 274 10 0 00 000007 sub q4, q3 ; Subtract from total buffer size 28937 002755'01 200 11 0 00 000002 move q5, t2 ; Store updated pointer for next round 28938 002756'01 327 10 0 00 002700' jumpg q4, top. ; If got anything, take another look 28939 002757'01 enddo. ; End of loop lexical context 28940 28941 002757'01 201 01 0 00 000310 movx t1, flushc ; Load largest possible buffer 28942 002760'01 274 01 0 00 000010 sub t1, q4 ; Subtract total remaining 28943 002761'01 272 01 0 00 000000# addm t1, vchrcn ; Update grand total characters ever flushed 28944 002762'01 200 02 0 00 005604' move t2, [point 8,flushb] ; Return pointer to 'flush' buffer 28945 002763'01 254 00 0 00 002665* retskp ; Finally return success 28946 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 43 K20NET MAC 15-Nov-23 19:11 Routine to unstop an XOFF'd line, added as edit 91. 28947 subttl Routine to unstop an XOFF'd line, added as edit 91. 28948 28949 002764'01 ttxon: entry ttxon ;[211] Partly rewritten for PTY's and NRT's 28950 002764'01 265 16 0 00 005605' saveac ;[211] Needs an extra register 28951 28952 002765'01 260 17 0 00 002423' call clrbuf ;[211] Call our new friend to toss data 28953 002766'01 263 17 0 00 000000 ret ;[211] But couldn't; give up 28954 28955 002767'01 332 01 0 00 002670* skipe t1, netjfn ;[186] Load the network JFN 28956 002770'01 254 00 0 00 003005' ifskp. ;[186] Unless we don't have one... 28957 002771'01 332 00 0 00 001300* skipe local ;[186] Are we remote? 28958 002772'01 334 01 0 00 000000# ermsg% (,r) ;[186] Punt 28959 002773'01 254 00 0 00 002777' 28960 002774'01 202 01 0 00 002534* 28961 002775'01 104 00 0 00 000313 28962 002776'01 254 00 0 00 002747* 28963 000206'03 000000000000# 28964 001740'04 113 105 122 115 111 28965 28966 002777'01 336 01 0 00 002672* skipn t1, ttyjfn ;[186] Yes, so just use the terminal JFN 28967 003000'01 334 01 0 00 000000# ermsg% (,r) ;[186] 28968 003001'01 254 00 0 00 003005' 28969 003002'01 202 01 0 00 002774* 28970 003003'01 104 00 0 00 000313 28971 003004'01 254 00 0 00 002776* 28972 000207'03 000000000000# 28973 001754'04 113 105 122 115 111 28974 28975 003005'01 endif. ;[186] Hopefully have SOMETHING ... 28976 003005'01 514 05 0 00 000001 hrlz q1, t1 ;[211] Save the JFN (sans flags) for later 28977 28978 003006'01 336 00 0 00 000000# ifmn. ptyflg ;[211] A pseudo-terminal? 28979 003007'01 254 00 0 00 003012' 28980 003010'01 550 01 0 00 000000# hrrz t1, ptytty ;[211] Yes, don't do this to the PTY half 28981 003011'01 660 01 0 00 400000 txo t1, .ttdes ;[211] Do it to the TTY half 28982 003012'01 endif. ;[211] End PTY-FE/NRT decision 28983 003012'01 540 05 0 00 000001 hrr q1, t1 ;[211] Save some terminal descriptor 28984 28985 ;[157] If we're doing flow control, send a ^Q (XON) to unstick the other side. 28986 28987 003013'01 336 00 0 00 001631* skipn flow ; Doing flow control? 28988 003014'01 263 17 0 00 000000 ret ; No, done. 28989 28990 003015'01 332 00 0 00 000000# skipe nrtflg ;[211] An NRT? 28991 003016'01 254 00 0 00 003037' callret ttxon3 ;[211] Skip this terminal stuff 28992 ;[211] Will never work with a DCN: JFN 28993 003017'01 550 01 0 00 000005 ttxon2: hrrz t1, q1 ;[211] Get some terminal descriptor 28994 003020'01 104 00 0 00 000107 RFMOD ; Yes, get terminal mode. 28995 003021'01 320 16 0 00 003004* erjmp r 28996 003022'01 200 03 0 00 000002 move t3, t2 ; Save it. 28997 003023'01 622 02 0 00 000300 txze t2, tt%dam ; Data mode? 28998 003024'01 254 00 0 00 003027' ifskp. ;[211] No, so no need to change 28999 003025'01 260 17 0 00 003037' call ttxon3 ; No, binary, just send it. 29000 003026'01 254 00 0 00 003036' else. ;[211] Otherwise, tweak the mode 29001 003027'01 104 00 0 00 000110 SFMOD ; Put in binary mode. k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 43-1 K20NET MAC 15-Nov-23 19:11 Routine to unstop an XOFF'd line, added as edit 91. 29002 003030'01 320 12 0 00 003021* erjmpr r ;[211] 29003 003031'01 260 17 0 00 003037' call ttxon3 ; Send the XON. 29004 003032'01 550 01 0 00 000005 hrrz t1, q1 ;[211] Reload the terminal descriptor 29005 003033'01 200 02 0 00 000003 move t2, t3 ; Load original settings 29006 003034'01 104 00 0 00 000110 SFMOD ; Put back in data mode. 29007 003035'01 320 12 0 00 003030* erjmpr r ;[211] 29008 003036'01 endif. ;[211] End terminal mode tweaking 29009 003036'01 263 17 0 00 000000 ret 29010 29011 003037'01 554 01 0 00 000005 ttxon3: hlrz t1, q1 ;[211] Use the real JFN 29012 003040'01 201 02 0 00 000021 movei t2, xon ; Send an XON. 29013 003041'01 104 00 0 00 000051 BOUT 29014 003042'01 320 16 0 00 003035* erjmp r 29015 003043'01 263 17 0 00 000000 ret 29016 29017 ;[211] End clrbuf rewrite for non-physical terminals 29018 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 44 K20NET MAC 15-Nov-23 19:11 clsnet -- Close any kind of 'network' connection 29019 subttl clsnet -- Close any kind of 'network' connection 29020 29021 remark ; Has to be before first reference!! 29022 syn clscom,clsfe ; Close the terminal 29023 syn clscom,clspty ; Close the pseudo-terminal 29024 29025 ; Ignores local setting, uses netjfn, regardless. Checks the JFN, 29026 ; regardless of it possibly being absurd. 29027 29028 003044'01 clsjfn: entry clsjfn ; Invoked by Kermit exit 29029 003044'01 265 16 0 00 005621' saveac ;Don't touch anything 29030 003045'01 200 01 0 00 002767* move t1, netjfn ; Use whatever is there, no matter what 29031 003046'01 254 00 0 00 003054' jrst chkcls ; Just get started with the JFN 29032 29033 ; Expects nothing; checks local to see if we would even have the JFN 29034 ; and sanity checks the JFN 29035 29036 003047'01 clsnet: entry clsnet ; Callable by anybody 29037 extern local ; Set if we are not using .priou for transfers 29038 29039 003047'01 336 00 0 00 002771* skipn local ; Are we not using our own terminal for packets? 29040 003050'01 263 17 0 00 000000 ret ; We are, so there is nothing to clean up 29041 003051'01 265 16 0 00 005621' saveac ;Don't touch anything 29042 003052'01 337 01 0 00 003045* skipg t1, netjfn ; If we are local, then we will have a JFN 29043 003053'01 254 00 0 00 003160' jrst clsasg ; Unless we are in some odd state 29044 remark chkcls ; falls through 29045 29046 003054'01 chkcls: remark ; Here to check if we can close it 29047 003054'01 104 00 0 00 000024 GTSTS% ; Now let's find out about the JFN 29048 003055'01 320 12 0 00 003057' ifje. r ; Catch and ignore the error 29049 003056'01 254 00 0 00 003063' 29050 003057'01 200 04 0 00 000001 move t4, t1 ; Save any error code for later 29051 003060'01 400 05 0 00 000000 setz q1, ; Whack the bits, assume nothing 29052 003061'01 550 01 0 00 003052* hrrz t1, netjfn ; Reload the JFN 29053 003062'01 254 00 0 00 003064' else. ; Otherwise, worked 29054 003063'01 200 05 0 00 000002 move q1, t2 ; Save the status bits 29055 003064'01 endif. 29056 003064'01 607 05 0 00 000200 jxe q1, gs%nam, clscln ; Nothing there? Just scrub the storage 29057 003065'01 254 00 0 00 003224' 29058 29059 003066'01 104 00 0 00 000117 DVCHR% ; JFN might work 29060 003067'01 320 12 0 00 003071' ifje. r ; But didn't 29061 003070'01 254 00 0 00 003075' 29062 003071'01 200 04 0 00 000001 move t4, t1 ; Save any error code for later 29063 003072'01 477 06 0 00 000010 setob q2, q4 ; Phoney device designator and assignment 29064 003073'01 400 07 0 00 000000 setz q3, ; No characteristics 29065 003074'01 254 00 0 00 003077' else. ; Otherwise, worked. Promising... 29066 003075'01 120 06 0 00 000001 dmove q2, t1 ; Save device designator and characteristics 29067 003076'01 200 10 0 00 000003 move q4, t3 ; And assignment word 29068 003077'01 endif. 29069 003077'01 325 05 0 00 003153' jxe q1, gs%opn, clsrlj ; If it isn't open, don't close it 29070 ; Load the device type 29071 003100'01 135 04 0 00 005637' ldb t4,[pointr q3,dv%typ] 29072 003101'01 306 04 0 00 000012 cain t4, .dvtty ; Physical (front end) terminal? 29073 003102'01 254 00 0 00 003130' jrst clsfe ; Clean that up and deassign k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 44-1 K20NET MAC 15-Nov-23 19:11 clsnet -- Close any kind of 'network' connection 29074 003103'01 306 04 0 00 000013 cain t4, .dvpty ; Pseudo terminal? 29075 003104'01 254 00 0 00 003130' jrst clspty ; Clean that up and deassign 29076 003105'01 306 04 0 00 000022 cain t4, .dvdcn ; Outgoing NRT? 29077 003106'01 254 00 0 00 003121' jrst clsnrt ; Clean that up (no deassign) 29078 29079 003107'01 334 01 0 00 000000# ermsg% (, clscom) 29080 003110'01 254 00 0 00 003114' 29081 003111'01 202 01 0 00 003002* 29082 003112'01 104 00 0 00 000313 29083 003113'01 254 00 0 00 003130' 29084 000210'03 000000000000# 29085 001770'04 113 105 122 115 111 29086 29087 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 45 K20NET MAC 15-Nov-23 19:11 Various JFN closure routines 29088 subttl Various JFN closure routines 29089 29090 remark ; See required location of SYN's, above 29091 remark clsfe ; Close the terminal 29092 remark clspty ; Close the pseudo-terminal 29093 29094 003114'01 44 07 0 00 003116' nrtend: point 7, .+2 ; Point to message 29095 003115'01 000000 000014 ^d12 ; Its length 29096 003116'01 113 145 162 155 151 ASCIZ "Kermit Close" ; Informative message... 29097 29098 003121'01 550 01 0 00 003061* clsnrt: hrrz t1, netjfn ; Load the network JFN 29099 003122'01 200 02 0 00 005640' move t2, [.dcx40,,.moclz] ;Object initiated close 29100 003123'01 120 03 0 00 003114' dmove t3, nrtend ; Message for remote NRT server to ignore 29101 003124'01 104 00 0 00 000077 MTOPR% ; Try to deliver the bad news 29102 003125'01 320 12 0 00 003127' ifje. r ; Catch and ignore error 29103 003126'01 254 00 0 00 003130' 29104 003127'01 200 04 0 00 000001 move t4, t1 ; Leave around for debugger 29105 003130'01 endif. 29106 remark clscom ; And proceed ...(falls through) 29107 29108 003130'01 550 01 0 00 003121* clscom: hrrz t1, netjfn ; Common close for any kind of JFN 29109 003131'01 104 00 0 00 000022 CLOSF% ; Make our first attempt 29110 003132'01 320 12 0 00 003134' ifje. r ; Catch and ignore the error 29111 003133'01 254 00 0 00 003140' 29112 003134'01 200 04 0 00 000001 move t4, t1 ; Save error for later 29113 003135'01 302 01 0 00 600160 caie t1, clsx1 ; File not open? 29114 003136'01 254 00 0 00 003141' jrst clsabt ; No, try to abort it 29115 003137'01 254 00 0 00 003153' jrst clsrlj ; Otherwise, just try to let go of it 29116 003140'01 endif. 29117 003140'01 254 00 0 00 003160' jrst clsasg ; Go clean up assignments and storage 29118 29119 003141'01 550 01 0 00 003130* clsabt: hrrz t1, netjfn ; Load the JFN, no flags 29120 003142'01 661 01 0 00 004000 txo t1, cz%abt ; Set the abort flag 29121 003143'01 104 00 0 00 000022 CLOSF% ; Toss it with reckless abandon 29122 003144'01 320 12 0 00 003146' ifje. r ; Catch and ignore the error 29123 003145'01 254 00 0 00 003152' 29124 003146'01 200 04 0 00 000001 move t4, t1 ; Save error for later 29125 003147'01 302 01 0 00 600152 caie t1, desx3 ; JFN not assigned anymore> 29126 003150'01 254 00 0 00 003141' jrst clsabt ; No, just try to let go of it 29127 003151'01 254 00 0 00 003160' jrst clsasg ; Otherwise, release assignments 29128 003152'01 endif. 29129 003152'01 254 00 0 00 003160' jrst clsasg ; Go clean up assignments 29130 29131 003153'01 550 01 0 00 003141* clsrlj: hrrz t1, netjfn ; Just try to let go 29132 003154'01 104 00 0 00 000023 RLJFN% ; and hope for the bext 29133 003155'01 320 12 0 00 003157' ifje. r ; Catch and ignore the error 29134 003156'01 254 00 0 00 003160' 29135 003157'01 200 04 0 00 000001 move t4, t1 ; Save error for later 29136 003160'01 endif. 29137 remark clsasg ; Clean up assignments 29138 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 46 K20NET MAC 15-Nov-23 19:11 Release any assigned terminals, pseudo or otherwise 29139 subttl Release any assigned terminals, pseudo or otherwise 29140 29141 003160'01 336 00 0 00 001130* clsasg: ifmn. asgflg ; Do we think anything assigned? 29142 003161'01 254 00 0 00 003167' 29143 003162'01 200 01 0 00 001131* move t1, asgdev ; Grab assigned device 29144 003163'01 104 00 0 00 000071 RELD% ; Punt it 29145 003164'01 320 12 0 00 003166' ifje. r ; Sigh 29146 003165'01 254 00 0 00 003167' 29147 003166'01 200 04 0 00 000001 move t4, t1 ; What if different from q2? 29148 003167'01 endif. 29149 003167'01 endif. 29150 ; Do a consistency check 29151 003167'01 574 03 0 00 000010 hlre t3, q4 ; Load job assignment 29152 003170'01 312 03 0 00 005641' came t3, [-1] ; Not assigned? 29153 003171'01 316 03 0 00 005642' camn t3, [-2] ; Allocator has it? 29154 003172'01 254 00 0 00 003224' Jrst clscln ; Then nothing else to do 29155 003173'01 312 03 0 00 001100* came t3, myjob ; Do we have this device? 29156 003174'01 254 00 0 00 003224' jrst clscln ; No, then surely cannot release it 29157 003175'01 200 01 0 00 000006 move t1, q2 ; Load JFN's device designator 29158 003176'01 316 01 0 00 003162* camn t1, asgdev ; Did we already release it, actually? 29159 003177'01 254 00 0 00 003224' jrst clscln ; Yes, so no inconsistency 29160 ; No, something extra left lying around... 29161 003200'01 554 02 0 00 000001 hlrz t2, t1 ; Pick up the device type 29162 003201'01 550 03 0 00 000001 hrrz t3, t1 ; Pick up the unit number 29163 003202'01 326 02 0 00 003212' ife. t2 ; But!! Any device type? 29164 003203'01 626 03 0 00 400000 trzn t3, .ttdes ; Universal terminal? 29165 003204'01 254 00 0 00 003224' jrst clscln ; No, some odd thing. Leave it alone 29166 003205'01 316 03 0 00 001263* camn t3, mytty ; It's a terminal. Ourself? 29167 003206'01 254 00 0 00 003224' jrst clscln ; Yes, LOGIN% or CRJOB% gave it to us 29168 003207'01 550 01 0 00 000003 hrrz t1, t3 ; Load bare terminal number 29169 003210'01 505 01 0 00 600012 hrli t1, .dvdes!.dvtty ;Give a general device designator 29170 003211'01 254 00 0 00 003220' else. ; Otherwise, fullword 29171 003212'01 200 04 0 00 000002 move t4, t2 ; Make a copy of the device designator 29172 003213'01 620 04 0 00 600000 trz t4, .dvdes ; Shut off the device designator 29173 003214'01 302 04 0 00 000012 caie t4, .dvtty ; A terminal? 29174 003215'01 254 00 0 00 003220' anskp. ; Not a terminal, so can't be our terminal 29175 003216'01 316 03 0 00 003205* camn t3, mytty ; It's a terminal. Ourself? 29176 003217'01 254 00 0 00 003224' jrst clscln ; Yes, LOGIN% or CRJOB% gave it to us 29177 003220'01 endif. ; To RELD% 29178 29179 003220'01 104 00 0 00 000071 RELD% ; Try to punt it, anyway 29180 003221'01 320 12 0 00 003223' ifje. r ; Sigh 29181 003222'01 254 00 0 00 003224' 29182 003223'01 200 04 0 00 000001 move t4, t1 ; Save error number for debuggers 29183 003224'01 endif. 29184 remark clscln ; Fall through to storage clean up 29185 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 47 K20NET MAC 15-Nov-23 19:11 Finally obliterate JFN related storage 29186 subttl Finally obliterate JFN related storage 29187 29188 ; Leaves ASCII device or node names alone for possible later reporting 29189 29190 003224'01 402 00 0 00 003160* clscln: setzm asgflg ; Nothing assigned 29191 003225'01 402 00 0 00 003176* setzm asgdev ; No relec of it, either 29192 003226'01 402 00 0 00 003153* setzm netjfn ; Not no JFN, not no how 29193 29194 003227'01 403 01 0 00 000002 setzb t1, t2 ; In case we have adjacent words 29195 003230'01 124 01 0 00 000000# dmovem t1, ndvchr ; Whack the characteristics double word 29196 003231'01 402 00 0 00 002351* setzm vtermf ; No kind of virtual terminal 29197 003232'01 402 00 0 00 000000# setzm nrtflg ; Not a DECnet NRT connection 29198 003233'01 402 00 0 00 000000# setzm ptytty ; No terminal assigned via PTY, either 29199 003234'01 402 00 0 00 000000# setzm ptyflg ; No a pseudo-terminal connection 29200 003235'01 402 00 0 00 000000# setzm ttyflg ; Not using a physical terminal 29201 003236'01 402 00 0 00 000000# setzm ttydev ; So don't have a device designator 29202 29203 003237'01 200 03 0 00 003216* move t3, mytty ; Use our local terminal 29204 003240'01 202 03 0 00 001503* movem t3, ttynum ; Use that 29205 003241'01 402 00 0 00 003047* setzm local ; We are no longer local 29206 003242'01 476 00 0 00 000000# setom opndev ; No opened device 29207 003243'01 263 17 0 00 000000 ret ; One way or another, finally done 29208 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 48 K20NET MAC 15-Nov-23 19:11 Lost virtual terminal connection, shut everything down 29209 subttl Lost virtual terminal connection, shut everything down 29210 29211 003244'01 netvtx: entry netvtx ;[196] 29212 extern frkchb ;[218] Convert channel number to bit 29213 txmsg < 29214 003244'01 200 01 0 00 000000# [KERMIT-20: Lost > 29215 003245'01 104 00 0 00 000076 29216 003246'01 320 12 0 00 003247' 29217 000211'03 000000000000# 29218 002000'04 015 012 007 133 113 29219 29220 003247'01 336 00 0 00 000000# ifmn. ptyflg 29221 003250'01 254 00 0 00 003266' 29222 003251'01 200 01 0 00 000000# txmsg 29223 003252'01 104 00 0 00 000076 29224 003253'01 320 12 0 00 003254' 29225 000212'03 000000000000# 29226 002005'04 160 163 145 165 144 29227 003254'01 561 01 0 00 000000# hrroi t1, ptynam ; Point to pseudo-terminal device name 29228 003255'01 104 00 0 00 000076 PSOUT% ; Type that 29229 003256'01 200 01 0 00 000000# txmsg < (> 29230 003257'01 104 00 0 00 000076 29231 003260'01 320 12 0 00 003261' 29232 000213'03 000000000000# 29233 002014'04 040 050 000 000 000 29234 003261'01 561 01 0 00 000000# hrroi t1, ttynam ; Point to associated terminal device name 29235 003262'01 104 00 0 00 000076 PSOUT% ; Type that 29236 003263'01 200 01 0 00 000000# txmsg <) > 29237 003264'01 104 00 0 00 000076 29238 003265'01 320 12 0 00 003266' 29239 000214'03 000000000000# 29240 002015'04 051 040 000 000 000 29241 003266'01 endif. 29242 29243 003266'01 336 00 0 00 000000# ifmn. nrtflg 29244 003267'01 254 00 0 00 003300' 29245 003270'01 200 01 0 00 000000# txmsg 29246 003271'01 104 00 0 00 000076 29247 003272'01 320 12 0 00 003273' 29248 000215'03 000000000000# 29249 002016'04 104 105 103 156 145 29250 003273'01 561 01 0 00 001702* hrroi t1,nodnam ; Point to the remote node 29251 003274'01 104 00 0 00 000076 PSOUT% ; Type it 29252 003275'01 200 01 0 00 000000# txmsg <:: > ; Trailing punctuation 29253 003276'01 104 00 0 00 000076 29254 003277'01 320 12 0 00 003300' 29255 000216'03 000000000000# 29256 002024'04 072 072 040 000 000 29257 003300'01 endif. 29258 29259 003300'01 200 01 0 00 000000# txmsg ; Find out where this blew up 29260 003301'01 104 00 0 00 000076 29261 003302'01 320 12 0 00 003303' 29262 000217'03 000000000000# 29263 002025'04 141 164 072 040 000 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 48-1 K20NET MAC 15-Nov-23 19:11 Lost virtual terminal connection, shut everything down 29264 003303'01 200 01 0 17 000000 move t1, (p) ; See who called us 29265 003304'01 621 01 0 00 777700 txz t1, klflgs ; Flags aren't part of the address 29266 003305'01 260 17 0 00 000000* call symout ; Symbollically! 29267 003306'01 200 01 0 00 000000# txmsg <. Returning to > 29268 003307'01 104 00 0 00 000076 29269 003310'01 320 12 0 00 003311' 29270 000220'03 000000000000# 29271 002026'04 056 040 122 145 164 29272 003311'01 561 01 0 00 000000# hrroi t1,sysnam ; Load local node name 29273 003312'01 104 00 0 00 000076 PSOUT% ; Type it, not "DEC-20" 29274 29275 dmove t1, [ .fhsup ;[218] Signaling superior Kermit 29276 003313'01 120 01 0 00 005643' frkchb ] ;[218] Inter-fork signal 29277 003314'01 104 00 0 00 000132 IIC% ; Give it a poke 29278 003315'01 320 12 0 00 003317' ifje. r ; Failed?? 29279 003316'01 254 00 0 00 003340' 29280 003317'01 302 01 0 00 600251 caie t1, FRKHX2 ; Wait! Tried to poke the wrong guy? 29281 003320'01 334 00 0 00 000000 %ermsg (,neter2) 29282 003321'01 254 00 0 00 003325' 29283 003322'01 265 01 0 00 002745* 29284 003323'01 000000000000# 29285 003324'01 254 00 0 00 003343' 29286 002032'04 125 156 141 142 154 29287 003325'01 201 01 0 00 400000 movei t1, .fhslf ;[186] We must be the inferior 29288 003326'01 104 00 0 00 000132 IIC% ;[186] So poke ourselves 29289 003327'01 320 12 0 00 003331' %jserr (,) ;[186] 29290 003330'01 254 00 0 00 003334' 29291 003331'01 265 01 0 00 003322* 29292 003332'01 000000000000# 29293 003333'01 254 00 0 00 003334' 29294 002044'04 125 156 141 142 154 29295 txmsg <:: (Sup)] 29296 29297 003334'01 200 01 0 00 000000# > 29298 003335'01 104 00 0 00 000076 29299 003336'01 320 12 0 00 003337' 29300 000221'03 000000000000# 29301 002053'04 072 072 040 050 123 29302 29303 003337'01 254 00 0 00 002363* jrst $connx ;[186] In self-case, close some other things 29304 003340'01 endif. ;[186] End signaling analysis and recovery 29305 txmsg <:: (Inf)] 29306 29307 003340'01 200 01 0 00 000000# > 29308 003341'01 104 00 0 00 000076 29309 003342'01 320 12 0 00 003343' 29310 000222'03 000000000000# 29311 002056'04 072 072 040 050 111 29312 29313 29314 003343'01 104 00 0 00 000170 neter2: HALTF ; Halt this fork. 29315 003344'01 254 00 0 00 003343' jrst neter2 ; Should never get here... 29316 29317 003345'01 261 17 0 00 000001 netinh: push p, t1 ; Save t1, just in case useful 29318 003346'01 261 17 0 00 000002 push p, t2 ; Ditto others k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 48-2 K20NET MAC 15-Nov-23 19:11 Lost virtual terminal connection, shut everything down 29319 003347'01 261 17 0 00 000003 push p, t3 29320 29321 003350'01 561 01 0 00 003366' hrroi t1, netinm ; Load error message 29322 003351'01 104 00 0 00 000313 ESOUT% ; Give ourselves an error 29323 003352'01 201 01 0 00 000101 movei t1,.priou ; Continue on primary output 29324 003353'01 525 02 0 00 400000 hrloi t2,.fhslf ; Wants this for explicit error 29325 003354'01 400 03 0 00 000000 setz t3, ; Don't limit length of text 29326 003355'01 104 00 0 00 000011 ERSTR% ; Type the JSYS failure reason text 29327 003356'01 320 12 0 00 003360' erjmpr .+2 ; Ignore strange error 29328 003357'01 320 12 0 00 003360' erjmpr .+1 ; Ignore stranger error 29329 003360'01 561 01 0 00 001727* hrroi t1, crlf ; Tie off the line 29330 003361'01 104 00 0 00 000076 PSOUT% 29331 29332 003362'01 262 17 0 00 000003 pop p, t3 ; Restore them 29333 003363'01 262 17 0 00 000002 pop p, t2 ; all of 29334 003364'01 262 17 0 00 000001 pop p, t1 ; them 29335 003365'01 254 00 0 00 003343' jrst neter2 ; Go drop dead and stay dead 29336 29337 003366'01 116 145 164 167 157 netinm: asciz /Network input subfork unexpectedly halted, / 29338 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 49 K20NET MAC 15-Nov-23 19:11 Open Net -- Opens network connection to somewhere 29339 subttl Open Net -- Opens network connection to somewhere 29340 29341 ; Call: 29342 ; 29343 ; t1/ LH: device type number - .dvpty, .dvdcn, .dvtty 29344 ; RH: unit number, if applicable (-1, otherwise) 29345 ; 29346 ; Return: 29347 ; 29348 ; +1/ t1, Gubbish 29349 ; t2, Ditto 29350 ; 29351 ; +2/ t1, JFN ready to use 29352 ; t2, Associated device designator (which may have been assigned) 29353 ; 29354 ; N.B., Assumes we are not treating a disk as a terminal 29355 29356 003377'01 openet: entry openet ; World callable 29357 extern flow ; Used for ^S/^Q processing 29358 003377'01 265 16 0 00 005564' saveac ;Save some things 29359 003400'01 200 05 0 00 000001 move q1, t1 ; Let's get that out of the way 29360 29361 003401'01 337 01 0 00 003226* skipg t1, netjfn ; Is anything maybe open? 29362 003402'01 254 00 0 00 003421' ifskp. ; Yes, let's get some information 29363 003403'01 104 00 0 00 000024 GTSTS% ; Get file status of JFN 29364 003404'01 320 16 0 00 003421' annje. ; Give up; JFN has to be ill 29365 003405'01 607 02 0 00 000200 ifxn. t2, gs%nam ; Don't go any further if nothing there 29366 003406'01 254 00 0 00 003420' 29367 003407'01 325 02 0 00 003420' andxn. t2, gs%opn ; And it has to be open 29368 003410'01 200 04 0 00 000002 move t4, t2 ; Save the status word 29369 003411'01 104 00 0 00 000117 DVCHR% ; Get the device characteristics 29370 003412'01 320 12 0 00 003414' ifje. r ; Catch and record error 29371 003413'01 254 00 0 00 003416' 29372 003414'01 661 04 0 00 000400 txo t4, gs%err ; Pretend the file is in error 29373 003415'01 254 00 0 00 003420' else. ; Otherwise, worked 29374 003416'01 200 06 0 00 000001 move q2, t1 ; Save device designator 29375 003417'01 120 07 0 00 000002 dmove q3, t2 ; Save characteristics and assignment 29376 003420'01 endif. ; End DVCHR error handling 29377 003420'01 endif. ; End case file status checking 29378 003420'01 254 00 0 00 003423' else. ; Otherwise, whack everything 29379 003421'01 403 04 0 00 000006 setzb t4, q2 ; No status or device designator 29380 003422'01 403 07 0 00 000010 setzb q3, q4 ; No device characteristics or assignment 29381 003423'01 endif. 29382 29383 remark ; See if we need to ditch the JFN 29384 003423'01 607 04 0 00 000200 ifxn. t4, gs%nam ; Is there a JFN already? 29385 003424'01 254 00 0 00 003430' 29386 003425'01 607 04 0 00 000400 andxn. t4, gs%err ; Any kind of error, phoney or otherwise? 29387 003426'01 254 00 0 00 003430' 29388 003427'01 260 17 0 00 003044' call clsjfn ; Yes, stomp it 29389 003430'01 endif. ; End case JFN status check 29390 29391 003430'01 554 01 0 00 000005 hlrz t1, q1 ; Finally have a look at the device type number 29392 003431'01 135 02 0 00 005645' ldb t2,[pointr q2,dv%typ];Load JFN's device type number 29393 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 49-1 K20NET MAC 15-Nov-23 19:11 Open Net -- Opens network connection to somewhere 29394 003432'01 302 01 0 00 000013 caie t1, .dvpty ; Wants a pseudo-terminal? 29395 003433'01 254 00 0 00 003443' ifskp. ; Yes, let's see if we are reconnecting 29396 003434'01 312 01 0 00 000002 came t1, t2 ; Already has one? 29397 003435'01 254 00 0 00 003440' ifskp. ; Fine, give him the same one 29398 003436'01 550 01 0 00 003401* hrrz t1, netjfn ; Reload the JFN 29399 003437'01 254 00 0 00 002763* retskp ; Return success 29400 003440'01 endif. ; Otherwise, wants to go somewhere else 29401 003440'01 603 04 0 00 400000 txne t4, gs%opn ; Anything already open? 29402 003441'01 260 17 0 00 003044' call clsjfn ; Yes, stomp it 29403 003442'01 254 00 0 00 003521' callret opnpty ; Yes, go assign and open one 29404 003443'01 endif. ; End case pseudo-terminal connection 29405 29406 003443'01 302 01 0 00 000012 caie t1, .dvtty ; Wants a physical terminal? 29407 003444'01 254 00 0 00 003463' ifskp. ; Yes, let's see if we are reconnecting 29408 003445'01 312 01 0 00 000002 came t1, t2 ; Already has one? 29409 003446'01 254 00 0 00 003460' ifskp. ; Yes, maybe reusing the current one 29410 003447'01 550 01 0 00 000005 hrrz t1, q1 ; Pick up requested unit number 29411 003450'01 135 02 0 00 005646' ldb t2,[pointr q2,dv%unt] ;Load JFN's device type number 29412 003451'01 312 01 0 00 000002 came t1, t2 ; Are they the same? 29413 003452'01 254 00 0 00 003460' anskp. ; No, release the old one and get out of here 29414 003453'01 574 01 0 00 000010 hlre t1, q4 ; Pick up assigned job 29415 003454'01 312 01 0 00 003173* came t1, myjob ; Is it me? 29416 003455'01 254 00 0 00 003460' anskp. ; Strange, don't risk reusing it 29417 003456'01 550 01 0 00 003436* hrrz t1, netjfn ; Reload the JFN 29418 003457'01 254 00 0 00 003437* retskp ; Return success 29419 003460'01 endif. 29420 003460'01 603 04 0 00 400000 txne t4, gs%opn ; Anything already open? 29421 003461'01 260 17 0 00 003044' call clsjfn ; Yes, stomp it 29422 003462'01 254 00 0 00 003625' callret opntty ; Go assign terminal and open it 29423 003463'01 endif. ; End case physical terminal 29424 29425 003463'01 302 01 0 00 000022 caie t1, .dvdcn ; Wants a DECnet NRT?? 29426 003464'01 254 00 0 00 003514' ifskp. ; Yes, maybe going to the same place 29427 003465'01 312 01 0 00 000002 came t1, t2 ; Already there someplace? 29428 003466'01 254 00 0 00 003511' ifskp. ; Fine, give him the same one 29429 003467'01 336 00 0 00 000000# ifmn. ndvfxp ; Has extended verify? 29430 003470'01 254 00 0 00 003500' 29431 003471'01 260 17 0 00 000236' call chknrt ; OK, so check the node name 29432 003472'01 254 00 0 00 003477' ifskp. ; Worked, let's compare the numbers 29433 003473'01 312 01 0 00 000000# came t1, oldnum ; Going to same node? 29434 003474'01 254 00 0 00 003477' anskp. ; No, so close up shop and go elsewhere 29435 003475'01 550 01 0 00 003456* hrrz t1, netjfn ; The same; reload the JFN 29436 003476'01 254 00 0 00 003457* retskp ; Return success 29437 003477'01 endif. ; Done 29438 remark ; Otherwise falls out and gets new connection 29439 003477'01 254 00 0 00 003511' else. ; Otherwise, have to compare characters 29440 dmove t1, [ -1,,oldnam ; Old node name 29441 003500'01 120 01 0 00 005647' -1,,nodnam ] ; Current node name 29442 003501'01 104 00 0 00 000540 STCMP% ; Compare them 29443 003502'01 320 12 0 00 003504' ifje. r ; Failed?? 29444 003503'01 254 00 0 00 003506' 29445 003504'01 200 03 0 00 000001 move t3, t1 ; Save error code 29446 003505'01 474 01 0 00 000000 seto t1, ; For sure not equal 29447 003506'01 endif. 29448 003506'01 326 01 0 00 003511' ife. t1 ; Equal? k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 49-2 K20NET MAC 15-Nov-23 19:11 Open Net -- Opens network connection to somewhere 29449 003507'01 550 01 0 00 003475* hrrz t1, netjfn ; The same; reload the JFN 29450 003510'01 254 00 0 00 003476* retskp ; Return success 29451 003511'01 endif. 29452 003511'01 endif. ; End same destination checks 29453 003511'01 endif. 29454 003511'01 603 04 0 00 400000 txne t4, gs%opn ; Anything already open? 29455 003512'01 260 17 0 00 003044' call clsjfn ; Yes, stomp it 29456 003513'01 254 00 0 00 000213' callret decnct ; Go connect somewhere 29457 003514'01 endif. ; End case DECnet MCB terminal 29458 29459 003514'01 334 01 0 00 000000# ermsg% (,r) 29460 003515'01 254 00 0 00 003521' 29461 003516'01 202 01 0 00 003111* 29462 003517'01 104 00 0 00 000313 29463 003520'01 254 00 0 00 003042* 29464 000223'03 000000000000# 29465 002061'04 113 105 122 115 111 29466 29467 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 50 K20NET MAC 15-Nov-23 19:11 Open a psuedo terminal connection 29468 subttl Open a psuedo terminal connection 29469 29470 003521'01 opnpty: remark ;These are already saved 29471 003521'01 260 17 0 00 001056' call asipty ; First, assign a PTY 29472 003522'01 263 17 0 00 000000 ret ; Unless we couldn't ... 29473 003523'01 476 00 0 00 003241* setom local ; We're the local Kermit 29474 29475 003524'01 120 05 0 00 000001 dmove q1, t1 ; Load terminal line and PTY designator 29476 003525'01 202 01 0 00 003240* movem t1,ttynum ; Store associated line number 29477 003526'01 202 02 0 00 000000# movem t2,ptydev ; Store assigned PTY designator 29478 003527'01 201 03 0 00 000010 movei t3, TOPS20 ; On a pseudo-terminal (I.E., a loopback) 29479 003530'01 200 04 0 03 000763' move t4, hsttyp(t3) ; Load OWGP to OS type string 29480 003531'01 124 03 0 00 000000# dmovem t3, nrtros ; The 'remote' OS is always Tops-20... 29481 29482 remark asgflg ; asipty sets the assigned flag 29483 remark asgdev ; Ditto the assigned device 29484 remark ptyflg ; Ditto pty and bin flags 29485 003532'01 402 00 0 00 003013* setzm flow ; Don't do control flow (although works) 29486 29487 003533'01 402 00 0 00 003507* setzm netjfn ; No network JFN, yet 29488 dmove t1, [ gj%sht!gj%flg ; Want flags 29489 003534'01 120 01 0 00 005651' -1,,ptynam ] ; asipty built this for us 29490 003535'01 104 00 0 00 000020 GTJFN% ; Try to open it 29491 003536'01 320 12 0 00 003540' ifje. r ; Catch the error 29492 003537'01 254 00 0 00 003552' 29493 003540'01 200 04 0 00 000001 move t4, t1 ; Record for debugger 29494 003541'01 334 00 0 00 000000 %ermsg (,) ; Bizarre, we just got the device 29495 003542'01 254 00 0 00 003546' 29496 003543'01 265 01 0 00 003331* 29497 003544'01 000000000000# 29498 003545'01 254 00 0 00 003546' 29499 002074'04 103 141 156 047 164 29500 003546'01 200 01 0 00 000006 move t1, q2 ; Load assigned designator 29501 003547'01 260 17 0 00 003620' call deadev ; Go deasign the device 29502 003550'01 263 17 0 00 000000 ret ; Return failure 29503 003551'01 254 00 0 00 003555' else. ; Otherwise worked 29504 003552'01 552 01 0 00 003533* hrrzm t1, netjfn ; Save as network JFN 29505 003553'01 512 01 0 00 000316* hllzm t1, netflg ; Ditto the flags (just in case) 29506 003554'01 200 11 0 00 000001 move q5, t1 ; Save a copy for recovery 29507 003555'01 endif. ; End case JSYS failure 29508 29509 003555'01 621 01 0 00 777777 tlz t1,-1 ; Whack flags them so OPENF% doesn't choke 29510 003556'01 200 02 0 00 005653' movx t2, fld(8,of%bsz)!of%wr!of%rd ; 8-bit bytes, read & write access. 29511 003557'01 104 00 0 00 000021 OPENF% ; Open the device. 29512 003560'01 320 12 0 00 003562' ifje. r ; Catch the error 29513 003561'01 254 00 0 00 003572' 29514 003562'01 200 04 0 00 000001 move t4, t1 ; Record for debugger 29515 003563'01 334 00 0 00 000000 %ermsg (,) ; Bizarre, we just got the device 29516 003564'01 254 00 0 00 003570' 29517 003565'01 265 01 0 00 003543* 29518 003566'01 000000000000# 29519 003567'01 254 00 0 00 003570' 29520 002101'04 103 157 165 154 144 29521 003570'01 550 01 0 00 000011 hrrz t1, q5 ; Load the JFN, sans flags 29522 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 20:02 27-Nov-23 Page 50-1 K20NET MAC 15-Nov-23 19:11 Open a psuedo terminal connection 29523 003572'01 endif. ; End case JSYS results handling 29524 ;[223] Find out about the associated terminal 29525 003572'01 200 01 0 00 000005 move t1, q1 ;[223] Load the terminal line 29526 003573'01 660 01 0 00 400000 txo t1, .ttdes ;[223] Turn it into a terminal designator 29527 003574'01 260 17 0 00 004776' call gndpar ;[223] Go find out about the parity 29528 003575'01 400 02 0 00 000000 setz t2, ;[223] Failed somehow, so no parity 29529 003576'01 606 02 0 00 000001 ifxn. t2, gd%par ;[223] Will it tolerate parity?? 29530 003577'01 254 00 0 00 003602' 29531 003600'01 476 00 0 00 000000# setom opnpar ;[223] It will 29532 003601'01 254 00 0 00 003603' else. ;[223] ...Otherwise... 29533 003602'01 402 00 0 00 000000# setzm opnpar ;[223] It won't 29534 003603'01 endif. ;[223] 29535 29536 003603'01 550 01 0 00 000011 hrrz t1, q5 ;[223] Load the PTY JFN, sans flags 29537 003604'01 201 02 0 00 000003 movei t2, .chcnc ;[186] PTY *must* have a ^C to get going 29538 003605'01 260 17 0 00 001741' call BOUTR% ;[186] Push it out, either way 29539 003606'01 334 00 0 00 000000 %ermsg (,r) ;[186] 29540 003607'01 254 00 0 00 003613' 29541 003610'01 265 01 0 00 003565* 29542 003611'01 000000000000# 29543 003612'01 254 00 0 00 003520* 29544 002106'04 106 151 162 163 164 29545 29546 003613'01 200 02 0 00 000006 move t2, q2 ; Load PTY device designator 29547 003614'01 201 03 0 00 000013 movei t3, .dvpty ; Opened a pseudo-terminal 29548 003615'01 202 03 0 00 000000# movem t3, opndev ; Store opened device type 29549 003616'01 476 00 0 00 003231* setom vtermf ; Set the virtual terminal flag 29550 003617'01 254 00 0 00 003510* retskp ; Won!! 29551 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 51 K20NET MAC 15-Nov-23 19:11 Used to deassign anything during opening failure 29552 subttl Used to deassign anything during opening failure 29553 29554 003620'01 104 00 0 00 000117 deadev: DVCHR% ; Pull the device characteristics 29555 003621'01 320 12 0 00 003224' erjmpr clscln ; Ignore error and scrub storage 29556 003622'01 120 06 0 00 000001 dmove q2, t1 ; Position designator and characteristics 29557 003623'01 200 10 0 00 000003 move q4, t3 ; Where clsarg wants them 29558 003624'01 254 00 0 00 003160' callret clsasg ; Go hand off to release device and scrub 29559 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 52 K20NET MAC 15-Nov-23 19:11 Open a physical line 29560 subttl Open a physical line 29561 29562 ; Assumes q1 has an (octal) line number 29563 29564 003625'01 265 16 0 00 005654' opntty: saveac ;[223] For a copy of the JFN 29565 003626'01 550 01 0 00 000005 hrrz t1, q1 ; Load the unit number (the terminal line) 29566 003627'01 312 01 0 00 003237* came t1, mytty ; Is it us? 29567 003630'01 254 00 0 00 003640' ifskp. ; Yes, LOGIN% or CRJOB% assigned it 29568 003631'01 402 00 0 00 003224* setzm asgflg ; Not assigned 29569 003632'01 402 00 0 00 003225* setzm asgdev ; So get rid of artifacts 29570 003633'01 402 00 0 00 000000# setzm ttydev ; all of them 29571 003634'01 550 02 0 00 000005 hrrz t2, q1 ; Begin build for DEVST% 29572 003635'01 505 02 0 00 600012 hrli t2, .dvdes!.dvtty ;Turn into a device designator 29573 003636'01 200 06 0 00 000002 move q2, t2 ; Save that, just in case 29574 003637'01 254 00 0 00 003664' jrst gttyjf ; Now go get a TTY JFN 29575 003640'01 endif. 29576 29577 003640'01 505 01 0 00 600012 hrli t1, .dvdes!.dvtty ; Turn into a device designator 29578 003641'01 200 06 0 00 000001 move q2, t1 ; Save that for later 29579 003642'01 621 01 0 00 777777 tlz t1, -1 ; Shut them back off for NTINF% 29580 003643'01 311 01 0 00 000000# caml t1, pty1st ; Into virtual range? 29581 003644'01 334 01 0 00 000000# ermsg% (, clscln) 29582 003645'01 254 00 0 00 003651' 29583 003646'01 202 01 0 00 003516* 29584 003647'01 104 00 0 00 000313 29585 003650'01 254 00 0 00 003224' 29586 000224'03 000000000000# 29587 002114'04 113 105 122 115 111 29588 29589 003651'01 200 01 0 00 000006 move t1, q2 ; Load final requested device 29590 003652'01 104 00 0 00 000070 ASND% ; Assign it, so no possible login 29591 003653'01 320 12 0 00 003655' %jserr (,clscln) 29592 003654'01 254 00 0 00 003660' 29593 003655'01 265 01 0 00 003610* 29594 003656'01 000000000000# 29595 003657'01 254 00 0 00 003224' 29596 002124'04 103 157 165 154 144 29597 003660'01 350 00 0 00 003631* aos asgflg ; Flag we have a terminal assigned 29598 003661'01 202 01 0 00 003632* movem t1, asgdev ; Store global 29599 003662'01 202 01 0 00 000000# movem t1, ttydev ; Store as terminal device designator 29600 003663'01 200 02 0 00 000001 move t2, t1 ; Position for DEVST% 29601 29602 003664'01 350 00 0 00 000000# gttyjf: aos ttyflg ; At this point, commiting to the open 29603 003665'01 561 01 0 00 000000# hrroi t1,ttynam ; Point to area to write TTY specification 29604 003666'01 552 02 0 00 003525* hrrzm t2, ttynum ; Store as foreign terminal 29605 003667'01 104 00 0 00 000121 DEVST% ; Turn device into string 29606 003670'01 320 12 0 00 003672' %jserr (,deadev) 29607 003671'01 254 00 0 00 003675' 29608 003672'01 265 01 0 00 003655* 29609 003673'01 000000000000# 29610 003674'01 254 00 0 00 003620' 29611 002133'04 103 157 165 154 144 29612 003675'01 201 02 0 00 000072 movei t2,":" ; Load terminating device punctuation 29613 003676'01 136 02 0 00 000001 idpb t2,t1 ; Complete device syntax 29614 003677'01 400 02 0 00 000000 setz t2, ; Load .chnul k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 52-1 K20NET MAC 15-Nov-23 19:11 Open a physical line 29615 003700'01 136 02 0 00 000001 idpb t2,t1 ; Tie off the string 29616 29617 003701'01 402 00 0 00 003552* setzm netjfn ; No network JFN, yet 29618 dmove t1, [ gj%sht!gj%flg ; Want flags 29619 003702'01 120 01 0 00 005662' -1,,ttynam ] ; asipty built this for us 29620 003703'01 104 00 0 00 000020 GTJFN% ; Try to open it 29621 003704'01 320 12 0 00 003706' ifje. r ; Catch the error 29622 003705'01 254 00 0 00 003720' 29623 003706'01 200 04 0 00 000001 move t4, t1 ; Record for debugger 29624 003707'01 334 00 0 00 000000 %ermsg (,) ; Bizarre, we just got the device 29625 003710'01 254 00 0 00 003714' 29626 003711'01 265 01 0 00 003672* 29627 003712'01 000000000000# 29628 003713'01 254 00 0 00 003714' 29629 002142'04 103 141 156 047 164 29630 003714'01 200 01 0 00 000006 move t1, q2 ; Load assigned designator 29631 003715'01 260 17 0 00 003620' call deadev ; Go deasign the device 29632 003716'01 263 17 0 00 000000 ret ; Return failure 29633 003717'01 254 00 0 00 003723' else. ; Otherwise, worked 29634 003720'01 552 01 0 00 003701* hrrzm t1, netjfn ; Save as network JFN 29635 003721'01 512 01 0 00 003553* hllzm t1, netflg ; Ditto the flags (just in case) 29636 003722'01 200 11 0 00 000001 move q5, t1 ;[223] Save a copy for recovery 29637 003723'01 endif. ; End case JSYS failure 29638 29639 remark 8-bit bytes, image mode, read & write access. 29640 003723'01 200 02 0 00 005664' movx t2, fld(8,of%bsz)!fld(.gsimg,of%mod)!of%wr!of%rd 29641 003724'01 621 01 0 00 777777 tlz t1,-1 ; Whack flags them so OPENF% doesn't choke 29642 003725'01 104 00 0 00 000021 OPENF% ; Open the device. 29643 003726'01 320 12 0 00 003730' ifje. r ; Catch the error 29644 003727'01 254 00 0 00 003740' 29645 003730'01 200 04 0 00 000001 move t4, t1 ; Record for debugger 29646 003731'01 334 00 0 00 000000 %ermsg (,) ; Bizarre, we just got the device 29647 003732'01 254 00 0 00 003736' 29648 003733'01 265 01 0 00 003711* 29649 003734'01 000000000000# 29650 003735'01 254 00 0 00 003736' 29651 002147'04 103 157 165 154 144 29652 003736'01 200 01 0 00 000003 move t1, t3 ; Load the JFN 29653 003737'01 254 00 0 00 003044' callret clsjfn ; Call JFN and device clean up and scrub 29654 003740'01 endif. ; End case JSYS failure 29655 29656 003740'01 200 01 0 00 000011 move t1, q5 ;[223] Load terminal JFN and flags 29657 003741'01 260 17 0 00 004776' call gndpar ;[223] Go find out about the parity 29658 003742'01 400 02 0 00 000000 setz t2, ;[223] Failed somehow, so no parity 29659 003743'01 606 02 0 00 000001 ifxn. t2, gd%par ;[223] Will it tolerate parity?? 29660 003744'01 254 00 0 00 003747' 29661 003745'01 476 00 0 00 000000# setom opnpar ;[223] It will 29662 003746'01 254 00 0 00 003750' else. ;[223] ...Otherwise... 29663 003747'01 402 00 0 00 000000# setzm opnpar ;[223] It won't 29664 003750'01 endif. ;[223] End case parity discovery 29665 29666 003750'01 550 01 0 00 000011 hrrz t1, q5 ;[223] Load just the JFN 29667 003751'01 550 04 0 00 000005 hrrz t4, q1 ; Load the unit number again 29668 003752'01 312 04 0 00 003627* came t4, mytty ; Is it us? 29669 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 20:02 27-Nov-23 Page 52-2 K20NET MAC 15-Nov-23 19:11 Open a physical line 29670 003754'01 402 00 0 00 003523* setzm local ; Mark us as remote 29671 003755'01 254 00 0 00 003766' else. ; Otherwise, we are going places 29672 003756'01 476 00 0 00 003754* setom local ; We're the local Kermit 29673 003757'01 201 02 0 00 000015 movei t2, .chcrt ; Send a CR down the line to get things going. 29674 003760'01 260 17 0 00 001741' call BOUTR% ; Get it going 29675 003761'01 334 00 0 00 000000 %ermsg (,r) ;[186] 29676 003762'01 254 00 0 00 003766' 29677 003763'01 265 01 0 00 003733* 29678 003764'01 000000000000# 29679 003765'01 254 00 0 00 003612* 29680 002154'04 106 151 162 163 164 29681 003766'01 endif. 29682 29683 remark t1, netjfn ;[223] Still has JFN 29684 003766'01 200 02 0 00 000006 move t2, q2 ; Load TTY device designator 29685 003767'01 201 03 0 00 000012 movei t3, .dvtty ; Opened a terminal 29686 003770'01 202 03 0 00 000000# movem t3, opndev ; Store opened device type 29687 003771'01 402 00 0 00 003616* setzm vtermf ; Clear the virtual terminal flag 29688 003772'01 254 00 0 00 003617* retskp ; Won!! 29689 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 53 K20NET MAC 15-Nov-23 19:11 Check the line whose JFN is in t1. 29690 subttl Check the line whose JFN is in t1. 29691 29692 ; Set flags MDMLIN if line is remote, CARIER if line has carrier up. 29693 ; SPEED is set to a nonnegative number if known, -1 otherwise. 29694 ; 29695 ; Returns +1 always, with t1 unchanged, t2-t4 modified. 29696 29697 003773'01 chklin: entry chklin ;[186] Identify location for LINK 29698 extern mdmlin,speed,carier ;[186] And of everyone's necessaries 29699 29700 003773'01 265 16 0 00 005665' saveac ; Save the JFN!!! 29701 29702 003774'01 402 00 0 00 002357* setzm mdmlin ;[186] Assume line not modem-controlled. 29703 003775'01 402 00 0 00 002362* setzm carier ;[186] And no carrier 29704 003776'01 476 00 0 00 000000* setom speed ;[186] Assume speed is unknown 29705 29706 003777'01 553 04 0 00 000001 hrrzs t4, t1 ;[186] Save the JFN, sans flags 29707 004000'01 306 01 0 00 377777 cain t1, .nulio ;[186] Wants to talk with nobody? 29708 004001'01 263 17 0 00 000000 ret ;[186] That's never online 29709 004002'01 260 17 0 00 004151' call chkljf ;[186] Check basic JFN health 29710 004003'01 263 17 0 00 000000 ret ;[186] It's sick, somehow 29711 29712 004004'01 200 01 0 00 000004 move t1, t4 ;[186] restore jfn's rightful place 29713 004005'01 104 00 0 00 000117 dvchr% ;[186] get the device characteristics 29714 004006'01 320 12 0 00 004010' ifje. r ;[186] failed?? 29715 004007'01 254 00 0 00 004016' 29716 004010'01 200 04 0 00 000001 move t4, t1 ;[186] retrieve and return error code 29717 004011'01 334 00 0 00 000000 %ermsg(,r) 29718 004012'01 254 00 0 00 004016' 29719 004013'01 265 01 0 00 003763* 29720 004014'01 000000000000# 29721 004015'01 254 00 0 00 003765* 29722 002162'04 165 156 141 142 154 29723 004016'01 endif. ;[186] get out of here, nothing further to do 29724 29725 004016'01 250 01 0 00 000004 exch t1, t4 ;[186] Get the JFN back, save device 29726 004017'01 135 03 0 00 005426' ldb t3,[pointr t2,dv%typ] ;[186] Pick up a device type 29727 29728 004020'01 306 03 0 00 000022 cain t3, .dvdcn ;[186] Is this an NRT? 29729 004021'01 254 00 0 00 004126' jrst chkdcn ;[186] Then can't "Read Speed" 29730 004022'01 306 03 0 00 000013 cain t3, .dvpty ;[186] pseudo-terminal? 29731 004023'01 254 00 0 00 004140' jrst chkpty ;[186] Can't check terminal through the PTY 29732 004024'01 306 03 0 00 000012 cain t3, .dvtty ;[186] A terminal?? 29733 004025'01 254 00 0 00 004033' jrst chktty ;[186] Yes, go handle a physical line 29734 remark t3, .dvpip ;[186] A pipe? (a place holder) 29735 remark chkpip ;[186] Yes, go handle that 29736 ;[186] Otherwise, failure 29737 004026'01 334 01 0 00 000000# ermsg% (,r) 29738 004027'01 254 00 0 00 004033' 29739 004030'01 202 01 0 00 003646* 29740 004031'01 104 00 0 00 000313 29741 004032'01 254 00 0 00 004015* 29742 000225'03 000000000000# 29743 002173'04 113 105 122 115 111 29744 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 53-1 K20NET MAC 15-Nov-23 19:11 Check the line whose JFN is in t1. 29745 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 54 K20NET MAC 15-Nov-23 19:11 Case of physical line (on a DH or DL) or controlling line 29746 subttl Case of physical line (on a DH or DL) or controlling line 29747 29748 004033'01 chktty: extern setspd, monv ;[186] Physical line additional necessaries 29749 004033'01 250 04 0 00 000001 exch t4, t1 ;[208] Save the JFN, restore device 29750 remark t1, JFN ;[186] Still has terminal JFN 29751 004034'01 260 17 0 00 004176' call ntidev ;[208] Find out about it 29752 004035'01 254 00 0 00 004041' ifskp. ;[208] Worked 29753 004036'01 265 16 0 00 005364' saveac ;[208] Save for getnti results 29754 004037'01 120 05 0 00 000001 dmove q1, t1 ;[208] So save the results 29755 004040'01 254 00 0 00 004046' else. ;[208] Otherwise gronked. Sad... 29756 004041'01 334 00 0 00 000000 %ermsg (,r) 29757 004042'01 254 00 0 00 004046' 29758 004043'01 265 01 0 00 004013* 29759 004044'01 000000000000# 29760 004045'01 254 00 0 00 004032* 29761 002211'04 125 156 141 142 154 29762 004046'01 endif. ;[208] 29763 29764 004046'01 415 16 0 00 004056' block. ;[208] Enter block context for better control flow 29765 004047'01 261 17 0 00 000016 29766 004050'01 302 05 0 00 000000 caie q1, nw%nnt ;[208] Not a network terminal? 29767 004051'01 263 17 0 00 000000 ret ;[208] It is a network tty, so this makes no sense 29768 004052'01 302 06 0 00 000001 caie q2, nw%fe ;[208] DL or DH? (front end terminal) 29769 004053'01 263 17 0 00 000000 ret ;[208] No, so these won't make sense 29770 004054'01 254 00 0 00 003772* retskp ;[208] Exit block, +2; physical line 29771 004055'01 263 17 0 00 000000 endbk. ;[208] End block. lexical context 29772 004056'01 254 00 0 00 004061' ifskp. ;[208] Real hardware!! 29773 004057'01 200 01 0 00 000004 move t1, t4 ;[208] Restore the original JFN 29774 004060'01 254 00 0 00 004062' else. ;[208] Otherwise, a 'soft' terminal 29775 remark carier ;[208] Go with chkljf's GTSTS% result 29776 004061'01 263 17 0 00 000000 ret ;[208] and done 29777 004062'01 endif. 29778 29779 004062'01 201 02 0 00 000027 movei t2, .morsp ; "Read Speed" 29780 004063'01 104 00 0 00 000077 MTOPR ; Flag bits are returned in LH(T2) 29781 004064'01 320 12 0 00 004066' ifje. r ;[186] Unless it FAILS 29782 004065'01 254 00 0 00 004074' 29783 004066'01 200 04 0 00 000001 move t4, t1 ;[186] Save the error, could be useful 29784 004067'01 334 00 0 00 000000 %ermsg(,r) 29785 004070'01 254 00 0 00 004074' 29786 004071'01 265 01 0 00 004043* 29787 004072'01 000000000000# 29788 004073'01 254 00 0 00 004045* 29789 002222'04 125 156 141 142 154 29790 004074'01 endif. ;[186] Don't try to process junk--leave 29791 29792 004074'01 573 00 0 00 000003 hrres t3 ; No split speed. 29793 004075'01 321 02 0 00 004102' ifxe. t2, mo%rmt ;[194] Is carrier valid? 29794 004076'01 202 03 0 00 003776* movem t3, speed ; No, it's local, so speed is valid. 29795 004077'01 476 00 0 00 003775* setom carier ; Say local always has carrier 29796 004100'01 263 17 0 00 000000 ret ; Don't have to worry about carrier. 29797 004101'01 254 00 0 00 004103' else. ;[194] Otherwise line is a real dial up 29798 004102'01 476 00 0 00 003774* setom mdmlin ; Yes, flag for SHOW LINE, etc. 29799 004103'01 endif. ;[194] 29800 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 54-1 K20NET MAC 15-Nov-23 19:11 Case of physical line (on a DH or DL) or controlling line 29801 004103'01 332 00 0 00 000000* ifme. setspd ;[161] Was speed NOT explicitly SET for this line? 29802 004104'01 254 00 0 00 004114' 29803 004105'01 336 00 0 00 000000* ifmn. monv ;[194] TOPS-20 V6 or later? 29804 004106'01 254 00 0 00 004111' 29805 004107'01 202 03 0 00 004076* movem t3, speed ; Yes, so we can believe the speed. 29806 004110'01 254 00 0 00 004114' else. ;[194] Otherwise, some kind of geeser (or KS) 29807 004111'01 312 03 0 00 004107* came t3, speed ; Pre-V6. Does this agree with what was set? 29808 004112'01 474 03 0 00 000000 seto t3, ; No, so we don't really know the speed. 29809 004113'01 202 03 0 00 004111* movem t3, speed ; Save the speed or else -1 for don't know. 29810 004114'01 endif. ;[194] 29811 004114'01 endif. ;[194] 29812 29813 004114'01 403 02 0 00 004077* setzb t2, carier ; See if we have carrier. 29814 004115'01 104 00 0 00 000107 RFMOD ; Get mode word. 29815 004116'01 320 12 0 00 004120' %jserr(,r) ;[186] 29816 004117'01 254 00 0 00 004123' 29817 004120'01 265 01 0 00 004071* 29818 004121'01 000000000000# 29819 004122'01 254 00 0 00 004073* 29820 002230'04 125 156 141 142 154 29821 004123'01 602 02 0 00 000001 txne t2, tt%car ; Carrier? 29822 004124'01 476 00 0 00 004114* setom carier ; Yes. 29823 004125'01 263 17 0 00 000000 ret 29824 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 55 K20NET MAC 15-Nov-23 19:11 DECnet Network Remote Terminal Checking 29825 subttl DECnet Network Remote Terminal Checking 29826 29827 004126'01 chkdcn: remark t1, ; Has NRT JFN 29828 004126'01 201 02 0 00 000025 movx t2,.morls ; Function to read link status 29829 004127'01 104 00 0 00 000077 MTOPR% ; Do the status read 29830 004130'01 320 12 0 00 000544' erjmpr decerr ; Handle error, getting it in t1 29831 004131'01 325 03 0 00 004134' ifxn. t3,mo%con ; Connected? 29832 004132'01 476 00 0 00 004124* setom carier ; Yes, everything is still fine 29833 004133'01 254 00 0 00 004135' else. ; Otherwise, the party is OVER 29834 004134'01 402 00 0 00 004132* setzm carier ; So drop 'carrier' 29835 004135'01 endif. ; End case connection check 29836 004135'01 603 03 0 00 002000 txne t3,mo%int ; Any interrupt message goofyness? 29837 004136'01 260 17 0 00 001006' call intmsg ; Yes, handle this oddity 29838 004137'01 263 17 0 00 000000 ret ; Finally get out of here 29839 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 56 K20NET MAC 15-Nov-23 19:11 Pseudo-terminal status, a bit different 29840 subttl Pseudo-terminal status, a bit different 29841 29842 004140'01 chkpty: remark ; Case of PTY: device 29843 29844 repeat 0,< ; Apparently, this isn't true 29845 ifxe. q1, gs%eof ; On a PTY:, EOF is an error condition 29846 setzm carier ; So 'drop' carrier 29847 ret ; and get out of here 29848 else. ; Otherwise, might still be good 29849 setom carier ; So assume OK, for the moment 29850 endif. ; End case GTSTS% analysis for PTY 29851 > 29852 004140'01 336 01 0 00 000000# skipn t1, ttygtb ; Load GETAB% table length and number 29853 004141'01 263 17 0 00 000000 ret ; Unless there is none... 29854 004142'01 504 01 0 00 000000# hrl t1, ptytty ; Load PTY's associated terminal line 29855 004143'01 621 01 0 00 400000 tlz t1, .ttdes ; Just in case (shouldn't be on) 29856 004144'01 104 00 0 00 000010 GETAB% ; Get associated job and 'hunger' 29857 004145'01 320 12 0 00 004122* erjmpr r ; Get and ignore error, returning 29858 004146'01 325 01 0 00 004145* jumpge t1, r ; Still connected? Just return 29859 29860 004147'01 402 00 0 00 004134* setzm carier ; No job there anymore, so 'drop' carrier 29861 004150'01 263 17 0 00 000000 ret ; And get out of here 29862 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 57 K20NET MAC 15-Nov-23 19:11 Check Line JFN 29863 subttl Check Line JFN 29864 29865 ; Call t1/ JFN 29866 ; 29867 ; +1 / JFN is unhealthy in some way 29868 ; +2 / JFN works and is not in error, q1 has GTSTS result 29869 ; 29870 ; Sets 'carier' accordingly 29871 29872 004151'01 265 16 0 00 005675' chkljf: saveac ; Basic JFN health 29873 29874 004152'01 104 00 0 00 000024 GTSTS% ; Get the status of whatever it is 29875 004153'01 320 12 0 00 004155' ifje. r ; Failed?? 29876 004154'01 254 00 0 00 004165' 29877 004155'01 200 04 0 00 000001 move t4, t1 ; Save code for debuggers 29878 004156'01 403 02 0 00 000005 setzb t2, q1 ; Assume we have no carrier. 29879 004157'01 334 00 0 00 000000 %ermsg(,r) 29880 004160'01 254 00 0 00 004164' 29881 004161'01 265 01 0 00 004120* 29882 004162'01 000000000000# 29883 004163'01 254 00 0 00 004146* 29884 002236'04 125 156 141 142 154 29885 004164'01 254 00 0 00 004166' else. ; Otherwise, worked 29886 004165'01 200 05 0 00 000002 move q1, t2 ; So save the JFN's status 29887 004166'01 endif. 29888 29889 004166'01 641 02 0 00 400200 txc t2, gs%nam!gs%opn ; Complement the required bits 29890 004167'01 643 02 0 00 400200 txce t2, gs%nam!gs%opn ; Is it any good at and is it open? 29891 004170'01 263 17 0 00 000000 ret ; No, then there is certainly no carrier 29892 004171'01 603 02 0 00 000400 txne t2,gs%err ; Any kind of error? 29893 004172'01 263 17 0 00 000000 ret ; Yes, we're done 29894 004173'01 476 00 0 00 004147* setom carier ; Groovy, let's say we have 'carrier' 29895 004174'01 254 00 0 00 004054* retskp ; Finally get out of here 29896 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 58 K20NET MAC 15-Nov-23 19:11 Get Network Terminal Information 29897 subttl Get Network Terminal Information 29898 29899 ; NTINF%, which was introduced in 6.0 series Tops-20 and is now known 29900 ; to work in 7.0 series PANDA monitor and XKL. I believe there are 29901 ; also standard patches to the DEC monitor to make it work. 29902 ; 29903 ; Wants a terminal designator in t1 29904 ; 29905 ; Question: does this break for a PIP: JFN? Should it? 29906 ; 29907 ; +1 t1/ Last error code 29908 ; +2 t1/ Line Network Type (zero if not network) 29909 ; t2/ Line Terminal type or protocol 29910 29911 004175'01 getnti: entry getnti ;[194] Inform LINK of our location 29912 004175'01 660 01 0 00 400000 txo t1, .ttdes ;[186] Convert line to a device designator 29913 004176'01 ntidev: remark ;[208] Alternate entry if called with a device id 29914 004176'01 202 01 0 00 000000# movem t1 ,ntiblk+.NWLIN ;[182] Store requested terminal 29915 004177'01 120 01 0 00 005703' dmove t1,[exp ntblen,.NWRRH] ;[182] Requesting remote host information 29916 004200'01 124 01 0 00 000000# dmovem t1,ntiblk+.NWABC ;[182] Store length and request type 29917 004201'01 561 01 0 00 000000# hrroi t1, ntihst ;[186] Point to host area 29918 004202'01 202 01 0 00 000000# movem t1, ntiblk+.NWNNP ;[182] return remote host information 29919 29920 004203'01 403 01 0 00 000002 setzb t1, t2 ;[182] Everything else is zero 29921 004204'01 202 01 0 00 000000* movem t1, tvtflg ;[182] Assume not on a TVT 29922 004205'01 124 01 0 00 000000# dmovem t1, ntihst ;[186] Stomp 20 character DECnet node 29923 004206'01 124 01 0 00 000000# dmovem t1, ntihst+2 ;[186] name (which is impossible) 29924 004207'01 124 01 0 00 000000# dmovem t1,ntiblk+.NWTTF ;[186] Stomp terminal type and flags 29925 004210'01 402 00 0 00 000000# setzm ntiblk+.nwnu1 ;[186] and the node number 29926 29927 004211'01 201 01 0 00 000000# movei t1, ntiblk ;[182] Load the address of the argument block 29928 004212'01 104 00 0 00 000632 NTINF% ;[182] finally try to see out what's going on 29929 004213'01 320 12 0 00 004215' %jserr (,r) ;[186] Phooey, return +1 29930 004214'01 254 00 0 00 004220' 29931 004215'01 265 01 0 00 004161* 29932 004216'01 000000000000# 29933 004217'01 254 00 0 00 004163* 29934 002246'04 116 124 111 116 106 29935 ;[182] Load network type and line type 29936 004220'01 135 01 0 00 005705' ldb t1,[POINTR(,nttype)] 29937 004221'01 135 02 0 00 005706' ldb t2,[POINTR(,ntline)] 29938 004222'01 254 00 0 00 004174* retskp ;[186] Won! 29939 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 59 K20NET MAC 15-Nov-23 19:11 chktvt - check to see if we are using a TVT line 29940 subttl chktvt - check to see if we are using a TVT line 29941 29942 ; We use NTINF% (see above) when the user sets TVT-Binary mode to 29943 ; automatic which is an additional keyword (used to be just on or 29944 ; off). Automatic is the default, but we still allow overide. 29945 ; 29946 ; If the NTINF% fails, then we try recover by using STAT% to 29947 ; indentify whether the line is in the range of TVT's. This should 29948 ; work on any ARPAnet monitor with TCP support; MRC noted that the 29949 ; monitor "requires STAT% to be there" 29950 ; 29951 ; PANDA monitor verified to have 400000,,RSKP in NVTDOD (see [129]) 29952 ; 29953 ; Call: nothing passed 29954 ; 29955 ; Checks to see whether we are in automatic mode and if so, we 29956 ; execute the determination code in some form. Otherwise, we 29957 ; are in override mode and we skip any checks. 29958 ; 29959 ; Return: +1, always (although may complain about Jsyi errors) 29960 ; 29961 ; tvtflg may be side-effected by our (possible lack of) discovery 29962 29963 004223'01 chktvt: entry chktvt ;[194] Inform LINK of our location 29964 extern tvtchk, tvtflg ;[194] And of our necessaries 29965 004223'01 336 00 0 00 000000* skipn tvtchk ;[182] Are we supposed to figure out if TVT? 29966 004224'01 263 17 0 00 000000 ret ;[182] No, so skip all this cruft 29967 29968 004225'01 402 00 0 00 004204* setzm tvtflg ;[194] Stompt TVT flag because not known, yet 29969 004226'01 260 17 0 00 004175' call getnti ;[186] Get network terminal information 29970 004227'01 254 00 0 00 004235' jrst bbntvt ;[186] Try it the old fashioned way 29971 004230'01 306 01 0 00 000001 cain t1, NW%TCP ;[182] Is the network type NOT TCP? 29972 004231'01 302 02 0 00 000004 caie t2, NW%TV ;[182] or is this NOT a TVT? 29973 004232'01 263 17 0 00 000000 ret ;[182] Leave line set as not a TVT 29974 004233'01 350 00 0 00 004225* aos tvtflg ;[182] Okay, set TVT-BInary to ON 29975 004234'01 263 17 0 00 000000 ret ;[182] 29976 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 60 K20NET MAC 15-Nov-23 19:11 Check for TVT line using BBN interface 29977 subttl Check for TVT line using BBN interface 29978 29979 ; The following code is not used because a BBN TCP jsys is called. 29980 ; It is fall-back because NTINF% is preferred. However, it should 29981 ; always work, no matter the monitor version. 29982 ; 29983 ; [129] Largely adapted from MODEM.MAC 29984 29985 004235'01 bbntvt: extern ttynum ;[194] Inform LINK of our necessary 29986 004235'01 205 01 0 00 000040 movx t1, tcp%nt ;[129] Want aobjn ptr for tvts 29987 004236'01 104 00 0 00 000745 STAT% ;[129] Get it 29988 004237'01 320 12 0 00 004241' %jserr (,r) ;[182] Just give up 29989 004240'01 254 00 0 00 004244' 29990 004241'01 265 01 0 00 004215* 29991 004242'01 000000000000# 29992 004243'01 254 00 0 00 004217* 29993 002251'04 123 124 101 124 040 29994 004244'01 550 03 0 00 003666* hrrz t3, ttynum ;[129] TTY line we're useing 29995 004245'01 550 01 0 00 000002 hrrz t1, t2 ;[129] Get first TVT 29996 004246'01 315 03 0 00 000001 camge t3, t1 ;[129] Are we less than the firsT? 29997 004247'01 263 17 0 00 000000 ret ;[182] Yes 29998 004250'01 577 00 0 00 000002 hlres t2 ;[129] Calculate last TVT 29999 004251'01 274 01 0 00 000002 sub t1, t2 ;[129] ... 30000 004252'01 275 01 0 00 000001 subi t1, 1 ;[129] ... 30001 004253'01 317 03 0 00 000001 camg t3, t1 ;[129] Are we .le. last TVT? 30002 004254'01 350 00 0 00 004233* aos tvtflg ;[182] Yes, flag for later 30003 004255'01 263 17 0 00 000000 ret ;[182] 30004 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 61 K20NET MAC 15-Nov-23 19:11 Line routines 30005 subttl Line routines 30006 30007 ;[190] all moved from K20MIT to reduce its size 30008 30009 ; INILIN -- Initialize the communication line for file transfer. 30010 ; 30011 004256'01 inilin: entry inilin ;[220] Used in k20srv, too 30012 004256'01 332 00 0 00 000000# skipe inited ;[177] Already init'd? Don't do it again. 30013 004257'01 263 17 0 00 000000 ret ;[177] 30014 30015 ; Set all the terminal mode bits for transparent i/o. 30016 30017 004260'01 332 00 0 00 003771* inil2: ifme. vtermf ;[186] Physical line? 30018 004261'01 254 00 0 00 004265' 30019 004262'01 260 17 0 00 004271' call dobits ; Go do the bits. 30020 004263'01 263 17 0 00 000000 ret ; Pass along any failures. 30021 004264'01 260 17 0 00 004525' call doarpa ; Set up any Arpanet stuff. 30022 004265'01 endif. 30023 30024 004265'01 260 17 0 00 002423' call clrbuf ;[194] Clear any NAK's 30025 004266'01 600 00 0 00 000000 nop ;[186] Ignore any errors 30026 004267'01 476 00 0 00 000000# setom inited ;[177] Flag we've done this. 30027 004270'01 263 17 0 00 000000 ret k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 62 K20NET MAC 15-Nov-23 19:11 Line routines 30028 30029 ; Set communication line bits for transparent i/o. 30030 ; Returns +1 on failure, +2 on success. 30031 30032 004271'01 dobits: entry dobits ;Used by k20ioc 30033 004271'01 265 16 0 00 005331' saveac ;[186] Used for device designator 30034 004272'01 332 05 0 00 003720* skipe q1, netjfn ;[186] Load the network JFN 30035 004273'01 254 00 0 00 004310' ifskp. ;[186] Unless we don't have one... 30036 004274'01 332 00 0 00 003756* skipe local ;[186] Are we remote? 30037 004275'01 334 01 0 00 000000# ermsg% (,r) ;[186] Just punt 30038 004276'01 254 00 0 00 004302' 30039 004277'01 202 01 0 00 004030* 30040 004300'01 104 00 0 00 000313 30041 004301'01 254 00 0 00 004243* 30042 000226'03 000000000000# 30043 002254'04 113 105 122 115 111 30044 30045 004302'01 336 05 0 00 002777* skipn q1, ttyjfn ;[186] Yes, so just use the terminal JFN 30046 004303'01 334 01 0 00 000000# ermsg% (,r) ;[186] 30047 004304'01 254 00 0 00 004310' 30048 004305'01 202 01 0 00 004277* 30049 004306'01 104 00 0 00 000313 30050 004307'01 254 00 0 00 004301* 30051 000227'03 000000000000# 30052 002270'04 113 105 122 115 111 30053 30054 004310'01 endif. ;[186] Hopefully have SOMETHING ... 30055 30056 004310'01 200 01 0 00 000005 move t1, q1 ;[186] ; JFN for connection to other system. 30057 004311'01 201 02 0 00 000035 movx t2, .mornt ; Read system message status. 30058 004312'01 104 00 0 00 000077 MTOPR 30059 004313'01 320 12 0 00 004315' %jserr (,dobit2) 30060 004314'01 254 00 0 00 004320' 30061 004315'01 265 01 0 00 004241* 30062 004316'01 000000 000000 30063 004317'01 254 00 0 00 004331' 30064 004320'01 202 03 0 00 000000# movem t3, sysmsg ; Save here for later restoral. 30065 004321'01 201 02 0 00 000034 movx t2, .mosnt ; Now refuse system messages. 30066 004322'01 201 03 0 00 000001 movx t3, .mosmn 30067 004323'01 104 00 0 00 000077 MTOPR 30068 004324'01 320 12 0 00 004326' %jserr (,dobit2) 30069 004325'01 254 00 0 00 004331' 30070 004326'01 265 01 0 00 004315* 30071 004327'01 000000 000000 30072 004330'01 254 00 0 00 004331' 30073 30074 004331'01 205 01 0 00 624000 dobit2: movx t1, ;[147] Clear/Refuse links, 30075 004332'01 540 01 0 00 004244* hrr t1, ttynum ;[147] on the line used for file transfer. 30076 004333'01 660 01 0 00 400000 txo t1, .ttdes ;[147] (TLINK wants a device designator.) 30077 004334'01 474 02 0 00 000000 seto t2, 30078 004335'01 104 00 0 00 000216 TLINK 30079 004336'01 320 16 0 00 004337' erjmp dobit3 ;[147] Ignore any failure. 30080 30081 004337'01 200 01 0 00 000005 dobit3: move t1, q1 ;[186] ; JFN for the file transfer line. 30082 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 20:02 27-Nov-23 Page 62-1 K20NET MAC 15-Nov-23 19:11 Line routines 30083 004341'01 104 00 0 00 000077 MTOPR% 30084 004342'01 320 12 0 00 004344' %jserr (,r) 30085 004343'01 254 00 0 00 004347' 30086 004344'01 265 01 0 00 004326* 30087 004345'01 000000 000000 30088 004346'01 254 00 0 00 004307* 30089 004347'01 202 03 0 00 000000# movem t3, oldpau ; Save the old pause mode. 30090 004350'01 201 02 0 00 000043 movei t2, .moxof ; Now set to... 30091 004351'01 201 03 0 00 000000 movei t3, .mooff ; no pause on end. 30092 004352'01 104 00 0 00 000077 MTOPR% 30093 004353'01 320 12 0 00 004355' %jserr (,r) 30094 004354'01 254 00 0 00 004360' 30095 004355'01 265 01 0 00 004344* 30096 004356'01 000000 000000 30097 004357'01 254 00 0 00 004346* 30098 004360'01 201 02 0 00 000000# movei t2, olddim ;[185] Point to line block 30099 004361'01 260 17 0 00 000000* call savlnw ;[185] Save this JFN's length and width 30100 004362'01 104 00 0 00 000107 RFMOD% ; Get current mode for this line. 30101 004363'01 320 12 0 00 004365' %jserr (,r) 30102 004364'01 254 00 0 00 004370' 30103 004365'01 265 01 0 00 004355* 30104 004366'01 000000 000000 30105 004367'01 254 00 0 00 004357* 30106 004370'01 476 00 0 00 004173* setom carier 30107 004371'01 402 00 0 00 004102* setzm mdmlin ;[130] Assume line not modem-controlled. 30108 004372'01 602 02 0 00 000001 txne t2, tt%car ;[130] Is it? 30109 004373'01 476 00 0 00 004371* setom mdmlin ;[130] Yes, flag. 30110 004374'01 202 02 0 00 000000# movem t2, oldmod ; Save the present mode. 30111 30112 ;[97] Turn off undesired bits (program echoing, links, translation). 30113 ;[97] Turn on desired bits (full duplex; TTY has form feed, tab, lowercase). 30114 ;[97] Note that any other settings are left intact, in particular TT%ECM, which 30115 ;[97] can cause a TAC to do its own echoing if turned off. 30116 30117 004375'01 dobit4: ; No echo, no links, no advice, no data mode, full duplex. 30118 004375'01 620 02 0 00 005734 txz t2, ;[129] Add TT$DUM 30119 ; No wakeup stuff, infinite width & length. 30120 004376'01 630 02 0 00 005707' txz t2, ;[127] 30121 ; No formfeed/tab/case interpretation, use XON/XOFF. 30122 004377'01 670 02 0 00 005710' txo t2, ;[129] REMOVE TT%DUM!!! 30123 30124 004400'01 336 00 0 00 000000* skipn handsh ;[155] Doing handshake? 30125 004401'01 336 00 0 00 003532* skipn flow ;[155] Doing flow control? 30126 004402'01 620 02 0 00 000002 txz t2, tt%pgm ; Handshake, or no flow - don't do XON/XOFF. 30127 004403'01 104 00 0 00 000110 SFMOD% ; Set the bits. 30128 004404'01 320 12 0 00 004406' %jserr (,) 30129 004405'01 254 00 0 00 004411' 30130 004406'01 265 01 0 00 004365* 30131 004407'01 000000 000000 30132 004410'01 254 00 0 00 004411' 30133 004411'01 104 00 0 00 000217 STPAR% 30134 004412'01 320 12 0 00 004414' %jserr (,) 30135 004413'01 254 00 0 00 004417' 30136 004414'01 265 01 0 00 004406* 30137 004415'01 000000 000000 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 62-2 K20NET MAC 15-Nov-23 19:11 Line routines 30138 004416'01 254 00 0 00 004417' 30139 004417'01 254 00 0 00 004222* retskp k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 63 K20NET MAC 15-Nov-23 19:11 Line routines 30140 30141 ;[181] PANDA Network Binary Mode routines 30142 30143 panda < ;[181] Only if doing Panda 30144 30145 ;[181] Returns true if we have network binary mode MTOPR% 30146 ;[181] Preserves ACs, always returns +1, havnbm: is side-effected 30147 30148 004420'01 chknbm: entry chknbm ;[190] 30149 004420'01 265 16 0 00 005711' saveac ;[181] Save the registers that MTOPR% trashes 30150 004421'01 120 01 0 00 005723' dmove t1,[ exp .CTTRM,.MORLT ] ;[181] Read local status 30151 004422'01 104 00 0 00 000077 MTOPR% ;[181] Can the monitor process this request? 30152 004423'01 320 12 0 00 004425' ifje. r ;[194] No, assume this isn't in the monitor 30153 004424'01 254 00 0 00 004430' 30154 004425'01 402 00 0 00 000000# setzm havnbm ;[181] so don't try to use it 30155 004426'01 402 00 0 00 000000# setzm setlts ;[181] and never try to restore status 30156 004427'01 254 00 0 00 004431' else. ;[194] 30157 004430'01 476 00 0 00 000000# setom havnbm ;[181] Otherwise, we have winning 30158 004431'01 endif. ;[194] 30159 004431'01 263 17 0 00 000000 ret ;[181] Panda Network Binary Mode! 30160 30161 ;[181] Sets network binary mode 30162 ;[181] Assumes it can stomp acumulators t1 through t3 30163 ;[181] Returns to doarpa's caller on success 30164 ;[181] on failure, assumes we don't have network binary mode, 30165 ;[181] clears the flag and tries it the old way 30166 30167 004432'01 332 00 0 00 000000# setnbm: skipe setlts ;[181] Did we already sucessfully set this? 30168 004433'01 263 17 0 00 000000 ret ;[181] Yes, why bother doing it twice? 30169 30170 004434'01 332 01 0 00 004272* skipe t1, netjfn ;[186] Load the network JFN 30171 004435'01 254 00 0 00 004452' ifskp. ;[186] Unless we don't have one... 30172 004436'01 332 00 0 00 004274* skipe local ;[186] Are we remote? 30173 004437'01 334 01 0 00 000000# ermsg% (,r) ;[186] Just punt 30174 004440'01 254 00 0 00 004444' 30175 004441'01 202 01 0 00 004305* 30176 004442'01 104 00 0 00 000313 30177 004443'01 254 00 0 00 004367* 30178 000230'03 000000000000# 30179 002305'04 113 105 122 115 111 30180 30181 004444'01 336 01 0 00 004302* skipn t1, ttyjfn ;[186] Yes, so just use the terminal JFN 30182 004445'01 334 01 0 00 000000# ermsg% (,r) ;[186] 30183 004446'01 254 00 0 00 004452' 30184 004447'01 202 01 0 00 004441* 30185 004450'01 104 00 0 00 000313 30186 004451'01 254 00 0 00 004443* 30187 000231'03 000000000000# 30188 002321'04 113 105 122 115 111 30189 30190 004452'01 endif. ;[186] Hopefully have SOMETHING ... 30191 30192 004452'01 201 02 0 00 400001 movx t2,.MORLT ;[181] Read local status 30193 004453'01 104 00 0 00 000077 MTOPR% 30194 004454'01 320 16 0 00 004472' erjmp nbmerr k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 63-1 K20NET MAC 15-Nov-23 19:11 Line routines 30195 004455'01 202 03 0 00 000000# movem t3,OLDLTS ;[181] save old terminal status 30196 004456'01 660 03 0 00 000006 txo t3,MO%NBI!MO%NBO ;[181] network binary mode (input AND output) 30197 004457'01 201 02 0 00 400002 movx t2,.MOSLT ;[181] want to set it 30198 004460'01 104 00 0 00 000077 MTOPR% 30199 004461'01 320 16 0 00 004472' erjmp nbmerr 30200 004462'01 201 02 0 00 400001 movx t2,.MORLT ;[181] now see what actually happened 30201 004463'01 104 00 0 00 000077 MTOPR% 30202 004464'01 320 16 0 00 004472' erjmp nbmerr 30203 004465'01 640 03 0 00 000006 xorx t3,MO%NBI!MO%NBO ;[181] flip binary mode status 30204 004466'01 602 03 0 00 000006 txne t3,MO%NBI!MO%NBO ;[181] they should have been BOTH set ... 30205 004467'01 254 00 0 00 004472' jrst nbmerr 30206 004470'01 350 00 0 00 000000# aos setlts ;[181] flag that we set terminal line status 30207 004471'01 263 17 0 00 000000 ret 30208 30209 004472'01 402 00 0 00 000000# nbmerr: setzm havnbm ;[181] We don't have network binary mode 30210 004473'01 254 00 0 00 004525' callret doarpa ;[181] Maybe the olde fashioned way works? 30211 30212 30213 ;[181] un-Sets network binary mode 30214 ;[181] Assumes it can stomp acumulators t1 through t3 30215 ;[181] Returns to unarpa's caller on success 30216 ;[181] on failure, assumes we don't have network binary mode, 30217 ;[181] clears the flag and tries it the old way 30218 30219 004474'01 400 01 0 00 000000 unsnbm: setz t1, ;[181] whatever the current state is, 30220 004475'01 250 01 0 00 000000# exch t1,setlts ;[181] say that it is no longer set 30221 004476'01 322 01 0 00 004451* jumpe t1,r ;[181] However: did we ever set nbm?? 30222 30223 004477'01 332 01 0 00 004434* skipe t1, netjfn ;[186] Load the network JFN 30224 004500'01 254 00 0 00 004515' ifskp. ;[186] Unless we don't have one... 30225 004501'01 332 00 0 00 004436* skipe local ;[186] Are we remote? 30226 004502'01 334 01 0 00 000000# ermsg% (,r) ;[186] Just punt 30227 004503'01 254 00 0 00 004507' 30228 004504'01 202 01 0 00 004447* 30229 004505'01 104 00 0 00 000313 30230 004506'01 254 00 0 00 004476* 30231 000232'03 000000000000# 30232 002336'04 113 105 122 115 111 30233 30234 004507'01 336 01 0 00 004444* skipn t1, ttyjfn ;[186] Yes, so just use the terminal JFN 30235 004510'01 334 01 0 00 000000# ermsg% (,r) ;[186] 30236 004511'01 254 00 0 00 004515' 30237 004512'01 202 01 0 00 004504* 30238 004513'01 104 00 0 00 000313 30239 004514'01 254 00 0 00 004506* 30240 000233'03 000000000000# 30241 002352'04 113 105 122 115 111 30242 30243 004515'01 endif. ;[186] Hopefully have SOMETHING ... 30244 30245 004515'01 201 02 0 00 400002 movx t2,.MOSLT ;[181] Read local status 30246 004516'01 200 03 0 00 000000# move t3,OLDLTS ;[181] get former status 30247 004517'01 104 00 0 00 000077 MTOPR% ;[181] try to restore it 30248 004520'01 320 12 0 00 004522' ifje. r ;[194] Failed, don't use this any longer 30249 004521'01 254 00 0 00 004524' k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 63-2 K20NET MAC 15-Nov-23 19:11 Line routines 30250 004522'01 402 00 0 00 000000# setzm havnbm ;[181] How could this have failed? 30251 004523'01 254 00 0 00 004722' callret unarpa ;[196] Get out of here and turn some more 30252 004524'01 endif. ;[196] things off 30253 004524'01 263 17 0 00 000000 ret 30254 30255 > ;[181] End Panda conditional 30256 ;[129] Do any required ARPAnet stuff. 30257 ; 30258 ; Important Note: The ability to send binary mode telnet negotiations 30259 ; depends on the monitor NOT doubling IACs on TVT lines. Some versions of 30260 ; TOPS-20 (particularly BBN's TCP monitor) will do this. 30261 ; 30262 ;[181] Use SOUTR% instead of SOUT% to ensure that 30263 ;[181] we flush the data to the TAC 30264 ; 30265 ; Returns +1 always, but prints warning on failure. 30266 ; 30267 004525'01 doarpa: entry doarpa ;[190] 30268 004525'01 336 00 0 00 004254* skipn tvtflg ; Are we on tvt? 30269 004526'01 263 17 0 00 000000 ret 30270 30271 004527'01 332 00 0 00 000000# panda < skipe havnbm ;[181] Does the monitor support network 30272 004530'01 254 00 0 00 004432' callret setnbm > ;[181] binary mode? 30273 30274 004531'01 265 16 0 00 005331' saveac ;[186] Used for device designator 30275 004532'01 332 05 0 00 004477* skipe q1, netjfn ;[186] Load the network JFN 30276 004533'01 254 00 0 00 004550' ifskp. ;[186] Unless we don't have one... 30277 004534'01 332 00 0 00 004501* skipe local ;[186] Are we remote? 30278 004535'01 334 01 0 00 000000# ermsg% (,r) ;[186] Just punt 30279 004536'01 254 00 0 00 004542' 30280 004537'01 202 01 0 00 004512* 30281 004540'01 104 00 0 00 000313 30282 004541'01 254 00 0 00 004514* 30283 000234'03 000000000000# 30284 002367'04 113 105 122 115 111 30285 30286 004542'01 336 05 0 00 004507* skipn q1, ttyjfn ;[186] Yes, so just use the terminal JFN 30287 004543'01 334 01 0 00 000000# ermsg% (,r) ;[186] 30288 004544'01 254 00 0 00 004550' 30289 004545'01 202 01 0 00 004537* 30290 004546'01 104 00 0 00 000313 30291 004547'01 254 00 0 00 004541* 30292 000235'03 000000000000# 30293 002403'04 113 105 122 115 111 30294 30295 004550'01 endif. ;[186] Hopefully have SOMETHING ... 30296 30297 004550'01 200 01 0 00 000005 move t1, q1 ;[186] ; Yes, talk binary. 30298 004551'01 120 02 0 00 005726' dmove t2,[exp ,-3] 30299 004552'01 104 00 0 00 000532 SOUTR% ;[181] This code adapted from MODEM.MAC 30300 004553'01 320 12 0 00 004555' %jserr(,doarpx) 30301 004554'01 254 00 0 00 004560' 30302 004555'01 265 01 0 00 004414* 30303 004556'01 000000 000000 30304 004557'01 254 00 0 00 004575' k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 63-3 K20NET MAC 15-Nov-23 19:11 Line routines 30305 004560'01 201 01 0 00 007640 movei t1,^d4000 ; Sleep four seconds. 30306 004561'01 104 00 0 00 000167 DISMS% 30307 004562'01 200 01 0 00 000005 move t1, q1 ;[186] Tell TVT "do binary". 30308 004563'01 120 02 0 00 005731' dmove t2,[exp ,-3] 30309 004564'01 104 00 0 00 000532 SOUTR% 30310 004565'01 320 12 0 00 004567' %jserr(,doarpx) 30311 004566'01 254 00 0 00 004572' 30312 004567'01 265 01 0 00 004555* 30313 004570'01 000000 000000 30314 004571'01 254 00 0 00 004575' 30315 004572'01 201 01 0 00 007640 movei t1,^d4000 30316 004573'01 104 00 0 00 000167 DISMS 30317 004574'01 263 17 0 00 000000 ret 30318 30319 doarpx: txmsg < 30320 %KERMIT-20: Warning -- Can't negotiate binary mode with TAC 30321 004575'01 200 01 0 00 000000# > 30322 004576'01 104 00 0 00 000076 30323 004577'01 320 12 0 00 004600' 30324 000236'03 000000000000# 30325 002420'04 015 012 045 113 105 30326 30327 004600'01 263 17 0 00 000000 ret k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 64 K20NET MAC 15-Nov-23 19:11 Line routines 30328 30329 ; RESLIN -- Reset/Restore the communications line. 30330 ; 30331 ; Restore old terminal modes, links, length & width, etc. 30332 ; Turn off control-C trap. 30333 ; 30334 ; CALL RESLIN does nothing if server. 30335 ; CALL RRSLIN restores the line even if server. 30336 30337 extern filjfn ;[190] 30338 30339 004601'01 reslin: entry reslin ;[190] 30340 004601'01 332 00 0 00 000000* skipe srvflg ; Server? 30341 004602'01 263 17 0 00 000000 ret ; Yes, forget it. 30342 30343 004603'01 rrslin: entry rrslin ;[220] Used by k20srv 30344 004603'01 260 17 0 00 000450* call ccoff2 ; REALLY reset the line. 30345 004604'01 rrsl2: entry rrsl2 ;[220] Used by k20srv 30346 004604'01 337 01 0 00 000000* skipg t1, filjfn ; Were we doing something with a file? 30347 004605'01 254 00 0 00 004613' ifskp. ;[194] Maybe so 30348 004606'01 621 01 0 00 777777 tlz t1, -1 ;[193] Just carefully toss any flags 30349 004607'01 306 01 0 00 377777 cain t1, .nulio ;[193] Not needed for NUL: 30350 004610'01 254 00 0 00 004613' anskp. ;[193] So bum the CLOSF 30351 004611'01 104 00 0 00 000022 CLOSF 30352 004612'01 320 12 0 00 004613' erjmpr .+1 ;[193] Catch and ignore error 30353 004613'01 endif. ;[194] 30354 004613'01 402 00 0 00 004604* setzm filjfn ;[194] Either way, no file 30355 30356 004614'01 332 00 0 00 004260* ifme. vtermf ;[186] Physical line? 30357 004615'01 254 00 0 00 004621' 30358 004616'01 260 17 0 00 004722' call unarpa ; Undo Arpanet TAC binary mode. 30359 004617'01 260 17 0 00 004625' call unbits ; Restore terminal bits. 30360 004620'01 260 17 0 00 002764' call ttxon ; Clear up any XOFF condition. 30361 004621'01 endif. ;[186] 30362 30363 004621'01 260 17 0 00 002423' call clrbuf ;[194] Clear terminal buffers 30364 004622'01 600 00 0 00 000000 nop ;[186] Ignore any failure 30365 004623'01 402 00 0 00 000000# setzm inited ;[177] Flag we're back to normal. 30366 004624'01 263 17 0 00 000000 ret k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 65 K20NET MAC 15-Nov-23 19:11 Line routines 30367 30368 ; Undo the effect of DOBITS -- restore all the communication line's 30369 ; old bits & modes. 30370 ; 30371 004625'01 unbits: entry unbits ;Used by K20IOC 30372 004625'01 265 16 0 00 005331' saveac ;[186] Used for device designator 30373 004626'01 332 05 0 00 004532* skipe q1, netjfn ;[186] Load the network JFN 30374 004627'01 254 00 0 00 004644' ifskp. ;[186] Unless we don't have one... 30375 004630'01 332 00 0 00 004534* skipe local ;[186] Are we remote? 30376 004631'01 334 01 0 00 000000# ermsg% (,r) ;[186] Just punt 30377 004632'01 254 00 0 00 004636' 30378 004633'01 202 01 0 00 004545* 30379 004634'01 104 00 0 00 000313 30380 004635'01 254 00 0 00 004547* 30381 000237'03 000000000000# 30382 002435'04 113 105 122 115 111 30383 30384 004636'01 336 05 0 00 004542* skipn q1, ttyjfn ;[186] Yes, so just use the terminal JFN 30385 004637'01 334 01 0 00 000000# ermsg% (,r) ;[186] 30386 004640'01 254 00 0 00 004644' 30387 004641'01 202 01 0 00 004633* 30388 004642'01 104 00 0 00 000313 30389 004643'01 254 00 0 00 004635* 30390 000240'03 000000000000# 30391 002451'04 113 105 122 115 111 30392 30393 004644'01 endif. ;[186] Hopefully have SOMETHING ... 30394 30395 004644'01 200 01 0 00 000005 move t1, q1 ;[186] ; Get the line. 30396 004645'01 201 02 0 00 000043 movei t2, .moxof ; Set the terminal pause on end mode... 30397 004646'01 200 03 0 00 000000# move t3, oldpau ; to what it was before. 30398 004647'01 104 00 0 00 000077 MTOPR% 30399 004650'01 320 12 0 00 004652' %jserr (,) 30400 004651'01 254 00 0 00 004655' 30401 004652'01 265 01 0 00 004567* 30402 004653'01 000000 000000 30403 004654'01 254 00 0 00 004655' 30404 004655'01 200 01 0 00 000005 move t1, q1 ;[186] ; Communication line JFN. 30405 004656'01 200 02 0 00 000000# move t2, oldmod ; Get the previous mode. 30406 004657'01 104 00 0 00 000110 SFMOD% 30407 004660'01 320 12 0 00 004662' %jserr (,) 30408 004661'01 254 00 0 00 004665' 30409 004662'01 265 01 0 00 004652* 30410 004663'01 000000 000000 30411 004664'01 254 00 0 00 004665' 30412 004665'01 104 00 0 00 000217 STPAR% 30413 004666'01 320 12 0 00 004670' %jserr (,) 30414 004667'01 254 00 0 00 004673' 30415 004670'01 265 01 0 00 004662* 30416 004671'01 000000 000000 30417 004672'01 254 00 0 00 004673' 30418 004673'01 201 02 0 00 000000# movei t2, olddim ;[185] Point to this JFN's dimensions 30419 004674'01 260 17 0 00 000000* call rstlnw ;[185] Restore length and width 30420 004675'01 201 02 0 00 000034 movx t2, .mosnt ; Restore system msg refuse/accept. 30421 004676'01 200 03 0 00 000000# move t3, sysmsg k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 65-1 K20NET MAC 15-Nov-23 19:11 Line routines 30422 004677'01 104 00 0 00 000077 MTOPR 30423 004700'01 320 12 0 00 004702' %jserr (,) 30424 004701'01 254 00 0 00 004705' 30425 004702'01 265 01 0 00 004670* 30426 004703'01 000000 000000 30427 004704'01 254 00 0 00 004705' 30428 30429 ; Restore links and advice if necessary. 30430 30431 004705'01 400 01 0 00 000000 setz t1, ; Restore links & advice. 30432 004706'01 200 02 0 00 000000# move t2, oldmod ; From old tty mode word. 30433 004707'01 602 02 0 00 001000 txne t2, tt%alk ; Was receiving links before? 30434 004710'01 661 01 0 00 030000 txo t1, ; Yes, so receive links. 30435 004711'01 602 02 0 00 000400 txne t2, tt%aad ; Was receiving advice before? 30436 004712'01 661 01 0 00 006000 txo t1, ; Yes, so receive links. 30437 004713'01 322 01 0 00 004643* jumpe t1, r ; Skip to next part if no bits to set. 30438 004714'01 540 01 0 00 004332* hrr t1, ttynum ; Must set bits, form tty designator 30439 004715'01 660 01 0 00 400000 txo t1, .ttdes ; ... 30440 004716'01 400 02 0 00 000000 setz t2, ; Don't leave garbage in here... 30441 004717'01 104 00 0 00 000216 TLINK ; Restore the settings. 30442 004720'01 320 16 0 00 004721' erjmp .+1 ; Ignore any errors. 30443 004721'01 263 17 0 00 000000 ret k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 66 K20NET MAC 15-Nov-23 19:11 Line routines 30444 30445 ; Turn off Arpanet TAC binary mode. 30446 30447 004722'01 336 00 0 00 004525* unarpa: skipn tvtflg ; Are we on a tvt? 30448 004723'01 263 17 0 00 000000 ret ; No, skip this. 30449 30450 004724'01 332 00 0 00 000000# panda < skipe havnbm ;[181] Does the monitor support network 30451 004725'01 254 00 0 00 004474' callret unsnbm > ;[181] binary mode? 30452 30453 004726'01 265 16 0 00 005331' saveac ;[186] Used for device designator 30454 004727'01 332 05 0 00 004626* skipe q1, netjfn ;[186] Load the network JFN 30455 004730'01 254 00 0 00 004745' ifskp. ;[186] Unless we don't have one... 30456 004731'01 332 00 0 00 004630* skipe local ;[186] Are we remote? 30457 004732'01 334 01 0 00 000000# ermsg% (,r) ;[186] Just punt 30458 004733'01 254 00 0 00 004737' 30459 004734'01 202 01 0 00 004641* 30460 004735'01 104 00 0 00 000313 30461 004736'01 254 00 0 00 004713* 30462 000241'03 000000000000# 30463 002466'04 113 105 122 115 111 30464 30465 004737'01 336 05 0 00 004636* skipn q1, ttyjfn ;[186] Yes, so just use the terminal JFN 30466 004740'01 334 01 0 00 000000# ermsg% (,r) ;[186] 30467 004741'01 254 00 0 00 004745' 30468 004742'01 202 01 0 00 004734* 30469 004743'01 104 00 0 00 000313 30470 004744'01 254 00 0 00 004736* 30471 000242'03 000000000000# 30472 002502'04 113 105 122 115 111 30473 30474 004745'01 endif. ;[186] Hopefully have SOMETHING ... 30475 30476 004745'01 200 01 0 00 000005 move t1, q1 ;[186] ;[181] Get the line. 30477 004746'01 120 02 0 00 005734' dmove t2, [exp ,-3] 30478 004747'01 104 00 0 00 000053 SOUT% ; Yes, turn off binary mode. 30479 004750'01 320 12 0 00 004752' %jserr(,unarpx) 30480 004751'01 254 00 0 00 004755' 30481 004752'01 265 01 0 00 004702* 30482 004753'01 000000 000000 30483 004754'01 254 00 0 00 004772' 30484 004755'01 201 01 0 00 007640 movei t1, ^d4000 ; Wait 4 secs. 30485 004756'01 104 00 0 00 000167 DISMS% 30486 004757'01 200 01 0 00 000005 move t1, q1 ;[186] ; Send the command. 30487 004760'01 120 02 0 00 005737' dmove t2, [exp ,-3] 30488 004761'01 104 00 0 00 000053 SOUT% 30489 004762'01 320 12 0 00 004764' %jserr(,unarpx) 30490 004763'01 254 00 0 00 004767' 30491 004764'01 265 01 0 00 004752* 30492 004765'01 000000 000000 30493 004766'01 254 00 0 00 004772' 30494 004767'01 201 01 0 00 007640 movei t1, ^d4000 ; Wait another 4 secs. 30495 004770'01 104 00 0 00 000167 DISMS% 30496 004771'01 263 17 0 00 000000 ret ; Done. 30497 30498 unarpx: txmsg < k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 66-1 K20NET MAC 15-Nov-23 19:11 Line routines 30499 %KERMIT-20: Warning -- Can't clear binary mode with TAC 30500 004772'01 200 01 0 00 000000# > ;[129] Error message for any of the above. 30501 004773'01 104 00 0 00 000076 30502 004774'01 320 12 0 00 004775' 30503 000243'03 000000000000# 30504 002517'04 015 012 045 113 105 30505 30506 30507 004775'01 263 17 0 00 000000 ret ;[129] And return 30508 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 67 K20NET MAC 15-Nov-23 19:11 Get Network Device Status 30509 subttl Get Network Device Status 30510 30511 ;[223] Begin Code Insertion 30512 ; 30513 ; N.B., Be aware that the result of GDSTS% has to be CAREFULLY checked 30514 ; because it may not throw an error, even when followed by an 30515 ; ERJMP! In certain error scenarios, the process's last error may 30516 ; not be changed, so messing around with a before-SETER% / after- 30517 ; GETER% won't catch the problem, either. We carefully check for 30518 ; such a situation and, if detected, set the process's last error 30519 ; appropriately. Sigh... 30520 ; 30521 ; On klh10, the only line currently known to tolerate parity is the CTY. 30522 ; On a PANDA monitor, PTY's will do parity 30523 ; 30524 ; Call: 30525 ; 30526 ; t1/ JFN on device (assumed opened in 8 bit mode) 30527 ; 30528 ; *OR* 30529 ; 30530 ; t1/ .ttdes+line number 30531 ; 30532 ; Returns: 30533 ; 30534 ; +1/ Some kind of bad 30535 ; +2/ Worked 30536 ; t1/ JFN, always 30537 ; t2/ Device-dependent status bits [If device supported GDSTS%] 30538 ; t3/ Device-dependent information [If device supported GDSTS%] 30539 ; t4/ Possible GDSTS% error 30540 30541 004776'01 gndpar: entry gndpar ; Also called from k20sub 30542 004776'01 265 16 0 00 005741' saveac ; Needs some extra registers 30543 30544 004777'01 200 05 0 00 000001 move q1, t1 ; Save JFN and any flags (which we don't use) 30545 005000'01 400 11 0 00 000000 setz q5, ; Second JFN on line 30546 30547 005001'01 606 05 0 00 400000 ifxn. q1, .ttdes ; Terminal device? 30548 005002'01 254 00 0 00 005006' 30549 005003'01 260 17 0 00 005215' call gndfil ; Yep, go get the JFN 30550 005004'01 200 11 0 00 000001 move q5, t1 ; Store it for later 30551 005005'01 254 00 0 00 005037' jrst devpar ; Go find out if it 'tolerates' parity 30552 005006'01 endif. ; End case terminal device 30553 30554 005006'01 621 01 0 00 777777 tlz t1, -1 ; Stomp the flags 30555 005007'01 104 00 0 00 000024 GTSTS% ; Get file status of JFN 30556 005010'01 320 12 0 00 004744* erjmpr r ; Failed, no way to know the parity 30557 005011'01 603 02 0 00 000200 txne t2, gs%nam ; Sanity check: does this JFN exist? 30558 005012'01 607 02 0 00 400000 txnn t2, gs%opn ; And is it open? 30559 005013'01 263 17 0 00 000000 ret ; No to one is a calling error 30560 ; Pick up and save the mode 30561 005014'01 135 04 0 00 005755' ldb t4,[pointr t2,gs%mod] 30562 005015'01 200 03 0 00 000002 move t3, t2 ; Save the entire status word, too 30563 005016'01 104 00 0 00 000045 RFBSZ% ; Get the opened byte size k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 67-1 K20NET MAC 15-Nov-23 19:11 Get Network Device Status 30564 005017'01 320 12 0 00 005010* erjmpr r ; Failed, better not go any further 30565 005020'01 415 16 0 00 005032' block. ; Build a stack frame for better control flow 30566 005021'01 261 17 0 00 000016 30567 005022'01 302 02 0 00 000007 caie t2, ^d7 ; Open in seven bit mode? 30568 005023'01 263 17 0 00 000000 ret ; Nope, have to have a new file 30569 005024'01 302 04 0 00 000000 caie t4, .gsnrm ; Opened in normal mode? 30570 005025'01 263 17 0 00 000000 ret ; No, so won't do parity 30571 005026'01 603 03 0 00 000400 txne t3, gs%err ; Nothing wrong, right? 30572 005027'01 263 17 0 00 000000 ret ; Better get our own copy 30573 005030'01 254 00 0 00 004417* retskp ; Otherwise, OK to check this JFN 30574 005031'01 263 17 0 00 000000 endbk. ; Either way, come out of the block 30575 005032'01 254 00 0 00 005035' ifskp. ; Skip means OK to check this JFN 30576 005033'01 200 11 0 00 000005 move q5, q1 ; So reuse it 30577 005034'01 254 00 0 00 005037' else. ; Otherwise, we need a copy 30578 005035'01 260 17 0 00 005215' call gndfil ; Go get a copy 30579 005036'01 200 11 0 00 000001 move q5, t1 ; Store it for later 30580 005037'01 endif. ; End of reuse determination logic 30581 30582 remark devpar ; Now check the parity (falls through) 30583 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 68 K20NET MAC 15-Nov-23 19:11 Get Network Device Status 30584 remark Now that we have a JFN, see if it will do parity 30585 30586 005037'01 200 11 0 00 000001 devpar: move q5, t1 ; Save terminal (copy) JFN and flags 30587 005040'01 621 01 0 00 777777 panda < tlz t1, -1 ; Stomp JFN flags so MTOPR%'s don't choke 30588 005041'01 201 02 0 00 400001 movx t2, .morlt ; PANDA can extract parity status 30589 005042'01 104 00 0 00 000077 MTOPR% ; So try to get it 30590 005043'01 320 12 0 00 005045' ifje. r ; Sigh... 30591 005044'01 254 00 0 00 005047' 30592 005045'01 474 10 0 00 000000 seto q4, ; Set a talisman and do nothing else 30593 005046'01 254 00 0 00 005062' else. ; Otherise, got something! 30594 005047'01 200 10 0 00 000003 move q4, t3 ; Save current settings, first 30595 005050'01 661 10 0 00 400000 txo q4, 1b0 ; Be optimistic and assume parity exists and is on 30596 005051'01 602 03 0 00 000010 txne t3, mo%par ; Any parity? 30597 005052'01 254 00 0 00 005062' anskp. ; Nothing further to do or undo 30598 005053'01 200 10 0 00 000003 move q4, t3 ; Try turning it on, saving current settings, first 30599 005054'01 660 03 0 00 000010 txo t3, mo%par ; Turn on (even) parity 30600 005055'01 620 03 0 00 000006 txz t3, mo%nbi!mo%nbo ; Shut network binary so that doesn't get in the way 30601 005056'01 201 02 0 00 400002 movx t2, .moslt ; Function to set PANDA mode bits 30602 005057'01 104 00 0 00 000077 MTOPR% ; Give it a whirl 30603 005060'01 254 00 0 00 005062' ifskp. ; Might not be in this monitor 30604 005061'01 474 10 0 00 000000 seto q4, ; So better leave it alone 30605 005062'01 endif. ; End .moslt analysis 30606 005062'01 endif. ; End .morlt recovery and interpretation 30607 >;panda 30608 dmove t1, [ .fhslf ; Can't believe result of GDSTS% all the time... 30609 005062'01 120 01 0 00 005756' lstrx1 ] ; So let's assume it worked 30610 005063'01 104 00 0 00 000336 SETER% ; and set no errors whatsoever 30611 005064'01 320 12 0 00 005066' %jserr(,) ; VERY strange... 30612 005065'01 254 00 0 00 005071' 30613 005066'01 265 01 0 00 004764* 30614 005067'01 000000000000# 30615 005070'01 254 00 0 00 005071' 30616 002533'04 125 156 141 142 154 30617 30618 005071'01 550 01 0 00 000011 hrrz t1, q5 ; Load the JFN we got 30619 005072'01 403 02 0 00 000003 setzb t2, t3 ; Let's assume the JSYS doesn't work 30620 005073'01 104 00 0 00 000145 GDSTS% ; Finally try a device status on it 30621 005074'01 320 12 0 00 005076' ifje. r ; Catch the error (hopefully) 30622 005075'01 254 00 0 00 005105' 30623 005076'01 200 04 0 00 000001 move t4, t1 ; Put error code someplace for debugger 30624 005077'01 334 00 0 00 000000 %ermsg(,) ;[223] Complain, but carry on 30625 005100'01 254 00 0 00 005104' 30626 005101'01 265 01 0 00 005066* 30627 005102'01 000000000000# 30628 005103'01 254 00 0 00 005104' 30629 002542'04 103 157 165 154 144 30630 005104'01 254 00 0 00 005121' else. ; Otherwise, worked. Maybe... 30631 005105'01 405 02 0 00 000001 andx t2, gd%par ; Toss everything but accepts parity 30632 005106'01 200 04 0 00 000002 move t4, t2 ; Get possible status out of the way 30633 005107'01 400 02 0 00 000000 setz t2, ; Let's assume GETER% fails (impossible) 30634 005110'01 201 01 0 00 400000 movei t1, .fhslf ; This process 30635 005111'01 104 00 0 00 000012 GETER% ; Get the last error 30636 005112'01 320 12 0 00 005114' %jserr(,) ; VERY strange... 30637 005113'01 254 00 0 00 005117' 30638 005114'01 265 01 0 00 005101* k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 68-1 K20NET MAC 15-Nov-23 19:11 Get Network Device Status 30639 005115'01 000000000000# 30640 005116'01 254 00 0 00 005117' 30641 002550'04 125 156 141 142 154 30642 005117'01 621 02 0 00 777777 tlz t2, -1 ; Shut off idiotic fork handle... 30643 005120'01 250 02 0 00 000004 exch t2, t4 ; Put the last error in a common place 30644 005121'01 endif. ; End case JSYS handling 30645 30646 005121'01 302 04 0 00 601405 caie t4, lstrx1 ; Any error? 30647 005122'01 254 00 0 00 005135' ifskp. ; No. Supposedly; let's double check 30648 005123'01 302 02 0 00 601340 caie t2, desx9 ; No entry in device dispatch table for GDSTS%? 30649 005124'01 254 00 0 00 005135' anskp. ; No, assume it's fine... 30650 005125'01 200 04 0 00 000002 move t4, t2 ; Yep, device doesn't support it 30651 005126'01 201 01 0 00 400000 movei t1, .fhslf ; This process 30652 005127'01 104 00 0 00 000336 SETER% ; Force it to be our last error 30653 005130'01 320 12 0 00 005132' %jserr(,) ; VERY strange... 30654 005131'01 254 00 0 00 005135' 30655 005132'01 265 01 0 00 005114* 30656 005133'01 000000000000# 30657 005134'01 254 00 0 00 005135' 30658 002557'04 125 156 141 142 154 30659 005135'01 endif. ; End case silent failure 30660 30661 005135'01 306 04 0 00 601405 cain t4, lstrx1 ; So... No error, right? 30662 005136'01 254 00 0 00 005140' ifskp. ; Something happened... 30663 ;;;; remark We handle this properly; uncomment for debugging or prototyping 30664 ;;;; %ermsg(,) 30665 005137'01 403 02 0 00 000003 setzb t2, t3 ; Cons up no status whatsoever 30666 005140'01 endif. 30667 30668 005140'01 335 03 0 00 000010 panda < skipge t3, q4 ; Did we have to restore anything? 30669 005141'01 254 00 0 00 005151' ifskp. ; Ok, so a bit of cleaning up to do, then 30670 005142'01 200 04 0 00 000002 move t4, t2 ; Save the precious gd%par bit! 30671 005143'01 550 01 0 00 000011 hrrz t1, q5 ; Pick up the terminal JFN, no flags 30672 005144'01 201 02 0 00 400002 movx t2, .moslt ; Function to set PANDA mode bits 30673 005145'01 104 00 0 00 000077 MTOPR% ; Try to set it back to the way it was 30674 005146'01 320 12 0 00 005147' erjmpr .+1 ; Failed?? We just changed it! 30675 005147'01 200 02 0 00 000004 move t2, t4 ; Restore the precious (scrubbed) gd%par bit 30676 005150'01 254 00 0 00 005155' else. ; Otherwise, looked negative 30677 005151'01 316 03 0 00 005641' camn t3, [-1] ; Is it our talisman? 30678 005152'01 254 00 0 00 005155' ifskp. ; No, so carry forward the parity setting 30679 005153'01 405 03 0 00 000010 andx t3, mo%par ; Just keep the parity on bit 30680 005154'01 434 02 0 00 000003 or t2, t3 ; And carry that on with a possible gd%par 30681 005155'01 endif. ; End case parity setting 30682 005155'01 endif. ; End .morlt recovery and interpretation 30683 >;;panda 30684 30685 remark t2, gd%par ; So will the thing do parity? 30686 005155'01 316 05 0 00 000011 camn q1, q5 ; Reused the JFN? 30687 005156'01 254 00 0 00 005030* retskp ; We did, so nothing further to do 30688 30689 005157'01 200 07 0 00 000002 move q3, t2 ; Save the precious device-dependent status bits 30690 dmove t1, [ devclt ; On time-out, hit device close timeout 30691 005160'01 120 01 0 00 005760' ^d2500 ] ; Give it two and half seconds to make up its mind 30692 005161'01 260 17 0 00 000363* call timeon ; Start the timer going 30693 005162'01 550 01 0 00 000011 hrrz t1, q5 ; Load the JFN, no flags k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 68-2 K20NET MAC 15-Nov-23 19:11 Get Network Device Status 30694 005163'01 104 00 0 00 000022 CLOSF% ; Close it 30695 005164'01 320 12 0 00 005166' %jserr(,) ; But carry on anyway 30696 005165'01 254 00 0 00 005171' 30697 005166'01 265 01 0 00 005132* 30698 005167'01 000000000000# 30699 005170'01 254 00 0 00 005171' 30700 002566'04 125 156 141 142 154 30701 005171'01 260 17 0 00 000451* call timdel ; Toss the timer, we won 30702 30703 005172'01 200 02 0 00 000007 move t2, q3 ; Restore the device-dependent status bits 30704 005173'01 254 00 0 00 005156* retskp ; Return success, anyway 30705 30706 30707 remark ; Here on device parity close timeout 30708 30709 devclt: dmove t1, [ devabt ; On time-out, hit device abort timeout 30710 005174'01 120 01 0 00 005762' ^d2500 ] ; Give it two and half seconds to make up its mind 30711 005175'01 260 17 0 00 005161* call timeon ; Start the timer going 30712 005176'01 550 01 0 00 000011 hrrz t1, q5 ; Load the JFN, no flags and set up to 30713 005177'01 621 01 0 00 004000 txz t1, cz%abt ; abort it, we mean business this time 30714 005200'01 104 00 0 00 000022 CLOSF% ; Bombs away! 30715 005201'01 320 12 0 00 005205' erjmpr devabt ; That didn't work, just try to let go of it 30716 005202'01 260 17 0 00 005171* call timdel ; Toss the timer, it's chucked 30717 005203'01 200 02 0 00 000007 move t2, q3 ; Restore the device-dependent status bits 30718 005204'01 254 00 0 00 005173* retskp ; Return some kind of success 30719 30720 devabt: dmove t1, [ devabf ; On time-out, hit device abort timeout 30721 005205'01 120 01 0 00 005764' ^d2500 ] ; Give it two and half seconds to make up its mind 30722 005206'01 260 17 0 00 005175* call timeon ; Start the timer going 30723 005207'01 550 01 0 00 000011 hrrz t1, q5 ; Load the JFN, no flags and set up to 30724 005210'01 104 00 0 00 000023 RLJFN% ; Just try to let go of it 30725 005211'01 320 12 0 00 005213' erjmpr devabf 30726 005212'01 260 17 0 00 005202* call timdel ; Toss the timer, it's chucked 30727 30728 005213'01 devabf: remark ; If hit here, just ignore what's going on, oh well.. 30729 005213'01 200 02 0 00 000007 move t2, q3 ; Restore the device-dependent status bits 30730 005214'01 254 00 0 00 005204* retskp ; Return some kind of success 30731 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 69 K20NET MAC 15-Nov-23 19:11 Get a seven bit handle on a (terminal) device 30732 subttl Get a seven bit handle on a (terminal) device 30733 30734 remark Constants definitions 30735 30736 000000 js%all==0 ; Has our JFNS% formatting bits 30737 .xcref js%all ; Not needed in the cross reference 30738 30739 define jsb(b) < ;;Macro to accumulate bits 30740 js%all==js%all! ;;OR in to completed word 30741 .xcref js%all ;;Keep off the cross reference!!!! 30742 >;;jsb 30743 30744 define jsf(m,v) < ; Macro to accumulate values 30745 ifb , ;;If no value, then always output 30746 ifnb , ;;If value, then use that 30747 .xcref js%all ;;Either way, keep off the cross reference 30748 >;;jsf 30749 30750 remark ; Finally cons up the formatting 30751 jsf(js%dev) ;;Device 30752 jsf(js%dir) ;;Directory 30753 jsf(js%nam) ;;Name 30754 jsf(js%typ) ;;Type 30755 jsf(js%gen) ;;Generation 30756 jsb(js%paf) ;;Punctuate all fields 30757 30758 chgsec(code,const) ; Not code, constants 30759 000244'03 111110 000001 allfld: js%all ; Output everything in the file name 30760 000245'03 000000 000000 0 ; No goofy prefix 30761 retsec ; Return from CONST psec 30762 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 70 K20NET MAC 15-Nov-23 19:11 Code to do the job 30763 subttl Code to do the job 30764 30765 ; N.B., This surely will NEVER work for a pipe or a file 30766 ; 30767 ; Call: 30768 ; 30769 ; t1/ JFN on device (assumed open) 30770 ; 30771 ; *OR* 30772 ; 30773 ; t1/ .ttdes+line number 30774 ; 30775 ; Return: 30776 ; 30777 ; +1/ Some problem 30778 ; t1/ Last JSYS' error 30779 ; t3/ Possible OPENF% error code 30780 ; t4/ Possible RLJFN% error code 30781 ; 30782 ; +2/ Worked! 30783 ; t1/ New JFN and flags 30784 30785 005215'01 265 16 0 00 005766' gndfil: saveac 30786 005216'01 265 16 0 00 001753* anstkv. (q2,mxfilw) ; Stack space for text of JFN 30787 005217'01 000000 000034 30788 005220'01 415 06 0 17 777743 30789 30790 005221'01 201 01 0 00 000033 movx t1, ; Length of storage to zero 30791 005222'01 200 02 0 00 000006 move t2, q2 ; First location to zero 30792 005223'01 201 03 0 02 000001 movei t3, 1(t2) ; Second location to zero 30793 005224'01 402 00 0 02 000000 setzm (t2) ; Whack the first location 30794 005225'01 320 12 0 00 005017* erjmpr r ; Must have bumped into a guard page or off section 30795 005226'01 123 01 0 00 006000' xblt. t1 ; And away we go! 30796 005227'01 320 12 0 00 005225* erjmpr r ; Must have bumped into a guard page or off section 30797 30798 005230'01 560 01 0 00 000006 hrro t1, q2 ; Tops-20 ASCIZ pointer to text area 30799 005231'01 550 02 0 00 000005 hrrz t2, q1 ; Load the JFN, sans flags 30800 005232'01 322 02 0 00 005227* jumpe t2, r ; Gubbish? 30801 005233'01 606 02 0 00 400000 txnn t2, .ttdes ; A terminal designator? 30802 005234'01 254 00 0 00 005243' ifskp. ; Yes, JFNS% will choke on it 30803 005235'01 104 00 0 00 000121 DEVST% ; So turn designator into a string 30804 005236'01 320 12 0 00 005232* erjmpr r ; But couldn't 30805 005237'01 120 02 0 00 006001' dmove t2, [exp ":",0] ; Load appropriate suffix 30806 005240'01 136 02 0 00 000001 idpb t2, t1 ; Punctuate the device 30807 005241'01 136 03 0 00 000001 idpb t3, t1 ; Tie off the string (does not allow append) 30808 005242'01 254 00 0 00 005246' else. ; Otherwise, a JFN which JFNS% can handle 30809 005243'01 120 03 0 00 000000# dmove t3, allfld ; Load formatting bits, no goofy prefix 30810 005244'01 104 00 0 00 000030 JFNS% ; Turn the JFN into text 30811 005245'01 320 12 0 00 005236* erjmpr r ; But couldn't 30812 005246'01 endif. 30813 30814 005246'01 205 01 0 00 100020 movx t1, gj%old!gj%flg ; Return flags 30815 005247'01 560 02 0 00 000006 hrro t2, q2 ; Load Tops-20 ASCIZ pointer to constructed text 30816 005250'01 104 00 0 00 000020 GTJFN% ; Get a duplicate JFN 30817 005251'01 320 12 0 00 005245* erjmpr r ; Failed?? k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 70-1 K20NET MAC 15-Nov-23 19:11 Code to do the job 30818 005252'01 200 07 0 00 000001 move q3, t1 ; Save file JFN and flags 30819 30820 005253'01 621 01 0 00 777777 tlz t1, -1 ; Shut off flags so OPENF% doesn't choke 30821 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!! 30822 005255'01 403 03 0 00 000004 setzb t3, t4 ; Scrub an error returns 30823 005256'01 104 00 0 00 000021 OPENF% ; Open the file (I hope) 30824 005257'01 320 12 0 00 005261' ifje. r ; Failed... 30825 005260'01 254 00 0 00 005263' 30826 005261'01 200 03 0 00 000001 move t3, t1 ; Save the error code 30827 005262'01 254 00 0 00 005265' else. ; Otherwise, worked!! 30828 005263'01 500 01 0 00 000007 hll t1, q3 ; Return the flags, too 30829 005264'01 254 00 0 00 005214* retskp ; Return success 30830 005265'01 endif. ; End initial JSYS handling 30831 30832 005265'01 550 01 0 00 000007 hrrz t1, q3 ; Reload the new JFN 30833 005266'01 104 00 0 00 000023 RLJFN% ; Toss its miserable remains 30834 005267'01 320 12 0 00 005271' ifje. r ; Failed?? 30835 005270'01 254 00 0 00 005272' 30836 005271'01 200 04 0 00 000001 move t4, t1 ; Return error code as talisman 30837 005272'01 endif. 30838 30839 005272'01 263 17 0 00 000000 ret ; Fail the call 30840 30841 ;[223] End Code Insertion 30842 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 71 K20NET MAC 15-Nov-23 19:11 Final code particulars 30843 subttl Final code particulars 30844 30845 xlist ; Save the trees!! 30846 list ; Safe to look 30847 .endps code ; Close out the code area 30848 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 72 K20NET MAC 15-Nov-23 19:11 Misc. data storage 30849 subttl Misc. data storage 30850 30851 .psect data ; Writeable area!! 30852 30853 000000'05 cnfigd: block .cfiln ; Space for CNFIG% .CFINF data 30854 000010'05 block 1 ; And slop 30855 000011'05 mynode:: block 1 ; Number of local executor (us) 30856 000012'05 myname:: block 2 ; Local executor name 30857 000014'05 ndvfxp:: block 1 ; Whether monitor has extended node verify 30858 30859 000015'05 syscnt:: block 1 ; Count of characters in system name 30860 000016'05 sysnam:: block syslen ; Name of local system we're running on 30861 000027'05 myprom:: block 3 ; Prompt built off system name 30862 000032'05 sysver: block 1 ; GETAB% table for system name 30863 30864 000033'05 cnfmsg: block <+1> ; Space for configuration message 30865 000065'05 block 1 ; And slop ... 30866 30867 remark ;[190] ; Various line bits of interest 30868 30869 000066'05 000000 000000 inited: 0 ;[190] ;[177] inilin/reslin flag. 30870 000067'05 000000 000000 oldmod: 0 ;[190] ; Previous mode of the line. 30871 000070'05 000000 000000 olddim: 0 ;[190] ;[185] Old line dimensions 30872 000071'05 000000 000000 oldpau: 0 ;[190] ; Previous terminal pause on end mode. 30873 000072'05 000000 000000 sysmsg: 0 ;[190] ;[82] Accept/refuse system message status. 30874 30875 panda < remark ;[181] Storage for PANDA monitor TVT support 30876 000073'05 000000 000000 havnbm: 0 ;[181] Non-zero if we have network binary mode 30877 000074'05 000000 000000 setlts: 0 ;[181] set if we set terminal status 30878 000075'05 000000 000000 oldlts: 0 ;[181] Old terminal status 30879 > ;[181] 30880 30881 remark Do not reorder next two! 30882 000076'05 nrtros:: block 1 ; If NRT, remote operating system type 30883 000077'05 rosnpt:: block 1 ; Remote operating system name pointer 30884 000100'05 nrtflg:: block 1 ; Set if a valid Network Remote Terminal 30885 000101'05 binflg:: block 1 ; Set if terminal will do binary (they all do) 30886 000102'05 nrtprt: block 1 ; NRT protocol supported 30887 000103'05 forkls:: block 1 ;[236] ; NRT connection is forkless 30888 30889 000104'05 000000 000000 job: 0 ;[218] ;[7] Number of job that has TTY I want. 30890 000105'05 000000 000000 oasflg: 0 ;[218] ;[7] -1 if we assigned the previous TTY. 30891 000106'05 000000 000000 osgdev: 0 ;[218] ;[186] Old device I had assigned 30892 000107'05 000000 000000 oldjfn: 0 ;[218] ; JFN on previous line. 30893 30894 000110'05 000000 000000 oldnum: 0 ; Previous DECnet node number 30895 000111'05 000000 000000 oldnam: exp 0, 0, 0, 0 ; Previous DECnet node name 30896 000115'05 nrtobj: block <+1> ; Area to build object name for GTJFN% 30897 000151'05 block 2 ; And slop 30898 000153'05 intbuf: block ^d<<16/5>+1> ; Space for interupt message 30899 000157'05 block 3 ; And generous slop... (it is DECnet, after all) 30900 30901 000162'05 frkpdl: block pdlsiz ;[186] Fork's PDL 30902 ;[223] If a buffer is large enough for 8 bit, it will be large enough for 7 bit 30903 000472'05 frkbuf: block +1 ;[223] Buffer for fork to read into (if 8 bit) k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page 72-1 K20NET MAC 15-Nov-23 19:11 Misc. data storage 30904 001073'05 nrtbuf: block +1 ;[223] Buffer for sending loop (if 8 bit) 30905 001474'05 parbuf: block +1 ;[223] Buffer if building parity from terminal input 30906 30907 remark pseudo-terminal information 30908 30909 002075'05 ttygtb: block 1 ; Terminal line to job mapping GETAB% 30910 002076'05 pty1st: block 1 ; Terminal line number of first pseudo-terminal 30911 002077'05 ptycnt: block 1 ; Count of pseudo-terminals 30912 002100'05 ptygtb: block 1 ; PTYPAR GETAB% index (which we'll never use) 30913 30914 002101'05 ndvchr:: block 2 ; Device characterstics double word 30915 30916 002103'05 ptyflg:: block 1 ; Set if doing pseudo-terminal I/O 30917 002104'05 ptynam:: block 3 ; ASCII name of pseudo-terminal 30918 002107'05 ptydev:: block 1 ; Assigned PTY device designator 30919 002110'05 ptytty:: block 1 ; Line number associated with pseudo-terminal 30920 30921 002111'05 ttyflg: block 1 ; Flag for physical terminal 30922 002112'05 ttydev:: block 1 ; Assigned TTY device designator 30923 002113'05 ttynam:: block 3 ; ASCII name of associated terminal 30924 30925 002116'05 777777 777777 opndev: -1 ;[186] Device type we are open on 30926 002117'05 opnsts:: block 2 ;[223] GDSTS% on the open JFN 30927 002121'05 000000 000000 opnpar:: 0 ;[223] Whether device supports parity 30928 30929 002122'05 000000 000000 vbict:: 0 ;[186] Virtual Terminal BIN% Count 30930 002123'05 000000 000000 vboct:: 0 ;[186] Virtual Terminal BOUT% Count (simulated) 30931 002124'05 000000 000000 vsict:: 0 ;[186] Virtual Terminal SIN% Count (number done) 30932 002125'05 000000 000000 vsitc:: 0 ;[186] Virtual Terminal total characters SIN%'ed 30933 002126'05 000000 000000 vsimx:: 0 ;[186] Virtual Terminal SIN% Maximum length 30934 002127'05 000000 000000 vsoct:: 0 ;[186] Virtual Terminal SOUTR%'s Issued 30935 002130'05 000000 000000 vsotc:: 0 ;[186] Virtual Terminal SOUTR% Total Characters 30936 002131'05 000000 000000 vsomx:: 0 ;[186] Virtual Terminal SOUTR% Maximum length 30937 002132'05 000000 000000 nbict:: 0 ;[186] Network BIN% count 30938 002133'05 000000 000000 nsici:: 0 ;[186] Network SIN%'s Issued 30939 002134'05 000000 000000 nsitc:: 0 ;[186] Network SIN% total characters 30940 002135'05 000000 000000 nsimx:: 0 ;[186] Network SIN% maximum length 30941 30942 002136'05 000000 000000 vchrcn:: 0 ;[211] Characters flushed from virtual line 30943 002137'05 flushb: block +1 ;[211] Flush buffer in words, eight bit bytes 30944 30945 002222'05 ntiblk::block ntblen ;[210] ;[182] NTINF% block for TVT 30946 002232'05 ntihst: block ^d20 ;[186] Remote DECnet host 30947 .endps data ; Close out the data area 30948 30949 .xcmsy ;[194] Ditch MACSYM junk 30950 30951 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 20:02 27-Nov-23 Page 72-2 K20NET MAC 15-Nov-23 19:11 Misc. data storage PSECT 4 BREAK IS 002576 FOR ETEXT PSECT 5 BREAK IS 002256 FOR DATA CPU TIME USED 00:02.114 143P CORE USED k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page S-1 K20NET MAC 15-Nov-23 19:11 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 20:02 27-Nov-23 Page S-2 K20NET MAC 15-Nov-23 19:11 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 20:02 27-Nov-23 Page S-3 K20NET MAC 15-Nov-23 19:11 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 20:02 27-Nov-23 Page S-4 K20NET MAC 15-Nov-23 19:11 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 20:02 27-Nov-23 Page S-5 K20NET MAC 15-Nov-23 19:11 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 20:02 27-Nov-23 Page S-6 K20NET MAC 15-Nov-23 19:11 SYMBOL TABLE FOR PSECT TEXT DEFNAM 000000' k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page S-7 K20NET MAC 15-Nov-23 19:11 SYMBOL TABLE FOR PSECT CONST ALLFLD 000244' 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 20:02 27-Nov-23 Page S-8 K20NET MAC 15-Nov-23 19:11 SYMBOL TABLE FOR PSECT ETEXT UNKDEC 001530' k20net - Kermit-20 Network Support MACRO %53B(1254)-4 20:02 27-Nov-23 Page S-9 K20NET MAC 15-Nov-23 19:11 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 20:02 27-Nov-23 Page 1 K20TIM MAC 9-Nov-23 15:10 All edit 216 except for some 207 code moved 30952 title K20TIM - Kermit (Virtual) Device Timing 30953 subttl All edit 216 except for some 207 code moved 30954 30955 Comment " ; Make gnuEmacs font-rot mode happy 30956 30957 The module provides basic loopback tests on various devices, currently 30958 all virtual. These are called speed tests because the results are 30959 used to validate the calculations for the efficiency rating of the 30960 line in the statistics output. 30961 30962 Other routines concerned with timing and load average may be found 30963 here. 30964 30965 Loopback tests could be provided for a physical line, but this would 30966 require taking the line out of service and fitting it with a loopback 30967 connector. For now, it is assumed that the baud rate is both 30968 correctly reported and used. 30969 30970 Please read the following VERY carefully: 30971 30972 1) The reported speed can vary WILDLY depending on other system 30973 activity and is easily peturbed for no readily apparent 30974 reason. 30975 30976 2) The speed itself is only reporting how fast the monitor is 30977 shuttling data around and has no basis in any physical 30978 transport, media or reality. 30979 30980 3) Changing the various mode, byte sizes and record lengths of 30981 the connection can produce speed changes, but these are of 30982 little pratical use other than determining what might be the 30983 most effective connection configuration. 30984 30985 4) Be particularly wary of the byte size for essentially 30986 meaningless results. It's largely here for DECnet testing 30987 and to see what the pseudo-terminal device driver might be 30988 stripping. 30989 30990 5) While it is possible to time intervals to 100 kHz (I.E., DK10) 30991 resolution, it is fundamentally impossible to accurately 30992 correlate such intervals with the time of day. This is 30993 because Tops-20 keeps the time of day as an 18 bit fixed point 30994 fraction, which works out to a 'Time of Day' tick being 30995 approximately 329.58858646932 milliseconds. 30996 30997 However, there is no way to tell when Tops-20 will advance 30998 this because the last system set time (TADIDT) as calculated 30999 STAD% is not available nor is the millisecond uptime counter 31000 that is used to calculate it. The problem is made worse 31001 because there is thus no public correlation between HPTIM%, 31002 either. 31003 31004 The problem really can't be resolved without a change to 31005 Tops-20 to make TADIDT available and to store the elapsed 31006 millisecond clock that was used to do the calculation. K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 1-1 K20TIM MAC 9-Nov-23 15:10 All edit 216 except for some 207 code moved 31007 31008 This is not a problem for commands that display elapsed time, 31009 such as CLEAR. It is a problem for logging where using HPTIM% 31010 can occasionally produce the effect of time going backwards. 31011 " 31012 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 2 K20TIM MAC 9-Nov-23 15:10 Preliminaries 31013 subttl Preliminaries 31014 31015 search monsym,macsym,cmd,k20unv 31016 search dcam ; Double compare macros 31017 cmdacs ^ ; Clean up p1-p4 definitions 31018 31019 sall ; Tidy listing 31020 .directive flblst ; We don't need to see all the ASCIZ bytes... 31021 31022 remark common parsing external data and usage 31023 31024 extern pars1 ; Contains address of .TIME 31025 extern pars2 ; Parsed device id 31026 extern pars3 ; OPENF% mode 31027 extern pars4 ; OPENF% byte size 31028 extern pars5 ; Buffer size (RECORD-LENGTH) 31029 31030 remark ; Various support routines 31031 extern ascdev ; Turns a device number into ASCII text 31032 extern %%jser ; JSYS error handler 31033 extern %%smsg ; smsg macro support 31034 extern BOUTI% ;[216] BOUT% Internal 31035 extern symout ; Get symbolic name and offset of an address 31036 remark $TIME ; Is found in k20dsp and invokes the timing routines 31037 31038 remark ; Various external variables 31039 extern crlf ; Carriage return line feed sequence 31040 31041 remark ; Some constants 31042 31043 000511 456000 msiday==^d86400000 ; Milliseconds in a day 31044 100276 770000 dkday==msiday*^d100 ; 100 DK10 ticks per millisecond 31045 000001 000000 todtic==^d262144 ; TOD ticks in a day 31046 31047 .psect code/ronly ; Don't allow stores!! 31048 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 3 K20TIM MAC 9-Nov-23 15:10 TIME command parse table 31049 subttl TIME command parse table 31050 31051 remark ; Common Names of devices we can test 31052 31053 000000'02 000000 000000 %table(timtab) ; Begin a keyword table 31054 000001'02 000000# 777777 %key2 , -1 ; Copy anotherdevice's baud 31055 000000'03 143 157 160 171 000 31056 000002'02 000000# 600015 %key2 , .dvdes!.dvnul ; Idiomatic for NUL: 31057 000001'03 144 141 164 141 055 31058 000003'02 000000# 600022 %keyf3 , .dvdes!.dvdcn, cm%inv ; Allows escape recognition 31059 000003'03 002000 000001 31060 000004'03 104 103 116 000 000 31061 000004'02 000000# 600022 %key2 , .dvdes!.dvdcn ; Means either SRV: or DCN: 31062 000005'03 104 105 103 156 145 31063 000005'02 000000# 777777 %keyf3 , -1, cm%inv ; When Tom gets sleepy 31064 000007'03 002000 000001 31065 000010'03 144 165 160 154 151 31066 000006'02 000000# 000010' %keyf3 , %NUL, cm%inv!cm%abr ; Prefer NUL over NRT 31067 000012'03 002000 000005 31068 000013'03 156 000 000 000 000 31069 000007'02 000000# 600022 %keyf3 , .dvdes!.dvdcn, cm%inv ; Sleepy Tom types this 31070 000014'03 002000 000001 31071 000015'03 116 122 124 000 000 31072 000010'02 000000# 600015 %nul: %keyf3 , .dvdes!.dvnul, cm%inv ; Allows escape recognition 31073 000016'03 002000 000001 31074 000017'03 116 125 114 000 000 31075 000011'02 000000# 000013' %keyf3 , %pipe, cm%inv!cm%abr ; Prefer pipe over PIP: 31076 000020'03 002000 000005 31077 000021'03 160 151 000 000 000 31078 000012'02 000000# 600403 %keyf3 , .dvdes!.dvpip, cm%inv ; Allows escape recognition 31079 000022'03 002000 000001 31080 000023'03 120 111 120 000 000 31081 000013'02 000000# 600403 %pipe: %key2 , .dvdes!.dvpip ; Idiomatic for PIP: 31082 000024'03 160 151 160 145 000 31083 000014'02 000000# 600013 %key2 , .dvdes!.dvpty ; Idiotmatic for PTY: 31084 000025'03 160 163 145 165 144 31085 000015'02 000000# 600013 %keyf3 , .dvdes!.dvpty, cm%inv ; Don't specify device number 31086 000031'03 002000 000001 31087 000032'03 120 124 131 000 000 31088 000016'02 000000# 000020' %keyf3 , %reus, cm%inv!cm%abr ; Prefer re-use over reuse 31089 000033'03 002000 000005 31090 000034'03 162 000 000 000 000 31091 000017'02 000000# 000020' %keyf3 , %reus, cm%inv!cm%abr ; Prefer re-use over reuse 31092 000035'03 002000 000005 31093 000036'03 162 145 000 000 000 31094 000020'02 000000# 777777 %reus: %keyf3 , -1, cm%inv ; Previous dumb name for copy 31095 000037'03 002000 000001 31096 000040'03 162 145 055 165 163 31097 000021'02 000000# 777777 %keyf3 , -1, cm%inv ; Ditto 31098 000042'03 002000 000001 31099 000043'03 162 145 165 163 145 31100 000022'02 000000# 600023 %keyf3 , .dvdes!.dvsrv, cm%inv ; Allows escape recognition 31101 000045'03 002000 000001 31102 000046'03 123 122 126 000 000 31103 000000'02 000022 000022 %tbend K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 3-1 K20TIM MAC 9-Nov-23 15:10 TIME command parse table 31104 cleans(<%nul,%pipe,%reus>) ; Pitch working symbols 31105 31106 chgsec(code,const) ;;Chained FDB's go into CONST area 31107 000023'02 000004 000026' timfdb: flddb. .cmkey,,timtab,,,timfd1 31108 000024'02 000000 000000' 31109 000025'02 44 07 0 00 000351' 31110 000026'02 016004 000000 timfd1: flddb. .cmdev,,, 31111 000027'02 000000 000000 31112 000030'02 44 07 0 00 000355' 31113 retsec ;;Restore psect assumptions 31114 cleans() ;;Toss working symbol 31115 31116 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 4 K20TIM MAC 9-Nov-23 15:10 TIME (device) command parsing 31117 subttl TIME (device) command parsing 31118 31119 000000'01 .time: intern .time ; Invoked by top level parser 31120 000000'01 265 16 0 00 003446' saveac ; Just in case 31121 000001'01 200 16 0 00 000000# guide (virtual speed of) 31122 000002'01 260 17 0 00 000000* 31123 000031'02 000000000000# 31124 000000'04 166 151 162 164 165 31125 31126 000003'01 477 01 0 00 000002 setob t1, t2 ; Cons up some talisman 31127 000004'01 124 01 0 00 000000* dmovem t1, pars2 ; No device nor OPENF% mode parsed 31128 000005'01 124 01 0 00 000000* dmovem t1, pars4 ; No OPENF% byte size 31129 000006'01 202 01 0 00 000000# movem t1, timdev ; Device being timed 31130 31131 000007'01 201 01 0 00 000000# movei t1, timfdb ; Parse a device as a keyword or something real 31132 000010'01 260 17 0 00 000000* call rfield ; Try to get something 31133 000011'01 135 04 0 00 003454' ldb t4, [pointr (.cmfnp(t3),cm%fnc)] ; Get parse function taken 31134 31135 000012'01 302 04 0 00 000000 caie t4, .cmkey ; Did a nice name? 31136 000013'01 254 00 0 00 000020' ifskp. ; Yep, that's not very difficult 31137 000014'01 524 02 0 02 000000 hrlo t2, (t2) ; Turn semantic action into a device designator 31138 000015'01 316 02 0 00 003455' camn t2, [-1] ; Wants to use a device's results elsewhere? 31139 000016'01 254 00 0 00 000125' callret .copy ; Yes, do that 31140 000017'01 201 04 0 00 000016 movei t4, .cmdev ; Otherwise, say we parsed a device 31141 000020'01 endif. ; And take the device case 31142 31143 000020'01 302 04 0 00 000016 caie t4, .cmdev ; Explicitly specified the device? 31144 000021'01 254 00 0 00 000040' ifskp. ; Yes, that's not much harder 31145 000022'01 554 01 0 00 000002 hlrz t1, t2 ; Pick up bare device designator 31146 000023'01 620 01 0 00 600000 txz t1, .dvdes ; Shut off the universal device code 31147 000024'01 202 01 0 00 000004* movem t1, pars2 ; Finally save just the device type number 31148 31149 000025'01 306 01 0 00 000013 cain t1, .dvpty ; Pseudo-terminal? 31150 000026'01 254 00 0 00 000052' callret parpty ; Yes, maybe parse its switch modifiers 31151 000027'01 306 01 0 00 000403 cain t1, .dvpip ; Pipe device? 31152 000030'01 254 00 0 00 000054' callret parpip ; Yes, maybe parse its switch modifiers 31153 000031'01 306 01 0 00 000015 cain t1, .dvnul ; NULL (or NIL) device? 31154 000032'01 254 00 0 00 000056' callret parnul ; Yes, maybe parse its bytesize modifier 31155 000033'01 302 01 0 00 000023 caie t1, .dvsrv ; DECnet passive component? 31156 000034'01 306 01 0 00 000022 cain t1, .dvdcn ; or DECnet active component 31157 000035'01 254 00 0 00 000060' callret pardcn ; Yes, maybe parse its switch modifiers 31158 ; None of the above, so nothing special 31159 000036'01 260 17 0 00 000000* confrm ; Tie off the line 31160 000037'01 263 17 0 00 000000 ret ; And done 31161 000040'01 endif. ; End case .cmdev parse item 31162 31163 000040'01 broken: remark ; Otherwise, we are deeply confused 31164 000040'01 200 01 0 00 000000# emsg() ; Begin the blat 31165 000041'01 104 00 0 00 000313 31166 000032'02 000000000000# 31167 000004'04 111 156 166 141 154 31168 000042'01 201 01 0 00 000101 movei t1, .priou ; Continue blatting on the terminal 31169 000043'01 200 02 0 00 000004 move t2, t4 ; Loaded the parsed function 31170 000044'01 201 03 0 00 000010 movei t3, fld(^d8,no%rdx) ;Function codes are octal 31171 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 20:02 27-Nov-23 Page 4-1 K20TIM MAC 9-Nov-23 15:10 TIME (device) command parsing 31172 000046'01 320 12 0 00 000047' erjmpr .+1 ; Ignore error, we're trying hard enough 31173 31174 000047'01 561 01 0 00 000000* hrroi t1, crlf ; Tie off the blat 31175 000050'01 104 00 0 00 000076 PSOUT% 31176 000051'01 263 17 0 00 000000 ret ; And go no further 31177 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 5 K20TIM MAC 9-Nov-23 15:10 Device secondary parse tables and function descriptor blocks 31178 subttl Device secondary parse tables and function descriptor blocks 31179 31180 remark Various switches for each device 31181 31182 000033'02 000000 000000 %table(nulswi) ; General device switch table 31183 000034'02 000000# 000000# %key2 ,parbyt ;Parse byte size 31184 000047'03 142 171 164 145 163 31185 000033'02 000001 000001 %tbend 31186 31187 000035'02 000000 000000 %table(devswi) ; General device switch table 31188 000036'02 000000# 000000# %key2 ,parbyt ;Parse byte size 31189 000051'03 142 171 164 145 163 31190 000037'02 000000# 000000# %key2 ,parmod ; Parse mode 31191 000053'03 155 157 144 145 072 31192 000035'02 000002 000002 %tbend 31193 31194 000040'02 000000 000000 %table(pipswi) ; Begin a special switch table for pipes 31195 000041'02 000000# 000000# %key2 ,parbyt ;Parse byte size 31196 000055'03 142 171 164 145 163 31197 000042'02 000000# 000000# %key2 ,parmod ; Parse mode 31198 000057'03 155 157 144 145 072 31199 000043'02 000000# 000000# %key2 ,parecl 31200 000061'03 162 145 143 157 162 31201 000040'02 000003 000003 %tbend 31202 31203 remark Switches applicable to potentiall all devices 31204 31205 000044'02 000000 000000 %table(modkey) ; N.B., Not all devices support all modes!! 31206 000045'02 000000# 000017 %keyf3 ,.GSDMP, cm%inv ;N.B., No device here supports dump mode 31207 000064'03 002000 000001 31208 000065'03 144 165 155 160 000 31209 000046'02 000000# 000047' %keyf3 , %imag, cm%abr!cm%inv 31210 000066'03 002000 000005 31211 000067'03 151 000 000 000 000 31212 000047'02 000000# 000010 %imag: %key2 , .GSIMG 31213 000070'03 151 155 141 147 145 31214 000050'02 000000# 000001 %keyf3 ,.GSSMB, cm%inv 31215 000072'03 002000 000001 31216 000073'03 151 156 164 145 162 31217 000051'02 000000# 000000 %key2 ,.GSNRM 31218 000076'03 156 157 162 155 141 31219 000052'02 000000# 000001 %key2 , .GSSMB 31220 000100'03 163 155 141 154 154 31221 000044'02 000006 000006 %tbend 31222 cleans(<%imag>) ;;Clean working symbol out of MACRO tables 31223 31224 chgsec(code,const) ;;Chained FDB's are in CONST, not code 31225 000053'02 010004 000056' parfdb: flddb. .cmcfm,,,,,parfd1 31226 000054'02 000000 000000 31227 000055'02 44 07 0 00 000365' 31228 000056'02 003000 000000 parfd1: flddb. .cmswi,,devswi, ;; or OPENF% mode modifiers 31229 000057'02 000000 000035' 31230 31231 000060'02 010004 000063' pipfdb: flddb. .cmcfm,,,,,pipfd1 31232 000061'02 000000 000000 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 5-1 K20TIM MAC 9-Nov-23 15:10 Device secondary parse tables and function descriptor blocks 31233 000062'02 44 07 0 00 000376' 31234 000063'02 003000 000000 pipfd1: flddb. .cmswi,,pipswi ;; or OPENF% mode and GTJFN% modifiers 31235 000064'02 000000 000040' 31236 31237 000065'02 010004 000070' nilfdb: flddb. .cmcfm,,,,,nilfd1 31238 000066'02 000000 000000 31239 000067'02 44 07 0 00 000405' 31240 000070'02 003000 000000 nilfd1: flddb. .cmswi,,nulswi, ;; NIL was the original TENEX name for NUL: 31241 000071'02 000000 000033' 31242 31243 000072'02 010004 000075' dcnfdb: flddb. .cmcfm,,,,,dcnfd1 31244 000073'02 000000 000000 31245 000074'02 44 07 0 00 000415' 31246 000075'02 003000 000000 dcnfd1: flddb. .cmswi,,devswi, ;; or OPENF% mode and GTJFN% modifiers 31247 000076'02 000000 000035' 31248 31249 31250 retsec ;;Back to code .psect 31251 cleans() 31252 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 6 K20TIM MAC 9-Nov-23 15:10 Device secondary (switch) parsing 31253 subttl Device secondary (switch) parsing 31254 31255 000052'01 201 05 0 00 000000# parpty: movei q1, parfdb ; Handle case of pseudo terminal 31256 000053'01 254 00 0 00 000062' callret parswi ; Now parse for PTY:'s switches 31257 31258 000054'01 201 05 0 00 000000# parpip: movei q1, pipfdb ; Handle pipe device 31259 000055'01 254 00 0 00 000062' callret parswi ; Now parse for PIP:'s switches 31260 31261 000056'01 201 05 0 00 000000# parnul: movei q1, nilfdb ; Handle NUL: (or NIL) device 31262 000057'01 254 00 0 00 000062' callret parswi ; Now parse for NUL:'s switches 31263 31264 000060'01 201 05 0 00 000000# pardcn: movei q1, dcnfdb ; Handle DECnet (SRV:/DCN:) device 31265 000061'01 254 00 0 00 000062' callret parswi ; Now parse for DCN:'s switch 31266 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 7 K20TIM MAC 9-Nov-23 15:10 Common secondary switch parsing 31267 subttl Common secondary switch parsing 31268 31269 000062'01 parswi: do. ; Enter loop logical context 31270 000062'01 200 01 0 00 000005 move t1, q1 ; Load the requested parse FDB 31271 000063'01 260 17 0 00 000010* call rfield ; Go parse something 31272 000064'01 135 04 0 00 003454' ldb t4, [pointr (.cmfnp(t3),cm%fnc)] ; Get parse function taken 31273 000065'01 306 04 0 00 000010 cain t4, .cmcfm ; Confirmed? 31274 000066'01 263 17 0 00 000000 ret ; They did, we're done 31275 000067'01 550 01 0 02 000000 hrrz t1, (t2) ; Otherwise, we have a switch to do 31276 000070'01 260 17 0 01 000000 call (t1) ; So Pick up switch parsed and call it 31277 000071'01 600 00 0 00 000000 nop ; Ignore any skip/non-skip (none currently skip) 31278 000072'01 254 00 0 00 000062' loop. ; Go get some more switches until confirmed 31279 000073'01 enddo. ; End loop lexical context 31280 31281 remark Here to handle BYTESIZE, MODE and RECORD-LENGTH switches 31282 31283 000073'01 parbyt: remark Parse file byte size 31284 000073'01 201 01 0 00 003462' movei t1, [flddb. .cmnum,,^d10,] 31285 000074'01 260 17 0 00 000063* call rfield ; Get a number 31286 000075'01 327 02 0 00 000101' ifle. t2 ; Gubbish? 31287 000076'01 200 01 0 00 000000# emsg 31288 000077'01 104 00 0 00 000313 31289 000077'02 000000000000# 31290 000013'04 111 154 154 157 147 31291 000100'01 254 00 0 00 000000* jrst cmder1 ; Complain and allow command retry. 31292 000101'01 endif. 31293 000101'01 307 02 0 00 000044 caig t2,^d36 ; Being overly bullish? 31294 000102'01 254 00 0 00 000106' ifskp. ; Then it isn't a DIGITAL computer... 31295 000103'01 200 01 0 00 000000# emsg 31296 000104'01 104 00 0 00 000313 31297 000100'02 000000000000# 31298 000025'04 124 150 145 040 120 31299 000105'01 254 00 0 00 000100* jrst cmder1 ; Complain and allow command retry. 31300 000106'01 endif. 31301 000106'01 202 02 0 00 000005* movem t2, pars4 ; Store byte size for OPENF% 31302 000107'01 263 17 0 00 000000 ret ; Get more switches 31303 31304 000110'01 parmod: remark Parse file mode 31305 000110'01 201 01 0 00 003471' movei t1, [flddb. .cmkey,,modkey,] 31306 000111'01 260 17 0 00 000074* call rfield ; Get a keyword 31307 000112'01 550 01 0 02 000000 hrrz t1, (t2) ; Turn semantic action into a mode value 31308 000113'01 202 01 0 00 000000* movem t1, pars3 ; Store OPENF% mode 31309 000114'01 263 17 0 00 000000 ret ; Get more switches 31310 31311 000115'01 parecl: remark Parse RECORD-LENGTH attrbute 31312 000115'01 201 01 0 00 003500' movei t1, [flddb. .cmnum,,^d10,] 31313 000116'01 260 17 0 00 000111* call rfield ; Get a number 31314 000117'01 327 02 0 00 000123' ifle. t2 ; Gubbish? 31315 000120'01 200 01 0 00 000000# emsg 31316 000121'01 104 00 0 00 000313 31317 000101'02 000000000000# 31318 000042'04 111 154 154 157 147 31319 000122'01 254 00 0 00 000105* jrst cmder1 ; Complain and allow command retry. 31320 000123'01 endif. 31321 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 20:02 27-Nov-23 Page 7-1 K20TIM MAC 9-Nov-23 15:10 Common secondary switch parsing 31322 000124'01 263 17 0 00 000000 ret ; Get more switches 31323 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 8 K20TIM MAC 9-Nov-23 15:10 Copy one device's speed test over another's 31324 subttl Copy one device's speed test over another's 31325 31326 ; Useful because inter-fork pseudo-terminal speed is FAR slower than 31327 ; inter-job speed, resulting in efficiency percentages in the 31328 ; quadruple digit range. 31329 31330 remark ; Common Names of device tests we can copy 31331 31332 000102'02 000000 000000 %table(coptab) ; Begin a keyword table 31333 000103'02 000000# 600015 %key2 , .dvdes!.dvnul ; Idiomatic for NUL: 31334 000102'03 144 141 164 141 055 31335 000104'02 000000# 600022 %keyf3 , .dvdes!.dvdcn, cm%inv ; Allows escape recognition 31336 000104'03 002000 000001 31337 000105'03 104 103 116 000 000 31338 000105'02 000000# 600022 %key2 , .dvdes!.dvdcn ; Means either SRV: or DCN: 31339 000106'03 104 105 103 156 145 31340 000106'02 000000# 000110' %keyf3 , %nul1, cm%inv!cm%abr ; Prefer NUL over NRT 31341 000110'03 002000 000005 31342 000111'03 156 000 000 000 000 31343 000107'02 000000# 600022 %keyf3 , .dvdes!.dvdcn, cm%inv ; Sleepy Tom types this 31344 000112'03 002000 000001 31345 000113'03 116 122 124 000 000 31346 000110'02 000000# 600015 %nul1: %keyf3 , .dvdes!.dvnul, cm%inv ; Allows escape recognition 31347 000114'03 002000 000001 31348 000115'03 116 125 114 000 000 31349 000111'02 000000# 000113' %keyf3 , %pip1, cm%inv!cm%abr ; Prefer pipe over PIP: 31350 000116'03 002000 000005 31351 000117'03 160 151 000 000 000 31352 000112'02 000000# 600403 %keyf3 , .dvdes!.dvpip, cm%inv ; Allows escape recognition 31353 000120'03 002000 000001 31354 000121'03 120 111 120 000 000 31355 000113'02 000000# 600403 %pip1: %key2 , .dvdes!.dvpip ; Idiomatic for PIP: 31356 000122'03 160 151 160 145 000 31357 000114'02 000000# 600013 %key2 , .dvdes!.dvpty ; Idiotmatic for PTY: 31358 000123'03 160 163 145 165 144 31359 000115'02 000000# 600013 %keyf3 , .dvdes!.dvpty, cm%inv ; Allows escape recognition 31360 000127'03 002000 000001 31361 000130'03 120 124 131 000 000 31362 000116'02 000000# 600023 %keyf3 , .dvdes!.dvsrv, cm%inv ; Allows escape recognition 31363 000131'03 002000 000001 31364 000132'03 123 122 126 000 000 31365 000102'02 000014 000014 %tbend 31366 31367 cleans(<%nul1,%pip1>) ; Toss working symbols 31368 31369 chgsec(code,const) ;;Chained FDB's go into const 31370 000117'02 000004 000122' cpffdb: flddb. .cmkey,,coptab,,,cpffd1 31371 000120'02 000000 000102' 31372 000121'02 44 07 0 00 000424' 31373 000122'02 016004 000000 cpffd1: flddb. .cmdev,,, 31374 000123'02 000000 000000 31375 000124'02 44 07 0 00 000355' 31376 31377 000125'02 000004 000130' cptfdb: flddb. .cmkey,,coptab,,,cptfd1 31378 000126'02 000000 000102' K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 8-1 K20TIM MAC 9-Nov-23 15:10 Copy one device's speed test over another's 31379 000127'02 44 07 0 00 000432' 31380 000130'02 016004 000000 cptfd1: flddb. .cmdev,,, 31381 000131'02 000000 000000 31382 000132'02 44 07 0 00 000355' 31383 retsec ;;Return to code .psect 31384 31385 cleans() ;;Punt the working symbols 31386 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 9 K20TIM MAC 9-Nov-23 15:10 TIME COPY command parsing 31387 subttl TIME COPY command parsing 31388 31389 000125'01 265 16 0 00 003503' .copy: saveac ; Wants another AC 31390 000126'01 200 16 0 00 000000# guide (a previous timing test result for) 31391 000127'01 260 17 0 00 000002* 31392 000133'02 000000000000# 31393 000055'04 141 040 160 162 145 31394 remark t5, q1 ; Note aliased, assumed saved 31395 31396 000130'01 201 01 0 00 000000# movei t1, cpffdb ; Copy-From FDB 31397 000131'01 260 17 0 00 000116* call rfield ; Try to get something 31398 000132'01 135 04 0 00 003454' ldb t4, [pointr (.cmfnp(t3),cm%fnc)] ; Get parse function taken 31399 31400 000133'01 302 04 0 00 000000 caie t4, .cmkey ; Did an idiomatic name? 31401 000134'01 254 00 0 00 000137' ifskp. ; Yep, that's not very difficult 31402 000135'01 524 02 0 02 000000 hrlo t2, (t2) ; Turn semantic action into a device designator 31403 000136'01 201 04 0 00 000016 movei t4, .cmdev ; Say we parsed a device 31404 000137'01 endif. ; And take the device case 31405 31406 000137'01 302 04 0 00 000016 caie t4, .cmdev ; If not a device at this point, 31407 000140'01 254 00 0 00 000040' jrst broken ; ...we are deeply broken... 31408 31409 000141'01 554 01 0 00 000002 hlrz t1, t2 ; Pick up bare device designator 31410 000142'01 620 01 0 00 600000 txz t1, .dvdes ; Shut off the universal device code 31411 000143'01 200 05 0 00 000001 move q1, t1 ; Save just the 'source' device type number 31412 31413 000144'01 200 16 0 00 000000# guide (to another device) 31414 000145'01 260 17 0 00 000127* 31415 000134'02 000000000000# 31416 000064'04 164 157 040 141 156 31417 31418 000146'01 201 01 0 00 000000# movei t1, cptfdb ; Copy-To FDB 31419 000147'01 260 17 0 00 000131* call rfield ; Try to get something 31420 000150'01 135 04 0 00 003454' ldb t4, [pointr (.cmfnp(t3),cm%fnc)] ; Get parse function taken 31421 31422 000151'01 302 04 0 00 000000 caie t4, .cmkey ; Did an idomatic name? 31423 000152'01 254 00 0 00 000155' ifskp. ; Indeed; transmorgrify 31424 000153'01 524 02 0 02 000000 hrlo t2, (t2) ; Turn semantic action into a device designator 31425 000154'01 201 04 0 00 000016 movei t4, .cmdev ; Say we parsed a device 31426 000155'01 endif. ; And take the device case 31427 31428 000155'01 302 04 0 00 000016 caie t4, .cmdev ; If not a device at this point, we are 31429 000156'01 254 00 0 00 000040' jrst broken ; deeply broken... 31430 31431 000157'01 554 06 0 00 000002 hlrz q2, t2 ; Pick up bare device designator 31432 000160'01 620 06 0 00 600000 txz q2, .dvdes ; Shut off the universal device code 31433 000161'01 312 05 0 00 000006 came q1, q2 ; Are we trying to reuse ourself? 31434 000162'01 254 00 0 00 000174' ifskp. ; Yes, don't let's be silly 31435 000163'01 200 01 0 00 000000# emsg 31436 000164'01 104 00 0 00 000313 31437 000135'02 000000000000# 31438 000070'04 122 145 144 165 156 31439 000165'01 200 01 0 00 000005 move t1, q1 ; Load device number 31440 000166'01 260 17 0 00 000000* call ascdev ; Turn into a string 31441 000167'01 104 00 0 00 000076 PSOUT% ; Type it K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 9-1 K20TIM MAC 9-Nov-23 15:10 TIME COPY command parsing 31442 txmsg <'s timing test result onto itself 31443 000170'01 200 01 0 00 000000# > 31444 000171'01 104 00 0 00 000076 31445 000172'01 320 12 0 00 000173' 31446 000136'02 000000000000# 31447 000074'04 047 163 040 164 151 31448 31449 000173'01 254 00 0 00 000122* jrst cmder1 ; Complain and allow command retry. 31450 000174'01 endif. 31451 000174'01 260 17 0 00 000036* confrm ; Tie off the line 31452 remark ; Fall through to execute the code 31453 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 10 K20TIM MAC 9-Nov-23 15:10 Re-use semantic action, not called since only one keyword 31454 subttl Re-use semantic action, not called since only one keyword 31455 31456 extern pvbaud ; PTY: virtual baud rate 31457 extern pibaud ; PIP: virtual baud rate 31458 extern nlbaud ; NUL: virtual baud rate 31459 extern dnbaud ; DCN:/SRV: pair virtual baud rate 31460 31461 000175'01 $copy: remark ; Check source tests 31462 000175'01 477 03 0 00 000004 setob t3, t4 ; Assume we don't know either 31463 000176'01 306 05 0 00 000013 cain q1, .dvpty ; Pseudo-terminal? 31464 000177'01 201 03 0 00 000000* movei t3, pvbaud ; Address of test results 31465 000200'01 306 05 0 00 000403 cain q1, .dvpip ; Pipe device? 31466 000201'01 201 03 0 00 000000* movei t3, pibaud ; Address of test results 31467 000202'01 306 05 0 00 000015 cain q1, .dvnul ; NULL (or NIL) device? 31468 000203'01 201 03 0 00 000000* movei t3, nlbaud ; Address of test results 31469 000204'01 302 05 0 00 000023 caie q1, .dvsrv ; DECnet passive component? 31470 000205'01 306 05 0 00 000022 cain q1, .dvdcn ; or DECnet active component 31471 000206'01 201 03 0 00 000000* movei t3, dnbaud ; Yes, has the same test result address 31472 000207'01 321 03 0 00 000244' jumpl t3, $copys ; We don't have a test for this source 31473 31474 remark ; Check destination tests 31475 000210'01 306 06 0 00 000013 cain q2, .dvpty ; Pseudo-terminal? 31476 000211'01 201 04 0 00 000177* movei t4, pvbaud ; Address of test results 31477 000212'01 306 06 0 00 000403 cain q2, .dvpip ; Pipe device? 31478 000213'01 201 04 0 00 000201* movei t4, pibaud ; Address of test results 31479 000214'01 306 06 0 00 000015 cain q2, .dvnul ; NULL (or NIL) device? 31480 000215'01 201 04 0 00 000203* movei t4, nlbaud ; Address of test results 31481 000216'01 302 06 0 00 000023 caie q2, .dvsrv ; DECnet passive component? 31482 000217'01 306 06 0 00 000022 cain q2, .dvdcn ; or DECnet active component 31483 000220'01 201 04 0 00 000206* movei t4, dnbaud ; Yes, has the same test result address 31484 000221'01 321 04 0 00 000246' jumpl t4, $copyd ; We don't have a test for this destination 31485 31486 000222'01 120 01 0 03 000000 dmove t1, (t3) ; Pick up source test 31487 000223'01 323 01 0 00 000233' jumple t1, $copyn ; No test run 31488 000224'01 124 01 0 04 000000 dmovem t1, (t4) ; Overwrite destination results 31489 000225'01 124 01 0 00 000106* dmovem t1, pars4 ; Store for $SHOW 31490 31491 remark ; Turn device numbers back into device 31492 000226'01 524 01 0 00 000005 hrlo t1, q1 ; Reposition source device number 31493 000227'01 661 01 0 00 600000 tlo t1, .dvdes ; Now a device designator 31494 000230'01 200 02 0 00 000006 move t2, q2 ; Load destination device number 31495 000231'01 124 01 0 00 000024* dmovem t1, pars2 ; Store as device designators 31496 31497 000232'01 263 17 0 00 000000 ret ; Return into $SHOW 31498 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 11 K20TIM MAC 9-Nov-23 15:10 various error handlers 31499 subttl various error handlers 31500 31501 chgsec(code,text) ;;Text .psect for strings 31502 000133'03 116 157 040 164 151 $copym: asciz "No timing run yet for " 31503 retsec ;;Get back in code .psect 31504 31505 000233'01 $copyn: remark ; Here if no test has been run 31506 000233'01 561 01 0 00 000000# hrroi t1, $copym ; Load common preamble 31507 000234'01 104 00 0 00 000313 ESOUT% ; Begin blat 31508 31509 000235'01 200 01 0 00 000005 move t1, q1 ; Pick up source device number 31510 000236'01 260 17 0 00 000166* call ascdev ; Convert to a string 31511 000237'01 104 00 0 00 000076 PSOUT% ; Type it 31512 31513 000240'01 561 01 0 00 000047* hrroi t1, crlf ; Tie off the line 31514 000241'01 104 00 0 00 000076 PSOUT% 31515 000242'01 476 00 0 00 000231* setom pars2 ; Flag already blatted 31516 000243'01 263 17 0 00 000000 ret ; Return into $SHOW 31517 31518 000244'01 $copys: remark ; Here if source device is unknown 31519 000244'01 202 05 0 00 000242* movem q1, pars2 ; Load the device number 31520 000245'01 263 17 0 00 000000 ret ; Return into $SHOW 31521 31522 000246'01 $copyd: remark ; Here if destination device is unknown 31523 000246'01 202 06 0 00 000244* movem q2, pars2 ; Load the device number 31524 000247'01 263 17 0 00 000000 ret ; Return into $SHOW 31525 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 12 K20TIM MAC 9-Nov-23 15:10 Determine PTY Virtual Baud rate 31526 subttl Determine PTY Virtual Baud rate 31527 31528 ; N.B., this code is not intended to provide a definitive answer to 31529 ; ANYTHING because Tops-20 is not a real-time system. Even a speck 31530 ; of system load can wildly peturb the results as well as whatever the 31531 ; current monitor's pseudo-terminal implementation happens to be. 31532 ; 31533 ; Also, the speed of a PTY in an intra-job context (as is done below) 31534 ; appears to be slower than the more typical inter-job example, as 31535 ; used by BATCON and Kermit's pseudo-terminal connection code. 31536 ; 31537 ; This result is therefore best viewed as a number suitable for 31538 ; checkout of the calculations performed in the efficiency code for a 31539 ; physical baud rate, if such a thing is ever seen again. 31540 31541 000250'01 dptybd: intern dptybd ; May be invoked as a test 31542 000250'01 265 16 0 00 003511' saveac ;Holds PTY particulars 31543 remark ; N.B., q4 and p1 are aliases!! 31544 31545 000251'01 403 05 0 00 000006 setzb q1, q2 ; No PTY or terminal JFN 31546 000252'01 403 07 0 00 000010 setzb q3, q4 ; No assigned PTY or TTY device 31547 000253'01 400 12 0 00 000013 setz p2, p3 ; No fork created 31548 31549 000254'01 260 17 0 00 000702' call comput ; Get correct byte pointer and count 31550 000255'01 260 17 0 00 000260' call ptyjfn ; Set JFN's to time a PTY: 31551 000256'01 254 00 0 00 001235' jrst epicom ; If failed, hit the epilogue 31552 000257'01 254 00 0 00 000715' callret tcommn ; Otherwise, hit the common code 31553 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 13 K20TIM MAC 9-Nov-23 15:10 Set up a PTY:/TTY: pair for transfer timing 31554 subttl Set up a PTY:/TTY: pair for transfer timing 31555 31556 ; +1/ Couldn't do it 31557 ; +2/ Worked 31558 ; 31559 ; q1/ Open PTY JFN and flags 31560 ; q2/ Open TTY JFN and flags 31561 ; q3/ Assigned PTY device 31562 ; q4/ Assigned TTY device 31563 31564 extern asipty ; Assign a pseudo-terminal 31565 extern ptynam,ttynam ; ASCII names of assigned devices 31566 extern asgflg ; Flag for assigned device 31567 extern asgdev ; Device actually assigned 31568 extern ndvchr ; Double word device characteristics 31569 extern ptytty ; PTY to TTY: line mapping 31570 extern ptyflg ; Using a pseudo-terminal 31571 extern binflg ; Device is in binary (8-bit) mode 31572 31573 000260'01 ptyjfn: remark ;Expects caller to have saved these 31574 remark ; N.B., q4 and p1 are aliases!! 31575 31576 000260'01 402 00 0 00 000000* setzm asgflg ; Force an assignment 31577 000261'01 260 17 0 00 000000* call asipty ; Grab us a PTY 31578 000262'01 263 17 0 00 000000 ret ; or not... 31579 000263'01 200 07 0 00 000002 move q3, t2 ; Store the returned PTY designator 31580 000264'01 505 01 0 00 600012 hrli t1,.dvdes+.dvtty ; Turn returned line into a TTY designator 31581 000265'01 104 00 0 00 000070 ASND% ; Grab associated terminal, too 31582 000266'01 320 12 0 00 000270' %jserr (,r) ; Odd, just got the PTY... 31583 000267'01 254 00 0 00 000273' 31584 000270'01 265 01 0 00 000000* 31585 000271'01 000000000000# 31586 000272'01 254 00 0 00 000000* 31587 000104'04 103 157 165 154 144 31588 000273'01 200 10 0 00 000001 move q4, t1 ; Store assigned terminal's device designator 31589 31590 remark ; PTY takes mode of TTY:, so open that first 31591 dmove t1, [ gj%sht!gj%flg ; Want GTJFN% flags returned 31592 000274'01 120 01 0 00 003525' -1,,ttynam ] ; asipty built this for us 31593 000275'01 104 00 0 00 000020 GTJFN% ; Try to get a JFN on the PTY's associated TTY 31594 000276'01 320 12 0 00 000300' %jserr (,r) 31595 000277'01 254 00 0 00 000303' 31596 000300'01 265 01 0 00 000270* 31597 000301'01 000000000000# 31598 000302'01 254 00 0 00 000272* 31599 000112'04 103 141 156 047 164 31600 000303'01 200 06 0 00 000001 move q2, t1 ; Store TTY JFN and flags 31601 000304'01 621 01 0 00 777777 tlz t1,-1 ; Whack flags so OPENF% doesn't choke 31602 000305'01 200 02 0 00 003527' movx t2, ; 8-bit bytes 31603 000306'01 335 03 0 00 000113* skipge t3, pars3 ; Load parsed OPENF% mode 31604 000307'01 254 00 0 00 000311' ifskp. ; User specified it, let's use it 31605 000310'01 137 03 0 00 003530' dpb t3, [pointr t2, of%mod] 31606 000311'01 endif. 31607 000311'01 337 04 0 00 000225* skipg t4, pars4 ; Load parsed OPENF% byte size 31608 000312'01 254 00 0 00 000314' ifskp. ; User specified it, let's use it K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 13-1 K20TIM MAC 9-Nov-23 15:10 Set up a PTY:/TTY: pair for transfer timing 31609 000313'01 137 04 0 00 003531' dpb t4, [pointr t2, of%bsz] 31610 000314'01 endif. 31611 000314'01 104 00 0 00 000021 OPENF% ; read-only 31612 000315'01 320 12 0 00 000317' %jserr (,r) 31613 000316'01 254 00 0 00 000322' 31614 000317'01 265 01 0 00 000300* 31615 000320'01 000000000000# 31616 000321'01 254 00 0 00 000302* 31617 000120'04 103 141 156 047 164 31618 31619 dmove t1, [ gj%sht!gj%flg ; Want GTJFN% flags returned 31620 000322'01 120 01 0 00 003532' -1,,ptynam ] ; asipty built this for us 31621 000323'01 104 00 0 00 000020 GTJFN% ; Try to get a JFN on the PTY 31622 000324'01 320 12 0 00 000326' %jserr (,r) 31623 000325'01 254 00 0 00 000331' 31624 000326'01 265 01 0 00 000317* 31625 000327'01 000000000000# 31626 000330'01 254 00 0 00 000321* 31627 000126'04 103 141 156 047 164 31628 000331'01 200 05 0 00 000001 move q1, t1 ; Store PTY JFN and flags 31629 000332'01 621 01 0 00 777777 tlz t1,-1 ; Whack flags so OPENF% doesn't choke 31630 000333'01 200 02 0 00 003534' movx t2, ; 8-bit bytes 31631 remark of%mod ; PTY itself *ONLY* supports normal mode 31632 000334'01 337 04 0 00 000311* skipg t4, pars4 ; Load parsed OPENF% byte size 31633 000335'01 254 00 0 00 000337' ifskp. ; User specified it, let's use it 31634 000336'01 137 04 0 00 003531' dpb t4, [pointr t2, of%bsz] 31635 000337'01 endif. 31636 000337'01 104 00 0 00 000021 OPENF% ; normal mode (only one supported), write-only 31637 000340'01 320 12 0 00 000342' %jserr (,r) 31638 000341'01 254 00 0 00 000345' 31639 000342'01 265 01 0 00 000326* 31640 000343'01 000000000000# 31641 000344'01 254 00 0 00 000330* 31642 000136'04 103 141 156 047 164 31643 31644 000345'01 254 00 0 00 000000* retskp ; Return success 31645 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 14 K20TIM MAC 9-Nov-23 15:10 Determine PIP: Virtual Baud Rate 31646 subttl Determine PIP: Virtual Baud Rate 31647 31648 ; N.B., this code is not intended to provide a definitive answer to 31649 ; ANYTHING because Tops-20 is not a real-time system. Even a speck 31650 ; of system load can wildly peturb the results as well as whatever the 31651 ; current monitor's pipe implementation happens to be. 31652 ; 31653 ; See dptybd for more extensive commentary 31654 31655 000346'01 dpipbd: intern dpipbd ; May be invoked as a test 31656 000346'01 265 16 0 00 003511' saveac ;Holds pipe particulars 31657 remark ; N.B., q4 and p1 are aliases!! 31658 31659 000347'01 403 05 0 00 000006 setzb q1, q2 ; No source or destination PIP: JFN 31660 000350'01 403 07 0 00 000010 setzb q3, q4 ; No assigned PIP: device 31661 000351'01 400 12 0 00 000013 setz p2, p3 ; No fork created 31662 31663 000352'01 260 17 0 00 000702' call comput ; Get correct byte pointer and count 31664 000353'01 260 17 0 00 000356' call pipjfn ; Set JFN's to time a PIP: device 31665 000354'01 254 00 0 00 001235' jrst epicom ; If failed, hit the epilogue 31666 000355'01 254 00 0 00 000715' callret tcommn ; Worked, hit the common code 31667 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 15 K20TIM MAC 9-Nov-23 15:10 Set up a PIP: pair for transfer timing 31668 subttl Set up a PIP: pair for transfer timing 31669 31670 ; +1/ Couldn't do it 31671 ; +2/ Worked 31672 ; 31673 ; q1/ Open write PIP: JFN and flags 31674 ; q2/ Open read PIP: JFN and flags 31675 ; q3/ Zero (no assigned write device) 31676 ; q4/ Zero (assigned read device) 31677 31678 ; N.B., Can't use ";RECORD-SIZE:500" attribute. Broken. 31679 ; Proper format is RECORD-LENGTH 31680 31681 chgsec(code,data) ;;Needs some storage 31682 000000'05 pipnam: block ^d20 ; Space to build name 31683 000024'05 pip2nd: block 4 ; Space for 19 characters, plus nul 31684 retsec ;;Get out of data psect 31685 31686 chgsec(code,text) ;;Put strings into text psect 31687 000140'03 120 111 120 072 056 pip1st: ASCIZ /PIP:.;RECORD-LENGTH:/ ; From PIPE.MAC (N.B., NOT RECORD-SIZE!) 31688 remark 12345678901234567890 ; Four words of storage 31689 retsec ;;Back in code psect 31690 31691 remark pars3 ; OPENF% mode 31692 remark pars4 ; OPENF% byte size 31693 remark pars5 ; Buffer size (RECORD-LENGTH) 31694 31695 000356'01 pipjfn: remark ;Expects caller to have saved these 31696 remark ; N.B., q4 and p1 are aliases!! 31697 31698 remark q1, q2, q3, q4 ; Assumes all zero 31699 31700 000356'01 333 02 0 00 000123* skiple t2, pars5 ; See if we have a record length 31701 000357'01 254 00 0 00 000364' ifskp. ; We don't 31702 000360'01 200 03 0 00 000000# move t3, pip1st ; Pick up first five characters (nice hack, Tom) 31703 000361'01 400 04 0 00 000000 setz t4, ; Tie off with .chnul's 31704 000362'01 124 03 0 00 000000# dmovem t3, pipnam ; Stomp into the file specification 31705 000363'01 254 00 0 00 000401' else. ; Otherwise, wants to specify it 31706 000364'01 120 03 0 00 000000# dmove t3, pip1st ; Get the first ten characters 31707 000365'01 124 03 0 00 000000# dmovem t3, pipnam ; Store them 31708 000366'01 120 03 0 00 000000# dmove t3, pip1st+2 ; Get the second ten characters 31709 000367'01 124 03 0 00 000000# dmovem t3, pipnam+2 ; Store them 31710 000370'01 402 00 0 00 000000# setzm pipnam+4 ; Tie off the string 31711 000371'01 561 01 0 00 000000# hrroi t1, ; Puts the decimal number after the colon 31712 000372'01 201 03 0 00 000012 movei t3, ^d10 ; RECORD-LENGTH number is decimal 31713 000373'01 104 00 0 00 000224 NOUT% ; Tack it on to the end 31714 000374'01 320 12 0 00 000376' %jserr (,r) 31715 000375'01 254 00 0 00 000401' 31716 000376'01 265 01 0 00 000342* 31717 000377'01 000000000000# 31718 000400'01 254 00 0 00 000344* 31719 000146'04 103 141 156 047 164 31720 000401'01 endif. 31721 31722 dmove t1,[gj%sht!gj%flg ; Want GTJFN% flags returned K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 15-1 K20TIM MAC 9-Nov-23 15:10 Set up a PIP: pair for transfer timing 31723 000401'01 120 01 0 00 003535' -1,,pipnam ] ; PIP:'s odd syntax 31724 000402'01 104 00 0 00 000020 GTJFN% ; Try to get a JFN on the pipe 31725 000403'01 320 12 0 00 000405' %jserr (,r) 31726 000404'01 254 00 0 00 000410' 31727 000405'01 265 01 0 00 000376* 31728 000406'01 000000000000# 31729 000407'01 254 00 0 00 000400* 31730 000161'04 103 141 156 047 164 31731 000410'01 200 05 0 00 000001 move q1, t1 ; Store first PIP: JFN and flags 31732 31733 000411'01 403 01 0 00 000002 setzb t1, t2 ; Cons up ten .CHNUL's 31734 000412'01 124 01 0 00 000000# dmovem t1, pip2nd+0 ; Whack all the storage 31735 000413'01 124 01 0 00 000000# dmovem t1, pip2nd+2 ; where we'll write more odd syntax 31736 31737 000414'01 561 01 0 00 000000# hrroi t1, pip2nd ; Point to area for JFNS% 31738 000415'01 550 02 0 00 000005 hrrz t2, q1 ; Load our odd first PIP: JFN 31739 dmove t3, [fld(.jsaof,js%dev)!fld(.jsaof,js%nam)!js%paf 31740 000416'01 120 03 0 00 003537' 0 ] ; No strange prefix (whatever that is) 31741 000417'01 104 00 0 00 000030 JFNS% ; Build first part of strange string 31742 000420'01 320 12 0 00 000422' %jserr(,r) 31743 000421'01 254 00 0 00 000425' 31744 000422'01 265 01 0 00 000405* 31745 000423'01 000000000000# 31746 000424'01 254 00 0 00 000407* 31747 000171'04 103 157 165 154 144 31748 000425'01 201 02 0 00 000056 movx t2, "." ; Load a dot 31749 000426'01 136 02 0 00 000001 idpb t2, t1 ; Punctuate the file type 31750 000427'01 550 02 0 00 000005 hrrz t2, q1 ; Load our odd first PIP: JFN 31751 000430'01 205 03 0 00 001000 movx t3, ; File type is the same as the name 31752 000431'01 104 00 0 00 000030 JFNS% ; Build second part of strange string 31753 000432'01 320 12 0 00 000434' %jserr(,r) 31754 000433'01 254 00 0 00 000437' 31755 000434'01 265 01 0 00 000422* 31756 000435'01 000000000000# 31757 000436'01 254 00 0 00 000424* 31758 000205'04 103 157 165 154 144 31759 31760 dmove t1, [ gj%sht!gj%flg ; Want GTJFN% flags returned 31761 000437'01 120 01 0 00 003541' -1,,pip2nd ] ; PIP:'s odd syntax 31762 000440'01 104 00 0 00 000020 GTJFN% ; Try to get a JFN on the PTY 31763 000441'01 320 12 0 00 000443' %jserr (,r) 31764 000442'01 254 00 0 00 000446' 31765 000443'01 265 01 0 00 000434* 31766 000444'01 000000000000# 31767 000445'01 254 00 0 00 000436* 31768 000221'04 103 141 156 047 164 31769 000446'01 200 06 0 00 000001 move q2, t1 ; Store 2nd PIP: JFN and flags 31770 31771 000447'01 550 01 0 00 000005 hrrz t1, q1 ; Load write JFN without flags 31772 000450'01 200 02 0 00 003534' movx t2, ; 8-bit bytes 31773 000451'01 335 03 0 00 000306* skipge t3, pars3 ; Load parsed OPENF% mode 31774 000452'01 254 00 0 00 000454' ifskp. ; User specified it, let's use it 31775 000453'01 137 03 0 00 003530' dpb t3, [pointr t2, of%mod] 31776 000454'01 endif. 31777 000454'01 337 04 0 00 000334* skipg t4, pars4 ; Load parsed OPENF% byte size K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 15-2 K20TIM MAC 9-Nov-23 15:10 Set up a PIP: pair for transfer timing 31778 000455'01 254 00 0 00 000457' ifskp. ; User specified it, let's use it 31779 000456'01 137 04 0 00 003531' dpb t4, [pointr t2, of%bsz] 31780 000457'01 endif. 31781 000457'01 104 00 0 00 000021 OPENF% ; N.B., source JFN is write-only 31782 000460'01 320 12 0 00 000462' %jserr (,r) 31783 000461'01 254 00 0 00 000465' 31784 000462'01 265 01 0 00 000443* 31785 000463'01 000000000000# 31786 000464'01 254 00 0 00 000445* 31787 000231'04 103 141 156 047 164 31788 000465'01 550 01 0 00 000006 hrrz t1, q2 ; Load read JFN without flags 31789 000466'01 200 02 0 00 003543' movx t2, ; 8-bit bytes 31790 000467'01 335 03 0 00 000451* skipge t3, pars3 ; Load parsed OPENF% mode 31791 000470'01 254 00 0 00 000472' ifskp. ; User specified it, let's use it 31792 000471'01 137 03 0 00 003530' dpb t3, [pointr t2, of%mod] 31793 000472'01 endif. 31794 000472'01 337 04 0 00 000454* skipg t4, pars4 ; Load parsed OPENF% byte size 31795 000473'01 254 00 0 00 000475' ifskp. ; User specified it, let's use it 31796 000474'01 137 04 0 00 003531' dpb t4, [pointr t2, of%bsz] 31797 000475'01 endif. 31798 000475'01 104 00 0 00 000021 OPENF% ; Normal mode, read-only 31799 000476'01 320 12 0 00 000500' %jserr (,r) 31800 000477'01 254 00 0 00 000503' 31801 000500'01 265 01 0 00 000462* 31802 000501'01 000000000000# 31803 000502'01 254 00 0 00 000464* 31804 000240'04 103 141 156 047 164 31805 31806 000503'01 254 00 0 00 000345* retskp ; Return success 31807 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 16 K20TIM MAC 9-Nov-23 15:10 Determine SRV: Virtual Baud Rate 31808 subttl Determine SRV: Virtual Baud Rate 31809 31810 ; N.B., this code is not intended to provide a definitive answer to 31811 ; ANYTHING because Tops-20 is not a real-time system. Even a speck 31812 ; of system load can wildly peturb the results as well as whatever the 31813 ; current monitor's DECnet implementation happens to be. 31814 ; 31815 ; It is not going over ANY hardware network interface; traffic is 31816 ; purely inside of Tops-20. 31817 ; 31818 ; See dptybd for more extensive commentary 31819 31820 000504'01 dsrvbd: intern dsrvbd ; May be invoked as a test 31821 000504'01 265 16 0 00 003511' saveac ;Holds DECnet particulars 31822 remark ; N.B., q4 and p1 are aliases!! 31823 31824 000505'01 403 05 0 00 000006 setzb q1, q2 ; No DCN: or SRV: JFN 31825 000506'01 403 07 0 00 000010 setzb q3, q4 ; No assigned DCN: or SRV: device 31826 000507'01 400 12 0 00 000013 setz p2, p3 ; No fork created 31827 31828 000510'01 260 17 0 00 000702' call comput ; Get correct byte pointer and count 31829 000511'01 260 17 0 00 000514' call srvdcn ; Set JFN's to time a DCN:-SRV: device pair 31830 000512'01 254 00 0 00 001235' jrst epicom ; If failed, hit the epilogue 31831 000513'01 254 00 0 00 000715' callret tcommn ; Worked, hit the common code 31832 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 17 K20TIM MAC 9-Nov-23 15:10 Acquire a JFN on a DCN:/SRV: pair 31833 subttl Acquire a JFN on a DCN:/SRV: pair 31834 31835 remark Storage area and string components 31836 31837 chgsec(code,text) ;;Put these in program text strings 31838 000145'03 123 122 126 072 056 srvnam: asciz "SRV:.KERMIT-TIMING" ; Task is Kermit Timing service 31839 000151'03 113 145 162 155 151 srvmsg: asciz "Kermit-20: Ready" 31840 000155'03 055 124 101 123 113 dcntsk: asciz "-TASK-KERMIT-TIMING;USER:" 31841 000163'03 073 104 101 124 101 dcndat: asciz ";DATA:" ; Gets HPTIM% ticks as ASCII 31842 retsec ;;Done with read-only text strings 31843 31844 chgsec(code,const) ;;Read-Only pointers are constant data 31845 000137'02 44 07 0 00 000000# srvacc: point 7, srvmsg ; Acknowledgement message 31846 000140'02 000000 000020 srvlen: ^d16 ;;And its length 31847 retsec 31848 31849 chgsec(code,data) ;;Need some writable storage 31850 000030'05 whoami: block 1 ; Currently signed in user number 31851 intern whoami ; START: in k20mit populates this 31852 000031'05 tsktim: block 1 ; HPTIM% value (max 27487790694) 31853 000032'05 dcname: Block ^d20 ; Space for 100 characters 31854 retsec ;;Back to generating executable code 31855 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 18 K20TIM MAC 9-Nov-23 15:10 Acquire a JFN on a DCN:/SRV: pair 31856 remark Code to get and open the JFN's 31857 31858 000514'01 srvdcn: remark ; First, must get SRV: JFN 31859 dmove t1, [ gj%sht!gj%flg ; Want GTJFN% flags returned 31860 000514'01 120 01 0 00 003544' -1,,srvnam ] ; 31861 000515'01 104 00 0 00 000020 GTJFN% ; Try to get a JFN on the passive component 31862 000516'01 320 12 0 00 000520' %jserr (,r) 31863 000517'01 254 00 0 00 000523' 31864 000520'01 265 01 0 00 000500* 31865 000521'01 000000000000# 31866 000522'01 254 00 0 00 000502* 31867 000247'04 103 157 165 154 144 31868 000523'01 200 06 0 00 000001 move q2, t1 ; Store SRV: JFN and flags 31869 000524'01 621 01 0 00 777777 tlz t1,-1 ; Whack flags so OPENF% doesn't choke 31870 000525'01 200 02 0 00 003543' movx t2, ; 8-bit bytes 31871 000526'01 335 03 0 00 000467* skipge t3, pars3 ; Load parsed OPENF% mode 31872 000527'01 254 00 0 00 000531' ifskp. ; User specified it, let's use it 31873 000530'01 137 03 0 00 003530' dpb t3, [pointr t2, of%mod] 31874 000531'01 endif. 31875 000531'01 337 04 0 00 000472* skipg t4, pars4 ; Load parsed OPENF% byte size 31876 000532'01 254 00 0 00 000534' ifskp. ; User specified it, let's use it 31877 000533'01 137 04 0 00 003531' dpb t4, [pointr t2, of%bsz] 31878 000534'01 endif. 31879 000534'01 104 00 0 00 000021 OPENF% ; normal mode, read-only 31880 000535'01 320 12 0 00 000537' %jserr (,r) 31881 000536'01 254 00 0 00 000542' 31882 000537'01 265 01 0 00 000520* 31883 000540'01 000000000000# 31884 000541'01 254 00 0 00 000522* 31885 000263'04 103 157 165 154 144 31886 31887 000542'01 260 17 0 00 000604' call bldcnt ; Build the (hairy) DCN: task name to SRV: 31888 000543'01 263 17 0 00 000000 ret ; But falled?? 31889 31890 dmove t1, [ gj%sht!gj%flg ; Want GTJFN% flags returned 31891 000544'01 120 01 0 00 003546' -1,,dcname ] ; 31892 000545'01 104 00 0 00 000020 GTJFN% ; Try to get a JFN on the PTY 31893 000546'01 320 12 0 00 000550' %jserr (,r) 31894 000547'01 254 00 0 00 000553' 31895 000550'01 265 01 0 00 000537* 31896 000551'01 000000000000# 31897 000552'01 254 00 0 00 000541* 31898 000275'04 103 157 165 154 144 31899 000553'01 200 05 0 00 000001 move q1, t1 ; Store DCN: JFN and flags 31900 000554'01 621 01 0 00 777777 tlz t1,-1 ; Whack flags so OPENF% doesn't choke 31901 000555'01 200 02 0 00 003534' movx t2, ; 8-bit bytes 31902 000556'01 335 03 0 00 000526* skipge t3, pars3 ; Load parsed OPENF% mode 31903 000557'01 254 00 0 00 000561' ifskp. ; User specified it, let's use it 31904 000560'01 137 03 0 00 003530' dpb t3, [pointr t2, of%mod] 31905 000561'01 endif. 31906 000561'01 337 04 0 00 000531* skipg t4, pars4 ; Load parsed OPENF% byte size 31907 000562'01 254 00 0 00 000564' ifskp. ; User specified it, let's use it 31908 000563'01 137 04 0 00 003531' dpb t4, [pointr t2, of%bsz] 31909 000564'01 endif. 31910 000564'01 104 00 0 00 000021 OPENF% ; normal mode, write-only K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 18-1 K20TIM MAC 9-Nov-23 15:10 Acquire a JFN on a DCN:/SRV: pair 31911 000565'01 320 12 0 00 000567' %jserr (,r) 31912 000566'01 254 00 0 00 000572' 31913 000567'01 265 01 0 00 000550* 31914 000570'01 000000000000# 31915 000571'01 254 00 0 00 000552* 31916 000311'04 103 157 165 154 144 31917 31918 000572'01 550 01 0 00 000006 hrrz t1, q2 ; Load server JFN 31919 000573'01 201 02 0 00 000041 movx t2, .mocc ; Explicitly accept the DCN: 31920 000574'01 120 03 0 00 000000# dmove t3, srvacc ; And the acknowledgement message 31921 000575'01 104 00 0 00 000077 MTOPR% ; Finish the connection negotiation 31922 000576'01 320 12 0 00 000600' %jserr (,r) 31923 000577'01 254 00 0 00 000603' 31924 000600'01 265 01 0 00 000567* 31925 000601'01 000000000000# 31926 000602'01 254 00 0 00 000571* 31927 000323'04 103 157 165 154 144 31928 31929 000603'01 254 00 0 00 000503* retskp 31930 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 19 K20TIM MAC 9-Nov-23 15:10 Build cooresponding DCN: task name to SRV: 31931 subttl Build cooresponding DCN: task name to SRV: 31932 31933 ; N.B., the DCN string is a little convoluted, but it is generalized 31934 ; enough so that we could run tests between Tops-20 nodes, should we 31935 ; want to try that. 31936 31937 extern myname ; Name of local executor 31938 31939 000604'01 bldcnt: remark Means: BuiLd DCN Text 31940 000604'01 200 01 0 00 003550' move t1, [ BYTE (7) "D", "C", "N", ":", .chnul] 31941 000605'01 202 01 0 00 000000# movem t1, dcname ; Start device portion immediately 31942 000606'01 200 01 0 00 003551' move t1, [ point 7, dcname, 27 ] ; point before the .chnul 31943 31944 remark ; Could drop in /REMOTE:NODE here 31945 000607'01 336 00 0 00 000000* ifmn. myname ; Did we ever figure our local node name out? 31946 000610'01 254 00 0 00 000616' 31947 000611'01 200 02 0 00 003552' move t2, [ point 7,myname ] ; We did, so drop that in 31948 000612'01 do. ; Enter loop context 31949 000612'01 134 03 0 00 000002 ildb t3, t2 ; Pick a byte of the node name 31950 000613'01 322 03 0 00 000616' jumpe t3, endlp. ; Unless we've done all of it 31951 000614'01 136 03 0 00 000001 idpb t3, t1 ; Append to active component device 31952 000615'01 254 00 0 00 000612' loop. ; Get some more, wee!! 31953 000616'01 enddo. ; Exit loop context 31954 000616'01 endif. 31955 31956 000616'01 200 02 0 00 003553' move t2, [ point 7, dcntsk ] 31957 000617'01 do. ; Append the rest of the DECnet task gibberish 31958 000617'01 134 03 0 00 000002 ildb t3, t2 ; Pick a byte of the node name 31959 000620'01 322 03 0 00 000623' jumpe t3, endlp. ; Unless we've done all of it 31960 000621'01 136 03 0 00 000001 idpb t3, t1 ; Append to active component device 31961 000622'01 254 00 0 00 000617' loop. ; Get some more, wee!! 31962 000623'01 enddo. 31963 31964 000623'01 200 02 0 00 000000# move t2, whoami ; Load my user number 31965 000624'01 104 00 0 00 000041 DIRST% ; Tack that on after 31966 000625'01 320 12 0 00 000627' %jserr (,r) 31967 000626'01 254 00 0 00 000632' 31968 000627'01 265 01 0 00 000600* 31969 000630'01 000000000000# 31970 000631'01 254 00 0 00 000602* 31971 000337'04 106 141 151 154 145 31972 31973 000632'01 200 02 0 00 003554' move t2, [ point 7, dcndat ] 31974 000633'01 do. ; Append the ;DATA: attribute 31975 000633'01 134 03 0 00 000002 ildb t3, t2 ; Pick a byte of the node name 31976 000634'01 322 03 0 00 000637' jumpe t3, endlp. ; Unless we've done all of it 31977 000635'01 136 03 0 00 000001 idpb t3, t1 ; Append to active component device 31978 000636'01 254 00 0 00 000633' loop. ; Get some more, wee!! 31979 000637'01 enddo. 31980 31981 000637'01 200 04 0 00 000001 move t4, t1 ; Save output pointer 31982 000640'01 201 01 0 00 000000 movei t1, .HPELP ; Elapsed DK10 ticks since start 31983 000641'01 104 00 0 00 000501 HPTIM% ; Grab it 31984 000642'01 320 12 0 00 000644' %jserr (,r) 31985 000643'01 254 00 0 00 000647' K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 19-1 K20TIM MAC 9-Nov-23 15:10 Build cooresponding DCN: task name to SRV: 31986 000644'01 265 01 0 00 000627* 31987 000645'01 000000000000# 31988 000646'01 254 00 0 00 000631* 31989 000351'04 125 156 141 142 154 31990 000647'01 202 01 0 00 000000# movem t1, tsktim ; Store as task time (for ;DATA:) 31991 31992 000650'01 200 02 0 00 000001 move t2, t1 ; Position uptime ticks 31993 000651'01 200 01 0 00 000004 move t1, t4 ; Reload output pointer 31994 000652'01 201 03 0 00 000012 movx t3, fld(^d10,no%rdx) ; 31995 000653'01 104 00 0 00 000224 NOUT% ; Tack that on 31996 000654'01 320 12 0 00 000656' %jserr (,r) 31997 000655'01 254 00 0 00 000661' 31998 000656'01 265 01 0 00 000644* 31999 000657'01 000000000000# 32000 000660'01 254 00 0 00 000646* 32001 000363'04 125 156 141 142 154 32002 32003 000661'01 254 00 0 00 000603* retskp ; Finally won 32004 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 20 K20TIM MAC 9-Nov-23 15:10 Device speed determination storage 32005 subttl Device speed determination storage 32006 32007 .endps code ; Get out of the code .psect 32008 .psect devtim/ronly,devorg; psect for reading and writing for timing 32009 32010 000000'06 devwrt: remark ; Where data will be written from 32011 000000' nulwrt==:devwrt ; Ditto for special case NUL: 32012 000000 $d$=.chnul ; Generated data starts at NUL 32013 000000 $c$=0 ; Rotating check digit starts at zero 32014 xlist ; Don't need silly listing 32015 list ; Turn listing back on 32016 001000 devwrd==.-devwrt ; Device words to write 32017 004000 devchr==devwrd*4 ; Corresponding 8 bit character count 32018 cleans(<$d$,$c$>) ; Chuck worker symbols 32019 32020 ; N.B., The below is a bit of a hack because the page won't exist, which 32021 ; means we can then create it and write it. Heh... 32022 32023 001000'06 devred: block ^d512 ; Where data will be read into 32024 002000'06 devdat: block ^d512 ; Additional data for NUL: timing 32025 003000'06 devda2: block ^d512 ; 2nd part of it 32026 .endps devtim ; End of timing .psect 32027 32028 .psect code ; Get back into code .psect 32029 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 21 K20TIM MAC 9-Nov-23 15:10 Device inferior fork timing code and storage 32030 subttl Device inferior fork timing code and storage 32031 32032 chgsec(code,data) ;;Inferior's storage 32033 000056'05 000000 000011 devpdl: devhlt ; Return to our HALTF% 32034 000057'05 block ^d19 ; Rest of inferior's stack 32035 000024 devstg==.-devpdl ; Length of inferior's storage 32036 retsec ; Back in code segment 32037 32038 ; Inferior code is in the AC's because I thought I was going to have a 32039 ; very restricted address space there. This is not possible because 32040 ; of the need to call the timing ending routine and catch its errors. 32041 ; 32042 ; Note, superior does a SOUTR% to force a 'push'; the inferior also 32043 ; does a SINR% because it appears to be SLIGHTLY faster. 32044 32045 000662' devcod=: . ; Inferior's code 32046 000000 phase 0 ; Inferior's program 32047 000000 44 10 0 00 000000# point 8,devred ; ac0/ Where we're reading to 32048 000001 000000 400000 .fhslf ; 1 t1/ This fork 32049 000002 000000 601405 lstrx1 ; 2 t2/ "Process has not encountered any errors" 32050 000003 777777 774000 - ; 3 t3/ length of data being read 32051 000004 000000 000000 0 ; 4 t4/ Stop on .chnul (ignored) 32052 000005 104 00 0 00 000147 devinf: RESET% ; 5 q1/ Inferior start up 32053 000006 320 12 0 00 000011 erjmpr devhlt ; 6 q2/ Handle any error by just stopping 32054 000007 104 00 0 00 000336 SETER% ; 7 q3/ Otherwise flag everything worked 32055 000010 320 12 0 00 000011 erjmpr devhlt ; 10 q4/ Shouldn't ever break ... 32056 000011 104 00 0 00 000170 devhlt: HALTF% ; 11 p2/ Completed initialization 32057 000012 201 01 0 00 000100 movei t1, .priin ; 12 p3/ Set by superior 32058 000013 200 02 0 00 000000 move t2, 0 ; 13 p4/ Load pointer 32059 000014 104 00 0 00 000052 SIN% ; 14 p5/ Do a counted read 32060 000015 320 12 0 00 000011 erjmpr devhlt ; 15 .fp/ Handle the error 32061 000016 254 00 0 00 002050' callret endtim ; 16 cx/ Finish the timing 32062 000017 777755 000000# -^d19,,devpdl ; p/ stack (17) 32063 32064 000702'01 dephase ; Restore normal location counter 32065 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 22 K20TIM MAC 9-Nov-23 15:10 Timing common storage 32066 subttl Timing common storage 32067 32068 chgsec(code,data) ;;Writeable storage for data transfer 32069 000102'05 timdev:: block 1 ; Device being timed 32070 000103'05 devacs: block ^d16 ; Timing fork AC's 32071 000123'05 chrptr: block 1 ;*** DO NOT ; Left halfword of section local pointer 32072 000124'05 chrcnt: block 1 ;REORDER ** ; Character count in current byte size 32073 retsec 32074 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 23 K20TIM MAC 9-Nov-23 15:10 Computer character pointer and counter construction 32075 subttl Computer character pointer and counter construction 32076 32077 ; Note, PTYLEN is the number of words in a single page and is common 32078 ; for all devices. 32079 32080 000702'01 333 04 0 00 000561* comput: skiple t4, pars4 ; Pick up byte size for SOUTR% 32081 000703'01 254 00 0 00 000706' ifskp. ; Was anything specifed? 32082 dmove t2,[ ; No, use defaults 32083 point 8,0 ; Using 8 bit bits 32084 000704'01 120 02 0 00 003555' - ] ; Number of characters in the single page 32085 000705'01 254 00 0 00 000713' else. ; Otherwise, need to do some coversions 32086 000706'01 120 02 0 00 003557' dmove t2,[exp -1,-^d36] ;Load double negative integer 36 32087 000707'01 234 02 0 00 000004 div t2, t4 ; Calculate bytes per word 32088 000710'01 225 02 0 00 001000 muli t2, ptylen ; Now have total bytes we'll do in t3 32089 000711'01 205 02 0 00 440000 movx t2, ; Set up for an ILDB at bit '36' 32090 000712'01 137 04 0 00 003561' dpb t4, [ pointr t2, sbyte ] ; Drop in the byte size 32091 000713'01 endif. ; End non-standard byte size 32092 32093 000713'01 124 02 0 00 000000# dmovem t2, chrptr ; Store pointer prototype and count 32094 000714'01 263 17 0 00 000000 ret 32095 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 24 K20TIM MAC 9-Nov-23 15:10 Multi-fork timing common code 32096 subttl Multi-fork timing common code 32097 32098 ; See commentary on timing PTY virtual baud rate. These numbers are 32099 ; only used to validate the granularity of regular transfers 32100 32101 extern frclose ; Force a JFN closed 32102 extern cmprmn ; cmpse in k20ioc 32103 32104 000715'01 tcommn: remark ; Assumes these are saved 32105 remark ; N.B., q4 and p1 are aliases!! 32106 32107 000715'01 400 12 0 00 000000 setz p2, ;[223] No inferior fork yet 32108 000716'01 260 17 0 00 001601' call parset ;[223] Set up parity, if doing parity 32109 000717'01 254 00 0 00 001235' jrst epicom ;[223] Beat it, we've got to fix our tables 32110 32111 000720'01 201 01 0 00 000020 movx t1, ^d16 ; Transferring 16 accumulators 32112 dmove t2, [ devcod ; Source is device code 32113 000721'01 120 02 0 00 003562' devacs ] ; Destination is writable storage 32114 000722'01 123 01 0 00 003564' xblt. t1 ; Transfer so we can modify it 32115 32116 000723'01 201 03 0 00 000000# movei t3, devacs ; Resolve address of writable AC's 32117 000724'01 120 01 0 00 000000# dmove t1, chrptr ; Load byte pointer prototype and count 32118 000725'01 502 01 0 03 000000 hllm t1, 0(t3) ; Tweak byte size and pointer 32119 000726'01 202 02 0 03 000003 movem t2, t3(t3) ; Put the correct count in 32120 32121 remark ; N.B., cr%map makes a real gross page map, sigh. 32122 dmove t1, [ cr%map!cr%acs!cr%st!fld(devinf,cr%pcv) 32123 000727'01 120 01 0 00 003565' devacs ] ; Set AC's to have device inferior code 32124 000730'01 104 00 0 00 000152 CFORK% ; Make me a fork (poof! You're a fork) 32125 000731'01 320 12 0 00 000733' %jserr (,epicom) 32126 000732'01 254 00 0 00 000736' 32127 000733'01 265 01 0 00 000656* 32128 000734'01 000000000000# 32129 000735'01 254 00 0 00 001235' 32130 000375'04 103 157 165 154 144 32131 000736'01 200 12 0 00 000001 move p2, t1 ; store inferior handle 32132 32133 000737'01 200 01 0 00 000012 move t1, p2 ; Load inferior's handle 32134 000740'01 104 00 0 00 000163 WFORK% ; Wait for inferior initialization completion 32135 000741'01 320 12 0 00 000743' %jserr(, epicom) 32136 000742'01 254 00 0 00 000746' 32137 000743'01 265 01 0 00 000733* 32138 000744'01 000000000000# 32139 000745'01 254 00 0 00 001235' 32140 000403'04 125 156 141 142 154 32141 000746'01 104 00 0 00 000012 GETER% ; Find out inferior's last error 32142 000747'01 320 12 0 00 000751' %jserr(, epicom) 32143 000750'01 254 00 0 00 000754' 32144 000751'01 265 01 0 00 000743* 32145 000752'01 000000000000# 32146 000753'01 254 00 0 00 001235' 32147 000416'04 125 156 141 142 154 32148 000754'01 621 02 0 00 777777 tlz t2, -1 ; Stomp silly fork handle 32149 000755'01 306 02 0 00 601405 cain t2, lstrx1 ; Everything's Archie, right? 32150 000756'01 254 00 0 00 000766' ifskp. ; It isn't, so complain K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 24-1 K20TIM MAC 9-Nov-23 15:10 Multi-fork timing common code 32151 000757'01 201 01 0 00 400000 movei t1, .fhslf ; Set our last error to inferior's 32152 000760'01 104 00 0 00 000336 SETER% ; So diagnostic message is more meaningful 32153 000761'01 334 00 0 00 000000 %ermsg(,epicom) 32154 000762'01 254 00 0 00 000766' 32155 000763'01 265 01 0 00 000751* 32156 000764'01 000000000000# 32157 000765'01 254 00 0 00 001235' 32158 000430'04 111 156 146 145 162 32159 000766'01 endif. 32160 32161 remark t1, .fhinf ; Still has the fork handle 32162 000766'01 514 02 0 00 000006 hrlz t2, q2 ; Load PTY's TTY JFN as inferior's primary input 32163 000767'01 541 02 0 00 777777 hrri t2, .cttrm ; But it can still write to our terminal 32164 000770'01 104 00 0 00 000207 SPJFN% ; Set it so SINR% doesn't break 32165 000771'01 320 12 0 00 000773' %jserr(, epicom) 32166 000772'01 254 00 0 00 000776' 32167 000773'01 265 01 0 00 000763* 32168 000774'01 000000000000# 32169 000775'01 254 00 0 00 001235' 32170 000441'04 125 156 141 142 154 32171 000776'01 416 00 0 00 000000# setmm devred ; Create reading page, so not creation time charge 32172 000777'01 661 01 0 00 400000 txo t1, sf%con ; Continuing inferior 32173 001000'01 104 00 0 00 000157 SFORK% ; Get it started in its read 32174 001001'01 320 12 0 00 001003' %jserr(, epicom) 32175 001002'01 254 00 0 00 001006' 32176 001003'01 265 01 0 00 000773* 32177 001004'01 000000000000# 32178 001005'01 254 00 0 00 001235' 32179 000451'04 125 156 141 142 154 32180 32181 001006'01 621 01 0 00 400000 txz t1, sf%con ; Get a clean fork handle 32182 001007'01 201 02 0 00 000000# movei t2, devacs ; Load address of inferior AC block 32183 dmove t3, [ lstrx1 ; What indicates it isn't in SINR%, yet 32184 001010'01 120 03 0 00 003567' ^d20 ] ; Only wait 5 seconds (.25 * 20) 32185 32186 001011'01 do. ; Enter inferior fork check loop context 32187 001011'01 104 00 0 00 000154 FFORK% ; Freeze inferor (so we can read its AC's) 32188 001012'01 320 12 0 00 001014' %jserr (,epicom) 32189 001013'01 254 00 0 00 001017' 32190 001014'01 265 01 0 00 001003* 32191 001015'01 000000000000# 32192 001016'01 254 00 0 00 001235' 32193 000461'04 125 156 141 142 154 32194 001017'01 104 00 0 00 000161 RFACS% ; Read inferior's accumulators 32195 001020'01 320 12 0 00 001022' %jserr (,epicom) 32196 001021'01 254 00 0 00 001025' 32197 001022'01 265 01 0 00 001014* 32198 001023'01 000000000000# 32199 001024'01 254 00 0 00 001235' 32200 000467'04 125 156 141 142 154 32201 001025'01 104 00 0 00 000155 RFORK% ; And resume the fork 32202 001026'01 320 12 0 00 001030' %jserr (,epicom) 32203 001027'01 254 00 0 00 001033' 32204 001030'01 265 01 0 00 001022* 32205 001031'01 000000000000# K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 24-2 K20TIM MAC 9-Nov-23 15:10 Multi-fork timing common code 32206 001032'01 254 00 0 00 001235' 32207 000477'04 125 156 141 142 154 32208 001033'01 312 03 0 02 000002 came t3, t2(t2) ; Not in the SINR% yet? 32209 001034'01 254 00 0 00 001041' exit. ; Finally in the SINR% (or real close!!) 32210 001035'01 201 01 0 00 000372 movei t1, ^d250 ; Wait a bit for it to turn back on 32211 001036'01 104 00 0 00 000167 DISMS% ; And chill out for a bit 32212 001037'01 200 01 0 00 000012 move t1, p2 ; Reload the fork handle 32213 001040'01 367 04 0 00 001011' sojg t4, top. ; Try again (but only so long) 32214 001041'01 enddo. ; Exit loop context 32215 32216 001041'01 326 04 0 00 001047' ife. t4 ; Exhausted the count? 32217 001042'01 334 00 0 00 000000 %ermsg (,epicom) 32218 001043'01 254 00 0 00 001047' 32219 001044'01 265 01 0 00 001030* 32220 001045'01 000000000000# 32221 001046'01 254 00 0 00 001235' 32222 000505'04 124 151 155 145 144 32223 001047'01 endif. ; piffle.... 32224 32225 remark ; Loop appears to be unnecessary for inter-job... 32226 001047'01 260 17 0 00 002033' call statim ; Start timing the transfer 32227 001050'01 120 02 0 00 000000# dmove t2, chrptr ; Load pointer prototype and count 32228 001051'01 541 02 0 00 000000# hrri t2, devwrt ; Where we're writing from 32229 001052'01 332 00 0 00 000000# skipe timpar ;[223] Unless doing parity 32230 001053'01 541 02 0 00 000000# hrri t2, devdat ;[223] OK, so we're doing it with parity bits set 32231 001054'01 201 13 0 00 000031 movei p3, ^d25 ; Only wait so long for buffers to drain 32232 ; Loop is because of limited monitor buffers 32233 001055'01 do. ; Enter loop context 32234 001055'01 550 01 0 00 000005 hrrz t1, q1 ; Load the source JFN (no flags) 32235 001056'01 200 04 0 00 000003 move t4, t3 ; Save a copy of remaining character count 32236 001057'01 104 00 0 00 000532 SOUTR% ; Blammo!! 32237 001060'01 320 12 0 00 001062' ifje. r ; Uh oh, investigate the failure 32238 001061'01 254 00 0 00 001071' 32239 001062'01 306 01 0 00 602423 cain t1, IOX33 ; Inferior couldn't swallow all of it at once? 32240 001063'01 254 00 0 00 001071' anskp. ; Nope; however, we can recover from this 32241 001064'01 334 00 0 00 000000 %ermsg(, epicom) 32242 001065'01 254 00 0 00 001071' 32243 001066'01 265 01 0 00 001044* 32244 001067'01 000000000000# 32245 001070'01 254 00 0 00 001235' 32246 000515'04 125 156 141 142 154 32247 001071'01 endif. ; Carry on if worked or IOX33 32248 001071'01 322 03 0 00 001101' jumpe t3, endlp. ; If done, then leave 32249 001072'01 312 03 0 00 000004 came t3, t4 ; Did it do anything, actually? 32250 001073'01 254 00 0 00 001055' loop. ; Yes, so ready to do some more 32251 001074'01 260 17 0 00 001327' call ckdtwr ; Otherwise, check device write status 32252 001075'01 254 00 0 00 001235' jrst epicom ; Something went wrong or is bad 32253 001076'01 201 01 0 00 000144 movei t1, ^d100 ; Give inferior a chance to run 32254 001077'01 104 00 0 00 000167 DISMS% ; So it can catch its breath 32255 001100'01 367 13 0 00 001055' sojg p3, top. ; And try another drop 32256 001101'01 enddo. ; Exit loop context 32257 32258 001101'01 326 13 0 00 001107' ife. p3 ; Exhausted the count? 32259 001102'01 334 00 0 00 000000 %ermsg (,epicom) 32260 001103'01 254 00 0 00 001107' K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 24-3 K20TIM MAC 9-Nov-23 15:10 Multi-fork timing common code 32261 001104'01 265 01 0 00 001066* 32262 001105'01 000000000000# 32263 001106'01 254 00 0 00 001235' 32264 000526'04 124 151 155 145 144 32265 001107'01 endif. ; piffle.... 32266 32267 remark ; Repeating previous code for better error messages 32268 001107'01 200 01 0 00 000012 move t1, p2 ; Load inferior's handle 32269 001110'01 104 00 0 00 000163 WFORK% ; Wait for inferior SINR% to complete 32270 001111'01 320 12 0 00 001113' %jserr(,epicom) 32271 001112'01 254 00 0 00 001116' 32272 001113'01 265 01 0 00 001104* 32273 001114'01 000000000000# 32274 001115'01 254 00 0 00 001235' 32275 000535'04 125 156 141 142 154 32276 001116'01 104 00 0 00 000012 GETER% ; Find out inferior's last error 32277 001117'01 320 12 0 00 001121' %jserr(,epicom) 32278 001120'01 254 00 0 00 001124' 32279 001121'01 265 01 0 00 001113* 32280 001122'01 000000000000# 32281 001123'01 254 00 0 00 001235' 32282 000547'04 125 156 141 142 154 32283 001124'01 621 02 0 00 777777 tlz t2, -1 ; Stomp silly fork handle 32284 001125'01 306 02 0 00 601405 cain t2, lstrx1 ; Everything's Archie, right? 32285 001126'01 254 00 0 00 001136' ifskp. ; It isn't, so complain 32286 001127'01 201 01 0 00 400000 movei t1, .fhslf ; Set our last error to inferior's 32287 001130'01 104 00 0 00 000336 SETER% ; So diagnostic message is more meaningful 32288 001131'01 334 00 0 00 000000 %ermsg(,epicom) 32289 001132'01 254 00 0 00 001136' 32290 001133'01 265 01 0 00 001121* 32291 001134'01 000000000000# 32292 001135'01 254 00 0 00 001235' 32293 000561'04 111 156 146 145 162 32294 001136'01 endif. 32295 32296 001136'01 260 17 0 00 002133' call elptim ; Compute elapsed transfer time 32297 32298 001137'01 260 17 0 00 001750' call parchk ;[223] Check parity, if doing parity 32299 001140'01 254 00 0 00 001235' jrst epicom ;[223] Skip the rest of it 32300 32301 remark ; Check the data made it over correctly 32302 001141'01 415 16 0 00 001161' block. ; Build a stack frame to preserve registers 32303 001142'01 261 17 0 00 000016 32304 001143'01 332 00 0 00 000000# skipe timpar ;[223] Did we already check the parity? 32305 001144'01 254 00 0 00 000661* retskp ;[223] We did, so if made it here, everything is fine 32306 001145'01 265 16 0 00 003571' saveac ; Need to save these 32307 001146'01 210 01 0 00 000000# movn t1, chrcnt ; Load length of string sent 32308 001147'01 200 04 0 00 000001 move t4, t1 ; Strings are the same length 32309 001150'01 403 03 0 00 000006 setzb t3, q2 ; Section local string pointers 32310 001151'01 200 02 0 00 000000# move t2, chrptr ; Load correct character pointer and size 32311 001152'01 510 05 0 00 000002 hllz q1, t2 ; Both sources are equivalent here 32312 001153'01 541 02 0 00 000000# hrri t2, devwrt ; What we wrote 32313 001154'01 541 05 0 00 000000# hrri q1, devred ; What we read 32314 001155'01 123 01 0 00 000000* extend t1, cmprmn ; See if everything made it through OK 32315 001156'01 263 17 0 00 000000 ret ; Not equal, phooey! K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 24-4 K20TIM MAC 9-Nov-23 15:10 Multi-fork timing common code 32316 001157'01 254 00 0 00 001144* retskp ; Equal!! 32317 001160'01 263 17 0 00 000000 endbk. ; End block 32318 001161'01 254 00 0 00 001164' ifskp. ; Worked 32319 001162'01 600 00 0 00 000000 nop ; No special action, carry on 32320 001163'01 254 00 0 00 001202' else. ; Failed??? 32321 001164'01 200 03 0 00 000001 move t3, t1 ; Save source character count 32322 001165'01 200 06 0 00 000002 move q2, t2 ; Save source character pointer 32323 001166'01 200 01 0 00 000000# emsg () 32324 001167'01 104 00 0 00 000313 32325 000141'02 000000000000# 32326 000571'04 124 151 155 151 156 32327 001170'01 201 01 0 00 000101 movei t1, .priou ; Continue blatting 32328 001171'01 210 02 0 00 000000# movn t2, chrcnt ; Load length of string sent 32329 001172'01 274 02 0 00 000003 sub t2, t3 ; Subtract remaining characters 32330 001173'01 201 03 0 00 000012 movei t3, fld(^d10,no%rdx) 32331 001174'01 104 00 0 00 000224 NOUT% ; Shows what character we croaked on 32332 001175'01 320 12 0 00 001176' erjmpr .+1 32333 001176'01 561 01 0 00 000240* hrroi t1, crlf 32334 001177'01 104 00 0 00 000076 PSOUT% 32335 001200'01 320 12 0 00 001201' erjmpr .+1 32336 001201'01 254 00 0 00 001235' jrst epicom 32337 001202'01 endif. 32338 32339 remark ; Finally get to do some arithmatic!! 32340 001202'01 400 01 0 00 000000 setz t1, ; Load integer high order of character count 32341 001203'01 210 02 0 00 000000# movn t2, chrcnt ; Load load order character count 32342 001204'01 116 01 0 00 003601' dmul t1, [exp 0, ^d100000*^d10 ] ; Scale to bits in microsecond time 32343 001205'01 120 01 0 00 000003 dmove t1, t3 ; Load low order double word 32344 001206'01 260 17 0 00 003301' call dfloat ; Convert to double floating point 32345 001207'01 334 00 0 00 000000 %ermsg (, epicom) 32346 001210'01 254 00 0 00 001214' 32347 001211'01 265 01 0 00 001133* 32348 001212'01 000000000000# 32349 001213'01 254 00 0 00 001235' 32350 000603'04 125 156 141 142 154 32351 001214'01 120 03 0 00 000001 dmove t3, t1 ; Save double floating bit count 32352 32353 001215'01 120 01 0 00 000000# dmove t1, ewallt+.datus ; Load tens of nanoseconds used 32354 001216'01 260 17 0 00 003301' call dfloat ; Convert to double floating point 32355 001217'01 334 00 0 00 000000 %ermsg (, epicom) 32356 001220'01 254 00 0 00 001224' 32357 001221'01 265 01 0 00 001211* 32358 001222'01 000000000000# 32359 001223'01 254 00 0 00 001235' 32360 000612'04 125 156 141 142 154 32361 001224'01 113 03 0 00 000001 dfdv t3, t1 ; Divide bits by ticks 32362 32363 001225'01 415 16 0 00 001232' block. ; Enter block context for another frame 32364 001226'01 261 17 0 00 000016 32365 001227'01 265 16 0 00 003603' saveac ; Save result before the call 32366 001230'01 260 17 0 00 001235' call epicom ; Stomp everything 32367 001231'01 263 17 0 00 000000 endbk. ; Exit block context 32368 32369 001232'01 200 05 0 00 000004 move t5, t4 ; Return virtual baud rate for some device 32370 001233'01 200 04 0 00 000003 move t4, t3 ; Return the high order, too K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 24-5 K20TIM MAC 9-Nov-23 15:10 Multi-fork timing common code 32371 001234'01 254 00 0 00 001157* retskp ; Return success 32372 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 25 K20TIM MAC 9-Nov-23 15:10 Common timing test epilogue code 32373 subttl Common timing test epilogue code 32374 32375 ; N.B., Do not change the order of resource release, below! 32376 ; 32377 ; 1) An open JFN that is in active use via an SPJFN% can not be 32378 ; closed or even force closed, the error being an arcane CLSX2, 32379 ; "File cannot be closed by this process". 32380 ; 32381 ; This is why the SPJFN% is done before any close attempts. 32382 ; (Learned that the hard way...) 32383 ; 32384 ; 2) The SPJFN% is also done before the KFORK% as a caution to the 32385 ; JFN being left in an odd way or the KFORK% failing. 32386 32387 001235'01 336 01 0 00 000012 epicom: skipn t1, p2 ; Did we have a fork? 32388 001236'01 254 00 0 00 001257' ifskp. ; We did, chuck it 32389 001237'01 200 02 0 00 003613' movx t2, <.nulio,,.nulio> ; Truely shut it up 32390 001240'01 104 00 0 00 000207 SPJFN% ; Attempt the muzzling 32391 001241'01 320 12 0 00 001243' ifje. r ; Catch and store error 32392 001242'01 254 00 0 00 001245' 32393 001243'01 200 04 0 00 000001 move t4, t1 ; Store error for debuggers 32394 001244'01 200 01 0 00 000012 move t1, p2 ; Reload the fork handle 32395 001245'01 endif. ; But carry on in either case 32396 001245'01 403 03 0 00 000004 setzb t3, t4 ; Whack JSYS error talismen 32397 001246'01 104 00 0 00 000153 KFORK% ; Try to clobber the inferior 32398 001247'01 320 12 0 00 001251' ifje. r ; Catch and store error 32399 001250'01 254 00 0 00 001256' 32400 001251'01 200 04 0 00 000001 move t4, t1 ; Store error for debuggers 32401 001252'01 200 01 0 00 000012 move t1, p2 ; Reload the fork handle again 32402 001253'01 104 00 0 00 000165 RFRKH% ; At least try to release that 32403 001254'01 254 00 0 00 001256' ifskp. ; There is no joy in mudville 32404 001255'01 200 03 0 00 000001 move t3, t1 ; Store for debuggders 32405 001256'01 endif. ; End case RFRKH% failure handling 32406 001256'01 endif. ; Continue and clean up storage 32407 001256'01 400 12 0 00 000000 setz p2, ; Either way, no more fork 32408 001257'01 endif. 32409 32410 001257'01 336 01 0 00 000006 skipn t1, q2 ; Did we ever have a destination JFN? 32411 001260'01 254 00 0 00 001264' ifskp. ; We did 32412 001261'01 260 17 0 00 000000* call frclose ; Force it closed (see k20sub) 32413 001262'01 600 00 0 00 000000 nop ; Failed somehow 32414 001263'01 400 06 0 00 000000 setz q2, ; Either way, no destination JFN 32415 001264'01 endif. 32416 32417 001264'01 336 01 0 00 000005 skipn t1, q1 ; Did we ever have a source JFN? 32418 001265'01 254 00 0 00 001271' ifskp. ; We did 32419 001266'01 260 17 0 00 001261* call frclose ; Force it closed (see k20sub) 32420 001267'01 600 00 0 00 000000 nop ; Failed somehow 32421 001270'01 400 05 0 00 000000 setz q1, ; Either way, no source JFN 32422 001271'01 endif. 32423 32424 001271'01 474 01 0 00 000000 seto t1, ; Removing pages 32425 dmove t2,[.fhslf,,nulpag+1 ;Whacking dirty pages from address space 32426 001272'01 120 02 0 00 003614' pm%cnt!pm%abt!fld(,pm%cnt) ] 32427 001273'01 104 00 0 00 000056 PMAP% ; Reduce our working set size K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 25-1 K20TIM MAC 9-Nov-23 15:10 Common timing test epilogue code 32428 001274'01 320 12 0 00 001276' ifje. r ; Should never happen... 32429 001275'01 254 00 0 00 001277' 32430 001276'01 200 04 0 00 000001 move t4, t1 ; Store error for debuggers 32431 001277'01 endif. 32432 32433 001277'01 336 01 0 00 000010 skipn t1, q4 ; Did we assign the PTY's associated terminal? 32434 001300'01 254 00 0 00 001306' ifskp. ; We did, release it 32435 001301'01 104 00 0 00 000071 RELD% ; Try to punt the TTY 32436 001302'01 320 12 0 00 001304' ifje. r ; Catch and store error 32437 001303'01 254 00 0 00 001305' 32438 001304'01 200 04 0 00 000001 move t4, t1 ; Store error for debuggers 32439 001305'01 endif. ; Carry on! 32440 001305'01 400 10 0 00 000000 setz q4, ; Either way, no assigned terminal 32441 001306'01 endif. 32442 32443 001306'01 336 01 0 00 000007 skipn t1, q3 ; Did we assign a PTY? 32444 001307'01 254 00 0 00 001326' ifskp. ; We did, release it 32445 001310'01 104 00 0 00 000071 RELD% ; Try to punt the PTY 32446 001311'01 320 12 0 00 001313' ifje. r ; Catch and store error 32447 001312'01 254 00 0 00 001314' 32448 001313'01 200 04 0 00 000001 move t4, t1 ; Store error for debuggers 32449 001314'01 endif. ; Continue and clean up storage 32450 001314'01 400 07 0 00 000000 setz q3, ; Either way, no assigned PTY 32451 001315'01 402 00 0 00 000260* setzm asgflg ; Clear device assignment flag 32452 001316'01 402 00 0 00 000000* setzm asgdev ; Clear stored assigned device 32453 001317'01 402 00 0 00 000000* setzm ptytty ; Clear PTY's associated TTY line number 32454 001320'01 402 00 0 00 000000* setzm ptyflg ; Clear pseudo-terminal I/O flag 32455 001321'01 402 00 0 00 000000* setzm binflg ; Clear binary I/O flag 32456 001322'01 403 01 0 00 000002 setzb t1, t2 ; Cons up a zero double word 32457 001323'01 124 01 0 00 000000* dmovem t1, ndvchr ; Whack characteristics double word 32458 001324'01 124 01 0 00 000000* dmovem t1, ttynam ; No ASCII terminal device name 32459 001325'01 124 01 0 00 000000* dmovem t1, ptynam ; No pseudo-terminal device name 32460 001326'01 endif. 32461 32462 001326'01 263 17 0 00 000000 ret ; Phew!! 32463 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 26 K20TIM MAC 9-Nov-23 15:10 Device lower fork checking code 32464 subttl Device lower fork checking code 32465 32466 ; Here if the upper fork SOUTR% fails and the byte count is unchanged 32467 32468 define errtxt (t,%t,%et) < ;;Macro to put a string in text section 32469 move t1,%t ;;Local pointer to text 32470 32471 chgsec(code,const) ;;Put pointer to extended text in const section 32472 %t: .px7!%et ;;OWGP to extended section 32473 retsec ;;Restore .PSECT assumptions 32474 32475 chgsec(code,etext) ;;Open non-section zero text 32476 %et: asciz |'t| ;;Deposit text and label text with generated symbol 32477 retsec ;;Restore .PSECT assumptions 32478 cleans(<%t,%et>) ;;Punt generated symbols 32479 >;;errtxt 32480 32481 001327'01 265 16 0 00 003616' ckdtwr: saveac ; Modifies no registers 32482 32483 remark ; First, pull fork information 32484 001330'01 200 01 0 00 000012 move t1, p2 ; Load inferior's handle 32485 001331'01 104 00 0 00 000012 GETER% ; Get its last error 32486 001332'01 320 12 0 00 001334' %jserr(, r) 32487 001333'01 254 00 0 00 001337' 32488 001334'01 265 01 0 00 001221* 32489 001335'01 000000000000# 32490 001336'01 254 00 0 00 000660* 32491 000621'04 125 156 141 142 154 32492 001337'01 621 02 0 00 777777 tlz t2, -1 ; Stomp silly fork handle 32493 001340'01 200 07 0 00 000002 move q3, t2 ; And save the last error 32494 001341'01 200 01 0 00 000012 move t1, p2 ; Load inferior's handle 32495 001342'01 104 00 0 00 000156 RFSTS% ; Return fork status 32496 001343'01 320 12 0 00 001345' %jserr(, r) 32497 001344'01 254 00 0 00 001350' 32498 001345'01 265 01 0 00 001334* 32499 001346'01 000000000000# 32500 001347'01 254 00 0 00 001336* 32501 000630'04 125 156 141 142 154 32502 001350'01 621 02 0 00 777777 tlz t2, -1 ; Stomp any flags 32503 001351'01 120 05 0 00 000001 dmove q1, t1 ; Save the inferior's status and PC 32504 32505 001352'01 135 04 0 00 003634' ldb t4, [pointr. q1, rf%sts] 32506 001353'01 305 04 0 00 000011 caige t4, .rfmax ; Out of range? 32507 001354'01 254 00 0 00 001366' ifskp. ; Must be a new monitor 32508 001355'01 201 01 0 00 400000 movei t1, .fhslf ; Set our last error 32509 001356'01 200 02 0 00 000007 move t2, q3 ; To inferior's for better 32510 001357'01 104 00 0 00 000336 SETER% ; Diagnostic messages 32511 001360'01 320 12 0 00 001361' erjmpr .+1 ; Catch and ignore error 32512 001361'01 334 00 0 00 000000 %ermsg(,r) 32513 001362'01 254 00 0 00 001366' 32514 001363'01 265 01 0 00 001345* 32515 001364'01 000000000000# 32516 001365'01 254 00 0 00 001347* 32517 000640'04 111 156 146 145 162 32518 001366'01 endif. ; But regular handler won't work K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 26-1 K20TIM MAC 9-Nov-23 15:10 Device lower fork checking code 32519 32520 001366'01 306 07 0 00 601405 cain q3, lstrx1 ; Everything's Archie, right? 32521 001367'01 254 00 0 00 001372' ifskp. ; It isn't, so complain 32522 001370'01 200 01 0 00 000000# errtxt() 32523 000142'02 000000000000# 32524 000650'04 111 156 146 145 162 32525 001371'01 254 00 0 00 001414' callret ckderr ; Return from error type out 32526 001372'01 endif. 32527 32528 001372'01 325 05 0 00 001375' ifxn. q1, rf%frz ; Did it get frozen somehow? 32529 001373'01 200 01 0 00 000000# errtxt() 32530 000143'02 000000000000# 32531 000662'04 111 156 146 145 162 32532 001374'01 254 00 0 00 001414' callret ckderr ; Return from error type out 32533 001375'01 endif. ; Should never happen in the push loop 32534 ; Otherwise, load its status 32535 001375'01 306 04 0 00 000000 cain t4, .rfrun ; Running? 32536 001376'01 254 00 0 00 001234* retskp ; That's OK. I guess... 32537 001377'01 306 04 0 00 000001 cain t4, .rfio ; Doing I/O? 32538 001400'01 254 00 0 00 001376* retskp ; This is expected (what its supposed to be doing) 32539 001401'01 302 04 0 00 000002 caie t4, .rfhlt ; Halted?? 32540 001402'01 254 00 0 00 001413' ifskp. ; That might be OK, actually 32541 001403'01 302 06 0 00 000012 caie q2, devhlt+1 ; Normal halt? 32542 001404'01 254 00 0 00 001411' ifskp. ; Yes, so need to wait for buffers to drain 32543 txmsg <% Inferior timing fork normal termination, waiting on buffers 32544 001405'01 200 01 0 00 000000# > 32545 001406'01 104 00 0 00 000076 32546 001407'01 320 12 0 00 001410' 32547 000144'02 000000000000# 32548 000673'04 045 040 111 156 146 32549 32550 001410'01 254 00 0 00 001400* retskp ; And try again 32551 001411'01 endif. ; Otherwise, a real error 32552 001411'01 200 01 0 00 000000# errtxt() 32553 000145'02 000000000000# 32554 000710'04 111 156 146 145 162 32555 001412'01 254 00 0 00 001414' callret ckderr ; Return from error type out 32556 001413'01 endif. 32557 32558 remark ; Any other status is bad 32559 001413'01 200 01 0 00 000000# errtxt () 32560 000146'02 000000000000# 32561 000720'04 111 156 146 145 162 32562 remark ckderr ; Fall through to error type out 32563 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 27 K20TIM MAC 9-Nov-23 15:10 Handle print out of inferior error 32564 subttl Handle print out of inferior error 32565 32566 ; Expects ckptwr register environment except t1 has an error message 32567 32568 001414'01 104 00 0 00 000313 ckderr: ESOUT% ; First, do the blat 32569 001415'01 320 12 0 00 001416' erjmpr .+1 ; Catch and ignore error 32570 001416'01 201 01 0 00 000054 movei t1, "," ; Punctuate first part of error message 32571 001417'01 104 00 0 00 000074 PBOUT% 32572 001420'01 320 12 0 00 001421' erjmpr .+1 ; Catch and ignore error 32573 001421'01 201 01 0 00 000040 movei t1, .chspc ; And space over 32574 001422'01 104 00 0 00 000074 PBOUT% 32575 001423'01 320 12 0 00 001424' erjmpr .+1 ; Catch and ignore error 32576 32577 001424'01 200 01 0 04 001475' move t1,rfstst(t4) ; Load appropriate status text 32578 001425'01 104 00 0 00 000076 PSOUT% ; Type it 32579 001426'01 320 12 0 00 001427' erjmpr .+1 ; Catch and ignore error 32580 32581 001427'01 302 04 0 00 000003 caie t4, .rffpt ; Forced? 32582 001430'01 254 00 0 00 001445' ifskp. ; Then we have some more information 32583 001431'01 200 01 0 00 000000# errtxt (<, channel: >) ;Meaning, the channel number 32584 000147'02 000000000000# 32585 000730'04 054 040 143 150 141 32586 001432'01 104 00 0 00 000076 PSOUT% ; Type that 32587 001433'01 320 12 0 00 001434' erjmpr .+1 ; Catch and ignore error 32588 001434'01 201 01 0 00 000101 movei t1, .priou ; Output to our terminal 32589 001435'01 135 02 0 00 003635' ldb t2, [pointr. q1, rf%sic] ; Load forcing channel 32590 001436'01 201 03 0 00 000012 movei t3, ^d10 ; Which is in base 10 32591 001437'01 104 00 0 00 000224 NOUT% ; Type it 32592 001440'01 334 00 0 00 000000 %ermsg(,r) 32593 001441'01 254 00 0 00 001445' 32594 001442'01 265 01 0 00 001363* 32595 001443'01 000000000000# 32596 001444'01 254 00 0 00 001365* 32597 000733'04 111 156 146 145 162 32598 001445'01 endif. 32599 32600 001445'01 201 01 0 00 000054 movei t1, "," ; Punctuate first part of error message 32601 001446'01 104 00 0 00 000074 PBOUT% 32602 001447'01 320 12 0 00 001450' erjmpr .+1 ; Catch and ignore error 32603 001450'01 201 01 0 00 000040 movei t1, .chspc ; And space over 32604 001451'01 104 00 0 00 000074 PBOUT% 32605 001452'01 320 12 0 00 001453' erjmpr .+1 ; Catch and ignore error 32606 32607 001453'01 200 01 0 00 000101 move t1, .priou ; Going to primary output 32608 001454'01 505 02 0 00 400000 hrli t2, .fhslf ; Have to use ourself for explicit error 32609 001455'01 540 02 0 00 000007 hrr t2, q3 ; Pick up inferior handle 32610 001456'01 400 03 0 00 000000 setz t3, ; No limit to blat 32611 001457'01 104 00 0 00 000011 ERSTR% ; Blat away! 32612 001460'01 320 12 0 00 001462' erjmpr .+2 ; Ignore its strange return 32613 001461'01 320 12 0 00 001462' erjmpr .+1 ; Ignore its stranger return 32614 32615 001462'01 201 01 0 00 000054 movei t1, "," ; Punctuate first part of error message 32616 001463'01 104 00 0 00 000074 PBOUT% 32617 001464'01 320 12 0 00 001465' erjmpr .+1 ; Catch and ignore error 32618 001465'01 201 01 0 00 000040 movei t1, .chspc ; And space over K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 27-1 K20TIM MAC 9-Nov-23 15:10 Handle print out of inferior error 32619 001466'01 104 00 0 00 000074 PBOUT% 32620 001467'01 320 12 0 00 001470' erjmpr .+1 ; Catch and ignore error 32621 32622 001470'01 200 01 0 00 000006 move t1, q2 ; Load inferior's captured PC 32623 001471'01 260 17 0 00 000000* call symout ; Symbolic type out of failed location 32624 32625 001472'01 561 01 0 00 001176* hrroi t1, crlf ; Tie off the line 32626 001473'01 104 00 0 00 000076 PSOUT% 32627 32628 001474'01 263 17 0 00 000000 ret ; Always return +1 to superior 32629 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 28 K20TIM MAC 9-Nov-23 15:10 Text for fork status codes 32630 subttl Text for fork status codes 32631 32632 remark ; RF%STS (Process Status Code) 32633 001475'01 000000000000# rfstst: eascii (< Runnable>) ; .RFRUN 32634 000741'04 040 122 165 156 156 32635 001476'01 000000000000# eascii (< I/O>) ; .RFIO (Dismissed for I/O) 32636 000743'04 040 111 057 117 000 32637 001477'01 000000000000# eascii (< Halted>) ; .RFHLT 32638 000744'04 040 110 141 154 164 32639 001500'01 000000000000# eascii (< Forced>) ; .RFFPT (Forced process termination) 32640 000746'04 040 106 157 162 143 32641 001501'01 000000000000# eascii (< Waiting>) ; .RFWAT (Waiting for inferior process) 32642 000750'04 040 127 141 151 164 32643 001502'01 000000000000# eascii (< Sleep>) ; .RFSLP 32644 000752'04 040 123 154 145 145 32645 001503'01 000000000000# eascii (< Trapped>) ; .RFTRP (JSYS Trapped) 32646 000754'04 040 124 162 141 160 32647 001504'01 000000000000# eascii (< Address>) ; .RFABK (Address break freeze) 32648 000756'04 040 101 144 144 162 32649 001505'01 000000000000# eascii (< Signal>) ; .RFSIG (Signal JFN freeze) 32650 000760'04 040 123 151 147 156 32651 000011 .rfmax==.rfsig+1 32652 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 29 K20TIM MAC 9-Nov-23 15:10 Discover NUL: baud rate 32653 subttl Discover NUL: baud rate 32654 32655 ; Written to merely check calculations code before writing other timers 32656 ; 32657 ; As above, NUL:'s virtual baud rate means very little. 32658 ; 32659 ; Unlike the above, NOTHING reads the SOUTR% because this is 32660 ; (onviously) impossible to do as the data just got dumped. The 32661 ; reason four times the data is written is to work the rate 32662 ; calculations in a different way, stressing them to look for edge 32663 ; cases 32664 ; 32665 ; Therefore, doing parity on NUL: is relatively to moderately...useless. 32666 32667 remark pars4 ; SOUTR% byte size 32668 32669 770000 000000 pbyte==maskb(0,5) ; Position of a byte in a section local pointer 32670 007700 000000 sbyte==maskb(6,11) ; Size of a byte in a section local pointer 32671 32672 001506'01 dnulbd: intern dnulbd ; Invoked by k20dsp 32673 001506'01 477 04 0 00 000005 setob t4, t5 ; Let's assume we can't do anything 32674 dmove t1,[.fhslf,,nulpag ; Source is NUL: page 32675 001507'01 120 01 0 00 003636' .fhslf,,nulpag+1 ] ; Destination is the second page 32676 001510'01 200 03 0 00 003640' movx t3, pm%cnt!pm%rd!fld(nulpgs,pm%rpt) ; Read only 32677 001511'01 104 00 0 00 000056 PMAP% ; Case III, process to process PMAP% 32678 001512'01 320 12 0 00 001514' %jserr (, nulepi) 32679 001513'01 254 00 0 00 001517' 32680 001514'01 265 01 0 00 001442* 32681 001515'01 000000000000# 32682 001516'01 254 00 0 00 001572' 32683 000762'04 125 156 141 142 154 32684 32685 remark ; NUL counts are different 32686 001517'01 333 04 0 00 000702* skiple t4, pars4 ; Pick up byte size for SOUTR% 32687 001520'01 254 00 0 00 001523' ifskp. ; Was anything specifed? 32688 dmove t2,[ ; No, use defaults 32689 point 8,nulwrt ; Where we're writing from 32690 001521'01 120 02 0 00 003641' - ] ; Number of characters in the pages 32691 001522'01 254 00 0 00 001531' else. ; Otherwise, need to do some coversions 32692 001523'01 120 02 0 00 003557' dmove t2,[exp -1,-^d36] ;Load double negative integer 36 32693 001524'01 234 02 0 00 000004 div t2, t4 ; Calculate bytes per word 32694 001525'01 225 02 0 00 004000 muli t2, nullen ; Now have total bytes we'll do in t3 32695 001526'01 205 02 0 00 440000 movx t2, ; Set up for an ILDB at bit '36' 32696 001527'01 137 04 0 00 003561' dpb t4, [ pointr t2, sbyte ] ; Drop in the byte size 32697 001530'01 541 02 0 00 000000# hrri t2, nulwrt ; Finally drop in the address 32698 001531'01 endif. ; End non-standard byte size 32699 32700 001531'01 201 01 0 00 377777 movx t1, .nulio ; Just dumping, maybe really fast 32701 001532'01 210 04 0 00 000003 movn t4, t3 ; Save count used 32702 001533'01 260 17 0 00 002033' call statim ; Start timing the transfer 32703 001534'01 104 00 0 00 000532 SOUTR% ; Bombs away!!! 32704 001535'01 320 12 0 00 001537' %jserr (, nulepi) 32705 001536'01 254 00 0 00 001542' 32706 001537'01 265 01 0 00 001514* 32707 001540'01 000000000000# K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 29-1 K20TIM MAC 9-Nov-23 15:10 Discover NUL: baud rate 32708 001541'01 254 00 0 00 001572' 32709 000770'04 125 156 141 142 154 32710 001542'01 260 17 0 00 002050' call endtim ; Finish the timing 32711 32712 001543'01 260 17 0 00 002133' call elptim ; Compute elapsed transfer time 32713 001544'01 400 01 0 00 000000 setz t1, ; Zero high order of characters transferred 32714 001545'01 200 02 0 00 000004 move t2, t4 ; Load low order of characters transferred 32715 001546'01 116 01 0 00 003601' dmul t1, [exp 0, ^d100000*^d10 ] ; Scale to bits in microsecond time 32716 001547'01 120 01 0 00 000003 dmove t1, t3 ; Load low order double word 32717 001550'01 260 17 0 00 003301' call dfloat ; Convert to double floating point 32718 001551'01 334 00 0 00 000000 %ermsg (, nulepi) 32719 001552'01 254 00 0 00 001556' 32720 001553'01 265 01 0 00 001537* 32721 001554'01 000000000000# 32722 001555'01 254 00 0 00 001572' 32723 000775'04 125 156 141 142 154 32724 001556'01 120 03 0 00 000001 dmove t3, t1 ; Save double floating bit count 32725 32726 001557'01 120 01 0 00 000000# dmove t1, ewallt+.datus ; Load tens of nanoseconds used 32727 001560'01 260 17 0 00 003301' call dfloat ; Convert to double floating point 32728 001561'01 334 00 0 00 000000 %ermsg (, nulepi) 32729 001562'01 254 00 0 00 001566' 32730 001563'01 265 01 0 00 001553* 32731 001564'01 000000000000# 32732 001565'01 254 00 0 00 001572' 32733 001003'04 125 156 141 142 154 32734 001566'01 113 03 0 00 000001 dfdv t3, t1 ; Divide bits by ticks 32735 001567'01 120 04 0 00 000003 dmove t4, t3 ; Return in the expected place 32736 001570'01 260 17 0 00 001572' call nulepi ; Call the epilogue 32737 001571'01 254 00 0 00 001410* retskp ; Return success 32738 32739 001572'01 nulepi: remark NUL test epilogue 32740 001572'01 474 01 0 00 000000 seto t1, ; Removing pages 32741 dmove t2,[.fhslf,,nulpag+1 ;Whacking dirty pages from address space 32742 001573'01 120 02 0 00 003643' pm%cnt!pm%abt!fld(nulpgs,pm%rpt) ] ; Read only 32743 001574'01 104 00 0 00 000056 PMAP% ; Reduce our working set size 32744 001575'01 320 12 0 00 001577' ifje. r ; Should never happen... 32745 001576'01 254 00 0 00 001600' 32746 001577'01 200 03 0 00 000001 move t3, t1 ; Store error for debuggers 32747 001600'01 endif. 32748 32749 001600'01 263 17 0 00 000000 ret 32750 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 30 K20TIM MAC 9-Nov-23 15:10 Set up for parity checking (if we're doing parity) 32751 subttl Set up for parity checking (if we're doing parity) 32752 32753 ;[223] Begin code insertion 32754 32755 ;N.B., Assumes we're ALWAYS doing 8 bit transfers, which is what 32756 ; Kermit would be sending over the line. However, due to the last 32757 ; four bits of the data being transferred having rotating values, 32758 ; it may be possible to get into the situation here where the byte 32759 ; parity is reported as being fine, but the word comparison can fail. 32760 32761 extern parity, none ; If we're doing any kind of parity 32762 extern genint ; Constructed instruction if generating parity 32763 remark ; If doing parity, ALWAYS sending AND checking it 32764 32765 chgsec(code,data) ;;Needs some writable storage 32766 000125'05 000000 000000 timpar: 0 ; Set if was doing parity 32767 retsec ;;Back in code 32768 32769 001601'01 402 00 0 00 000000# parset: setzm timpar ; Don't assume doing parity 32770 001602'01 200 01 0 00 000000* move t1, parity ; Load parity setting 32771 001603'01 302 01 0 00 000000* caie t1, none ; Not doing any parity? 32772 001604'01 254 00 0 00 001607' ifskp. ; Nope, nothing further to do 32773 001605'01 254 00 0 00 001571* retskp ; so get out of here 32774 001606'01 254 00 0 00 001614' else. ; Otherwise, doing some real work 32775 001607'01 335 01 0 00 000000# skipge t1, timdev ; Load timing device 32776 001610'01 254 00 0 00 001605* retskp ; Unless never got one 32777 001611'01 306 01 0 00 000015 cain t1, .dvnul ; NUL:? 32778 001612'01 254 00 0 00 001610* retskp ; Yeah, no way to read from that, so forget parity 32779 001613'01 476 00 0 00 000000# setom timpar ; Flag we're doing parity 32780 001614'01 endif. 32781 32782 remark ; OK to trash these temporaries 32783 001614'01 265 16 0 00 003645' saveac ; But needs many piggy registers 32784 32785 001615'01 201 01 0 00 004000 movei t1, devchr ; Load number of characters 32786 001616'01 200 04 0 00 000001 move t4, t1 ; destination string is same length 32787 001617'01 201 02 0 00 000000# movei t2, devwrt ; Load address of what will be written 32788 001620'01 201 05 0 00 000000# movei q1, devdat ; Where we'll write the converted data 32789 001621'01 505 02 0 00 441000 hrli t2, (point 8,0) ; Turn source address into a section local point 32790 001622'01 500 05 0 00 000002 hll q1, t2 ; Ditto destination pointer, both being 8 bits 32791 001623'01 403 03 0 00 000006 setzb t3, q2 ; Force pointer to remain section local 32792 001624'01 200 07 0 00 000000* move q3, genint ; Load parity generation instruction 32793 001625'01 400 10 0 00 000000 setz q4, ; Unused fill character will be NUL 32794 001626'01 661 01 0 00 400000 txo t1, S ; Start significance immediately 32795 001627'01 123 01 0 00 000007 extend t1, q3 ; Finally do the conversion 32796 001630'01 600 00 0 00 000000 nop ; Ignore non-skip (which should never happen) 32797 001631'01 254 00 0 00 001632' callret chkleg ; Check generated parity against legacy parity 32798 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 31 K20TIM MAC 9-Nov-23 15:10 Routine to check parity we generated against legacy routines 32799 subttl Routine to check parity we generated against legacy routines 32800 32801 ; +1 If disagreement someplace 32802 ; +2 If complete agreement 32803 32804 extern putc ; Does a small amount of formating 32805 32806 001632'01 chkleg: dmove t2, [ ; Will run legacy routines 32807 point 8, devwrt ; over same string 32808 001632'01 120 02 0 00 003657' point 8, devdat ] ; and compare the results 32809 001633'01 200 07 0 00 000002 move q3, t2 ; Save original string pointer 32810 001634'01 201 06 0 00 004000 movei q2, devchr ; Load number of characters 32811 32812 001635'01 do. ; Enter loop context 32813 001635'01 361 06 0 00 001644' sojl q2, endlp. ; Account for a character pair consumed 32814 001636'01 134 01 0 00 000002 ildb t1, t2 ; Pick up byte from original string 32815 001637'01 260 17 1 00 001602* call @parity ; Compute the correct parity 32816 001640'01 134 04 0 00 000003 ildb t4, t3 ; Pick up byte from MOVST generated string 32817 001641'01 312 01 0 00 000004 came t1, t4 ; The same? 32818 001642'01 254 00 0 00 001644' exit. ; They are not, give up right now 32819 001643'01 254 00 0 00 001635' loop. ; Nose through the rest 32820 001644'01 enddo. ; End loop lexical context 32821 32822 001644'01 321 06 0 00 001612* jumpl q2, RSKP ; Did them all? That's dandy!! 32823 ; Sigh... 32824 001645'01 200 05 0 00 000001 move q1, t1 ; Save legacy parity 32825 001646'01 200 10 0 00 000004 move q4, t4 ; Save MOVST generated parity 32826 001647'01 201 01 0 00 004000 movei t1, devchr ; Load original number of characters 32827 001650'01 274 01 0 00 000006 sub t1, q2 ; Calculate bad byte position 32828 001651'01 200 06 0 00 000001 move q2, t1 ; Save result 32829 001652'01 133 01 0 00 000007 adjbp t1, q3 ; Position to the correct character 32830 001653'01 135 07 0 00 000001 ldb q3, t1 ; And load the character 32831 ; Finally start complaining 32832 001654'01 200 01 0 00 000000# emsg () 32833 001655'01 104 00 0 00 000313 32834 000150'02 000000000000# 32835 001011'04 107 145 156 145 162 32836 001656'01 201 01 0 00 000101 movei t1, .priou ; Still typing on terminal 32837 001657'01 200 02 0 00 000006 move t2, q2 ; Load byte position 32838 001660'01 201 03 0 00 000010 movei t3, ^d8 ; k20ioc table is documented in octal 32839 001661'01 104 00 0 00 000224 NOUT% ; Type it 32840 001662'01 320 12 0 00 001664' %jserr (,) 32841 001663'01 254 00 0 00 001667' 32842 001664'01 265 01 0 00 001563* 32843 001665'01 000000000000# 32844 001666'01 254 00 0 00 001667' 32845 001017'04 125 156 141 142 154 32846 32847 001667'01 200 01 0 00 000000# txmsg (<, legacy: >) 32848 001670'01 104 00 0 00 000076 32849 001671'01 320 12 0 00 001672' 32850 000151'02 000000000000# 32851 001026'04 054 040 154 145 147 32852 001672'01 200 04 0 00 000005 move t4, q1 ; Load what arithmatic calculated 32853 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 20:02 27-Nov-23 Page 31-1 K20TIM MAC 9-Nov-23 15:10 Routine to check parity we generated against legacy routines 32854 001674'01 622 04 0 00 000200 txze t4, 200 ; Check and strip the parity 32855 001675'01 201 01 0 00 000061 movei t1, "1" ; It's set! 32856 001676'01 104 00 0 00 000074 PBOUT% ; Either way, type it 32857 001677'01 201 01 0 00 000101 movei t1, .priou ; Still typing on terminal 32858 001700'01 200 02 0 00 000004 move t2, t4 ; Load the value, itself 32859 001701'01 200 03 0 00 003661' movx t3, 32860 001702'01 104 00 0 00 000224 NOUT% ; Type it 32861 001703'01 320 12 0 00 001705' %jserr (,) 32862 001704'01 254 00 0 00 001710' 32863 001705'01 265 01 0 00 001664* 32864 001706'01 000000000000# 32865 001707'01 254 00 0 00 001710' 32866 001031'04 125 156 141 142 154 32867 32868 001710'01 200 01 0 00 000000# txmsg (<, table: >) 32869 001711'01 104 00 0 00 000076 32870 001712'01 320 12 0 00 001713' 32871 000152'02 000000000000# 32872 001040'04 054 040 164 141 142 32873 001713'01 200 04 0 00 000010 move t4, q4 ; Load what MOVST looked up 32874 001714'01 201 01 0 00 000060 movei t1, "0" ; Let's assume it was zero 32875 001715'01 622 04 0 00 000200 txze t4, 200 ; Check and strip the parity 32876 001716'01 201 01 0 00 000061 movei t1, "1" ; It's set! 32877 001717'01 104 00 0 00 000074 PBOUT% ; Either way, type it 32878 001720'01 201 01 0 00 000101 movei t1, .priou ; Still typing on terminal 32879 001721'01 200 02 0 00 000004 move t2, t4 ; Load the value, itself 32880 001722'01 200 03 0 00 003661' movx t3, 32881 001723'01 104 00 0 00 000224 NOUT% ; Type it 32882 001724'01 320 12 0 00 001726' %jserr (,) 32883 001725'01 254 00 0 00 001731' 32884 001726'01 265 01 0 00 001705* 32885 001727'01 000000000000# 32886 001730'01 254 00 0 00 001731' 32887 001042'04 125 156 141 142 154 32888 32889 001731'01 200 01 0 00 000000# txmsg (<, character: >) 32890 001732'01 104 00 0 00 000076 32891 001733'01 320 12 0 00 001734' 32892 000153'02 000000000000# 32893 001050'04 054 040 143 150 141 32894 001734'01 400 04 0 00 000000 setz t4, ; Let's assume bit 8 is not up 32895 001735'01 200 01 0 00 000007 move t1, q3 ; Load the character 32896 001736'01 622 01 0 00 000200 txze t1, 200 ; Zero bit 8 and skip if wasn't set 32897 001737'01 474 04 0 00 000000 seto t4, ; Was set... 32898 001740'01 260 17 0 00 000000* call putc ; Type our poor character 32899 001741'01 322 04 0 00 001745' ifn. t4 ; Did it have bit eight up? 32900 001742'01 200 01 0 00 000000# txmsg (<(M)>) ; List that as 'Mark' 32901 001743'01 104 00 0 00 000076 32902 001744'01 320 12 0 00 001745' 32903 000154'02 000000000000# 32904 001053'04 050 115 051 000 000 32905 001745'01 endif. 32906 001745'01 561 01 0 00 001472* hrroi t1, crlf 32907 001746'01 104 00 0 00 000076 PSOUT% 32908 001747'01 263 17 0 00 000000 ret K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 31-2 K20TIM MAC 9-Nov-23 15:10 Routine to check parity we generated against legacy routines 32909 32910 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 32 K20TIM MAC 9-Nov-23 15:10 Check parity (if we're doing parity) 32911 subttl Check parity (if we're doing parity) 32912 32913 ;N.B., Assumes parset has been called and will almost surly *BREAK* otherwise 32914 32915 extern chkint ; Constructed instruction if checking parity 32916 32917 001750'01 336 00 0 00 000000# parchk: skipn timpar ; Did we actually do any parity? 32918 001751'01 254 00 0 00 001644* retskp ; Nope, then say all is well 32919 001752'01 335 01 0 00 000000# skipge t1, timdev ; Load timing device 32920 001753'01 254 00 0 00 001751* retskp ; Unless never got one 32921 001754'01 306 01 0 00 000015 cain t1, .dvnul ; NUL:? 32922 001755'01 254 00 0 00 001753* retskp ; Yeah, no way to read from that, so forget parity 32923 32924 remark ; OK to trash these temporaries 32925 001756'01 265 16 0 00 003645' saveac ; But needs many piggy registers 32926 32927 001757'01 201 01 0 00 004000 movei t1, devchr ; Load number of characters 32928 001760'01 200 04 0 00 000001 move t4, t1 ; destination string is same length 32929 001761'01 201 02 0 00 000000# movei t2, devred ; Source is what the subfork read 32930 001762'01 201 05 0 00 000000# movei q1, devda2 ; destination is seperate; do not update in place 32931 001763'01 505 02 0 00 441000 hrli t2, (point 8,0) ; Turn source address into a section local point 32932 001764'01 500 05 0 00 000002 hll q1, t2 ; Ditto destination pointer, both being 8 bits 32933 001765'01 403 03 0 00 000006 setzb t3, q2 ; Force pointer to remain section local 32934 001766'01 200 07 0 00 000000* move q3, chkint ; Load parity checking instruction 32935 001767'01 400 10 0 00 000000 setz q4, ; Fill character is NUL (yet unused...) 32936 remark t1, N!M ; Shut off Negative and Mark (movei cleared them) 32937 001770'01 661 01 0 00 400000 txo t1, S ; Have to dink the foolish significance bit... 32938 001771'01 123 01 0 00 000007 extend t1, q3 ; Get down to some serious string translating 32939 001772'01 600 00 0 00 000000 nop ; Can't happen 32940 001773'01 627 01 0 00 200000 txzn t1, N ; Bump into any bad parity? 32941 001774'01 254 00 0 00 001755* retskp ; Nope, everything's fin 32942 32943 001775'01 120 07 0 00 000001 dmove q3, t1 ; Save failing character position 32944 001776'01 200 01 0 00 000000# emsg 32945 001777'01 104 00 0 00 000313 32946 000155'02 000000000000# 32947 001054'04 120 141 162 151 164 32948 002000'01 201 01 0 00 000101 movei t1, .priou ; Primary output 32949 dmove t2, [ devchr ; Load number of characters 32950 002001'01 120 02 0 00 003662' ^d10 ] ; Positions are in decimal 32951 002002'01 274 02 0 00 000007 sub t2, q3 ; Subtract remaining to get position 32952 002003'01 104 00 0 00 000224 NOUT% ; Type it 32953 002004'01 320 12 0 00 002006' %jserr(,) 32954 002005'01 254 00 0 00 002011' 32955 002006'01 265 01 0 00 001726* 32956 002007'01 000000000000# 32957 002010'01 254 00 0 00 002011' 32958 001063'04 103 157 165 154 144 32959 32960 002011'01 201 06 0 00 004000 movei q2, devchr ; Load original 32961 002012'01 274 06 0 00 000004 sub q2, t4 ; Calculate amount done 32962 002013'01 323 06 0 00 002032' ifg. q2 ; Did we do anything (or gubbish)? 32963 002014'01 200 01 0 00 000000# txmsg (<, translated: ">) 32964 002015'01 104 00 0 00 000076 32965 002016'01 320 12 0 00 002017' K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 32-1 K20TIM MAC 9-Nov-23 15:10 Check parity (if we're doing parity) 32966 000156'02 000000000000# 32967 001074'04 054 040 164 162 141 32968 dmove t1, [ .priou ; Still going to primary output 32969 002017'01 120 01 0 00 003664' point 8, devda2 ] ; From beginning of translation buffer 32970 002020'01 210 03 0 00 000006 movn t3, q2 ; Counted transfer 32971 002021'01 104 00 0 00 000053 SOUT% ; and type what we did 32972 002022'01 320 12 0 00 002024' %jserr(,) 32973 002023'01 254 00 0 00 002027' 32974 002024'01 265 01 0 00 002006* 32975 002025'01 000000000000# 32976 002026'01 254 00 0 00 002027' 32977 001100'04 103 157 165 154 144 32978 txmsg (<" 32979 002027'01 200 01 0 00 000000# >) ; Shutting off font-crock mode 32980 002030'01 104 00 0 00 000076 32981 002031'01 320 12 0 00 002032' 32982 000157'02 000000000000# 32983 001110'04 042 015 012 000 000 32984 002032'01 endif. 32985 002032'01 263 17 0 00 000000 ret ; Failure return 32986 32987 ;[223] End code insertion 32988 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 33 K20TIM MAC 9-Nov-23 15:10 Transfer timing routines 32989 subttl Transfer timing routines 32990 32991 ;[207] Begin code insertion 32992 32993 ; Historically, Kermit timed transfers using the time of day clock 32994 ; which has approximately 1/3 of second resolution. That's probably 32995 ; fine for dial up or even local terminals where the DH11 would limit 32996 ; you to 9600 baud. The most we could get in 1988 was 19.2Kbd on a 32997 ; local Microvax connecting to CU20B. 32998 ; 32999 ; The pseudo-terminal code can do a megabaud and TCP/IP uploads to 33000 ; ckermit are clearing 500 kilobaud. A short file can get sent in FAR 33001 ; less then a time of day tick. So we read some timers here that have 33002 ; greater resolution. 33003 ; 33004 ; Although it is not currently (2023) necessary to exceed DK10 33005 ; internal clock resolution (10 microseconds, see HPTIM%), a 33006 ; certain amount of anticipatory code has been written to do this, 33007 ; particularly in the area of extended uptimes. 33008 ; 33009 ; For example, Kermit can handle the display of terabaud speeds (see 33010 ; ranger in k20dsp). It should be noted that, with faster hosts, a 33011 ; transfer may get done in less time then the scheduling interval, so 33012 ; such times should be carefully reviewed. 33013 ; 33014 ; Another matter is such resolution with the extended uptimes 33015 ; apparently available with certain version of Tops-20. DEC and PANDA 33016 ; Tops-20 7.x can not handle a millisecond uptime which exceeds a 33017 ; signed 35 bit number. It will crash with an UP2LNG BUGHLT (see 33018 ; APRSRV) after 1 Year, 4 Weeks, 5 Days, 16 Hours, 22 Minutes, 18 33019 ; Seconds and 367 Milliseconds. 33020 33021 ; Given the user load on systems and the hardware technology of the 33022 ; early 1980's, this was about 5 times the maximum uptime (a little 33023 ; over two months) that was ever seen on CU20B. It is easily 33024 ; exceeded on systems with commodity hardware and one or two active 33025 ; users. 33026 ; 33027 ; The XKL (and possibly other) version(s) of Tops-20 return the uptime 33028 ; in a signed double word. The full 70 bit millisecond number will be 33029 ; reported as 37,539,161 Millennia, 7 Centuries, 2 Decades, 9 Years, 8 33030 ; Weeks, 2 Days, 11 Hours, 35 Minutes, 3 Seconds and 423 Milliseconds. 33031 ; 33032 ; Since the current estimate of the age of the universe is 13.7 33033 ; billion years, a thirty seven and a half billion year uptime is 33034 ; probably fine. 33035 ; 33036 ; This code handles running on an XKL monitor (which does not have 33037 ; DECnet support). 33038 ; 33039 ; In 2023, doing a get "NUL:" NUL: when connected to a pseudo- 33040 ; terminal gets an elapsed transfer time of 1.6 milliseconds, so we 33041 ; are already getting pretty close to the microsecond realm. 33042 33043 chgsec(code,data) ;;Declare writable storage K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 33-1 K20TIM MAC 9-Nov-23 15:10 Transfer timing routines 33044 33045 remark stdat,etdat,ewallt 33046 33047 xlist ; Save a few trees 33048 list ; Turn the listing back on 33049 33050 retsec 33051 33052 remark Set variables at the beginning of a transfer transfer 33053 33054 002033'01 statim: entry statim ; Allow global use 33055 002033'01 265 16 0 00 003666' saveac ; Don't side effect any accumulators 33056 33057 remark ; Set up initial states of timing blocks 33058 002034'01 415 04 0 00 000000# xmovei t4, etdat ; Resolve address of end time data block 33059 002035'01 260 17 0 00 002042' call zeroit ; Go zero it out 33060 33061 002036'01 415 04 0 00 000000# xmovei t4, ewallt ; Load address of elapsed wall time 33062 002037'01 260 17 0 00 002042' call zeroit ; Go whack that, too 33063 33064 002040'01 415 04 0 00 000000# xmovei t4, stdat ; Resolve address of timing data block 33065 002041'01 254 00 0 00 002052' callret timwrk ; Hit the time worker and return through it 33066 33067 002042'01 zeroit: remark t4,address ; Routine to stomp a time block 33068 002042'01 201 01 0 00 000020 movx t1, dtilen-1 ; Length of remaining structure to whack 33069 002043'01 200 02 0 00 000004 move t2, t4 ; First location to whack 33070 002044'01 201 03 0 02 000001 movei t3, 1(t2) ; Cascading whackage 33071 002045'01 402 00 0 02 000000 setzm (t2) ; Stomp the first word 33072 002046'01 123 01 0 00 003564' xblt. t1 ; Stomp the rest of them 33073 002047'01 263 17 0 00 000000 ret ; Done 33074 33075 remark Set variables at end of transfer 33076 33077 002050'01 endtim: entry endtim ; Allow global use 33078 002050'01 265 16 0 00 003666' saveac ; Don't side effect any accumulator 33079 002051'01 415 04 0 00 000000# xmovei t4, etdat ; Resolve address of timing data block 33080 remark timwrk ; fall through to the time worker 33081 ; (and return through it) 33082 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 34 K20TIM MAC 9-Nov-23 15:10 Time storage worker 33083 subttl Time storage worker 33084 33085 ; Call: Expects t4 to have the block address 33086 ; 33087 ; Be aware that all timing variables have gone from a single word to 33088 ; three words and resolution is stored in increasing resolution in 33089 ; order to not break any overlooked older code. 33090 ; 33091 ; The reads are done in the reverse order to keep HPTIM% as accurate 33092 ; as possible. "Accurate" may be debatable; the point of going to 33093 ; microsecond level reads was not accuracy so much as the timings had 33094 ; gone under a TOD tick (approximately 329.58858646932 milliseconds). 33095 ; 33096 ; It was subsequently discovered that some transfers are happening so 33097 ; quickly that they are approaching sub-millisecond levels (I.E., 33098 ; single digit milliseconds), bringing Kermit into the microsecond 33099 ; realm. 33100 ; 33101 ; Negative numbers will flag errors for uptime because these currently 33102 ; will not go negative. Since the time of day is actually unsigned 33103 ; (mostly), this isn't possible, so that is flagged as zero as Tops-20 33104 ; didn't exist in 1858. 33105 ; 33106 ; Note the compatible use of the strange XKL arguments to the TIME% 33107 ; JSYS, lifted from my rewrite of OS/2 UPTIME.MAC. Documentation of 33108 ; arcane TIME% changes from Ralph Gorin of XKL. The full text is 33109 ; STAR:TOPS-20-UPTIME.TXT. 33110 ; 33111 ; Date: Sat, 07 Mar 2009 14:35:18 -0800 33112 ; From: Ralph Gorin 33113 ; To: Thomas DeBellis 33114 ; CC: Tops-20 Wizards 33115 ; Subject: Re: Another Uptime Record 33116 ; In-Reply-To: <49B29F35.4010402@acedsl.com> 33117 ; Message-ID: <49B2F6A6.3040602@xkl.com> 33118 ; 33119 ; ... 33120 ; 33121 ; If AC 1 contains 'TODSEC' then return the uptime in seconds 33122 ; in AC 1, the residue in milliseconds in LH of AC 2 33123 ; and the divisor to convert to seconds (the number 1) 33124 ; in the RH of AC 2. 33125 ; 33126 ; If AC 1 contains 'MSTIME' then return the uptime in milliseconds 33127 ; as a double word in AC 1 and AC 2. 33128 ; 33129 ; For other values of AC 1, the old behavior is preserved. 33130 ; 33131 ; If the uptime has exceeded 2^35 milliseonds, the program gets the 33132 ; TIMEX3 error. This is an encouragement to fix old programs. 33133 ; 33134 ; Note, the code below is not 'perfect' because it will do the wrong 33135 ; thing on an XKL monitor that is up for 1000 milliseconds in the low 33136 ; order register, no matter is what in the high order. As this will 33137 ; 'only' happen for a single millisecond once every 56 Weeks, 5 Days, K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 34-1 K20TIM MAC 9-Nov-23 15:10 Time storage worker 33138 ; 16 Hours, 22 Minutes, 18 Seconds and 367 Milliseconds, it is 33139 ; expected to be 'relatively' uncommon. 33140 ; 33141 ; It also assumes that the millisecond uptime is stored as a 36 bit 33142 ; unsigned number. This isn't true in 'vanilla' Tops-20; it's a 35 33143 ; bit signed value and should never be negative. A bit of defensive 33144 ; coding for intermediate implementations. 33145 33146 002052'01 timwrk: remark t1,t2,t3 ; Previously saved and available 33147 002052'01 265 16 0 00 003700' saveac ; Will need t1-t4 for the double math 33148 002053'01 200 05 0 00 000004 move q1, t4 ; Save the address so have block of four accumulators 33149 33150 002054'01 403 01 0 00 000002 setzb t1, t2 ; A handy pair of zeros for .HPELP 33151 ; dmove t1, [ .HPELP ; Elapsed DK10 ticks since start 33152 ; 0 ] ; A handy zero 33153 002055'01 104 00 0 00 000501 HPTIM% ; Grab it 33154 002056'01 320 12 0 00 002060' ifje. r ; Failed?? 33155 002057'01 254 00 0 00 002063' 33156 002060'01 560 02 0 00 000001 hrro t2, t1 ; Turn negative to flag error 33157 002061'01 474 01 0 00 000000 seto t1, ; Ditto low order 33158 002062'01 254 00 0 00 002064' else. ; Otherwise worked, 33159 002063'01 250 02 0 00 000001 exch t2, t1 ; so put in low order 33160 002064'01 endif. ; and just use it 33161 002064'01 124 01 0 05 000017 dmovem t1, .datus(q1) ; Store amount or error (and possible flag) 33162 33163 002065'01 120 01 0 00 000000# dmove t1, mstime ; XKL's arcane 'magic' argument (if Toad) 33164 002066'01 104 00 0 00 000014 TIME% ; Get uptime in milliseconds (maybe long) 33165 002067'01 320 12 0 00 002071' ifje. r ; Failed?? 33166 002070'01 254 00 0 00 002074' 33167 002071'01 560 02 0 00 000001 hrro t2, t1 ; Turn negative to flag error 33168 002072'01 474 01 0 00 000000 seto t1, ; Ditto low order 33169 002073'01 254 00 0 00 002102' else. ; Otherwise, some kind of success 33170 002074'01 302 02 0 00 001750 caie t2, ^d1000 ; XKL monitor? 33171 002075'01 254 00 0 00 002102' ifskp. ; No, plain old 'vanilla' 33172 002076'01 200 02 0 00 000001 move t2, t1 ; Put low order in proper place 33173 002077'01 627 02 0 00 400000 tlzn t2,(1b0) ; Test if Negative, fix low order and skip 33174 002100'01 634 01 0 00 000001 tdza t1, t1 ; Positive, zero high order and skip 33175 002101'01 201 01 0 00 000001 movei t1, ^d1 ; Negative, put sign bit in the high order 33176 002102'01 endif. ; Otherwise XKL, so can stay up a lot longer!! 33177 002102'01 endif. ; End TIME% result handling 33178 002102'01 124 01 0 05 000015 dmovem t1, .datms(q1) ; Store error (and possible flag) 33179 33180 002103'01 325 01 0 00 002120' ifl. t1 ; TIME% gronked somehow? 33181 002104'01 104 00 0 00 000227 GTAD% ; Oh well, get time of day 33182 002105'01 320 12 0 00 002107' ifje. r ; Failed?? 33183 002106'01 254 00 0 00 002111' 33184 002107'01 552 01 0 05 000000 hrrzm t1, .dattd(q1) ;Store error and flag it (not 1858!!) 33185 002110'01 254 00 0 00 002117' else. ;Otherwise worked, 33186 002111'01 202 01 0 05 000000 movem t1, .dattd(q1) ; so just use it 33187 002112'01 200 02 0 00 000001 move t2, t1 ; Put low order in proper place 33188 002113'01 627 02 0 00 400000 tlzn t2,(1b0) ; Test if Negative, fix low order and skip 33189 002114'01 634 01 0 00 000001 tdza t1, t1 ; Positive, zero high order and skip 33190 002115'01 201 01 0 00 000001 movei t1, ^d1 ; Negative, put sign bit in the high order 33191 002116'01 124 01 0 05 000001 dmovem t1, .dattl(q1) ;Store signed double word result 33192 002117'01 endif. ; End JSYS result handling K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 34-2 K20TIM MAC 9-Nov-23 15:10 Time storage worker 33193 002117'01 263 17 0 00 000000 ret ; Either way, we're done 33194 002120'01 endif. 33195 33196 002120'01 260 17 0 00 002753' call miltod ; Convert millisecond uptime to TOD ticks 33197 002121'01 124 03 0 05 000013 dmovem t3, .datmr(q1) ; Store millisecond remainder 33198 002122'01 124 01 0 05 000001 dmovem t1, .dattl(q1) ; Time of Date (TOD) as signed double 33199 002123'01 322 01 0 00 002125' ifn. t1 ; Any high order? 33200 002124'01 661 02 0 00 400000 tlo t2,(1b0) ; Yes, coerce to low order 33201 002125'01 endif. 33202 002125'01 202 02 0 05 000000 movem t2, .dattd(q1) ; Time of Date (TOD) in unsigned ticks 33203 002126'01 263 17 0 00 000000 ret ; Done, finally 33204 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 35 K20TIM MAC 9-Nov-23 15:10 Compute Elapsed Wall Times 33205 subttl Compute Elapsed Wall Times 33206 33207 ; Populates a block with elapsed TOD ticks, milliseconds and HPTIM% 33208 ; ticks (10 ms resolution). 33209 ; 33210 ; Note that the HPTIM% elapsed wall time will wrap at a value of 3 33211 ; Days, 4 Hours, 21 Minutes, 17 Seconds, 906 Milliseconds and 940 33212 ; Microseconds (76:21:17.906.940). This is the basis for the comment 33213 ; of 76 hours in the monitor. Therefore, the greatest possible 33214 ; elapsed high precision time that can be measured is the above. 33215 ; 33216 ; The value for maxhpt is gotten by running the monitor code (MTIME:: 33217 ; in APRSRV.MAC with the maximum value that RDTIME could theoretically 33218 ; return, a double word of .infin (377777,,-1). No known processor 33219 ; would do this and other uptime counters would have wrapped far 33220 ; before we got anywhere near this value. 33221 ; 33222 ; Be aware that the value for maxhpt is in HPTIM% ticks or DK10 units 33223 ; when running on the 100 kHz internal clock. Should you wish to double 33224 ; check this value (say by putting it into UPTIME), then you need to 33225 ; multiply it by 10 decimal to scale it to microseconds. That value 33226 ; will be the double word value 7::377777,,777774. 33227 ; 33228 ; If that situation is detected, then we punt and simulate with an 33229 ; appropriately scaled millisecond value. However, the maximum amount 33230 ; of DK10 time that can be held in a single word is .infin, which 33231 ; works out to 95:26:37.383.670. If that situation is hit, then we 33232 ; stop faking DK10 ticks and just pretend we don't have any more of 33233 ; them. 33234 ; 33235 ; maxmil is the value of maxhpt scaled (from DK10 ticks) to milli- 33236 ; seconds, meaning the value is divided by 100 decimal. I didn't see 33237 ; how to compute these values symbolically as there are some 33238 ; intermediate results which are double words, so I just did 33239 ; everything in DDT and documented here. 33240 ; 33241 ; Note that the order of the calculations matters here because Tops-20 33242 ; rounds up TOD ticks, but we can't because, at a minimum, we are 33243 ; timing at millisecond resolution, which is two decimal orders of 33244 ; magnitude less than a TOD tick. The more common case of DK10 (or 33245 ; microsecond) resolution, is five orders of magnitude less. If we 33246 ; don't handle things ourselves, you can have the case where time 33247 ; appears to be going backwards in a high resolution log file. 33248 ; 33249 ; HPTIM% ticks are stored as signed doubles to allow for future code 33250 ; which can read finer times (see documentation for RDTIME instruction) 33251 33252 002127'01 000000 000000 maxhpt: 0 ; See MTIME in APRSRV 33253 002130'01 314631 463146 314631,,463146 ; N.B., DK10 units (10 us), not usecs! 33254 002131'01 000000 000000 maxmil: 0 ; Maximum HPTIM% in milliseconds 33255 002132'01 002030 446722 2030,,446722 ; maxmil is maxhpt divided by 100 decimal 33256 33257 002133'01 elptim: entry elptim ; Called from K20MIT, results used in K20DSP 33258 002133'01 265 16 0 00 003710' saveac ;Don't side-effect any registers!! 33259 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 20:02 27-Nov-23 Page 35-1 K20TIM MAC 9-Nov-23 15:10 Compute Elapsed Wall Times 33260 002135'01 415 13 0 00 000000# xmovei p3, etdat ; Load address of ending time and date block 33261 002136'01 415 12 0 00 000000# xmovei p2, stdat ; Load address of starting time and date block 33262 33263 002137'01 201 01 0 00 000020 movx t1, dtilen-1 ; Length of remaining structure to whack 33264 002140'01 200 02 0 00 000014 move t2, p4 ; First location to whack 33265 002141'01 201 03 0 02 000001 movei t3, 1(t2) ; Cascading whackage 33266 002142'01 476 00 0 02 000000 setom (t2) ; Set first word to ERROR value 33267 002143'01 123 01 0 00 003564' xblt. t1 ; Stomp the rest of them 33268 ; Do milliseconds in case we must fix up 33269 002144'01 415 16 0 00 002166' block. ; Enter block context for better control flow 33270 002145'01 261 17 0 00 000016 33271 002146'01 120 01 0 13 000015 dmove t1, .datms(p3) ; Load ending milliseconds double word 33272 002147'01 120 03 0 12 000015 dmove t3, .datms(p2) ; Load starting milliseconds double word 33273 002150'01 321 01 0 00 001444* jumpl t1, R ; Negative means some kind of failure on TIME% 33274 002151'01 321 03 0 00 002150* jumpl t3, R ; Ditto 33275 002152'01 316 03 0 00 000001 dcamg t3, t1 ; We didn't get anything backwards, did we? 33276 002153'01 254 00 0 00 002157' 33277 002154'01 317 03 0 00 000001 33278 002155'01 254 00 0 00 002160' 33279 002156'01 254 00 0 00 002161' 33280 002157'01 317 04 0 00 000002 33281 002160'01 254 00 0 00 002163' ifskp. ; Well, that's peculiar ... 33282 002161'01 250 01 0 00 000003 exch t1, t3 ; Swap high orders 33283 002162'01 250 02 0 00 000004 exch t2, t4 ; Swap low orders 33284 002163'01 endif. 33285 002163'01 115 01 0 00 000003 dsub t1, t3 ; Calculate elapsed milliseconds (should never wrap) 33286 002164'01 254 00 0 00 001774* retskp ; Success! 33287 002165'01 263 17 0 00 000000 endbk. ; End block context 33288 002166'01 254 00 0 00 002174' ifskp. ; Successful calculation block exit 33289 002167'01 124 01 0 14 000015 dmovem t1, .datms(p4) ; Store millisecond resolution 33290 002170'01 260 17 0 00 002753' call miltod ; Convert to elapsed TOD and remainder milliseconds 33291 002171'01 124 01 0 14 000011 dmovem t1, .datem(p4) ; Save elapsed TOD 33292 002172'01 124 03 0 14 000013 dmovem t3, .datmr(p4) ; Save remainder milliseconds 33293 002173'01 254 00 0 00 002175' else. ; Otherwise, some kind of odd input arguments 33294 002174'01 254 00 0 00 003014' jrst ovrflw ; Complain and punt 33295 002175'01 endif. ; Done elapsed milliseconds 33296 ; Do elapsed HPTIM% ticks 33297 002175'01 415 16 0 00 002236' block. ; Enter block context for better control flow 33298 002176'01 261 17 0 00 000016 33299 002177'01 120 01 0 14 000015 dmove t1, .datms(p4) ; Load millisecond resolution 33300 002200'01 316 01 0 00 002131' dcamg t1, maxmil ; Duration exceeds HPTIM% maximum? 33301 002201'01 254 00 0 00 002205' 33302 002202'01 317 01 0 00 002131' 33303 002203'01 254 00 0 00 002206' 33304 002204'01 254 00 0 00 002207' 33305 002205'01 317 02 0 00 002132' 33306 002206'01 254 00 0 00 002211' ifskp. ; Yes, then fake the HP ticks 33307 002207'01 260 17 0 00 002260' call ms2hp ; Convert milliseconds to equivalent DK10 units 33308 002210'01 254 00 0 00 002164* retskp ; Break out of the block 33309 002211'01 endif. ; End case handling HPTIM% overflow 33310 remark ; Otherwise, can still do DK10 resolution 33311 002211'01 120 01 0 13 000017 dmove t1, .datus(p3) ; Load ending HPTIM% ticks double word 33312 002212'01 120 03 0 12 000017 dmove t3, .datus(p2) ; Load beginning HPTIM% ticks double word 33313 002213'01 321 01 0 00 002151* jumpl t1, R ; Negative means some kind of failure on HPTIM% 33314 002214'01 321 03 0 00 002213* jumpl t3, R ; Ditto K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 35-2 K20TIM MAC 9-Nov-23 15:10 Compute Elapsed Wall Times 33315 002215'01 316 03 0 00 000001 dcaml t3, t1 ; Did the HPTIM% count wrap around? 33316 002216'01 254 00 0 00 002222' 33317 002217'01 311 03 0 00 000001 33318 002220'01 254 00 0 00 002223' 33319 002221'01 254 00 0 00 002224' 33320 002222'01 311 04 0 00 000002 33321 002223'01 254 00 0 00 002227' ifskp. ; No, so safe to subtract 33322 002224'01 115 01 0 00 000003 dsub t1, t3 ; Compute elapsed ticks 33323 002225'01 254 00 0 00 002210* retskp ; Get out of here, we're done 33324 002226'01 254 00 0 00 002235' else. ; Otherwise, calculate the wrap gap 33325 002227'01 261 17 0 00 000012 push p, p2 ; Preserve pointer to starting ticks 33326 002230'01 120 11 0 00 002127' dmove p1, maxhpt ; Load MTIME's odd wrap value 33327 002231'01 115 11 0 00 000003 dsub p1, t3 ; Calculate ticks to wrap point 33328 002232'01 114 01 0 00 000011 dadd t1, p1 ; Calculate total elapsed ticks 33329 002233'01 262 17 0 00 000012 pop p, p2 ; Restore pointer to starting ticks 33330 002234'01 254 00 0 00 002225* retskp ; As per non-wrapped case, result is in t2 33331 002235'01 endif. ; End calculating HP tick difference 33332 002235'01 263 17 0 00 000000 endbk. ; End block context 33333 002236'01 254 00 0 00 002244' ifskp. ; Successful calculation block exit 33334 002237'01 124 01 0 14 000017 dmovem t1, .datus(p4) ; Store elapsed HPTIM% ticks 33335 002240'01 260 17 0 00 002302' call etodhp ; Extract the elapsed TOD and HP ticks 33336 002241'01 124 01 0 14 000005 dmovem t1, .dateh(p4) ; Store elapsed TOD ticks, DK10 base 33337 002242'01 124 03 0 14 000007 dmovem t3, .datdk(p4) ; Store remaining DK10 ticks 33338 002243'01 254 00 0 00 002245' else. ; Otherwise, some kind of odd input arguments 33339 002244'01 254 00 0 00 003014' jrst ovrflw ; Complain and punt 33340 002245'01 endif. ; Done elapsed HPTIM% ticks 33341 33342 remark ; Calculate ending TOD 33343 002245'01 120 01 0 12 000015 dmove t1, .datms(p2) ; Load starting uptime 33344 002246'01 114 01 0 14 000015 dadd t1, .datms(p4) ; Add elapsed milliseconds 33345 002247'01 114 01 0 00 000000# dadd t1, bootrm ; Also original boot millisecond remainder 33346 002250'01 260 17 0 00 002753' call miltod ; Calculate proper elapsed TOD 33347 002251'01 124 03 0 14 000003 dmovem t3, .dattr(p4) ; Store remainder milliseconds 33348 002252'01 114 01 0 00 000000# dadd t1, bootdd ; Bring into range of current date and time 33349 002253'01 124 01 0 14 000001 dmovem t1, .dattl(p4) ; Store as unrounded ending time 33350 002254'01 322 01 0 00 002256' ifn. t1 ; Total is 36 bits, signed double? 33351 002255'01 661 02 0 00 400000 tlo t2, (1b0) ; Coerce to 36 bits unsigned single 33352 002256'01 endif. ; End of date far in the future 33353 002256'01 202 02 0 14 000000 movem t2, .dattd(p4) ; Store as unrounded ending time 33354 002257'01 263 17 0 00 000000 ret ; Done, restoring dirty registers 33355 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 36 K20TIM MAC 9-Nov-23 15:10 Convert Milliseconds to equivalent DK10 internal clock units 33356 subttl Convert Milliseconds to equivalent DK10 internal clock units 33357 33358 ; Used when HPTIM% result exceeds 95:26:37.383.670 (TOD: 1042499) 33359 ; 33360 ; Call: 33361 ; 33362 ;T1,T2/ millisecond signed double word 33363 ; 33364 ; Return: 33365 ; 33366 ;T1,T2/ Equivalent HP ticks (call value times 100 decimal) 33367 ; 33368 ; N.B., Currently does not do anything useful on overflow, +1 always 33369 33370 002260'01 326 01 0 00 002263' ms2hp: ife. t1 ; Maybe bum the math 33371 002261'01 326 02 0 00 002263' ife. t2 ; Got called with a zero double word? 33372 002262'01 263 17 0 00 000000 ret ; Get out of here, we're done 33373 002263'01 endif. 33374 002263'01 endif. 33375 33376 002263'01 265 16 0 00 003603' saveac ; Maybe somebody might be using these 33377 002264'01 255 17 0 00 002265' jfcl 17,.+1 ; Clear all flags 33378 002265'01 116 01 0 00 003726' dmul t1, [exp 0, ^d100] ; Scale milliseconds up to DK10 units 33379 002266'01 415 16 0 00 002275' block. ; Enter block context for easier control flow 33380 002267'01 261 17 0 00 000016 33381 002270'01 255 17 0 00 002214* jfcl 17, R ; Punt if any kind of oddity 33382 002271'01 326 01 0 00 002270* jumpn t1, R ; Upper high order of 140 bit result? 33383 002272'01 326 02 0 00 002271* jumpn t2, R ; Lower high order of 140 bit result? 33384 002273'01 254 00 0 00 002234* retskp ; No to both, return 70 bit result 33385 002274'01 263 17 0 00 000000 endbk. ; End block contxt 33386 002275'01 254 00 0 00 002300' ifskp. ; In range uptime? 33387 002276'01 120 01 0 00 000003 dmove t1, t3 ; Yes, return that 33388 002277'01 254 00 0 00 002301' else. ; Wow... Big uptime 33389 002300'01 254 00 0 00 003014' callret ovrflw ; Go clip down to 'reasonable' maximum 33390 002301'01 endif. ; End case HPTIM% overflow handling 33391 002301'01 263 17 0 00 000000 ret ; Done HPTIM% fixup 33392 33393 ;[207] End code insertion 33394 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 37 K20TIM MAC 9-Nov-23 15:10 Extract TOD ticks from HPTIM% ticks 33395 subttl Extract TOD ticks from HPTIM% ticks 33396 33397 ;[221] Begin code insertion 33398 33399 ; Call: 33400 ; 33401 ; t1/ Elapsed HPTIM% ticks high order 33402 ; t2/ Elapsed HPTIM% ticks low order 33403 ; Return: 33404 ; 33405 ; t1/ Elapsed TOD ticks, high order 33406 ; t2/ Elapsed TOD ticks, low order 33407 ; t3/ Remaining HPTIM% ticks after TOD's are extracted, high order 33408 ; t4/ Remaining HPTIM% ticks after TOD's are extracted, low order 33409 ; 33410 ; Proportion to extract TOD X given DK10 Y is Y:DK10=X:TOD, where TOD 33411 ; is equal to 262,144 and DK10 is equal to 8,640,000,000 (that's eight 33412 ; million, six hundred and fourty thousand). Solving for X gives: 33413 ; 33414 ; X*DK10 = Y*TOD or X = (Y*TOD)/DK10 33415 ; 33416 ; To convert input X TOD ticks to the equivalent Y DK10 ticks, the 33417 ; proportion remains the same, but we solve for Y, instead, viz: 33418 ; 33419 ; X*DK10 = Y*TOD or Y = (X*DK10)/TOD 33420 ; 33421 ; Recall that these fractions are not exact and that there are 33422 ; 32958.98438 DK10 ticks per TOD tick. This can be found by the 33423 ; following code: 33424 ; 33425 ; movx t1, <86400.> ; Numerator is seconds in a day 33426 ; movx t2, <262144.> ; Denominator is TOD tics in a day 33427 ; movx t3, <100000.> ; DK10 ticks in a second 33428 ; fdv t1, t2 ; Gets .3295898438 seconds per TOD tick 33429 ; fmp t1, t3 ; Gets 32958.98438 DK10 ticks per TOD tick 33430 ; 33431 ; Again, this kind of precision is necessary for short messages when 33432 ; doing megabaud communications, a TOD tick being wholly insufficient. 33433 ; It is unknown whether it would be sufficient for the case of short 33434 ; messages when doing gigabaud communications. Time marches on... 33435 ; 33436 ; Assumes signed 72 bit number is ALWAYS positive!! 33437 33438 002302'01 326 01 0 00 002306' etodhp: ife. t1 ; Maybe bum the math 33439 002303'01 326 02 0 00 002306' ife. t2 ; Got called with a zero double word? 33440 002304'01 403 03 0 00 000004 setzb t3, t4 ; Yes, so zero the remainder 33441 002305'01 263 17 0 00 000000 ret ; Get out of here, we're done 33442 002306'01 endif. 33443 002306'01 endif. 33444 33445 002306'01 265 16 0 00 003645' saveac ; Will need some temporary storage 33446 002307'01 120 07 0 00 000001 dmove q3, t1 ; Save the original dividend 33447 33448 002310'01 255 17 0 00 002311' jfcl 17, .+1 ; Clear the flags 33449 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 20:02 27-Nov-23 Page 37-1 K20TIM MAC 9-Nov-23 15:10 Extract TOD ticks from HPTIM% ticks 33450 002312'01 255 17 0 00 003014' jfcl 17, ovrflw ; Over 140 bits??? 33451 002313'01 326 01 0 00 003014' jumpn t1, ovrflw ; Over 105 bits?? 33452 002314'01 326 02 0 00 003014' jumpn t2, ovrflw ; Over 70 bits? 33453 002315'01 117 01 0 00 000000# ddiv t1, dkdayd ; Strip off remaining DK10 ticks 33454 002316'01 255 17 0 00 003014' jfcl 17, ovrflw ; Catch any odd math strangeness 33455 33456 remark ; Remember, returning remainder; NOT ROUNDING 33457 002317'01 120 03 0 00 000001 dmove t3, t1 ; Load quotient 33458 002320'01 116 03 0 00 000000# dmul t3, dkdayd ; Scale TOD ticks by DK10 ticks 33459 002321'01 255 17 0 00 003014' jfcl 17, ovrflw ; Over 140 bits??? 33460 002322'01 326 03 0 00 003014' jumpn t3, ovrflw ; Over 105 bits?? 33461 002323'01 326 04 0 00 003014' jumpn t4, ovrflw ; Over 70 bits? 33462 002324'01 117 03 0 00 000000# ddiv t3, tticdw ; Strip off remaining TOD ticks 33463 002325'01 255 17 0 00 003014' jfcl 17, ovrflw ; Catch any odd math strangeness 33464 33465 remark q1:q2 ; Should we round? For now, don't 33466 002326'01 316 03 0 00 000007 dcamg t3, q3 ; We didn't get anything backwards, did we? 33467 002327'01 254 00 0 00 002333' 33468 002330'01 317 03 0 00 000007 33469 002331'01 254 00 0 00 002334' 33470 002332'01 254 00 0 00 002335' 33471 002333'01 317 04 0 00 000010 33472 002334'01 254 00 0 00 002337' ifskp. ; That's odd; fix it 33473 002335'01 250 07 0 00 000003 exch q3, t3 ; Swap high order 33474 002336'01 250 10 0 00 000004 exch q4, t4 ; Swap low order 33475 002337'01 endif. 33476 002337'01 115 07 0 00 000003 dsub q3, t3 ; Calculate remaining DK10 ticks 33477 ; remark ; This DSUB should not set flags, but does 33478 ; jfcl 17, ovrflw ; Catch any odd math strangeness 33479 33480 ; dcamle q3,[exp 0,^d32958] ;Remainder should never exceed this 33481 ; jrst ovrflw ; But did 33482 002340'01 120 03 0 00 000007 dmove t3, q3 ; Return remaining DK10 ticks 33483 33484 002341'01 263 17 0 00 000000 ret ; Done 33485 33486 ;[221] End code insertion 33487 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 38 K20TIM MAC 9-Nov-23 15:10 Expresses a duration in DK10 units (tens of microseconds) 33488 subttl Expresses a duration in DK10 units (tens of microseconds) 33489 33490 ;[207] Begin code insertion 33491 33492 ; t1/ Output pointer or JFN 33493 ; t2/ Pointer to time structure 33494 33495 002342'01 durtim: entry durtim ; Also called by k20dsp 33496 002342'01 265 16 0 00 003446' saveac ; Used to save a pointer 33497 33498 002343'01 200 05 0 00 000002 move q1, t2 ; Save pointer to structure 33499 002344'01 201 02 0 05 000017 movei t2, .datus(q1) ; Resolve pointer to elapsed DK10 ticks 33500 002345'01 400 03 0 00 000000 setz t3, ;[221] Do not suppress leading seconds 33501 002346'01 260 17 0 00 002370' call ehptim ; Display elapsed HP ticks 33502 002347'01 600 00 0 00 000000 nop ;[221] Ignore +1, it isn't fatal 33503 33504 002350'01 120 03 0 05 000005 dmove t3, .dateh(q1) ;[221] Load elapsed TOD ticks 33505 002351'01 326 03 0 00 002354' ife. t3 ;[221] No high order 33506 002352'01 326 04 0 00 002354' ife. t4 ;[221] and no low order? 33507 002353'01 263 17 0 00 000000 ret ;[221] None; suppress the whole thing 33508 002354'01 endif. ;[221] 33509 002354'01 endif. ;[221] 33510 33511 002354'01 322 03 0 00 002356' ifn. t3 ; Any high order? 33512 002355'01 661 04 0 00 400000 tlo t4,(1b0) ; Yes, coerce to low order 33513 002356'01 endif. 33514 002356'01 322 04 0 00 002367' ifn. t4 ; Got any TOD ticks? 33515 002357'01 120 02 0 00 000000# smsg < (TOD: > 33516 002360'01 260 17 0 00 000000* 33517 000160'02 000000000000# 33518 000161'02 777777 777771 33519 001111'04 040 050 124 117 104 33520 002361'01 200 02 0 00 000004 move t2, t4 ; Load elapsed TOD ticks 33521 002362'01 200 03 0 00 003730' movx t3, ;N.B., Unsigned!! 33522 002363'01 104 00 0 00 000224 NOUT% 33523 002364'01 320 14 0 00 002272* erjmps r 33524 002365'01 120 02 0 00 000000# smsg <)> ; Close off and return 33525 002366'01 260 17 0 00 002360* 33526 000162'02 000000000000# 33527 000163'02 777777 777777 33528 001113'04 051 000 000 000 000 33529 002367'01 endif. 33530 33531 002367'01 263 17 0 00 000000 ret ; Done, restore registers, destroy frame 33532 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 39 K20TIM MAC 9-Nov-23 15:10 Display elapsed HP ticks 33533 subttl Display elapsed HP ticks 33534 33535 ; Call: 33536 ; 33537 ; t1/ Output pointer (or .PRIOU) 33538 ; t2/ Pointer to double word of duration in HPTIM% ticks 33539 ; [DK10 Internal 100 Khz resolution, tens of microseconds] 33540 ; t3/ Leading second suppression flag 33541 ; 33542 ; +1/ Something untoward happened ... 33543 ; +2/ Everything's Archie 33544 ; t1/ Updated, if string pointer 33545 33546 002370'01 ehptim: entry ehptim ; Also called by k20par 33547 remark t1 ; It is deadly to touch t1!! 33548 remark ; Assumes these may be smashed 33549 002370'01 265 16 0 00 000000* trvar <,hrs,mins,secs,mils,dk10,lsflag> ;[221] 33550 002371'01 000000 000010 33551 33552 002372'01 202 03 0 15 000010 movem t3, lsflag ;[221] Save leading second flag 33553 002373'01 120 03 0 02 000000 dmove t3, (t2) ;[221] Load the duration (don't overwrite t2, yet) 33554 002374'01 124 03 0 15 000001 dmovem t3, dur ;[221] Save for internal debugging 33555 002375'01 403 03 0 00 000004 setzb t3, t4 ; Cons up some zeros 33556 002376'01 124 03 0 15 000003 dmovem t3, hrs ; Stomp hours and minutes 33557 002377'01 124 03 0 15 000005 dmovem t3, secs ; Stomp seconds and milliseconds 33558 002400'01 402 00 0 15 000007 setzm dk10 ; Stomp tens of microseconds 33559 002401'01 120 02 0 15 000001 dmove t2,dur ;[221] Load the duration double word 33560 ; Let's get down to some arithmatic 33561 002402'01 415 16 0 00 002430' ehpti1: block. ; Enter block context for easier control flow 33562 002403'01 261 17 0 00 000016 33563 002404'01 255 17 0 00 002405' jfcl 17,.+1 ; Clear any flags, just in case 33564 002405'01 235 02 0 00 000144 divi t2, ^d100 ; Strip out DK10 ticks 33565 002406'01 255 10 0 00 002364* jov r ; Stop on overflow 33566 002407'01 250 03 0 15 000007 exch t3, dk10 ; Store DK10 ticks and rezero remainder 33567 002410'01 322 02 0 00 002406* jumpe t2, r ; If no more quotient, then done 33568 002411'01 250 02 0 00 000003 exch t2, t3 ; Zero in high order, quotient in low order 33569 002412'01 235 02 0 00 001750 divi t2, ^d1000 ; Strip out milliseconds 33570 002413'01 255 10 0 00 002410* jov r ; Stop on overflow 33571 002414'01 250 03 0 15 000006 exch t3, mils ; Store milliseconds and rezero quotient 33572 002415'01 322 02 0 00 002413* jumpe t2, r ; If no more quotient, then done 33573 002416'01 250 02 0 00 000003 exch t2, t3 ; Zero in high order, quotient in low order 33574 002417'01 235 02 0 00 000074 divi t2, ^d60 ; Strip out seconds 33575 002420'01 255 10 0 00 002415* jov r ; Stop on overflow 33576 002421'01 250 03 0 15 000005 exch t3, secs ; Store seconds and rezero quotient 33577 002422'01 322 02 0 00 002420* jumpe t2, r ; If no more quotient, then done 33578 002423'01 250 02 0 00 000003 exch t2, t3 ; Zero in high order, quotient in low order 33579 002424'01 235 02 0 00 000074 divi t2, ^d60 ; Strip out minutes 33580 002425'01 202 03 0 15 000004 movem t3, mins ; Store minutes 33581 002426'01 202 02 0 15 000003 movem t2, hrs ; Store hours 33582 002427'01 263 17 0 00 000000 endbk. ; Exit block context 33583 33584 002430'01 337 02 0 15 000003 ehpti2: skipg t2, hrs ; Have any hours? 33585 002431'01 254 00 0 00 002441' ifskp. ; Yes, print as many as there are 33586 002432'01 201 03 0 00 000012 movx t3, fld(^d10,no%rdx) 33587 002433'01 104 00 0 00 000224 NOUT% K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 39-1 K20TIM MAC 9-Nov-23 15:10 Display elapsed HP ticks 33588 002434'01 320 14 0 00 002422* erjmps r 33589 002435'01 201 02 0 00 000072 movei t2, ":" ; Puctuate hours 33590 002436'01 260 17 0 00 000000* call BOUTI% ;[216] 33591 002437'01 474 04 0 00 000000 seto t4, ; Mark hours were printed 33592 002440'01 254 00 0 00 002442' else. ; Otherwise, no hours 33593 002441'01 400 04 0 00 000000 setz t4, ; Mark no hours printed 33594 002442'01 endif. 33595 33596 002442'01 322 04 0 00 002446' ehpti3: ifn. t4 ; Previous? 33597 002443'01 200 02 0 15 000004 move t2, mins ; Yes, MUST print minutes 33598 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 33599 002445'01 254 00 0 00 002451' else. ; Otherwise, nothing previous 33600 002446'01 201 03 0 00 000012 movx t3, fld(^d10,no%rdx) ; So no leading digits 33601 002447'01 332 02 0 15 000004 skipe t2, mins ; Have any minutes? 33602 002450'01 474 04 0 00 000000 seto t4, ; Yes, force a print 33603 002451'01 endif. 33604 33605 002451'01 322 04 0 00 002464' ifn. t4 ; Have to print minutes 33606 002452'01 322 02 0 00 002456' ifn. t2 ; Do we have a number? 33607 002453'01 104 00 0 00 000224 NOUT% ; We do, so print it 33608 002454'01 320 14 0 00 002434* erjmps r ; Catch and suppress error 33609 002455'01 254 00 0 00 002462' else. ; It's zero, so let's bum the NOUT% 33610 002456'01 201 02 0 00 000060 movei t2, "0" ; Load the zero 33611 002457'01 260 17 0 00 002436* call BOUTI% ; Type it 33612 002460'01 603 03 0 00 100000 txne t3,no%lfl ; Not fixed columns? 33613 002461'01 260 17 0 00 002457* call BOUTI% ; No, so type it twice to make "00" 33614 002462'01 endif. ; End case NOUT% execution determination 33615 002462'01 201 02 0 00 000072 movei t2, ":" ; Punctuate minutes 33616 002463'01 260 17 0 00 002461* call BOUTI% ;[216] 33617 002464'01 endif. 33618 33619 002464'01 322 04 0 00 002467' ehpti4: ifn. t4 ; Columnar if did minutes 33620 002465'01 200 03 0 00 003731' movx t3, no%lfl!no%zro!no%ast!fld(^d2,no%col)!fld(^d10,no%rdx) 33621 002466'01 254 00 0 00 002470' else. ; No, so somewhat more free form 33622 002467'01 201 03 0 00 000012 movx t3, fld(^d10,no%rdx) 33623 002470'01 endif. 33624 33625 002470'01 415 16 0 00 002501' block. ;[221] Enter control block for better flow 33626 002471'01 261 17 0 00 000016 33627 002472'01 326 04 0 00 002273* jumpn t4, RSKP ;[221] If printed minutes, MUST print seconds 33628 002473'01 332 00 0 15 000005 skipe secs ;[221] No seconds? 33629 002474'01 254 00 0 00 002472* retskp ;[221] No, if non-zero, must print them 33630 002475'01 336 00 0 15 000010 skipn lsflag ;[221] Got told to suppress the seconds 33631 002476'01 254 00 0 00 002474* retskp ;[221] No, so print them 33632 002477'01 263 17 0 00 000000 ret ;[221] Otherwise, don't 33633 002500'01 263 17 0 00 000000 endbk. ;[221] End control block context 33634 002501'01 254 00 0 00 002513' ifskp. ;[221] +1 means we must print seconds 33635 002502'01 336 02 0 15 000005 skipn t2, secs ; Load and always print seconds 33636 002503'01 254 00 0 00 002507' ifskp. ; Non-zero, so print it 33637 002504'01 104 00 0 00 000224 NOUT% 33638 002505'01 320 14 0 00 002454* erjmps r 33639 002506'01 254 00 0 00 002513' else. ; Otherwise, was zero 33640 002507'01 201 02 0 00 000060 movei t2, "0" ; So bum the NOUT% 33641 002510'01 260 17 0 00 002463* call BOUTI% ;[216] 33642 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 20:02 27-Nov-23 Page 39-2 K20TIM MAC 9-Nov-23 15:10 Display elapsed HP ticks 33643 002512'01 260 17 0 00 002510* call BOUTI% ;[216] Have to print another zero if minutes 33644 002513'01 endif. 33645 002513'01 endif. ;[221] End case forced print of seconds 33646 33647 ; N.B., Didn't know how or if to punctuate (tens of) microseconds, so 33648 ; broke them out seperately. It still looked funny, so I simply 33649 ; alide them until I find out what the right thing to do is. 33650 33651 002513'01 200 04 0 15 000006 ehpti5: move t4, mils ; Load milliseconds 33652 002514'01 434 04 0 15 000007 or t4, dk10 ; Or in any dk10 total 33653 002515'01 322 04 0 00 002540' ifn. t4 ; If either is set, then display 33654 002516'01 201 02 0 00 000056 movei t2, "." ; Punctuate milliseconds 33655 002517'01 260 17 0 00 002512* call BOUTI% ;[216] 33656 002520'01 336 02 0 15 000006 skipn t2, mils ; Mils can go up to 999 33657 002521'01 254 00 0 00 002526' ifskp. ; Have a real value, so print it 33658 002522'01 200 03 0 00 003732' movx t3, no%lfl!no%zro!no%ast!fld(^d3,no%col)!fld(^d10,no%rdx) 33659 002523'01 104 00 0 00 000224 NOUT% 33660 002524'01 320 14 0 00 002505* erjmps r 33661 ;;;; movei t2, "." ; Punctuate tens of microseconds 33662 ;;;; call BOUTI% ;[216] 33663 002525'01 254 00 0 00 002530' else. ; Otherwise, was zero 33664 ;;;; smsg <000.> ; So bum the NOUT% and the BOUT% 33665 002526'01 120 02 0 00 000000# smsg <000> ; So bum the NOUT% and the BOUT% 33666 002527'01 260 17 0 00 002366* 33667 000164'02 000000000000# 33668 000165'02 777777 777775 33669 001114'04 060 060 060 000 000 33670 002530'01 endif. 33671 002530'01 336 02 0 15 000007 skipn t2, dk10 ; DK10 can go up to 99 33672 002531'01 254 00 0 00 002536' ifskp. ; Have a real value, so print it 33673 002532'01 200 03 0 00 003731' movx t3, no%lfl!no%zro!no%ast!fld(^d2,no%col)!fld(^d10,no%rdx) 33674 002533'01 104 00 0 00 000224 NOUT% 33675 002534'01 320 14 0 00 002524* erjmps r 33676 ;;;; remark ; Don't fool ourselves into thinking we have true mHz 33677 ;;;; movei t2, "0" ; Show it as hundreds of microseconds 33678 ;;;; call BOUTI% ;[216] 33679 002535'01 254 00 0 00 002540' else. ; Otherwise, was zero 33680 ;;;; smsg <000> ; So bum the NOUT% and the BOUT% 33681 002536'01 120 02 0 00 000000# smsg <00> ; So bum the NOUT% and the BOUT% 33682 002537'01 260 17 0 00 002527* 33683 000166'02 000000000000# 33684 000167'02 777777 777776 33685 001115'04 060 060 000 000 000 33686 002540'01 endif. 33687 002540'01 endif. 33688 002540'01 263 17 0 00 000000 ret ; Don't forget to return!!! 33689 33690 endtv. ; End lexical context transient variables 33691 33692 ;[207] End code insertion 33693 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 40 K20TIM MAC 9-Nov-23 15:10 Initialize time variables 33694 subttl Initialize time variables 33695 33696 ; Tops-20 takes the time of day and rounds it to the nearest TOD tick, 33697 ; which is .3295898438, which can easily cause messages to appear to 33698 ; have happened at the same time at high kilobaud and above speeds. 33699 ; 33700 ; Therefore, we never use GTAD% for timing because we can't tell where 33701 ; Tops-20 might have rounded. We use GTAD% precisely once to get the 33702 ; current date and time in internal format. We then use TIME% to get 33703 ; the elapsed milliseconds since system boot and subtract that from 33704 ; from the previous. 33705 ; 33706 ; Note that the math to do this is NOT rounded. The reason for this 33707 ; is to make sure that time doesn't go backwards for higher precision 33708 ; logging. 33709 ; 33710 ; N.B., HPTIM% can not be used because the current interface rounds it 33711 ; every 76 hours. 33712 33713 chgsec(code,const) ; Monitor symbol names are constants 33714 000170'02 55 63 64 51 55 45 mstime: sixbit "MSTIME" ; XKL's arcane 'magic' argument 33715 000171'02 000000 000000 0 ; Used to side-effect T2 33716 retsec ; Return back to original .PSECT 33717 33718 chgsec(code,data) ; Values go in writable storage 33719 000211'05 prgsdt: block 1 ; Program start date and time (unsigned!) 33720 000212'05 prgsdd: block 2 ; Same thing as a signed double word 33721 000214'05 sysums: block 2 ; System uptime in milliseconds on startup 33722 000216'05 bootdt: block 1 ; System boot as unsigned GTAD% word 33723 000217'05 bootdd: block 2 ; Same thing as a signed double word 33724 000221'05 bootrm: block 2 ; Remainder milliseconds in calculation 33725 000223'05 mhptod::block 1 ;[239] ; Set if monitor has high precision time of day 33726 000224'05 ehptod: block 1 ;[239] ; JSYS error when first tried 33727 000225'05 ihptod: block 2 ;[239] ; High precision time of day when started 33728 retsec ; Return back to original .PSECT 33729 33730 002541'01 initim: entry initim ; Called once by START in K20MIT 33731 002541'01 265 16 0 00 003571' saveac ; Used as index and capability word 33732 33733 002542'01 104 00 0 00 000227 GTAD% ; Get current date and time 33734 002543'01 320 12 0 00 002545' ifje. r ; Failed?? 33735 002544'01 254 00 0 00 002560' 33736 002545'01 552 01 0 00 000000# hrrzm t1, prgsdt ; Store error and flag it (not 1858!!) 33737 002546'01 550 01 0 00 000000# hrrz t1, bootdt ; Save single word format (not 1858!!) 33738 002547'01 334 00 0 00 000000 %ermsg (,) 33739 002550'01 254 00 0 00 002554' 33740 002551'01 265 01 0 00 002024* 33741 002552'01 000000000000# 33742 002553'01 254 00 0 00 002554' 33743 001116'04 105 162 162 157 162 33744 002554'01 477 05 0 00 000006 setob q1, q2 ; Flag date and time not set 33745 002555'01 124 05 0 00 000000# dmovem q1, bootdd ; Store boot date and time double word 33746 002556'01 263 17 0 00 000000 ret ; Can't go any further 33747 002557'01 254 00 0 00 002567' else. ; Otherwise worked, 33748 002560'01 202 01 0 00 000000# movem t1, prgsdt ; so just use it K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 40-1 K20TIM MAC 9-Nov-23 15:10 Initialize time variables 33749 002561'01 200 02 0 00 000001 move t2, t1 ; Cast to signed long 33750 002562'01 627 02 0 00 400000 tlzn t2,(1b0) ; Test if Negative, fix low order and skip 33751 002563'01 634 01 0 00 000001 tdza t1, t1 ; Positive, zero high order and skip 33752 002564'01 201 01 0 00 000001 movei t1, ^d1 ; Negative, put sign bit in the high order 33753 002565'01 124 01 0 00 000000# dmovem t1, prgsdd ; Store for later inspection 33754 002566'01 120 05 0 00 000001 dmove q1, t1 ; Cache as we are soon to use it 33755 002567'01 endif. 33756 33757 002567'01 120 01 0 00 000000# dmove t1, mstime ; XKL's arcane 'magic' argument (if Toad) 33758 002570'01 104 00 0 00 000014 TIME% ; Get uptime in milliseconds (maybe long) 33759 002571'01 320 12 0 00 002573' ifje. r ; Failed?? 33760 002572'01 254 00 0 00 002603' 33761 002573'01 560 02 0 00 000001 hrro t2, t1 ; Turn negative to flag error 33762 002574'01 474 01 0 00 000000 seto t1, ; Ditto high order 33763 002575'01 334 00 0 00 000000 %ermsg (,) 33764 002576'01 254 00 0 00 002602' 33765 002577'01 265 01 0 00 002551* 33766 002600'01 000000000000# 33767 002601'01 254 00 0 00 002602' 33768 001125'04 105 162 162 157 162 33769 002602'01 254 00 0 00 002611' else. ; Otherwise, some kind of success 33770 002603'01 302 02 0 00 001750 caie t2, ^d1000 ; XKL monitor? 33771 002604'01 254 00 0 00 002611' ifskp. ; No, plain old 'vanilla' 33772 002605'01 200 02 0 00 000001 move t2, t1 ; Put low order in proper place 33773 002606'01 627 02 0 00 400000 tlzn t2,(1b0) ; Test if Negative, fix low order and skip 33774 002607'01 634 01 0 00 000001 tdza t1, t1 ; Positive, zero high order and skip 33775 002610'01 201 01 0 00 000001 movei t1, ^d1 ; Negative, put sign bit in the high order 33776 002611'01 endif. ; And case casting vanilla Tops-20 to double word 33777 002611'01 endif. ; End TIME% result handling 33778 002611'01 124 01 0 00 000000# dmovem t1, sysums ; Either way, store double word millisecond uptime 33779 33780 002612'01 415 16 0 00 002625' block. ; Enter block for better control flow 33781 002613'01 261 17 0 00 000016 33782 002614'01 321 01 0 00 002534* jumpl t1, R ; Only do this if 33783 002615'01 321 02 0 00 002614* jumpl t2, R ; current time is reasonable 33784 002616'01 321 05 0 00 002615* jumpl q1, R ; Only do this if 33785 002617'01 321 06 0 00 002616* jumpl q2, R ; uptime is reasonable 33786 002620'01 260 17 0 00 002655' call initod ; Convert uptime to elapsed TOD uptime 33787 002621'01 115 05 0 00 000001 dsub q1, t1 ; Subtract from current time of day 33788 002622'01 321 05 0 00 002617* jumpl q1, R ; Wrapped?? 33789 002623'01 254 00 0 00 002476* retskp ; Succeed with boot TOD in a signed double word 33790 002624'01 263 17 0 00 000000 endbk. ; Block exit 33791 002625'01 254 00 0 00 002632' ifskp. ; Worked 33792 002626'01 200 01 0 00 000006 move t1, q2 ; Load low order of result 33793 002627'01 322 05 0 00 002631' ifn. q1 ; Any high order? 33794 002630'01 661 01 0 00 400000 tlo t1,(1b0) ; Yes, coerce to low order 33795 002631'01 endif. 33796 002631'01 254 00 0 00 002634' else. ; Something didn't work 33797 002632'01 474 01 0 00 000000 seto t1, ; And no valid time of day 33798 002633'01 477 05 0 00 000006 setob q1, q2 ; Ditto double word 33799 002634'01 endif. 33800 33801 002634'01 124 05 0 00 000000# dmovem q1, bootdd ; Store boot date and time double word 33802 002635'01 202 01 0 00 000000# movem t1, bootdt ; Save single word format 33803 002636'01 124 03 0 00 000000# dmovem t3, bootrm ; And remainder milliseconds K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 40-2 K20TIM MAC 9-Nov-23 15:10 Initialize time variables 33804 33805 remark ;[239] Finally see if we can do microsecond TOD 33806 002637'01 201 01 0 00 000004 movei t1,.hptod ;[239] Request high precision time of day 33807 002640'01 104 00 0 00 000501 HPTIM% ;[239] Issue the JSYS to see if it's there 33808 002641'01 320 12 0 00 002643' ifje. r ;[239] Didn't work ... 33809 002642'01 254 00 0 00 002650' 33810 002643'01 202 01 0 00 000000# movem t1, ehptod ;[239] Store the error code, but don't whine about it 33811 002644'01 403 01 0 00 000002 setzb t1, t2 ;[239] Cons up a set of double zeros 33812 002645'01 202 01 0 00 000000# movem t1, mhptod ;[239] Flag that it's not there 33813 002646'01 124 01 0 00 000000# dmovem t1, ihptod ;[239] No high precision time of day 33814 002647'01 254 00 0 00 002654' else. ;[239] Otherwise, monitor has the code and worked! 33815 002650'01 124 01 0 00 000000# dmovem t1, ihptod ;[239] Store initial high precision time of day 33816 002651'01 201 01 0 00 601405 movx t1, LSTRX1 ;[239] "Process has not encountered any errors" 33817 002652'01 202 01 0 00 000000# movem t1,ehptod ;[239] Phoney it up that this worked 33818 002653'01 476 00 0 00 000000# setom mhptod ;[239] Flag that functionality is there 33819 002654'01 endif. ;[239] End case testing for JSYS support 33820 33821 002654'01 263 17 0 00 000000 ret ; Finally done 33822 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 41 K20TIM MAC 9-Nov-23 15:10 Initialize Time of Day offset from current uptime 33823 subttl Initialize Time of Day offset from current uptime 33824 33825 ; Like miltod, but doesn't peel off a subsecond first, but rather 33826 ; Returns a remainder if not rounding 33827 ; 33828 ; Calling arguments are the same as are the return values 33829 33830 002655'01 initod: remark ; Almost impossible for this to happen, but... 33831 002655'01 321 01 0 00 003014' jumpl t1, ovrflw ; Sanity check calling arguments 33832 002656'01 321 02 0 00 003014' jumpl t2, ovrflw 33833 002657'01 326 01 0 00 002663' ife. t1 ; Maybe bum the math 33834 002660'01 326 02 0 00 002663' ife. t2 ; Got called with a zero double word? 33835 002661'01 403 03 0 00 000004 setzb t3, t4 ; Yes, so there can't be any remainder 33836 002662'01 263 17 0 00 000000 ret ; Yes, we're done 33837 002663'01 endif. 33838 002663'01 endif. 33839 33840 002663'01 265 16 0 00 003645' saveac ; Intermediate double word results 33841 002664'01 120 07 0 00 000001 dmove q3, t1 ; Save calling milliseconds to extract remainder 33842 002665'01 255 17 0 00 002666' jfcl 17,.+1 ; Clear flags 33843 33844 remark ; Calculate T = (M*262144)/86400000 33845 002666'01 116 01 0 00 000000# dmul t1, tticdw ; Scale milliseconds up by time of day ticks 33846 002667'01 255 17 0 00 003014' jfcl 17, ovrflw ; Over 140 bits??? 33847 002670'01 326 01 0 00 003014' jumpn t1, ovrflw ; Over 105 bits?? 33848 002671'01 326 02 0 00 003014' jumpn t2, ovrflw ; Over 70 bits? 33849 002672'01 117 01 0 00 000000# ddiv t1, msidad ; Then strip off partial TOD 33850 002673'01 255 17 0 00 003014' jfcl 17, ovrflw ; Punt if any kind of funny business 33851 remark ; Don't round because extracting milliseconds 33852 33853 remark ; Now convert TOD quotient back to ms 33854 002674'01 120 03 0 00 000001 dmove t3, t1 ; Load TOD quotient as input 33855 remark 17,ovlflw ; Flags are still clear 33856 33857 remark ; Calculate M = (86400000*T)/262144. 33858 002675'01 116 03 0 00 000000# dmul t3, msidad ; Scale TOD ticks by milliseconds 33859 002676'01 255 17 0 00 003014' jfcl 17, ovrflw ; Over 140 bits??? 33860 002677'01 326 03 0 00 003014' jumpn t3, ovrflw ; Over 105 bits?? 33861 002700'01 326 04 0 00 003014' jumpn t4, ovrflw ; Over 70 bits? 33862 002701'01 117 03 0 00 000000# ddiv t3, tticdw ; Strip off partial milliseconds 33863 002702'01 255 17 0 00 003014' jfcl 17, ovrflw ; Punt if any kind of funny business 33864 33865 002703'01 115 07 0 00 000003 dsub q3, t3 ; Calculate remaining milliseconds 33866 002704'01 321 07 0 00 003014' jumpl q3, ovrflw ; Sanity check arithmatic 33867 002705'01 120 03 0 00 000007 dmove t3, q3 ; Return millisecond remainder 33868 002706'01 263 17 0 00 000000 ret ; Finally done 33869 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 42 K20TIM MAC 9-Nov-23 15:10 Fine Grained Time of Day 33870 subttl Fine Grained Time of Day 33871 33872 ; At megabaud (and even high kilobaud) speeds, messages can easily 33873 ; transfer in under the TOD resolution (a single TOD tick being 33874 ; 329.5898438 ms), so a simple subtraction of before and after GTAD%'s 33875 ; really won't work as it will seem as if no time elapsed. 33876 ; 33877 ; Kermit-20 therefore does not use GTAD% difference, but rather uptime 33878 ; (I.E., TIME% a.k.a milliseconds). Can't make DK10 ticks work for 33879 ; elapsed TOD on an unmodified Tops-20 (see above). 33880 ; 33881 ; Expects to smash t1 - t3, others preserved 33882 ; 33883 ; +1/ Unrecoverable error 33884 ; +2/ Worked 33885 33886 002707'01 fintim: entry fintim ; Used in K20PDC, but coded here 33887 002707'01 265 16 0 00 003645' saveac ;[239] Set up a pointer register 33888 33889 002710'01 336 00 0 00 000000# ifmn. mhptod ;[239] Have we got high precision time of day? 33890 002711'01 254 00 0 00 002722' 33891 002712'01 201 01 0 00 000004 movx t1, .hptod ;[239] Yes, let's do DK10 units 33892 002713'01 104 00 0 00 000501 HPTIM% ;[239] Get the data 33893 002714'01 320 16 0 00 002722' annje. ;[239] If failed, then silently don't use it 33894 002715'01 303 01 0 00 303237 caile t1, ^d99999 ;[239] We didn't get gubbish, did we? 33895 002716'01 320 16 0 00 002722' annje. ;[239] A subsecond is never more than 99,999 DK10 ticks! 33896 002717'01 120 06 0 00 000001 dmove q2, t1 ;[239] Store TOD and DK10 subseconds 33897 002720'01 200 10 0 00 003733' movx q4, no%lfl!no%zro!no%ast!fld(^d5,no%col)!fld(^d10,no%rdx) ;[239] 33898 002721'01 254 00 0 00 002740' else. ;[239] Otherwise, don't have it, failed or gubbish 33899 002722'01 260 17 0 00 002050' call endtim ; Get current time of day into ending variables 33900 002723'01 260 17 0 00 002133' call elptim ; Calculated elapsed time in various formats 33901 002724'01 201 05 0 00 000000# movei q1, ewallt ; Pointer to elapsed time structure 33902 002725'01 200 06 0 05 000000 move q2, .dattd(q1) ;[239] Load ending signed time of day (unrounded) 33903 002726'01 120 02 0 05 000003 dmove t2, .dattr(q1) ;[239] Load remainder milliseconds, if any 33904 002727'01 326 02 0 00 002735' ife. t2 ;[239] Zero high order ... 33905 002730'01 326 03 0 00 002733' ife. t3 ;[239] ... and zero low order? 33906 002731'01 400 07 0 00 000000 setz q3, ;[239] None there, so note that 33907 002732'01 254 00 0 00 002734' else. ;[239] Otherwise, nothing to cast 33908 002733'01 200 07 0 00 000003 move q3, t3 ;[239] Can just use signed low order 33909 002734'01 endif. ;[239] End case zero double word 33910 002734'01 254 00 0 00 002737' else. ;[239] Non-zero high order 33911 002735'01 661 03 0 00 400000 tlo t3, (1b0) ;[239] Cast low order to unsigned 33912 002736'01 200 07 0 00 000003 move q3, t3 ;[239] Store unsigned word 33913 002737'01 endif. ;[239] End case remainder checking 33914 002737'01 200 10 0 00 003732' movx q4, no%lfl!no%zro!no%ast!fld(^d3,no%col)!fld(^d10,no%rdx) ;[239] 33915 002740'01 endif. ;[239] End case ms or dk10 units? 33916 33917 002740'01 550 01 0 00 000013 hrrz t1, p3 ; Load the logging file JFN 33918 002741'01 200 02 0 00 000006 move t2, q2 ;[239] Load some kind of time of day 33919 002742'01 400 03 0 00 000000 setz t3, 33920 002743'01 104 00 0 00 000220 ODTIM% ; Put into the log file 33921 002744'01 320 12 0 00 002622* erjmpr r ; Unless couldn't... 33922 33923 002745'01 201 02 0 00 000056 movei t2, "." ; Otherwise, punctuate milliseconds 33924 002746'01 260 17 0 00 002517* call BOUTI% ;[216] K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 42-1 K20TIM MAC 9-Nov-23 15:10 Fine Grained Time of Day 33925 33926 002747'01 120 02 0 00 000007 dmove t2, q3 ;[239] Load the remainder milliseconds or DK10 units 33927 002750'01 104 00 0 00 000224 NOUT% ; Gives ".012" or ".012345" 33928 002751'01 320 14 0 00 002744* erjmps r 33929 33930 002752'01 254 00 0 00 002623* retskp ; Done 33931 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 43 K20TIM MAC 9-Nov-23 15:10 Convert Milliseconds to Time of Day Ticks 33932 subttl Convert Milliseconds to Time of Day Ticks 33933 33934 ; We have two fixed point fractions, one in TOD ticks in a day and the 33935 ; other in milliseconds in a day. The denominator for the former is 33936 ; 262,144 (2^18) whilst the denominator for the later is 86,400,000 33937 ; (24*60*60*1000). 33938 ; 33939 ; If M is the number of milliseconds (input), and T is the number of 33940 ; TOD ticks (output), then the proportion is M:86400000 = T:262144. 33941 ; Solving for T yields M*262144 = T*86400000 (intermediate) or T = 33942 ; (M*262144)/86400000. 33943 ; 33944 ; To extract the remainder, we simply solve the same equation for a 33945 ; different variable, that is, the input is now TOD or T, thus we 33946 ; have T:262144 = M:86400000, or 262144*M = 86400000*T intermediate, 33947 ; or M = (86400000*T)/262144. We then subtract this new M from the 33948 ; input arguments to yield the integer remainder. 33949 ; 33950 ; Call: 33951 ; 33952 ;t1:t2/ Milliseconds as a signed double word 33953 ; 33954 ; Return: 33955 ; 33956 ;t1:t2/ Cooresponding quantity in Time of Day ticks 33957 ; as a signed double word. 33958 ;t3:t4/ Remainder milliseconds as a signed double. 33959 ; The double is used to speed downstream calculations 33960 ; by avoiding conversions. 33961 ; 33962 ; Caution! 33963 ; 33964 ; Be aware that a Time of Day tick equals 329.5898438 milliseconds. 33965 ; So, this conversion is going to cause a REDUCTION in precision 33966 ; between two and three decimal orders of magnitude (!!) 33967 ; 33968 ; Therefore, all intermediate results should be kept in milliseconds 33969 ; and not TOD ticks. 33970 ; 33971 ; We also do not round because the display is printing the milli- 33972 ; seconds and we don't want time to appear to be going backwards. 33973 ; The remainder milliseconds are returned for possible later use. 33974 33975 chgsec(code,const) ;;Constants do not go in the code .PSECT 33976 000172'02 000000 000000 msidad: ^d0 ; Milliseconds in a day, high order 33977 000173'02 000511 456000 msiday ; Milliseconds in a day, low order 33978 000174'02 000000 000000 ms1000: ^d0 ; High order milliseconds in a second 33979 000175'02 000000 001750 ^d1000 ; Low order millisecond in a second 33980 000176'02 000000 000000 lione: ^d0 ; Long integer one, high order 33981 000177'02 000000 000001 ^d1 ; Long integer one, low order 33982 000200'02 000000 000000 dkdayd: ^d0 ; DK10 ticks in a day, high order 33983 000201'02 100276 770000 dkday ; DK10 ticks in a day, low order 33984 000202'02 000000 000000 tticdw: ^d0 ; TOD ticks in a day as a double word, high order 33985 000203'02 000001 000000 todtic ; TOD ticks in a day as a single word, low order 33986 000204'02 000000 000000 tticd2: ^d0 ; Half previous, high order K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 43-1 K20TIM MAC 9-Nov-23 15:10 Convert Milliseconds to Time of Day Ticks 33987 000205'02 000000 400000 ; Half previous, low order 33988 000206'02 377777 777777 clipmx: exp .infin,.infin ; Maximum if we go over 70 bits 33989 retsec ;;Restore .PSECT assumptions 33990 33991 002753'01 321 01 0 00 003014' miltod: jumpl t1, ovrflw ; Sanity check calling arguments 33992 002754'01 321 02 0 00 003014' jumpl t2, ovrflw 33993 002755'01 326 01 0 00 002761' ife. t1 ; Maybe bum the math 33994 002756'01 326 02 0 00 002761' ife. t2 ; Got called with a zero double word? 33995 002757'01 403 03 0 00 000004 setzb t3, t4 ; Yes, so there can't be any remainder 33996 002760'01 263 17 0 00 000000 ret ; Yes, we're done 33997 002761'01 endif. 33998 002761'01 endif. 33999 34000 002761'01 265 16 0 00 003571' saveac ; Intermediate double word results 34001 002762'01 120 05 0 00 000001 dmove q1, t1 ; Save calling milliseconds 34002 002763'01 255 17 0 00 002764' jfcl 17,.+1 ; Clear flags 34003 34004 remark ; First strip off the milliseconds 34005 002764'01 120 03 0 00 000001 dmove t3, t1 ; Cast to a 140 bit intermediate quantity 34006 002765'01 403 01 0 00 000002 setzb t1, t2 ; Nothing in high 70 bits 34007 002766'01 117 01 0 00 000000# ddiv t1, ms1000 ; Strip off anything less than a second 34008 002767'01 255 17 0 00 003014' jfcl 17, ovrflw ; Shouldn't be strange ... 34009 002770'01 120 01 0 00 000005 dmove t1, q1 ; Restore original dividend 34010 002771'01 115 01 0 00 000003 dsub t1, t3 ; Subtract remainder to get to greatest second 34011 002772'01 255 17 0 00 002773' jfcl 17,.+1 ; Clear dsub's strange flags 34012 002773'01 321 01 0 00 003014' jumpl t1, ovrflw ; But double check for any funny business 34013 002774'01 120 05 0 00 000003 dmove q1, t3 ; Save remainder for return 34014 34015 remark ; Calculate T = (M*262144)/86400000 34016 002775'01 116 01 0 00 000000# dmul t1, tticdw ; Scale milliseconds up by time of day ticks 34017 002776'01 255 17 0 00 003014' jfcl 17, ovrflw ; Over 140 bits??? 34018 002777'01 326 01 0 00 003014' jumpn t1, ovrflw ; Over 105 bits?? 34019 003000'01 326 02 0 00 003014' jumpn t2, ovrflw ; Over 70 bits? 34020 003001'01 117 01 0 00 000000# ddiv t1, msidad ; Then strip off partial TOD 34021 003002'01 255 17 0 00 003014' jfcl 17, ovrflw ; Punt if any kind of funny business 34022 003003'01 316 03 0 00 000000# dcaml t3, tticd2 ; Should we round? 34023 003004'01 254 00 0 00 003010' 34024 003005'01 311 03 0 00 000000# 34025 003006'01 254 00 0 00 003011' 34026 003007'01 254 00 0 00 003012' 34027 003010'01 311 04 0 00 000000# 34028 003011'01 114 01 0 00 000000# dadd t1, lione ; Give us an extra tick 34029 34030 remark t1, t2 ; Has TOD ticks 34031 003012'01 120 03 0 00 000005 dmove t3, q1 ; Return millisecond remainder 34032 003013'01 263 17 0 00 000000 ret ; Finally done 34033 34034 003014'01 200 01 0 00 000000# ovrflw: emsg 34035 003015'01 104 00 0 00 000313 34036 000210'02 000000000000# 34037 001133'04 101 162 151 164 150 34038 003016'01 120 01 0 00 000000# dmove t1, clipmx ; Clip down to 'reasonable' maximum 34039 003017'01 263 17 0 00 000000 ret ; Get out of here 34040 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 44 K20TIM MAC 9-Nov-23 15:10 Convert Time of Day Ticks to Seconds 34041 subttl Convert Time of Day Ticks to Seconds 34042 34043 ; Do the math right. We have two fixed point fractions, one in TOD 34044 ; ticks in a day and the other in seconds in a day. The denominator 34045 ; for the former is 262,144 (2^18) whilst the denominator for the 34046 ; later is 86,400 (24*60*60). 34047 ; 34048 ; If T is the number of ticks (input) and S is the number seconds 34049 ; (output), then the proportion is T:262144 = S:86400. Solving for 34050 ; S yields S*262144=T*86400 intermediate or S=(T*86400)/262144. 34051 ; 34052 ; It will be noted that a second is a little more than three TOD ticks 34053 ; (3.034074074). So dividing by 3 will get an increasingly wrong 34054 ; answer, the longer a transfer goes. 34055 ; 34056 ; For example, consider 2,560 time of day ticks. Dividing by three 34057 ; yields a quotient of 853 seconds whereas the actual value is closer 34058 ; to 844 seconds, a difference of nine seconds. For a transfer taking 34059 ; over a day and a half, the difference is over 10,000 seconds 34060 ; 34061 ; Note intermediate double word result which is designed to handle 34062 ; dial up transfers that go on over a weekend (some did) 34063 ; 34064 ; Ticks are in t2, t1 is *** SACRED *** 34065 ; 34066 ; The below is about as fast as we can make this because the only 34067 ; math that is being done is the muli. The lsh with halfword moves 34068 ; and the or are faster than the ashc and whatever else we'd have 34069 ; to do. Div works too, but is blindingly slow. 34070 34071 003020'01 todsec: entry todsec ; Keep LINK informed of our location 34072 003020'01 265 16 0 00 003603' saveac ; Intermediate double word results 34073 003021'01 225 02 0 00 250600 muli t2,^d86400 ; Convert to base 86400 34074 003022'01 514 04 0 00 000002 hrlz t4,t2 ; Pick up high order 34075 003023'01 242 04 0 00 777777 lsh t4,-1 ; Strip off the extra sign bit 34076 003024'01 554 02 0 00 000003 hlrz t2,t3 ; Pick up low order of quotient 34077 003025'01 434 02 0 00 000004 or t2,t4 ; Build final quotient 34078 003026'01 621 03 0 00 777777 tlz t3,-1 ; Clear out from the remainder 34079 003027'01 303 03 0 00 124300 caile t3,^d<86400/2> ; Greater than a half second? 34080 003030'01 340 02 0 00 000000 aoj t2, ; Round up a second, then 34081 003031'01 263 17 0 00 000000 ret ; All done! 34082 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 45 K20TIM MAC 9-Nov-23 15:10 Previous todsec attempts, both good and bad 34083 subttl Previous todsec attempts, both good and bad 34084 34085 repeat 0,< ; First part works 34086 muli t2,^d86400 ; Convert to base 86400, double word result t2,t3 34087 ashc t2,-^d18 ; Strip out TOD ticks 34088 caile t3,^d<86400/2> ; Greater than a half second? 34089 aoj t2, ; Yes, round up a tick, then 34090 ret 34091 > 34092 repeat 0,< ; This works, but is slow 34093 muli t2,^d86400 ; Convert to base 86400 34094 div t2,[^d262144] ; Strip of TOD ticks 34095 caile t3,^d<86400/2> ; Greater than a half second? 34096 aoj t2, ; Round up a second, then 34097 ret ; All done! 34098 > 34099 34100 repeat 0,< ; This won't work for double length results 34101 hrl t2,t2 ; 'Divide' by 2^18 34102 hlr t2,t3 ; Pick up low order of quotient 34103 tlz t3,-1 ; Clear out from the remainder 34104 > 34105 34106 repeat 0,< ; Won't handle over a day 34107 imuli t2,^d86400 ; Convert to base 86400 34108 hrrz t3,t2 ; Pick up the remainder 34109 hlrz t2,t2 ; Properly position quotient 34110 caile t3,^d<86400/2> ; Greater than a half second? 34111 aoj t2, ; Round up a second, then 34112 ret ; All done! 34113 > K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 46 K20TIM MAC 9-Nov-23 15:10 subtract two (unsigned) times of day 34114 subttl subtract two (unsigned) times of day 34115 34116 ; Time of Day in TOD ticks is an ***UNSIGNED*** 36 bit number 34117 ; 34118 ; Therefore, a simple signed 35 bit subtract will eventually not 34119 ; work. Avoid the problem by using signed 70 bit math 34120 ; 34121 ; Returns result in t2, t1 is sacred 34122 34123 003032'01 elapst: entry elapst ; Keep LINK informed of our location 34124 34125 003032'01 265 16 0 00 003734' saveac 34126 003033'01 474 02 0 00 000000 seto t2, ; Assume unlikely case of something wrong 34127 003034'01 200 03 0 00 000000# move t3, etdat ; Load ending TOD 34128 003035'01 603 03 0 00 777777 tlne t3, -1 ; Any kind 34129 003036'01 316 03 0 00 003455' camn t3, [-1] ; of phonkey? 34130 003037'01 263 17 0 00 000000 ret ; Bad, return talisman 34131 003040'01 200 12 0 00 000000# move p2, stdat ; Load starting TOD 34132 003041'01 603 12 0 00 777777 tlne p2, -1 ; Any kind 34133 003042'01 316 12 0 00 003455' camn p2, [-1] ; of phonkey? 34134 003043'01 263 17 0 00 000000 ret ; Bad, return talisman 34135 34136 remark ; TOD is a 36 bit unsigned number!! 34137 003044'01 403 02 0 00 000011 setzb t2, p1 ; Zero high orders 34138 003045'01 623 03 0 00 400000 tlze t3, (1b0) ; Cast unsigned to signed long 34139 003046'01 201 02 0 00 000001 movei t2, ^d1 ; Propagate to high order 34140 003047'01 623 12 0 00 400000 tlze p2, (1b0) ; Cast unsigned to signed long 34141 003050'01 201 11 0 00 000001 movei p1, ^d1 ; Propagate to high order 34142 ; Make sure beginning is before last 34143 003051'01 316 02 0 00 000011 camn t2, p1 ; Compare high order 34144 003052'01 254 00 0 00 003060' ifskp. ; Not equal so just compare high order 34145 003053'01 311 02 0 00 000011 caml t2, p1 ; Is beginning before end? 34146 003054'01 254 00 0 00 003057' ifskp. ; Yep, swap them 34147 003055'01 250 02 0 00 000011 exch t2, p1 ; Swap high order 34148 003056'01 250 03 0 00 000012 exch t3, p2 ; Swap low order 34149 003057'01 endif. 34150 003057'01 254 00 0 00 003064' else. ; Equal, so compare low order 34151 003060'01 311 03 0 00 000012 caml t3, p2 ; Is beginning before end? 34152 003061'01 254 00 0 00 003064' ifskp. ; Yep, swap them 34153 003062'01 250 02 0 00 000011 exch t2, p1 ; Swap high order 34154 003063'01 250 03 0 00 000012 exch t3, p2 ; Swap low order 34155 003064'01 endif. 34156 003064'01 endif. 34157 ; Finally ok to subtract 34158 003064'01 115 02 0 00 000011 dsub t2, p1 ; Do a signed subtract 34159 003065'01 332 00 0 00 000002 skipe t2 ; Signed result of 36 bits? 34160 003066'01 661 03 0 00 400000 tlo t3,(1b0) ; Cast to unsigned 36 bits 34161 34162 003067'01 200 02 0 00 000003 move t2, t3 ; Load low order into return AC 34163 003070'01 263 17 0 00 000000 ret 34164 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 47 K20TIM MAC 9-Nov-23 15:10 Calculates character rate with double floating point arithmatic 34165 subttl Calculates character rate with double floating point arithmatic 34166 34167 ; Call: 34168 ; 34169 ; t2/ Pointer to elapsed HPTIM% (DK10) ticks for transfer (double word) 34170 ; t3/ Total characters sent or received 34171 ; 34172 ; Characters are handled as if they were unsigned int's, but currently, 34173 ; they never will be. This is done for future expansion. 34174 ; 34175 ; Returns: 34176 ; 34177 ; +1 - Failed 34178 ; +2 - Success!! 34179 ; t4/ Double floating raw baud rate, high order mantissa 34180 ; t5/ Ditto, low order mantissa 34181 ; 34182 ; Maintains precision by keeping numerator and denominator in fixed 34183 ; point as long as possible with the assumption that a dmul is faster 34184 ; than a dfmp and a ddiv is WAY faster than a dfdv. 34185 ; 34186 ; Since t5 is a lexical alias for q1, assumes q1 has been saved 34187 ; by caller. DON'T BREAK THIS ASSUMPTION! 34188 ; 34189 ; The odd calling conventions are because this used to be passed an 34190 ; unsigned int which did not have enough precision for certain extreme 34191 ; cases. However, because of agressive register scheduling, only a 34192 ; single register was available, so this was changed to a pointer, 34193 ; to a long int, instead. 34194 34195 chgsec(code,const) ;;Constants do not go in the code .PSECT 34196 000211'02 dblscl: intern dblscl ; Also used in k20dsp 34197 000211'02 000000 000000 0 ; Scaling factor between DK10 ticks and seconds 34198 000212'02 000000 303240 ^d100000 ; Low order of same (100000 ticks per second) 34199 retsec ;;Return to regular .PSECT assumptions 34200 34201 chgsec(code,data) ;;Intermediate results, largely used for debugging 34202 000227'05 tickpt: block 1 ; Pointer to HP tick double word (not always .datus!) 34203 000230'05 dbltic: block 2 ; Double INTEGER value that tickpt points to 34204 000232'05 dfltic: block 2 ; Double floating version of same 34205 000234'05 dblchr: block 2 ; Double INTEGER value of unsigned characters (exact) 34206 000236'05 dflchr: block 2 ; Double floating version of same 34207 retsec ;;Return to regular .PSECT assumptions 34208 34209 003071'01 dblcal: entry dblcal ; Used by k20dsp 34210 remark q1, t5 ; Recall this alias 34211 003071'01 265 16 0 00 003746' saveac ; Don't touch output pointer 34212 34213 003072'01 202 02 0 00 000000# movem t2, tickptr ; Save pointer to calling double word DK10 count 34214 34215 remark t3,chars ; Treated as unsigned 36; I.E., never negative 34216 003073'01 400 01 0 00 000000 setz t1, ; Form high order in t1 34217 003074'01 623 03 0 00 400000 tlze t3, (1b0) ; Cast unsigned to signed long 34218 003075'01 201 01 0 00 000001 movei t1, ^d1 ; Propagate to high order 34219 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 20:02 27-Nov-23 Page 47-1 K20TIM MAC 9-Nov-23 15:10 Calculates character rate with double floating point arithmatic 34220 003077'01 124 01 0 00 000000# dmovem t1, dblchr ; Store interim long (double) signed integer 34221 34222 003100'01 200 03 0 00 000000# move t3, tickptr ; Load pointer to DK10 double word 34223 003101'01 120 01 0 03 000000 dmove t1, (t3) ; and then load said double word 34224 003102'01 124 01 0 00 000000# dmovem t1, dbltic ; Store long integer ticks 34225 003103'01 260 17 0 00 003301' call dfloat ; Convert to KL10 double floating point 34226 003104'01 263 17 0 00 000000 ret ; But failed for some reason 34227 003105'01 124 01 0 00 000000# dmovem t1, dfltic ; Store double floating ticks 34228 34229 003106'01 120 01 0 00 000000# dmove t1, dblchr ; Load interim long integer characters 34230 003107'01 403 03 0 00 000004 setzb t3, t4 ; Clear low order 34231 003110'01 116 01 0 00 000000# dmul t1, dblscl ; Scale to DK10 resolution 34232 003111'01 124 03 0 00 000000# dmovem t3, dblchr ; Store final long integer characters 34233 003112'01 120 01 0 00 000003 dmove t1, t3 ; Load scaled double integer for double float 34234 003113'01 260 17 0 00 003301' call dfloat ; Convert to double floating form 34235 003114'01 263 17 0 00 000000 ret ; Failed 34236 003115'01 124 01 0 00 000000# dmovem t1, dflchr ; Store interim double floating characters 34237 34238 003116'01 120 04 0 00 000001 dmove t4, t1 ; Position characters for return 34239 003117'01 113 04 0 00 000000# dfdv t4, dfltic ; Calculate character rate 34240 003120'01 254 00 0 00 002752* retskp ; Finally return successful result 34241 34242 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 48 K20TIM MAC 9-Nov-23 15:10 Single word to double integer and double float 34243 subttl Single word to double integer and double float 34244 34245 ; Call: 34246 ; 34247 ; t2/ Unsigned 36 bit integer to be converted to long and double float 34248 ; 34249 ; Result: 34250 ; 34251 ; +1/ Failed 34252 ; +2/ 34253 ; t2/ double floating high order 34254 ; t3/ double floating low order 34255 ; t4/ long integer high order 34256 ; t5/ long integer low order 34257 34258 003121'01 singdf: entry singdf ; Called by display 34259 003121'01 265 16 0 00 003746' saveac ; Save because dfloat will trash it 34260 34261 003122'01 400 01 0 00 000000 setz t1, ; Assume not more than 35 bits 34262 003123'01 623 02 0 00 400000 tlze t2, (1b0) ; Cast unsigned to signed long 34263 003124'01 201 01 0 00 000001 movei t1, ^d1 ; Propagate to high order 34264 003125'01 120 04 0 00 000001 dmove t4, t1 ; Now save the signed long 34265 34266 003126'01 260 17 0 00 003301' call dfloat ; Float signed long 34267 003127'01 263 17 0 00 000000 ret ; Or not... 34268 34269 003130'01 200 03 0 00 000002 move t3, t2 ; Reposition double floating low order 34270 003131'01 200 02 0 00 000001 move t2, t1 ; Reposition double floating high order 34271 003132'01 254 00 0 00 003120* retskp ; Succeed 34272 34273 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 49 K20TIM MAC 9-Nov-23 15:10 Schedule, Class and Load storage declarations 34274 subttl Schedule, Class and Load storage declarations 34275 34276 chgsec(code,data) ;;Declare non-global writable storage 34277 000240'05 000000 000000 class: 0 ;[130] My scheduler class. 34278 000241'05 000000 000000 skdflg: 0 ;[130] Nonzero if class scheduler on. 34279 000242'05 skdblk: block .saclu+1 ; Argument block for SKED% jsys. 34280 000251'05 000000 000000 skedx: 0 ;[194] SKED% error count 34281 000252'05 000000 601405 lgetbe: lstrx1 ;[194] Last GETAB% error 34282 000253'05 000000 000000 getabx: 0 ;[194] GETAB% error count 34283 000254'05 000000 601405 lskede: lstrx1 ;[194] Last error from SKED% (none) 34284 000255'05 000000 000000 ksajus: 0 ;[194] Kermit's (floating) job utilization 34285 retsec ;;Back into code 34286 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 50 K20TIM MAC 9-Nov-23 15:10 Get Scheduler Class information. 34287 subttl Get Scheduler Class information. 34288 34289 003133'01 gtclas: entry gtclas ; Identfy ourselves for LINK 34290 34291 003133'01 402 00 0 00 000000# setzm class ; Assume we ain't got no class ... (boo) 34292 003134'01 201 01 0 00 000014 movei t1, .skrcv ; Read scheduler status 34293 003135'01 120 02 0 00 003754' dmove t2, [exp t3 , 2] ; Two words, starting at t3 34294 003136'01 201 03 0 00 000002 movei t3, 2 ; Just want 2 words. 34295 003137'01 104 00 0 00 000577 SKED% 34296 003140'01 320 12 0 00 003142' ifje. r ; Catch and ignore error 34297 003141'01 254 00 0 00 003146' 34298 003142'01 202 01 0 00 000000# movem t1, lskede ; Save as last SKED% error 34299 003143'01 350 00 0 00 000000# aos skedx ; Count the error (should be only one) 34300 003144'01 402 00 0 00 000000# setzm skdflg ; Flag that the class scheduler is off 34301 003145'01 263 17 0 00 000000 ret ; Nothing else we can do 34302 003146'01 endif. ; End JSYS error handling 34303 34304 003146'01 603 04 0 00 100000 txne t4, sk%stp ; Class scheduler on? (bit means "stopped") 34305 003147'01 400 04 0 00 000000 setz t4, ; No, then whack all the bits we got back 34306 003150'01 202 04 0 00 000000# movem t4, skdflg ; And save some interesting bits 34307 003151'01 322 04 0 00 002751* jumpe t4, r ; If no scheduler, we're basically done here 34308 34309 ;[130] Scheduler is on, get my scheduler class. 34310 34311 003152'01 104 00 0 00 000013 GJINF% ; Get my job information 34312 003153'01 200 04 0 00 000003 move t4, t3 ; Put my job number in the right place 34313 34314 003154'01 265 16 0 00 000000* anstkv (t2,<.saclu+1>) ; Allocate an anonymous stack variable 34315 003155'01 000000 000007 34316 003156'01 415 02 0 17 777770 34317 remark ; Now fill out the argument block 34318 003157'01 124 03 0 02 000000 dmovem t3, .sacnt(t2) ; Pop them into the block 34319 003160'01 403 03 0 00 000004 setzb t3, t4 ; Cons up a pair of zeros 34320 003161'01 124 03 0 02 000002 dmovem t3, .sajcl(t2) ; Whack job class and job share 34321 003162'01 124 03 0 02 000004 dmovem t3, .sajus(t2) ; Whack job utilization and class share 34322 003163'01 402 00 0 02 000006 setzm .saclu(t2) ; Whack class utilization 34323 34324 003164'01 201 01 0 00 000007 movx t1, .skrjp ; Function code for getting job's class info. 34325 003165'01 104 00 0 00 000577 SKED% ; Cross our fingers 34326 003166'01 320 12 0 00 003170' ifje. r ; Failed?? 34327 003167'01 254 00 0 00 003174' 34328 003170'01 202 01 0 00 000000# movem t1, lskede ; Save as last SKED% error 34329 003171'01 350 00 0 00 000000# aos skedx ; Count the error (should be only one) 34330 003172'01 477 01 0 02 000002 setob t1, .sajcl(t2) ; Set class to -1 as a talisman 34331 003173'01 254 00 0 00 003175' else. ; Otherwise, worked! 34332 003174'01 200 01 0 02 000002 move t1, .sajcl(t2) ; So get a legitimate class 34333 003175'01 endif. ; End JSYS error 'recovery' 34334 34335 003175'01 202 01 0 00 000000# movem t1, class ; Who says I ain't got no class? 34336 003176'01 200 01 0 02 000004 move t1, .sajus(t2) ; Load job utilization because it's cool 34337 003177'01 202 01 0 00 000000# movem t1, ksajus ; Save it in case somebody ever cares 34338 003200'01 263 17 0 00 000000 ret 34339 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 51 K20TIM MAC 9-Nov-23 15:10 LDAV -- Get the current load average. 34340 subttl LDAV -- Get the current load average. 34341 34342 ;[130] This routine added as part of edit 130. 34343 ; 34344 ; Takes class scheduling into account. 34345 ; 34346 ; Call with 34347 ; 34348 ; t1/ 0 for 1 minute load average 34349 ; 1 for 5 minute load average 34350 ; 2 for 15 minute load average 34351 ; 34352 ; SKDFLG/ -1 if class scheduler running, 34353 ; 0 if no class scheduler or class scheduler stopped 34354 ; 34355 ; CLASS/ This job's scheduler class. 34356 ; 34357 ; Returns +1 always, with requested load average in t1. 34358 34359 003201'01 ldav: entry ldav ; Inform LINK of our location 34360 003201'01 265 16 0 00 003446' saveac ; Copy of deglitched calling argument 34361 003202'01 301 01 0 00 000000 cail t1, 0 ; Argument in range? 34362 003203'01 303 01 0 00 000002 caile t1, 2 34363 003204'01 400 01 0 00 000000 setz t1, ; Gubbish, silently force to 0. 34364 003205'01 200 05 0 00 000001 move q1, t1 ; Save a copy of it 34365 003206'01 332 00 0 00 000000# skipe skdflg ; Class scheduler on? 34366 003207'01 254 00 0 00 003221' jrst cldav ; Yes, go get class load average 34367 34368 ; No class scheduler or it's off, so use GETAB for system-wide load average 34369 34370 003210'01 514 01 0 00 000005 gldav: hrlz t1, q1 ; Desired load average. 34371 003211'01 270 01 0 00 003756' add t1, [14,,.systa] ; Goes from offset 14 to 16 (see 2.3.2) 34372 003212'01 104 00 0 00 000010 GETAB ; use load avg from SYSTAT monitor table. 34373 003213'01 320 12 0 00 003215' ifje. r ;[194] Catch and ignore error 34374 003214'01 254 00 0 00 003220' 34375 003215'01 202 01 0 00 000000# movem t1, lgetbe ;[194] Save last error 34376 003216'01 350 00 0 00 000000# aos getabx ;[194] Bump GETAB error count 34377 003217'01 205 01 0 00 203400 movx t1, ; Return minimum load in case of any error. 34378 003220'01 endif. ;[194] 34379 003220'01 263 17 0 00 000000 ret ; Otherwise, got some useful 34380 34381 ; Class scheduler on, get load avg for this class from SKED%. 34382 34383 003221'01 335 04 0 00 000000# cldav: skipge t4, class ; This job's scheduler class. 34384 003222'01 254 00 0 00 003210' jrst gldav ; We're in an odd way, fall back to GETAB 34385 34386 003223'01 265 16 0 00 003154* anstkv (t2,<.sa15l+1>) ; Allocate an anonymous stack variable 34387 003224'01 000000 000007 34388 003225'01 415 02 0 17 777770 34389 003226'01 124 03 0 02 000000 dmovem t3, .sacnt(t2) ; Store length and requested class 34390 003227'01 403 03 0 00 000004 setzb t3, t4 ; Cons up a pair of zeros 34391 003230'01 124 03 0 02 000002 dmovem t3, .sashr(t2) ; Whack returned share and use 34392 003231'01 124 03 0 02 000004 dmovem t3, .sa1ml(t2) ; Whack one and five minute load averages 34393 003232'01 402 00 0 02 000006 setzm .sa15l(t2) ; Whack 15 minute load average 34394 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 51-1 K20TIM MAC 9-Nov-23 15:10 LDAV -- Get the current load average. 34395 003233'01 201 01 0 00 000003 movei t1, .skrcs ; Function is read class parameters. 34396 003234'01 104 00 0 00 000577 SKED% 34397 003235'01 320 12 0 00 003237' ifje. r ; Catch and ignore error 34398 003236'01 254 00 0 00 003243' 34399 003237'01 202 01 0 00 000000# movem t1, lskede ; Save as last SKED% error 34400 003240'01 350 00 0 00 000000# aos skedx ; Count the error (should be only one) 34401 003241'01 402 00 0 00 000000# setzm skdflg ; Flag that the class scheduler went off 34402 003242'01 254 00 0 00 003210' jrst gldav ; Fall back to GETAB 34403 003243'01 endif. ; End JSYS error handling 34404 34405 003243'01 201 03 0 02 000004 movei t3,.sa1ml(t2) ; Resolve base of load average block 34406 003244'01 270 03 0 00 000005 add t3, q1 ; Add offset to get to the one we want 34407 003245'01 200 01 0 03 000000 move t1, (t3) ; Finally load whatever it is 34408 003246'01 263 17 0 00 000000 ret ; Done 34409 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 52 K20TIM MAC 9-Nov-23 15:10 Increase wait time, depending on system load (very clever) 34410 subttl Increase wait time, depending on system load (very clever) 34411 34412 ;[128] Make this a separate routine. 34413 ; 34414 ; ADJTIM -- Adjust timeout interval based on load average (ldav). 34415 ; 34416 ; Timeout = mintim + (ldav-MINLOD)*((MAXTIM-mintim)/MAXLOD) 34417 ; 34418 ; 1) If the load is low, gives the minimum acceptable timeout, mintim. 34419 ; 2) If the load is very high, gives the maximum timeout, MAXTIM. 34420 ; 34421 ; In between, the timeout goes up linearly with given load average. 34422 ; 34423 ; MINLOD, MAXLOD, and MAXTIM are defined as global symbols. 34424 ; 34425 ; Call with: 34426 ; 34427 ; t1/ 1, 5, or 15 minute ldav, 34428 ; (floating point number as returned by ldav) 34429 ; t2/ minimum acceptable timeout (mintim), milliseconds (integer). 34430 ; 34431 ; Returns +1 always, with 34432 ; 34433 ; t2/ adjusted timeout interval, in milliseconds (integer). 34434 ; 34435 ; N.B., 34436 ; 34437 ; Will never return a number larger than MAXTIM. 34438 ; Zero means no time out and is always returned as zero 34439 34440 003247'01 adjtim: entry adjtim ; Inform LINK of our location 34441 003247'01 327 02 0 00 003252' ifle. t2 ;[212] Zero or goofy? 34442 003250'01 400 02 0 00 000000 setz t2, ;[212] Load zero (to never time out) 34443 003251'01 263 17 0 00 000000 ret ;[212] And return that 34444 003252'01 endif. 34445 34446 remark ;[212] Otherwise, have some math to do 34447 003252'01 265 16 0 00 000000* acvar ; Local storage for second argument. 34448 003253'01 202 02 0 00 000005 movem t2, mintim ; Save the minimum for later. 34449 34450 remark (ldav-MINLOD) ;[212] Normalize load to trigger after minlod 34451 003254'01 155 01 0 00 203400 fsbrx t1, ;[194] Adjust load by subtracting the minimum. 34452 003255'01 327 01 0 00 003261' ifle. t1 ;[212] Zero or negative load? 34453 003256'01 200 02 0 00 000005 move t2, mintim ;[212] Then second term has no effect 34454 003257'01 263 17 0 00 000000 ret ;[212] So just return the number, unaltered 34455 003260'01 254 00 0 00 003263' else. ;[212] Otherwise, range check the result 34456 003261'01 311 01 0 00 003757' caxl t1, ;[194] If too big, clamp to maximum 34457 003262'01 205 01 0 00 206620 movx t1, ;[194] It was, so load the maximum 34458 003263'01 endif. 34459 34460 remark (MAXTIM-mintim) ;[212] Range check and correct timeout 34461 003263'01 201 02 0 00 267460 movx t2, maxtim ;[212] Maximum timeout, milliseconds. 34462 003264'01 274 02 0 00 000005 sub t2, mintim ; Less specified timeout interval. 34463 003265'01 327 02 0 00 003271' ifle. t2 ;[212] Efficiency hack, is this not positive? 34464 003266'01 201 02 0 00 267460 movx t2, maxtim ;[212] Clamp result to maximum K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 52-1 K20TIM MAC 9-Nov-23 15:10 Increase wait time, depending on system load (very clever) 34465 003267'01 263 17 0 00 000000 ret ;[212] And done 34466 003270'01 254 00 0 00 003272' else. ;[212] Otherwise, 34467 003271'01 127 02 0 00 000002 fltr t2, t2 ;[212] float the result 34468 003272'01 endif. ;[212] End term check 34469 34470 003272'01 175 02 0 00 206620 fdvrx t2, ;[194] Divided by maximum load. 34471 003273'01 164 01 0 00 000002 fmpr t1, t2 ; Multiplied by actual (adjusted) load. 34472 003274'01 126 02 0 00 000001 fixr t2, t1 ; Fixed & rounded. 34473 003275'01 270 02 0 00 000005 add t2, mintim ; Add in requested minimum timeout. 34474 003276'01 303 02 0 00 267460 caile t2, maxtim ;[212] Larger than largest? 34475 003277'01 201 02 0 00 267460 movx t2, maxtim ;[212] Clamp to maximum 34476 34477 003300'01 263 17 0 00 000000 ret ; Return with result in t2. 34478 34479 endav. ;[194] End scope mintim acvar 34480 34481 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 53 K20TIM MAC 9-Nov-23 15:10 Tables to support integer to double floating conversion 34482 SUBTTL Tables to support integer to double floating conversion 34483 34484 ;[206] Begin code insertion, selflessly donated from my very 34485 ; own Tops-20 Extended mode FTP Server. "Share and Enjoy" 34486 34487 REMARK Table to see if we can do a simple shift 34488 34489 ; When converting a single word integer to double floating point 34490 ; format, there is no case where we are ever going to have to round. 34491 ; However, in certain instances where the lower part of the word is 34492 ; clear, we can bum the combined (double accumulator) arithmetic shift 34493 ; and get by with a faster single accumulator logical shift. 34494 ; 34495 ; This is accomplished by checking to see if any bits would go from 34496 ; the lower high order word to the upper lower order word with these 34497 ; masks whose indices correspond to the amount of bits we'd need to 34498 ; shift over. 34499 34500 chgsec(code,const) ;;Constants go into CONST area 34501 34502 000213'02 000000 000000 SLSHMK: 0 ; Always positive means we'll skip the first entry 34503 000214'02 000000 000377 ^B11111111 ; 8 ; and will always be at least one 34504 000215'02 000000 000177 ^B1111111 ; 7 ; Means we have to have entire field free 34505 000216'02 000000 000077 ^B111111 ; 6 34506 000217'02 000000 000037 ^B11111 ; 5 34507 000220'02 000000 000017 ^B1111 ; 4 34508 000221'02 000000 000007 ^B111 ; 3 34509 000222'02 000000 000003 ^B11 ; 2 34510 000223'02 000000 000001 ^B1 ; 1 34511 000224'02 000 00 0 00 000000 Z ; 0 ; Should never happen because should have 34512 ; been caught by the rounding logic 34513 34514 REMARK Binary exponent increment 34515 34516 ; The table cooresponds to the simple shift hack, above. In this 34517 ; case, we already have the correct magnitude and simply need to 34518 ; change it based on the amount of the shift. 34519 34520 000225'02 000000 000000 BXPINC: 0 ; Always positive means we'll skip the first entry 34521 000226'02 010000 000000 FLD(^D8,EXPMSK) ; and will always be at least one bit because JFFO 34522 000227'02 007000 000000 FLD(^D7,EXPMSK) ; is always going to count the sign. Thus, having 34523 000230'02 006000 000000 FLD(^D6,EXPMSK) ; one bit set means we would have shifted out an 34524 000231'02 005000 000000 FLD(^D5,EXPMSK) ; entire exponent field 34525 000232'02 004000 000000 FLD(^D4,EXPMSK) 34526 000233'02 003000 000000 FLD(^D3,EXPMSK) 34527 000234'02 002000 000000 FLD(^D2,EXPMSK) 34528 000235'02 001000 000000 FLD(^D1,EXPMSK) 34529 000236'02 000 00 0 00 000000 Z ; Should never happen because should have caught 34530 ; by the rounding decision logic 34531 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 54 K20TIM MAC 9-Nov-23 15:10 Tables to support integer to double floating conversion 34532 REMARK Double word binary exponent 34533 34534 ; In this case, the table contains all of the possible exponent values 34535 ; for corresponding shifts when normalizing an integer in the high 34536 ; order word. 34537 34538 000237'02 000000 000000 DWBEXP: 0 ; Ignore the sign bit 34539 000240'02 306000 000000 FLD(^D<35+35+128>,EXPMSK) 34540 000241'02 305000 000000 FLD(^D<34+35+128>,EXPMSK) 34541 000242'02 304000 000000 FLD(^D<33+35+128>,EXPMSK) 34542 000243'02 303000 000000 FLD(^D<32+35+128>,EXPMSK) 34543 000244'02 302000 000000 FLD(^D<31+35+128>,EXPMSK) 34544 000245'02 301000 000000 FLD(^D<30+35+128>,EXPMSK) 34545 000246'02 300000 000000 FLD(^D<29+35+128>,EXPMSK) 34546 000247'02 277000 000000 FLD(^D<28+35+128>,EXPMSK) 34547 000250'02 000 00 0 00 000000 Z ; Should be caught by non-shifting case!!! 34548 000251'02 275000 000000 FLD(^D<26+35+128>,EXPMSK) 34549 000252'02 274000 000000 FLD(^D<25+35+128>,EXPMSK) 34550 000253'02 273000 000000 FLD(^D<24+35+128>,EXPMSK) 34551 000254'02 272000 000000 FLD(^D<23+35+128>,EXPMSK) 34552 000255'02 271000 000000 FLD(^D<22+35+128>,EXPMSK) 34553 000256'02 270000 000000 FLD(^D<21+35+128>,EXPMSK) 34554 000257'02 267000 000000 FLD(^D<20+35+128>,EXPMSK) 34555 000260'02 266000 000000 FLD(^D<19+35+128>,EXPMSK) 34556 000261'02 265000 000000 FLD(^D<18+35+128>,EXPMSK) 34557 000262'02 264000 000000 FLD(^D<17+35+128>,EXPMSK) 34558 000263'02 263000 000000 FLD(^D<16+35+128>,EXPMSK) 34559 000264'02 262000 000000 FLD(^D<15+35+128>,EXPMSK) 34560 000265'02 261000 000000 FLD(^D<14+35+128>,EXPMSK) 34561 000266'02 260000 000000 FLD(^D<13+35+128>,EXPMSK) 34562 000267'02 257000 000000 FLD(^D<12+35+128>,EXPMSK) 34563 000270'02 256000 000000 FLD(^D<11+35+128>,EXPMSK) 34564 000271'02 255000 000000 FLD(^D<10+35+128>,EXPMSK) 34565 000272'02 254000 000000 FLD(^D<09+35+128>,EXPMSK) 34566 000273'02 253000 000000 FLD(^D<08+35+128>,EXPMSK) 34567 000274'02 252000 000000 FLD(^D<07+35+128>,EXPMSK) 34568 000275'02 251000 000000 FLD(^D<06+35+128>,EXPMSK) 34569 000276'02 250000 000000 FLD(^D<05+35+128>,EXPMSK) 34570 000277'02 247000 000000 FLD(^D<04+35+128>,EXPMSK) 34571 000300'02 246000 000000 FLD(^D<03+35+128>,EXPMSK) 34572 000301'02 245000 000000 FLD(^D<02+35+128>,EXPMSK) 34573 000302'02 244000 000000 FLD(^D<01+35+128>,EXPMSK) 34574 000303'02 000 00 0 00 000000 Z ; Indicates a zero upper word which should 34575 ; have already been accounted for 34576 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 55 K20TIM MAC 9-Nov-23 15:10 Tables to support integer to double floating conversion 34577 REMARK Double word arithmetic shift normalization 34578 34579 RADIX ^D10 34580 34581 ; N.B., negative shift is the only case where a round operation would be needed 34582 34583 000304'02 000000 000000 DWASHN: 0 ; Ignore the sign bit 34584 000305'02 777777 777770 EXP -8,-7,-6,-5,-4,-3,-2,-1 ; Cases of opening up exponent field 34585 000315'02 000 00 0 00 000000 Z ; Should be caught by non-shifting case!! 34586 000316'02 000000 000001 EXP 1, 2, 3, 4, 5, 6, 7, 8, 9 ; Cases of shifting significance towards 34587 000327'02 000000 000012 EXP 10,11,12,13,14,15,16,17,18,19 ; the exponent field--never any rounding 34588 000341'02 000000 000024 EXP 20,21,22,23,24,25,26 ; Should never exceed 26 shifts 34589 000350'02 000 00 0 00 000000 Z ; Indicates a zero upper word which 34590 ; should have already been accounted for 34591 RADIX ^D8 34592 34593 retsec ;;Restore psect assumptions 34594 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 56 K20TIM MAC 9-Nov-23 15:10 Routine to implement double float 34595 SUBTTL Routine to implement double float 34596 34597 ; The routine assumes that the exponent will always be positive (I.E., 34598 ; greater than 128 decimal, 200 octal). This is--by definition-- 34599 ; always true for integers: there will NEVER be fractions, much less 34600 ; values less than 1 other than zero (0) or a negative. 34601 ; 34602 ; It assumes that the number will be positive. If this is not the 34603 ; case, it takes the magitude of the integer and multiplies the 34604 ; eventual result by double floating negative 1. This will slow down 34605 ; the double floatation of negative numbers, but in this program we 34606 ; never produce those. 34607 ; 34608 ; It also doesn't do any rounding. However, rounding would only occur 34609 ; for values that are in excess of 4,611,686,018,427,387,903 34610 ; (approximately 4.5 million trillion). Since the numbers in question 34611 ; are not going to be THAT large, this is not a problem in this 34612 ; program. 34613 ; 34614 ; We're just looking to keep the original number in the fraction (or 34615 ; mantissa) and hence need the additional word of dynamic range 34616 ; 34617 ; N.B., Toad doesn't have dfltr yet it has dgfltr... Why?? 34618 ; 34619 ; Call: 34620 ; 34621 ; T1/ High order double integer 34622 ; T2/ Low order double integer 34623 ; 34624 ; Return: 34625 ; 34626 ; +1 Something failed, T1 and T2 indeterminate 34627 ; +2 Success 34628 ; T1/ High order double floating point (most significant bits of mantissa) 34629 ; T2/ Low order double floating point number 34630 34631 377000 000000 EXPMSK==MASKB(1,8) ; Exponent field mask 34632 34633 003301'01 DFLOAT: ENTRY DFLOAT ; Make available to the world 34634 003301'01 326 01 0 00 003304' IFE. T1 ; No high order. Might be zero ... 34635 003302'01 326 02 0 00 003304' IFE. T2 ; Any low order? 34636 003303'01 263 17 0 00 000000 RET ; No, got passed a zero, so nothing to do 34637 003304'01 ENDIF. ; End case of zero low order 34638 003304'01 ENDIF. ; End case of zero high order 34639 34640 003304'01 265 16 0 00 003760' SAVEAC ; Real work! Will need some scratch storage 34641 003305'01 321 01 0 00 003311' IFGE. T1 ; Something positivishly flavored? 34642 003306'01 120 03 0 00 000001 DMOVE T3,T1 ; Yes, save a copy of the number 34643 003307'01 400 06 0 00 000000 SETZ Q2, ; flag positivity 34644 003310'01 254 00 0 00 003314' ELSE. ; Otherwise make positive and fix later 34645 REMARK DMOVN ; Don't use; floating only, will break on ints 34646 003311'01 403 03 0 00 000004 SETZB T3,T4 ; Make a big fat zero 34647 003312'01 115 03 0 00 000001 DSUB T3,T1 ; Make negative a positive in T3:T4 34648 003313'01 474 06 0 00 000000 SETO Q2, ; Flag negativity 34649 003314'01 ENDIF. ; End case of negative signed double K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 56-1 K20TIM MAC 9-Nov-23 15:10 Routine to implement double float 34650 34651 003314'01 326 03 0 00 003347' IFE. T3 ; Not really a HUGE number after all? 34652 003315'01 603 04 0 00 377000 TXNE T4,EXPMSK ; Would we have to round???? 34653 003316'01 254 00 0 00 003327' IFSKP. ; No, maybe we can bum the FLTR ... 34654 003317'01 607 04 0 00 000400 TXNN T4,1B9 ; In the range of 67,108,864 to 134,217,727? 34655 003320'01 254 00 0 00 003324' IFSKP. ; Yes, already normalized! 34656 003321'01 205 01 0 00 233000 MOVX T1,FLD(^D<128+27>,EXPMSK) 34657 003322'01 434 01 0 00 000004 IOR T1,T4 ; Cons the exponent and mantissa 34658 003323'01 254 00 0 00 003325' ELSE. ; Otherwise, can use plain old reliable ... 34659 003324'01 127 01 0 00 000004 FLTR T1,T4 ; and float it (slowly) 34660 003325'01 ENDIF. ; Either way, T1 is complete 34661 003325'01 400 02 0 00 000000 SETZ T2, ; There is no low order mantissa 34662 003326'01 254 00 0 00 003346' ELSE. ; Otherwise more than 27 bit mantissa 34663 003327'01 200 01 0 00 000004 MOVE T1,T4 ; Load the integer 34664 003330'01 260 17 0 00 003431' CALL EXPSFT ; Compute shift amount to clear field 34665 003331'01 263 17 0 00 000000 RET ; Oh dear, we're ill, beat it 34666 003332'01 205 01 0 00 233000 MOVX T1,FLD(^D<128+27>,EXPMSK) 34667 003333'01 270 01 0 02 000000# ADD T1,BXPINC(T2) ; Load maximum unrounded and calculate shift 34668 003334'01 612 04 0 02 000000# TDNE T4,SLSHMK(T2) ; Is there enough space for a single shift 34669 003335'01 254 00 0 00 003342' IFSKP. ; Yes, use logical since FASTER than a combined 34670 003336'01 242 04 0 05 000000 LSH T4,(Q1) ; Finally get the bits out of the way 34671 003337'01 434 01 0 00 000004 IOR T1,T4 ; Cons the exponent and mantissa 34672 003340'01 400 02 0 00 000000 SETZ T2, ; And nothing in the low order 34673 003341'01 254 00 0 00 003346' ELSE. ; Otherwise part of mantissa will be in low word 34674 003342'01 250 03 0 00 000004 EXCH T3,T4 ; Bum a word's worth of shifting 34675 003343'01 244 03 0 05 000000 ASHC T3,(Q1) ; Split the fraction across two words 34676 003344'01 434 01 0 00 000003 IOR T1,T3 ; Cons the exponent and high mantissa 34677 003345'01 200 02 0 00 000004 MOVE T2,T4 ; And return the low mantissa 34678 003346'01 ENDIF. ; End case of combined shift decision 34679 003346'01 ENDIF. ; End case of 27 bit (non-rounded) mantissa 34680 003346'01 254 00 0 00 003424' JRST DFLRET ; And return the value 34681 003347'01 ENDIF. ; End case of no high order mantissa 34682 ; Some kind of large number ... 34683 003347'01 326 04 0 00 003402' IFE. T4 ; Maybe no low order mantissa? 34684 003350'01 603 03 0 00 377000 TXNE T3,EXPMSK ; Would we round the high order? 34685 003351'01 254 00 0 00 003363' IFSKP. ; No, maybe we can bum the FLTR ... 34686 003352'01 607 03 0 00 000400 TXNN T3,1B9 ; If between 2,305,843,009,213,693,952 and 34687 003353'01 254 00 0 00 003357' IFSKP. ; 4,611,685,984,067,649,536, already normalized! 34688 003354'01 205 01 0 00 276000 MOVX T1,FLD(^D<128+27+35>,EXPMSK) 34689 003355'01 434 01 0 00 000003 IOR T1,T3 ; Cons the exponent and mantissa 34690 003356'01 254 00 0 00 003361' ELSE. ; Otherwise, can use plain old reliable ... 34691 003357'01 127 01 0 00 000003 FLTR T1,T3 ; and float it (slowly) 34692 003360'01 270 01 0 00 003772' ADDX T1,FLD(^D35,EXPMSK) ; However, it is a lot larger 34693 003361'01 ENDIF. ; Either way, T1 is complete 34694 003361'01 400 02 0 00 000000 SETZ T2, ; There is no low order mantissa 34695 003362'01 254 00 0 00 003401' ELSE. ; Must get some bits out of the exponent field 34696 003363'01 200 01 0 00 000003 MOVE T1,T3 ; Load the (large) integer 34697 003364'01 260 17 0 00 003431' CALL EXPSFT ; Compute shift amount to clear field 34698 003365'01 263 17 0 00 000000 RET ; Oh dear, we're ill, beat it 34699 003366'01 205 01 0 00 276000 MOVX T1,FLD(^D<128+27+35>,EXPMSK) 34700 003367'01 270 01 0 02 000000# ADD T1,BXPINC(T2) ; Load maximum unrounded and calculate shift 34701 003370'01 612 03 0 02 000000# TDNE T3,SLSHMK(T2) ; Is there enough space for a single shift 34702 003371'01 254 00 0 00 003376' IFSKP. ; Yes, use logical since FASTER than a combined 34703 003372'01 242 03 0 05 000000 LSH T3,(Q1) ; Finally get the bits out of the way 34704 003373'01 434 01 0 00 000003 IOR T1,T3 ; Cons the exponent and mantissa K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 56-2 K20TIM MAC 9-Nov-23 15:10 Routine to implement double float 34705 003374'01 400 02 0 00 000000 SETZ T2, ; And nothing in the low order 34706 003375'01 254 00 0 00 003401' ELSE. ; Otherwise part of mantissa will be in low word 34707 003376'01 244 03 0 05 000000 ASHC T3,(Q1) ; Split the fraction across two words 34708 003377'01 434 01 0 00 000003 IOR T1,T3 ; Cons the exponent and high mantissa 34709 003400'01 200 02 0 00 000004 MOVE T2,T4 ; And return the low mantissa 34710 003401'01 ENDIF. ; End case of combined shift decision 34711 003401'01 ENDIF. ; End case of 27 or less bit high order mantissa 34712 003401'01 254 00 0 00 003424' JRST DFLRET ; and return the value 34713 003402'01 ENDIF. ; End case of no low order mantissa 34714 ; Here if more than 35 significant bits 34715 003402'01 603 03 0 00 377000 TXNE T3,EXPMSK ; If we are between 2,305,843,009,213,693,952 34716 003403'01 254 00 0 00 003412' IFSKP. ; and 4,611,686,018,427,387,903 then the double 34717 003404'01 607 03 0 00 000400 TXNN T3,1B9 ; float will be trivial as the mantissa is already 34718 003405'01 254 00 0 00 003412' ANSKP. ; in the right place, 'normalized' so to speak 34719 003406'01 205 01 0 00 276000 MOVX T1,FLD(^D<128+27+35>,EXPMSK) 34720 003407'01 434 01 0 00 000003 IOR T1,T3 ; Cons the exponent and mantissa 34721 003410'01 200 02 0 00 000004 MOVE T2,T4 ; lower order fraction will not move, either 34722 003411'01 254 00 0 00 003424' JRST DFLRET ; and return the value 34723 003412'01 ENDIF. ; End case of exactly perfect double mantissa 34724 ; Finally have to do some honest work ... 34725 003412'01 332 01 0 00 000003 SKIPE T1,T3 ; Load (and check) the high order of the mantissa 34726 003413'01 243 01 0 00 003415' JFFO T1,.+2 ; Find the first significant bit 34727 003414'01 263 17 0 00 000000 RET ; Broken JFFO, we just checked T3! 34728 003415'01 337 01 0 02 000000# SKIPG T1,DWBEXP(T2) ; Load the appropriate double word binary exponent 34729 003416'01 263 17 0 00 000000 RET ; Probably an errorneous table ... 34730 003417'01 336 05 0 02 000000# SKIPN Q1,DWASHN(T2) ; Load and check the normalization shift 34731 003420'01 263 17 0 00 000000 RET ; Probably an errorneous table ... 34732 003421'01 244 03 0 05 000000 ASHC T3,(Q1) ; Otherwise normalize the double integer 34733 003422'01 434 01 0 00 000003 IOR T1,T3 ; Cons up the exponent and high order mantissa 34734 003423'01 200 02 0 00 000004 MOVE T2,T4 ; Return the properly normalized low order 34735 REMARK DFLRET ; And hit the exit code 34736 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 57 K20TIM MAC 9-Nov-23 15:10 Double floating integer conversion support 34737 SUBTTL Double floating integer conversion support 34738 34739 REMARK Common exit, converts number to negative, if necessary 34740 34741 003424'01 305 06 0 00 000000 DFLRET: CAIGE Q2,0 ; If the original was positive, then we're through 34742 003425'01 112 01 0 00 003427' DFMP T1,DFLM1 ; No, (re)negativize our result (slowly) 34743 003426'01 254 00 0 00 003132* RETSKP ; Done 34744 34745 003427'01 576400 000000 DFLM1: EXP <576400,,0>,0 ; -1 DFMP multiplicand is what DFIN% gave us 34746 34747 34748 REMARK Here to compute number of bits to shift out of exponent field 34749 34750 ; Call: 34751 ; 34752 ; T1/ Has a number with bits in the exponent field 34753 ; 34754 ; Return: 34755 ; 34756 ; +1 Something failed, T2 and Q1 indeterminate 34757 ; +2 Success 34758 ; T2/ JFFO results (first set bit) 34759 ; Q1/ Number of bits to shift to clear the field 34760 34761 003431'01 307 01 0 00 000000 EXPSFT: CAIG T1,0 ; Zero or negative? 34762 003432'01 263 17 0 00 000000 RET ; Gronk, got called with junk 34763 003433'01 607 01 0 00 377000 TXNN T1,EXPMSK ; But is there anything to be shifted out? 34764 003434'01 263 17 0 00 000000 RET ; No, we should never have been invoked 34765 003435'01 243 01 0 00 003437' JFFO T1,.+2 ; Now find out how many leading bits 34766 003436'01 263 17 0 00 000000 RET ; Broken JFFO ... 34767 003437'01 301 02 0 00 000011 CAXL T2,1+WID(EXPMSK) ; More bits than the exponent field? 34768 003440'01 263 17 0 00 000000 RET ; Already clear and we shouldn't be here 34769 003441'01 307 02 0 00 000000 CAIG T2,0 ; However, there better be at least the sign bit! 34770 003442'01 263 17 0 00 000000 RET ; Broken JFFO (negative number check) 34771 003443'01 561 05 0 00 777767 MOVX Q1,-<1+WID(EXPMSK)> ;Load maximum possible shift 34772 003444'01 270 05 0 00 000002 ADD Q1,T2 ; And calculate the shift 34773 003445'01 254 00 0 00 003426* RETSKP ; Done! 34774 34775 ;[206] End code insertion. Or transfer. Or graft. Or something... 34776 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 58 K20TIM MAC 9-Nov-23 15:10 Calculates rate assuming input mantissas of less tnen 2^27 34777 subttl Calculates rate assuming input mantissas of less tnen 2^27 34778 34779 repeat 0,< ; Vestigial, unused 34780 34781 ; Call: 34782 ; 34783 ; t2/ Elapsed TOD ticks for transfer 34784 ; t3/ Total characters sent or received 34785 ; 34786 ; Returns: 34787 ; 34788 ; t4/ Double floating raw baud rate, high order mantissa 34789 ; t5/ Ditto, low order mantissa 34790 ; 34791 ; N.B., assumes input arguments (t3 and elapsed TOD ticks) 34792 ; do not have more than a 27 bit mantissa. 34793 ; 34794 ; Note refactoring of mathmatical operations to maintain better 34795 ; precision, Also bums a double floating divide (see below), the 34796 ; slowest instruction going. Thanks to Professor Anne for the 34797 ; multiplicative identities. 34798 34799 34800 calr27: fltr t4,t3 ; Float the count 34801 setz t5, ; Whack low order 34802 dfmp t4,[exp 2621440.,0] ;Intermediate bit ticks 34803 fltr t2,t2 ; Float those, too 34804 setz t3, ; Double float, almost (see peffif, sigh) 34805 dfmp t2,[exp 86400.,0] ; Intermediate seconds 34806 dfdv t4,t2 ; Calculates bits per second 34807 ret ; Returns rate in t4,t5 34808 34809 >;;End repeat 0 34810 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page 59 K20TIM MAC 9-Nov-23 15:10 Calculates rate assuming input mantissas of less then 2^27 34811 subttl Calculates rate assuming input mantissas of less then 2^27 34812 34813 repeat 0,< ; See numerical analysis, above 34814 34815 ; Call: 34816 ; 34817 ; t2/ Elapsed TOD ticks for transfer 34818 ; t3/ Total characters sent or received 34819 ; 34820 ; Returns: 34821 ; 34822 ; t4/ Double floating raw baud rate, high order mantissa 34823 ; t5/ Ditto, low order mantissa 34824 ; 34825 ; N.B., Assumes input arguments (t3 and elapsed TOD ticks) 34826 ; do not have more than a 27 bit mantissa. 34827 34828 calr27: fltr t4,t3 ; Float the count 34829 setz t5, ; Whack low order 34830 fltr t2,t2 ; Float elapsed ticks 34831 setz t3, ; Double float, almost (see peffif, sigh) 34832 dfmp t2,[exp 86400.,0] ; Convert to characters per second 34833 dfdv t2,[exp 262144.,0] ; Strip off TOD ticks 34834 dfdv t4,t2 ; Calculates characters per second 34835 dfmp t4,[exp 10.,0] ; Convert cps to bps 34836 ret ; Returns rate in t4,t5 34837 34838 >;;End repeat 0 34839 34840 .xcmsy ; Ditch any MACSYM junk 34841 34842 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.606 123P CORE USED K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 20:02 27-Nov-23 Page S-1 K20TIM MAC 9-Nov-23 15:10 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 20:02 27-Nov-23 Page S-2 K20TIM MAC 9-Nov-23 15:10 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 20:02 27-Nov-23 Page S-3 K20TIM MAC 9-Nov-23 15:10 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 20:02 27-Nov-23 Page S-4 K20TIM MAC 9-Nov-23 15:10 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 20:02 27-Nov-23 Page S-5 K20TIM MAC 9-Nov-23 15:10 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 20:02 27-Nov-23 Page S-6 K20TIM MAC 9-Nov-23 15:10 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 20:02 27-Nov-23 Page S-7 K20TIM MAC 9-Nov-23 15:10 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 20:02 27-Nov-23 Page 1 K20SRV MAC 26-Nov-23 15:09 Preliminaries 34843 title k20srv - Kermit-20 High Level Server and Associated Local Commands 34844 34845 ; Much of the server code was moved from k20mit to this module as part 34846 ; of Edit 194 to address the issue of a very large single source file 34847 ; that unexpectedly began generating MCRNEC errors. 34848 ; 34849 ; Another goal was to make the server code more robust, easier to 34850 ; maintain and add new features. If an efficiency gain was obvious, 34851 ; then it was taken. 34852 ; 34853 ; One example of robustness was an attempt to combine the semanic 34854 ; action routines of the LOCAL commands with those of the REMOTE 34855 ; commands. This allowed for easier debugging with the understanding 34856 ; that, if something works as a LOCAL command, some amount of 34857 ; confidence could be assumed for at least that part would work as a 34858 ; server command. 34859 ; 34860 ; Thus, the supporting code for the LOCAL and remote commands is also 34861 ; here. One example would be the file deleting and directory code. 34862 34863 subttl Preliminaries 34864 34865 search monsym,macsym,cmd,k20unv ;[194] 34866 cmdacs ^ ;Clean up p1-p4 definitions 34867 34868 sall ; Tidy listing 34869 .directive flblst ; We don't need to see all the ASCIZ bytes... 34870 34871 remark common parsing external data 34872 extern pars1 ; Data from first parse. 34873 extern pars2 ; Data from second parse. 34874 extern pars3 ; Data from third parse. 34875 extern pars4 ; Data from fourth parse. 34876 extern pars5 ;[41] ... 34877 extern pars6 ;[218] 34878 34879 remark ; COMND% storage from CMD 34880 extern cjfnbk ; COMND% GTJFN block (long form) 34881 extern atmbuf ; The ubiquitous atom buffer 34882 extern atmbln ; Its length 34883 34884 remark ; Packet level storage and routines 34885 extern xflg ; Sending with X header (probably will be displayed) 34886 extern gotx ; Flag for "already got an X-packet". 34887 extern gots ; Flag for "already got an S-packet". 34888 extern sinit ; Sends an "S" or "I" (initialize parameters) 34889 extern iflg ; Sending an "I" packet 34890 extern spack ; Send a packet 34891 extern spsiz ; Maximimum size packet to send 34892 extern spar ; Get the arguments from a Send-Init packet. 34893 extern sptot ; Total of sent packets 34894 extern rpack ; Receive a packet 34895 extern rpsiz ; Maximimum size packet to receive 34896 extern $sends ; Entry point of $send for server 34897 extern rpar ; Set arguments we'd like honored k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 1-1 K20SRV MAC 26-Nov-23 15:09 Preliminaries 34898 extern rptot ; Total of recieved packets 34899 extern rrinit ; Set up various variables for receiving 34900 extern $recvs ; Entry point of $recv for server 34901 extern $recvb ; Alternate entry point in $recv for server 34902 34903 extern nak ; Negative acknowledgde; bounce a packet 34904 extern nnak ; Number of NACK's sent 34905 extern pktnum ; Current packet number 34906 extern strbuf ; String buffer, used to decode data 34907 extern strptr ; Pointer into the above (also used by k20ioc) 34908 extern strbz ; Last address of combined string areas (used to zero) 34909 extern bctone ; Set if doing single character checksum 34910 extern maxdat ; Maximum length of data field 34911 extern pktacs ; Place to save RPACK/SPACK ACs. 34912 34913 remark ; Data flow routines that feed and drain packets 34914 extern source ; Routine that GETCH calls to get data 34915 extern dest ; Routine that PUTCH calls to put data 34916 remark ch ; Current character 34917 extern next ; Next character in stream 34918 34919 remark ; JFN related storage 34920 extern filjfn ; JFN of open file 34921 extern nxtjfn ; Next JFN in wildcarding 34922 extern ndxjfn ; Stepping JFN 34923 extern logjfn ; Log file JFN (if logging) 34924 extern netjfn ; Network or non-controlling TTY JFN 34925 extern ttyjfn ; JFN of local terminal (never the same as TTYJFN) 34926 34927 remark ; File related routines and storage 34928 extern decodf ; Decode a file name 34929 extern typfil ; Display a file's contents on the terminal 34930 extern typnam ; Type a file's name (special casing .nulio) 34931 extern whakfp ; Whack a mapped file page from our address space 34932 extern frclos ; Force a JFN to close 34933 extern isnulj ; Is this JFN some flavor of NUL:? 34934 extern putbuf ; Put a buffer full of data from a packet in a file 34935 extern getbuf ; Get a buffer full of data from a file for a packet 34936 extern datbuf ; Data field of the packet 34937 extern subbp ; 'subtract' two byte pointers 34938 extern filbuf ; Buffer to build a file listing entry in 34939 extern filbfz ; End of buffer marker (address) 34940 extern mxascz ; Crazy long length for moving strings 34941 extern movasc ; Routine to move ASCII bytes quickly (hopefully) 34942 34943 remark ; N.B., the next three must be in order! 34944 extern pagcnt ; .FBBYV, Number of pages in the file and byte size 34945 extern bytcnt ; .FBSIZ and byte count 34946 extern crdate ; .FBCRV and creation date (these 3 must be adjacent!) 34947 34948 remark ; Various interrupt routines and storage 34949 extern ccon ; Enable Control-C handling 34950 extern ccoff ; Shut Control-C handling off 34951 extern caxzof ; Turn file processing interrupts off 34952 extern timeit ; Begin timing an activity k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 1-2 K20SRV MAC 26-Nov-23 15:09 Preliminaries 34953 extern timoff ; Shut off an asynchronous timer 34954 extern clrcno ; Clear Control-O 34955 extern czseen ; Control-Z seen 34956 34957 remark ; Variables for local/non-local communications 34958 extern ptyflg ; Set if the 'network' is a pseudo-terminal 34959 extern ptytty ; Mapping from PTY number to TTY number 34960 extern ttynum ; Number of controlling terminal 34961 extern speed ; Speed of physical line (if we have one) 34962 extern carier ; Carrier signal if dial up, otherwise, connection status 34963 extern mdmlin ; Set if modem-controlled line (I.E., dialup) 34964 34965 remark ; Low level communications routines and variables 34966 extern inilin ; Initialize the line 34967 extern rrslin ; Reset/Restore the communications line. 34968 extern rrsl2 ; Really reset (don't allow ^C) 34969 extern ttxon ; ^Q a line, if flow control 34970 extern statim ; Start timing (a generic command) 34971 extern delay ; Time to wait in milliseconds before first send 34972 extern odelay ; What it used to be (for saving and restoring) 34973 extern ntimou ; Number of timeouts 34974 extern stimou ; Send timeout interval 34975 extern otimou ; Its previous value, if overriden by transfer 34976 extern numtry ; Number of times we'vre tried sending this packet 34977 extern maxtry ; Maximum number of times to try 34978 extern seolch ; Remote host's End of Line character 34979 34980 remark ; Low level Top-20 monitor buffer management 34981 extern clrbuf ; Clear all characters in Tops-20 buffers 34982 extern clread ; As clrbuf, but lets us see what was in there 34983 34984 remark ; Low level I/O counters 34985 extern vchrcn ;[211] Virtual characters cleared 34986 extern nsici ;[211] Network SIN% count (SIN%'s issued) 34987 extern nsitc ;[211] Network SIN% total characters 34988 extern nsimx ;[211] Network SIN% maximum length 34989 34990 remark ; Server specific routines storage 34991 extern srvflg ; If running as a server 34992 extern local ; Set if we are not remote 34993 extern srvtim ; Server command time out 34994 34995 remark ;[189] Timing routines in K20TIM 34996 extern statim ;[189] Start timing an interval 34997 extern endtim ;[189] Stop timing an interval 34998 extern elptim ;[189] Compute elapsed HPTIM% ticks 34999 35000 remark ; Error and string macro support 35001 extern errptr ; Pointer to error text 35002 extern %%jser ; Handler for %jsErr macro 35003 extern %%krms ; Same as above, but sends to remote Kermit, too 35004 extern %%smsg ; Used to get text from non-zero section 35005 extern %kerms ; Addition messages when in protocol 35006 extern %wtlog ; Write to transaction log 35007 extern scrlft ;[233] Set to -1 to suppress trailing crlf k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 1-3 K20SRV MAC 26-Nov-23 15:09 Preliminaries 35008 extern tlgjfn ;[233] Transaction log JFN 35009 extern setlog ; Open debugging log 35010 35011 remark ; Other external variables of interest 35012 extern jobtab ;[220] Our job's GETJI% 35013 extern expung ; Set if expunging files on delete 35014 extern crlf ; Carriage Return/Line Feed 35015 extern mycaps ; Capability vector double word 35016 extern capas ; Enabled process capabilities 35017 extern f$exit ; The exit flag which tells main loop to stop 35018 35019 .psect code/ronly ; Pure code, pure Heaven 35020 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 2 K20SRV MAC 26-Nov-23 15:09 Parse tables, used as a kind of table of contents 35021 subttl Parse tables, used as a kind of table of contents 35022 35023 ;N.B., When parsing for .cmtxt and .cmcfm, .cmcfm must come first!!!! 35024 35025 remark Parse table for LOCAL commands 35026 35027 000000'02 000000 000000 %table(loctab,G) ;[220] Used as a kind of table of contents 35028 000001'02 000000# 000003' %keyf3 , %cwd, 35029 000000'03 002000 000005 35030 000001'03 143 000 000 000 000 35031 000002'02 000000# 000000# %keyf4 , .ycwd, $ycwd, cm%inv 35032 000002'03 002000 000001 35033 000003'03 143 144 000 000 000 35034 000004'03 000000# 000000# 35035 000003'02 000000# 000000# %cwd: %key3 , .ycwd, $ycwd 35036 000005'03 143 167 144 000 000 35037 000006'03 000000# 000000# 35038 000004'02 000000# 000000# %key3 , .ydele, $ydele 35039 000007'03 144 145 154 145 164 35040 000011'03 000000# 000000# 35041 000005'02 000000# 000000# %key3 , .ydire, $ydire 35042 000012'03 144 151 162 145 143 35043 000014'03 000000# 000000# 35044 000006'02 000000# 000000# %key3 , .ypwd, $ypwd ;[188] ;[194] 35045 000015'03 160 167 144 000 000 35046 000016'03 000000# 000000# 35047 000007'02 000000# 000000# %key3 , .yrun, $yrun 35048 000017'03 162 165 156 000 000 35049 000020'03 000000# 000000# 35050 000010'02 000000# 000000# %key3 , .ydisk, $ydisk ;[194] 35051 000021'03 163 160 141 143 145 35052 000023'03 000000# 000000# 35053 000011'02 000000# 000015' %keyf3 , %lst, 35054 000024'03 002000 000005 35055 000025'03 163 164 000 000 000 35056 000012'02 000000# 000015' %keyf3 , %lst, 35057 000026'03 002000 000005 35058 000027'03 163 164 141 000 000 35059 000013'02 000000# 000015' %keyf3 , %lst, 35060 000030'03 002000 000005 35061 000031'03 163 164 141 164 000 35062 000014'02 000000# 000000# %keyf4 , .stat, $ysrvt, cm%inv 35063 000032'03 002000 000001 35064 000033'03 163 164 141 164 151 35065 000036'03 000000# 000000# 35066 000015'02 000000# 000000# %lst: %key3 , .stat, $ysrvt ;[189] ;[194] 35067 000037'03 163 164 141 164 165 35068 000041'03 000000# 000000# 35069 000016'02 000000# 000000# %key3 , .ytype, $ytype 35070 000042'03 164 171 160 145 000 35071 000043'03 000000# 000000# 35072 000000'02 000016 000016 %tbend 35073 35074 cleans(<%cwd,%lst>) 35075 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 2-1 K20SRV MAC 26-Nov-23 15:09 Parse tables, used as a kind of table of contents 35076 remark Parse table for REMOTE commands 35077 35078 000017'02 000000 000000 %table(remtab,G) ;[220] Moved here as a kind of table of contents 35079 000020'02 000000# 000000# %keyf4 , .bye, $bye, cm%inv ;[186] Tom can't remember.. 35080 000044'03 002000 000001 35081 000045'03 142 171 145 000 000 35082 000046'03 000000# 000000# 35083 000021'02 000000# 000000# %key3 , .xcwd, $xcwd ;[194] 35084 000047'03 143 167 144 000 000 35085 000050'03 000000# 000000# 35086 000022'02 000000# 000000# %key3 , .rmfil, $xdele ;[194] 35087 000051'03 144 145 154 145 164 35088 000053'03 000000# 000000# 35089 000023'02 000000# 000000# %key3 , .rmfil, $xdire ;[194] 35090 000054'03 144 151 162 145 143 35091 000056'03 000000# 000000# 35092 000024'02 000000# 000000# %keyf4 , .xerr, $xerr, cm%inv ;[194] 35093 000057'03 002000 000001 35094 000060'03 145 162 162 157 162 35095 000062'03 000000# 000000# 35096 000025'02 000000# 000000# %keyf4 , .finis, $finis, cm%inv ;[186] Tom can't remember.. 35097 000063'03 002000 000001 35098 000064'03 146 151 156 151 163 35099 000066'03 000000# 000000# 35100 000026'02 000000# 000000# %key3 , .xhelp, $xhelp ;[120] ;[194] 35101 000067'03 150 145 154 160 000 35102 000070'03 000000# 000000# 35103 000027'02 000000# 000000# %key3 , .xhost, $xhost ;[105] 35104 000071'03 150 157 163 164 000 35105 000072'03 000000# 000000# 35106 000030'02 000000# 000000# %key3 , .xpwd, $xpwd ;[188] ;[194] 35107 000073'03 160 167 144 000 000 35108 000074'03 000000# 000000# 35109 ;;;* %key3 , .???, $??? 35110 000031'02 000000# 000000# %key3 , .xdisk, $xdisk ;[194] 35111 000075'03 163 160 141 143 145 35112 000077'03 000000# 000000# 35113 000032'02 000000# 000036' %keyf3 , %rst, 35114 000100'03 002000 000005 35115 000101'03 163 164 000 000 000 35116 000033'02 000000# 000036' %keyf3 , %rst, 35117 000102'03 002000 000005 35118 000103'03 163 164 141 000 000 35119 000034'02 000000# 000036' %keyf3 , %rst, 35120 000104'03 002000 000005 35121 000105'03 163 164 141 164 000 35122 000035'02 000000# 000000# %keyf4 , .xstat, $xstat, cm%inv 35123 000106'03 002000 000001 35124 000107'03 163 164 141 164 151 35125 000112'03 000000# 000000# 35126 000036'02 000000# 000000# %rst: %key3 , .xstat, $xstat ;[189] ;[194] 35127 000113'03 163 164 141 164 165 35128 000115'03 000000# 000000# 35129 000037'02 000000# 000000# %key3 , .rmfil, $xtype 35130 000116'03 164 171 160 145 000 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 2-2 K20SRV MAC 26-Nov-23 15:09 Parse tables, used as a kind of table of contents 35131 000117'03 000000# 000000# 35132 000017'02 000020 000020 %tbend 35133 35134 cleans(<%rst>) 35135 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 3 K20SRV MAC 26-Nov-23 15:09 BYE command 35136 subttl BYE command 35137 35138 remark Parse the BYE command. 35139 35140 000000'01 .bye: entry .bye ; Can be invoked as top-level by k20par 35141 000000'01 200 16 0 00 000000# guide (to remote server) ; Parse rest of BYE command. 35142 000001'01 260 17 0 00 000000* 35143 000040'02 000000000000# 35144 000000'04 164 157 040 162 145 35145 000002'01 260 17 0 00 000000* confrm 35146 000003'01 263 17 0 00 000000 ret 35147 35148 remark Execute the BYE command. 35149 35150 ; N.B., Uses clread to drain the terminal buffer. However, we are 35151 ; SOUT%'ing raw eight bit data, no parity. Maybe this should be 35152 ; fixed? However, the previous code didn't do parity, either 35153 ; Maybe controlify? 35154 35155 000004'01 $bye: entry $bye ; Can be invoked as top-level by k20par 35156 000004'01 265 16 0 00 005503' saveac ;[211] Needs some additional storage 35157 000005'01 260 17 0 00 000000* call statim ;[189] Start timing so k20pdc doesn't choke 35158 dmove t1, [ ;[220] 35159 point 7, [asciz/L/] ; An "L" for the data field. 35160 000006'01 120 01 0 00 005512' "G" ] ; Packet type is G. 35161 000007'01 260 17 0 00 004363' call srvcmd ;[121] Send the command. 35162 000010'01 254 00 0 00 000050' jrst $byez ; Some error, don't exit. 35163 35164 ;[16] From here to end is part of edit 16. 35165 35166 000011'01 201 05 0 00 000005 movei q1, ^d5 ;[211] ; Waiting a total of 1.25 seconds 35167 000012'01 201 01 0 00 001750 movei t1, ^d1000 ;[211] ; Wait a second right now 35168 000013'01 104 00 0 00 000167 DISMS% 35169 35170 000014'01 do. ;[211] Enter loop context 35171 000014'01 260 17 0 00 000000* call clread ;[211] Get and clear data 35172 000015'01 254 00 0 00 000040' exit. ;[211] Unless there was an error 35173 000016'01 323 01 0 00 000034' ifg. t1 ;[211] Any goodies? 35174 000017'01 350 00 0 00 000000* aos nsici ;[211] Network SIN%'s Issued 35175 000020'01 210 03 0 00 000001 movn t3, t1 ;[211] Set up for counted SOUT% 35176 000021'01 272 03 0 00 000000* addm t3, vchrcn ;[211] Subtract from cleared 35177 000022'01 272 01 0 00 000000* addm t1, nsitc ;[211] And give them to Network SIN% 35178 000023'01 313 01 0 00 000000* camle t1, nsimx ;[211] Smaller than largest? 35179 000024'01 202 01 0 00 000023* movem t1, nsimx ;[211] Nope, have a new largest! 35180 000025'01 201 01 0 00 000101 movei t1, .priou ;[211] This terminal 35181 remark t2, ;[211] Raw 8 bit pointer! 35182 000026'01 104 00 0 00 000053 SOUT% ;[211] Type it 35183 000027'01 320 12 0 00 000031' %jserr (,) ;[211] ?? 35184 000030'01 254 00 0 00 000034' 35185 000031'01 265 01 0 00 000000* 35186 000032'01 000000 000000 35187 000033'01 254 00 0 00 000034' 35188 000034'01 endif. ;[211] End case got some data 35189 000034'01 363 05 0 00 000040' sojle q1, endlp. ;[211] Stop looking if done waiting 35190 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 20:02 27-Nov-23 Page 3-1 K20SRV MAC 26-Nov-23 15:09 BYE command 35191 000036'01 104 00 0 00 000167 DISMS% 35192 000037'01 254 00 0 00 000014' loop. ;[211] Try again 35193 000040'01 enddo. ;[211] Exit loop lexical context 35194 35195 txmsg < 35196 000040'01 200 01 0 00 000000# ...> ; Maybe there's more, but... 35197 000041'01 104 00 0 00 000076 35198 000042'01 320 12 0 00 000043' 35199 000041'02 000000000000# 35200 000004'04 015 012 056 056 056 35201 000043'01 260 17 0 00 000000* call clrbuf ;[194] can't wait forever for it, 35202 000044'01 600 00 0 00 000000 nop ;[186] ; throw the rest away. 35203 000045'01 476 00 0 00 000000* setom f$exit ;[38] Set exit flag. 35204 000046'01 260 17 0 00 000000* call endtim ;[189] Stop timing 35205 000047'01 260 17 0 00 000000* call elptim ;[189] Compute elapsed time 35206 35207 ; Error exit 35208 35209 000050'01 402 00 0 00 000045* $byez: setzm f$exit ;[70] Don't exit. 35210 000051'01 263 17 0 00 000000 ret ;[70] 35211 35212 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 4 K20SRV MAC 26-Nov-23 15:09 CWD command 35213 subttl CWD command 35214 35215 remark [137] LOCAL CWD command parsing. 35216 35217 ; Changed to only parse for a password if it is determined that we 35218 ; can't connect without one. Trying the ACESS% more than once can get 35219 ; the ACJ or monitor delay code involved. 35220 ; 35221 ; N.B., The following COMND% oddity. If you are parsing for .cmdir 35222 ; and .cmdev (as is done below) and if you are connected to one 35223 ; structure and you type only the device name of another structure 35224 ; with the same named directory, then COMND% will actually parse a 35225 ; .cmdir of that directory on the other structure! 35226 35227 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 35228 000042'02 011004 000045' ycwfdb: flddb. .cmdir,,,,,ycwfd1 35229 000043'02 000000 000000 35230 000044'02 44 07 0 00 000333' 35231 000045'02 016004 000050' ycwfd1: flddb. .cmdev,,,,,ycwfd2 35232 000046'02 000000 000000 35233 000047'02 44 07 0 00 000342' 35234 000050'02 010004 000000 ycwfd2: flddb. .cmcfm,,,,, ;[220] 35235 000051'02 000000 000000 35236 000052'02 44 07 0 00 000352' 35237 000053'02 010004 000056' ypwfdb: flddb. .cmcfm,,,,,ypwfd1 35238 000054'02 000000 000000 35239 000055'02 44 07 0 00 000362' 35240 000056'02 021004 000061' ypwfd1: flddb. .cmqst,,,,,ypwfd2 35241 000057'02 000000 000000 35242 000060'02 44 07 0 00 000371' 35243 000061'02 017004 000000 ypwfd2: flddb. .cmtxt,,,,, ;[220] 35244 000062'02 000000 000000 35245 000063'02 44 07 0 00 000371' 35246 retsec ;;Get back to wherever we came from 35247 cleans() 35248 35249 000052'01 .ycwd: entry .ycwd ; Invoked from k20par 35250 000052'01 265 16 0 00 005514' saveac ; Save some accumulators for interim parse results 35251 35252 000053'01 200 16 0 00 000000# guide ; Issue guide words. 35253 000054'01 260 17 0 00 000001* 35254 000064'02 000000000000# 35255 000006'04 164 157 040 144 151 35256 000055'01 201 01 0 00 000000# movei t1, ycwfdb ;[220] 35257 000056'01 260 17 0 00 000000* call rfield ; Parse a directory specification. 35258 000057'01 135 03 0 00 005524' ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 35259 000060'01 120 06 0 00 000002 dmove q2, t2 ;[220] Save these for downstream parsing 35260 35261 000061'01 302 07 0 00 000010 caie q3, .cmcfm ; Confirmation? 35262 000062'01 254 00 0 00 000070' ifskp. ; Yes, then use our own logged-in directory 35263 000063'01 200 02 0 00 000000# move t2, .jilno+jobtab ; number, which always works without a password 35264 000064'01 201 03 0 00 000011 movei t3, .cmdir ;[220] Lie and say we parsed a directory 35265 000065'01 124 02 0 00 000000* dmovem t2, pars3 ;[220] Pass to semantic action 35266 000066'01 402 00 0 00 000000* setzm pars5 ;[220] No password string being passed 35267 000067'01 263 17 0 00 000000 ret ; We're done k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 4-1 K20SRV MAC 26-Nov-23 15:09 CWD command 35268 000070'01 endif. 35269 35270 000070'01 302 07 0 00 000016 caie q3, .cmdev ;[220] Parsed a device?? 35271 000071'01 254 00 0 00 000103' ifskp. ;[193] Yes (can't connect to DECtape) 35272 000072'01 200 01 0 00 000006 move t1, q2 ;[220] Let's check it 35273 000073'01 260 17 0 00 000000* call isnulj ;[193] Is it NUL:? 35274 000074'01 254 00 0 00 000103' anskp. ;[193] It isn't, must be some other odd thing 35275 000075'01 200 06 0 00 000001 move q2, t1 ;[220] It is, so remember that 35276 000076'01 260 17 0 00 000002* confrm ;[220] Confirm the line, do not allow .cmqst 35277 000077'01 124 06 0 00 000065* dmovem q2, pars3 ;[220] Pass both to semantic action 35278 000100'01 402 00 0 00 000066* setzm pars5 ;[220] No password string being passed 35279 000101'01 263 17 0 00 000000 ret ;[220] Done, skipping the .cmqst 35280 000102'01 254 00 0 00 000136' else. ;[220] Here if some other device 35281 000103'01 302 07 0 00 000016 caie q3, .cmdev ;[220] Are we here because of phonkey .cmdev? 35282 000104'01 254 00 0 00 000136' anskp. ;[220] No, it's a .cmdir, so that's fine 35283 000105'01 200 01 0 00 000006 move t1, q2 ;[220] Let's see if it can do files 35284 000106'01 260 17 0 00 004723' call isdird ;[220] See if this is a directory device 35285 000107'01 254 00 0 00 000114' ifskp. ;[220] It is, see what kind 35286 000110'01 135 03 0 00 005525' ldb t3,[pointr(t2,dv%typ)] ;[220] Load type 35287 000111'01 302 03 0 00 000000 caie t3, .dvdsk ;[220] Structure? 35288 000112'01 254 00 0 00 000114' anskp. ;[220] Can't connect to DECtape... 35289 000113'01 254 00 0 00 000133' else. ;[220] Not a disk based directory structure 35290 000114'01 200 01 0 00 000000# sxtext(t1,) ;[220] Initial part of error message 35291 000065'02 000000000000# 35292 000011'04 115 141 171 040 156 35293 000115'01 104 00 0 00 000313 ESOUT% ;[220] Begin whining 35294 000116'01 403 03 0 00 000004 setzb t3, t4 ;[220] Clear up some storage 35295 000117'01 561 01 0 00 000003 hrroi t1, t3 ;[220] Writing device name into registers 35296 000120'01 200 02 0 00 000006 move t2, q2 ;[220] Load device 35297 000121'01 104 00 0 00 000121 DEVST% ;[220] Write it 35298 000122'01 320 12 0 00 000124' ifje. r ;[220] Failed?? We just parsed it! 35299 000123'01 254 00 0 00 000126' 35300 000124'01 120 03 0 00 005526' dmove t3, [asciz /(error)/] ;[220] Stomp in something 35301 000125'01 254 00 0 00 000130' else. ;[220] Otherwise, worked 35302 000126'01 201 02 0 00 000072 movei t2, ":" ;[220] Load terminating device punctuation 35303 000127'01 136 02 0 00 000001 idpb t2, t1 ;[220] Take on the end, rest of word is .chnul's 35304 000130'01 endif. ;[220] End case DEVST% handling 35305 000130'01 561 01 0 00 000003 hrroi t1, t3 ;[220] Point to t3 again 35306 000131'01 104 00 0 00 000076 PSOUT% ;[220] Blat that out, too 35307 000132'01 254 00 0 00 000000* callret cmder1 ;[220] Allow a reparse, however 35308 000133'01 endif. ;[220] End case acceptable directory analysis 35309 000133'01 260 17 0 00 000163' call defdir ;[220] Try to default the directory on the structure 35310 000134'01 254 00 0 00 000132* callret cmder1 ;[220] Couldn't... Allow reparse 35311 000135'01 201 07 0 00 000011 movei q3, .cmdir ;[220] Pretend they typed the directory 35312 000136'01 endif. ;[193] End case parsed a device 35313 35314 remark .cmdir ;[220] At this point, we know the directory exists 35315 000136'01 200 01 0 00 000006 move t1, q2 ;[220] Load the directory in question 35316 000137'01 260 17 0 00 000642' call pwconp ;[220] Do we need a password to get to this? 35317 000140'01 254 00 0 00 000145' ifskp. ;[220] No, so do not parse for a quoted string 35318 000141'01 260 17 0 00 000076* confrm ;[220] Just confirm the command 35319 000142'01 124 06 0 00 000077* dmovem q2, pars3 ;[220] Pass directory and parse type to semantic action 35320 000143'01 402 00 0 00 000100* setzm pars5 ;[220] No password string being passed 35321 000144'01 263 17 0 00 000000 ret ;[220] And we're done 35322 000145'01 endif. ;[220] k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 4-2 K20SRV MAC 26-Nov-23 15:09 CWD command 35323 35324 remark ;[220] May need a password, so allow a parse for that 35325 000145'01 201 01 0 00 000000# movei t1, ypwfdb ;[220] Allow a password on the same line 35326 000146'01 260 17 0 00 000056* call rfield ;[220] See if they want the password right now 35327 000147'01 135 03 0 00 005524' ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 35328 35329 000150'01 302 03 0 00 000010 caie t3, .cmcfm ;[220] Didn't specify anything? 35330 000151'01 254 00 0 00 000155' ifskp. ;[220] Nope, so we're done with the parse 35331 000152'01 124 06 0 00 000142* dmovem q2, pars3 ;[220] Pass directory and parse type to semantic action 35332 000153'01 402 00 0 00 000143* setzm pars5 ;[220] No password string being passed 35333 000154'01 263 17 0 00 000000 ret ;[220] And get out of here 35334 000155'01 endif. ;[220] End case no string parsed 35335 35336 000155'01 260 17 0 00 000141* confrm ; Get confirmation. 35337 000156'01 124 06 0 00 000152* dmovem q2, pars3 ;[220] Pass directory and parse type to semantic action 35338 000157'01 201 01 0 00 000000* movei t1, atmbuf ;[220] Load address of the atom buffer 35339 000160'01 505 01 0 00 440700 hrli t1, () ;[220] Turn into a local pointer 35340 000161'01 202 01 0 00 000153* movem t1, pars5 ;[220] Flag that we are passing in a password 35341 000162'01 263 17 0 00 000000 ret 35342 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 5 K20SRV MAC 26-Nov-23 15:09 Vestigial Echoing code 35343 subttl Vestigial Echoing code 35344 35345 comment " ;[220] Removed because it got too hairy on a reparse 35346 ifmn. takdep ;[220] Are we in a take file? 35347 setz q5, ;[220] We are, flag that 35348 else. ;[220] Aren't; so monkey with terminal mode 35349 seto q5, ;[220] Let's assume not in a take file 35350 remark cm%wkf ;[220] Maybe tweak this? 35351 endif. 35352 35353 remark ... 35354 35355 ifn. q5 ;[220] Not in a take file? 35356 skipg t1, ttyjfn ;[220] This terminal 35357 anskp. ;[220] We don't have one, don't do this 35358 RFMOD% ;[220] Pull its mode word 35359 annje. ;[220] Punt the rest if this fails 35360 txz t2, tt%osp ;[220] Clear control-O so prompt comes out 35361 move q5, t2 ;[220] And save it 35362 txz t2, tt%eco ;[220] Turn off echoing. 35363 SFMOD% ;[220] Try doing it ... 35364 annje. ;[220] Punt the rest if this fails 35365 remark ;[220] At this point, echo is off 35366 else. ;[220] Otherwise, q5 is zero or should be 35367 setz q5, ;[220] If here because of error, disallow 35368 endif. ;[220] 35369 35370 remark ... 35371 35372 ifn. q5 ;[220] Hacking terminal modes? 35373 push p, t1 ;[220] Save temporaries around SFMOD% 35374 push p, t2 ;[220] it wants t1 and t2 35375 move t1, ttyjfn ;[220] Load terminal JFN 35376 move t2, q5 ;[220] and whatever we saved 35377 SFMOD% ;[220] Restore TTY to normal echoing. 35378 %jserr (,) ;[220] Carry on 35379 pop p, t2 ;[220] Restore temporaries SFMOD% used 35380 pop p, t1 ;[220] it wanted t1 and t2 35381 endif. ;[220] End case mode detweak 35382 35383 ";;comment k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 6 K20SRV MAC 26-Nov-23 15:09 Default a directory on a structure 35384 subttl Default a directory on a structure 35385 35386 ;[220] Begin code insertion 35387 35388 ; Largely unnecessary, as Tops-20 will do this for domestic structures. 35389 35390 000163'01 265 16 0 00 005530' defdir: saveac ; Needs two index registers 35391 000164'01 265 16 0 00 000000* anstkv (q3,dirmxw) ; Place to build the default directory 35392 000165'01 000000 000012 35393 000166'01 415 07 0 17 777765 35394 000167'01 265 16 0 00 000164* anstkv (q4,dirmxw) ; Place to put currently connected directory 35395 000170'01 000000 000012 35396 000171'01 415 10 0 17 777765 35397 35398 000172'01 201 01 0 00 000011 movx t1, ; Length of area in words 35399 000173'01 200 02 0 00 000007 move t2, q3 ; First address in area 35400 000174'01 201 03 0 02 000001 movei t3, 1(t2) ; Doing a cascade xblt 35401 000175'01 402 00 0 02 000000 setzm (t2) ; Zero first word 35402 000176'01 123 01 0 00 005542' xblt. t1 ; Clear the rest of the area 35403 35404 000177'01 560 01 0 00 000007 hrro t1, q3 ; Build Tops-20 pointer to area 35405 000200'01 200 02 0 00 000006 move t2, q2 ; Load device 35406 000201'01 104 00 0 00 000121 DEVST% ; Construct first part of defaulted directory 35407 000202'01 320 12 0 00 000204' %jserr (,r) 35408 000203'01 254 00 0 00 000207' 35409 000204'01 265 01 0 00 000031* 35410 000205'01 000000000000# 35411 000206'01 254 00 0 00 000000* 35412 000015'04 125 156 141 142 154 35413 000207'01 200 11 0 00 000001 move q5, t1 ; Save the final pointer for appending 35414 35415 000210'01 201 01 0 00 000011 movx t1, ; Length of area in words 35416 000211'01 200 02 0 00 000010 move t2, q4 ; First address in area 35417 000212'01 201 03 0 02 000001 movei t3, 1(t2) ; Doing a cascade xblt 35418 000213'01 402 00 0 02 000000 setzm (t2) ; Zero first word 35419 000214'01 123 01 0 00 005542' xblt. t1 ; Clear the rest of the area 35420 35421 000215'01 560 01 0 00 000010 hrro t1, q4 ; Build Tops-20 pointer to area 35422 000216'01 200 02 0 00 000000# move t2, .jidno+jobtab ; Load currently connected directory 35423 000217'01 104 00 0 00 000041 DIRST% ; Render as a string 35424 000220'01 320 12 0 00 000222' %jserr (,r) 35425 000221'01 254 00 0 00 000225' 35426 000222'01 265 01 0 00 000204* 35427 000223'01 000000000000# 35428 000224'01 254 00 0 00 000206* 35429 000027'04 125 156 141 142 154 35430 35431 000225'01 200 02 0 00 000010 move t2, q4 ; Load address of connected directory string 35432 000226'01 505 02 0 00 440700 hrli t2, () ; Turn into a local pointer 35433 35434 000227'01 do. ; Enter loop context to find end of device 35435 000227'01 134 03 0 00 000002 ildb t3, t2 ; Pick up a byte 35436 000230'01 306 03 0 00 000072 cain t3, ":" ; Hit the colon? 35437 000231'01 254 00 0 00 000241' exit. ; We did, break out of the loop 35438 000232'01 326 03 0 00 000240' ife. t3 ; Sanity check k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 6-1 K20SRV MAC 26-Nov-23 15:09 Default a directory on a structure 35439 000233'01 334 01 0 00 000000# ermsg% (,r) 35440 000234'01 254 00 0 00 000240' 35441 000235'01 202 01 0 00 000000* 35442 000236'01 104 00 0 00 000313 35443 000237'01 254 00 0 00 000224* 35444 000066'02 000000000000# 35445 000041'04 113 105 122 115 111 35446 35447 000240'01 endif. ; End check 35448 000240'01 254 00 0 00 000227' loop. ; Try next character 35449 000241'01 enddo. ; End loop lexical context 35450 35451 000241'01 200 01 0 00 000011 move t1, q5 ; Load end of device 35452 35453 000242'01 do. ; Enter loop context to copy over the directory 35454 000242'01 136 03 0 00 000001 idpb t3, t1 ; Deposit into new device string 35455 000243'01 306 03 0 00 000076 cain t3, .chrpt ; Hit the right pointy bracket? 35456 000244'01 254 00 0 00 000247' exit. ; We did, so we're done 35457 000245'01 134 03 0 00 000002 ildb t3, t2 ; Pick next byte of source connected directory 35458 000246'01 254 00 0 00 000242' loop. ; Deposit it and get next byte 35459 000247'01 enddo. ; End loop lexical context 35460 35461 000247'01 400 03 0 00 000000 setz t3, ; Cons up a .chnul 35462 000250'01 136 03 0 00 000001 idpb t3, t1 ; Tie off the proposed default directory 35463 ; Now see if it exists.. 35464 000251'01 205 01 0 00 000001 movx t1, rc%emo ; Therefore, exact-match, only 35465 000252'01 560 02 0 00 000007 hrro t2, q3 ; Build Tops-20 pointer to candidate 35466 000253'01 400 03 0 00 000000 setz t3, ; Not doing any stepping, but... 35467 000254'01 104 00 0 00 000553 RCDIR% ; See if it exists 35468 000255'01 320 12 0 00 000257' %jserr (,r) 35469 000256'01 254 00 0 00 000262' 35470 000257'01 265 01 0 00 000222* 35471 000260'01 000000000000# 35472 000261'01 254 00 0 00 000237* 35473 000053'04 106 141 151 154 165 35474 000262'01 607 01 0 00 040000 ifxn. t1, rc%nom ; Doesn't exist? We surely can't connect... 35475 000263'01 254 00 0 00 000272' 35476 000264'01 560 01 0 00 000007 hrro t1, q3 ; Load pointer to our created directory 35477 000265'01 104 00 0 00 000313 ESOUT% ; Begin complaining 35478 000266'01 200 01 0 00 000000# txmsg (< does not exist, so can't be used as a default>) 35479 000267'01 104 00 0 00 000076 35480 000270'01 320 12 0 00 000271' 35481 000067'02 000000000000# 35482 000064'04 040 144 157 145 163 35483 000271'01 263 17 0 00 000000 ret ; Return +1 35484 000272'01 endif. 35485 35486 000272'01 200 06 0 00 000003 move q2, t3 ; Pretend they asked for this 35487 000273'01 254 00 0 00 000000* retskp ; Have a default 35488 35489 ;[220] End code insertion 35490 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 7 K20SRV MAC 26-Nov-23 15:09 Update GETJI% information from GJINV% 35491 subttl Update GETJI% information from GJINV% 35492 35493 ;[220] Begin code insertion 35494 35495 000274'01 udjinf: entry udjinf ; Also used by k20mit 35496 000274'01 265 16 0 00 005543' saveac ; Only side-effect storage, not accumulators 35497 35498 000275'01 104 00 0 00 000013 GJINF% ; Faster than GETJI% and always works 35499 remark t1,.jiuno+jobtab ; User number will NEVER change; no SETUID. 35500 000276'01 202 02 0 00 000000# movem t2, .jidno+jobtab ; Connected directory, which CWD changes 35501 remark t3,.jijno+jobtab ; Job number will NEVER change during execution 35502 000277'01 202 04 0 00 000000# movem t4, .jitno+jobtab ; Update current controlling terminal 35503 000300'01 263 17 0 00 000000 ret ; Always works, so return +1, always 35504 35505 ;[220] End code insertion 35506 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 8 K20SRV MAC 26-Nov-23 15:09 GETPAS -- Get a password from the terminal or file 35507 subttl GETPAS -- Get a password from the terminal or file 35508 35509 ; Call: 35510 ; 35511 ; t1/ Length of password buffer (in characters) 35512 ; t2/ Pointer to password buffer 35513 ; 35514 ; Return: 35515 ; 35516 ; +1, Some kind of failure 35517 ; +2, Got some text: 35518 ; 35519 ; t1/ Password length (in characters) 35520 ; t2/ Updated to end of password 35521 ; 35522 ; Other accumulators are unmodified 35523 ; 35524 ; Performs the following: 35525 ; 35526 ; If invoked from a TAKE file, reads the password from the file, 35527 ; using end of line as the ending delimiter. 35528 ; 35529 ; Otherwise: 35530 ; 35531 ; 1) Prompts for password, 35532 ; 2) Turns off echoing during typein, 35533 ; 3) Restores echoing 35534 ; 4) Returns with result in buffer 35535 ; 35536 ; smashes t1-t4, others preserved 35537 ; 35538 ; Partially rewritten as part of [194] for better security 35539 35540 ; In TEXT, not ETEXT because brain damaged RDTTY% can not handle the 35541 ; OWGP that PSOUT% has just typed. The RDCBP routine in COMND% only 35542 ; allows OWGP's from a non-zero section. Bogus... 35543 35544 chgsec(code,text) ;[220] Section zero text, sigh... 35545 000120'03 040 120 141 163 163 pwdprm: asciz / Password: / ;[220] Prompt for when requesting passwords 35546 retsec ;[220] Back into mainline code 35547 35548 000301'01 getpas: extern takdep, takjfn ;[194] and of our necessaries 35549 000301'01 327 01 0 00 000307' ifle. t1 ;[194] You're kidding, right? 35550 000302'01 334 01 0 00 000000# ermsg% (,r) ;[194] 35551 000303'01 254 00 0 00 000307' 35552 000304'01 202 01 0 00 000235* 35553 000305'01 104 00 0 00 000313 35554 000306'01 254 00 0 00 000261* 35555 000070'02 000000000000# 35556 000076'04 113 105 122 115 111 35557 35558 000307'01 endif. ;[194] Useless to go further 35559 ;[194] Otherwise, got a positive length 35560 000307'01 265 16 0 00 005555' saveac ;[194] 35561 000310'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 20:02 27-Nov-23 Page 8-1 K20SRV MAC 26-Nov-23 15:09 GETPAS -- Get a password from the terminal or file 35562 000311'01 201 01 0 00 000047 movx t1, mxpwlc ;[194] Yes, clip it down 35563 000312'01 120 05 0 00 000001 dmove q1, t1 ;[194] Save the calling parameters 35564 000313'01 231 01 0 00 000005 idivi t1, ^d5 ;[194] Convert from characters to words 35565 000314'01 322 02 0 00 000316' ifn. t2 ;[194] Any remainder? 35566 000315'01 271 01 0 00 000001 addi t1, ^d1 ;[194] Yes, round up a word 35567 000316'01 endif. ;[194] 35568 000316'01 200 07 0 00 000001 move q3, t1 ;[194] Store final length 35569 000317'01 550 02 0 00 000006 hrrz t2, q2 ;[194] Load word address of password buffer 35570 000320'01 260 17 0 00 000467' call scrubp ;[194] Clobber it, first 35571 35572 000321'01 336 00 0 00 000000* ifmn. takdep ;[194] ;[178] Do specially for TAKE files 35573 000322'01 254 00 0 00 000351' 35574 000323'01 200 01 0 00 000000* move t1, takjfn ; Read line from the TAKE file 35575 000324'01 120 02 0 00 000006 dmove t2, q2 ;[194] Into buffer, clipping maximum 35576 000325'01 201 04 0 00 000012 movei t4, .CHLFD ; terminate on linefeed. 35577 000326'01 104 00 0 00 000052 SIN 35578 000327'01 320 12 0 00 000331' %jserr (,r) ;[194] 35579 000330'01 254 00 0 00 000334' 35580 000331'01 265 01 0 00 000257* 35581 000332'01 000000000000# 35582 000333'01 254 00 0 00 000306* 35583 000113'04 107 145 164 040 160 35584 000334'01 474 01 0 00 000000 seto t1, ;[194] Let's investigate the read 35585 000335'01 133 01 0 00 000002 adjbp t1, t2 ;[194] Decrement the returned byte pointer. 35586 000336'01 135 04 0 00 000001 ldb t4, t1 ;[194] Load the previous character 35587 000337'01 302 04 0 00 000015 caie t4, .chcrt ;[194] Better have been a carriage return 35588 000340'01 263 17 0 00 000000 ret ;[194] It wasn't, so fail the call 35589 000341'01 400 04 0 00 000000 setz t4, ; Write a zero over the terminating CR. 35590 000342'01 137 04 0 00 000001 dpb t4, t1 35591 000343'01 136 04 0 00 000001 idpb t4, t1 ; And linefeed. 35592 000344'01 200 01 0 00 000005 move t1, q1 ;[194] Load original length 35593 000345'01 271 03 0 00 000002 addi t3, ^d2 ;[194] Account for .chcrt and .chlfd we pitched 35594 000346'01 274 01 0 00 000003 sub t1, t3 ;[194] Subtract what we didn't read, yielding length 35595 000347'01 200 02 0 00 000006 move t2, q2 ;[194] ; Return pointer to password. 35596 000350'01 254 00 0 00 000273* retskp ;[194] ;[178] Won!! 35597 000351'01 endif. ;[194] 35598 35599 remark ;[194] Otherwise, user has to type something 35600 000351'01 201 01 0 00 000100 movei t1, .priin ; Get TTY mode word 35601 000352'01 104 00 0 00 000107 RFMOD 35602 000353'01 320 12 0 00 000355' %jserr (,r) ;[194] 35603 000354'01 254 00 0 00 000360' 35604 000355'01 265 01 0 00 000331* 35605 000356'01 000000000000# 35606 000357'01 254 00 0 00 000333* 35607 000124'04 107 145 164 040 160 35608 000360'01 621 02 0 00 400000 txz t2, tt%osp ;[194] Clear control-O so prompt comes out 35609 000361'01 202 02 0 00 000010 movem t2, q4 ;[194] And save it 35610 000362'01 620 02 0 00 004000 txz t2, tt%eco ; Turn off echoing. 35611 000363'01 104 00 0 00 000110 SFMOD 35612 000364'01 320 12 0 00 000366' %jserr (,r) ;[194] 35613 000365'01 254 00 0 00 000371' 35614 000366'01 265 01 0 00 000355* 35615 000367'01 000000000000# 35616 000370'01 254 00 0 00 000357* k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 8-2 K20SRV MAC 26-Nov-23 15:09 GETPAS -- Get a password from the terminal or file 35617 000136'04 107 145 164 040 160 35618 35619 000371'01 561 01 0 00 000000# hrroi t1, pwdprm ;[194] Issue first prompt. 35620 000372'01 104 00 0 00 000076 PSOUT 35621 000373'01 200 01 0 00 000006 move t1, q2 ;[194] Load pointer to password buffer 35622 000374'01 550 02 0 00 000005 hrrz t2, q1 ;[194] Load length of buffer 35623 000375'01 661 02 0 00 060100 txo t2, rd%bel!rd%crf!rd%sui ;[194] Break on .chcrt or .chlfd, suppress .chcrt 35624 000376'01 561 03 0 00 000000# hrroi t3, pwdprm ;[194] Prompt if ^R typed 35625 000377'01 104 00 0 00 000523 RDTTY 35626 000400'01 320 12 0 00 000402' ifje. r ;[194] Failed?? 35627 000401'01 254 00 0 00 000424' 35628 000402'01 200 04 0 00 000001 move t4, t1 ;[194] Save the error 35629 000403'01 200 01 0 00 000007 move t1, q3 ;[220] Load word length of buffer 35630 000404'01 550 02 0 00 000006 hrrz t2, q2 ;[220] Load word address of password buffer 35631 000405'01 260 17 0 00 000467' call scrubp ;[220] Ditch anything that we might have gotten 35632 000406'01 334 00 0 00 000000 %ermsg (,) ;[194] Begin complaining 35633 000407'01 254 00 0 00 000413' 35634 000410'01 265 01 0 00 000366* 35635 000411'01 000000000000# 35636 000412'01 254 00 0 00 000413' 35637 000146'04 107 145 164 040 160 35638 000413'01 201 01 0 00 000100 movei t1, .priin ;[194] Diddle primary input 35639 000414'01 200 02 0 00 000010 move t2, q4 ;[194] Load original mode word 35640 000415'01 104 00 0 00 000110 SFMOD% ;[194] Restore terminal to original mode 35641 000416'01 320 12 0 00 000420' %jserr (,) ;[194] 35642 000417'01 254 00 0 00 000423' 35643 000420'01 265 01 0 00 000410* 35644 000421'01 000000000000# 35645 000422'01 254 00 0 00 000423' 35646 000155'04 107 145 164 040 160 35647 000423'01 263 17 0 00 000000 ret ;[220] Fail the call 35648 000424'01 endif. ;[194] 35649 35650 000424'01 415 16 0 00 000441' block. ;[194] Get a stack frame 35651 000425'01 261 17 0 00 000016 35652 000426'01 265 16 0 00 005571' saveac ;[194] Preserve these over SFMOD% 35653 000427'01 201 01 0 00 000100 movei t1, .priin ;[194] Diddle primary input 35654 000430'01 200 02 0 00 000010 move t2, q4 ;[194] Load original mode word 35655 000431'01 104 00 0 00 000110 SFMOD ; Restore TTY to normal echoing. 35656 000432'01 320 12 0 00 000434' %jserr (,r) ;[194] 35657 000433'01 254 00 0 00 000437' 35658 000434'01 265 01 0 00 000420* 35659 000435'01 000000000000# 35660 000436'01 254 00 0 00 000370* 35661 000170'04 107 145 164 040 160 35662 000437'01 254 00 0 00 000350* retskp ;[194] Otherwise, worked 35663 000440'01 263 17 0 00 000000 endbk. ;[194] End of block context 35664 000441'01 600 00 0 00 000000 nop ;[220] Ignore error and carry on 35665 35666 000442'01 400 03 0 00 000000 setz t3, ;[194] Cons up a .chnul 35667 000443'01 137 03 0 00 000001 dpb t3, t1 ;[194] ; Write a zero over the terminating linefeed. 35668 000444'01 550 04 0 00 000002 hrrz t4, t2 ;[194] Pick up the remaining length 35669 000445'01 271 04 0 00 000001 addi t4, ^d1 ;[194] Account for linefeed we'll toss 35670 000446'01 274 05 0 00 000004 sub q1, t4 ;[194] Calculate length of password 35671 000447'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 20:02 27-Nov-23 Page 8-3 K20SRV MAC 26-Nov-23 15:09 GETPAS -- Get a password from the terminal or file 35672 000450'01 510 04 0 00 000002 hllz t4, t2 ;[169] Remember flag bits that were returned. 35673 000451'01 561 01 0 00 000000* hrroi t1, crlf ;[194] Point to carriage return line feed 35674 000452'01 104 00 0 00 000076 PSOUT% ;[194] ; Echo the crlf that wasn't echoed. 35675 35676 000453'01 603 04 0 00 000040 ifxe. t4, rd%btm ;[194] Too long? 35677 000454'01 254 00 0 00 000465' 35678 000455'01 334 01 0 00 000000# ermsg% (,) ;[194] Complain 35679 000456'01 254 00 0 00 000461' 35680 000457'01 202 01 0 00 000304* 35681 000460'01 104 00 0 00 000313 35682 000071'02 000000000000# 35683 000202'04 113 105 122 115 111 35684 35685 000461'01 200 01 0 00 000007 move t1, q3 ;[220] Load word length of buffer 35686 000462'01 550 02 0 00 000006 hrrz t2, q2 ;[220] Load word address of password buffer 35687 000463'01 260 17 0 00 000467' call scrubp ;[220] Ditch anything that we might have gotten 35688 000464'01 263 17 0 00 000000 ret ;[220] Fail the call 35689 000465'01 endif. ;[194] 35690 35691 000465'01 120 01 0 00 000005 dmove t1, q1 ;[194] Load updated results 35692 000466'01 254 00 0 00 000437* retskp ;[194] And return them 35693 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 9 K20SRV MAC 26-Nov-23 15:09 Scrub the password buffer 35694 subttl Scrub the password buffer 35695 35696 ;[194] Begin code insertion 35697 35698 ; Call: 35699 ; 35700 ; t1/ Length of password buffer (in WORDS) 35701 ; t2/ Pointer to password buffer 35702 ; 35703 ; Returns: 35704 ; 35705 ; +1, always 35706 ; Stomps the buffer to all zeros, all AC's preserved 35707 35708 000467'01 323 01 0 00 000436* scrubp: jumple t1, r ; You're kidding, right? 35709 000470'01 265 16 0 00 005543' saveac ; Don't touch anything 35710 000471'01 200 04 0 02 000000 move t4, (t2) ; First of all, does the memory even exist? 35711 000472'01 320 12 0 00 000467* erjmpr r ; Nope, so nothing to scrub 35712 35713 000473'01 302 01 0 00 000001 caie t1, ^d1 ; Is the password really short? 35714 000474'01 254 00 0 00 000477' ifskp. ; Not a great idea, but easy enough to do 35715 000475'01 402 00 0 02 000000 setzm (t2) ; Scrub the buffer 35716 000476'01 263 17 0 00 000000 ret ; And we're done 35717 000477'01 endif. 35718 35719 remark ; Otherwise, doing two or more words 35720 000477'01 403 03 0 00 000004 setzb t3, t4 ; Cons up 10 .chnul's 35721 000500'01 124 03 0 02 000000 dmovem t3, (t2) ; Stomp at least that much 35722 000501'01 307 01 0 00 000002 caig t1, ^d2 ; Wanted to clear more than two words? 35723 000502'01 263 17 0 00 000000 ret ; No, then we're done 35724 35725 000503'01 275 01 0 00 000002 subi t1, ^d2 ; Account for two words cleared 35726 000504'01 415 03 0 02 000002 xmovei t3, 2(t2) ; Skip already cleared words 35727 000505'01 123 01 0 00 005542' xblt. t1 ; Clear the rest of the block 35728 000506'01 263 17 0 00 000000 ret ; Return all nice and tidy 35729 35730 ;[194] End code insertion 35731 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 10 K20SRV MAC 26-Nov-23 15:09 Execute the LOCAL CWD command. 35732 subttl Execute the LOCAL CWD command. 35733 35734 ;[171] Rewritten to only prompt for the password when necessary, as 35735 ; the Exec CONNECT command does, and to print the name of the 35736 ; directory connected to. 35737 ; 35738 ; First try to connect with no password. This returns immediately on 35739 ; error. 35740 ; 35741 ; [194] The previous sentence is no longer true; a connection attempt 35742 ; that fails will put the process to sleep so that it can not stay in 35743 ; a loop, trying passwords. Eventually, alerts will come out on the 35744 ; CTY. 35745 ; 35746 ; Thus, we try to guess whether we'll need a password with CHKAC% 35747 35748 000003 acabl==<.acjob+1> ; ACCES% argument block length 35749 35750 000507'01 $ycwd: entry $ycwd ;Invoked from k20par 35751 000507'01 265 16 0 00 005514' saveac ;[194] Used for anonymous stkvars 35752 000510'01 265 16 0 00 000167* anstkv (q1, ) ;[194] Argument block and password 35753 000511'01 000000 000013 35754 000512'01 415 05 0 17 777764 35755 000513'01 415 06 0 05 000003 xmovei q2, (q1) ;[194] Base of password buffer 35756 35757 000514'01 336 01 0 00 000156* skipn t1, pars3 ;[194] Load the directory (if there is one) 35758 000515'01 334 01 0 00 000000# ermsg% (,r) ;[194] 35759 000516'01 254 00 0 00 000522' 35760 000517'01 202 01 0 00 000457* 35761 000520'01 104 00 0 00 000313 35762 000521'01 254 00 0 00 000472* 35763 000072'02 000000000000# 35764 000211'04 113 105 122 115 111 35765 35766 000522'01 302 01 0 00 377777 caie t1, .nulio ;[193] Connecting to NUL:? 35767 000523'01 254 00 0 00 000526' ifskp. ;]193] We are, so do nothing 35768 000524'01 476 00 0 05 000000 setom .acdir(q1) ;[194] And impossible connected directory 35769 000525'01 254 00 0 00 000574' jrst $ycwdz ;[193] Continue as if we did something... 35770 000526'01 endif. ;[193] End NUL: special case 35771 000526'01 200 02 0 00 000000* move t2, pars4 ;[193] Load the parse type 35772 000527'01 306 02 0 00 000016 cain t2, .cmdev ;[193] Not a device, was it?? 35773 000530'01 254 00 0 00 000624' jrst cwdeve ;[193] Go handle a bogus connect device 35774 000531'01 400 02 0 00 000000 setz t2, ;[220] assume no password 35775 000532'01 124 01 0 05 000000 dmovem t1, .acdir(q1) ;[194] Store in block 35776 000533'01 476 00 0 05 000002 setom .acjob(q1) ;[194] Do the connect for this job 35777 35778 000534'01 336 00 0 00 000161* ifmn. pars5 ;[220] Did they already give us a password 35779 000535'01 254 00 0 00 000550' 35780 000536'01 201 01 0 00 000010 movx t1, mxpwlw ;[220] Load length of password buffer 35781 000537'01 550 02 0 00 000534* hrrz t2, pars5 ;[220] Load section local address of where it was parsed 35782 000540'01 200 03 0 00 000006 move t3, q2 ;[220] and the address of the password buffer 35783 000541'01 123 01 0 00 005542' xblt. t1 ;[220] Transfer it 35784 remark ;[220] This is wrong if the password isn't in atmbuf 35785 dmove t1, [ atmbln ;[220] Load length of atom buffer again 35786 000542'01 120 01 0 00 005601' atmbuf ] ;[220] and the address of atom buffer k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 10-1 K20SRV MAC 26-Nov-23 15:09 Execute the LOCAL CWD command. 35787 000543'01 260 17 0 00 000467' call scrubp ;[220] Scrub any password text out of it 35788 000544'01 550 02 0 00 000006 hrrz t2, q2 ;[220] Load address of password buffer 35789 000545'01 505 02 0 00 440700 hrli t2,() ;[220] Turn into a local pointer 35790 000546'01 202 02 0 05 000001 movem t2, .acpsw(q1) ;[220] Store in access argument block 35791 000547'01 254 00 0 00 000564' jrst $ycwdy ;[220] Skip access check and first attempt 35792 000550'01 endif. ;[220] End case password already specified 35793 35794 000550'01 260 17 0 00 000642' call pwconp ;[194] Can we connect without a password? 35795 000551'01 254 00 0 00 000557' jrst $ycwdx ;[194] No, go get one 35796 000552'01 200 01 0 00 005603' movx t1, ac%con!acabl ;[194] Ask for connect function,,arg block length 35797 000553'01 200 02 0 00 000005 move t2, q1 ;[194] Load address of argument block 35798 000554'01 104 00 0 00 000552 ACCES ; Try to connect. 35799 000555'01 320 12 0 00 000557' erjmpr $ycwdx ; If error, go prompt for password. 35800 000556'01 254 00 0 00 000574' jrst $ycwdz ; Connected OK, exit. 35801 35802 ; Handle error by prompting for password and then trying to connect again. 35803 35804 000557'01 120 01 0 00 005604' $ycwdx: dmove t1, [ exp mxpwlc,] ;[194] Load length and byte size 35805 000560'01 540 02 0 00 000006 hrr t2, q2 ;[194] Now have an ASCII pointer to password buffer 35806 000561'01 202 02 0 05 000001 movem t2, .acpsw(q1) ;[194] Store in access argument block 35807 000562'01 260 17 0 00 000301' call getpas ; Ask for password. 35808 000563'01 263 17 0 00 000000 ret ;[194] Return failure 35809 000564'01 200 01 0 00 005603' $ycwdy: movx t1, ac%con!acabl ;[194] Ask for connect function,,arg block length 35810 000565'01 200 02 0 00 000005 move t2, q1 ;[194] Load address of argument block 35811 000566'01 104 00 0 00 000552 ACCES ;[194] Failure here will trigger a wait 35812 000567'01 320 12 0 00 000571' %jserr (,) ;[194] On failure, whine and continue 35813 000570'01 254 00 0 00 000574' 35814 000571'01 265 01 0 00 000434* 35815 000572'01 000000000000# 35816 000573'01 254 00 0 00 000574' 35817 000225'04 103 127 104 040 146 35818 35819 ; At this point, done either way, whether succeeded or not 35820 35821 000574'01 201 01 0 00 000010 $ycwdz: movx t1, mxpwlw ;[194] Load maximum password length, words 35822 000575'01 200 02 0 00 000006 move t2, q2 ;[194] Load address of password buffer 35823 000576'01 260 17 0 00 000467' call scrubp ;[194] Scrub any password text out of it 35824 35825 000577'01 201 01 0 00 000133 movei t1, "[" ;[194] Begin message 35826 000600'01 104 00 0 00 000074 PBOUT ;[194] 35827 000601'01 104 00 0 00 000013 GJINF% ;[194] Get job information 35828 000602'01 202 02 0 00 000000# movem t2, jobtab+.jidno ;[194] Remember for future reference. 35829 000603'01 312 02 0 05 000000 came t2, .acdir(q1) ;[194] Did we go where we wanted? 35830 000604'01 254 00 0 00 000611' ifskp. ;[194] Yes, advise of such 35831 000605'01 200 01 0 00 000000# txmsg ;[194] Print what we're connected to. 35832 000606'01 104 00 0 00 000076 35833 000607'01 320 12 0 00 000610' 35834 000073'02 000000000000# 35835 000232'04 103 157 156 156 145 35836 000610'01 254 00 0 00 000614' else. ;[194] Otherwise, say nothing happened 35837 000611'01 200 01 0 00 000000# txmsg ;[194] 35838 000612'01 104 00 0 00 000076 35839 000613'01 320 12 0 00 000614' 35840 000074'02 000000000000# 35841 000235'04 122 145 155 141 151 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 10-2 K20SRV MAC 26-Nov-23 15:09 Execute the LOCAL CWD command. 35842 000614'01 endif. ;[194] 35843 000614'01 201 01 0 00 000101 movei t1, .priou 35844 000615'01 104 00 0 00 000041 DIRST 35845 000616'01 320 12 0 00 000617' erjmpr .+1 ;[194] 35846 000617'01 201 01 0 00 000135 movei t1, "]" 35847 000620'01 104 00 0 00 000074 PBOUT 35848 000621'01 561 01 0 00 000451* hrroi t1, crlf ;[194] Tie off the line 35849 000622'01 104 00 0 00 000076 PSOUT% ;[194] 35850 000623'01 263 17 0 00 000000 ret 35851 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 11 K20SRV MAC 26-Nov-23 15:09 Here to handle some bogus connect device 35852 subttl Here to handle some bogus connect device 35853 35854 ; t1/ device designator 35855 ; t2/ parsed function code 35856 35857 000624'01 200 02 0 00 000001 cwdeve: move t2, t1 ;[193] Save device designator 35858 000625'01 403 03 0 00 000004 setzb t3, t4 ;[193] Cons up ten nulls 35859 000626'01 124 03 0 06 000000 dmovem t3, (q2) ;[193] Scrub the buffer 35860 000627'01 561 01 0 06 000000 hrroi t1, (q2) ;[193] Point to buffer 35861 000630'01 104 00 0 00 000121 DEVST% ;[193] Convert devie to a string 35862 000631'01 320 14 0 00 000632' erjmps .+1 ;[193] Catch and suppress error 35863 000632'01 561 01 0 06 000000 hrroi t1, (q2) ;[193] Point to buffer 35864 000633'01 104 00 0 00 000313 ESOUT% ;[194] Begin blatting at user 35865 000634'01 320 12 0 00 000635' erjmpr .+1 ;[194] Catch and ignore error 35866 txmsg <: is not a file structure, so can't connect to it. 35867 000635'01 200 01 0 00 000000# > ;[193] Rest of the blat 35868 000636'01 104 00 0 00 000076 35869 000637'01 320 12 0 00 000640' 35870 000075'02 000000000000# 35871 000242'04 072 040 151 163 040 35872 35873 000640'01 124 03 0 06 000000 dmovem t3,(q2) ;[193] Scrub again 35874 000641'01 263 17 0 00 000000 ret ;[193] Return from failure 35875 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 12 K20SRV MAC 26-Nov-23 15:09 Can we do a passwordless connect to a directory? 35876 subttl Can we do a passwordless connect to a directory? 35877 35878 ;[194] Begin code insertion 35879 ; 35880 ; Call: 35881 ; 35882 ; t1/ Directory (number) to connect to 35883 ; 35884 ; Return: 35885 ; 35886 ; +1, t1/ Has a zero if can't connect 35887 ; t2/ Zero if CHKAC% succeed or last error 35888 ; t1/ Has last error code if we failed the CHKAC% 35889 ; 35890 ; +2, t1/ Negative one 35891 ; t2/ Zero 35892 ; 35893 ; Smashes t1-t4 35894 35895 000642'01 265 16 0 00 000510* pwconp: anstkv(t4,<.ckapr+1>) ; Allocate an argument block 35896 000643'01 000000 000006 35897 000644'01 415 04 0 17 777771 35898 35899 000645'01 474 02 0 00 000000 seto t2, ; Request complete file access (everything) 35900 000646'01 124 01 0 04 000004 dmovem t1, .ckaud(t4) ; Store with directory number in argument block 35901 000647'01 200 01 0 00 000000# move t1, jobtab+.jidno ; Load currently connected directory 35902 000650'01 200 02 0 00 000000# move t2, mycaps+1 ; Load my enabled capabilities 35903 000651'01 124 01 0 04 000002 dmovem t1, .ckacd(t4) ; Store in argument block 35904 000652'01 201 01 0 00 000010 movx t1, .ckacn ; Checking for connect access 35905 000653'01 200 02 0 00 000000# move t2, jobtab+.jiuno ; Load my login user number 35906 000654'01 124 01 0 04 000000 dmovem t1, .ckaac(t4) ; Store in argument block 35907 35908 000655'01 201 01 0 00 000006 movx t1, <.ckapr+1> ; Load length of block 35909 000656'01 200 02 0 00 000004 move t2, t4 ; Load address of block 35910 000657'01 104 00 0 00 000521 CHKAC% ; See if we can do anything 35911 000660'01 320 12 0 00 000662' ifje. r ; Failed?? 35912 000661'01 254 00 0 00 000665' 35913 000662'01 200 02 0 00 000001 move t2, t1 ; Return the error 35914 000663'01 400 01 0 00 000000 setz t1, ; Say we can't access it 35915 000664'01 254 00 0 00 000666' else. ; Otherwise, JSYS worked 35916 000665'01 400 02 0 00 000000 setz t2, ; In which case there is no error code 35917 000666'01 endif. 35918 35919 000666'01 322 01 0 00 000521* jumpe t1, r ; If zero, then return +1 35920 000667'01 254 00 0 00 000466* retskp ; Otherwise, won!! 35921 35922 ;[194] End code insertion 35923 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 13 K20SRV MAC 26-Nov-23 15:09 REMOTE CWD Parsing 35924 subttl REMOTE CWD Parsing 35925 35926 ;[106] Parsing and execution all for Edit 106 35927 35928 ;N.B., all the extra scrubbing being done here is to try to enhance 35929 ; security by getting rid of any password remnants. 35930 35931 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 35932 000076'02 010004 000101' xcwfdb: flddb. .cmcfm,,,,,xcwfd1 35933 000077'02 000000 000000 35934 000100'02 44 07 0 00 000400' 35935 000101'02 021004 000104' xcwfd1: flddb. .cmqst,,,,,xcwfd2 35936 000102'02 000000 000000 35937 000103'02 44 07 0 00 000410' 35938 000104'02 017004 000000 xcwfd2: flddb. .cmtxt,,,,, 35939 000105'02 000000 000000 35940 000106'02 44 07 0 00 000410' 35941 000107'02 010004 000112' xpwfdb: flddb. .cmcfm,,,,,xpwfd1 35942 000110'02 000000 000000 35943 000111'02 44 07 0 00 000416' 35944 000112'02 021004 000115' xpwfd1: flddb. .cmqst,,,,,xpwfd2 35945 000113'02 000000 000000 35946 000114'02 44 07 0 00 000425' 35947 000115'02 017004 000000 xpwfd2: flddb. .cmtxt,,,,, 35948 000116'02 000000 000000 35949 000117'02 44 07 0 00 000425' 35950 retsec ;;Get back to wherever we came from 35951 cleans() 35952 35953 000670'01 .xcwd: entry .xcwd ;[220] Invoked by k20par 35954 000670'01 265 16 0 00 005606' saveac ;[220] Necessary for intermediate parse results 35955 35956 remark ;[220] Note, these lengths are for foreign directories 35957 000671'01 120 01 0 00 005620' dmove t1, [exp fdrmxw,dirbuf] 35958 000672'01 260 17 0 00 000467' call scrubp ;[194] Scrub the directory buffer 35959 000673'01 120 01 0 00 005622' dmove t1, [exp fpwmxw,pasbuf] 35960 000674'01 260 17 0 00 000467' call scrubp ;[194] Scrub the password buffer 35961 35962 remark ;[220] First get directory, if specified 35963 000675'01 200 16 0 00 000000# guide ; Issue guide words. 35964 000676'01 260 17 0 00 000054* 35965 000120'02 000000000000# 35966 000255'04 164 157 040 144 151 35967 000677'01 201 01 0 00 000000# movei t1, xcwfdb ;[220] Allow a quote of the remote directory 35968 000700'01 260 17 0 00 000146* call rfield ;[220] Parse something 35969 000701'01 120 05 0 00 000001 dmove q1, t1 ;[220] Store parse results 35970 000702'01 135 07 0 00 005524' ldb q3, [pointr (.cmfnp(t3),cm%fnc)] ;[220] Get function code 35971 000703'01 302 07 0 00 000010 caie q3, .cmcfm ;[241] Was it a bare confirm? 35972 000704'01 254 00 0 00 000710' ifskp. ;[241] Yes, let's not return gubbish 35973 000705'01 120 01 0 00 005624' dmove t1, [exp atmbln,atmbuf] 35974 000706'01 260 17 0 00 000467' call scrubp ;[241] Don't send anything to remote system!! 35975 000707'01 263 17 0 00 000000 ret ;[241] Return, taking default (with no password) 35976 000710'01 endif. ;[241] End case bare confirm 35977 35978 remark ;[220] BUT!! Did they actually type anything?? k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 13-1 K20SRV MAC 26-Nov-23 15:09 REMOTE CWD Parsing 35979 000710'01 200 02 0 00 005626' move t2, [point 7, atmbuf] ;[220] Let's see what they did 35980 000711'01 134 01 0 00 000002 ildb t1, t2 ;[220] Pick up the first byte 35981 000712'01 306 01 0 00 000015 cain t1, .chcrt ;[241] Bare carriage return? 35982 000713'01 400 01 0 00 000000 setz t1, ;[241] Turn into .CHNUL 35983 000714'01 306 01 0 00 000012 cain t1, .chlfd ;[241] Bare linefeed? 35984 000715'01 400 01 0 00 000000 setz t1, ;[241] Turn into .CHNUL 35985 000716'01 326 01 0 00 000723' ife. t1 ;[220] They didn't, so still using default area 35986 000717'01 260 17 0 00 000155* confrm ;[220] Line needs to be confirmed, however 35987 000720'01 120 01 0 00 005627' dmove t1, [exp atmbln,atmbuf] 35988 000721'01 260 17 0 00 000467' call scrubp ;[241] Don't send anything to remote system!! 35989 000722'01 263 17 0 00 000000 ret ;[220] We're done; not sending a directory 35990 000723'01 endif. ;[220] or its related password 35991 35992 000723'01 201 01 0 00 000141 movx t1, fdrmxw ;[220] Load maximum length of foreign directory 35993 dmove t2, [ atmbuf ;[220] Source is atom buffer 35994 000724'01 120 02 0 00 005631' dirbuf ] ;[220] Destination is foreign 35995 000725'01 123 01 0 00 005542' xblt. t1 ;[220] Store for semantic action 35996 000726'01 201 01 0 00 000000# movei t1, dirbuf ;[220] Load address of foreign directory 35997 000727'01 505 01 0 00 440700 hrli t1,() ;[220] Turn into a local pointer 35998 000730'01 202 01 0 00 000514* movem t1, pars3 ;[220] Store for semantic action 35999 36000 remark ;[220] Second, get password, one way or another 36001 ;;;; remark shut off echoing here like exec? 36002 000731'01 201 01 0 00 000000# movei t1, xpwfdb ;[220] Allow a quote of the remote directory 36003 000732'01 260 17 0 00 000700* call rfield ;[220] Parse something 36004 000733'01 120 05 0 00 000001 dmove q1, t1 ;[220] Store parse results 36005 000734'01 135 07 0 00 005524' ldb q3, [pointr (.cmfnp(t3),cm%fnc)] ;[220] Get function code 36006 ;;;; remark turn back on, but only if not in take file 36007 36008 000735'01 306 07 0 00 000010 cain q3, .cmcfm ;[220] Was it a confirm? 36009 000736'01 254 00 0 00 000762' jrst .xcwd1 ;[220] It was, so specifying password on next line 36010 36011 remark ;[220] BUT!! Did they type anything?? 36012 000737'01 200 02 0 00 005626' move t2, [point 7, atmbuf] ;[220] Let's see what they did 36013 000740'01 134 01 0 00 000002 ildb t1, t2 ;[220] Pick up the first byte 36014 000741'01 306 01 0 00 000015 cain t1, .chcrt ;[241] Bare carriage return? 36015 000742'01 400 01 0 00 000000 setz t1, ;[241] Turn into .CHNUL 36016 000743'01 306 01 0 00 000012 cain t1, .chlfd ;[241] Bare linefeed? 36017 000744'01 400 01 0 00 000000 setz t1, ;[241] Turn into .CHNUL 36018 000745'01 326 01 0 00 000752' ife. t1 ;[220] Did they do a "" for no password? 36019 000746'01 260 17 0 00 000717* confrm ;[220] They did; still needs to be confirmed 36020 000747'01 120 01 0 00 005633' dmove t1, [exp atmbln,atmbuf] 36021 000750'01 260 17 0 00 000467' call scrubp ;[241] Don't send anything to remote system!! 36022 000751'01 263 17 0 00 000000 ret ;[220] Leave, explicitly not sending a password 36023 000752'01 endif. 36024 36025 remark ;[220] Otherwise, nearly done 36026 000752'01 260 17 0 00 000746* confrm ;[220] Confirm before copying sensitive data 36027 000753'01 201 01 0 00 000141 movx t1, fpwmxw ;[220] Load maximum length of foreign password 36028 dmove t2, [ atmbuf ;[220] Source is atom buffer 36029 000754'01 120 02 0 00 005635' pasbuf ] ;[220] Destination is foreign password 36030 000755'01 123 01 0 00 005542' xblt. t1 ;[220] Store for semantic action 36031 000756'01 201 01 0 00 000000# movei t1, pasbuf ;[220] Load address of foreign password 36032 000757'01 505 01 0 00 440700 hrli t1,() ;[220] Turn into a local pointer 36033 000760'01 202 01 0 00 000526* movem t1, pars4 ;[220] Store for semantic action k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 13-2 K20SRV MAC 26-Nov-23 15:09 REMOTE CWD Parsing 36034 000761'01 263 17 0 00 000000 ret ;[220] Successfully completed parse 36035 36036 000762'01 .xcwd1: dmove t1, [ ;[220] No, they did not 36037 mxpwlc ;[220] Maximum password length in characters 36038 000762'01 120 01 0 00 005637' point 7,pasbuf ] ;[220] Point to password buffer 36039 000763'01 260 17 0 00 000301' call getpas ;[220] Ask for a password. 36040 000764'01 254 00 0 00 000134* jrst cmder1 ;[220] Handle like a parse error, do not do semantics 36041 36042 000765'01 200 01 0 00 005641' move t1,[point 7,pasbuf];[241] Point to password buffer 36043 000766'01 134 01 0 00 000002 ildb t1, t2 ;[241] Pick up the first byte 36044 000767'01 306 01 0 00 000015 cain t1, .chcrt ;[241] Bare carriage return? 36045 000770'01 400 01 0 00 000000 setz t1, ;[241] Turn into .CHNUL 36046 000771'01 306 01 0 00 000012 cain t1, .chlfd ;[241] Bare linefeed? 36047 000772'01 400 01 0 00 000000 setz t1, ;[241] Turn into .CHNUL 36048 000773'01 326 01 0 00 001001' ife. t1 ;[241] They didn't, so chuck remnants 36049 000774'01 120 01 0 00 005642' dmove t1, [exp fpwmxw,pasbuf] 36050 000775'01 260 17 0 00 000467' call scrubp ;[241] Chuck any gubbish in password buffer 36051 000776'01 120 01 0 00 005644' dmove t1, [exp atmbln,atmbuf] 36052 000777'01 260 17 0 00 000467' call scrubp ;[241] Sanitize the atom buffer, also 36053 001000'01 263 17 0 00 000000 ret ;[241] We're done; sending a directory 36054 001001'01 endif. ;[220] but not its related password 36055 36056 001001'01 200 01 0 00 005646' move t1,[point 7,pasbuf];[220] Point to password buffer 36057 001002'01 202 01 0 00 000760* movem t1, pars4 ;[220] Save pointer to it. 36058 001003'01 263 17 0 00 000000 ret ;[220] Done 36059 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 14 K20SRV MAC 26-Nov-23 15:09 REMOTE CWD Execution 36060 subttl REMOTE CWD Execution 36061 36062 001004'01 $xcwd: extern strbuf, strptr ; Defined in k20mit 36063 001004'01 260 17 0 00 000005* call statim ;[189] Start timing so k20pdc doesn't choke 36064 36065 001005'01 403 01 0 00 000002 setzb t1, t2 ;[220] Cons up some .chnul's 36066 001006'01 124 01 0 00 000000* dmovem t1, strbuf ;[220] Zero out old stuff 36067 001007'01 124 01 0 00 000000# dmovem t1, strbuf+2 ;[220] and a bit more of it 36068 001010'01 200 02 0 00 005647' move t2, [ point 7, strbuf ] ;[220] Point to string buffer 36069 001011'01 202 02 0 00 000000* movem t2, strptr ;[220] Save current location 36070 36071 001012'01 201 04 0 00 000103 movei t4, "C" ; CWD generic command letter 36072 001013'01 136 04 0 00 000002 idpb t4, t2 ;[220] First character of data 36073 001014'01 133 00 0 00 000002 ibp t2 ; Leave room for length. 36074 36075 001015'01 332 01 0 00 000730* skipe t1, pars3 ;[220] But!! Did they specify a directory? 36076 001016'01 254 00 0 00 001025' ifskp. ;[220] They did not, we're done 36077 dmove t3, [ ;[220] Force zero length data area 36078 .chspc ;[220] Space is ASCII for zero length 36079 001017'01 120 03 0 00 005650' point 7,strbuf,13 ] ;[220] Point to second character in packet 36080 001020'01 137 03 0 00 000004 dpb t3, t4 ;[220] Deposit count at head of field. 36081 001021'01 200 01 0 00 001011* move t1, strptr ;[220] Point to beginning of packet (before "C") 36082 001022'01 201 02 0 00 000107 movei t2, "G" ;[220] Packet type is generic 36083 001023'01 254 00 0 00 004635' callret dosrv ;[220] Go send it, handle the reply and return 36084 001024'01 254 00 0 00 001026' else. ;[220] Otherwise, have a directory to copy 36085 001025'01 400 03 0 00 000000 setz t3, ;[220] Initialize counter 36086 001026'01 endif. ;[220] End case default area 36087 36088 001026'01 do. ; Enter loop context to copy directory 36089 001026'01 134 04 0 00 000001 ildb t4, t1 ; Pick up a byte of the directory 36090 001027'01 322 04 0 00 001032' jumpe t4, endlp. ; Stop at the end of the string 36091 001030'01 136 04 0 00 000002 idpb t4, t2 ; Deposit it in string buffer 36092 001031'01 344 03 0 00 001026' aoja t3, top. ; Get some more bytes, weee!! 36093 001032'01 enddo. ; End of loop context 36094 36095 ; Note that lengths here apply to UNPREFIXED values. If a length 36096 ; turns out to be the same as a prefix character, it will be quoted 36097 ; itself. 36098 36099 001032'01 200 04 0 00 005651' move t4, [point 7, strbuf, 13] ; Deposit count at head of field. 36100 001033'01 271 03 0 00 000040 addi t3, 40 ; Make it printable. 36101 001034'01 137 03 0 00 000004 dpb t3, t4 36102 36103 001035'01 336 00 0 00 001002* ifmn. pars4 ; Got a password too? 36104 001036'01 254 00 0 00 001052' 36105 001037'01 202 02 0 00 001021* movem t2, strptr ; Yes. Save current pointer. 36106 001040'01 133 00 0 00 000002 ibp t2 ; Save a place for length of this field. 36107 001041'01 400 03 0 00 000000 setz t3, ; Reset counter for new field. 36108 001042'01 200 01 0 00 001035* move t1, pars4 ; Load pointer to password 36109 001043'01 do. ; Enter loop context to copy that over 36110 001043'01 134 04 0 00 000001 ildb t4, t1 ; Get a character from the password 36111 001044'01 322 04 0 00 001047' jumpe t4, endlp. ; If zero, done. 36112 001045'01 136 04 0 00 000002 idpb t4, t2 ; Append it 36113 001046'01 344 03 0 00 001043' aoja t3, top. ; Count it & loop. 36114 001047'01 enddo. ; End loop context k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 14-1 K20SRV MAC 26-Nov-23 15:09 REMOTE CWD Execution 36115 001047'01 136 04 0 00 000002 idpb t4, t2 ; Make it asciz. 36116 001050'01 271 03 0 00 000040 addi t3, 40 ; Make count printable. 36117 001051'01 136 03 0 00 001037* idpb t3, strptr ; Deposit it at head of field. 36118 001052'01 endif. ; End case password supplied 36119 ; Point to completed buffer 36120 dmove t1, [ point 7, strbuf 36121 001052'01 120 01 0 00 005652' "G" ] ; Packet type is H. 36122 001053'01 254 00 0 00 004635' jrst dosrv ; Go send it and handle the reply. 36123 36124 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 15 K20SRV MAC 26-Nov-23 15:09 LOCAL DELETE parsing 36125 subttl LOCAL DELETE parsing 36126 36127 chgsec(code,const) ;;Parsing and tables go in constants 36128 000121'02 100120 777775 delbk: gj%old!gj%ifg!gj%flg!.gjall ; Flag bits,,generation number. 36129 000122'02 000100 000101 .priin,,.priou ; COMND i/o. 36130 repeat 6,<0> ; No defaults, except all generations. 36131 000123'02 000000 000000 36132 000124'02 000000 000000 36133 000125'02 000000 000000 36134 000126'02 000000 000000 36135 000127'02 000000 000000 36136 000130'02 000000 000000 36137 000010 delbkl==<.-delbk> ; Length of this GTJFN argument block. 36138 36139 000131'02 006000 000000 ydefdb: flddb. .cmfil 36140 000132'02 000000 000000 36141 retsec 36142 36143 001054'01 .ydele: entry .ydele ; Invoked from k20par 36144 001054'01 200 01 0 00 005654' movx t1, cz%ncl!.fhslf ; Close any nonopen JFNs. 36145 001055'01 104 00 0 00 000034 CLZFF 36146 001056'01 200 16 0 00 000000# guide ; Issue guide words. 36147 001057'01 260 17 0 00 000676* 36148 000133'02 000000000000# 36149 000260'04 146 151 154 145 163 36150 001060'01 200 01 0 00 005655' move t1, [delbk,,cjfnbk] ; Insert our file parsing defaults. 36151 001061'01 251 01 0 00 000000# blt t1, cjfnbk+delbkl 36152 001062'01 201 01 0 00 000000# movei t1, ydefdb 36153 001063'01 260 17 0 00 000000* call cfield 36154 001064'01 202 02 0 00 001015* movem t2, pars3 ; Here's the JFN just parsed. 36155 001065'01 550 01 0 00 000002 hrrz t1,t2 ;[193] Load the JFN, sans flags 36156 001066'01 260 17 0 00 000073* call isnulj ;[193] Is this NUL:? 36157 001067'01 254 00 0 00 001072' ifskp. ;[193] Yes, so let's fix up the parse 36158 001070'01 202 01 0 00 001064* movem t1, pars3 ;[193] Store the .nulio in there 36159 001071'01 200 02 0 00 000001 move t2,t1 ;[193] Leave for anybody downstream 36160 001072'01 endif. ;[193] 36161 001072'01 263 17 0 00 000000 ret 36162 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 16 K20SRV MAC 26-Nov-23 15:09 [113] LOCAL DELETE execution 36163 subttl [113] LOCAL DELETE execution 36164 36165 001073'01 $ydele: entry $ydele ; Invoked from k20par 36166 36167 extern ffunc ; File function being performed 36168 001073'01 550 01 0 00 001070* hrrz t1, pars3 ; Load parsed JFN 36169 001074'01 260 17 0 00 004723' call isdird ;[193] Is this a directory device? 36170 001075'01 254 00 0 00 001110' ifskp. ;[193] If worked, proceed 36171 001076'01 201 02 0 00 005233' movei t2, delfil ; Address of delete-file code. 36172 001077'01 202 02 0 00 000000* movem t2, ffunc ; Make it the file function. 36173 001100'01 332 00 0 00 000000* ifme. expung ;[199] Can only speed up the non-expunge case 36174 001101'01 254 00 0 00 001106' 36175 001102'01 200 01 0 00 001073* move t1, pars3 ;[199] Reload the parsed JFN with flags 36176 001103'01 260 17 0 00 005154' call ffjfgd ;[199] Fix file JFN for fast generational delete 36177 001104'01 254 00 0 00 001367' callret $ydir1 ;[199] Failed or exact generation; do each file by hand 36178 001105'01 202 01 0 00 001102* movem t1, pars3 ;[199] Store the updated JFN with flags 36179 001106'01 endif. ;[199] End case not expunging 36180 001106'01 254 00 0 00 001367' callret $ydir1 ; Go do it like a directory. 36181 001107'01 254 00 0 00 001144' else. ;[193] Otherwise, not a directory device (or failed) 36182 001110'01 265 16 0 00 000642* anstkv (t4,^d4) ;[193] Allocate an anonymous stack variable 36183 001111'01 000000 000004 36184 001112'01 415 04 0 17 777773 36185 001113'01 200 02 0 00 000001 move t2, t1 ;[193] Save the device designator 36186 001114'01 560 01 0 00 000004 hrro t1, t4 ;[193] Create pointer to stack space 36187 001115'01 104 00 0 00 000121 DEVST% ;[193] Convert to a string 36188 001116'01 320 12 0 00 001120' ifje. r ;[193] Failed?? 36189 001117'01 254 00 0 00 001123' 36190 001120'01 200 03 0 00 000001 move t3, t1 ;[193] Save error for debugger 36191 001121'01 561 04 0 00 001144' hrroi t4, badevc ;[193] Load a default 36192 001122'01 254 00 0 00 001127' else. ;[193] Otherwise, we have a good device 36193 001123'01 120 02 0 00 005656' dmove t2, [exp ":", .chnul] ;[193] 36194 001124'01 136 02 0 00 000001 idpb t2, t1 ;[193] Punctuate device 36195 001125'01 136 03 0 00 000001 idpb t3, t1 ;[193] Tie off the string 36196 001126'01 661 04 0 00 777777 tlo t4, -1 ;[193] So turn it into a pointer 36197 001127'01 endif. ;[193] End case DEVST% error handling 36198 001127'01 200 01 0 00 000004 move t1, t4 ;[193] Load pointer to something 36199 001130'01 104 00 0 00 000313 ESOUT% ;[193] Start complaining 36200 001131'01 200 01 0 00 000000# txmsg < has no directory to delete files from> ;[193] 36201 001132'01 104 00 0 00 000076 36202 001133'01 320 12 0 00 001134' 36203 000134'02 000000000000# 36204 000262'04 040 150 141 163 040 36205 001134'01 561 01 0 00 000621* hrroi t1, crlf ;[193] Newline 36206 001135'01 104 00 0 00 000076 PSOUT% ;[193] 36207 001136'01 400 01 0 00 000000 setz t1, ;[193] Cons up a zero 36208 001137'01 250 01 0 00 001105* exch t1, pars3 ;[193] Get and clear parsed JFN 36209 001140'01 621 01 0 00 777777 tlz t1, -1 ;[193] Clear any goofy flags 36210 001141'01 104 00 0 00 000023 RLJFN% ;[193] Punt it 36211 001142'01 320 12 0 00 001143' erjmpr .+1 ;[193] Catch and ignore error 36212 001143'01 263 17 0 00 000000 ret ;[193] And get out of here 36213 001144'01 endif. ;[193] End case device check 36214 36215 001144'01 125 156 153 156 157 badevc: asciz "Unknown device" 36216 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 17 K20SRV MAC 26-Nov-23 15:09 REMOTE DELETE, DIRECTORY, TYPE parsing 36217 subttl REMOTE DELETE, DIRECTORY, TYPE parsing 36218 36219 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 36220 000135'02 021004 000140' rmffdb: flddb. .cmqst,,,,,rmffd1 36221 000136'02 000000 000000 36222 000137'02 44 07 0 00 000431' 36223 000140'02 017004 000000 rmffd1: flddb. .cmtxt,,,,, 36224 000141'02 000000 000000 36225 000142'02 44 07 0 00 000431' 36226 retsec 36227 cleans() 36228 36229 001147'01 200 16 0 00 000000# .rmfil: guide ; Parse the rest of the command. 36230 001150'01 260 17 0 00 001057* 36231 000143'02 000000000000# 36232 000272'04 162 145 155 157 164 36233 001151'01 201 01 0 00 000000# movei t1, rmffdb ;[220] Allow a quote of the remote file specification 36234 001152'01 260 17 0 00 001063* call cfield 36235 001153'01 263 17 0 00 000000 ret 36236 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 18 K20SRV MAC 26-Nov-23 15:09 REMOTE DELETE (Erase) execution 36237 subttl REMOTE DELETE (Erase) execution 36238 36239 001154'01 336 00 0 00 000000* $xdele: ifmn. tlgjfn ;[233] Doing transaction logging? 36240 001155'01 254 00 0 00 001177' 36241 001156'01 415 16 0 00 001177' block. ;[233] Get a stack frame 36242 001157'01 261 17 0 00 000016 36243 001160'01 265 16 0 00 005543' saveac ;[233] Save even the temporaries 36244 001161'01 476 00 0 00 000000* setom scrlft ;[233] Suppress the trailing line feed 36245 001162'01 265 01 0 00 000000* wtlog(,) ;[233] 36246 001163'01 000000000000# 36247 001164'01 777777 777743 36248 001165'01 000000 000000 36249 000275'04 122 145 161 165 145 36250 001166'01 200 01 0 00 001154* move t1, tlgjfn ;[233] Put the file name name in the log 36251 001167'01 561 02 0 00 000157* hrroi t2,atmbuf ;[233] It's in the atom buffer 36252 001170'01 403 03 0 00 000004 setzb t3,t4 ;[233] Don't know how long, stop on a NUL 36253 001171'01 104 00 0 00 000053 SOUT% ;[233] Out it goes! 36254 001172'01 320 14 0 00 001173' erjmps .+1 ;[233] Catch and suppress error 36255 dmove t2,[ -1,,crlf ;[233] Tops-20 pointer to carriage return line feed 36256 001173'01 120 02 0 00 005660' -2 ] ;[233] Counted SOUT%'s are faster 36257 001174'01 104 00 0 00 000053 SOUT% ;[233] Out it goes! 36258 001175'01 320 14 0 00 001176' erjmps .+1 ;[233] Catch and suppress error 36259 001176'01 263 17 0 00 000000 endbk. ;[233] Release stack frame, restoring AC's 36260 001177'01 endif. ;[233] 36261 36262 001177'01 260 17 0 00 001004* call statim ;[189] Start timing so k20pdc doesn't choke 36263 001200'01 201 04 0 00 000105 movei t4, "E" ; Generic command is E. 36264 001201'01 254 00 0 00 004611' jrst srvfil 36265 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 19 K20SRV MAC 26-Nov-23 15:09 DIRECTORY command 36266 subttl DIRECTORY command 36267 36268 ; Default wildcard filespec fields for .CMFIL: 36269 36270 chgsec(code,const) ;;Tables and fdb's go in const 36271 000144'02 100120 777775 dirbk: gj%old!gj%ifg!gj%flg!.gjall ; Flag bits,,generation number. 36272 000145'02 000100 000101 .priin,,.priou ; COMND i/o. 36273 repeat 2,<0> ; Normal defaults for dev: and gen. 36274 000146'02 000000 000000 36275 000147'02 000000 000000 36276 repeat 2,)> ; *.* for name and type. 36277 000150'02 000000000000# 36278 000303'04 052 000 000 000 000 36279 000151'02 000000000000# 36280 000304'04 052 000 000 000 000 36281 36282 000152'02 000000000000# 0 ; Default protection, 36283 000153'02 000000 000000 0 ; and account. 36284 000010 dirbkl==<.-dirbk> ; Length of this GTJFN argument block. 36285 36286 000154'02 006000 000156' ydifdb: flddb. .cmfil,,,,,ydifd1 36287 000155'02 000000 000000 36288 000156'02 016001 000000 ydifd1: flddb. .cmdev,cm%sdh ;[193] 36289 000157'02 000000 000000 36290 retsec 36291 cleans() 36292 36293 001202'01 .ydire: entry .ydire ; Invoked from k20par 36294 001202'01 265 16 0 00 005662' saveac 36295 001203'01 200 01 0 00 005674' move t1, [dirbk,,cjfnbk] ; Insert our file parsing defaults. 36296 001204'01 251 01 0 00 000000# blt t1, cjfnbk+dirbkl 36297 001205'01 200 01 0 00 005654' movx t1, cz%ncl!.fhslf ; Close any nonopen JFNs. 36298 001206'01 104 00 0 00 000034 CLZFF 36299 001207'01 320 12 0 00 001210' erjmpr .+1 36300 36301 001210'01 200 16 0 00 000000# guide ; Issue guide words. 36302 001211'01 260 17 0 00 001150* 36303 000160'02 000000000000# 36304 000305'04 157 146 040 146 151 36305 001212'01 201 01 0 00 000000# movei t1, ydifdb ;[193] 36306 001213'01 260 17 0 00 000732* call rfield ;[193] Parse for a file, really 36307 001214'01 200 05 0 00 000002 move q1, t2 ;[193] Store whatever we got 36308 001215'01 135 07 0 00 005524' ldb q3, [pointr (.cmfnp(t3),cm%fnc)] ;[193] Get function code. 36309 36310 001216'01 302 07 0 00 000016 caie q3, .cmdev ;[193] Picked up a device? 36311 001217'01 254 00 0 00 001250' ifskp. ;[193] Yes, let's see if we can work with it 36312 001220'01 265 16 0 00 001110* anstkv(t4,^d4) ;[193] 20 characters of device name 36313 001221'01 000000 000004 36314 001222'01 415 04 0 17 777773 36315 001223'01 402 00 0 04 000000 setzm (t4) ;[193] Let's scrub a bit of it 36316 001224'01 560 01 0 00 000004 hrro t1, t4 ;[193] Create a Tops-20 ASCII pointer 36317 001225'01 104 00 0 00 000121 DEVST% ;[193] Turn it into a string (I hope) 36318 001226'01 320 12 0 00 001230' ifje. r ;[193] Failed?? 36319 001227'01 254 00 0 00 001233' 36320 001230'01 200 03 0 00 000001 move t3, t1 ;[193] Save error code for debuggers k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 19-1 K20SRV MAC 26-Nov-23 15:09 DIRECTORY command 36321 001231'01 474 06 0 00 000000 seto q2, ;[193] Cons up an impossible JFN 36322 001232'01 254 00 0 00 001247' else. ;[193] Otherwise, have a string we can maybe use 36323 001233'01 120 02 0 00 005656' dmove t2, [ exp ":", 0] ;[193] Load final characters 36324 001234'01 136 02 0 00 000001 idpb t2, t1 ;[193] Punctuate the device 36325 001235'01 136 03 0 00 000001 idpb t3, t1 ;[193] Tie off the device string 36326 001236'01 205 01 0 00 000021 movx t1, ;[193] Short form, want flags 36327 001237'01 560 02 0 00 000004 hrro t2, t4 ;[193] Recreate a Tops-20 ASCII pointer 36328 001240'01 104 00 0 00 000020 GTJFN% ;[193] Try to get a handle 36329 001241'01 320 12 0 00 001243' ifje. r ;[193] Sigh... 36330 001242'01 254 00 0 00 001246' 36331 001243'01 200 03 0 00 000001 move t3, t1 ;[193] Save error code for debuggers 36332 001244'01 474 06 0 00 000000 seto q2, ;[193] Cons up an impossible JFN 36333 001245'01 254 00 0 00 001247' else. ;[193] Otherwise, worked 36334 001246'01 200 06 0 00 000001 move q2, t1 ;[193] Put JFN in a COMND% kind of place 36335 001247'01 endif. ;[193] 36336 001247'01 endif. ;[193] End case of DEVST% handling 36337 001247'01 254 00 0 00 001251' else. ;[193] Otherwise, got a JFN 36338 001250'01 200 06 0 00 000005 move q2, q1 ;[193] Put JFN in a COMND% kind of place 36339 001251'01 endif. ;[193] End case .cmdev transmogrification 36340 36341 001251'01 337 01 0 00 000006 skipg t1, q2 ;[193] Load the JFN, unless we couldn't get one 36342 001252'01 200 01 0 00 000005 move t1, q1 ;[193] Otherwise, load the device 36343 001253'01 200 04 0 00 000001 move t4, t1 ;[193] Save a handy copy 36344 001254'01 260 17 0 00 001066* call isnulj ;[193] Is this NUL:? 36345 001255'01 254 00 0 00 001260' ifskp. ;[193] Yes, so let's fix up the parse 36346 001256'01 200 06 0 00 000001 move q2, t1 ;[193] Store the .nulio in there 36347 001257'01 254 00 0 00 001322' else. ;[193] Otherwise, isn't NUL: 36348 001260'01 200 01 0 00 000004 move t1, t4 ;[193] Load whatever we parsed 36349 001261'01 302 07 0 00 000016 caie q3, .cmdev ;[193] Did we parse a device? 36350 001262'01 254 00 0 00 001265' ifskp. ;[193] We did 36351 001263'01 200 01 0 00 000005 move t1, q1 ;[193] so use that 36352 001264'01 254 00 0 00 001266' else. ;[193] Otherwise, got a JFN 36353 001265'01 621 01 0 00 777777 tlz t1, -1 ;[193] So use that 36354 001266'01 endif. 36355 001266'01 104 00 0 00 000117 DVCHR% ;[198] Let's find out about the device 36356 001267'01 320 12 0 00 001271' %jserr (,r) ;[193] 36357 001270'01 254 00 0 00 001274' 36358 001271'01 265 01 0 00 000571* 36359 001272'01 000000000000# 36360 001273'01 254 00 0 00 000666* 36361 000307'04 117 160 145 156 040 36362 001274'01 135 03 0 00 005525' ldb t3,[pointr t2, dv%typ] ;[193] Pick up the device type 36363 001275'01 306 03 0 00 000000 cain t3, .dvdsk ;[193] Isn't a disk? 36364 001276'01 254 00 0 00 001322' anskp. ;[193] It is, so we're fine 36365 001277'01 200 02 0 00 000001 move t2, t1 ;[193] Load device designator for DEVST% 36366 001300'01 561 01 0 00 000003 hrroi t1, t3 ;[193] String is going in the registers 36367 001301'01 403 03 0 00 000004 setzb t3, t4 ;[193] Get 9 characters of device (only need 6) 36368 001302'01 104 00 0 00 000121 DEVST% ;[193] Get a string representation 36369 001303'01 320 12 0 00 001305' ifje. r ;[193] Pick up and ignore error 36370 001304'01 254 00 0 00 001307' 36371 001305'01 200 02 0 00 000001 move t2, t1 ;[193] Save error code for debuggers 36372 001306'01 120 03 0 00 005675' dmove t3, [asciz /Unknown/] ;[193] Phoney up something 36373 001307'01 endif. ;[193] 36374 001307'01 337 01 0 00 000006 skipg t1, q2 ;[193] Load the JFN 36375 001310'01 254 00 0 00 001314' ifskp. ;[193] If it was a JFN... k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 19-2 K20SRV MAC 26-Nov-23 15:09 DIRECTORY command 36376 001311'01 621 01 0 00 777777 tlz t1, -1 ;[193] Stomp any flags 36377 001312'01 104 00 0 00 000023 RLJFN% ;[193] Toss it 36378 001313'01 320 12 0 00 001314' erjmpr .+1 ;[193] Catch and ignore error 36379 001314'01 endif. ;[193] 36380 001314'01 561 01 0 00 000003 hrroi t1, t3 ;[193] String is coming from registers 36381 001315'01 104 00 0 00 000313 ESOUT% ;[193] Begin complaining 36382 txmsg <: is not a directory structured device 36383 001316'01 200 01 0 00 000000# > ;[193] Complete the blat 36384 001317'01 104 00 0 00 000076 36385 001320'01 320 12 0 00 001321' 36386 000161'02 000000000000# 36387 000322'04 072 040 151 163 040 36388 36389 001321'01 254 00 0 00 000764* callret cmder1 ;[193] Allow a reparse 36390 001322'01 endif. ;[193] 36391 36392 001322'01 260 17 0 00 000752* confrm ;[193] Tie off the line 36393 001323'01 202 06 0 00 001137* movem q2, pars3 ; Here's the JFN just parsed. 36394 001324'01 263 17 0 00 000000 ret 36395 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 20 K20SRV MAC 26-Nov-23 15:09 LOCAL DIRECTORY command execution [111] 36396 subttl LOCAL DIRECTORY command execution [111] 36397 36398 001325'01 $ydire: entry $ydire ; Invoked from k20par 36399 001325'01 550 01 0 00 001323* hrrz t1, pars3 ; Load parsed JFN 36400 001326'01 260 17 0 00 004723' call isdird ;[193] Is this a directory device? 36401 001327'01 254 00 0 00 001333' ifskp. ;[193] If worked, proceed 36402 001330'01 402 00 0 00 001077* setzm ffunc ; Function is "directory". 36403 001331'01 254 00 0 00 001367' jrst $ydir1 ; Go do the directory 36404 001332'01 254 00 0 00 001367' else. ;[193] Otherwise, not a directory device (or failed) 36405 001333'01 265 16 0 00 001220* anstkv (t4,^d4) ;[193] Allocate an anonymous stack variable 36406 001334'01 000000 000004 36407 001335'01 415 04 0 17 777773 36408 001336'01 200 02 0 00 000001 move t2, t1 ;[193] Reposition the device designator 36409 001337'01 560 01 0 00 000004 hrro t1, t4 ;[193] Create pointer to stack space 36410 001340'01 104 00 0 00 000121 DEVST% ;[193] Convert to a string 36411 001341'01 320 12 0 00 001343' ifje. r ;[193] Failed?? 36412 001342'01 254 00 0 00 001346' 36413 001343'01 200 03 0 00 000001 move t3, t1 ;[193] Save error for debugger 36414 001344'01 561 04 0 00 001144' hrroi t4, badevc ;[193] Load a default 36415 001345'01 254 00 0 00 001352' else. ;[193] Otherwise, we have a good device 36416 001346'01 120 02 0 00 005656' dmove t2, [exp ":", .chnul] ;[193] 36417 001347'01 136 02 0 00 000001 idpb t2, t1 ;[193] Punctuate device 36418 001350'01 136 03 0 00 000001 idpb t3, t1 ;[193] Tie off the string 36419 001351'01 661 04 0 00 777777 tlo t4, -1 ;[193] So turn it into a pointer 36420 001352'01 endif. ;[193] 36421 001352'01 200 01 0 00 000004 move t1, t4 ;[193] Device name 36422 001353'01 104 00 0 00 000313 ESOUT% ;[193] Begin complaining 36423 001354'01 200 01 0 00 000000# txmsg < does not have a directory to list files> ;[193] 36424 001355'01 104 00 0 00 000076 36425 001356'01 320 12 0 00 001357' 36426 000162'02 000000000000# 36427 000333'04 040 144 157 145 163 36428 001357'01 561 01 0 00 001134* hrroi t1, crlf ;[193] Newline 36429 001360'01 104 00 0 00 000076 PSOUT% ;[193] 36430 001361'01 400 01 0 00 000000 setz t1, ;[193] Cons up a zero 36431 001362'01 250 01 0 00 001325* exch t1, pars3 ;[193] Get and clear parsed JFN 36432 001363'01 621 01 0 00 777777 tlz t1, -1 ;[193] Clear any goofy flags 36433 001364'01 104 00 0 00 000023 RLJFN% ;[193] Punt it 36434 001365'01 320 12 0 00 001366' erjmpr .+1 ;[193] Catch and ignore error 36435 001366'01 263 17 0 00 000000 ret ;[193] And get out of here 36436 001367'01 endif. ;[193] End case device check 36437 36438 001367'01 200 02 0 00 001362* $ydir1: move t2, pars3 ; Here's the JFN. 36439 001370'01 402 00 0 00 000000* setzm filjfn ; Make sure no one thinks this is in use. 36440 001371'01 260 17 0 00 001420' call dirhdr ; Do the header first. 36441 36442 ; File-listing loop 36443 36444 001372'01 do. ;[194] Enter loop lexical context 36445 001372'01 260 17 0 00 005373' call dmpbuf ; Get some directory listing. 36446 001373'01 260 17 0 00 001452' call dirlst ; Print it. 36447 001374'01 326 01 0 00 001372' jumpn t1, top. ;[194] Go back for more. 36448 001375'01 enddo. ;[194] Exit loop lexical context 36449 36450 001375'01 263 17 0 00 000000 ret ; Till done. k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 20-1 K20SRV MAC 26-Nov-23 15:09 LOCAL DIRECTORY command execution [111] 36451 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 21 K20SRV MAC 26-Nov-23 15:09 Directory Header Set Up 36452 subttl Directory Header Set Up 36453 36454 ; Call: 36455 ; 36456 ; t2/ JFN of files to list. 36457 ; 36458 ; Returns: 36459 ; 36460 ; +1, always. 36461 ; 36462 ; Puts the directory listing header into the server buffer. 36463 ; Initializes buffer pointers, counters, etc. 36464 36465 001376'01 hdrtxt: asciz / 36466 001376'01 015 012 116 141 155 Name Pages Bytes(Size) Creation Date 36467 / ;[193] Directory listing header 36468 001413'01 44 07 0 00 001376' hdrptr: point 7, hdrtxt ;[193] Pointer to heading text 36469 001414'01 777777 777702 -^d62 ;[193] Length of text 36470 36471 36472 001415'01 472531 435000 nuldev: byte (7) "N","U","L",":",.chnul ;[193] 36473 001416'01 44 07 0 00 001415' nul4:: point 7, nuldev ; Pointer to fixed "NUL:" string 36474 001417'01 777777 777774 -^d4 ; Length 36475 36476 001420'01 202 02 0 00 000000* dirhdr: movem t2, ndxjfn ; Save wildcard bits. 36477 001421'01 552 02 0 00 000000* hrrzm t2, nxtjfn ; Initialize lookahead 36478 001422'01 402 00 0 00 000000# setzm filcnt ; File counter 36479 001423'01 476 00 0 00 000000# setom dirfin ; Initialize directory finished flag to assume error 36480 ; Put the listing in the server buffer. 36481 001424'01 332 00 0 00 001330* ifme. ffunc ; Directory listing? 36482 001425'01 254 00 0 00 001446' 36483 001426'01 550 03 0 00 000002 hrrz t3,t2 ;[193] Pick up just the JFN, no flags 36484 001427'01 302 03 0 00 377777 caie t3, .nulio ;[193] Data sink? 36485 001430'01 254 00 0 00 001437' ifskp. ;[193] Yep, that's easy enough 36486 001431'01 200 01 0 00 005677' move t1, [point 7, srvbuf, 27] ;[193] Points to ":" 36487 001432'01 621 02 0 00 777777 tlz t2, -1 ;[193] Shut off the flags (shouldn't be any) 36488 001433'01 211 03 0 00 000004 movni t3, ^d4 ;[193] What counted SOUT% would have wanted 36489 001434'01 200 04 0 00 001415' move t4, nuldev ;[193] Load device name in ASCII 36490 001435'01 202 04 0 00 000000# movem t4, srvbuf ;[193] Drop right into the buffer 36491 remark SOUT% ;[193] Bum the JSYS 36492 001436'01 254 00 0 00 001443' else. ;[193] Otherwise, put real file name in buffer 36493 001437'01 200 01 0 00 005700' move t1, [point 7, srvbuf] 36494 dmove t3,[111110,,js%paf ;[194] dev:name.typ.gen 36495 001440'01 120 03 0 00 005701' 0 ] ;[194] No goofy prefix 36496 001441'01 104 00 0 00 000030 JFNS 36497 001442'01 320 14 0 00 001443' erjmps .+1 ;[193] Catch and suppress error 36498 001443'01 endif. ;[193] End special case .nulio 36499 001443'01 120 02 0 00 001413' dmove t2, hdrptr ;[193] The standard header 36500 001444'01 260 17 0 00 000000* call %%smsg ;[216] Print heading. 36501 ;[216] erjmps +1 ;[194] Catch and suppress error 36502 001445'01 254 00 0 00 001447' else. ;[193] Otherwise, just reset the buffer pointer 36503 001446'01 200 01 0 00 005703' move t1, [point 7, srvbuf] 36504 001447'01 endif. ;[194] End case file function decision 36505 36506 001447'01 402 00 0 00 000000# setzm dirfin ; No error, so not finished. k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 21-1 K20SRV MAC 26-Nov-23 15:09 Directory Header Set Up 36507 001450'01 202 01 0 00 000000# movem t1, srvptr ; Preserve string buffer pointer. 36508 001451'01 263 17 0 00 000000 ret 36509 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 22 K20SRV MAC 26-Nov-23 15:09 Directory Listing Display Logic 36510 subttl Directory Listing Display Logic 36511 36512 ; Constructs directory listing text in a chunk of memory starting at 36513 ; SRVBUF and ending at (or slightly after) SRVBZ. Updates SRVPTR. 36514 ; 36515 ; Returns +1 always, with t1/ -1 if we got some data, t1/ 0 if done. 36516 ; 36517 ; Keeps global file counter in FILCNT. 36518 ; 36519 ; Be aware that the routine is doing double duty for ANY file function 36520 ; that might need to be executed over a set of files. 36521 36522 001452'01 400 01 0 00 000000 dirlst: setz t1, 36523 001453'01 332 00 0 00 000000# skipe dirfin ; Finished? 36524 001454'01 263 17 0 00 000000 ret ; Yes. 36525 001455'01 200 01 0 00 000000# move t1, srvptr ; No, there's more to do. 36526 001456'01 120 02 0 00 005704' dmove t2, [ exp .chcrt, .chlfd ] ;[194] Load the line break. 36527 001457'01 136 02 0 00 000001 idpb t2, t1 ;[194] And issue 36528 001460'01 136 03 0 00 000001 idpb t3, t1 ;[194] it 36529 001461'01 202 01 0 00 000000# movem t1, srvptr ; Save the buffer pointer. 36530 001462'01 260 17 0 00 004754' call gtnfil ; Get next file. 36531 001463'01 254 00 0 00 001553' jrst dirlsz ; If none, done. 36532 001464'01 350 00 0 00 000000# aos filcnt ; Got one, count it. 36533 36534 ;[133] Get detailed size info from FDB. 36535 36536 001465'01 553 02 0 00 000001 hrrzs t2, t1 ; Get rid of any flags. 36537 001466'01 200 01 0 00 005706' move t1, [byte (7) .chspc,.chspc,.chspc,.chspc,.chspc] ;[193] 36538 001467'01 202 01 0 00 000000* movem t1, filbuf ;[194] Fill the filename buffer with blanks. 36539 001470'01 200 01 0 00 005707' move t1, [filbuf,,filbuf+1] 36540 001471'01 251 01 0 00 000000# blt t1, filbfz-1 36541 36542 remark ;[193] Always put the file name in 36543 001472'01 302 02 0 00 377777 caie t2, .nulio ;[193] Data sink? 36544 001473'01 254 00 0 00 001500' ifskp. ;[193] Yes, don't do any of the file stuff 36545 001474'01 200 03 0 00 001415' move t3, nuldev ;[193] Just the device name 36546 001475'01 202 03 0 00 001467* movem t3, filbuf ;[193] Store a hardwired name 36547 001476'01 200 01 0 00 005710' move t1, [ point 7, filbuf, 27] ;[193] Where SOUT% would leave it 36548 001477'01 254 00 0 00 001505' else. ;[193] Otherwise, an honest file 36549 001500'01 200 01 0 00 005711' move t1, [point 7, filbuf] ; Now start filling in the fields. 36550 001501'01 200 03 0 00 005712' movx t3, fld(.jsaof,js%nam)!fld(.jsaof,js%typ)!fld(.jsaof,js%gen)!js%tmp!js%paf 36551 001502'01 400 04 0 00 000000 setz t4, ;[193] No goofy prefix 36552 001503'01 104 00 0 00 000030 JFNS 36553 001504'01 320 14 0 00 001553' erjmps dirlsz ;[193] Failed, get out of here 36554 001505'01 endif. ;[193] End special case NUL: 36555 001505'01 202 01 0 00 000000# movem t1, filptr ;[193] Store updated pointer 36556 36557 001506'01 332 00 0 00 001424* ifme. ffunc ; What was the file function? 36558 001507'01 254 00 0 00 001521' 36559 001510'01 260 17 0 00 005061' call filinf ;[200] Pull the file information 36560 001511'01 254 00 0 00 001553' jrst dirlsz ;[200] Or fail the loop 36561 001512'01 302 02 0 00 377777 caie t2, .nulio ;[193] Was it a directory of NUL:? 36562 001513'01 254 00 0 00 001517' ifskp. ;[193] Yes, so go make that up 36563 001514'01 260 17 0 00 001606' call nulist ;[193] Just make up our own entry 36564 001515'01 254 00 0 00 001553' jrst dirlsz ;[193] Failed, get out of here k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 22-1 K20SRV MAC 26-Nov-23 15:09 Directory Listing Display Logic 36565 001516'01 254 00 0 00 001521' else. ;[193] Otherwise, 36566 001517'01 260 17 0 00 001623' call filist ;[193] Construct text for this file 36567 001520'01 254 00 0 00 001553' jrst dirlsz ;[193] Failed, get out of here 36568 001521'01 endif. ;[193] End .nulio special casing 36569 001521'01 endif. ;[193] End case doing a directory 36570 36571 001521'01 202 01 0 00 000000# movem t1, filptr ;[193] Store updated pointer 36572 001522'01 400 03 0 00 000000 setz t3, ; Done with this line, make it asciz. 36573 001523'01 136 03 0 00 000001 idpb t3, t1 36574 36575 ; Copy the result into the server sending buffer. 36576 36577 001524'01 415 16 0 00 001540' block. ;[202] Set up a stack frame 36578 001525'01 261 17 0 00 000016 36579 001526'01 265 16 0 00 005713' saveac ;[202] movst gorges on registers 36580 001527'01 200 05 0 00 000000# move q1, srvptr ;[202] Load server buffer pointer 36581 001530'01 200 02 0 00 005711' move t2, [point 7, filbuf] ;[202] Load source pointer 36582 001531'01 403 03 0 00 000006 setzb t3, q2 ;[202] Force section local pointers 36583 001532'01 200 01 0 00 005725' move t1, [S!mxascz] ;[202] Limit source length, start significance 36584 001533'01 200 04 0 00 005730' movx t4, [mxascz] ;[202] Limit destination length 36585 001534'01 123 01 0 00 000000* extend t1, movasc ;[202] Move characters, doing useless translating 36586 001535'01 600 00 0 00 000000 nop ;[202] Will never +1 because t1 and t4 are equal 36587 001536'01 202 05 0 00 000000# movem q1, srvptr ;[202] Save updated destination pointer 36588 001537'01 263 17 0 00 000000 endbk. ;[202] End of stack frame 36589 36590 ; Still expect to have file jfn in t2 when we get here. 36591 36592 001540'01 336 01 0 00 001506* skipn t1, ffunc ;[199] What is the function? 36593 001541'01 254 00 0 00 001544' ifskp. ;[200] Not doing a directory 36594 remark t2, ;[200] Already has the right JFN 36595 001542'01 500 02 0 00 001420* hll t2, ndxjfn ;[200] Put in the global stepping flags 36596 001543'01 260 17 0 01 000000 call (t1) ;[200] and go do selected function. 36597 001544'01 endif. ;[200] 36598 36599 001544'01 200 01 0 00 000000# move t1, srvptr 36600 001545'01 550 02 0 00 000001 hrrz t2, t1 ; See if buffer full. 36601 001546'01 305 02 0 00 000000# caige t2, srvbz ;[194] Full? 36602 001547'01 254 00 0 00 001552' ifskp. ;[194] It is 36603 001550'01 474 01 0 00 000000 seto t1, ; Return indicating we have data. 36604 001551'01 263 17 0 00 000000 ret 36605 001552'01 endif. ;[194] 36606 001552'01 254 00 0 00 001452' jrst dirlst ; Loop for another file 36607 36608 ; Done, print summary. 36609 36610 001553'01 200 01 0 00 000000# dirlsz: move t1, srvptr ; Get the buffer pointer. 36611 001554'01 201 02 0 00 000040 movei t2, .chspc ;[194] Summary. First a space. 36612 001555'01 104 00 0 00 000051 BOUT 36613 001556'01 200 02 0 00 000000# move t2, filcnt ; Then the number of files. 36614 001557'01 201 03 0 00 000012 movei t3, ^d10 36615 001560'01 104 00 0 00 000224 NOUT 36616 001561'01 320 16 0 00 001562' erjmp .+1 36617 001562'01 376 00 0 00 000000# sosn filcnt ; Do singular or plural right. 36618 001563'01 254 00 0 00 001567' ifskp. ; Was more than one 36619 smsg < files k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 22-2 K20SRV MAC 26-Nov-23 15:09 Directory Listing Display Logic 36620 001564'01 120 02 0 00 000000# > 36621 001565'01 260 17 0 00 001444* 36622 000163'02 000000000000# 36623 000164'02 777777 777770 36624 000344'04 040 146 151 154 145 36625 36626 001566'01 254 00 0 00 001571' else. ; Otherwise, unary case 36627 smsg < file 36628 001567'01 120 02 0 00 000000# > 36629 001570'01 260 17 0 00 001565* 36630 000165'02 000000000000# 36631 000166'02 777777 777771 36632 000346'04 040 146 151 154 145 36633 36634 001571'01 endif. 36635 36636 001571'01 202 01 0 00 000000# movem t1, srvptr ; Save pointer. 36637 001572'01 477 01 0 00 000000# setob t1, dirfin ; Say we're returning data. 36638 remark dirfin ; Set finished flag for next time through. 36639 001573'01 263 17 0 00 000000 ret 36640 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 23 K20SRV MAC 26-Nov-23 15:09 NUL: device directory listing 36641 subttl NUL: device directory listing 36642 36643 ;[193] Begin Code Insertion 36644 36645 ; Expects t1 to point to a buffer area to write text 36646 36647 001574'01 011 011 040 040 040 nuldir: asciz / 0 0(7) Now/ 36648 001602'01 000000 000031 nulfil: ^d25 ; Length of phoney directory entry 36649 001603'01 44 07 0 00 001574' point 7, nuldir ; Pointer to our phoney directory entry 36650 36651 001604'01 movchr: intern movchr ; Extended opcode is also used elsewhere 36652 001604'01 016 00 0 00 000000 movslj 0, 0 ; No accumulator; E1 unused 36653 001605'01 000000 000040 .chspc ; Fill with spaces 36654 36655 001606'01 261 17 0 00 000005 nulist: push p, q1 ; Extend gorges on registers 36656 001607'01 261 17 0 00 000006 push p, q2 36657 36658 001610'01 200 05 0 00 000001 move q1, t1 ; Reposition destination 36659 001611'01 120 01 0 00 001602' dmove t1, nulfil ; Load source length and pointer 36660 001612'01 200 04 0 00 000001 move t4, t1 ; Source and destination are the same length 36661 001613'01 400 03 0 00 000006 setz t3, q2 ; Force section local pointers 36662 001614'01 123 01 0 00 001604' extend t1, movchr ; Copy the listing over 36663 001615'01 600 00 0 00 000000 nop ; Will never +1 since t1 == t4 36664 001616'01 200 01 0 00 000005 move t1, q1 ; Return final destination pointer 36665 remark t4, ; t4 is still zero 36666 001617'01 136 04 0 00 000005 idpb t4, q1 ; Tie of the string, allowing append 36667 36668 001620'01 262 17 0 00 000006 pop p, q2 ; Restore registers 36669 001621'01 262 17 0 00 000005 pop p, q1 36670 001622'01 254 00 0 00 000667* retskp ; Return success, pointing to .chnul 36671 36672 ;[193] End Code Insertion 36673 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 24 K20SRV MAC 26-Nov-23 15:09 Real directory listing, including file size and creation date. 36674 subttl Real directory listing, including file size and creation date. 36675 36676 ; Call: 36677 ; 36678 ; t1/ Pointer to buffer area 36679 ; 36680 ; Assumes the following are valid: 36681 ; 36682 ; pagcnt/ Number of pages (or blocks) in the file 36683 ; bytcnt/ Count of bytes in the file and byte size 36684 ; crdate/ Creation date and time 36685 ; 36686 ; In other words that filinf has been called. Note that it is a 36687 ; mistake to use this when doing .nulio, even though filinf will 36688 ; put reasonable (yet false) data in. The resulting string will 36689 ; always be the same, so this is special cased. 36690 36691 ;[122] The rest of this routine rewritten to provide nice columnar listing. 36692 36693 001623'01 200 01 0 00 000000# filist: move t1, filptr ;[193] Load current buffer pointer 36694 001624'01 201 03 0 00 000040 movei t3, .chspc ; Put a blank over the null left by JFNS. 36695 001625'01 136 03 0 00 000001 idpb t3, t1 36696 36697 001626'01 550 02 0 00 000001 hrrz t2, t1 ; Get address from updated pointer. 36698 001627'01 301 02 0 00 000000# cail t2, filbuf+4 ; Name stayed within its field? 36699 001630'01 254 00 0 00 001634' ifskp. ;[194] It did 36700 001631'01 200 01 0 00 005731' move t1, [point 7, filbuf+4] ; Yes, advance to next field. 36701 001632'01 200 03 0 00 005732' movx t3, 36702 001633'01 254 00 0 00 001637' else. ;[194] Otherwise, blew through it 36703 001634'01 201 02 0 00 000040 movei t2, .chspc ; No, do free format. 36704 001635'01 136 02 0 00 000001 idpb t2, t1 ; Deposit a blank, advance pointer. 36705 001636'01 201 03 0 00 000012 movei t3, ^d10 ; No fixed-field stuff on page count. 36706 001637'01 endif. ;[194] 36707 36708 ;[133] More detailed info about size: pages, byte count, byte size. 36709 36710 001637'01 550 02 0 00 000000* hrrz t2, pagcnt ; Number of pages in file. 36711 001640'01 104 00 0 00 000224 NOUT 36712 001641'01 320 14 0 00 001273* erjmps r ; Catch and suppress error, returning +1 36713 001642'01 201 03 0 00 000040 movei t3, .chspc ; A blank 36714 001643'01 136 03 0 00 000001 idpb t3, t1 36715 001644'01 200 02 0 00 000000* move t2, bytcnt ; Byte count, free format. 36716 001645'01 201 03 0 00 000012 movei t3, ^d10 36717 001646'01 104 00 0 00 000224 NOUT 36718 001647'01 320 14 0 00 001641* erjmps r ; Catch and suppress error, returning +1 36719 36720 001650'01 135 02 0 00 005733' ldb t2, [pointr (pagcnt,fb%bsz)] ;[200] Load the byte size 36721 001651'01 322 02 0 00 001662' ifn. t2 ;[200] Device may not do byte sizes 36722 001652'01 201 03 0 00 000050 movei t3, "(" ; Byte size, in parens. 36723 001653'01 136 03 0 00 000001 idpb t3, t1 36724 001654'01 201 03 0 00 000012 movei t3, ^d10 36725 001655'01 104 00 0 00 000224 NOUT 36726 001656'01 320 14 0 00 001647* erjmps r ; Catch and suppress error, returning +1 36727 001657'01 201 03 0 00 000051 movei t3, ")" 36728 001660'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 20:02 27-Nov-23 Page 24-1 K20SRV MAC 26-Nov-23 15:09 Real directory listing, including file size and creation date. 36729 001661'01 254 00 0 00 001665' else. ;[200] Fix string contiguity 36730 001662'01 200 02 0 00 000001 move t2, t1 ;[200] Get a copy of the pointer 36731 001663'01 201 03 0 00 000040 movei t3, .chspc ;[200] Load a space 36732 001664'01 136 03 0 00 000002 idpb t3, t2 ;[200] Overwrite the .chnul 36733 001665'01 endif. ;[200] 36734 36735 001665'01 301 03 0 00 000000# cail t3, filbuf+11 ;[194] Out of the field? 36736 001666'01 254 00 0 00 001671' ifskp. ;[194] No, that's great! 36737 001667'01 200 01 0 00 005734' move t1, [point 7, filbuf+11] 36738 001670'01 254 00 0 00 001673' else. ;[194] Otherwise, overflowed field 36739 001671'01 201 02 0 00 000040 movei t2, .chspc ; Put in a blank to separate. 36740 001672'01 136 02 0 00 000001 idpb t2, t1 36741 001673'01 endif. 36742 36743 001673'01 336 02 0 00 000000* skipn t2, crdate ;[200] Pick up creation date, if there is one 36744 001674'01 254 00 0 00 001700' ifskp. ;[200] There was, let's type it 36745 001675'01 205 03 0 00 010000 movx t3, ot%4yr ;[200] We're waaaaay past the millenium 36746 001676'01 104 00 0 00 000220 ODTIM% ;[200] Finally display something 36747 001677'01 320 14 0 00 001656* erjmps r ;[200] Catch and suppress error, returning +1 36748 001700'01 endif. ;[200] 36749 001700'01 254 00 0 00 001622* retskp ;[193] Won 36750 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 25 K20SRV MAC 26-Nov-23 15:09 REMOTE DIRECTORY execution 36751 subttl REMOTE DIRECTORY execution 36752 36753 001701'01 336 00 0 00 001166* $xdire: ifmn. tlgjfn ;[233] Doing transaction logging? 36754 001702'01 254 00 0 00 001724' 36755 001703'01 415 16 0 00 001724' block. ;[233] Get a stack frame 36756 001704'01 261 17 0 00 000016 36757 001705'01 265 16 0 00 005543' saveac ;[233] Save even the temporaries 36758 001706'01 476 00 0 00 001161* setom scrlft ;[233] Don't append the crlf! 36759 001707'01 265 01 0 00 001162* wtlog(,) ;[233] 36760 001710'01 000000000000# 36761 001711'01 777777 777734 36762 001712'01 000000 000000 36763 000350'04 122 145 161 165 145 36764 001713'01 200 01 0 00 001701* move t1, tlgjfn ;[233] Put the directory name in the log 36765 001714'01 561 02 0 00 001167* hrroi t2,atmbuf ;[233] It's in the atom buffer 36766 001715'01 403 03 0 00 000004 setzb t3,t4 ;[233] Don't know how long, stop on a NUL 36767 001716'01 104 00 0 00 000053 SOUT% ;[233] Out it goes! 36768 001717'01 320 14 0 00 001720' erjmps .+1 ;[233] Catch and suppress error 36769 dmove t2,[ -1,,crlf ;[233] Tops-20 pointer to carriage return line feed 36770 001720'01 120 02 0 00 005660' -2 ] ;[233] Counted SOUT%'s are faster 36771 001721'01 104 00 0 00 000053 SOUT% ;[233] Out it goes! 36772 001722'01 320 14 0 00 001723' erjmps .+1 ;[233] Catch and suppress error 36773 001723'01 263 17 0 00 000000 endbk. ;[233] Release stack frame, restoring AC's 36774 001724'01 endif. ;[233] 36775 36776 001724'01 260 17 0 00 001177* call statim ;[189] Start timing so k20pdc doesn't choke 36777 001725'01 201 04 0 00 000104 movei t4, "D" ; Generic command is D. 36778 001726'01 254 00 0 00 004611' jrst srvfil 36779 36780 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 26 K20SRV MAC 26-Nov-23 15:09 REMOTE ERROR parsing 36781 subttl REMOTE ERROR parsing 36782 36783 ; This is a SECRET command to send an (optionally) null error packet. Shh!! 36784 36785 chgsec(code,const) ;;Chained fdb's go in const 36786 000167'02 010004 000172' xerfdb: flddb. .cmcfm,,,,,xerfd1 36787 000170'02 000000 000000 36788 000171'02 44 07 0 00 000437' 36789 000172'02 021004 000175' xerfd1: flddb. .cmqst,,,,,xerfd2 36790 000173'02 000000 000000 36791 000174'02 44 07 0 00 000445' 36792 000175'02 017004 000000 xerfd2: flddb. .cmtxt,,,,, 36793 000176'02 000000 000000 36794 000177'02 44 07 0 00 000445' 36795 retsec 36796 cleans() 36797 36798 001727'01 201 01 0 00 000000# .xerr: movei t1, xerfdb ;[220] Allow a quote of the remote file specification 36799 001730'01 260 17 0 00 001213* call rfield ;[220] Try to parse something 36800 001731'01 135 03 0 00 005524' ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ;[220] Get function code. 36801 36802 001732'01 306 03 0 00 000010 cain t3, .cmcfm ;[220] Confirm? 36803 001733'01 263 17 0 00 000000 ret ;[220] We're done 36804 36805 001734'01 260 17 0 00 001322* confrm ;[220] Otherwise tie off the line 36806 001735'01 200 01 0 00 005626' move t1,[point 7,atmbuf];[220] Load pointer to complaint department 36807 001736'01 202 01 0 00 001367* movem t1, pars3 ;[220] and ask to ship that off 36808 36809 001737'01 263 17 0 00 000000 ret 36810 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 27 K20SRV MAC 26-Nov-23 15:09 REMOTE ERROR semantic action 36811 subttl REMOTE ERROR semantic action 36812 36813 001740'01 265 16 0 00 005503' $xerr: saveac ;[220] Extra register for possible pointer 36814 001741'01 260 17 0 00 001724* call statim ;[189] Start timing so k20pdc doesn't choke 36815 001742'01 336 05 0 00 001736* skipn q1, pars3 ;[220] Wants to send accompanying text 36816 001743'01 254 00 0 00 001753' ifskp. ;[220] Must be really annoyed... 36817 001744'01 400 03 0 00 000000 setz t3, ;[220] Let's assume a bogus parse 36818 001745'01 200 02 0 00 000005 move t2, q1 ;[220] Load the pointer we were passed 36819 001746'01 134 03 0 00 000002 ildb t3, t2 ;[220] Try to get a character 36820 001747'01 320 12 0 00 001750' erjmpr .+1 ;[220] Catch and store error for debuggers 36821 001750'01 306 03 0 00 000000 cain t3, 0 ;[220] Anything there? 36822 001751'01 254 00 0 00 001753' anskp. ;[220] No, so still sending a null packet 36823 001752'01 254 00 0 00 001761' else. ;[220] No pointer, or bad pointer or no data 36824 001753'01 201 01 0 00 000105 movei t1, "E" ; Send an error packet. 36825 001754'01 200 02 0 00 000000* move t2, pktnum ;[220] Packet number must match 36826 001755'01 403 03 0 00 000004 setzb t3, t4 ;[220] Yet no data 36827 001756'01 260 17 0 00 000000* call spack ;[220] Send the packet... 36828 001757'01 600 00 0 00 000000 nop ;[220] ... and ignore the response 36829 001760'01 263 17 0 00 000000 ret ;[220] Done with this trivial case 36830 001761'01 endif. ;[220] End argument check 36831 36832 remark ;[220] Otherwise, stuff some text in 36833 001761'01 403 01 0 00 000002 setzb t1, t2 ;[220] Cons up some .chnul's 36834 001762'01 124 01 0 00 001006* dmovem t1, strbuf ;[220] Zero out old stuff 36835 001763'01 124 01 0 00 000000# dmovem t1, strbuf+2 ;[220] and a bit more of it 36836 001764'01 200 02 0 00 005647' move t2, [ point 7, strbuf ] ;[220] Point to string buffer 36837 001765'01 202 02 0 00 001051* movem t2, strptr ;[220] Save current location 36838 36839 001766'01 200 01 0 00 000005 move t1, q1 ;[220] Load pointer to error text 36840 001767'01 400 03 0 00 000000 setz t3, ;[220] Zero the count 36841 36842 001770'01 do. ; Enter loop context to copy the complaint 36843 001770'01 134 04 0 00 000001 ildb t4, t1 ; Pick up a byte of the wahhh 36844 001771'01 322 04 0 00 001774' jumpe t4, endlp. ; Stop at the end of the string 36845 001772'01 136 04 0 00 000002 idpb t4, t2 ; Deposit it in string buffer 36846 001773'01 344 03 0 00 001770' aoja t3, top. ; Get some more bytes, weee!! 36847 001774'01 enddo. ; End of loop context 36848 36849 001774'01 400 04 0 00 000000 setz t4, ;[220] Cons up a NUL 36850 001775'01 136 04 0 00 000002 idpb t4, t2 ;[220] Tie off string but don't count it 36851 36852 001776'01 201 01 0 00 000105 movei t1, "E" ;[220] Sending an error packet with extra flavoring 36853 001777'01 200 02 0 00 001754* move t2, pktnum ;[220] Packet number must match 36854 remark t3, data count ;[220] Unchanged from do. loop 36855 002000'01 200 04 0 00 001765* move t4, strptr ;[220] Load beginning of data area 36856 002001'01 260 17 0 00 001756* call spack ;[220] Send the packet... 36857 002002'01 600 00 0 00 000000 nop ;[220] ... and ignore the response 36858 002003'01 263 17 0 00 000000 ret ;[220] Done with the semantic action for ERROR 36859 36860 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 28 K20SRV MAC 26-Nov-23 15:09 FINISH command 36861 subttl FINISH command 36862 36863 ;[28] The FINISH command is edit 28. 36864 36865 ; Invoked by K20PAR 36866 36867 002004'01 .finis: entry .finis ;[220] 36868 002004'01 200 16 0 00 000000# guide (remote server operation) ; Parse rest of FINISH command. 36869 002005'01 260 17 0 00 001211* 36870 000200'02 000000000000# 36871 000360'04 162 145 155 157 164 36872 002006'01 260 17 0 00 001734* confrm 36873 002007'01 263 17 0 00 000000 ret 36874 36875 remark Execute FINISH command. 36876 36877 002010'01 $finis: entry $finis ;[220] 36878 002010'01 260 17 0 00 001741* call statim ;[189] Start timing so k20pdc doesn't choke 36879 002011'01 200 01 0 00 005736' move t1, [point 7, [asciz/F/]] ; An "F" for the data field. 36880 002012'01 201 02 0 00 000107 movei t2, "G" ; Packet type is G. 36881 002013'01 260 17 0 00 004363' call srvcmd ; Go send the command. 36882 002014'01 600 00 0 00 000000 nop ; Ignore any failure. 36883 002015'01 263 17 0 00 000000 ret ; Done. 36884 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 29 K20SRV MAC 26-Nov-23 15:09 REMOTE HELP 36885 subttl REMOTE HELP 36886 36887 remark REMOTE HELP parsing 36888 36889 002016'01 .xhelp: entry .xhelp ;[220] 36890 002016'01 200 16 0 00 000000# guide 36891 002017'01 260 17 0 00 002005* 36892 000201'02 000000000000# 36893 000365'04 146 162 157 155 040 36894 002020'01 260 17 0 00 002006* confrm 36895 002021'01 263 17 0 00 000000 ret 36896 36897 remark REMOTE HELP execution 36898 36899 002022'01 $xhelp: entry $xhelp ;[220] 36900 002022'01 336 00 0 00 001713* ifmn. tlgjfn ;[233] Doing transaction logging? 36901 002023'01 254 00 0 00 002034' 36902 002024'01 415 16 0 00 002034' block. ;[233] Get a stack frame 36903 002025'01 261 17 0 00 000016 36904 002026'01 265 16 0 00 005543' saveac ;[233] Save even the temporaries 36905 002027'01 265 01 0 00 001707* wtlog(,) ;[233] 36906 002030'01 000000000000# 36907 002031'01 777777 777741 36908 002032'01 000000 000000 36909 000371'04 122 145 161 165 145 36910 002033'01 263 17 0 00 000000 endbk. ;[233] Release stack frame, restoring AC's 36911 002034'01 endif. ;[233] 36912 36913 002034'01 260 17 0 00 002010* call statim ;[189] Start timing so k20pdc doesn't choke 36914 002035'01 260 17 0 00 004560' call sinfo ; Exchange parameters. 36915 002036'01 263 17 0 00 000000 ret ;[133] Failed, give up. 36916 dmove t1, [point 7, [asciz/H/] ; H command for data field. 36917 002037'01 120 01 0 00 005740' "G" ] ; Packet type is G. 36918 002040'01 254 00 0 00 004635' jrst dosrv 36919 36920 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 30 K20SRV MAC 26-Nov-23 15:09 REMOTE HOST parsing 36921 subttl REMOTE HOST parsing 36922 36923 chgsec(code,const) ;;Chained fdb's go in const 36924 000202'02 021004 000205' xhofdb: flddb. .cmqst,,,,,xhofd1 36925 000203'02 000000 000000 36926 000204'02 44 07 0 00 000452' 36927 000205'02 017004 000000 xhofd1: flddb. .cmtxt,,,,, 36928 000206'02 000000 000000 36929 000207'02 44 07 0 00 000452' 36930 retsec 36931 cleans() 36932 36933 002041'01 200 16 0 00 000000# .xhost: guide 36934 002042'01 260 17 0 00 002017* 36935 000210'02 000000000000# 36936 000400'04 143 157 155 155 141 36937 002043'01 201 01 0 00 000000# movei t1, xhofdb ;[220] Allow a quote of the remote command 36938 002044'01 260 17 0 00 001152* call cfield 36939 002045'01 263 17 0 00 000000 ret 36940 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 31 K20SRV MAC 26-Nov-23 15:09 REMOTE HOST command [105] 36941 subttl REMOTE HOST command [105] 36942 36943 002046'01 $xhost: entry $xhost ;[220] 36944 002046'01 336 00 0 00 000321* ifmn. takdep ;[176] Allow commands to servers from TAKE file 36945 002047'01 254 00 0 00 002057' 36946 002050'01 336 00 0 00 000000* ifmn. local ; This only works if local Kermit. 36947 002051'01 254 00 0 00 002057' 36948 002052'01 334 01 0 00 000000# ermsg% (,r) 36949 002053'01 254 00 0 00 002057' 36950 002054'01 202 01 0 00 000517* 36951 002055'01 104 00 0 00 000313 36952 002056'01 254 00 0 00 001677* 36953 000211'02 000000000000# 36954 000402'04 113 105 122 115 111 36955 36956 002057'01 endif. ;[194] End case not remote 36957 002057'01 endif. ;[194] End case allowing from take file 36958 36959 002057'01 260 17 0 00 002034* call statim ;[189] Start timing so k20pdc doesn't choke 36960 dmove t1, [point 7, atmbuf ; And move them from here 36961 002060'01 120 01 0 00 005742' point 7, strbuf] ; to here. 36962 36963 002061'01 do. ;[194] Enter loop context 36964 002061'01 134 04 0 00 000001 ildb t4, t1 ; Copy the string. 36965 002062'01 322 04 0 00 002065' jumpe t4, endlp. ;[194] 36966 002063'01 136 04 0 00 000002 idpb t4, t2 36967 002064'01 254 00 0 00 002061' loop. ;[194] 36968 002065'01 enddo. ;[194] 36969 36970 002065'01 200 03 0 00 000000* move t3, seolch ; Terminate it with the host's eol character. 36971 002066'01 136 03 0 00 000002 idpb t3, t2 36972 002067'01 136 04 0 00 000002 idpb t4, t2 ; And a null. 36973 36974 002070'01 260 17 0 00 000000* call ccon ;[169] Enable ^C during this bit. 36975 002071'01 254 00 0 00 000000* jrst ccoff ;[169] Where to go if ^C happens. 36976 002072'01 260 17 0 00 004560' call sinfo ; Exchange params. 36977 002073'01 254 00 0 00 002071* jrst ccoff ;[169] Failed, give up, turn off ^C trap. 36978 002074'01 260 17 0 00 002073* call ccoff ;[169] 36979 002075'01 200 01 0 00 005647' move t1, [point 7, strbuf] ; Point to command. 36980 002076'01 201 02 0 00 000103 movei t2, "C" ; Packet type is C. 36981 002077'01 254 00 0 00 004635' jrst dosrv ; Go send it and handle the reply. 36982 36983 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 32 K20SRV MAC 26-Nov-23 15:09 PWD command 36984 subttl PWD command 36985 36986 remark LOCAL PWD (trivial) parsing 36987 36988 002100'01 .ypwd: entry .ypwd 36989 002100'01 200 16 0 00 000000# guide 36990 002101'01 260 17 0 00 002042* 36991 000212'02 000000000000# 36992 000417'04 160 162 151 156 164 36993 002102'01 260 17 0 00 002020* confrm 36994 002103'01 263 17 0 00 000000 ret 36995 36996 remark LOCAL PWD semanic action 36997 36998 002104'01 $ypwd: entry $ypwd 36999 002104'01 561 01 0 00 001357* hrroi t1, crlf ; Offset from prompt 37000 002105'01 104 00 0 00 000076 PSOUT% 37001 002106'01 104 00 0 00 000013 GJINF% ; Get current job information. 37002 002107'01 201 01 0 00 000101 movei t1, .priou ; Type on terminal 37003 remark t2, ; Already has the connected directory 37004 002110'01 104 00 0 00 000041 DIRST% ; Translate into a string 37005 002111'01 320 12 0 00 002113' %jserr (,r) 37006 002112'01 254 00 0 00 002116' 37007 002113'01 265 01 0 00 001271* 37008 002114'01 000000 000000 37009 002115'01 254 00 0 00 002056* 37010 002116'01 561 01 0 00 002104* hrroi t1,crlf ; Tie off the line 37011 002117'01 104 00 0 00 000076 PSOUT% 37012 002120'01 263 17 0 00 000000 ret 37013 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 33 K20SRV MAC 26-Nov-23 15:09 REMOTE PWD 37014 subttl REMOTE PWD 37015 37016 ;[188] Begin Code Insertion 37017 37018 remark REMOTE PWD parsing 37019 37020 002121'01 .xpwd: entry .xpwd ;[220] 37021 002121'01 200 16 0 00 000000# guide 37022 002122'01 260 17 0 00 002101* 37023 000213'02 000000000000# 37024 000425'04 160 162 151 156 164 37025 002123'01 260 17 0 00 002102* confrm 37026 002124'01 263 17 0 00 000000 ret 37027 37028 remark REMOTE PWD execution 37029 37030 002125'01 $xpwd: entry $xpwd ;[220] 37031 002125'01 260 17 0 00 002057* call statim ;[189] Start timing so k20pdc doesn't choke 37032 dmove t1, [ 37033 point 7, [asciz/A/] ; 'A' command for data field. 37034 002126'01 120 01 0 00 005745' "G" ] ; Packet type is G. 37035 002127'01 254 00 0 00 004635' jrst dosrv 37036 37037 37038 ;[188] End Code Insertion 37039 37040 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 34 K20SRV MAC 26-Nov-23 15:09 LOCAL SPACE 37041 subttl LOCAL SPACE 37042 37043 remark LOCAL SPACE (trivial) parsing 37044 37045 002130'01 .ydisk: entry .ydisk 37046 002130'01 200 16 0 00 000000# guide 37047 002131'01 260 17 0 00 002122* 37048 000214'02 000000000000# 37049 000433'04 165 163 141 147 145 37050 002132'01 260 17 0 00 002123* confrm 37051 002133'01 263 17 0 00 000000 ret 37052 37053 remark LOCAL SPACE semanic action 37054 37055 002134'01 $ydisk: entry $ydisk 37056 002134'01 474 01 0 00 000000 seto t1, ; local disk usage query. 37057 002135'01 104 00 0 00 000305 GTDAL% 37058 002136'01 320 12 0 00 002140' %jserr (,r) 37059 002137'01 254 00 0 00 002143' 37060 002140'01 265 01 0 00 002113* 37061 002141'01 000000 000000 37062 002142'01 254 00 0 00 002115* 37063 002143'01 120 05 0 00 000001 dmove q1, t1 37064 txmsg < 37065 002144'01 200 01 0 00 000000# Quota: > ;[194] 37066 002145'01 104 00 0 00 000076 37067 002146'01 320 12 0 00 002147' 37068 000215'02 000000000000# 37069 000436'04 015 012 040 121 165 37070 37071 002147'01 305 05 0 00 005747' caige q1, [^d100000000] ;[194] Where did this number come from? 37072 002150'01 254 00 0 00 002155' ifskp. ;[194] Really big ... 37073 002151'01 200 01 0 00 000000# txmsg <+Inf> ;[194] 37074 002152'01 104 00 0 00 000076 37075 002153'01 320 12 0 00 002154' 37076 000216'02 000000000000# 37077 000441'04 053 111 156 146 000 37078 002154'01 254 00 0 00 002162' else. ;[194] 37079 002155'01 201 01 0 00 000101 numout q1 37080 002156'01 200 02 0 00 000005 37081 002157'01 201 03 0 00 000012 37082 002160'01 104 00 0 00 000224 37083 002161'01 320 14 0 00 002162' 37084 002162'01 endif. 37085 37086 002162'01 200 01 0 00 000000# txmsg <, used: > 37087 002163'01 104 00 0 00 000076 37088 002164'01 320 12 0 00 002165' 37089 000217'02 000000000000# 37090 000442'04 054 040 165 163 145 37091 002165'01 201 01 0 00 000101 numout q2 37092 002166'01 200 02 0 00 000006 37093 002167'01 201 03 0 00 000012 37094 002170'01 104 00 0 00 000224 37095 002171'01 320 14 0 00 002172' k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 34-1 K20SRV MAC 26-Nov-23 15:09 LOCAL SPACE 37096 002172'01 200 01 0 00 000000# txmsg < (pages)> 37097 002173'01 104 00 0 00 000076 37098 002174'01 320 12 0 00 002175' 37099 000220'02 000000000000# 37100 000444'04 040 050 160 141 147 37101 002175'01 263 17 0 00 000000 ret 37102 37103 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 35 K20SRV MAC 26-Nov-23 15:09 REMOTE SPACE 37104 subttl REMOTE SPACE 37105 37106 remark REMOTE SPACE parsing 37107 37108 002176'01 .xdisk: entry .xdisk ;[220] 37109 002176'01 200 16 0 00 000000# guide 37110 002177'01 260 17 0 00 002131* 37111 000221'02 000000000000# 37112 000446'04 165 163 141 147 145 37113 002200'01 260 17 0 00 002132* confrm 37114 002201'01 263 17 0 00 000000 ret 37115 37116 remark REMOTE SPACE execution 37117 37118 002202'01 $xdisk: entry $xdisk ;[220] 37119 002202'01 260 17 0 00 002125* call statim ;[189] Start timing so k20pdc doesn't choke 37120 dmove t1, [ 37121 point 7, [asciz/U/] ; U command for data field. 37122 002203'01 120 01 0 00 005751' "G" ] ; Packet type is G. 37123 002204'01 254 00 0 00 004635' jrst dosrv 37124 37125 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 36 K20SRV MAC 26-Nov-23 15:09 LOCAL STATISTICS 37126 subttl LOCAL STATISTICS 37127 37128 ; Parse rest of STATISTICS command. 37129 37130 002205'01 .stat: entry .stat 37131 002205'01 200 16 0 00 000000# guide 37132 002206'01 260 17 0 00 002177* 37133 000222'02 000000000000# 37134 000451'04 141 142 157 165 164 37135 002207'01 260 17 0 00 002200* confrm 37136 002210'01 263 17 0 00 000000 ret 37137 37138 remark LOCAL STATUS execution 37139 37140 ;[189] All part of edit [189] 37141 37142 002211'01 $ysrvt: entry $ysrvt 37143 extern $srvt,statxt ;[194] Our necessary 37144 002211'01 260 17 0 00 000000* call $srvt ; Format the stuff 37145 002212'01 561 01 0 00 000000* hrroi t1,statxt ; Point to text it built 37146 002213'01 104 00 0 00 000076 PSOUT% ; Print it 37147 002214'01 320 12 0 00 002142* erjmpr r ; Get error, get out of here 37148 002215'01 263 17 0 00 000000 ret ; Get out of here 37149 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 37 K20SRV MAC 26-Nov-23 15:09 REMOTE STATUS 37150 subttl REMOTE STATUS 37151 37152 ;[189] Begin Code Insertion 37153 37154 remark REMOTE STATUS parsing 37155 37156 002216'01 .xstat: entry .xstat ;[220] 37157 002216'01 200 16 0 00 000000# guide 37158 002217'01 260 17 0 00 002206* 37159 000223'02 000000000000# 37160 000456'04 157 146 040 154 141 37161 002220'01 260 17 0 00 002207* confrm 37162 002221'01 263 17 0 00 000000 ret 37163 37164 remark REMOTE STATUS execution 37165 37166 002222'01 336 00 0 00 002022* $xstat: ifmn. tlgjfn ;[233] Doing transaction logging? 37167 002223'01 254 00 0 00 002234' 37168 002224'01 415 16 0 00 002234' block. ;[233] Get a stack frame 37169 002225'01 261 17 0 00 000016 37170 002226'01 265 16 0 00 005543' saveac ;[233] Save even the temporaries 37171 002227'01 265 01 0 00 002027* wtlog(,) ;[233] 37172 002230'01 000000000000# 37173 002231'01 777777 777732 37174 002232'01 000000 000000 37175 000462'04 122 145 161 165 145 37176 002233'01 263 17 0 00 000000 endbk. ;[233] Release stack frame, restoring AC's 37177 002234'01 endif. ;[233] 37178 37179 002234'01 260 17 0 00 002202* call statim ;[189] Start timing so k20pdc doesn't choke 37180 dmove t1, [ 37181 point 7, [asciz/Q/] ; 'Q' command for data field. 37182 002235'01 120 01 0 00 005754' "G" ] ; Packet type is G. 37183 002236'01 254 00 0 00 004635' jrst dosrv 37184 37185 ;[198] End Code Insertion 37186 37187 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 38 K20SRV MAC 26-Nov-23 15:09 LOCAL TYPE [143] 37188 subttl LOCAL TYPE [143] 37189 37190 chgsec(code,const) ;;Tables and fdb's go in const 37191 000224'02 100120 000000 typbk: gj%old!gj%ifg!gj%flg ; Flag bits,,most recent generation. 37192 000225'02 000100 000101 .priin,,.priou ; COMND i/o. 37193 repeat 6,<0> ; No defaults, except all generations. 37194 000226'02 000000 000000 37195 000227'02 000000 000000 37196 000230'02 000000 000000 37197 000231'02 000000 000000 37198 000232'02 000000 000000 37199 000233'02 000000 000000 37200 000010 typbkl==<.-typbk> ; Length of this GTJFN argument block. 37201 37202 000234'02 006000 000236' typfdb: flddb. .cmfil,,,,,typfd1 37203 000235'02 000000 000000 37204 000236'02 016001 000000 typfd1: flddb. .cmdev,cm%sdh ;[193] 37205 000237'02 000000 000000 37206 retsec 37207 cleans() 37208 37209 002237'01 .ytype: entry .ytype 37210 002237'01 200 01 0 00 005654' movx t1, cz%ncl!.fhslf ; Close any nonopen JFNs. 37211 002240'01 104 00 0 00 000034 CLZFF 37212 002241'01 320 12 0 00 002242' erjmpr .+1 ;[194] Catch and ignore any odd error 37213 002242'01 200 16 0 00 000000# guide ; Issue guide words. 37214 002243'01 260 17 0 00 002217* 37215 000240'02 000000000000# 37216 000472'04 146 151 154 145 163 37217 37218 002244'01 200 01 0 00 005756' move t1, [typbk,,cjfnbk] ; Insert our file parsing defaults. 37219 002245'01 251 01 0 00 000000# blt t1, cjfnbk+typbkl ; Same as for DELETE. 37220 002246'01 201 01 0 00 000000# movei t1, typfdb ;[193] 37221 002247'01 260 17 0 00 001730* call rfield ;[193] Parse something 37222 002250'01 200 05 0 00 000002 move q1, t2 ;[193] Store whatever we got 37223 002251'01 135 07 0 00 005524' ldb q3, [pointr (.cmfnp(t3),cm%fnc)] ;[193] Get function code. 37224 37225 002252'01 302 07 0 00 000016 caie q3, .cmdev ;[193] Picked up a device? 37226 002253'01 254 00 0 00 002304' ifskp. ;[193] Yes, let's see if we can work with it 37227 002254'01 265 16 0 00 001333* anstkv(t4,^d4) ;[193] 20 characters of device name 37228 002255'01 000000 000004 37229 002256'01 415 04 0 17 777773 37230 002257'01 402 00 0 04 000000 setzm (t4) ;[193] Let's scrub a bit of it 37231 002260'01 560 01 0 00 000004 hrro t1, t4 ;[193] Create a Tops-20 ASCII pointer 37232 002261'01 104 00 0 00 000121 DEVST% ;[193] Turn it into a string (I hope) 37233 002262'01 320 12 0 00 002264' ifje. r ;[193] Failed?? 37234 002263'01 254 00 0 00 002267' 37235 002264'01 200 03 0 00 000001 move t3, t1 ;[193] Save error code for debuggers 37236 002265'01 474 06 0 00 000000 seto q2, ;[193] Cons up an impossible JFN 37237 002266'01 254 00 0 00 002303' else. ;[193] Otherwise, have a string we can maybe use 37238 002267'01 120 02 0 00 005656' dmove t2, [ exp ":", 0] ;[193] Load final characters 37239 002270'01 136 02 0 00 000001 idpb t2, t1 ;[193] Punctuate the device 37240 002271'01 136 03 0 00 000001 idpb t3, t1 ;[193] Tie off the device string 37241 002272'01 205 01 0 00 000021 movx t1, ;[193] Short form, want flags 37242 002273'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 20:02 27-Nov-23 Page 38-1 K20SRV MAC 26-Nov-23 15:09 LOCAL TYPE [143] 37243 002274'01 104 00 0 00 000020 GTJFN% ;[193] Try to get a handle 37244 002275'01 320 12 0 00 002277' ifje. r ;[193] Sigh... 37245 002276'01 254 00 0 00 002302' 37246 002277'01 200 03 0 00 000001 move t3, t1 ;[193] Save error code for debuggers 37247 002300'01 474 06 0 00 000000 seto q2, ;[193] Cons up an impossible JFN 37248 002301'01 254 00 0 00 002303' else. ;[193] Otherwise, worked 37249 002302'01 200 06 0 00 000001 move q2, t1 ;[193] Put JFN in a COMND% kind of place 37250 002303'01 endif. ;[193] 37251 002303'01 endif. ;[193] End case of DEVST% handling 37252 002303'01 254 00 0 00 002305' else. ;[193] Otherwise, got a JFN 37253 002304'01 200 06 0 00 000005 move q2, q1 ;[193] Put JFN in a COMND% kind of place 37254 002305'01 endif. ;[193] End case .cmdev transmogrification 37255 37256 002305'01 337 01 0 00 000006 skipg t1, q2 ;[193] Load the JFN, unless we couldn't get one 37257 002306'01 200 01 0 00 000005 move t1, q1 ;[193] Otherwise, load the device 37258 002307'01 200 04 0 00 000001 move t4, t1 ;[193] Save a handy copy 37259 002310'01 260 17 0 00 001254* call isnulj ;[193] Is this NUL:? 37260 002311'01 254 00 0 00 002314' ifskp. ;[193] Yes, so let's fix up the parse 37261 002312'01 200 06 0 00 000001 move q2, t1 ;[193] Store the .nulio in there 37262 002313'01 254 00 0 00 002356' else. ;[193] Otherwise, isn't NUL: 37263 002314'01 200 01 0 00 000004 move t1, t4 ;[193] Load whatever we parsed 37264 002315'01 302 07 0 00 000016 caie q3, .cmdev ;[193] Did we parse a device? 37265 002316'01 254 00 0 00 002321' ifskp. ;[193] We did 37266 002317'01 200 01 0 00 000005 move t1, q1 ;[193] so use that 37267 002320'01 254 00 0 00 002322' else. ;[193] Otherwise, got a JFN 37268 002321'01 621 01 0 00 777777 tlz t1, -1 ;[193] So use that 37269 002322'01 endif. 37270 002322'01 104 00 0 00 000117 DVCHR% ;[198] Let's find out about the device 37271 002323'01 320 12 0 00 002325' %jserr (,r) ;[193] 37272 002324'01 254 00 0 00 002330' 37273 002325'01 265 01 0 00 002140* 37274 002326'01 000000000000# 37275 002327'01 254 00 0 00 002214* 37276 000474'04 124 171 160 145 040 37277 002330'01 135 03 0 00 005525' ldb t3,[pointr t2, dv%typ] ;[193] Pick up the device type 37278 002331'01 306 03 0 00 000000 cain t3, .dvdsk ;[193] Isn't a disk? 37279 002332'01 254 00 0 00 002356' anskp. ;[193] It is, so we're fine 37280 002333'01 200 02 0 00 000001 move t2, t1 ;[193] Load device designator for DEVST% 37281 002334'01 561 01 0 00 000003 hrroi t1, t3 ;[193] String is going in the registers 37282 002335'01 403 03 0 00 000004 setzb t3, t4 ;[193] Get 9 characters of device (only need 6) 37283 002336'01 104 00 0 00 000121 DEVST% ;[193] Get a string representation 37284 002337'01 320 12 0 00 002341' ifje. r ;[193] Pick up and ignore error 37285 002340'01 254 00 0 00 002343' 37286 002341'01 200 02 0 00 000001 move t2, t1 ;[193] Save error code for debuggers 37287 002342'01 120 03 0 00 005675' dmove t3, [asciz /Unknown/] ;[193] Phoney up something 37288 002343'01 endif. ;[193] 37289 002343'01 337 01 0 00 000006 skipg t1, q2 ;[193] Load the JFN 37290 002344'01 254 00 0 00 002350' ifskp. ;[193] If it was a JFN... 37291 002345'01 621 01 0 00 777777 tlz t1, -1 ;[193] Stomp any flags 37292 002346'01 104 00 0 00 000023 RLJFN% ;[193] Toss it 37293 002347'01 320 12 0 00 002350' erjmpr .+1 ;[193] Catch and ignore error 37294 002350'01 endif. ;[193] 37295 002350'01 561 01 0 00 000003 hrroi t1, t3 ;[193] String is coming from registers 37296 002351'01 104 00 0 00 000313 ESOUT% ;[193] Begin complaining 37297 txmsg <: is not a directory structured device k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 38-2 K20SRV MAC 26-Nov-23 15:09 LOCAL TYPE [143] 37298 002352'01 200 01 0 00 000000# > ;[193] Complete the blat 37299 002353'01 104 00 0 00 000076 37300 002354'01 320 12 0 00 002355' 37301 000241'02 000000000000# 37302 000506'04 072 040 151 163 040 37303 37304 002355'01 254 00 0 00 001321* callret cmder1 ;[193] Allow a reparse 37305 002356'01 endif. ;[193] 37306 37307 002356'01 260 17 0 00 002220* confrm ;[193] Tie off the line 37308 002357'01 202 06 0 00 001742* movem q2, pars3 ; Here's the JFN just parsed. 37309 002360'01 263 17 0 00 000000 ret 37310 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 39 K20SRV MAC 26-Nov-23 15:09 LOCAL TYPE command execution. 37311 subttl LOCAL TYPE command execution. 37312 37313 002361'01 $ytype: entry $ytype ;[194] Maybe move this? 37314 002361'01 337 01 0 00 002357* skipg t1, pars3 ; Get the JFN. 37315 002362'01 263 17 0 00 000000 ret ; Junk, just don't do anything ... 37316 37317 002363'01 265 16 0 00 005514' saveac ; Save for fast copy of current JFN 37318 002364'01 200 05 0 00 000001 move q1, t1 ; Save the JFN (and its flags) 37319 002365'01 260 17 0 00 002310* call isnulj ; BUT!! Is this JFN open on NUL:? 37320 002366'01 254 00 0 00 002375' ifskp. ; It is, so fix some things up 37321 002367'01 202 01 0 00 001370* movem t1, filjfn ; Let's say .nulio is 'open' 37322 002370'01 202 01 0 00 001421* movem t1, nxtjfn ; And that it is our next JFN 37323 002371'01 202 01 0 00 001542* movem t1, ndxjfn ; Store as our pseudo-stepping JFN 37324 002372'01 502 05 0 00 002371* hllm q1, ndxjfn ; Also store original flags on NUL: 37325 002373'01 550 05 0 00 000001 hrrz q1, t1 ; And over the previous JFN and flags 37326 002374'01 254 00 0 00 002431' else. ; Otherwise, set up for real file stepping. 37327 002375'01 550 01 0 00 000005 hrrz t1, q1 ;[220] Load just the JFN, no flags 37328 002376'01 260 17 0 00 004723' call isdird ;[193] But! Did somebody slip something phonkey in? 37329 002377'01 254 00 0 00 002404' ifskp. ;[193] Nope, this is a directory device 37330 002400'01 202 05 0 00 002372* movem q1, ndxjfn ; Store JFN and flags 37331 002401'01 552 05 0 00 002370* hrrzm q1, nxtjfn ; Just the JFN, no flags 37332 002402'01 402 00 0 00 002367* setzm filjfn ; No file currently open 37333 002403'01 254 00 0 00 002431' else. ;[193] Otherwise, not NUL:, so we can't use this 37334 002404'01 265 16 0 00 002254* anstkv(q2,^d4) ;[193] 20 characters of device name 37335 002405'01 000000 000004 37336 002406'01 415 06 0 17 777773 37337 002407'01 403 03 0 00 000004 setzb t3, t4 ;[193] Cons up some NUL's 37338 002410'01 124 03 0 06 000000 dmovem t3, 0(q2) ;[193] Let's scrub 37339 002411'01 124 03 0 06 000002 dmovem t3, 2(q2) ;[193] a dub dub 37340 002412'01 561 01 0 06 000000 hrroi t1, 0(q2) ;[193] Tops-20 pointer to beginning of buffer 37341 002413'01 550 02 0 00 000005 hrrz t2, q1 ;[193] Load the JFN, sans flags 37342 dmove t3, [fld(.jsaof,js%dev)!js%paf 37343 002414'01 120 03 0 00 005757' 0 ] ;[193] Just the punctuated device, no prefix 37344 002415'01 104 00 0 00 000030 JFNS% ;[193] Convert it 37345 002416'01 320 12 0 00 002420' ifje. r ;[193] Failed?? 37346 002417'01 254 00 0 00 002423' 37347 002420'01 200 02 0 00 000001 move t2, t1 ;[193] Save the error for debuggers 37348 002421'01 120 03 0 00 005761' dmove t3, [ asciz /Unknown:/ ] ;[193] 37349 002422'01 124 03 0 06 000000 dmovem t3, 0(q2) ;[193] Store some kind of message... 37350 002423'01 endif. 37351 002423'01 561 01 0 06 000000 hrroi t1, 0(q2) ;[193] Tops-20 pointer to beginning of buffer 37352 002424'01 104 00 0 00 000313 ESOUT% ;[193] Begin whining 37353 txmsg < is not a directory structured device 37354 002425'01 200 01 0 00 000000# > 37355 002426'01 104 00 0 00 000076 37356 002427'01 320 12 0 00 002430' 37357 000242'02 000000000000# 37358 000517'04 040 151 163 040 156 37359 37360 002430'01 254 00 0 00 002513' jrst $ytypz ;[193] Finally get out of here 37361 002431'01 endif. ;[193] End directory device double check 37362 002431'01 endif. ;[193] End NUL: 'directory' special check 37363 37364 002431'01 260 17 0 00 002070* call ccon ;[169] Allow ^C out of this. 37365 002432'01 254 00 0 00 002510' jrst $ytypy ;[169] Upon ^C, get out of here k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 39-1 K20SRV MAC 26-Nov-23 15:09 LOCAL TYPE command execution. 37366 37367 002433'01 do. ; Enter loop context 37368 002433'01 260 17 0 00 004754' call gtnfil ; Any more files? 37369 002434'01 254 00 0 00 002510' exit. ; Nope, beat it 37370 002435'01 550 05 0 00 000001 hrrz q1, t1 ; OK, so save what we're doing now 37371 002436'01 260 17 0 00 000000* call clrcno ; Clear Control-O, if set 37372 002437'01 561 01 0 00 002116* hrroi t1, crlf ; Tie off the line 37373 002440'01 104 00 0 00 000076 PSOUT% 37374 002441'01 201 01 0 00 000101 movei t1, .priou ; Going to primary output 37375 002442'01 200 02 0 00 000005 move t2, q1 ; Load the current JFN to do 37376 002443'01 260 17 0 00 000000* call typnam ; Type the file name 37377 002444'01 254 00 0 00 002510' exit. ; Stop processing files on error 37378 002445'01 200 01 0 00 000005 move t1, q1 ; Load JFN 37379 002446'01 302 01 0 00 377777 caie t1, .nulio ;[193] Not actually typing anything? 37380 002447'01 254 00 0 00 002452' ifskp. ;[193] No, so that's easy to set up 37381 002450'01 201 03 0 00 000010 movx t3, ^d8 ;[193] Assume NUL: is always eight bit 37382 002451'01 254 00 0 00 002474' else. ;[193] Otherwise, a real JFN, maybe? 37383 002452'01 200 02 0 00 005763' move t2, [1,,.fbbyv] ;Get bytesize. 37384 002453'01 201 03 0 00 000004 movei t3, t4 37385 002454'01 104 00 0 00 000063 GTFDB 37386 002455'01 320 12 0 00 002457' ifje. r ;[194] Might fail if not disk 37387 002456'01 254 00 0 00 002462' 37388 002457'01 200 03 0 00 000001 move t3, t1 ;[194] Save error code for debugger 37389 002460'01 400 04 0 00 000000 setz t4, ;[194] If failed, say no byte size 37390 002461'01 200 01 0 00 000005 move t1, q1 ;[194] Reload JFN 37391 002462'01 endif. ;[194] 37392 002462'01 200 02 0 00 005764' movx t2, of%rd+fld(7,of%bsz) ; Assume 7-bit mode. 37393 002463'01 135 03 0 00 005765' ldb t3, [pointr (t4,fb%bsz)] ; Extract the bytesize. 37394 002464'01 306 03 0 00 000010 cain t3, ^d8 ; 8 bit? 37395 002465'01 200 02 0 00 005766' movx t2, of%rd+fld(^d8,of%bsz) ; Yes, 8-bit. 37396 002466'01 104 00 0 00 000021 OPENF ; Open the file in appropriate mode. 37397 002467'01 320 12 0 00 002471' %jserr (,endlp.) 37398 002470'01 254 00 0 00 002474' 37399 002471'01 265 01 0 00 002325* 37400 002472'01 000000000000# 37401 002473'01 254 00 0 00 002510' 37402 000527'04 103 157 165 154 144 37403 002474'01 endif. ;[193] End .nulio special casing 37404 002474'01 260 17 0 00 000000* call typfil ; Type the file 37405 002475'01 254 00 0 00 002510' exit. ; If failed, go no further 37406 002476'01 200 01 0 00 000005 move t1, q1 ; Close the file. 37407 002477'01 302 01 0 00 377777 caie t1, .nulio ; Unless there is no need 37408 002500'01 104 00 0 00 000022 CLOSF 37409 002501'01 320 12 0 00 002503' %jserr (,endlp.) 37410 002502'01 254 00 0 00 002506' 37411 002503'01 265 01 0 00 002471* 37412 002504'01 000000000000# 37413 002505'01 254 00 0 00 002510' 37414 000535'04 103 157 165 154 144 37415 002506'01 400 05 0 00 000000 setz q1, ;[194] Done with this file 37416 002507'01 254 00 0 00 002433' loop. ;[194] Do the next file 37417 002510'01 enddo. ;[193] End loop context 37418 37419 002510'01 260 17 0 00 002074* $ytypy: call ccoff ; Turn off ^C 37420 002511'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 20:02 27-Nov-23 Page 39-2 K20SRV MAC 26-Nov-23 15:09 LOCAL TYPE command execution. 37421 002512'01 600 00 0 00 000000 nop ; Ignore any error 37422 37423 002513'01 322 05 0 00 002516' $ytypz: ifn. q1 ; Any JFN left lying around maybe? 37424 002514'01 200 01 0 00 000005 move t1, q1 ; OK, so load it 37425 002515'01 260 17 0 00 000000* call frclos ; Force it to close 37426 002516'01 endif. 37427 002516'01 263 17 0 00 000000 ret ; No more, done. 37428 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 40 K20SRV MAC 26-Nov-23 15:09 REMOTE TYPE command execution. 37429 subttl REMOTE TYPE command execution. 37430 37431 002517'01 $xtype: entry $xtype 37432 002517'01 336 00 0 00 002222* ifmn. tlgjfn ;[233] Doing transaction logging? 37433 002520'01 254 00 0 00 002542' 37434 002521'01 415 16 0 00 002542' block. ;[233] Get a stack frame 37435 002522'01 261 17 0 00 000016 37436 002523'01 265 16 0 00 005543' saveac ;[233] Save even the temporaries 37437 002524'01 476 00 0 00 001706* setom scrlft ;[233] Don't append the crlf! 37438 002525'01 265 01 0 00 002227* wtlog(,) ;[233] 37439 002526'01 000000000000# 37440 002527'01 777777 777744 37441 002530'01 000000 000000 37442 000543'04 122 145 161 165 145 37443 002531'01 200 01 0 00 002517* move t1, tlgjfn ;[233] Put the directory name in the log 37444 002532'01 561 02 0 00 001714* hrroi t2,atmbuf ;[233] It's in the atom buffer 37445 002533'01 403 03 0 00 000004 setzb t3,t4 ;[233] Don't know how long, stop on a NUL 37446 002534'01 104 00 0 00 000053 SOUT% ;[233] Out it goes! 37447 002535'01 320 14 0 00 002536' erjmps .+1 ;[233] Catch and suppress error 37448 dmove t2,[ -1,,crlf ;[233] Tops-20 pointer to carriage return line feed 37449 002536'01 120 02 0 00 005660' -2 ] ;[233] Counted SOUT%'s are faster 37450 002537'01 104 00 0 00 000053 SOUT% ;[233] Out it goes! 37451 002540'01 320 14 0 00 002541' erjmps .+1 ;[233] Catch and suppress error 37452 002541'01 263 17 0 00 000000 endbk. ;[233] Release stack frame, restoring AC's 37453 002542'01 endif. ;[233] 37454 37455 002542'01 260 17 0 00 002234* call statim ;[189] Start timing so k20pdc doesn't choke 37456 002543'01 201 04 0 00 000124 movei t4, "T" ; Generic command is T. 37457 002544'01 254 00 0 00 004611' jrst srvfil 37458 37459 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 41 K20SRV MAC 26-Nov-23 15:09 Server Operation 37460 subttl Server Operation 37461 37462 ; GETCOM 37463 ; 37464 ; We come here if we are in server mode. We just wait for a packet of one of 37465 ; the following types: 37466 ; 37467 ; S Send init - just follow the normal path from here 37468 ; R Receive init - like a local "send filespec" 37469 ; I Init (all-purpose exchange of parameters) 37470 ; G Generic command: 37471 ; L Logout - the other side is done, log out this job 37472 ; F Finish - exit from Kermit 37473 ; U Disk Usage query 37474 ; T Type a file 37475 ; etc 37476 ; 37477 ; First, issue a message telling the user what to do. 37478 ; 37479 002545'01 getcom: entry getcom ;[194] Also invoked from k20par 37480 movei t1, [ ;[157] In case line gets XOFF'd while 37481 call ttxon ;[157] typing the message, unstick it, 37482 002545'01 201 01 0 00 005767' jrst getcm2 ] ;[157] and proceed. 37483 002546'01 260 17 0 00 000000* call timeit ;[157] Set the timer. 37484 002547'01 336 00 0 00 002050* ifmn. local ;[174] Local mode? 37485 002550'01 254 00 0 00 002575' 37486 txmsg < 37487 002551'01 200 01 0 00 000000# Entering server mode on TTY> ;[174] Yes, give appropriate message. 37488 002552'01 104 00 0 00 000076 37489 002553'01 320 12 0 00 002554' 37490 000243'02 000000000000# 37491 000551'04 015 012 040 105 156 37492 002554'01 201 01 0 00 000101 numout ttynum, 8 37493 002555'01 200 02 0 00 000000* 37494 002556'01 201 03 0 00 000010 37495 002557'01 104 00 0 00 000224 37496 002560'01 320 14 0 00 002561' 37497 002561'01 337 02 0 00 000000* skipg t2, speed ;[194] Load speed 37498 002562'01 254 00 0 00 002574' ifskp. ;[194] If we have one .. 37499 002563'01 200 01 0 00 000000# txmsg <, > 37500 002564'01 104 00 0 00 000076 37501 002565'01 320 12 0 00 002566' 37502 000244'02 000000000000# 37503 000560'04 054 040 000 000 000 37504 002566'01 201 01 0 00 000101 movei t1, .priou ;[194] 37505 002567'01 201 03 0 00 000012 movei t3, ^d10 ;[194] 37506 002570'01 104 00 0 00 000224 NOUT% 37507 002571'01 200 01 0 00 000000# txmsg < baud> 37508 002572'01 104 00 0 00 000076 37509 002573'01 320 12 0 00 002574' 37510 000245'02 000000000000# 37511 000561'04 040 142 141 165 144 37512 002574'01 endif. ;[194] 37513 002574'01 254 00 0 00 002605' jrst getcmm ;[174] 37514 002575'01 endif. ;[194] k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 41-1 K20SRV MAC 26-Nov-23 15:09 Server Operation 37515 37516 txmsg < 37517 002575'01 200 01 0 00 000000# Kermit Server running on > ;[186] 37518 002576'01 104 00 0 00 000076 37519 002577'01 320 12 0 00 002600' 37520 000246'02 000000000000# 37521 000563'04 015 012 040 113 145 37522 002600'01 561 01 0 00 000000* hrroi t1,sysnam## ;[186] Load local node name 37523 002601'01 104 00 0 00 000076 PSOUT% ;[186] Type it, not "DEC-20" 37524 txmsg < host. Please type your escape 37525 sequence to return to your local machine. Shut down the server by 37526 002602'01 200 01 0 00 000000# typing the BYE command to KERMIT on your local machine.> ;[186] 37527 002603'01 104 00 0 00 000076 37528 002604'01 320 12 0 00 002605' 37529 000247'02 000000000000# 37530 000571'04 040 150 157 163 164 37531 37532 37533 37534 getcmm: txmsg < 37535 002605'01 200 01 0 00 000000# > 37536 002606'01 104 00 0 00 000076 37537 002607'01 320 12 0 00 002610' 37538 000250'02 000000000000# 37539 000631'04 015 012 000 000 000 37540 002610'01 260 17 0 00 000000* getcm2: call timoff ;[157] Turn off timer. 37541 002611'01 260 17 0 00 002542* call statim ;[189] Give k20pdc something to not choke on 37542 002612'01 476 00 0 00 000000* setom srvflg ; Flag that we are serving. 37543 002613'01 260 17 0 00 000000* call inilin ; Initialize the line. 37544 002614'01 260 17 0 00 002431* call ccon ; Don't let someone ^C without reseting line. 37545 002615'01 254 00 0 00 003134' jrst xgfin2 ; On control-C, go "finish". 37546 002616'01 403 03 0 00 000004 setzb t3, t4 ; Set default parameters in case we get some 37547 002617'01 124 03 0 00 000000* dmovem t3, delay ;[212] No delay in server mode (gets floating value) 37548 002620'01 260 17 0 00 000000* call spar ; command before first Send-Init or Info. 37549 002621'01 254 00 0 00 002622' jrst xxwait ; Go wait for a command packet. 37550 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 42 K20SRV MAC 26-Nov-23 15:09 Server command loop 37551 subttl Server command loop 37552 37553 ; Server commands should always jrst back to here, even upon error, 37554 ; except for those that specify exit from server mode. 37555 37556 002622'01 332 00 0 00 000000* xxwait: skipe mdmlin ;[130] Modem line? 37557 002623'01 332 00 0 00 000000* skipe carier ;[130] Did carrier drop? 37558 002624'01 334 00 0 00 000000 skipa ;[130] No. 37559 002625'01 254 00 0 00 003134' jrst xgfin2 ;[130] Yes, go clean up. 37560 37561 002626'01 476 00 0 00 000000* setom sptot ;[134] Clear packet statistics counters 37562 002627'01 476 00 0 00 000000* setom rptot ;[134] ... 37563 002630'01 402 00 0 00 000000* setzm xflg ; Clear the server "type" flag. 37564 002631'01 402 00 0 00 000000* setzm source ; Ditto for GETCH source. 37565 002632'01 402 00 0 00 000000* setzm dest ; Ditto for PUTCH destination. 37566 002633'01 402 00 0 00 001540* setzm ffunc ; And for file function. 37567 002634'01 120 01 0 00 000000* dmove t1, srvtim ;[212] ; Get the default server packet time out. 37568 002635'01 124 01 0 00 000000* dmovem t1, stimou ;[212] ; Set it so we don't time out as often. 37569 37570 002636'01 do. ;[194] Enter loop context 37571 002636'01 476 00 0 00 000000* setom bctone ;[98] Set this so we use type 1 checksum. 37572 002637'01 402 00 0 00 001777* setzm pktnum ; Initial packet sequence number. 37573 002640'01 260 17 0 00 000000* call rpack ; Get a packet. 37574 002641'01 254 00 0 00 002656' ifskp. ;[194] Worked 37575 002642'01 306 01 0 00 000124 cain t1, "T" ;[194] But!! A TIMER interrupt pseudo packet? 37576 002643'01 254 00 0 00 002656' anskp. ; On timeout, NAK what we're looking for. 37577 002644'01 301 01 0 00 000101 cail t1, "A" ;[150] Packet type in range? 37578 002645'01 303 01 0 00 000132 caile t1, "Z" ;[150] 37579 002646'01 334 00 0 00 000000 kermsg (,xxwait) ;[150] No. 37580 002647'01 254 00 0 00 002654' 37581 002650'01 265 01 0 00 000000* 37582 002651'01 000000 000043 37583 002652'01 000000000000# 37584 002653'01 254 00 0 00 002622' 37585 000632'04 120 141 143 153 145 37586 002654'01 254 00 0 00 002662' exit. ;[194] Otherwise, goo so break out of the loop 37587 002655'01 254 00 0 00 002662' else. ;[194] Some kind of error 37588 002656'01 200 02 0 00 002637* move t2, pktnum ; Load current packet number 37589 002657'01 260 17 0 00 000000* call nak ; NAK that "packet". 37590 002660'01 254 00 0 00 002636' loop. ;[194] Go round again. 37591 002661'01 254 00 0 00 002636' loop. ; (no matter what) 37592 002662'01 endif. ;[194] End packet reception analysis 37593 002662'01 enddo. ;[194] End loop lexical context 37594 37595 ; Got a real command. Restore the normal timeout interval and do the command. 37596 37597 002662'01 202 02 0 00 002656* movem t2, pktnum ; Save packet number. 37598 002663'01 261 17 0 00 000001 push p, t1 ; We can't use any normal AC's here... 37599 002664'01 261 17 0 00 000002 push p, t2 ;[212] Ditto floating display value 37600 002665'01 120 01 0 00 000000* dmove t1, otimou ;[212] Put normal timeout back. 37601 002666'01 124 01 0 00 002635* dmovem t1, stimou ;[212] 37602 002667'01 262 17 0 00 000002 pop p, t2 ;[212] Restore this, too 37603 002670'01 262 17 0 00 000001 pop p, t1 37604 002671'01 275 01 0 00 000101 subi t1, "A" ;[194] Get into range (easier to debug) 37605 002672'01 254 00 1 01 002673' jrst @xxcmd(t1) ;[150] Go do the indicated command. k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 42-1 K20SRV MAC 26-Nov-23 15:09 Server command loop 37606 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 43 K20SRV MAC 26-Nov-23 15:09 Server command loop 37607 37608 ;[150] Server command dispatch table and error message routines. 37609 37610 37611 002673'01 000000 002731' xxcmd: xxinv ; A - Attributes, shouldn't come now 37612 002674'01 000000 002731' xxinv ; B - EOT, shouldn't come now 37613 002675'01 000000 003016' xhost ; C - Host Command 37614 002676'01 000000 002731' xxinv ; D - Data, shouldn't come now 37615 002677'01 000000 002622' xxwait ; E - Error, just ignore 37616 002700'01 000000 002731' xxinv ; F - File header, shouldn't come now 37617 002701'01 000000 003024' xgen ; G - Generic Command 37618 002702'01 000000 002726' xxunk ; H - Undefined 37619 002703'01 000000 003260' xinfo ; I - Info Packet 37620 002704'01 000000 002726' xxunk ; J - Undefined 37621 002705'01 000000 002726' xxunk ; K - Undefined 37622 002706'01 000000 002726' xxunk ; L - Undefined 37623 002707'01 000000 002726' xxunk ; M - Undefined 37624 002710'01 000000 002622' xxwait ; N - NAK, ignore 37625 002711'01 000000 002726' xxunk ; O - Undefined 37626 002712'01 000000 002726' xxunk ; P - Undefined 37627 002713'01 000000 002726' xxunk ; Q - Undefined 37628 002714'01 000000 002762' xrecv ; R - Receive (GET), server sends 37629 002715'01 000000 002744' xsend ; S - Send, server receives 37630 002716'01 000000 002622' xxwait ; T - (Already handled specially above) 37631 002717'01 000000 002726' xxunk ; U - Undefined 37632 002720'01 000000 002726' xxunk ; V - Undefined 37633 002721'01 000000 002726' xxunk ; W - Undefined 37634 002722'01 000000 002731' xxinv ; X - Text Header, shouldn't come now 37635 002723'01 000000 002622' xxwait ; Y - ACK, ignore 37636 002724'01 000000 002731' xxinv ; Z - EOF, shouldn't come now 37637 002725'01 000000 000000 0 ; (superstition) 37638 37639 ; Routine to issue informative error messages. 37640 37641 002726'01 200 04 0 00 005771' xxunk: move t4, [point 7, xxumsg] ; Get "unknown command" message. 37642 002727'01 201 03 0 00 000034 movei t3, xxulen ; And its length 37643 002730'01 254 00 0 00 002733' jrst xxmsg 37644 37645 002731'01 200 04 0 00 005772' xxinv: move t4, [point 7, xxbmsg] ; Get "invalid use of..." message. 37646 002732'01 201 03 0 00 000041 movei t3, xxblen ; And its lentgh. 37647 37648 002733'01 261 17 0 00 000004 xxmsg: push p, t4 ; Save msg pointer. 37649 002734'01 133 00 0 00 000004 ibp t4 ; Point past opening quote. 37650 002735'01 136 01 0 00 000004 idpb t1, t4 ; Deposit the packet type. 37651 002736'01 201 01 0 00 000105 movei t1, "E" ; Send an Error packet. 37652 002737'01 200 02 0 00 002662* move t2, pktnum ; This is the packet number. 37653 002740'01 262 17 0 00 000004 pop p, t4 ; Get original pointer back. 37654 002741'01 260 17 0 00 002001* call spack ; Send the error packet. 37655 002742'01 600 00 0 00 000000 nop 37656 002743'01 254 00 0 00 002622' jrst xxwait ; Go back to command wait. k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 44 K20SRV MAC 26-Nov-23 15:09 Server command loop 37657 37658 subttl Server commands. 37659 37660 ; Server SEND command (i.e. send to me, I'm the server, I receive the files.) 37661 ; 37662 ; We've just received a Send-Init. 37663 ; 37664 002744'01 402 00 0 00 000000* xsend: setzm numtry ; Packet retry counter. 37665 002745'01 202 02 0 00 002737* movem t2, pktnum ; Synchronize packet numbers. 37666 002746'01 260 17 0 00 002620* call spar ; Get the Send-Init parameters. 37667 002747'01 200 04 0 00 005773' move t4, [point 8, datbuf] ;[190] ;[50] Now send back our own, 37668 002750'01 260 17 0 00 000000* call rpar ; which we put in the data field of our ACK. 37669 002751'01 201 01 0 00 000131 movei t1, "Y" ; Set up the ACK. 37670 002752'01 200 02 0 00 002745* move t2, pktnum ; Packet number. 37671 002753'01 260 17 0 00 002741* call spack ; Send the packet. 37672 002754'01 254 00 0 00 002622' jrst xxwait ;* Give up if we can't.(?) 37673 002755'01 260 17 0 00 000000* call rrinit ;[126] Set things up for receiving. 37674 002756'01 201 11 0 00 000106 movei state, "F" ; Set the state to file send. 37675 002757'01 260 17 0 00 000000* call $recvs ;[42] Go look like we're receiving. 37676 002760'01 600 00 0 00 000000 nop ; 37677 002761'01 254 00 0 00 002622' jrst xxwait ; Get another command when done. 37678 37679 37680 ; Server RECEIVE (or GET) command -- Server sends files. 37681 ; 37682 ; We've just received a Receive-Init packet, containing a filename. 37683 ; (Or a remote TYPE command). T1-T4 contain packet parameters returned 37684 ; by RPACK. 37685 ; 37686 002762'01 200 01 0 00 000004 xrecv: move t1, t4 ;[141] Pointer to encoded filespec. 37687 002763'01 200 02 0 00 000003 move t2, t3 ;[141] Number of characters. 37688 002764'01 260 17 0 00 000000* call decodf ;[141] Decode it. 37689 002765'01 334 00 0 00 000000 kermsg (, xxwait) ;[141] Can't? Give message. 37690 002766'01 254 00 0 00 002773' 37691 002767'01 265 01 0 00 002650* 37692 002770'01 000000 000040 37693 002771'01 000000000000# 37694 002772'01 254 00 0 00 002622' 37695 000637'04 103 141 156 047 164 37696 002773'01 200 02 0 00 000001 move t2, t1 ;[141] Decoded OK, point to decoded filespec. 37697 37698 ; Entry point when filespec already decoded. 37699 37700 002774'01 205 01 0 00 100101 xrecv2: movx t1, gj%sht!gj%old!gj%ifg ; Old file and allow wildcarding. 37701 002775'01 104 00 0 00 000020 GTJFN% ; Get a JFN. 37702 002776'01 320 14 0 00 003000' %jsker (,xxwait) ; Can't, send error packet and loop. 37703 002777'01 254 00 0 00 003003' 37704 003000'01 265 01 0 00 000000* 37705 003001'01 000000 000000 37706 003002'01 254 00 0 00 002622' 37707 003003'01 202 01 0 00 002400* movem t1, ndxjfn ;[111] Got JFN, save wildcard bits here. 37708 003004'01 552 01 0 00 002401* hrrzm t1, nxtjfn ;[111] Initialize file lookahead. 37709 003005'01 260 17 0 00 002365* call isnulj ;[193] Is this the NUL: device? 37710 003006'01 254 00 0 00 003011' ifskp. ;[193] It is, propagate our talisman 37711 003007'01 552 01 0 00 003004* hrrzm t1, nxtjfn ;[193] Re-initialize file lookahead k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 44-1 K20SRV MAC 26-Nov-23 15:09 Server commands. 37712 003010'01 552 01 0 00 003003* hrrzm t1, ndxjfn ;[193] Save JFN with whacked wildcard bits 37713 003011'01 endif. ;[193] 37714 37715 003011'01 260 17 0 00 004754' call gtnfil ;[111] Get next (in this case, first) file. 37716 003012'01 600 00 0 00 000000 nop ;[111] Could never fail, right? 37717 003013'01 260 17 0 00 000000* call $sends ; Go send the file(s). 37718 003014'01 600 00 0 00 000000 nop ; (in case it skips for some reason...) 37719 003015'01 254 00 0 00 002622' jrst xxwait ; Go back & get another command. 37720 37721 37722 ; HOST command. 37723 37724 003016'01 334 00 0 00 000000 xhost: kermsg (, xxwait) 37725 003017'01 254 00 0 00 003024' 37726 003020'01 265 01 0 00 002767* 37727 003021'01 000000 000050 37728 003022'01 000000000000# 37729 003023'01 254 00 0 00 002622' 37730 000644'04 110 157 163 164 040 37731 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 45 K20SRV MAC 26-Nov-23 15:09 Server commands. 37732 37733 ;[150] Server GENERIC command. Get the subcommand and execute it. 37734 37735 003024'01 134 01 0 00 000004 xgen: ildb t1, t4 ; Get the first character of the data field. 37736 003025'01 301 01 0 00 000101 cail t1, "A" ; Validate. 37737 003026'01 303 01 0 00 000132 caile t1, "Z" 37738 003027'01 334 00 0 00 000000 kermsg (, xxwait) ; Bad. 37739 003030'01 254 00 0 00 003035' 37740 003031'01 265 01 0 00 003020* 37741 003032'01 000000 000047 37742 003033'01 000000000000# 37743 003034'01 254 00 0 00 002622' 37744 000652'04 107 145 156 145 162 37745 37746 003035'01 370 00 0 00 000003 sos t3 ; Command in range, account for it. 37747 003036'01 275 01 0 00 000101 subi t1, "A" ;[194] Command in range, change to table offset 37748 003037'01 306 01 0 00 000121 cain t1, "Q" ;[189] Don't overwrite times on status query!! 37749 003040'01 254 00 1 01 003045' jrst @xxgcmd(t1) ;[194] Dispatch to it. 37750 37751 003041'01 260 17 1 01 003045' call @xxgcmd(t1) ;[189] Go do whatever we're supposed to be doing 37752 003042'01 260 17 0 00 000046* call endtim ;[189] Stop timing 37753 003043'01 260 17 0 00 000047* call elptim ;[189] Compute elapsed time 37754 003044'01 263 17 0 00 000000 ret ;[189] 37755 37756 37757 37758 ;[150] Server generic command dispatch table. 37759 37760 003045'01 000000 003602' xxgcmd: xgpwd ;[188] ; A - PWD 37761 003046'01 000000 003100' xgundf ; B - Undefined 37762 003047'01 000000 003345' xgcwd ; C - CWD 37763 003050'01 000000 003754' xgdir ; D - Directory 37764 003051'01 000000 004105' xgdel ; E - Erase (delete) 37765 003052'01 000000 003106' xgfin ; F - Finish 37766 003053'01 000000 003100' xgundf ; G - Undefined 37767 003054'01 000000 003676' xghelp ; H - Help 37768 003055'01 000000 003103' xgnyi ; I - Login (not yet implemented) 37769 003056'01 000000 003103' xgnyi ; J - Journal control (nyi) 37770 003057'01 000000 003103' xgnyi ; K - Copy (nyi) 37771 003060'01 000000 003150' xglogo ; L - Logout, Bye 37772 003061'01 000000 003103' xgnyi ; M - Short message 37773 003062'01 000000 003100' xgundf ; N - Undef 37774 003063'01 000000 003100' xgundf ; O - Undef 37775 003064'01 000000 003103' xgnyi ; P - Program invocation (nyi) 37776 003065'01 000000 003655' xgstat ; Q - Server status query 37777 003066'01 000000 003103' xgnyi ; R - Rename (nyi) 37778 003067'01 000000 003100' xgundf ; S - Undef 37779 003070'01 000000 003220' xgtype ; T - Type 37780 003071'01 000000 003510' xgdisk ; U - Disk Usage 37781 003072'01 000000 003103' xgnyi ; V - Variable Set/Query 37782 003073'01 000000 003103' xgnyi ; W - Who (Finger) 37783 003074'01 000000 003100' xgundf ; X - Undef 37784 003075'01 000000 003100' xgundf ; Y - Undef 37785 003076'01 000000 003100' xgundf ; Z - Undef 37786 003077'01 000000 000000 0 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 45-1 K20SRV MAC 26-Nov-23 15:09 Server commands. 37787 37788 003100'01 200 04 0 00 005774' xgundf: move t4, [point 7, xxgums] ; Issue message for undefined command. 37789 003101'01 201 03 0 00 000037 movei t3, xxguln 37790 003102'01 254 00 0 00 002733' jrst xxmsg 37791 37792 003103'01 200 04 0 00 005775' xgnyi: move t4, [point 7, xxgnms] ; Issue msg for unimplemented command. 37793 003104'01 201 03 0 00 000043 movei t3, xxgnln 37794 003105'01 254 00 0 00 002733' jrst xxmsg k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 46 K20SRV MAC 26-Nov-23 15:09 Server commands. 37795 37796 ; Generic commands... 37797 37798 37799 ; FINISH. Shut down the server, but don't log out. 37800 37801 003106'01 201 01 0 00 000131 xgfin: movei t1, "Y" ; Acknowledge packet. 37802 003107'01 403 03 0 00 000004 setzb t3, t4 ; No data. 37803 003110'01 260 17 0 00 002753* call spack ; Send the packet. 37804 003111'01 600 00 0 00 000000 nop ;[56] 37805 003112'01 201 01 0 00 003134' movei t1,xgfin2 ;[186] Where to go on a time out 37806 003113'01 260 17 0 00 002546* call timeit ;[186] Start a timer 37807 003114'01 337 01 0 00 000000* skipg t1, netjfn ;[186] Wait until the packet 37808 003115'01 200 01 0 00 000000* move t1, ttyjfn ;[186] Unless using local terminal 37809 003116'01 336 00 0 00 000000* ifmn. ptyflg ;[186] On a pseudo-terminal? 37810 003117'01 254 00 0 00 003130' 37811 003120'01 200 01 0 00 000000* move t1,ptytty ;[186] Load PTY's associated TTY 37812 003121'01 104 00 0 00 000212 DIBE% ;[186] Wait for it to swallow everything 37813 003122'01 320 12 0 00 003124' %jsErr (,) ;[186] 37814 003123'01 254 00 0 00 003127' 37815 003124'01 265 01 0 00 002503* 37816 003125'01 000000000000# 37817 003126'01 254 00 0 00 003127' 37818 000660'04 103 157 165 154 144 37819 003127'01 254 00 0 00 003132' else. ;[186] Otherwise, do it the ordinary way 37820 003130'01 104 00 0 00 000104 DOBE ;[158] gets all the way out. 37821 003131'01 320 12 0 00 003132' erjmpr .+1 ;[186] Catch and ignore error 37822 003132'01 endif. ;[186] End case waiting for output done 37823 003132'01 260 17 0 00 002610* call timoff ;[186] Shut off the timer 37824 003133'01 476 00 0 00 000050* setom f$exit ;[137] Say we want to go back to command level. 37825 37826 003134'01 260 17 0 00 000000* xgfin2: call rrslin ;[121] Put line back in interactive state. 37827 003135'01 120 01 0 00 000000* dmove t1, odelay ;[194] ;[27] Restore normal delay 37828 003136'01 124 01 0 00 002617* dmovem t1, delay ;[194] ;[27] 37829 003137'01 120 01 0 00 002665* dmove t1, otimou ;[212] ;[27] and timout interval 37830 003140'01 124 01 0 00 002666* dmovem t1, stimou ;[212] ;[27] 37831 003141'01 402 00 0 00 002612* setzm srvflg ;[27] and reset the server flag 37832 003142'01 265 01 0 00 002525* wtlog (,) ;[244] Log the FINISH. 37833 003143'01 000000000000# 37834 003144'01 777777 777761 37835 003145'01 000000 000000 37836 000667'04 106 111 116 111 123 37837 003146'01 260 17 0 00 000000* call clenup## ;[244] Close all logs. 37838 003147'01 263 17 0 00 000000 ret ; Done 37839 37840 ; LOGOUT (or BYE) -- Shut down the server and log out. 37841 37842 003150'01 201 01 0 00 000131 xglogo: movei t1, "Y" ; Acknowledge the command. 37843 003151'01 403 03 0 00 000004 setzb t3, t4 ; No data. 37844 003152'01 260 17 0 00 003110* call spack ; Send the packet. 37845 003153'01 600 00 0 00 000000 nop ; 37846 003154'01 201 01 0 00 003175' movei t1,xglog1 ;[186] Where to go on a time out 37847 003155'01 260 17 0 00 003113* call timeit ;[186] Start a timer 37848 003156'01 337 01 0 00 003114* skipg t1, netjfn ;[186] Wait until the packet 37849 003157'01 200 01 0 00 003115* move t1, ttyjfn ;[186] Unless using local terminal k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 46-1 K20SRV MAC 26-Nov-23 15:09 Server commands. 37850 003160'01 336 00 0 00 003116* ifmn. ptyflg ;[186] On a pseudo-terminal? 37851 003161'01 254 00 0 00 003172' 37852 003162'01 200 01 0 00 003120* move t1,ptytty ;[186] Load PTY's associated TTY 37853 003163'01 104 00 0 00 000212 DIBE% ;[186] Wait for it to swallow everything 37854 003164'01 320 12 0 00 003166' %jsErr (,) ;[186] 37855 003165'01 254 00 0 00 003171' 37856 003166'01 265 01 0 00 003124* 37857 003167'01 000000000000# 37858 003170'01 254 00 0 00 003171' 37859 000673'04 103 157 165 154 144 37860 003171'01 254 00 0 00 003174' else. ;[186] Otherwise, do it the ordinary way 37861 003172'01 104 00 0 00 000104 DOBE ;[158] gets all the way out. 37862 003173'01 320 12 0 00 003174' erjmpr .+1 ;[186] Catch and ignore error 37863 003174'01 endif. ;[186] End case waiting for output done 37864 003174'01 260 17 0 00 003132* call timoff ;[186] Shut off the timer 37865 003175'01 260 17 0 00 003134* xglog1: call rrslin ;[186] Restore the line for interactive use. 37866 003176'01 120 01 0 00 003135* dmove t1, odelay ;[194] Restore normal delay 37867 003177'01 124 01 0 00 003136* dmovem t1, delay ;[194] 37868 003200'01 120 01 0 00 003137* dmove t1, otimou ;[212] and timout interval 37869 003201'01 124 01 0 00 003140* dmovem t1, stimou ;[212] 37870 003202'01 402 00 0 00 003141* setzm srvflg ; and reset the server flag. 37871 003203'01 265 01 0 00 003142* wtlog (,) ;[126] Log the BYE. 37872 003204'01 000000000000# 37873 003205'01 777777 777764 37874 003206'01 000000 000000 37875 000702'04 102 131 105 040 122 37876 003207'01 260 17 0 00 003146* call clenup## ;[126] Close all logs. 37877 003210'01 476 00 0 00 003133* setom f$exit ; Just in case we can't logout, set exit flag. 37878 003211'01 474 01 0 00 000000 seto t1, ; -1 = Myself. 37879 003212'01 104 00 0 00 000003 LGOUT% ; Log me out. 37880 003213'01 320 14 0 00 003215' %jsker (,r) ; If this fails, print msg & go back. 37881 003214'01 254 00 0 00 003220' 37882 003215'01 265 01 0 00 003000* 37883 003216'01 000000 000000 37884 003217'01 254 00 0 00 002327* 37885 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 47 K20SRV MAC 26-Nov-23 15:09 Server commands. 37886 37887 ; Command to TYPE a file. Just like sending a file, except must send "X" 37888 ; packet instead of file header. 37889 37890 003220'01 260 17 0 00 003313' xgtype: call getarg ; Get the argument. 37891 003221'01 476 00 0 00 002630* setom xflg ; Send file with X header. 37892 003222'01 336 00 0 00 002531* ifmn. tlgjfn ;[233] Doing transaction logging? 37893 003223'01 254 00 0 00 003256' 37894 003224'01 415 16 0 00 003256' block. ;[233] Get a stack frame 37895 003225'01 261 17 0 00 000016 37896 003226'01 265 16 0 00 005543' saveac ;[233] Save even the temporaries 37897 003227'01 202 04 0 00 000000# movem t4,tmpjfn ;[233] Save the pointer 37898 003230'01 476 00 0 00 002524* setom scrlft ;[233] Don't append the crlf! 37899 003231'01 265 01 0 00 003203* wtlog(,) ;[233] 37900 003232'01 000000000000# 37901 003233'01 777777 777770 37902 003234'01 000000 000000 37903 000705'04 123 145 156 144 151 37904 003235'01 200 01 0 00 003222* move t1, tlgjfn ;[233] Put the directory name in the log 37905 003236'01 200 02 0 00 000000# move t2,tmpjfn ;[233] Reload the pointer 37906 003237'01 403 03 0 00 000004 setzb t3,t4 ;[233] Don't know how long, stop on a NUL 37907 003240'01 104 00 0 00 000053 SOUT% ;[233] Out it goes! 37908 003241'01 320 14 0 00 003242' erjmps .+1 ;[233] Catch and suppress error 37909 003242'01 402 00 0 00 000000# setzm tmpjfn ;[233] Scrub it, not a JFN anyway 37910 003243'01 120 02 0 00 000000# dxtext (t2,< for local display >) ;[233] 37911 000251'02 000000000000# 37912 000252'02 777777 777755 37913 000707'04 040 146 157 162 040 37914 003244'01 415 16 0 00 003255' block. ;[233] Set up ANOTHER stack context 37915 003245'01 261 17 0 00 000016 37916 003246'01 265 16 0 00 005530' saveac ;[233] Needs plenty registers for intersection jumps 37917 003247'01 254 14 0 00 000007 xsfm q3 ;[233] Get and store current processor flags 37918 003250'01 200 10 0 00 000000* move q4, bigsou## ;[233] Load up inter-section transfer address 37919 003251'01 201 11 0 00 003253' movei q5, .+2 ;[233] And the inter-section return adress 37920 003252'01 254 05 0 00 000007 xjrstf q3 ;[233] and take a giant step! 37921 003253'01 263 17 0 00 000000 ret ;[232] Get out of the block, restoring registers 37922 003254'01 263 17 0 00 000000 endbk. ;[232] End lexical SOUT% block 37923 003255'01 263 17 0 00 000000 endbk. ;[233] Release stack frame, restoring AC's 37924 003256'01 endif. ;[233] End case transaction logging 37925 003256'01 200 02 0 00 000004 move t2, t4 ;[141] Point to filespec. 37926 003257'01 254 00 0 00 002774' 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 20:02 27-Nov-23 Page 48 K20SRV MAC 26-Nov-23 15:09 Server commands. 37927 37928 ;[58] Init-Info mechanism added as edit 58. 37929 ; 37930 ; Get an "I" parameters packet from the user, record the parameters, and send 37931 ; our own back in return. This exchange is optional, but should take place 37932 ; before any server/user transaction except file transfer, where it is required 37933 ; and always takes place via the Send-Init mechanism. 37934 ; 37935 003260'01 202 02 0 00 002752* xinfo: movem t2, pktnum ; Set the parameters we just got. 37936 003261'01 260 17 0 00 002746* call spar 37937 003262'01 402 00 0 00 002744* setzm numtry 37938 003263'01 200 04 0 00 005773' move t4, [point 8, datbuf] ;[190] Respond with ours. 37939 003264'01 260 17 0 00 002750* call rpar 37940 003265'01 201 01 0 00 000131 movei t1, "Y" 37941 003266'01 200 02 0 00 003260* move t2, pktnum 37942 003267'01 260 17 0 00 003152* call spack 37943 003270'01 600 00 0 00 000000 nop ; If they don't get it, they'll ask again... 37944 003271'01 254 00 0 00 002622' jrst xxwait k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 49 K20SRV MAC 26-Nov-23 15:09 Server commands. 37945 37946 ; GTSCH -- Get String Character 37947 ; 37948 ; Alternate GETCH routine for getting a character from an ASCIZ string in 37949 ; memory. Uses global STRPTR for input string. 37950 ; 37951 ; Returns: 37952 ; +1 if no more characters left in string. 37953 ; +2 always, with NEXT containing next character, -1 if no more. 37954 ; 37955 003272'01 gtsch: entry gtsch ;[220] 37956 003272'01 134 01 0 00 002000* ildb t1, strptr ; Get next character. 37957 003273'01 322 01 0 00 003276' jumpe t1, gtschz ; If zero, must be done. 37958 37959 ; Return with character like GETCH. 37960 37961 003274'01 202 01 0 00 000000* gtschx: movem t1, next ; Put result in NEXT, as GETCH does. 37962 003275'01 254 00 0 00 001700* retskp ; Done. 37963 37964 ; "EOF" return, like GETCH 37965 37966 003276'01 400 01 0 00 000000 gtschz: setz t1, 37967 003277'01 476 00 0 00 003274* setom next 37968 003300'01 263 17 0 00 000000 ret k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 50 K20SRV MAC 26-Nov-23 15:09 Server commands. 37969 37970 ; PUTSCH 37971 ; 37972 ; Alternate PUTCH routine. Just writes the character to a string in memory. 37973 ; Call with t2/ character to write. 37974 ; 37975 003301'01 putsch: entry putsch ;[220] 37976 003301'01 136 02 0 00 003272* idpb t2, strptr ; Here's the alternate PUTCH routine. 37977 003302'01 254 00 0 00 003275* retskp ; It always succeeds. 37978 37979 37980 ; PUTTCH 37981 ; 37982 ; Another alternate PUTCH routine. Writes the character to the terminal. 37983 ; Call like PUTCH and PUTSCH. 37984 ; 37985 37986 003303'01 puttch: entry puttch ;[220] 37987 003303'01 336 00 0 00 002547* skipn local ;[186] ;[177] But only if local. 37988 003304'01 254 00 0 00 003302* retskp ;[177] ... 37989 003305'01 261 17 0 00 000001 push p, t1 37990 003306'01 201 01 0 00 000101 movei t1, .priou 37991 003307'01 104 00 0 00 000051 BOUT 37992 003310'01 320 16 0 00 003311' erjmp .+1 37993 003311'01 262 17 0 00 000001 pop p, t1 37994 003312'01 254 00 0 00 003304* retskp 37995 37996 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 51 K20SRV MAC 26-Nov-23 15:09 Get Argument 37997 subttl Get Argument 37998 37999 ; Does the following: 38000 ; 38001 ; 1) Decodes server command packet 38002 ; 2) Sets up pointers to packet 38003 ; 3) Gets first argument 38004 ; 38005 ; Returns +1 always with: 38006 ; 38007 ; t3/ Length of first argument 38008 ; t4/ pointer to first argument 38009 38010 003313'01 201 01 0 00 003301' getarg: movei t1, putsch ; Address of alternate PUTCH routine. 38011 003314'01 202 01 0 00 002632* movem t1, dest 38012 003315'01 402 00 0 00 001762* setzm strbuf ; Clear decoding area. 38013 003316'01 200 01 0 00 005776' move t1, [strbuf,,strbuf+1] 38014 003317'01 251 01 0 00 000000* blt t1, strbz 38015 003320'01 200 01 0 00 005647' move t1, [point 7, strbuf] ; Where to put the decoded string. 38016 003321'01 202 01 0 00 003301* movem t1, strptr 38017 003322'01 200 01 0 00 000004 move t1, t4 ; Pointer to data to decode. 38018 003323'01 200 02 0 00 000003 move t2, t3 ; Length. 38019 003324'01 260 17 0 00 000000* call putbuf ; Go decode the packet. 38020 003325'01 254 00 0 00 003330' ifskp. ;[194] Worked, that's promising 38021 003326'01 402 00 0 00 003314* setzm dest ; Put PUTCH back to normal. 38022 003327'01 254 00 0 00 003337' else. ;[194] Failed somehow 38023 003330'01 402 00 0 00 003326* setzm dest ;[194] Stomp whatever's driving PUTCH 38024 003331'01 334 00 0 00 000000 kermsg (, xxwait) ;[194] 38025 003332'01 254 00 0 00 003337' 38026 003333'01 265 01 0 00 003031* 38027 003334'01 000000 000046 38028 003335'01 000000000000# 38029 003336'01 254 00 0 00 002622' 38030 000713'04 103 141 156 047 164 38031 003337'01 endif. ;[194] 38032 003337'01 200 04 0 00 005647' move t4, [point 7, strbuf] ; Point to decoded string. 38033 003340'01 134 03 0 00 000004 ildb t3, t4 ; Get CHAR(length) of directory string. 38034 003341'01 305 03 0 00 000040 caige t3, 40 ;[128] If null, no need to convert. 38035 003342'01 201 03 0 00 000040 movei t3, 40 ;[128] This also catches funny cases. 38036 003343'01 275 03 0 00 000040 subi t3, 40 ; UNCHAR of that to make a number. 38037 003344'01 263 17 0 00 000000 ret k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 52 K20SRV MAC 26-Nov-23 15:09 Get Argument 38038 38039 ;[107] CWD server command (Connect to directory in DEC-20 parlance). 38040 ; 38041 ; Changes Working Directory, sends new directory name back in ACK, or else 38042 ; error packet if there's a problem. 38043 ; 38044 ; Arrive here with t4 containing pointer to argument string of form 38045 ; 38046 ; where is a single character (offset by CHAR), 38047 ; and t3 containing the length of the string. 38048 ; 38049 003345'01 260 17 0 00 003313' xgcwd: call getarg ; Get the first argument. 38050 003346'01 327 03 0 00 003356' jumpg t3, xgcwd2 ; If positive, go handle string. 38051 003347'01 322 03 0 00 003446' jumpe t3, xgcwd5 ; If null, go connect back to own directory. 38052 38053 003350'01 334 00 0 00 000000 kermsg (,xxwait) ; Negative length??? 38054 003351'01 254 00 0 00 003356' 38055 003352'01 265 01 0 00 003333* 38056 003353'01 000000 000051 38057 003354'01 000000000000# 38058 003355'01 254 00 0 00 002622' 38059 000721'04 102 141 144 040 154 38060 38061 ; Set up argument block for ACCES 38062 38063 003356'01 200 05 0 00 000004 xgcwd2: move q1, t4 ; Byte pointer to directory string. 38064 003357'01 133 03 0 00 000004 adjbp t3, t4 ; Now point to password. 38065 003360'01 134 04 0 00 000003 ildb t4, t3 ; Get its length. 38066 003361'01 200 06 0 00 000003 move q2, t3 ; Put pointer in ACCES arg block. 38067 003362'01 275 04 0 00 000040 subi t4, 40 ; UNCHAR to make it a number. 38068 003363'01 335 00 0 00 000004 skipge t4 ; Normal kind of number? 38069 003364'01 400 04 0 00 000000 setz t4, ; No, must have fallen off end, so no pswd. 38070 003365'01 400 02 0 00 000000 setz t2, ; Zero the length to make directory asciz. 38071 003366'01 137 02 0 00 000003 dpb t2, t3 ; ... 38072 003367'01 133 04 0 00 000003 adjbp t4, t3 ; Make sure password is asciz. 38073 003370'01 136 02 0 00 000004 idpb t2, t4 38074 38075 ;[193] Check to see what we might be connecting to 38076 38077 003371'01 205 01 0 00 000001 xgcwd3: movx t1, rc%emo ;[193] Exact machine only 38078 003372'01 200 02 0 00 000005 move t2, q1 ;[193] Load pointer to the string that got sent 38079 003373'01 400 03 0 00 000000 setz t3, ;[193] Not doing any directory stepping 38080 003374'01 104 00 0 00 000553 RCDIR% ;[193] See if it exists 38081 003375'01 320 12 0 00 003377' ifje. r ;[193] Catch and ignore error 38082 003376'01 254 00 0 00 003401' 38083 003377'01 200 02 0 00 000001 move t2, t1 ;[193] May be of interest to debuggers 38084 003400'01 205 01 0 00 040000 movx t1, rc%nom ;[193] So say no match 38085 003401'01 endif. ;[193] End RCDIR% error handling 38086 003401'01 607 01 0 00 040000 jxe t1, rc%nom, xgcwd4 ;[193] If no match is off, then it worked! 38087 003402'01 254 00 0 00 003434' 38088 003403'01 200 01 0 00 000005 move t1, q1 ;[193] Load pointer to the string that got sent 38089 003404'01 104 00 0 00 000120 STDEV% ;[193] Translate to a device 38090 003405'01 320 14 0 00 003407' %jsker (,xxwait) ;[193] Ship error message back in an error packet. 38091 003406'01 254 00 0 00 003412' 38092 003407'01 265 01 0 00 003215* k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 52-1 K20SRV MAC 26-Nov-23 15:09 Get Argument 38093 003410'01 000000 000000 38094 003411'01 254 00 0 00 002622' 38095 003412'01 200 01 0 00 000002 move t1, t2 ;[193] Load the device designator 38096 003413'01 104 00 0 00 000117 DVCHR% ;[193] Get its characteristics 38097 003414'01 320 14 0 00 003416' %jsker (,xxwait) ;[193] STDEV% just handed it to us... 38098 003415'01 254 00 0 00 003421' 38099 003416'01 265 01 0 00 003407* 38100 003417'01 000000 000000 38101 003420'01 254 00 0 00 002622' 38102 003421'01 135 03 0 00 005525' ldb t3, [pointr t2, dv%typ] ;[193] Pick up the device type 38103 003422'01 306 03 0 00 000015 cain t3, .dvnul ;[193] Want's to do absolutely nothing? 38104 003423'01 254 00 0 00 003461' jrst xgcwdz ;[193] Fine, then don't do anything 38105 dmove t1, [ .fhslf ;[193] Get ready to complain about ourself 38106 003424'01 120 01 0 00 005777' RCDIX3 ] ;[193] Force "Invalid structure name" 38107 003425'01 104 00 0 00 000336 SETER% ;[193] Set last error for this process 38108 003426'01 320 12 0 00 003427' erjmpr .+1 ;[193] Catch and ignore error 38109 003427'01 254 00 0 00 003431' %erker (,xxwait) ;[193] Go blat and leave 38110 003430'01 254 00 0 00 003434' 38111 003431'01 265 01 0 00 003416* 38112 003432'01 000000000000# 38113 003433'01 254 00 0 00 002622' 38114 000730'04 116 157 164 040 141 38115 38116 ; Access the directory. ** Maybe should also mount structure if necessary? 38117 38118 003434'01 200 01 0 00 005603' xgcwd4: move t1, [ac%con!<3>] ; Function is Connect, arg block has 2 words. 38119 003435'01 201 02 0 00 000005 movei t2, q1 ; Address of argument block. 38120 003436'01 474 07 0 00 000000 seto q3, ; Own job. 38121 003437'01 104 00 0 00 000552 ACCES 38122 003440'01 320 14 0 00 003442' %jsker (,xxwait) ; Send any error message in error packet. 38123 003441'01 254 00 0 00 003445' 38124 003442'01 265 01 0 00 003431* 38125 003443'01 000000 000000 38126 003444'01 254 00 0 00 002622' 38127 003445'01 254 00 0 00 003461' jrst xgcwdz ; Done connecting, go send ACK. k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 53 K20SRV MAC 26-Nov-23 15:09 Get Argument 38128 38129 ;...XGCWD, cont'd 38130 38131 38132 ; Come here to connect to own directory. 38133 38134 003446'01 200 05 0 00 000000# xgcwd5: move q1, .jilno+jobtab ;[220] Logged-in directory number. 38135 003447'01 400 06 0 00 000000 setz q2, ; No password needed 38136 003450'01 474 07 0 00 000000 seto q3, ; Own job. 38137 003451'01 201 02 0 00 000005 movei t2, q1 ; Address of arg block. 38138 003452'01 200 01 0 00 005603' move t1, [ac%con!<3>] ; Function is connect. 38139 003453'01 104 00 0 00 000552 ACCES ; Connect to own directory. 38140 003454'01 320 14 0 00 003456' %jsker (,xxwait) 38141 003455'01 254 00 0 00 003461' 38142 003456'01 265 01 0 00 003442* 38143 003457'01 000000 000000 38144 003460'01 254 00 0 00 002622' 38145 ;... k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 54 K20SRV MAC 26-Nov-23 15:09 Get Argument 38146 38147 ;...XGCWD, cont'd 38148 38149 38150 ; Done, send back ACK with directory string in it. 38151 38152 003461'01 104 00 0 00 000013 xgcwdz: GJINF 38153 003462'01 200 01 0 00 005647' move t1, [point 7, strbuf] 38154 003463'01 202 01 0 00 003321* movem t1, strptr 38155 003464'01 104 00 0 00 000041 DIRST 38156 003465'01 320 14 0 00 003467' %jsker (,xxwait) 38157 003466'01 254 00 0 00 003472' 38158 003467'01 265 01 0 00 003456* 38159 003470'01 000000 000000 38160 003471'01 254 00 0 00 002622' 38161 38162 003472'01 201 01 0 00 003272' movei t1, gtsch ; Indicate routine to be used for getting 38163 003473'01 202 01 0 00 002631* movem t1, source ; characters. 38164 003474'01 476 00 0 00 003277* setom next ; Set initial condition. 38165 003475'01 200 01 0 00 000000* move t1, maxdat ; Get a buffer full of data. 38166 003476'01 260 17 0 00 000000* call getbuf ; ... 38167 003477'01 326 01 0 00 002622' jumpn t1, xxwait ; 38168 003500'01 402 00 0 00 003473* setzm source ; Put GETCH back to normal. 38169 003501'01 200 03 0 00 000001 move t3, t1 ; Length 38170 003502'01 201 01 0 00 000131 movei t1, "Y" ; Y for Yes (ACK) 38171 003503'01 400 02 0 00 000000 setz t2, ; Packet number 0. 38172 003504'01 200 04 0 00 005773' move t4, [point 8, datbuf] ;[190] Point to string built by getbuf. 38173 003505'01 260 17 0 00 003267* call spack ; Send the ACK. 38174 003506'01 600 00 0 00 000000 nop ; Nothing much we can do here... 38175 003507'01 254 00 0 00 002622' jrst xxwait ; Done. k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 55 K20SRV MAC 26-Nov-23 15:09 Get Argument 38176 38177 ;[56] Disk USAGE server query added in edit 56. 38178 ; 38179 ; Assumes reply will fit in data field of ACK packet; does not use 38180 ; text header ("X") protocol. Sends as much of reply as will fit. 38181 ; 38182 003510'01 474 01 0 00 000000 xgdisk: seto t1, ; Get disk usage of connected directory. 38183 003511'01 104 00 0 00 000305 GTDAL% 38184 003512'01 320 14 0 00 003514' %jsker ,r 38185 003513'01 254 00 0 00 003517' 38186 003514'01 265 01 0 00 003467* 38187 003515'01 000000000000# 38188 003516'01 254 00 0 00 003217* 38189 000735'04 103 141 156 047 164 38190 003517'01 120 05 0 00 000001 dmove q1, t1 ; Save the numbers in q1,q2. 38191 38192 003520'01 200 01 0 00 005647' move t1, [point 7, strbuf] ;[188] String pointer to data field. 38193 003521'01 202 01 0 00 003463* movem t1, strptr ;[103] 38194 003522'01 120 02 0 00 000000# smsg () ;[188] Inital part of response 38195 003523'01 260 17 0 00 001570* 38196 000253'02 000000000000# 38197 000254'02 777777 777771 38198 000742'04 121 165 157 164 141 38199 38200 003524'01 200 02 0 00 000005 move t2, q1 ; Quota, or "+Inf" 38201 003525'01 305 02 0 00 005747' caige t2, [^d100000000] ;[194] Big? 38202 003526'01 254 00 0 00 003532' ifskp. ;[194] Yep, really big 38203 003527'01 120 02 0 00 000000# smsg (<+Inf>) ;[194] So say that differently 38204 003530'01 260 17 0 00 003523* 38205 000255'02 000000000000# 38206 000256'02 777777 777774 38207 000744'04 053 111 156 146 000 38208 003531'01 254 00 0 00 003535' else. ;[194] Otherwise, comprehensible limit 38209 003532'01 201 03 0 00 000012 movei t3, ^d10 ; in decimal 38210 003533'01 104 00 0 00 000224 NOUT% 38211 003534'01 320 14 0 00 003545' erjmps xgdis2 ;[194] Catch and suppress errpr 38212 003535'01 endif. ;[194] 38213 38214 003535'01 120 02 0 00 000000# smsg (<, used: >) ;[194] How much we're using of it 38215 003536'01 260 17 0 00 003530* 38216 000257'02 000000000000# 38217 000260'02 777777 777770 38218 000745'04 054 040 165 163 145 38219 38220 003537'01 200 02 0 00 000006 move t2, q2 ; Pages used, 38221 003540'01 201 03 0 00 000012 movei t3, ^d10 ; in decimal 38222 003541'01 104 00 0 00 000224 NOUT% 38223 003542'01 320 14 0 00 003545' erjmps xgdis2 ;[194] Catch and suppress error 38224 38225 003543'01 120 02 0 00 000000# smsg (< (pages)>) ; Specify units 38226 003544'01 260 17 0 00 003536* 38227 000261'02 000000000000# 38228 000262'02 777777 777770 38229 000747'04 040 050 160 141 147 38230 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 55-1 K20SRV MAC 26-Nov-23 15:09 Get Argument 38231 003545'01 200 02 0 00 003521* xgdis2: move t2, strptr ;[103] Check length 38232 003546'01 250 01 0 00 000002 exch t1, t2 38233 003547'01 260 17 0 00 000000* call subbp 38234 003550'01 334 00 0 00 000000 kermsg (,r) ;[188] 38235 003551'01 254 00 0 00 003556' 38236 003552'01 265 01 0 00 003352* 38237 003553'01 000000 000027 38238 003554'01 000000000000# 38239 003555'01 254 00 0 00 003516* 38240 000751'04 163 165 142 142 160 38241 003556'01 400 04 0 00 000000 setz t4, ;[188] Cons up a .CHNUL 38242 003557'01 136 04 0 00 000002 idpb t4, t2 ; Done constructing string, make it asciz 38243 003560'01 200 05 0 00 000000* move q1, spsiz ; Is the string bigger than max size to send? 38244 003561'01 275 05 0 00 000005 subi q1, 5 38245 003562'01 307 05 0 03 000000 caig q1, (t3) ; (it should always fit). 38246 003563'01 200 03 0 00 000005 move t3, q1 ; Yes, so cut it off at the limit. 38247 ;.. k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 56 K20SRV MAC 26-Nov-23 15:09 Get Argument 38248 38249 ;...XGDISK, cont'd 38250 38251 38252 ;[103] Begin Change: Use standard packet filling technique to send this. 38253 38254 003564'01 201 01 0 00 003272' movei t1, gtsch ; Indicate routine to be used for getting 38255 003565'01 202 01 0 00 003500* movem t1, source ; characters. 38256 003566'01 476 00 0 00 003474* setom next ; Set initial condition. 38257 003567'01 200 01 0 00 003475* move t1, maxdat ; Get a buffer full of data. 38258 003570'01 260 17 0 00 003476* call getbuf ; ... 38259 003571'01 326 01 0 00 002622' jumpn t1, xxwait ; 38260 003572'01 200 03 0 00 000001 move t3, t1 ; Set up length. 38261 003573'01 402 00 0 00 003565* setzm source ; Put GETCH back to normal. 38262 38263 ;[103] End Change. Now send the packet. 38264 38265 003574'01 201 01 0 00 000131 xgdisz: movei t1, "Y" ; Formulate the ACK 38266 003575'01 400 02 0 00 000000 setz t2, ; (Packet number should be 0, right?) 38267 003576'01 200 04 0 00 005773' move t4, [point 8, datbuf] ;[190] The data itself 38268 003577'01 260 17 0 00 003505* call spack ; Send it off. 38269 003600'01 600 00 0 00 000000 nop ;* What if it fails? 38270 003601'01 254 00 0 00 002622' jrst xxwait k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 57 K20SRV MAC 26-Nov-23 15:09 Get Argument 38271 38272 ; 38273 ;[188] PWD server query; prints working directory. 38274 ; 38275 ; Assumes reply will fit in data field of ACK packet; does not use 38276 ; text header ("X") protocol. Sends as much of reply as will fit. 38277 ; 38278 ; N.B., For Unix fans and Windows heros, be aware that the so-called 38279 ; working directory is NOT the same thing on Tops-20! It is the 38280 ; connected directory, which changes your access rights to that 38281 ; directory and possible group memberships. A connected directory 38282 ; is also job wide, not process wide. 38283 ; 38284 ; Looks remarkably like xgdisk... 38285 38286 003602'01 104 00 0 00 000013 xgpwd: GJINF% ; Get current job information. 38287 003603'01 320 14 0 00 003605' %jsker ,r 38288 003604'01 254 00 0 00 003610' 38289 003605'01 265 01 0 00 003514* 38290 003606'01 000000000000# 38291 003607'01 254 00 0 00 003555* 38292 000754'04 103 141 156 047 164 38293 003610'01 200 01 0 00 005647' move t1, [point 7, strbuf] ; String pointer to data field. 38294 003611'01 202 01 0 00 003545* movem t1, strptr ; Also for packetizer 38295 remark t2, ; Already has the connected directory 38296 003612'01 104 00 0 00 000041 DIRST% ; Translate into a string 38297 003613'01 320 14 0 00 003615' %jsker ,r 38298 003614'01 254 00 0 00 003620' 38299 003615'01 265 01 0 00 003605* 38300 003616'01 000000000000# 38301 003617'01 254 00 0 00 003607* 38302 000763'04 103 157 165 154 144 38303 38304 remark ^D<6+1+1+39+1=48> ;Maximum directory string length 38305 38306 003620'01 200 02 0 00 003611* move t2, strptr ; Check the length in case of 'micropacket' 38307 003621'01 250 01 0 00 000002 exch t1, t2 ; Beginning pointer in t1, final in t2 38308 003622'01 260 17 0 00 003547* call subbp ; Subtract to get length 38309 003623'01 334 00 0 00 000000 kermsg (,r) ;Really unlikely, see above 38310 003624'01 254 00 0 00 003631' 38311 003625'01 265 01 0 00 003552* 38312 003626'01 000000 000027 38313 003627'01 000000000000# 38314 003630'01 254 00 0 00 003617* 38315 000776'04 163 165 142 142 160 38316 38317 003631'01 400 04 0 00 000000 setz t4, ; Cons up a .CHNUL 38318 003632'01 136 04 0 00 000002 idpb t4, t2 ; Tie off the string 38319 003633'01 200 05 0 00 003560* move q1, spsiz ; Is the string bigger than max size to send? 38320 003634'01 275 05 0 00 000005 subi q1, 5 38321 003635'01 307 05 0 03 000000 caig q1, (t3) ; (it should always fit). 38322 003636'01 200 03 0 00 000005 move t3, q1 ; Yes, so cut it off at the limit. 38323 38324 003637'01 201 01 0 00 003272' movei t1, gtsch ; Indicate routine to be used for getting 38325 003640'01 202 01 0 00 003573* movem t1, source ; characters. k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 57-1 K20SRV MAC 26-Nov-23 15:09 Get Argument 38326 003641'01 476 00 0 00 003566* setom next ; Set initial condition. 38327 003642'01 200 01 0 00 003567* move t1, maxdat ; Get a buffer full of data. 38328 003643'01 260 17 0 00 003570* call getbuf ; ... 38329 003644'01 326 01 0 00 002622' jumpn t1, xxwait ; 38330 003645'01 200 03 0 00 000001 move t3, t1 ; Set up length. 38331 003646'01 402 00 0 00 003640* setzm source ; Put GETCH back to normal. 38332 ; Now send the packet. 38333 003647'01 201 01 0 00 000131 movei t1, "Y" ; Formulate the ACK 38334 003650'01 400 02 0 00 000000 setz t2, ; (Packet number should be 0, right?) 38335 003651'01 200 04 0 00 005773' move t4, [point 8, datbuf] ;[190] The data itself 38336 003652'01 260 17 0 00 003577* call spack ; Send it off. 38337 003653'01 600 00 0 00 000000 nop ;* What if it fails? 38338 003654'01 254 00 0 00 002622' jrst xxwait 38339 38340 ;[188] End Code Insertion k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 58 K20SRV MAC 26-Nov-23 15:09 Get Argument 38341 38342 ; Define 30 bit one word global ASCII pointer to another section 38343 38344 extern hlpntr ;[194] One word global ASCII pointer 38345 extern srvhlp ;[194] In k20hlp in section one 38346 38347 000000000000# xhlptr==hlpntr!srvhlp ;[194] Forces LINK to do a polish fix up 38348 38349 003655'01 336 00 0 00 003235* xgstat:ifmn. tlgjfn ;[233] Doing transaction logging? 38350 003656'01 254 00 0 00 003670' 38351 003657'01 415 16 0 00 003670' block. ;[233] Get a stack frame 38352 003660'01 261 17 0 00 000016 38353 003661'01 265 16 0 00 005543' saveac ;[233] Save even the temporaries 38354 003662'01 476 00 0 00 003230* setom scrlft ;[233] Suppress the trailing carriage return 38355 003663'01 265 01 0 00 003231* wtlog(,) ;[233] 38356 003664'01 000000000000# 38357 003665'01 777777 777735 38358 003666'01 000000 000000 38359 001001'04 123 145 156 144 151 38360 003667'01 263 17 0 00 000000 endbk. ;[233] Release stack frame, restoring AC's 38361 003670'01 endif. ;[233] 38362 38363 003670'01 260 17 0 00 002211* call $srvt ;[189] Build the text in a buffer 38364 003671'01 400 02 0 00 000000 setz t2, ;[189] Cons up a .chnul 38365 003672'01 136 02 0 00 000001 idpb t2,t1 ;[189] Tied off the 'string' 38366 003673'01 136 02 0 00 000001 idpb t2,t1 ;[189] Tie it off some more ... 38367 003674'01 200 01 0 00 006001' move t1,[point 7,statxt];[233] Load pointer to constructed text 38368 003675'01 254 00 0 00 003712' jrst xghel1 ;[233] Join common code 38369 38370 003676'01 336 00 0 00 003655* xghelp: ifmn. tlgjfn ;[233] Doing transaction logging? 38371 003677'01 254 00 0 00 003711' 38372 003700'01 415 16 0 00 003711' block. ;[233] Get a stack frame 38373 003701'01 261 17 0 00 000016 38374 003702'01 265 16 0 00 005543' saveac ;[233] Save even the temporaries 38375 003703'01 476 00 0 00 003662* setom scrlft ;[233] Suppress the trailing carriage return 38376 003704'01 265 01 0 00 003663* wtlog(,) ;[233] 38377 003705'01 000000000000# 38378 003706'01 777777 777744 38379 003707'01 000000 000000 38380 001011'04 123 145 156 144 151 38381 003710'01 263 17 0 00 000000 endbk. ;[233] Release stack frame, restoring AC's 38382 003711'01 endif. ;[233] 38383 003711'01 200 01 0 00 006002' move t1, [ xhlptr ] ;[194] Load pointer to general remote help text 38384 38385 003712'01 xghel1: remark ;[233] Common link 38386 003712'01 202 01 0 00 003620* movem t1, strptr ; Put pointer here, where 38387 003713'01 201 01 0 00 003272' movei t1, gtsch ; routine for getting chars from a string 38388 003714'01 202 01 0 00 003646* movem t1, source ; can find it. 38389 003715'01 476 00 0 00 003641* setom next ; Init char lookahead 38390 003716'01 476 00 0 00 003221* setom xflg ; Send with X rather than F header. 38391 003717'01 260 17 0 00 003013* call $sends ; Go send the text like a file 38392 003720'01 600 00 0 00 000000 nop 38393 003721'01 402 00 0 00 003714* setzm source ;[121] Put send source back to normal. 38394 003722'01 254 00 0 00 002622' jrst xxwait k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 59 K20SRV MAC 26-Nov-23 15:09 Get Argument 38395 38396 ;[116] DIRECTORY server command. 38397 38398 ; DIRCH 38399 ; 38400 ; Alternate GETCH routine for getting characters from a directory listing 38401 ; in a memory buffer, and for refilling the buffer when it gets empty. 38402 ; 38403 003723'01 dirch: entry dirch ;[186] 38404 003723'01 134 01 0 00 000000# ildb t1, getptr ; Get character. 38405 003724'01 332 00 0 00 000001 skipe t1 ; Null? 38406 003725'01 254 00 0 00 003735' jrst dirchx ; No, return the character. 38407 38408 ; No characters in buffer, try to refill. 38409 38410 003726'01 260 17 0 00 005373' dirch2: call dmpbuf ; If so, reset the buffer pointers, etc. 38411 003727'01 260 17 0 00 001452' call dirlst ; And try to fill the listing buffer again. 38412 003730'01 322 01 0 00 003737' jumpe t1, dirchz ; No more, done. 38413 003731'01 200 01 0 00 006003' move t1, [point 7, srvbuf] ; Get new listing buffer pointer. 38414 003732'01 202 01 0 00 000000# movem t1, getptr ; Save it for getting characters. 38415 003733'01 134 01 0 00 000000# ildb t1, getptr ; Get first character of new buffer. 38416 003734'01 322 01 0 00 003737' jumpe t1, dirchz ; This shouldn't happen... 38417 38418 ; Return with character like GETCH. 38419 38420 003735'01 202 01 0 00 003715* dirchx: movem t1, next 38421 003736'01 254 00 0 00 003312* retskp 38422 38423 ; "EOF" return, like GETCH. 38424 38425 003737'01 400 01 0 00 000000 dirchz: setz t1, 38426 003740'01 476 00 0 00 003735* setom next 38427 003741'01 263 17 0 00 000000 ret 38428 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 60 K20SRV MAC 26-Nov-23 15:09 XGDIR - Server provides directory listing. 38429 subttl XGDIR - Server provides directory listing. 38430 38431 003742'01 100100 777775 sdirb2: gj%old!gj%ifg!.gjall ;[191] Flags,,All generations. 38432 003743'01 377777 377777 .nulio,,.nulio ;[191] No i/o. 38433 repeat <^d8>,<0> ;[191] No defaults; nothing 38434 003744'01 000000 000000 38435 003745'01 000000 000000 38436 003746'01 000000 000000 38437 003747'01 000000 000000 38438 003750'01 000000 000000 38439 003751'01 000000 000000 38440 003752'01 000000 000000 38441 003753'01 000000 000000 38442 38443 ;[190] Prologue rewritten to not store in (write-protected!) code .psect 38444 38445 003754'01 260 17 0 00 003313' xgdir: call getarg ; Get the first (& only) argument 38446 003755'01 327 03 0 00 003777' jumpg t3, xgdir2 ; Got something, go do it. 38447 003756'01 326 03 0 00 003771' ife. t3 ;[190] Got nothing, default the directory 38448 003757'01 265 16 0 00 002404* anstkv(t4,^d4) ;[190] Create an anonymous stkvar 38449 003760'01 000000 000004 38450 003761'01 415 04 0 17 777773 38451 003762'01 120 01 0 00 006004' dmove t1,[ exp ascii "*.*.*", 0 ] ;[190] Load default file spec 38452 003763'01 124 01 0 04 000000 dmovem t1,0(t4) ;[190] Stomp into buffer 38453 003764'01 403 01 0 00 000002 setzb t1,t2 ;[190] Cons up ten .CHNUL's 38454 003765'01 124 01 0 04 000002 dmovem t1,2(t4) ;[190] Stomp rest of buffer 38455 003766'01 201 03 0 00 000005 movei t3,^d5 ;[190] Five characters long 38456 003767'01 505 04 0 00 440700 hrli t4,(point 7,) ;[190] Now have an ASCII pointer 38457 003770'01 254 00 0 00 003777' jrst xgdir2 ;[190] Go get a file specification 38458 003771'01 endif. ;[190] End case defaulting directory 38459 38460 003771'01 334 00 0 00 000000 kermsg (,xxwait) ; Got junk. 38461 003772'01 254 00 0 00 003777' 38462 003773'01 265 01 0 00 003625* 38463 003774'01 000000 000060 38464 003775'01 000000000000# 38465 003776'01 254 00 0 00 002622' 38466 001017'04 102 141 144 040 154 38467 38468 ; Get JFN on the string we got, supply normal defaults like Exec does. 38469 38470 003777'01 200 02 0 00 000004 xgdir2: move t2, t4 ; Point to filespec 38471 004000'01 133 03 0 00 000004 adjbp t3, t4 ; Make it asciz 38472 004001'01 400 04 0 00 000000 setz t4, 38473 004002'01 136 04 0 00 000003 idpb t4, t3 38474 004003'01 200 04 0 00 000002 move t4, t2 ;[191] Save the string pointer 38475 004004'01 201 01 0 00 004061' movei t1, sdirbk ; JFN block containing flags & defaults. 38476 004005'01 104 00 0 00 000020 GTJFN ; Do long form GTJFN. 38477 004006'01 320 12 0 00 004010' ifje. r ;[191] Catch error 38478 004007'01 254 00 0 00 004026' 38479 004010'01 302 01 0 00 600114 caie t1, GJFX32 ;[191] No files matched? 38480 004011'01 254 00 0 00 004013' %erker (,xxwait) ;[191] No, just send the error 38481 004012'01 254 00 0 00 004016' 38482 004013'01 265 01 0 00 003615* 38483 004014'01 000000 000000 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 60-1 K20SRV MAC 26-Nov-23 15:09 XGDIR - Server provides directory listing. 38484 004015'01 254 00 0 00 002622' 38485 004016'01 201 01 0 00 003742' movei t1, sdirb2 ;[191] Try not defaulting anything 38486 004017'01 200 02 0 00 000004 move t2, t4 ;[191] Restore the string pointer 38487 004020'01 104 00 0 00 000020 GTJFN% ;[191] Attempt another long form GTJFN. 38488 004021'01 320 14 0 00 004023' %jsker (,xxwait) ;[191] No such luck, just give up 38489 004022'01 254 00 0 00 004026' 38490 004023'01 265 01 0 00 004013* 38491 004024'01 000000 000000 38492 004025'01 254 00 0 00 002622' 38493 004026'01 endif. ;[191] End GTJFN% recovery 38494 004026'01 260 17 0 00 003005* call isnulj ;[191] Gave us NUL:? 38495 004027'01 600 00 0 00 000000 nop ;[191] Didn't, that's fine. 38496 remark t1, .nulio ;[191] Did, that's fine, too. 38497 38498 004030'01 336 00 0 00 003676* ifmn. tlgjfn ;[233] Doing transaction logging? 38499 004031'01 254 00 0 00 004045' 38500 004032'01 415 16 0 00 004045' block. ;[233] Get a stack frame 38501 004033'01 261 17 0 00 000016 38502 004034'01 265 16 0 00 005543' saveac ;[233] Save even the temporaries 38503 004035'01 552 01 0 00 000000# hrrzm t1,tmpjfn ;[233] Give it how %wtlog wants it .. 38504 004036'01 476 00 0 00 003703* setom scrlft ;[233] Suppress the trailing carriage return 38505 004037'01 265 01 0 00 003704* wtlog(,tmpjfn) ;[233] Sigh... 38506 004040'01 000000000000# 38507 004041'01 777777 777736 38508 004042'01 000000000000# 38509 001027'04 123 145 156 144 151 38510 004043'01 402 00 0 00 000000# setzm tmpjfn ;[233] Stomp it, done. 38511 004044'01 263 17 0 00 000000 endbk. ;[233] Release stack frame, restoring AC's 38512 004045'01 endif. ;[233] 38513 38514 004045'01 200 02 0 00 000001 move t2, t1 ; Construct heading in string buffer. 38515 004046'01 402 00 0 00 002633* setzm ffunc ; Function is "directory". 38516 004047'01 260 17 0 00 001420' call dirhdr 38517 004050'01 200 01 0 00 006006' move t1, [point 7, srvbuf] ; Point to beginning of text buffer. 38518 004051'01 202 01 0 00 000000# movem t1, getptr ; This is where we'll get characters from. 38519 004052'01 201 01 0 00 003723' movei t1, dirch ; And this routine will do the getting. 38520 004053'01 202 01 0 00 003721* movem t1, source ; ... 38521 004054'01 476 00 0 00 003740* setom next ; Initialize character lookahead. 38522 004055'01 476 00 0 00 003716* setom xflg ; This produces some desired effects... 38523 004056'01 260 17 0 00 003717* call $sends ; Go send the listing like it's a file. 38524 004057'01 600 00 0 00 000000 nop ; Ignore any skipping... 38525 004060'01 254 00 0 00 002622' jrst xxwait 38526 38527 004061'01 100100 777775 sdirbk: gj%old!gj%ifg!.gjall ; Flags,,All generations. 38528 004062'01 377777 377777 .nulio,,.nulio ; No i/o. 38529 repeat <2>,<0> ; Default device and directory. 38530 004063'01 000000 000000 38531 004064'01 000000 000000 38532 repeat <2>,)> ;Default name is "*.*" 38533 004065'01 000000000000# 38534 001036'04 052 000 000 000 000 38535 004066'01 000000000000# 38536 001037'04 052 000 000 000 000 38537 38538 repeat <4>,<0> ; Nothing special for the rest. k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 60-2 K20SRV MAC 26-Nov-23 15:09 XGDIR - Server provides directory listing. 38539 004067'01 000000 000000 38540 004070'01 000000 000000 38541 004071'01 000000 000000 38542 004072'01 000000 000000 38543 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 61 K20SRV MAC 26-Nov-23 15:09 XGDEL - Server provides file deletion [118] 38544 subttl XGDEL - Server provides file deletion [118] 38545 38546 004073'01 100100 777775 sdelbk: gj%old!gj%ifg!.gjall ; Flags,,All generations. 38547 004074'01 377777 377777 .nulio,,.nulio ; No i/o. 38548 repeat <^d8>,<0> ; No other defaults. 38549 004075'01 000000 000000 38550 004076'01 000000 000000 38551 004077'01 000000 000000 38552 004100'01 000000 000000 38553 004101'01 000000 000000 38554 004102'01 000000 000000 38555 004103'01 000000 000000 38556 004104'01 000000 000000 38557 38558 38559 004105'01 260 17 0 00 003313' xgdel: call getarg ; Get the first (& only) argument 38560 004106'01 327 03 0 00 004115' jumpg t3, xgdel2 ; Got something, go do it. 38561 38562 004107'01 334 00 0 00 000000 kermsg (,xxwait) 38563 004110'01 254 00 0 00 004115' 38564 004111'01 265 01 0 00 003773* 38565 004112'01 000000 000051 38566 004113'01 000000000000# 38567 004114'01 254 00 0 00 002622' 38568 001040'04 116 157 040 146 151 38569 38570 ; Get JFN on the string we got, supply normal defaults like Exec does. 38571 38572 004115'01 200 02 0 00 000004 xgdel2: move t2, t4 ; Point to filespec 38573 004116'01 133 03 0 00 000004 adjbp t3, t4 ; Make it asciz 38574 004117'01 400 04 0 00 000000 setz t4, 38575 004120'01 136 04 0 00 000003 idpb t4, t3 38576 004121'01 201 01 0 00 004073' movei t1, sdelbk ; JFN block containing flags & defaults. 38577 004122'01 104 00 0 00 000020 GTJFN ; Do long form GTJFN. 38578 004123'01 320 14 0 00 004125' %jsker (,xxwait) ; Send error packet if we can't. 38579 004124'01 254 00 0 00 004130' 38580 004125'01 265 01 0 00 004023* 38581 004126'01 000000 000000 38582 004127'01 254 00 0 00 002622' 38583 004130'01 260 17 0 00 004026* call isnulj ;[191] Gave us NUL: 38584 004131'01 600 00 0 00 000000 nop ;[191] Didn't, that's fine. 38585 38586 004132'01 336 00 0 00 004030* ifmn. tlgjfn ;[233] Doing transaction logging? 38587 004133'01 254 00 0 00 004147' 38588 004134'01 415 16 0 00 004147' block. ;[233] Get a stack frame 38589 004135'01 261 17 0 00 000016 38590 004136'01 265 16 0 00 005543' saveac ;[233] Save even the temporaries 38591 004137'01 552 01 0 00 000000# hrrzm t1,tmpjfn ;[233] Give it how %wtlog wants it .. 38592 004140'01 476 00 0 00 004036* setom scrlft ;[233] Suppress the trailing carriage return 38593 004141'01 265 01 0 00 004037* wtlog(,tmpjfn) ;[233] Sigh... 38594 004142'01 000000000000# 38595 004143'01 777777 777767 38596 004144'01 000000000000# 38597 001047'04 104 145 154 145 164 38598 004145'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 20:02 27-Nov-23 Page 61-1 K20SRV MAC 26-Nov-23 15:09 XGDEL - Server provides file deletion [118] 38599 004146'01 263 17 0 00 000000 endbk. ;[233] Release stack frame, restoring AC's 38600 004147'01 endif. ;[233] 38601 38602 remark t1, .nulio ;[191] Is, that's fine, too. 38603 004147'01 200 02 0 00 000001 move t2, t1 ; Construct heading in string buffer. 38604 004150'01 201 01 0 00 005233' movei t1, delfil ;[194] ; Routine for deleting a file. 38605 004151'01 202 01 0 00 004046* movem t1, ffunc ; Make it the file function. 38606 004152'01 260 17 0 00 001420' call dirhdr ; Start things off. 38607 004153'01 200 01 0 00 006007' move t1, [point 7, srvbuf] ; Point to beginning of text buffer. 38608 004154'01 202 01 0 00 000000# movem t1, getptr ; This is where we'll get characters from. 38609 004155'01 201 01 0 00 003723' movei t1, dirch ; And this routine will do the getting. 38610 004156'01 202 01 0 00 004053* movem t1, source ; ... 38611 004157'01 476 00 0 00 004054* setom next ; Initialize character lookahead. 38612 004160'01 476 00 0 00 004055* setom xflg ; This produces some desired effects... 38613 004161'01 260 17 0 00 004056* call $sends ; Go send the listing like it's a file. 38614 004162'01 600 00 0 00 000000 nop ; Ignore any skipping... 38615 004163'01 254 00 0 00 002622' jrst xxwait 38616 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 62 K20SRV MAC 26-Nov-23 15:09 LOCAL RUN command parsing 38617 subttl LOCAL RUN command parsing 38618 38619 ; JFN block for RUN command. 38620 38621 chgsec(code,const) ;;Tables and chained fdb's go in const 38622 000263'02 100120 000000 runbk: gj%old!gj%ifg!gj%flg ; Flag bits,,most recent generation. 38623 000264'02 000100 000101 .priin,,.priou ; COMND i/o. 38624 repeat 3,<0> ; No defaults, except 38625 000265'02 000000 000000 38626 000266'02 000000 000000 38627 000267'02 000000 000000 38628 000270'02 000000000000# cascii() ; file type. 38629 001051'04 105 130 105 000 000 38630 repeat 2,<0> ; No defaults, except 38631 000271'02 000000 000000 38632 000272'02 000000 000000 38633 000010 runbkl==<.-runbk> ; Length of this GTJFN argument block. 38634 38635 000273'02 006000 000000 yrufdb: flddb. .cmfil 38636 000274'02 000000 000000 38637 000275'02 006004 000300' yrrfdb: flddb. .cmfil,,,,,yrrfd1 38638 000276'02 000000 000000 38639 000277'02 44 07 0 00 000463' 38640 000300'02 010004 000000 yrrfd1: flddb. .cmcfm,,,,, 38641 000301'02 000000 000000 38642 000302'02 44 07 0 00 000470' 38643 retsec 38644 cleans() 38645 38646 ; Parse local RUN command. 38647 38648 004164'01 .yrun: entry .yrun ; Can be invoked as top-level by k20par 38649 004164'01 200 01 0 00 005654' movx t1, cz%ncl!.fhslf ; Close any nonopen JFNs. 38650 004165'01 104 00 0 00 000034 CLZFF 38651 004166'01 200 16 0 00 000000# guide ; Issue guide word. 38652 004167'01 260 17 0 00 002243* 38653 000303'02 000000000000# 38654 001052'04 146 151 154 145 000 38655 004170'01 200 01 0 00 006010' move t1, [runbk,,cjfnbk] ; Insert our file parsing defaults. 38656 004171'01 251 01 0 00 000000# blt t1, cjfnbk+runbkl ; Same as for DELETE. 38657 004172'01 201 01 0 00 000000# movei t1, yrufdb 38658 004173'01 332 00 0 00 000000# skipe rufork ; Already have a fork? 38659 004174'01 201 01 0 00 000000# movei t1, yrrfdb ; Yes, let them rerun it. 38660 004175'01 260 17 0 00 002247* call rfield ; Parse an existing file specification. 38661 004176'01 135 03 0 00 005524' ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 38662 004177'01 302 03 0 00 000010 caie t3, .cmcfm ;[194] Confirmation? 38663 004200'01 254 00 0 00 004203' ifskp. ;[194] It is 38664 004201'01 476 00 0 00 002361* setom pars3 ; Yes, set "jfn" to -1. 38665 004202'01 263 17 0 00 000000 ret 38666 004203'01 endif. ;[194] 38667 38668 004203'01 265 16 0 00 005606' saveac ;[220] Will need some extra registers 38669 004204'01 550 05 0 00 000002 hrrz q1, t2 ;[220] Save the JFN 38670 004205'01 510 06 0 00 000002 hllz q2, t2 ;[220] Save the flags 38671 004206'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 20:02 27-Nov-23 Page 62-1 K20SRV MAC 26-Nov-23 15:09 LOCAL RUN command parsing 38672 004207'01 260 17 0 00 004723' call isdird ;[220] Only run files from structures 38673 004210'01 254 00 0 00 004221' ifskp. ;[220] It is 38674 004211'01 120 07 0 00 000001 dmove q3, t1 ;[220] Save device information 38675 004212'01 260 17 0 00 002356* confrm ; Get confirmation 38676 004213'01 135 03 0 00 005525' ldb t3,[pointr(t2,dv%typ)] ;[220] Pick up device type 38677 004214'01 306 03 0 00 000015 cain t3, .dvnul ;[220] NUL:? 38678 004215'01 201 05 0 00 377777 movei q1, .nulio ;[220] Yes, JFN has already been tossed 38679 004216'01 202 05 0 00 004201* movem q1, pars3 ;[220] Save some kind of JFN 38680 004217'01 124 07 0 00 001042* dmovem q3, pars4 ;[220] Also device information, if useful 38681 004220'01 263 17 0 00 000000 ret ;[220] Done 38682 004221'01 endif. ;[220] 38683 ;[220] Otherwise, start whining 38684 004221'01 200 01 0 00 000000# emsg 38685 004222'01 104 00 0 00 000313 38686 000304'02 000000000000# 38687 001053'04 103 141 156 047 164 38688 004223'01 201 01 0 00 000101 movei t1, .priou ;[220] Contine on terminal 38689 004224'01 200 02 0 00 000005 move t2, q1 ;[220] Load the JFN, no flags 38690 004225'01 403 03 0 00 000004 setzb t3, t4 ;[220] Standard formating, no goofy prefix 38691 004226'01 104 00 0 00 000030 JFNS% ;[220] Type it 38692 004227'01 320 12 0 00 004231' %jserr(,) ;[220] Odd, but carry on 38693 004230'01 254 00 0 00 004234' 38694 004231'01 265 01 0 00 003166* 38695 004232'01 000000000000# 38696 004233'01 254 00 0 00 004234' 38697 001060'04 125 156 141 142 154 38698 004234'01 200 01 0 00 000005 move t1, q1 ;[220] Get the JFN 38699 004235'01 104 00 0 00 000023 RLJFN% ;[220] Toss it 38700 004236'01 320 12 0 00 004240' %jserr(,) ;[220] Odd, but carry on 38701 004237'01 254 00 0 00 004243' 38702 004240'01 265 01 0 00 004231* 38703 004241'01 000000000000# 38704 004242'01 254 00 0 00 004243' 38705 001067'04 125 156 141 142 154 38706 004243'01 254 00 0 00 002355* callret cmder1 ;[220] Allow a reparse (^H) 38707 38708 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 63 K20SRV MAC 26-Nov-23 15:09 LOCAL RUN command executon 38709 subttl LOCAL RUN command executon 38710 38711 ; Execute local RUN command. 38712 38713 ;[220] Begin code insertion 38714 chgsec(code,const) ; Code to run from registers 38715 000305'02 nulprg: remark ; Pretend we did a GET% into just the AC's 38716 000000 phase 0 ; Runs in accumulators 38717 000000 000000 601405 LSTRX1 ;ac0 No last error 38718 000001 000000 000000 0 ;t1 Argument to PSOUT% 38719 000002 000000 000000 0 ;t2 Argument to SETER% 38720 000003 104 00 0 00 000147 nulent: RESET% ;t3 Reset the world 38721 000004 320 12 0 00 000014 erjmpr nulend ;t4 It *CAN* fail, actually.. 38722 000005 201 01 0 00 400000 movei t1,.fhslf ;q1 This process 38723 000006 200 02 0 00 000000 move t2, f ;q2 No last error (RESET% leaves it in an odd way) 38724 000007 104 00 0 00 000336 SETER% ;q3 Set it 38725 000010 320 12 0 00 000014 erjmpr nulend ;p1 Or not 38726 000011 561 01 0 00 000016 hrroi t1,nulmsg ;p2 Load Tops-20 pointer to text message 38727 000012 104 00 0 00 000076 PSOUT% ;p3 Type it 38728 000013 320 12 0 00 000014 erjmpr nulend ;p4 Or not 38729 000014 104 00 0 00 000170 nulend: HALTF% ;p5 Stop 38730 000015 254 00 0 00 000003 jrst nulent ;p6 Or do it again 38731 000016 472531 435100 nulmsg: BYTE (7) "N","U","L",":",.chspc ;cx 38732 000017 476261 505000 BYTE (7) "O","K",.chcrt,.chlfd,.chnul ;p 38733 000325'02 dephase ; Done with our little NUL: program 38734 retsec ; Restore .psect's 38735 ;[220] End code insertion 38736 38737 004244'01 $yrun: entry $yrun ;[194] 38738 004244'01 337 00 0 00 004216* skipg pars3 ; Re-run current fork? 38739 004245'01 254 00 0 00 004337' jrst $yrun2 ; Yes, do do that. 38740 38741 004246'01 333 01 0 00 000000# skiple t1, rufork ; No, do we have a current fork to kill? 38742 004247'01 104 00 0 00 000153 KFORK ; Yes, try to kill it. 38743 004250'01 320 12 0 00 004252' %jserr (,r) ;[194] 38744 004251'01 254 00 0 00 004255' 38745 004252'01 265 01 0 00 004240* 38746 004253'01 000000000000# 38747 004254'01 254 00 0 00 003630* 38748 001077'04 103 141 156 047 164 38749 004255'01 403 01 0 00 000002 setzb t1, t2 ; Take care of capabilities below. 38750 004256'01 104 00 0 00 000152 CFORK ; Make a fork. 38751 004257'01 320 12 0 00 004261' %jserr (,r); 38752 004260'01 254 00 0 00 004264' 38753 004261'01 265 01 0 00 004252* 38754 004262'01 000000000000# 38755 004263'01 254 00 0 00 004254* 38756 001106'04 103 141 156 047 164 38757 004264'01 202 01 0 00 000000# movem t1, rufork ; Remember the fork handle. 38758 004265'01 200 04 0 00 000001 move t4, t1 ;[220] Keep the handle handy 38759 004266'01 336 02 0 00 000000* skipn t2, capas ;[169] Get our capabilities. 38760 004267'01 200 02 0 00 000000# move t2, mycaps+1 ;[187] Use start up enabled caps, instead 38761 004270'01 630 02 0 00 006011' andx t2,badmsk ;[186] Don't turn on unsafe bits 38762 004271'01 621 02 0 00 040000 txz t2, sc%log ;[169] Do not allow inferior to log us out 38763 004272'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 20:02 27-Nov-23 Page 63-1 K20SRV MAC 26-Nov-23 15:09 LOCAL RUN command executon 38764 004273'01 200 03 0 00 000002 move t3, t2 ;[169] Enable what we've set 38765 004274'01 104 00 0 00 000151 EPCAP ;[169] ... 38766 004275'01 320 14 0 00 004276' erjmps .+1 ;[194] ... 38767 004276'01 517 00 0 00 000001 hrlzs t1 ; Move handle into left half. 38768 004277'01 540 01 0 00 004244* hrr t1, pars3 ; JFN in right half. 38769 004300'01 550 03 0 00 000001 hrrz t3, t1 ;[220] Save a copy of the JFN 38770 004301'01 400 02 0 00 000000 setz t2, ;[220] Nothing special. 38771 004302'01 302 03 0 00 377777 caie t3, .nulio ;[220] NUL:? 38772 004303'01 254 00 0 00 004326' ifskp. ;[220] Just give up here 38773 004304'01 200 01 0 00 000004 move t1, t4 ;[220] Inferior fork handle 38774 004305'01 201 02 0 00 000000# movei t2, nulprg ;[220] NUL: program 38775 004306'01 104 00 0 00 000160 SFACS% ;[220] Set the registers 38776 004307'01 320 12 0 00 004311' %jserr (,r) ;[220] ?? 38777 004310'01 254 00 0 00 004314' 38778 004311'01 265 01 0 00 004261* 38779 004312'01 000000000000# 38780 004313'01 254 00 0 00 004263* 38781 001113'04 103 157 165 154 144 38782 004314'01 200 02 0 00 006012' move t2, [1,,nulent] ;[220] Load NUL:'s 'start address' 38783 004315'01 104 00 0 00 000204 SEVEC% ;[220] Set the entry vector 38784 004316'01 477 02 0 00 000003 setob t2, t3 ;[220] Don't fault in PA1050 38785 004317'01 104 00 0 00 000301 SCVEC% ;[220] Shut off UUO simulation 38786 004320'01 320 12 0 00 004322' %jserr (,) ;[220] Odd, but continue 38787 004321'01 254 00 0 00 004325' 38788 004322'01 265 01 0 00 004311* 38789 004323'01 000000000000# 38790 004324'01 254 00 0 00 004325' 38791 001122'04 103 157 165 154 144 38792 remark ;[220] Fall through to $yrun2 38793 004325'01 254 00 0 00 004337' else. ;[220] Otherwise, it's a real file 38794 004326'01 104 00 0 00 000200 GET ; Get the file to run. 38795 004327'01 320 12 0 00 004331' %jserr (,r) 38796 004330'01 254 00 0 00 004334' 38797 004331'01 265 01 0 00 004322* 38798 004332'01 000000000000# 38799 004333'01 254 00 0 00 004313* 38800 001131'04 103 141 156 047 164 38801 004334'01 550 01 0 00 004277* hrrz t1, pars3 ; Got the file, now can release its JFN. 38802 004335'01 104 00 0 00 000023 RLJFN 38803 004336'01 320 12 0 00 004337' erjmpr .+1 ;[220] Catch and ignore error 38804 004337'01 endif. ;[220] 38805 38806 ; Can come straight here to re-run current fork. 38807 38808 004337'01 337 01 0 00 000000# $yrun2: skipg t1, rufork ; Get fork handle. 38809 004340'01 334 01 0 00 000000# ermsg% (,r) ; Make sure it's ok. 38810 004341'01 254 00 0 00 004345' 38811 004342'01 202 01 0 00 002054* 38812 004343'01 104 00 0 00 000313 38813 004344'01 254 00 0 00 004333* 38814 000325'02 000000000000# 38815 001136'04 113 105 122 115 111 38816 38817 004345'01 400 02 0 00 000000 setz t2, ; Primary start address. 38818 004346'01 104 00 0 00 000201 SFRKV ; Start it up. k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 63-2 K20SRV MAC 26-Nov-23 15:09 LOCAL RUN command executon 38819 004347'01 320 12 0 00 004351' %jserr (,r) 38820 004350'01 254 00 0 00 004354' 38821 004351'01 265 01 0 00 004331* 38822 004352'01 000000000000# 38823 004353'01 254 00 0 00 004344* 38824 001144'04 103 141 156 047 164 38825 004354'01 104 00 0 00 000163 WFORK ; wait for the fork to halt. 38826 004355'01 320 12 0 00 004357' %jserr (,r) 38827 004356'01 254 00 0 00 004362' 38828 004357'01 265 01 0 00 004351* 38829 004360'01 000000000000# 38830 004361'01 254 00 0 00 004353* 38831 001151'04 103 141 156 047 164 38832 38833 004362'01 263 17 0 00 000000 ret 38834 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 64 K20SRV MAC 26-Nov-23 15:09 SRVCMD - Routine to send a command to a server. 38835 subttl SRVCMD - Routine to send a command to a server. 38836 ; 38837 ; Call with: 38838 ; 38839 ; t1/ Byte pointer to string. 38840 ; First character is Generic Command, subsequent chars are arguments. 38841 ; t2/ Packet type, e.g. "G" for Generic, "C" for Host Command. 38842 ; 38843 ; Returns: 38844 ; 38845 ; +1 if reply was not received successfully. 38846 ; +2 If we got a good response, with 38847 ; t1/ packet type of response, "Y", "X", or "S". 38848 ; PKTACS/ Block of 4 words containing the data returned by RPACK. 38849 ; 38850 ; If packet was ACK containing data, this routine prints it. 38851 38852 004363'01 332 00 0 00 002046* srvcmd: skipe takdep ;[176] Allow commands to servers from TAKE file 38853 004364'01 254 00 0 00 004365' jrst srvxx 38854 004365'01 265 16 0 00 005514' srvxx: saveac ; Preserve these work registers. 38855 004366'01 120 05 0 00 000001 dmove q1, t1 ; Copy arguments into them. 38856 004367'01 336 00 0 00 003303* skipn local ;[177] Local Kermit? 38857 004370'01 260 17 0 00 002613* call inilin ;[177] No, set TTY: up for packets. 38858 004371'01 402 00 0 00 003262* setzm numtry ; Reset retry counter. 38859 004372'01 402 00 0 00 000000* setzm nnak ; Init some statistics counters 38860 004373'01 402 00 0 00 000000* setzm ntimou ; ... 38861 004374'01 476 00 0 00 002636* setom bctone ; Force 1-char checksum. 38862 004375'01 260 17 0 00 000043* call clrbuf ;[194] Clear out any stacked-up NAKs 38863 004376'01 600 00 0 00 000000 nop ;[186] Ignore any errors 38864 004377'01 260 17 0 00 002611* call statim ; Start timing (so k20pdc works) 38865 004400'01 260 17 0 00 002614* call ccon ; Let them ^C out gracefully 38866 004401'01 254 00 0 00 004516' jrst srvcmx ; and go here if they do. 38867 38868 004402'01 260 17 0 00 000000* call setlog ; Set up any debugging log. 38869 004403'01 600 00 0 00 000000 nop 38870 38871 ; Put the command into the data field of the packet, using the normal 38872 ; packet-filling technique, prefixing, etc. 38873 38874 004404'01 402 00 0 00 000000* setzm datbuf ;[190] ; Zero the buffer. 38875 38876 004405'01 201 01 0 00 003272' srvcma: movei t1, gtsch ; Indicate routine to be used for getting 38877 004406'01 202 01 0 00 004156* movem t1, source ; characters. 38878 004407'01 202 05 0 00 003712* movem q1, strptr ; And where it should get them from. 38879 004410'01 476 00 0 00 004157* setom next ; Set initial condition. 38880 004411'01 200 01 0 00 003642* move t1, maxdat ; Get a buffer full of data. 38881 004412'01 260 17 0 00 003643* call getbuf ; ... 38882 004413'01 326 01 0 00 004516' jumpn t1, srvcmx ; Clean up if this fails. 38883 004414'01 402 00 0 00 004406* setzm source ; Got it, so put GETCH back to normal. 38884 38885 004415'01 202 01 0 00 000000# movem t1, gclen ; Save length. 38886 004416'01 326 01 0 00 004424' jumpn t1, srvcm2 ; Proceed if we got any. 38887 38888 004417'01 334 01 0 00 000000# ermsg% (, srvcmx) ; Do this otherwise. 38889 004420'01 254 00 0 00 004424' k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 64-1 K20SRV MAC 26-Nov-23 15:09 SRVCMD - Routine to send a command to a server. 38890 004421'01 202 01 0 00 004342* 38891 004422'01 104 00 0 00 000313 38892 004423'01 254 00 0 00 004516' 38893 000326'02 000000000000# 38894 001156'04 113 105 122 115 111 38895 38896 38897 ; Top of try-again loop. 38898 38899 004424'01 200 05 0 00 004371* srvcm2: move q1, numtry ; Too many tries? 38900 004425'01 311 05 0 00 000000* caml q1, maxtry 38901 004426'01 334 01 0 00 000000# ermsg% (,srvcmx) 38902 004427'01 254 00 0 00 004433' 38903 004430'01 202 01 0 00 004421* 38904 004431'01 104 00 0 00 000313 38905 004432'01 254 00 0 00 004516' 38906 000327'02 000000000000# 38907 001167'04 113 105 122 115 111 38908 38909 004433'01 350 00 0 00 004424* aos numtry ; Not too many, count this try. 38910 004434'01 200 01 0 00 000006 move t1, q2 ; Packet type. 38911 004435'01 400 02 0 00 000000 setz t2, ; Make the packet number zero. 38912 004436'01 200 03 0 00 000000# move t3, gclen ; Length of data. 38913 004437'01 200 04 0 00 005773' move t4, [point 8, datbuf] ;[190] Point to data buffer. 38914 004440'01 260 17 0 00 003652* call spack ; Send it off. 38915 004441'01 254 00 1 01 006013' jrst @[exp srvcm2, srvcmx](t1) ; Handle nonfatal & fatal failures. 38916 004442'01 402 00 0 00 000000* setzm gotx ; Assume it'll be an ACK. 38917 004443'01 260 17 0 00 002640* call rpack ; Look for response. 38918 004444'01 334 01 0 00 000000# ermsg% (,srvcm2) 38919 004445'01 254 00 0 00 004451' 38920 004446'01 202 01 0 00 004430* 38921 004447'01 104 00 0 00 000313 38922 004450'01 254 00 0 00 004424' 38923 000330'02 000000000000# 38924 001203'04 113 105 122 115 111 38925 38926 38927 004451'01 302 01 0 00 000130 caie t1, "X" ; X or Y? 38928 004452'01 306 01 0 00 000131 cain t1, "Y" 38929 004453'01 254 00 0 00 004536' jrst srvcmz ; Good. 38930 38931 004454'01 302 01 0 00 000123 caie t1, "S" ; S or I? 38932 004455'01 306 01 0 00 000111 cain t1, "I" 38933 004456'01 254 00 0 00 004536' jrst srvcmz ; That's ok too. 38934 38935 004457'01 302 01 0 00 000105 caie t1, "E" ; Error packet? 38936 004460'01 254 00 0 00 004470' ifskp. ;[186] Yes, let's see about squawking 38937 004461'01 336 00 0 00 004367* skipn local ;[186] Local? 38938 004462'01 254 00 0 00 004516' jrst srvcmx ;[186] No, this will always mess up 38939 004463'01 200 01 0 00 000000# emsg ;[186] Yes, print it. 38940 004464'01 104 00 0 00 000313 38941 000331'02 000000000000# 38942 001211'04 122 145 155 157 164 38943 004465'01 200 01 0 00 000004 move t1, t4 ; Get pointer to it, 38944 004466'01 104 00 0 00 000076 PSOUT% ; and print it. k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 64-2 K20SRV MAC 26-Nov-23 15:09 SRVCMD - Routine to send a command to a server. 38945 004467'01 254 00 0 00 004516' jrst srvcmx ;[70] 38946 004470'01 endif. ;[186] End error pack 38947 38948 004470'01 302 01 0 00 000116 caie t1, "N" ; NAK? 38949 004471'01 306 01 0 00 000124 cain t1, "T" ; Or Timeout? 38950 004472'01 254 00 0 00 004424' jrst srvcm2 ; One of those, go try again. 38951 38952 004473'01 336 00 0 00 004461* skipn local ;[233] Local? 38953 004474'01 254 00 0 00 004516' jrst srvcmx ;[235] Nothing to display on 38954 remark ;[235] Tell us the offending packet and punt 38955 004475'01 200 02 0 00 000001 move t2,t1 ;[235] Save the offending character 38956 004476'01 561 01 0 00 006015' hrroi t1,[ asciz /Invalid response from server: '/] ;[235] 38957 004477'01 104 00 0 00 000313 ESOUT% ;[235] Begin blat 38958 004500'01 320 12 0 00 004501' erjmpr .+1 ;[235] Catch and ignore any error 38959 004501'01 200 01 0 00 000002 move t1,t2 ;[235] Get the character back 38960 004502'01 104 00 0 00 000074 PBOUT% ;[235] Type it 38961 004503'01 320 12 0 00 004504' erjmpr .+1 ;[235] Catch and ignore any error 38962 004504'01 561 01 0 00 006024' hrroi t1,[asciz /' (/] ;[235] And seperate the rest 38963 004505'01 104 00 0 00 000076 PSOUT% ;[235] Type that 38964 004506'01 320 12 0 00 004507' erjmpr .+1 ;[235] Catch and ignore any error 38965 004507'01 201 01 0 00 000101 movei t1,.priou ;[235] Still going to primary output 38966 004510'01 201 03 0 00 000010 movei t3,^d8 ;[235] ASCII characters are base 8 here 38967 004511'01 104 00 0 00 000224 NOUT% ;[235] Type it 38968 004512'01 320 12 0 00 004513' erjmpr .+1 ;[235] Catch and ignore any error 38969 hrroi t1,[asciz /) 38970 004513'01 561 01 0 00 006025' /] ;[235] Close off the line 38971 004514'01 104 00 0 00 000076 PSOUT% ;[235] Type that 38972 004515'01 320 12 0 00 004516' erjmpr .+1 ;[235] Catch and ignore any error 38973 remark srvcmx ;[235] Falls through 38974 38975 ; Exit point for any kind of error, failure, or interruption 38976 38977 004516'01 260 17 0 00 002510* srvcmx: call ccoff ; Turn off ^C trap. 38978 004517'01 260 17 0 00 000000* call caxzof ; Turn these interrupts off too. 38979 004520'01 260 17 0 00 003042* call endtim ;[189] Stop timing 38980 004521'01 260 17 0 00 003043* call elptim ;[189] Compute elapsed time 38981 004522'01 337 01 0 00 002402* skipg t1, filjfn ;[193] Any file left open? 38982 004523'01 254 00 0 00 004531' ifskp. ;[193] Apparently, try to close it. 38983 004524'01 621 01 0 00 777777 tlz t1,-1 ;[193] Ditch any flags 38984 004525'01 302 01 0 00 377777 caie t1, .nulio ;[193] No need to close since never opened 38985 004526'01 104 00 0 00 000022 CLOSF 38986 004527'01 320 12 0 00 004530' erjmpr .+1 ;[193] Catch and ignore error 38987 004530'01 402 00 0 00 004522* setzm filjfn ;[193] Whatever it was, it's closed now! 38988 004531'01 endif. ;[193](end) 38989 004531'01 336 00 0 00 004473* skipn local ;[177] Put controlling TTY back to normal 38990 004532'01 260 17 0 00 000000* call rrsl2 ;[177] ... (entry point to reslin) 38991 004533'01 402 00 0 00 004414* setzm source ; Put things back to normal. 38992 004534'01 474 01 0 00 000000 seto t1, ; Indicate no good response was received. 38993 004535'01 263 17 0 00 000000 ret ; Return +1. 38994 38995 38996 ; Exit here when response received successfully. 38997 38998 004536'01 124 01 0 00 000000* srvcmz: dmovem t1, pktacs ;[112] Save the ACs returned in RPACK 38999 004537'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 20:02 27-Nov-23 Page 64-3 K20SRV MAC 26-Nov-23 15:09 SRVCMD - Routine to send a command to a server. 39000 004540'01 202 02 0 00 003266* movem t2, pktnum ; Synchronize packet numbers. 39001 004541'01 302 01 0 00 000131 caie t1, "Y" ;[194] Was the reply an ACK? 39002 004542'01 254 00 0 00 004553' ifskp. ;[194] It was 39003 004543'01 337 02 0 00 000003 skipg t2, t3 ;[144] Yes, any characters? 39004 004544'01 254 00 0 00 004553' anskp. ;[194] No. 39005 004545'01 201 01 0 00 003303' movei t1, puttch ;[144] Routine to display decoded characters. 39006 004546'01 202 01 0 00 003330* movem t1, dest ;[144] ... 39007 004547'01 200 01 0 00 000004 move t1, t4 ;[144] Pointer to data buffer. 39008 004550'01 260 17 0 00 003324* call putbuf ;[144] Go decode it. 39009 004551'01 600 00 0 00 000000 nop ;[144] 39010 004552'01 402 00 0 00 004546* setzm dest ;[144] 39011 004553'01 endif. ;[194] 39012 004553'01 200 01 0 00 004536* move t1, pktacs ;[112] Get packet type back. 39013 004554'01 260 17 0 00 004516* call ccoff ; Turn off ^C trap. 39014 004555'01 336 00 0 00 004531* skipn local ;[177] Put controlling TTY back to normal 39015 004556'01 260 17 0 00 004532* call rrsl2 ;[177] ... (entry point to reslin) 39016 004557'01 254 00 0 00 003736* retskp ; Done. 39017 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 65 K20SRV MAC 26-Nov-23 15:09 SINFO Sends Iniatialization Packet 39018 subttl SINFO Sends Iniatialization Packet 39019 39020 ;[58] SINFO added as part of edit 58. 39021 ; 39022 ; Call this routine before sending any server command which has a 39023 ; nontrivial response. For instance, it should be called before 39024 ; requesting a remote directory listing, but need not be called before 39025 ; sending a CWD command, which normally responds with a simple ACK. 39026 ; 39027 ; Action: Sends an info packet with our own parameters, waits for 39028 ; ACK with other side's. Uses packet number 0, does not increment the 39029 ; packet number. If other side doesn't know about I packets, this 39030 ; routine returns as if a an ACK was received containing all default 39031 ; values. 39032 ; 39033 ; Returns: 39034 ; +1 on failure, maximum tries exceeded. 39035 ; +2 on "success" getting a reply, even if it was an error packet, 39036 ; with other sides parameters set. 39037 39038 004560'01 sinfo: entry sinfo 39039 004560'01 265 16 0 00 006026' saveac ;[128] Save these. 39040 004561'01 402 00 0 00 004433* setzm numtry ; Give it a try, 39041 004562'01 402 00 0 00 004540* setzm pktnum ; starting out with a clean slate. 39042 004563'01 476 00 0 00 004374* setom bctone ;[98] Use 1-char checksum. 39043 39044 004564'01 260 17 0 00 004375* call clrbuf ;[194] Clear out any piled up NAKs. 39045 004565'01 600 00 0 00 000000 nop ;[186] Ignore any errors 39046 004566'01 260 17 0 00 004402* call setlog ; Set up any debugging log. 39047 004567'01 600 00 0 00 000000 nop 39048 004570'01 201 11 0 00 000123 movei state, "S" ;[133] This will be a little state switcher. 39049 39050 004571'01 201 01 0 00 000111 sinfo2: movei t1, "I" ;[100][133] Packet type. 39051 004572'01 476 00 0 00 000000* setom iflg ;[100] Say we're doing I, not S. 39052 004573'01 260 17 0 00 000000* call sinit ;[100] Let SINIT send it & get reply. 39053 004574'01 302 01 0 00 000105 caie t1, "E" ;[194] Other side doesn't know I packet? 39054 004575'01 254 00 0 00 004601' ifskp. ;[194] Strangely, no 39055 004576'01 403 03 0 00 000004 setzb t3, t4 ;[133] Then set defaults this way. 39056 004577'01 260 17 0 00 003261* call spar ;[133] Sets our parameters 39057 004600'01 254 00 0 00 004607' jrst sinfoz ;[133] And return successfully. 39058 004601'01 endif. ;[194] 39059 39060 ;[133] Keep going if it doesn't get thru the first time. 39061 39062 004601'01 306 11 0 00 000106 cain state, "F" ; Switched into F state? 39063 004602'01 254 00 0 00 004607' jrst sinfoz ; Yes, so I was ACK'd, done. 39064 004603'01 306 11 0 00 000123 cain state, "S" ; Still in S state? 39065 004604'01 254 00 0 00 004571' jrst sinfo2 ; So go round again. 39066 39067 004605'01 402 00 0 00 004572* sinfox: setzm iflg ; Must have exceeded retry limit. 39068 004606'01 263 17 0 00 000000 ret ; Fail. 39069 39070 004607'01 402 00 0 00 004605* sinfoz: setzm iflg ;[100] Done with sending I packet. 39071 004610'01 254 00 0 00 004557* retskp 39072 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 65-1 K20SRV MAC 26-Nov-23 15:09 SINFO Sends Iniatialization Packet 39073 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 66 K20SRV MAC 26-Nov-23 15:09 SRVFIL 39074 subttl SRVFIL 39075 ; 39076 ; Common code to construct a generic one-field command. 39077 ; Generic command is single character in t4. Argument is in ATMBUF. 39078 ; Puts a 1-character length field at the beginning. 39079 ; 39080 004611'01 260 17 0 00 004560' srvfil: call sinfo ;[128] Exchange parameters with I packet. 39081 004612'01 263 17 0 00 000000 ret ;[133] Failed, give up. 39082 39083 004613'01 402 00 0 00 000000# setzm srvbuf ;[194] Zero out old stuff 39084 004614'01 200 01 0 00 006036' move t1, [srvbuf,,srvbuf+1] ;[194] The whole buffer 39085 004615'01 251 01 0 00 000000# blt t1, srvbzz ;[194] Not just two words ... 39086 dmove t1, [ point 7, atmbuf ;[194] Copy directory name from here 39087 004616'01 120 01 0 00 005742' point 7, strbuf ] ;[194] to there 39088 39089 004617'01 136 04 0 00 000002 idpb t4, t2 ; Deposit generic command. 39090 004620'01 133 00 0 00 000002 ibp t2 ; Leave a space 39091 004621'01 400 03 0 00 000000 setz t3, ; Initialize counter 39092 39093 004622'01 do. ;[194] Enter loop context 39094 004622'01 134 04 0 00 000001 ildb t4, t1 ; Get next one. 39095 004623'01 136 04 0 00 000002 idpb t4, t2 ; Deposit this one. 39096 004624'01 322 04 0 00 004626' jumpe t4, endlp. ;[194] Stop on a .chnul 39097 004625'01 344 03 0 00 004622' aoja t3, top. ;[194] Otherwise, count it & loop. 39098 004626'01 enddo. ;[194] Exit loop context 39099 39100 ;* jumpe t3, [ ; Make sure there was at least one character. 39101 ;* txmsg 39102 ;* ret ] 39103 39104 004626'01 200 01 0 00 000003 srvfi3: move t1, t3 ; Length 39105 004627'01 271 01 0 00 000040 addi t1, 40 ; CHAR of that. 39106 004630'01 200 02 0 00 005651' move t2, [point 7, strbuf, 13] ; Deposit count at head of field. 39107 004631'01 137 01 0 00 000002 dpb t1, t2 39108 004632'01 200 01 0 00 005647' move t1, [point 7, strbuf] ; Point to generic command. 39109 004633'01 201 02 0 00 000107 movei t2, "G" ; Packet type is G. 39110 004634'01 254 00 0 00 004635' jrst dosrv ; Go do it. 39111 39112 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 67 K20SRV MAC 26-Nov-23 15:09 DOSRV - Wrapper for SRVCMD 39113 subttl DOSRV - Wrapper for SRVCMD 39114 39115 ; Call this exactly like SRVCMD. 39116 ; 39117 ; Send a command to a server and dispatch appropriately depending on the reply. 39118 ; 39119 004635'01 dosrv: entry dosrv ;[220] 39120 004635'01 402 00 0 00 004442* setzm gotx ; Clear flags: "got X packet", 39121 004636'01 402 00 0 00 000000* setzm gots ; "got S packet". 39122 004637'01 260 17 0 00 004363' call srvcmd ; Send a generic command. 39123 004640'01 263 17 0 00 000000 ret ; Didn't get good response. 39124 004641'01 306 01 0 00 000131 cain t1, "Y" ; Was it an ACK? 39125 004642'01 263 17 0 00 000000 ret ; Yes, so we're done. 39126 39127 ; Come here if we're about to receive a multipacket reply. 39128 39129 004643'01 302 01 0 00 000130 caie t1, "X" ; Text header? 39130 004644'01 254 00 0 00 004711' jrst dosrv3 ; No 39131 39132 004645'01 476 00 0 00 004635* setom gotx ; Yup, flag that we already got it. 39133 004646'01 201 11 0 00 000106 movei state, "F" ; State state to file receive. 39134 004647'01 336 00 0 00 000003 skipn t3 ;[173](begin) Any contents? 39135 004650'01 254 00 0 00 000000* jrst $recvb ; No. 39136 39137 remark ;[220] Squeeze out leading and trailing CRLF's 39138 004651'01 415 16 0 00 004710' block. ;[220] Yes, create a frame to print them 39139 004652'01 261 17 0 00 000016 39140 004653'01 265 16 0 00 005543' saveac ;[220] Save in flight temporaries (particularly t1) 39141 004654'01 200 04 0 00 000000# move t4, pktacs+3 ;[220] Load pointer text 39142 004655'01 200 03 0 00 000004 move t3, t4 ;[220] Keep a copy handy 39143 39144 004656'01 134 01 0 00 000004 ildb t1, t4 ;[220] Pick up a character 39145 004657'01 302 01 0 00 000015 caie t1, .chcrt ;[220] A carriage return? 39146 004660'01 254 00 0 00 004665' ifskp. ;[220] It is, let's see if followed by a line feed 39147 004661'01 134 01 0 00 000004 ildb t1, t4 ;[220] Pick up another character 39148 004662'01 302 01 0 00 000012 caie t1, .chlfd ;[220] A line feed?? 39149 004663'01 254 00 0 00 004665' anskp. ;[220] No, so must advance the carriage 39150 remark ;[220] Fall out and skip the crlf 39151 004664'01 254 00 0 00 004670' else. ;[220] Need to get to a clean line 39152 004665'01 561 01 0 00 002437* hrroi t1, crlf 39153 004666'01 104 00 0 00 000076 PSOUT% 39154 004667'01 320 12 0 00 004361* erjmpr r ;[220] If fails, break out of the block, +1 39155 004670'01 endif. ;[220] Either way, ready to see something 39156 39157 004670'01 200 01 0 00 000003 move t1, t3 ;[220] Load original pointer 39158 004671'01 104 00 0 00 000076 PSOUT% ;[220] Type whatever we got handed 39159 004672'01 320 12 0 00 004667* erjmpr r ;[220] Or not... 39160 39161 004673'01 211 04 0 00 777776 movni t4, -2 ;[220] Done printing, so back the 39162 004674'01 133 04 0 00 000001 adjbp t4, t1 ;[220] pointer up so we can have a look 39163 004675'01 134 01 0 00 000004 ildb t1, t4 ;[220] Pick up a character 39164 004676'01 302 01 0 00 000015 caie t1, .chcrt ;[220] A carriage return? 39165 004677'01 254 00 0 00 004704' ifskp. ;[220] It is, let's see if followed by a line feed 39166 004700'01 134 01 0 00 000004 ildb t1, t4 ;[220] Pick up another character 39167 004701'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 20:02 27-Nov-23 Page 67-1 K20SRV MAC 26-Nov-23 15:09 DOSRV - Wrapper for SRVCMD 39168 004702'01 254 00 0 00 004704' anskp. ;[220] No, so must advance the carriage 39169 remark ;[220] Fall out and skip the crlf 39170 004703'01 254 00 0 00 004707' else. ;[220] Need to get to a clean line 39171 004704'01 561 01 0 00 004665* hrroi t1, crlf 39172 004705'01 104 00 0 00 000076 PSOUT% 39173 004706'01 320 12 0 00 004672* erjmpr r ;[220] If fails, break out of the block, +1 39174 004707'01 endif. ;[220] Either way, ready to see something 39175 remark ;[220] Fall out of the block 39176 004707'01 263 17 0 00 000000 endbk. ;[220] End block context 39177 004710'01 254 00 0 00 004650* jrst $recvb ; Go receive whatever is coming. 39178 39179 004711'01 302 01 0 00 000123 dosrv3: caie t1, "S" ;[194] Or Send-Init? 39180 004712'01 254 00 0 00 004716' ifskp. ;[194] Got it 39181 004713'01 476 00 0 00 004636* setom gots ; Yes, flag that we already got it. 39182 004714'01 201 11 0 00 000122 movei state, "R" ; Set state to receive init. 39183 004715'01 254 00 0 00 004710* jrst $recvb ; Go receive what's coming. 39184 004716'01 endif. ;[194] 39185 39186 004716'01 334 01 0 00 000000# ermsg% (,r) 39187 004717'01 254 00 0 00 004723' 39188 004720'01 202 01 0 00 004446* 39189 004721'01 104 00 0 00 000313 39190 004722'01 254 00 0 00 004706* 39191 000332'02 000000000000# 39192 001215'04 113 105 122 115 111 39193 39194 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 68 K20SRV MAC 26-Nov-23 15:09 Is this a directory device? 39195 subttl Is this a directory device? 39196 39197 ;[193] Begin code insertion 39198 ; 39199 ; Call: 39200 ; 39201 ; t1/ JFN to test, NO FLAGS! 39202 ; 39203 ; Returns: 39204 ; 39205 ; +1, Not a directory based device 39206 ; N.B., t1 and t2 may be invalid if DVCHR% failed! 39207 ; 39208 ; +2, Something we can use as a directory 39209 ; 39210 ; t1/ device designator 39211 ; t2/ device characteristics word 39212 ; 39213 ; All other accumulators are preserved 39214 ; 39215 ; NUL: and .nulio directories are expected to be simulated by calling routine 39216 39217 004723'01 isdird: entry isdird ; Called by k20par and maybe k20dsp 39218 004723'01 260 17 0 00 004130* call isnulj ; Is this some kind of NUL: or .nulio? 39219 004724'01 254 00 0 00 004727' ifskp. ; It is, so just say yes 39220 dmove t1, [ .dvdes!.dvnul,,-1 ; NUL: has no units 39221 004725'01 120 01 0 00 006037' dv%out!dv%in!dv%av!fld(.dvnul,dv%typ)!dv%psd!fld(-1,dv%mod) ] 39222 004726'01 254 00 0 00 004610* retskp ; Insist that it is a directory device 39223 004727'01 endif. ; Done with the easy case 39224 ; Have to do some work... 39225 004727'01 265 16 0 00 006026' saveac ; Don't touch the other accumulators 39226 004730'01 104 00 0 00 000117 DVCHR% ; Get device characteristics 39227 004731'01 320 12 0 00 004733' ifje. r ; Fail and retrieve error 39228 004732'01 254 00 0 00 004737' 39229 004733'01 200 04 0 00 000001 move t4, t1 ; Store the error 39230 004734'01 477 01 0 00 000002 setob t1, t2 ; Cons up some real junk 39231 004735'01 400 03 0 00 000000 setz t3, ; This value should never happen 39232 004736'01 254 00 0 00 004740' else. ; Otherwise, worked 39233 004737'01 400 04 0 00 000000 setz t4, ; Flag that DVCHR% worked 39234 004740'01 endif. ; End case DVCHR% failure recovery 39235 ; Finally pick up the device type 39236 004740'01 135 03 0 00 005525' ldb t3,[pointr(t2,dv%typ)] 39237 004741'01 306 03 0 00 000015 cain t3, .dvnul ; NUL:? 39238 004742'01 254 00 0 00 004726* retskp ; Can always delete or list that (simulated) 39239 004743'01 306 03 0 00 000000 cain t3, .dvdsk ; Structure? 39240 004744'01 254 00 0 00 004742* retskp ; Yes, that has directories and files 39241 004745'01 306 03 0 00 000003 cain t3, .dvdta ; Eh? DECtape?? 39242 004746'01 254 00 0 00 004744* retskp ; Who put that back in? 39243 ; None of the above, try general case 39244 004747'01 326 04 0 00 004753' ife. t4 ; Did the DVCHR% work? 39245 004750'01 607 02 0 00 100000 txnn t2, dv%dir ; It did, so does the device have directories? 39246 004751'01 254 00 0 00 004753' anskp. ; No, so can't return true 39247 004752'01 254 00 0 00 004746* retskp ; Something new with a directory should work 39248 004753'01 endif. ; Otherwise, they are out of luck 39249 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 68-1 K20SRV MAC 26-Nov-23 15:09 Is this a directory device? 39250 004753'01 263 17 0 00 000000 ret ; Return doesn't have directories 39251 39252 ;[194] End code insertion 39253 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 69 K20SRV MAC 26-Nov-23 15:09 GTNFIL - Get next file from wild file specification. 39254 subttl GTNFIL - Get next file from wild file specification. 39255 39256 ; Call: 39257 ; 39258 ; filjfn/ Current JFN, possibly one of many 39259 ; nxtjfn/ Next JFN in sequence (1-file lookahead) 39260 ; ndxjfn/ Flags associated with stepping to next specification 39261 ; 39262 ; Returns: 39263 ; 39264 ; +1 t1/ 0 (indicating no more) 39265 ; +2 t1/ JFN of next file 39266 ; 39267 ;[111] Rewritten to do 1-file lookahead as part of edit 111. 39268 ; 39269 ;[194] Partial rewrite to simulate NUL: stepping and also to always 39270 ; return zero on plus 1 return, as per specification 39271 39272 004754'01 gtnfil: entry gtnfil ; Also used by k20mit 39273 004754'01 337 01 0 00 004530* skipg t1, filjfn ;[193] Release the JFN of the previous file. 39274 004755'01 254 00 0 00 004762' ifskp. ;[193] If we have one ... 39275 004756'01 306 01 0 00 377777 cain t1, .nulio ;[193] But!! Is this the sink? 39276 004757'01 254 00 0 00 004762' anskp. ;[193] Yes, no need to release it 39277 004760'01 104 00 0 00 000023 RLJFN 39278 004761'01 320 12 0 00 004762' erjmpr .+1 ;[193] Catch and ignore error 39279 004762'01 endif. ;[193] End case releasing JFN 39280 004762'01 402 00 0 00 004754* setzm filjfn 39281 39282 ; Check to see if we really want to or can get the next file. 39283 39284 004763'01 400 01 0 00 000000 setz t1, ; Assume no more files. 39285 004764'01 336 00 0 00 000000* skipn czseen ;[59] If CTRL-Z seen, then get no more files. 39286 004765'01 336 01 0 00 003007* skipn t1, nxtjfn ; No CTRL-Z. Get next JFN. 39287 004766'01 263 17 0 00 000000 ret ; None, so we're done. 39288 39289 ; Make a separate JFN for the file so that wildcard stepping won't be 39290 ; wiped out by anything we do to it, like deleting it, renaming it, etc. 39291 39292 004767'01 550 02 0 00 000001 hrrz t2, t1 ; Get the filename string. 39293 004770'01 561 01 0 00 003315* hrroi t1, strbuf 39294 004771'01 306 02 0 00 377777 cain t2, .nulio ;[193] Data sink? 39295 004772'01 254 00 0 00 005003' ifskp. ;[193] No, do it the regular way 39296 004773'01 400 03 0 00 000004 setz t3, t4 ;[193] No idiotic prefix 39297 004774'01 104 00 0 00 000030 JFNS 39298 004775'01 320 12 0 00 005032' erjmpr gtnerr ;[194] Bag the whole thing if failed 39299 004776'01 205 01 0 00 100001 movx t1, gj%old!gj%sht ;Get a new JFN on it. 39300 004777'01 561 02 0 00 004770* hrroi t2, strbuf 39301 005000'01 104 00 0 00 000020 GTJFN 39302 005001'01 320 12 0 00 005032' erjmpr gtnerr ;[194] Bag the whole thing if failed 39303 005002'01 254 00 0 00 005007' else. ;[193] Otherwise, NUL: 39304 dmove t2 , [ BYTE (7) "N","U","L",":", 0 39305 005003'01 120 02 0 00 006041' 0 ] ;[193] 39306 005004'01 124 02 0 00 004777* dmovem t2, strbuf ;[193] Put the file name into the buffer 39307 005005'01 400 04 0 00 000000 setz t4, ;[193] Keep t4 whacked like JFNS 39308 005006'01 201 01 0 00 377777 movei t1, .nulio ;[193] Load sink k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 69-1 K20SRV MAC 26-Nov-23 15:09 GTNFIL - Get next file from wild file specification. 39309 005007'01 endif. ;[193] End special case NUL: 39310 39311 005007'01 552 01 0 00 004762* hrrzm t1, filjfn ; Save it here, sans flags, if any 39312 005010'01 402 00 0 00 005004* setzm strbuf ; Scrub the buffer 39313 005011'01 402 00 0 00 000000# setzm strbuf+1 ; Give it a little more scrubby, just in case 39314 39315 ; Get new next JFN. 39316 39317 005012'01 550 01 0 00 004765* hrrz t1, nxtjfn ;[193] Get the JFN again. 39318 005013'01 302 01 0 00 377777 caie t1, .nulio ;[193] Data sink? 39319 005014'01 254 00 0 00 005020' ifskp. ;[193] Yes, so nothing to step 39320 005015'01 402 00 0 00 005012* setzm nxtjfn ;[193] So flag nothing left 39321 005016'01 402 00 0 00 003010* setzm ndxjfn ;[193] Nothing to step to 39322 remark t1, .nulio ;[193] Fall through with .nulio as JFN 39323 005017'01 254 00 0 00 005030' else. ;[193] Otherwise, have something to sep 39324 005020'01 500 01 0 00 005016* hll t1, ndxjfn ; Get wildcard flags into left half. 39325 005021'01 104 00 0 00 000017 GNJFN ; Get the next JFN. 39326 005022'01 320 12 0 00 005024' ifje. r ;[194] Failed 39327 005023'01 254 00 0 00 005027' 39328 005024'01 200 04 0 00 000001 move t4, t1 ;[194] Save error for interested parties 39329 005025'01 400 01 0 00 000000 setz t1, ; If no more, then no JFN 39330 005026'01 402 00 0 00 005020* setzm ndxjfn ;[194] Nothing more to step 39331 005027'01 endif. ;[193] End GNJFN% failure handling 39332 005027'01 202 01 0 00 005015* movem t1, nxtjfn ; Save result for next time. 39333 005030'01 endif. ;[193] End .nulio special case 39334 39335 ; Return with current JFN 39336 39337 005030'01 200 01 0 00 005007* move t1, filjfn ; Return JFN of current file in t1. 39338 005031'01 254 00 0 00 004752* retskp ; Return +2 indicating another file was found. 39339 39340 005032'01 200 04 0 00 000001 gtnerr: move t4, t1 ;[194] Save error for debuggers 39341 39342 005033'01 336 00 0 00 005030* ifmn. filjfn ;[194] Any file? 39343 005034'01 254 00 0 00 005041' 39344 005035'01 550 01 0 00 005033* hrrz t1, filjfn ;[194] Load JFN, sans flags 39345 005036'01 260 17 0 00 002515* call frclos ;[194] Force it to close 39346 005037'01 600 00 0 00 000000 nop ;[194] Ignore any error 39347 005040'01 402 00 0 00 005035* setzm filjfn ;[194] Whack the remnants 39348 005041'01 endif. ;[194] 39349 39350 005041'01 336 00 0 00 005027* ifmn. nxtjfn ;[194] Any 'next' JFN left? 39351 005042'01 254 00 0 00 005047' 39352 005043'01 550 01 0 00 005041* hrrz t1, nxtjfn ;[194] Yes, load JFN, sans flags 39353 005044'01 260 17 0 00 005036* call frclos ;[194] Force it to close 39354 005045'01 600 00 0 00 000000 nop ;[194] Ignore any error 39355 005046'01 402 00 0 00 005043* setzm nxtjfn ;[194] Whack the remnants 39356 005047'01 endif. ;[194] 39357 39358 005047'01 336 00 0 00 005026* ifmn. ndxjfn ;[194] Any stepping JFN? 39359 005050'01 254 00 0 00 005055' 39360 005051'01 550 01 0 00 005047* hrrz t1, ndxjfn ;[194] Yes, load the JFN, sans flags 39361 005052'01 260 17 0 00 005044* call frclos ;[194] Force it to close 39362 005053'01 600 00 0 00 000000 nop ;[194] Ignore any error 39363 005054'01 402 00 0 00 005051* setzm ndxjfn ;[194] Nothing to step any more k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 69-2 K20SRV MAC 26-Nov-23 15:09 GTNFIL - Get next file from wild file specification. 39364 005055'01 endif. ;[194] 39365 39366 005055'01 400 01 0 00 000000 setz t1, ;[194] No JFN anywhere, anyhow 39367 005056'01 263 17 0 00 000000 ret ;[194] Returns plus one 39368 39369 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 70 K20SRV MAC 26-Nov-23 15:09 Fetch File Information 39370 subttl Fetch File Information 39371 39372 ;[200] Begin Code Insertion 39373 ; 39374 ; Call: 39375 ; 39376 ; t2/ JFN of file to get information for 39377 ; 39378 ; Returns: 39379 ; 39380 ; +1/ Failure, the below are not dependable 39381 ; +2/ Succeed, the below contain 'reasonable' values 39382 ; 39383 ; pagcnt/ Number of pages (or blocks) in the file 39384 ; bytcnt/ Count of bytes in the file and byte size 39385 ; crdate/ Creation date and time 39386 ; 39387 ; N.B., Assumes both that the above variables are contiguous 39388 ; and that they are in the above order! 39389 ; 39390 ; To Do: See if can be coupled with isdird 39391 39392 005057'01 000700 000000 nulfdb: fld(^d7,fb%bsz) ; Pretend ASCII file with no pages 39393 005060'01 000000 000000 0 ; And no bytes 39394 39395 005061'01 filinf: extern pagcnt,crdate ; Size and date storage 39396 005061'01 265 16 0 00 005543' saveac ; Don't destroy calling context 39397 005062'01 553 04 0 00 000002 hrrzs t4, t2 ; Save and strip and flags 39398 005063'01 306 04 0 00 377777 cain t4, .nulio ; OK, is this going to be easy? 39399 005064'01 254 00 0 00 005147' jrst nulinf ; Special cased NUL: is trivial 39400 39401 005065'01 200 01 0 00 000004 move t1, t4 ; Load the JFN 39402 005066'01 104 00 0 00 000117 DVCHR% ; Get the device characteristics 39403 005067'01 320 12 0 00 005071' %jsErr (,r) 39404 005070'01 254 00 0 00 005074' 39405 005071'01 265 01 0 00 004357* 39406 005072'01 000000000000# 39407 005073'01 254 00 0 00 004722* 39408 001230'04 106 151 154 145 040 39409 39410 005074'01 135 03 0 00 005525' ldb t3,[pointr(t2,dv%typ)] ; Load the device type 39411 005075'01 306 03 0 00 000015 cain t3, .dvnul ; An unconverted NUL: device? 39412 005076'01 254 00 0 00 005147' jrst nulinf ; Odd, but handle it 39413 005077'01 302 03 0 00 000000 caie t3, .dvdsk ; Structure? 39414 005100'01 254 00 0 00 005107' ifskp. ; Of course it is 39415 005101'01 200 01 0 00 000004 move t1, t4 ; Restore the JFN 39416 dmove t2, [3,,.fbbyv ; Get size info from FDB (3 words) 39417 005102'01 120 02 0 00 006043' pagcnt] ; Put info in PAGCNT,BYTCNT,CRDATE 39418 005103'01 104 00 0 00 000063 GTFDB% ; which are adjacent in the data area. 39419 005104'01 320 16 0 00 005107' annje. ; Failed, try alternate way 39420 005105'01 254 00 0 00 005031* retskp ; Succeeded 39421 005106'01 254 00 0 00 005147' else. ; Otherwise, use older slower mechanisms 39422 005107'01 200 01 0 00 000004 move t1, t4 ; Restore the JFN 39423 005110'01 104 00 0 00 000036 SIZEF% ; Will work on any directory device 39424 005111'01 320 12 0 00 005113' %jsErr (,r) k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 70-1 K20SRV MAC 26-Nov-23 15:09 Fetch File Information 39425 005112'01 254 00 0 00 005116' 39426 005113'01 265 01 0 00 005071* 39427 005114'01 000000000000# 39428 005115'01 254 00 0 00 005073* 39429 001241'04 106 151 154 145 040 39430 005116'01 250 02 0 00 000003 exch t2,t3 ; Reorder as per above 39431 005117'01 124 02 0 00 001637* dmovem t2, pagcnt ; Store as per GTFDB% 39432 005120'01 265 16 0 00 003757* anstkv (t4,<.rsfet+1>) ;Allocate an anonymous stack variable 39433 005121'01 000000 000007 39434 005122'01 415 04 0 17 777770 39435 005123'01 200 02 0 00 000004 move t2, t4 ; Point to block 39436 005124'01 201 03 0 00 000007 movx t3, <.rsfet+1> ; Length of same 39437 005125'01 104 00 0 00 000533 RFTAD% ; Try it this way 39438 005126'01 320 12 0 00 005130' %jsErr (,r) 39439 005127'01 254 00 0 00 005133' 39440 005130'01 265 01 0 00 005113* 39441 005131'01 000000000000# 39442 005132'01 254 00 0 00 005115* 39443 001253'04 106 151 154 145 040 39444 005133'01 415 16 0 00 005144' block. ; Enter block context for better control flow 39445 005134'01 261 17 0 00 000016 39446 005135'01 332 03 0 04 000001 skipe t3,.rscrv(t4) ; Can we use the obvious file creation date? 39447 005136'01 254 00 0 00 005105* retskp ; Yes, go with that 39448 005137'01 332 03 0 04 000000 skipe t3,.rswrt(t4) ; OK, maybe the last time it was written? 39449 005140'01 254 00 0 00 005136* retskp ; Good enough... 39450 005141'01 332 03 0 04 000003 skipe t3,.rscre(t4) ; No, how about this odd word? 39451 005142'01 254 00 0 00 005140* retskp ; About as good as the previous 39452 remark ; Fall through, +1 39453 005143'01 263 17 0 00 000000 endbk. ; End of block context 39454 005144'01 263 17 0 00 000000 ret ; Failed 39455 005145'01 202 03 0 00 001673* movem t3, crdate ; Store what we decided to use 39456 005146'01 254 00 0 00 005142* retskp ; Return success 39457 005147'01 endif. 39458 39459 remark ; Special case .nulio (and NUL:) 39460 39461 005147'01 120 01 0 00 005057' nulinf: dmove t1,nulfdb ; Phoney up some FDB entries 39462 005150'01 124 01 0 00 005117* dmovem t1, pagcnt ; Store like GTFDB% would 39463 005151'01 104 00 0 00 000227 GTAD% ; Get current time of day 39464 005152'01 202 01 0 00 005145* movem t1, crdate ; NUL: is always created right now 39465 005153'01 254 00 0 00 005146* retskp ; Succeed 39466 39467 ;[200] End Code Insertion 39468 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 71 K20SRV MAC 26-Nov-23 15:09 Fix up a file JFN for fast generational delete 39469 subttl Fix up a file JFN for fast generational delete 39470 39471 ;[199] Begin code insertion 39472 39473 ; The following is necessary to leverage the DELNF% JSYS, which will 39474 ; result in far faster deletion of a file with multiple generations. 39475 ; Otherwise, each and every generation must be handled seperately in a 39476 ; loop doing GTJFN%, GNJFN% and DELF%'s 39477 ; 39478 ; Call: 39479 ; 39480 ; t1/ flags,,JFN as returned by .cmfil 39481 ; 39482 ; Assumes the following are true: 39483 ; 39484 ; 1) That the NUL: device has already been special cased to .nulio 39485 ; 2) That we are not being called with resulting .nulio 39486 ; 3) That the device in question supports directories 39487 ; 39488 ; To do: Was this necessary? If doing highest generation, does a 39489 ; negative value for generations to keep work? 39490 39491 111100 000001 fjfnsf==> ; Want everything but the generation 39492 39493 005154'01 607 01 0 00 010000 ffjfgd: jxe t1, gj%ver, r ; Nothing to do if didn't wildcard the version 39494 005155'01 254 00 0 00 005132* 39495 005156'01 607 01 0 00 004000 ifxn. t1, gj%uhv ; Already doing highest generation? 39496 005157'01 254 00 0 00 005162' 39497 005160'01 621 01 0 00 010000 txz t1, gj%ver ; Don't step generations 39498 005161'01 254 00 0 00 005153* retskp ; Succeed 39499 005162'01 endif. 39500 39501 005162'01 265 16 0 00 005514' saveac ; Candidate JFN and storage for file name 39502 005163'01 200 05 0 00 000001 move q1, t1 ; Save the JFN and flags 39503 005164'01 265 16 0 00 005120* anstkv (q2,mxfilw) ; Storage to build a new name 39504 005165'01 000000 000034 39505 005166'01 415 06 0 17 777743 39506 39507 005167'01 560 01 0 00 000006 hrro t1, q2 ; Construct Tops-20 ASCII pointer to stack 39508 005170'01 550 02 0 00 000005 hrrz t2, q1 ; Load JFN, sans flags 39509 005171'01 120 03 0 00 006045' dmove t3, [exp fjfnsf,0] ;Fast delete JFNS Flags and no prefix 39510 005172'01 104 00 0 00 000030 JFNS% ; Reconstruct on the stack 39511 005173'01 320 12 0 00 005175' %jsErr (,r) 39512 005174'01 254 00 0 00 005200' 39513 005175'01 265 01 0 00 005130* 39514 005176'01 000000000000# 39515 005177'01 254 00 0 00 005155* 39516 001265'04 125 156 141 142 154 39517 005200'01 120 02 0 00 006047' dmove t2, [exp ".","0"] ; Highest generation and punctuation 39518 005201'01 136 02 0 00 000001 idpb t2, t1 ; Append the generation punctionation 39519 005202'01 136 03 0 00 000001 idpb t3, t1 ; Append the highest generation moniker 39520 005203'01 136 04 0 00 000001 idpb t4, t1 ; Tie off the string 39521 ; Load GTJFN% flag bits,,generation number. 39522 005204'01 205 01 0 00 100120 movx t1, gj%old!gj%ifg!gj%flg!fld(.rhalf,.gjdef) 39523 005205'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 20:02 27-Nov-23 Page 71-1 K20SRV MAC 26-Nov-23 15:09 Fix up a file JFN for fast generational delete 39524 005206'01 104 00 0 00 000020 GTJFN% ; Get a brand new JFN on file group 39525 005207'01 320 12 0 00 005211' %jsErr (,r) 39526 005210'01 254 00 0 00 005214' 39527 005211'01 265 01 0 00 005175* 39528 005212'01 000000000000# 39529 005213'01 254 00 0 00 005177* 39530 001275'04 125 156 141 142 154 39531 39532 005214'01 500 01 0 00 000005 hll t1, q1 ; Load just the calling flags 39533 005215'01 621 01 0 00 013000 txz t1, gj%ver!gj%nhv!gj%ulv ; Shut off wildcarded lowest and next highest 39534 005216'01 661 01 0 00 004000 txo t1, gj%uhv ; Force highest generation, always 39535 005217'01 250 01 0 00 000005 exch t1, q1 ; Swap with old flags,,JFN 39536 39537 005220'01 621 01 0 00 777777 tlz t1, -1 ; Toss its flags 39538 005221'01 104 00 0 00 000023 RLJFN% ; Toss the JFN 39539 005222'01 320 12 0 00 005224' ifje. r ; Failed?? 39540 005223'01 254 00 0 00 005230' 39541 005224'01 306 01 0 00 600152 cain t1, desx3 ; Wait, did it disappear?? 39542 005225'01 254 00 0 00 005230' anskp. ; Odd, but that's really fine 39543 005226'01 200 02 0 00 000001 move t2, t1 ; Otherwise, save the error carry on 39544 005227'01 254 00 0 00 005231' else. ; Otherwise, worked!! 39545 005230'01 400 02 0 00 000000 setz t2, ; Signal no error 39546 005231'01 endif. ; Worst case, we drag an extra JFN around 39547 39548 005231'01 200 01 0 00 000005 move t1, q1 ; Load updated flags and new JFN 39549 005232'01 254 00 0 00 005161* retskp ; Finally return success 39550 39551 ;[199] End code insertion 39552 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 72 K20SRV MAC 26-Nov-23 15:09 Routine to delete a file [118] 39553 subttl Routine to delete a file [118] 39554 39555 extern expung ; Auto expunge flag 39556 39557 ; [199] Partially adapted from EFTPST. 39558 39559 ; Call: 39560 ; 39561 ; t2/ flags,,JFN 39562 ; 39563 ; The flags are the stepping flags for a wildcarded JFN and may 39564 ; NOT be associated with the JFN in question. gj%uhv is checked 39565 ; to see if the original file specification wildcarded the 39566 ; version number. If this is the case and expunge is not on, 39567 ; then DELNF% will be used for a substantial performance increase. 39568 ; 39569 ; Returns: +1, always 39570 ; 39571 ; The JFN is not released (see below) in order to allow the driving 39572 ; loop to release it. Otherwise, in a multi-forking environment, you 39573 ; can get into the situation that the JFN is released here and another 39574 ; fork is then picked to run which issues a GTJFN%. If the same JFN 39575 ; is given, then when driver code resumes, it may wind up releasing 39576 ; somebody else's JFN!! 39577 ; 39578 ; N.B., The "remark t1, df%nrj" is used to acknowledge a documentation 39579 ; 'bug' that claims that the DELNF% JSYS will release the JFN unless 39580 ; this bit is set. No, it doesn't. 39581 ; 39582 ; DELNF% does not handle the bit: it NEVER releases JFNs because 39583 ; there is no code to do this. So, we pretend to set it even though 39584 ; DELNF% does not look at it, never has looked at it and never will 39585 ; look at it. 39586 ; 39587 ; This behavior has been consistent from TENEX days. The problem is 39588 ; a Tops-20 Monitor Calls Manual documentation defect which has 39589 ; existed since version 3A. 39590 39591 005233'01 550 01 0 00 000002 delfil: hrrz t1, t2 ;[193] Load the JFN, sans flags 39592 39593 005234'01 302 01 0 00 377777 caie t1, .nulio ;[193] Data sink? 39594 005235'01 254 00 0 00 005240' ifskp. ;[193] Yep, that's pretty easy 39595 005236'01 474 04 0 00 000000 seto t4, ;[199] Flag a phoney delete 39596 005237'01 254 00 0 00 005260' jrst delepi ;[199] And hit the epilogue 39597 005240'01 endif. ;[199] End .nulio special case 39598 39599 remark ;[199] Otherwise, deleting something for real 39600 005240'01 332 00 0 00 001100* ifme. expung ;[143] Not expunging automatically? 39601 005241'01 254 00 0 00 005254' 39602 005242'01 607 02 0 00 004000 txnn t2, gj%uhv ;[199] Yes. Doing all of them? 39603 005243'01 254 00 0 00 005254' anskp. ;[199] No, then don't whack all of them 39604 remark t1, df%nrj ;[199] No flags being used (see above) 39605 005244'01 400 02 0 00 000000 setz t2, ;[199] Don't keep ANY generations 39606 005245'01 104 00 0 00 000317 DELNF% ;[199] Chuck all of them; boom! 39607 005246'01 320 12 0 00 005316' erjmpr delerr ;[199] But didn't ... k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 72-1 K20SRV MAC 26-Nov-23 15:09 Routine to delete a file [118] 39608 005247'01 553 04 0 00 000002 hrrzs t4, t2 ;[199] Remember number deleted 39609 005250'01 275 02 0 00 000001 subi t2, ^d1 ;[199] Account for assumed single file 39610 005251'01 323 02 0 00 005253' ifg. t2 ;[199] Two or more? 39611 005252'01 272 02 0 00 000000# addm t2, filcnt ;[199] Bump the file count with remainder 39612 005253'01 endif. ;[199] 39613 005253'01 254 00 0 00 005260' else. ;[199] Otherwise, just do this single file 39614 005254'01 505 01 0 00 600000 hrli t1, (df%nrj!df%exp) ;[143] Yes, set the bit 39615 005255'01 104 00 0 00 000026 DELF ; Try to delete it. 39616 005256'01 320 12 0 00 005316' erjmpr delerr ;[199] But couldn't 39617 005257'01 400 04 0 00 000000 setz t4, ;[199] Flag special singular case 39618 005260'01 endif. ;[199] End case expunge optimization 39619 remark t4, delepi ;[199] Falls through to epilogue with t4 set 39620 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 73 K20SRV MAC 26-Nov-23 15:09 Delete epilogue code comments on file operation 39621 subttl Delete epilogue code comments on file operation 39622 39623 ; Expects t4 to have a file count or a negative talisman 39624 39625 005260'01 200 01 0 00 000000# delepi: move t1, srvptr ;[199] Build confirmation message. 39626 005261'01 303 04 0 00 000001 caile t4, ^d1 ;[193] A single file or something odd 39627 005262'01 254 00 0 00 005276' ifskp. ;[193] Yes, that's easy enough 39628 005263'01 200 02 0 00 000000# move t2, delfa ;[199] Load singular file delete acknowledge 39629 005264'01 136 02 0 00 000001 idpb t2, t1 ;[199] Append first character 39630 repeat ^d4, < ;[199] And the other four 39631 lsh t2, -^d7 ;[199] Shift next character into place 39632 idpb t2, t1 ;[199] Append it 39633 > ;[199] End loop unroll 39634 005265'01 242 02 0 00 777771 39635 005266'01 136 02 0 00 000001 39636 005267'01 242 02 0 00 777771 39637 005270'01 136 02 0 00 000001 39638 005271'01 242 02 0 00 777771 39639 005272'01 136 02 0 00 000001 39640 005273'01 242 02 0 00 777771 39641 005274'01 136 02 0 00 000001 39642 39643 005275'01 254 00 0 00 005312' else. ;[199] Otherwise, DELNF% cleaned up a bunch 39644 005276'01 120 02 0 00 006051' dmove t2, [ exp ",", .chspc ] ;[199] Comma space over 39645 005277'01 136 02 0 00 000001 idpb t2, t1 ;[199] append the comma 39646 005300'01 136 03 0 00 000001 idpb t3, t1 ;[199] and the space 39647 005301'01 200 02 0 00 000004 move t2, t4 ;[199] Pick up the number done 39648 005302'01 201 03 0 00 000012 movei t3, ^d10 ;[199] Generations are base 10 39649 005303'01 104 00 0 00 000224 NOUT% ;[199] Convert and append 39650 005304'01 320 12 0 00 005306' %jsErr (,) ;[199] 39651 005305'01 254 00 0 00 005311' 39652 005306'01 265 01 0 00 005211* 39653 005307'01 000000000000# 39654 005310'01 254 00 0 00 005311' 39655 001310'04 103 157 165 154 144 39656 005311'01 260 17 0 00 005342' call apptxt ;[199] Append clarifying text 39657 005312'01 endif. ;[199] 39658 39659 005312'01 202 01 0 00 000000# movem t1, srvptr ; Update the string pointer. 39660 005313'01 400 02 0 00 000000 setz t2, ;[199] Cons up a .chnul 39661 005314'01 136 02 0 00 000001 idpb t2, t1 ;[199] Keep it ASCIZ 39662 005315'01 263 17 0 00 000000 ret ; Done 39663 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 74 K20SRV MAC 26-Nov-23 15:09 Handle some kind of delete error 39664 subttl Handle some kind of delete error 39665 39666 ; Expects to be called with an erjmpr or similar (NOT ercalr or pushj!) 39667 39668 005316'01 370 00 0 00 000000# delerr: sos filcnt ; "Uncount" this file, it wasn't deleted. 39669 005317'01 200 04 0 00 000001 move t4, t1 ;[199] Pass error back, if wanted 39670 005320'01 661 04 0 00 777777 tlo t4, -1 ;[199] And flag it was an error 39671 005321'01 200 01 0 00 000000# move t1, srvptr ;[199] Error, record the message 39672 005322'01 120 02 0 00 006053' dmove t2, [ exp ":", .chspc] ;[199] Load punctuation 39673 005323'01 136 02 0 00 000001 idpb t2, t1 ;[199] Append it 39674 005324'01 136 03 0 00 000001 idpb t3, t1 ;[199] 39675 005325'01 505 02 0 00 400000 hrli t2,.fhslf ;[199] This fork (LH) 39676 005326'01 540 02 0 00 000004 hrr t2, t4 ;[199] Load 'calling' error 39677 005327'01 400 03 0 00 000000 setz t3, ;[199] No limit (maybe bad idea?) 39678 005330'01 104 00 0 00 000011 ERSTR 39679 005331'01 320 14 0 00 005333' erjmps .+2 ;[199] Ignore strange return 39680 005332'01 320 14 0 00 005333' erjmps .+1 ;[199] Ignore stranger return 39681 005333'01 120 02 0 00 005704' dmove t2, [ exp .chcrt, .chlfd ] ;[199] Load line terminators 39682 005334'01 136 02 0 00 000001 idpb t2, t1 ;[199] Tie off 39683 005335'01 136 03 0 00 000001 idpb t3, t1 ;[199] the line ... 39684 005336'01 202 01 0 00 000000# movem t1, srvptr ;[199] Update the pointer 39685 005337'01 400 02 0 00 000000 setz t2, ;[199] Cons up a .chnul 39686 005340'01 136 02 0 00 000001 idpb t2, t1 ;[199] Keep it ASCIZ 39687 005341'01 263 17 0 00 000000 ret ;[199] Done with blat 39688 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 75 K20SRV MAC 26-Nov-23 15:09 ASCII text to efficiently append in arcane ways 39689 subttl ASCII text to efficiently append in arcane ways 39690 39691 ;[199] Begin code insertion 39692 39693 chgsec(code,text) ;;Text goes in section zero text 39694 000123'03 delfa: remark " [OK] " ; delete file acknowlege 39695 000123'03 273134 766640 byte (1) 0 (7) "]", "K", "O", "[", .chspc 39696 39697 000124'03 gentxt: remark " generations" ; Inflection will always be plural 39698 000124'03 313566 271640 byte (1) 0 (7) "e", "n", "e", "g", .chspc 39699 000125'03 337517 230362 byte (1) 0 (7) "o", "i", "t", "a", "r" 39700 000126'03 000000 034756 byte (1) 0 (7) .chnul, .chnul, .chnul, "s", "n" 39701 retsec ;;Back to generating code 39702 39703 ; To do: The unrolled right justified ASCIZ ", generations" text can 39704 ; be stored with 24 instructions. At what point would the MOVSLJ 39705 ; begin to outperform this? I dislike using SOUT% to shuttle 39706 ; characters. Ditto NOUT% for numbers... 39707 39708 005342'01 apptxt: remark t1, ; Expects a valid pointer in t1 39709 005342'01 200 02 0 00 000000# move t2, gentxt ; Load first part of explanatory text 39710 005343'01 136 02 0 00 000001 idpb t2, t1 ; Append first character 39711 repeat ^d4, < ; And the other four 39712 lsh t2, -^d7 ; Shift the next character into place 39713 idpb t2, t1 ; Append it 39714 > ; End loop unroll 39715 005344'01 242 02 0 00 777771 39716 005345'01 136 02 0 00 000001 39717 005346'01 242 02 0 00 777771 39718 005347'01 136 02 0 00 000001 39719 005350'01 242 02 0 00 777771 39720 005351'01 136 02 0 00 000001 39721 005352'01 242 02 0 00 777771 39722 005353'01 136 02 0 00 000001 39723 39724 005354'01 200 02 0 00 000000# move t2, gentxt+1 ; Load next part of explanatory text 39725 005355'01 136 02 0 00 000001 idpb t2, t1 ; Append first character 39726 repeat ^d4, < ; And the other four 39727 lsh t2, -^d7 ; Shift next next character into place 39728 idpb t2, t1 ; Append it 39729 > ; End loop unroll 39730 005356'01 242 02 0 00 777771 39731 005357'01 136 02 0 00 000001 39732 005360'01 242 02 0 00 777771 39733 005361'01 136 02 0 00 000001 39734 005362'01 242 02 0 00 777771 39735 005363'01 136 02 0 00 000001 39736 005364'01 242 02 0 00 777771 39737 005365'01 136 02 0 00 000001 39738 39739 005366'01 200 02 0 00 000000# move t2, gentxt+2 ; Load final part of explanatory text 39740 005367'01 136 02 0 00 000001 idpb t2, t1 ; Append first character 39741 005370'01 242 02 0 00 777771 lsh t2, -^d7 ; Shift the final character into place 39742 005371'01 136 02 0 00 000001 idpb t2, t1 ; Append it 39743 005372'01 263 17 0 00 000000 ret ; Done k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 75-1 K20SRV MAC 26-Nov-23 15:09 ASCII text to efficiently append in arcane ways 39744 39745 ;[199] End code insertion 39746 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 76 K20SRV MAC 26-Nov-23 15:09 DMPBUF - Dump the buffer [115] 39747 subttl DMPBUF - Dump the buffer [115] 39748 39749 ;[215] Begin code insertion (moved from k20mit) 39750 ; 39751 ; 39752 ; Call with SRVPTR/ current pointer (to end of string to be dumped) 39753 ; Returns +1 with t1/ new pointer. Uses t2. 39754 ; 39755 ; Dumps the buffer starting from SRVBUF thru present position, 39756 ; resets pointer SRVPTR to beginning of SRVBUF. 39757 ; 39758 ; Certain headers are hardcoded and need no termination. These are all 39759 ; up in section 1 and are referenced by one word global ASCII pointers. 39760 39761 005373'01 dmpbuf: entry dmpbuf ;[194] Also used from k20dsp 39762 005373'01 200 01 0 00 000000# move t1, srvptr ; Get current pointer. 39763 005374'01 200 03 0 00 000001 move t3, t1 ;[215] Save a copy here, just in case 39764 005375'01 200 04 0 00 000001 move t4, t1 ;[215] And another copy over here 39765 39766 005376'01 474 02 0 00 000000 seto t2, ;[215] Just in case first fetch fails 39767 005377'01 135 02 0 00 000004 ldb t2, t4 ;[215] Pick up current byte 39768 005400'01 320 12 0 00 005425' erjmpr dmpbfe ;[215] Handle an addressing error 39769 005401'01 322 02 0 00 005411' jumpe t2, dmpbf2 ;[215] Already tied off, nothing to do 39770 005402'01 474 02 0 00 000000 seto t2, ;[215] Just in case 2nd fetch fails 39771 005403'01 134 02 0 00 000004 ildb t2, t4 ;[215] No, how about the NEXT byte, then? 39772 005404'01 320 12 0 00 005425' erjmpr dmpbfe ;[215] Handle an addressing error 39773 005405'01 322 02 0 00 005411' jumpe t2, dmpbf2 ;[215] Already tied off, nothing to do 39774 39775 005406'01 403 02 0 00 000004 dmpbf1: setzb t2, t4 ;[215] Have to tie it off, then 39776 005407'01 136 04 0 00 000003 idpb t4, t3 ;[215] Make sure string is asciz. 39777 005410'01 320 12 0 00 005425' erjmpr dmpbfe ;[215] Failed?? 39778 39779 005411'01 200 01 0 00 006055' dmpbf2: move t1, [point 7, srvbuf] ; Point to buffer 39780 005412'01 202 01 0 00 000000# movem t1, srvptr ; Save new pointer. 39781 39782 005413'01 332 00 0 00 003202* ifme. srvflg ;[194] Am I not a server? 39783 005414'01 254 00 0 00 005420' 39784 005415'01 336 00 0 00 000000# skipn srvbuf ;[194] No, but is there anything to type? 39785 005416'01 254 00 0 00 005420' anskp. ;[194] No, so bum the JSYS 39786 005417'01 104 00 0 00 000076 PSOUT ; If not, print it. 39787 005420'01 endif. ;[194] 39788 39789 005420'01 402 00 0 00 000000# dmpbf3: setzm srvbuf ; Clear it. 39790 005421'01 200 01 0 00 006056' move t1, [srvbuf,,srvbuf+1] 39791 005422'01 251 01 0 00 000000# blt t1, srvbzz 39792 005423'01 200 01 0 00 000000# move t1, srvptr ; Return pointer in t1. 39793 005424'01 263 17 0 00 000000 ret 39794 39795 ; Here on some addressing error. If t2 is negative, then we failed 39796 ; on the read. If it is zero, then we failed on the write. 39797 39798 005425'01 dmpbfe: remark ;[215] Here if an addressing error 39799 005425'01 305 02 0 00 000000 caige t2, 0 ;[215] Failed the read? 39800 005426'01 334 00 0 00 000000 %ermsg (,dmpbe3) ;[215] 39801 005427'01 254 00 0 00 005433' k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 76-1 K20SRV MAC 26-Nov-23 15:09 DMPBUF - Dump the buffer [115] 39802 005430'01 265 01 0 00 005306* 39803 005431'01 000000000000# 39804 005432'01 254 00 0 00 005500' 39805 001321'04 144 155 160 142 165 39806 39807 005433'01 200 04 0 00 000001 move t4, t1 ;[215] Get error number out of the way 39808 005434'01 302 04 0 00 601775 caie t4, ILLX02 ;[215] Write-protected page, then? 39809 005435'01 334 00 0 00 000000 %ermsg (,dmpbe3) ;[215] 39810 005436'01 254 00 0 00 005442' 39811 005437'01 265 01 0 00 005430* 39812 005440'01 000000000000# 39813 005441'01 254 00 0 00 005500' 39814 001334'04 144 155 160 142 165 39815 005442'01 554 01 0 00 000003 hlrz t1, t3 ;[215] Pick up the pointer position portion 39816 005443'01 200 02 0 00 000001 move t2, t1 ;[215] Make a copy so can examine both parts 39817 005444'01 405 01 0 00 770000 andi t1, 770000 ;[215] Shut off the section 39818 005445'01 405 02 0 00 007777 andi t2, 007777 ;[215] Keep just the section 39819 ;[215] First check just the pointer 39820 remark ;[215] There will be only six possible positions 39821 005446'01 306 01 0 00 610000 cain t1, (.p0736) ;[215] Starting position? 39822 005447'01 254 00 0 00 005467' jrst dmpbe1 ;[215] Yep, OK 39823 005450'01 306 01 0 00 620000 cain t1, (.p0706) ;[215] First byte? 39824 005451'01 254 00 0 00 005467' jrst dmpbe1 ;[215] Yep, OK 39825 005452'01 306 01 0 00 630000 cain t1, (.p0713) ;[215] Second byte? 39826 005453'01 254 00 0 00 005467' jrst dmpbe1 ;[215] Yep, OK 39827 005454'01 306 01 0 00 640000 cain t1, (.p0720) ;[215] Third byte? 39828 005455'01 254 00 0 00 005467' jrst dmpbe1 ;[215] Yep, OK 39829 005456'01 306 01 0 00 650000 cain t1, (.p0727) ;[215] Fourth byte? 39830 005457'01 254 00 0 00 005467' jrst dmpbe1 ;[215] Yep, OK 39831 005460'01 306 01 0 00 660000 cain t1, (.p0734) ;[215] Fifth byte? 39832 005461'01 254 00 0 00 005467' jrst dmpbe1 ;[215] Yep, OK 39833 39834 005462'01 334 00 0 00 000000 %ermsg (,dmpbe3) ;[215] 39835 005463'01 254 00 0 00 005467' 39836 005464'01 265 01 0 00 005437* 39837 005465'01 000000000000# 39838 005466'01 254 00 0 00 005500' 39839 001346'04 144 155 160 142 165 39840 39841 005467'01 dmpbe1: remark ;[215] Here if thought to be a valid OWG ASCII ptr 39842 005467'01 302 02 0 00 000001 caie t2, extsec ;[215] In extended text psect? 39843 005470'01 334 00 0 00 000000 %ermsg (,dmpbe3) ;[215] 39844 005471'01 254 00 0 00 005475' 39845 005472'01 265 01 0 00 005464* 39846 005473'01 000000000000# 39847 005474'01 254 00 0 00 005500' 39848 001357'04 144 155 160 142 165 39849 39850 005475'01 dmpbe2: remark ;[215] Terminated string or a write error we can handle 39851 005475'01 200 01 0 00 000003 move t1, t3 ;[215] Reload original pointer 39852 005476'01 133 00 0 00 000001 ibp t1 ;[215] Pretend the idpb worked 39853 005477'01 254 00 0 00 005411' jrst dmpbf2 ;[215] Carry on 39854 39855 005500'01 dmpbe3: remark ;[215] Here on error recovery failure 39856 005500'01 200 01 0 00 006057' move t1, [point 7, srvbuf] ;[215] Just reset k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 76-2 K20SRV MAC 26-Nov-23 15:09 DMPBUF - Dump the buffer [115] 39857 005501'01 202 01 0 00 000000# movem t1, srvptr ;[215] the bufer pointer 39858 005502'01 254 00 0 00 005420' jrst dmpbf3 ;[215] And stomp the buffer 39859 39860 39861 ;[215] End code insertion 39862 39863 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 77 K20SRV MAC 26-Nov-23 15:09 Close out Code 39864 subttl Close out Code 39865 39866 xlist ; Shut off the listing 39867 list ; Turn the listing back on 39868 39869 .endps code 39870 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page 78 K20SRV MAC 26-Nov-23 15:09 Impure data area 39871 subttl Impure data area 39872 39873 .psect data 39874 39875 000000'05 tmpjfn: block 1 ;[233] Used for directory/name logging 39876 000001'05 dirbuf: block fdrmxw ;[220] Maximum size foreign directory 39877 000142'05 pasbuf: block fpwmxw ;[220] Maximum size foreign password 39878 000303'05 44 07 0 00 000000* filptr: point 7, filbuf ; Pointer to file buffer text 39879 39880 000304'05 000000 000000 filcnt: 0 ;[194] ; File counter for directory listings. 39881 000305'05 000000 000000 dirfin: 0 ;[194] ; Flag for directory listing finished. 39882 39883 000306'05 000000 000000 gclen: 0 ; Generic command data field length. 39884 000307'05 000000 000000 rufork: 0 ; Fork number for LOCAL RUN program fork. 39885 39886 ;[220] These all get the "x" overwritten 39887 39888 ;To do, they get the X overwritten sometimes... 39889 39890 000310'05 042 170 042 040 055 xxbmsg: asciz/"x" - Not valid as server command/ ; Another. 39891 000041 xxblen==^d33 ;[220] ; Number of characters in xxbmsg. 39892 000317'05 042 170 042 040 055 xxgnms: asciz/"x" - Unimplemented generic command/ 39893 000043 xxgnln==^d35 ;[220] 39894 000327'05 042 170 042 040 055 xxgums: asciz/"x" - Undefined generic command/ 39895 000037 xxguln==^d31 ;[220] 39896 000336'05 042 170 042 040 055 xxumsg: asciz/"x" - Unknown server command/ ; Server message (fill in the x) 39897 000034 xxulen==^d28 ;[220] ; Number of characters in xxumsg. 39898 39899 remark Buffer space 39900 39901 000344'05 000000 000000 getptr: 0 ;[220] ; Pointer for emptying... 39902 000345'05 000000 000000 srvptr: 0 ;[194] ; And pointer for filling... 39903 000346'05 srvbuf: xlist ;[194] ;[187] Save the trees!! 39904 list ;[187] 39905 39906 001346'05 srvbz: xlist ;[194] ;[187] 39907 list ;[187] 39908 001446'05 000000 000000 srvbzz: 0 ;[220] ;[215] Where the padding ends. 39909 39910 .endps data 39911 39912 end NO ERRORS DETECTED PROGRAM BREAK IS 000000 PSECT 1 BREAK IS 006060 FOR CODE PSECT 2 BREAK IS 000501 FOR CONST PSECT 3 BREAK IS 000127 FOR TEXT PSECT 4 BREAK IS 001372 FOR ETEXT PSECT 5 BREAK IS 001447 FOR DATA CPU TIME USED 00:01.721 129P CORE USED k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page S-1 K20SRV MAC 26-Nov-23 15:09 SYMBOL TABLE AC%CON 400000 000000 sin DOBE 104000 000104 int INILIN 000000 ext P2 000012 spd ACCES 104000 000552 int DV%AV 010000 000000 sin ISNULJ 000000 ext P3 000013 spd ATMBLN 000000 ext DV%DIR 100000 000000 sin JFNS 104000 000030 int P4 000014 spd ATMBUF 000000 ext DV%IN 200000 000000 sin JFNS% 104000 000030 int P5 000015 spd BADMSK 113777 176377 spd DV%MOD 177777 sin JOBTAB 000000 ext PAGCNT 000000 ext BCTONE 000000 ext DV%OUT 400000 000000 sin JS%DEV 700000 000000 sin PARS1 000000 ext BOUT 104000 000051 int DV%PSD 400000 sin JS%GEN 000070 000000 sin PARS2 000000 ext BYTCNT 000000 ext DV%TYP 000777 000000 sin JS%NAM 007000 000000 sin PARS3 000000 ext CALL 260740 000000 DVCHR% 104000 000117 int JS%PAF 000001 sin PARS4 000000 ext CALLRE 254000 000000 spd ELPTIM 000000 ext JS%SPC 111110 000001 sin PARS5 000000 ext CAPAS 000000 ext ENDTIM 000000 ext JS%TMP 040000 sin PARS6 000000 ext CARIER 000000 ext EPCAP 104000 000151 int JS%TYP 000700 000000 sin PBOUT 104000 000074 int CAXZOF 000000 ext ERJMP 320700 000000 int KFORK 104000 000153 int PBOUT% 104000 000074 int CCOFF 000000 ext ERJMPR 320500 000000 int LGOUT% 104000 000003 int PKTACS 000000 ext CCON 000000 ext ERJMPS 320600 000000 int LOCAL 000000 ext PKTNUM 000000 ext CFIELD 000000 ext ERRPTR 000000 ext LOGJFN 000000 ext PSOUT 104000 000076 int CFMRTN 000000 ext ERSTR 104000 000011 int LSTRX1 601405 int PSOUT% 104000 000076 int CFORK 104000 000152 int ESOUT% 104000 000313 int MAXDAT 000000 ext PTYFLG 000000 ext CHKAC% 104000 000521 int ETEXT 000000 ext MAXTRY 000000 ext PTYTTY 000000 ext CJFNBK 000000 ext EXPUNG 000000 ext MDMLIN 000000 ext PUTBUF 000000 ext CLOSF 104000 000022 int EXTSEC 000001 spd MOVASC 000000 ext Q1 000005 spd CLRBUF 000000 ext F 000000 spd MOVSLJ 016000 000000 Q2 000006 spd CLRCNO 000000 ext F$EXIT 000000 ext MXASCZ 000000 ext Q3 000007 spd CLREAD 000000 ext FB%BSZ 007700 000000 sin MXFILW 000034 spd Q4 000010 spd CLZFF 104000 000034 int FDRMXW 000141 spd MXPWLC 000047 spd Q5 000011 spd CM%ABR 000004 sin FILBFZ 000000 ext MXPWLW 000010 spd R 000000 ext CM%FNC 777000 000000 sin FILBUF 000000 ext MYCAPS 000000 ext RC%EMO 000001 000000 sin CM%FW 002000 000000 sin FILJFN 000000 ext NAK 000000 ext RC%NOM 040000 000000 sin CM%HPP 000004 000000 sin FPWMXW 000141 spd NDXJFN 000000 ext RCDIR% 104000 000553 int CM%INV 000001 sin FRCLOS 000000 ext NETJFN 000000 ext RCDIX3 601400 int CM%SDH 000001 000000 sin GET 104000 000200 int NEXT 000000 ext RD%BEL 040000 000000 sin CMDER1 000000 ext GETBUF 000000 ext NNAK 000000 ext RD%BTM 000040 000000 sin CODE 000000 ext GJ%FLG 000020 000000 sin NO%AST 010000 000000 sin RD%CRF 020000 000000 sin CONST 000000 ext GJ%IFG 000100 000000 sin NO%COL 000177 000000 sin RD%SUI 000100 000000 sin CRDATE 000000 ext GJ%NHV 002000 000000 sin NO%LFL 100000 000000 sin RDTTY 104000 000523 int CRLF 000000 ext GJ%OLD 100000 000000 sin NO%RDX 777777 sin RESET% 104000 000147 int CX 000016 GJ%SHT 000001 000000 sin NOIRTN 000000 ext RET 263740 000000 CZ%NCL 040000 000000 sin GJ%UHV 004000 000000 sin NOP 600000 000000 sin RFIELD 000000 ext CZSEEN 000000 ext GJ%ULV 001000 000000 sin NOUT 104000 000224 int RFMOD 104000 000107 int DATA 000000 ext GJ%VER 010000 000000 sin NOUT% 104000 000224 int RFTAD% 104000 000533 int DATBUF 000000 ext GJFX32 600114 int NSICI 000000 ext RLJFN 104000 000023 int DECODF 000000 ext GJINF 104000 000013 int NSIMX 000000 ext RLJFN% 104000 000023 int DELAY 000000 ext GJINF% 104000 000013 int NSITC 000000 ext RPACK 000000 ext DELF 104000 000026 int GNJFN 104000 000017 int NTIMOU 000000 ext RPAR 000000 ext DELNF% 104000 000317 int GOTS 000000 ext NUMTRY 000000 ext RPSIZ 000000 ext DEST 000000 ext GOTX 000000 ext NXTJFN 000000 ext RPTOT 000000 ext DESX3 600152 int GTAD% 104000 000227 int ODELAY 000000 ext RRINIT 000000 ext DEVST% 104000 000121 int GTDAL% 104000 000305 int ODTIM% 104000 000220 int RRSL2 000000 ext DF%EXP 200000 000000 sin GTFDB 104000 000063 int OF%BSZ 770000 000000 sin RRSLIN 000000 ext DF%NRJ 400000 000000 sin GTFDB% 104000 000063 int OF%RD 200000 sin RSKP 000000 ext DIBE% 104000 000212 int GTJFN 104000 000020 int OPENF 104000 000021 int S 400000 000000 spd DIRMXW 000012 spd GTJFN% 104000 000020 int OT%4YR 010000 000000 sin SC%GTB 200000 000000 sin DIRST 104000 000041 int HALTF% 104000 000170 int OTIMOU 000000 ext SC%LOG 040000 000000 sin DIRST% 104000 000041 int IFLG 000000 ext P 000017 SCRLFT 000000 ext DISMS% 104000 000167 int ILLX02 601775 int P1 000011 spd SCVEC% 104000 000301 int k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page S-2 K20SRV MAC 26-Nov-23 15:09 SYMBOL TABLE 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 .CMTXT 000017 sin STRBUF 000000 ext .DVDES 600000 sin STRBZ 000000 ext .DVDSK 000000 sin STRPTR 000000 ext .DVDTA 000003 sin SUBBP 000000 ext .DVNUL 000015 sin T1 000001 spd .FBBYV 000011 sin T2 000002 spd .FHSLF 400000 sin T3 000003 spd .GJALL 777775 sin T4 000004 spd .GJDEF 000000 sin TEXT 000000 ext .JIDNO 000003 sin TIMEIT 000000 ext .JILNO 000017 sin TIMOFF 000000 ext .JITNO 000001 sin TLGJFN 000000 ext .JIUNO 000002 sin TT%ECO 004000 sin .JSAOF 000001 sin TT%OSP 400000 000000 sin .NULIO 377777 sin TTXON 000000 ext .P0706 620000 000000 sin TTYJFN 000000 ext .P0713 630000 000000 sin TTYNUM 000000 ext .P0720 640000 000000 sin TYPFIL 000000 ext .P0727 650000 000000 sin TYPNAM 000000 ext .P0734 660000 000000 sin VCHRCN 000000 ext .P0736 610000 000000 sin WFORK 104000 000163 int .PRIIN 000100 sin WHAKFP 000000 ext .PRIOU 000101 sin XFLG 000000 ext .PX7 610001 000000 spd XJRSTF 254240 000000 int .RHALF 777777 sin XMOVEI 415000 000000 int .RSCRE 000003 sin XSFM 254600 000000 int .RSCRV 000001 sin $RECVB 000000 ext .RSFET 000006 sin $RECVS 000000 ext .RSWRT 000000 sin $SENDS 000000 ext .SAC 000016 %%JSER 000000 ext .XSTKS 000000 ext %%KRMS 000000 ext k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page S-3 K20SRV MAC 26-Nov-23 15:09 SYMBOL TABLE FOR PSECT CODE ACABL 000003 spd FFJFGD 005154' NUMTRY 004561' ext STATXT 006001' ext APPTXT 005342' FFUNC 004151' ext NXTJFN 005046' ext STIMOU 003201' ext ATMBLN 000000 ext FILBFZ 000000 ext ODELAY 003176' ext STRBUF 005743' ext ATMBUF 005742' ext FILBUF 005711' ext OTIMOU 003200' ext STRBZ 003317' ext BADEVC 001144' FILINF 005061' PAGCNT 005150' ext STRPTR 004407' ext BCTONE 004563' ext FILIST 001623' PARS3 004334' ext SUBBP 003622' ext BIGSOU 003250' ext FILJFN 005040' ext PARS4 004217' ext SYSNAM 002600' ext BYTCNT 001644' ext FJFNSF 111100 000001 spd PARS5 000537' ext TAKDEP 004363' ext CAPAS 004266' ext FRCLOS 005052' ext PKTACS 004553' ext TAKJFN 000323' ext CARIER 002623' ext GETARG 003313' PKTNUM 004562' ext TIMEIT 003155' ext CAXZOF 004517' ext GETBUF 004412' ext PTYFLG 003160' ext TIMOFF 003174' ext CCOFF 004554' ext GETCM2 002610' PTYTTY 003162' ext TLGJFN 004132' ext CCON 004400' ext GETCMM 002605' PUTBUF 004550' ext TTXON 005767' ext CFIELD 002044' ext GETCOM 002545' ent PUTSCH 003301' ent TTYJFN 003157' ext CFMRTN 004212' ext GETPAS 000301' PUTTCH 003303' ent TTYNUM 002555' ext CJFNBK 006010' ext GOTS 004713' ext PWCONP 000642' TYPFIL 002474' ext CLENUP 003207' ext GOTX 004645' ext R 005213' ext TYPNAM 002443' ext CLRBUF 004564' ext GTNERR 005032' RFIELD 004175' ext UDJINF 000274' ent CLRCNO 002436' ext GTNFIL 004754' ent RPACK 004443' ext VCHRCN 000021' ext CLREAD 000014' ext GTSCH 003272' ent RPAR 003264' ext WHAKFP 002511' ext CMDER1 004243' ext GTSCHX 003274' RPTOT 002627' ext XFLG 004160' ext CRDATE 005152' ext GTSCHZ 003276' RRINIT 002755' ext XGCWD 003345' CRLF 005660' ext HDRPTR 001413' RRSL2 004556' ext XGCWD2 003356' CWDEVE 000624' HDRTXT 001376' RRSLIN 003175' ext XGCWD3 003371' CZSEEN 004764' ext HLPNTR 000000 ext RSKP 005232' ext XGCWD4 003434' DATBUF 005773' ext IFLG 004607' ext SCRLFT 004140' ext XGCWD5 003446' DECODF 002764' ext INILIN 004370' ext SCRUBP 000467' XGCWDZ 003461' DEFDIR 000163' ISDIRD 004723' ent SDELBK 004073' XGDEL 004105' DELAY 003177' ext ISNULJ 004723' ext SDIRB2 003742' XGDEL2 004115' DELEPI 005260' JOBTAB 000000 ext SDIRBK 004061' XGDIR 003754' DELERR 005316' LOCAL 004555' ext SEOLCH 002065' ext XGDIR2 003777' DELFIL 005233' MAXDAT 004411' ext SETLOG 004566' ext XGDIS2 003545' DEST 004552' ext MAXTRY 004425' ext SINFO 004560' ent XGDISK 003510' DIRCH 003723' ent MDMLIN 002622' ext SINFO2 004571' XGDISZ 003574' DIRCH2 003726' MOVASC 001534' ext SINFOX 004605' XGEN 003024' DIRCHX 003735' MOVCHR 001604' int SINFOZ 004607' XGFIN 003106' DIRCHZ 003737' MXASCZ 000000 ext SINIT 004573' ext XGFIN2 003134' DIRHDR 001420' MYCAPS 000000 ext SOURCE 004533' ext XGHEL1 003712' DIRLST 001452' NAK 002657' ext SPACK 004440' ext XGHELP 003676' DIRLSZ 001553' NDXJFN 005054' ext SPAR 004577' ext XGLOG1 003175' DMPBE1 005467' NETJFN 003156' ext SPEED 002561' ext XGLOGO 003150' DMPBE2 005475' NEXT 004410' ext SPSIZ 003633' ext XGNYI 003103' DMPBE3 005500' NNAK 004372' ext SPTOT 002626' ext XGPWD 003602' DMPBF1 005406' NOIRTN 004167' ext SRVCM2 004424' XGSTAT 003655' DMPBF2 005411' NSICI 000017' ext SRVCMA 004405' XGTYPE 003220' DMPBF3 005420' NSIMX 000024' ext SRVCMD 004363' XGUNDF 003100' DMPBFE 005425' NSITC 000022' ext SRVCMX 004516' XHLPTR 000000000000# pol DMPBUF 005373' ent NTIMOU 004373' ext SRVCMZ 004536' XHOST 003016' DOSRV 004635' ent NUL4 001416' int SRVFI3 004626' XINFO 003260' DOSRV3 004711' NULDEV 001415' SRVFIL 004611' XRECV 002762' ELPTIM 004521' ext NULDIR 001574' SRVFLG 005413' ext XRECV2 002774' ENDTIM 004520' ext NULFDB 005057' SRVHLP 000000 ext XSEND 002744' ERRPTR 004720' ext NULFIL 001602' SRVTIM 002634' ext XXCMD 002673' EXPUNG 005240' ext NULINF 005147' SRVXX 004365' XXGCMD 003045' F$EXIT 003210' ext NULIST 001606' STATIM 004377' ext XXINV 002731' k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page S-4 K20SRV MAC 26-Nov-23 15:09 SYMBOL TABLE FOR PSECT CODE XXMSG 002733' ..0206 000240' spd ..0634 001367' spd ..1215 002341' spd XXUNK 002726' ..0224 000242' spd ..0641 001343' spd ..1216 002343' spd XXWAIT 002622' ..0225 000247' spd ..0642 001346' spd ..1224 002350' spd $BYE 000004' ent ..0231 000272' spd ..0643 001352' spd ..1234 002375' spd $BYEZ 000050' ..0241 000307' spd ..0653 001372' spd ..1235 002431' spd $FINIS 002010' ent ..0252 000316' spd ..0654 001375' spd ..1242 002404' spd $RECVB 004715' ext ..0260 000351' spd ..0655 001446' spd ..1243 002431' spd $RECVS 002757' ext ..0303 000402' spd ..0662 001447' spd ..1250 002420' spd $SENDS 004161' ext ..0304 000424' spd ..0667 001437' spd ..1251 002423' spd $SRVT 003670' ext ..0314 000441' spd ..0670 001443' spd ..1262 002433' spd $XCWD 001004' ..0320 000465' spd ..0675 001500' spd ..1263 002510' spd $XDELE 001154' ..0335 000477' spd ..0676 001505' spd ..1270 002452' spd $XDIRE 001701' ..0346 000526' spd ..0677 001521' spd ..1271 002474' spd $XDISK 002202' ent ..0350 000550' spd ..0711 001517' spd ..1276 002457' spd $XERR 001740' ..0365 000611' spd ..0712 001521' spd ..1277 002462' spd $XHELP 002022' ent ..0366 000614' spd ..0714 001540' spd ..1307 002516' spd $XHOST 002046' ent ..0401 000662' spd ..0721 001544' spd ..1315 002542' spd $XPWD 002125' ent ..0402 000665' spd ..0727 001552' spd ..1324 002542' spd $XSTAT 002222' ..0403 000666' spd ..0735 001567' spd ..1327 002575' spd $XTYPE 002517' ent ..0412 000710' spd ..0736 001571' spd ..1343 002574' spd $YCWD 000507' ent ..0414 000723' spd ..0751 001634' spd ..1364 002636' spd $YCWDX 000557' ..0422 000752' spd ..0752 001637' spd ..1365 002662' spd $YCWDY 000564' ..0430 001001' spd ..0753 001662' spd ..1372 002656' spd $YCWDZ 000574' ..0442 001025' spd ..0760 001665' spd ..1373 002662' spd $YDELE 001073' ent ..0443 001026' spd ..0765 001671' spd ..1411 003011' spd $YDIR1 001367' ..0451 001026' spd ..0766 001673' spd ..1421 003130' spd $YDIRE 001325' ent ..0452 001032' spd ..0773 001700' spd ..1426 003132' spd $YDISK 002134' ent ..0453 001052' spd ..0775 001724' spd ..1434 003172' spd $YPWD 002104' ent ..0466 001043' spd ..1004 001724' spd ..1441 003174' spd $YRUN 004244' ent ..0467 001047' spd ..1013 001753' spd ..1452 003256' spd $YRUN2 004337' ..0476 001072' spd ..1014 001761' spd ..1461 003256' spd $YSRVT 002211' ent ..0504 001110' spd ..1022 001770' spd ..1470 003255' spd $YTYPE 002361' ent ..0505 001144' spd ..1023 001774' spd ..1475 003330' spd $YTYPY 002510' ..0506 001106' spd ..1030 002034' spd ..1476 003337' spd $YTYPZ 002513' ..0520 001120' spd ..1037 002034' spd ..1511 003377' spd %%JSER 005472' ext ..0521 001123' spd ..1044 002057' spd ..1512 003401' spd %%KRMS 004125' ext ..0522 001127' spd ..1052 002057' spd ..1550 003532' spd %%SMSG 003544' ext ..0527 001177' spd ..1070 002061' spd ..1551 003535' spd %KERMS 004111' ext ..0536 001177' spd ..1071 002065' spd ..1577 003670' spd %WTLOG 004141' ext ..0551 001250' spd ..1114 002155' spd ..1606 003670' spd ..0103 000014' spd ..0552 001251' spd ..1115 002162' spd ..1611 003711' spd ..0104 000040' spd ..0557 001230' spd ..1132 002234' spd ..1620 003711' spd ..0105 000034' spd ..0560 001233' spd ..1141 002234' spd ..1623 003771' spd ..0126 000070' spd ..0561 001247' spd ..1152 002304' spd ..1640 004010' spd ..0134 000103' spd ..0566 001243' spd ..1153 002305' spd ..1641 004026' spd ..0135 000136' spd ..0567 001246' spd ..1160 002264' spd ..1651 004045' spd ..0142 000114' spd ..0570 001247' spd ..1161 002267' spd ..1660 004045' spd ..0143 000133' spd ..0575 001260' spd ..1162 002303' spd ..1673 004147' spd ..0152 000124' spd ..0576 001322' spd ..1167 002277' spd ..1702 004147' spd ..0153 000126' spd ..0603 001265' spd ..1170 002302' spd ..1714 004203' spd ..0154 000130' spd ..0604 001266' spd ..1171 002303' spd ..1722 004221' spd ..0161 000145' spd ..0614 001305' spd ..1176 002314' spd ..1746 004326' spd ..0167 000155' spd ..0615 001307' spd ..1177 002356' spd ..1747 004337' spd ..0204 000227' spd ..0623 001314' spd ..1204 002321' spd ..2007 004470' spd ..0205 000241' spd ..0633 001333' spd ..1205 002322' spd ..2017 004531' spd k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page S-5 K20SRV MAC 26-Nov-23 15:09 SYMBOL TABLE FOR PSECT CODE ..2025 004553' spd .XPWD 002121' ent ..2033 004601' spd .XSTAT 002216' ent ..2042 004622' spd .XSTKS 005164' ext ..2043 004626' spd .YCWD 000052' ent ..2045 004710' spd .YDELE 001054' ent ..2052 004665' spd .YDIRE 001202' ent ..2053 004670' spd .YDISK 002130' ent ..2060 004704' spd .YPWD 002100' ent ..2061 004707' spd .YRUN 004164' ent ..2066 004716' spd .YTYPE 002237' ent ..2077 004727' spd ..2105 004733' spd ..2106 004737' spd ..2107 004740' spd ..2110 004753' spd ..2122 004762' spd ..2130 005003' spd ..2131 005007' spd ..2136 005020' spd ..2137 005030' spd ..2144 005024' spd ..2145 005027' spd ..2147 005041' spd ..2155 005047' spd ..2163 005055' spd ..2200 005107' spd ..2201 005147' spd ..2211 005144' spd ..2212 005162' spd ..2232 005224' spd ..2233 005230' spd ..2234 005231' spd ..2241 005240' spd ..2243 005254' spd ..2250 005260' spd ..2251 005253' spd ..2263 005276' spd ..2264 005312' spd ..2270 005420' spd ..IFT 004000 000001 spd ..JX1 004000 000000 spd ..MX1 100120 000000 spd ..MX2 000001 spd ..TX1 004000 000000 spd ..TX2 000001 spd .BYE 000000' ent .FINIS 002004' ent .RMFIL 001147' .STAT 002205' ent .XCWD 000670' ent .XCWD1 000762' .XDISK 002176' ent .XERR 001727' .XHELP 002016' ent .XHOST 002041' k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page S-6 K20SRV MAC 26-Nov-23 15:09 SYMBOL TABLE FOR PSECT CONST DELBK 000121' DELBKL 000010 spd DIRBK 000144' DIRBKL 000010 spd LOCTAB 000000' int NULEND 000014 NULENT 000003 NULMSG 000016 NULPRG 000305' REMTAB 000017' int RMFFDB 000135' RUNBK 000263' RUNBKL 000010 spd TYPBK 000224' TYPBKL 000010 spd TYPFDB 000234' XCWFDB 000076' XERFDB 000167' XHOFDB 000202' XPWFDB 000107' YCWFDB 000042' YDEFDB 000131' YDIFDB 000154' YPWFDB 000053' YRRFDB 000275' YRUFDB 000273' ..XX 010004 000000 spd k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page S-7 K20SRV MAC 26-Nov-23 15:09 SYMBOL TABLE FOR PSECT TEXT DELFA 000123' GENTXT 000124' PWDPRM 000120' k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 20:02 27-Nov-23 Page S-8 K20SRV MAC 26-Nov-23 15:09 SYMBOL TABLE FOR PSECT DATA DIRBUF 000001' DIRFIN 000305' FILBUF 000303' ext FILCNT 000304' FILPTR 000303' GCLEN 000306' GETPTR 000344' PASBUF 000142' RUFORK 000307' SRVBUF 000346' SRVBZ 001346' SRVBZZ 001446' SRVPTR 000345' TMPJFN 000000' XXBLEN 000041 spd XXBMSG 000310' XXGNLN 000043 spd XXGNMS 000317' XXGULN 000037 spd XXGUMS 000327' XXULEN 000034 spd XXUMSG 000336' k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 1 K20SUB MAC 25-Nov-23 13:11 Preliminaries 39913 title k20sub - Kermit-20 Semantic Action and Support Subroutines 39914 remark Moved to seperate module as part of 194 to address MCRNEC 39915 39916 subttl Preliminaries 39917 39918 search monsym,macsym,k20unv 39919 cmdacs ^ ;Clean up p1-p4 definitions 39920 .xcmsy ^ ;Ditch MACSYM nonsense 39921 39922 sall ; Tidy listing 39923 .directive flblst ; We don't need to see all the ASCIZ bytes... 39924 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 2 K20SUB MAC 25-Nov-23 13:11 common parsing external data 39925 subttl common parsing external data 39926 39927 extern pars1 ; Data from first parse. 39928 extern pars2 ; Data from second parse. 39929 extern pars3 ; Data from third parse. 39930 extern pars4 ; Data from fourth parse. 39931 extern pars5 ;[41] ... 39932 39933 remark cmd storage 39934 39935 extern cjfnbk ; Actually in CMD.MAC 39936 extern atmbuf ; Atom buffer, in CMD.MAC 39937 extern sbk ; State Block 39938 39939 remark file related storage 39940 39941 extern filjfn ; Current file 39942 extern nxtjfn ; Next file in sequence 39943 extern ndxjfn ; Stepping JFN (with flags) 39944 extern strbuf ; String buffer (to build things in, Etc.) 39945 39946 remark Terminal and other JFN's 39947 39948 extern ttyjfn ; JFN on local terminal 39949 extern $PRIOU ;[220] Whatever we think primary output should be 39950 extern udjinf ;[220] Updates jobtab for use by this routine 39951 extern tlgjfn ; Transaction log JFN 39952 39953 remark other stuff 39954 39955 extern czseen ; ^Z seen (typed) 39956 extern crlf ; Carriage Return, Linefeed string 39957 extern nul4 ; Pointer to NUL: string and length 39958 extern scrlft ;[233] ; Set to -1 to suppress trailing CRLF in transaction log 39959 extern jobtab ; My job information 39960 39961 extern errptr ; Error message pointer 39962 extern pktnum ;[234] ; Packet number 39963 extern spack ;[234] ; Send a packet 39964 extern spsiz ;[234] ; Sending packet size 39965 extern subbp ;[234] ; 'Subtract' two byte pointers 39966 extern %%krbf ;[234] ; Buffer to construct an error pack 39967 39968 .psect code/ronly ;[190] Don't allow stores 39969 39970 ; To do: Needs a double float (dfltr) 39971 ; 39972 ; Could do the fltr, then extract the exponent and use it to do 39973 ; an ashc on the double word. 39974 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 3 K20SUB MAC 25-Nov-23 13:11 Support routines for error handling macros. 39975 subttl Support routines for error handling macros. 39976 39977 ;[234] Moved here from K20MIT.MAC 39978 39979 ; KERMSG -- Send an error message to the KERMIT on the other side in an 39980 ; error packet. Invoked from %JSKER, with T1 pointing at the user-provided 39981 ; prefix (if any), to which the JSYS error message is appended. 39982 ; 39983 ; As part of [194], rewritten to offload most the macro expansion and 39984 ; do more of the work here. Saves some memory by not always duplicating 39985 ; the KERMIT-20: prefix 39986 ; 39987 ; Called 39988 ; 39989 ; jsp t1,%%krms 39990 ; 39991 ; t1 offsets: 39992 ; 39993 ; +0: Address of ASCII text or zero 39994 ; +1: Jump address or zero 39995 ; +2: Return address (implied) 39996 39997 000000'01 blanks: xlist ; We don't need to see all the .chspc's... 39998 list 39999 000030 blankl==<.-blanks> ; Length of blank array 40000 40001 000030'01 000000 000000' krxblt: blanks ; Source block of memory 40002 000031'01 000000000000# %%krbf ; Destination block 40003 000032'01 44 07 0 00 000000* krxptr: point 7, %%krbf ; Pointer to (scrubbed) buffer 40004 40005 000033'01 44 07 0 00 000254' k20ptr: point 7, k20hdr ; Point to header text 40006 000034'01 000000 000013 ^d11 ; Length of header 40007 40008 000035'01 %%krms: entry %%krms ;[213] Declare for the world 40009 000035'01 415 16 0 00 000130' block. ; Enter block context for a stack frame 40010 000036'01 261 17 0 00 000016 40011 000037'01 265 16 0 00 004102' saveac ;Get some registers to enjoy ourselves with 40012 000040'01 200 05 0 00 000001 move q1, t1 ; Save argument/return pointer 40013 40014 000041'01 201 01 0 00 000030 movei t1, blankl ; Set up XBLT block 40015 000042'01 120 02 0 00 000030' dmove t2, krxblt 40016 000043'01 123 01 0 00 004116' xblt. t1 ; Scrub the buffer with blanks 40017 40018 000044'01 200 01 0 00 000032' move t1, krxptr ; Load pointer to scrubbed buffer 40019 000045'01 120 03 0 00 000033' dmove t3,k20ptr ; Load pointer to header text 40020 remark t4,count ; Length of same 40021 000046'01 200 06 0 00 000004 move q2, t4 ; Begin length of message 40022 40023 000047'01 do. ; Enter loop lexical context 40024 000047'01 134 02 0 00 000003 ildb t2, t3 ; Pick up a byte 40025 000050'01 136 02 0 00 000001 idpb t2, t1 ; Deposit it 40026 000051'01 367 04 0 00 000047' sojg t4, top. ; Do all of them 40027 000052'01 enddo. ; Fall out of loop lexical context 40028 40029 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 20:02 27-Nov-23 Page 3-1 K20SUB MAC 25-Nov-23 13:11 Support routines for error handling macros. 40030 000053'01 254 00 0 00 000065' ifskp. ; Got passed something 40031 000054'01 do. ; and copy the characters over 40032 000054'01 134 02 0 00 000003 ildb t2, t3 ; Get the byte. 40033 000055'01 322 02 0 00 000060' jumpe t2, endlp. ; Exit if a null 40034 000056'01 136 02 0 00 000001 idpb t2, t1 ; Deposit the byte. 40035 000057'01 344 06 0 00 000054' aoja q2, top. ; Loop and increment tally 40036 000060'01 enddo. ; Never falls out; explicit exit 40037 ; Tack on " - " 40038 000060'01 120 02 0 00 004117' dmove t2, [exp .chspc, .chdas] 40039 000061'01 136 02 0 00 000001 idpb t2, t1 ; Append the space 40040 000062'01 136 03 0 00 000001 idpb t3, t1 ; Append the dash 40041 000063'01 136 02 0 00 000001 idpb t2, t1 ; Append the space after that 40042 000064'01 271 06 0 00 000003 addi q2, ^d3 ; Account for three more characters 40043 000065'01 endif. 40044 40045 remark t1, ; Put the Tops-20 error string into the buffer. 40046 000065'01 525 02 0 00 400000 hrloi t2, .fhslf ; Say: this fork ,, last error. 40047 000066'01 210 03 0 00 000000* movn t3, spsiz ; Specify the maximum to send as a negative 40048 000067'01 270 03 0 00 000006 add t3, q2 ; number (don't overflow the buffer) 40049 000070'01 517 00 0 00 000003 hrlzs t3 ;[74] (ERSTR wants -n,,0) 40050 000071'01 325 03 0 00 000102' ifl. t3 ;[50] (don't bother if not negative). 40051 000072'01 104 00 0 00 000011 ERSTR% 40052 000073'01 320 14 0 00 000075' erjmps .+2 ; Ignore its strange return 40053 000074'01 320 14 0 00 000075' erjmps .+1 ; Ignore its stranger return 40054 000075'01 200 02 0 00 000001 move t2, t1 ; Set up to get the new length. 40055 000076'01 200 01 0 00 000032' move t1, krxptr ; Load pointer to partially filled buffer 40056 000077'01 260 17 0 00 000000* call subbp ; Subtract byte pointers. 40057 000100'01 254 00 0 00 000102' anskp. ;[40] If there is an error assume this count. 40058 remark ; Worked, so don't hit the else. 40059 000101'01 254 00 0 00 000103' else. ; Otherwise... 40060 000102'01 200 03 0 00 000006 move t3, q2 ; Don't trust ERSTR% 40061 000103'01 endif. ; End case fence post checking 40062 40063 000103'01 313 03 0 00 000066* camle t3, spsiz ;[40] Longer than we're supposed to send? 40064 000104'01 200 03 0 00 000103* move t3, spsiz ;[40] If so, truncate it. 40065 000105'01 200 06 0 00 000003 move q2, t3 ; Save whatever the length is 40066 000106'01 201 01 0 00 000105 movei t1, "E" ; An error packet. 40067 000107'01 200 02 0 00 000000* move t2, pktnum ; Packet number. 40068 000110'01 200 04 0 00 000032' move t4, krxptr ; Load pointer to finished buffer 40069 000111'01 260 17 0 00 000000* call spack ; Send the error packet. 40070 000112'01 600 00 0 00 000000 nop 40071 40072 000113'01 332 00 0 00 000000* ifme. srvflg ;[234] ; If a server, NOT safe to type 40073 000114'01 254 00 0 00 000126' 40074 000115'01 200 01 0 00 000032' move t1, krxptr ; Load pointer to finished buffer 40075 000116'01 200 02 0 00 000006 move t2, q2 ; Load final character count 40076 000117'01 133 02 0 00 000001 adjbp t2, t1 ; Go to end of character string 40077 000120'01 120 03 0 00 004121' dmove t3, [ exp .chcrt, .chlfd ] 40078 000121'01 136 03 0 00 000002 idpb t3, t2 ; Drop in a CR-LF 40079 000122'01 136 04 0 00 000002 idpb t4, t2 40080 000123'01 400 03 0 00 000000 setz t3, ; Cons up a NUL 40081 000124'01 136 03 0 00 000002 idpb t3, t2 ; Tie off the string 40082 000125'01 104 00 0 00 000313 ESOUT% ; Finally whine about our problems 40083 000126'01 endif. ;[234] ; End case local output 40084 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 20:02 27-Nov-23 Page 3-2 K20SUB MAC 25-Nov-23 13:11 Support routines for error handling macros. 40085 000127'01 263 17 0 00 000000 endbk. ; Restore registers, tear down the stack 40086 40087 000130'01 326 01 0 01 000000 jumpn t1, (t1) ; Go somewhere, if told to 40088 000131'01 104 00 0 00 000170 HALTF% ; Cease execution 40089 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 20:02 27-Nov-23 Page 4 K20SUB MAC 25-Nov-23 13:11 Support routines for error handling macros. 40090 40091 ; Support for kermsg. Written for maximum reduction of kermsg() macro 40092 ; 40093 ; All part of [194] 40094 40095 000133'01 %kerms: entry %kerms ; Globally available 40096 000133'01 261 17 0 00 000012 push p, p2 ; Save p2 (not aliased) 40097 000134'01 200 12 0 00 000001 move p2, t1 ; Save return and argument address 40098 000135'01 201 01 0 00 000105 movei t1, "E" ; Send an error packet to the other side. 40099 000136'01 200 02 0 00 000107* move t2, pktnum ; Packet number. 40100 000137'01 120 03 0 12 000000 dmove t3, (p2) ; Pick up count and text address 40101 000140'01 202 04 0 00 000000* movem t4, errptr ; Save pointer to error msg for status. 40102 000141'01 260 17 0 00 000111* call spack ; Send the error packet. 40103 000142'01 600 00 0 00 000000 nop 40104 000143'01 336 00 0 00 000113* ifmn. srvflg ;[234] ; If local, safe to type 40105 000144'01 254 00 0 00 000153' 40106 000145'01 561 01 0 00 000254' hrroi t1, k20hdr ; Load start of message 40107 000146'01 104 00 0 00 000313 ESOUT% ;[187] ; Begin whining 40108 000147'01 200 01 0 12 000001 move t1, 1(p2);[202] ; Same message 40109 000150'01 104 00 0 00 000076 PSOUT% ; Type that, too 40110 000151'01 561 01 0 00 000000* hrroi t1, crlf ; Tie off the line 40111 000152'01 104 00 0 00 000076 PSOUT% 40112 000153'01 endif. ;[234] ; End case local output 40113 000153'01 200 01 0 00 000012 move t1, p2 ; Restore calling t1 40114 000154'01 262 17 0 00 000012 pop p, p2 ; Restore p2 40115 000155'01 271 01 0 00 000002 addi t1,^d2 ; Skip past both arguments 40116 000156'01 254 00 0 01 000000 jrst (t1) ; Finally done 40117 40118 ;[234] End move from K20MIT.MAC 40119 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 5 K20SUB MAC 25-Nov-23 13:11 Macro support routines 40120 subttl Macro support routines 40121 40122 ; JSERR0 synchronizes with terminal i/o in progress before typing the 40123 ; JSYS error message. 40124 ; 40125 ; JSMSG0 just types the JSYS error message. 40126 ; 40127 ; These names where changed in order to not conflict with routines of the 40128 ; same name in MACSYM (MACREL). Also removed CFIBF% and DOBE% as part of 40129 ; edit 187 as ESOUT% does this. 40130 ; 40131 ; No macro should EVER invoke these directly 40132 40133 000157'01 561 01 0 00 004123' kserr0: tmsg < - > ; Type a dash. 40134 000160'01 104 00 0 00 000076 40135 40136 000161'01 ksmsg0: remark ; Alternate entry 40137 000161'01 201 01 0 00 000101 movei t1,.priou 40138 000162'01 525 02 0 00 400000 hrloi t2,.fhslf ; This fork ,, last error. 40139 000163'01 400 03 0 00 000000 setz t3, 40140 000164'01 104 00 0 00 000011 ERSTR% 40141 000165'01 320 12 0 00 000167' erjmpr .+2 40142 000166'01 320 12 0 00 000167' erjmpr .+1 40143 000167'01 263 17 0 00 000000 ret 40144 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 6 K20SUB MAC 25-Nov-23 13:11 Support for wtlog 40145 subttl Support for wtlog 40146 40147 ;[194] Begin Code Insertion 40148 40149 ; Rewritten for maximum reduction of expansion wtlog() macro 40150 40151 000170'01 %wtlog: entry %wtlog ; Globally available 40152 000170'01 260 17 0 00 000173' call %wtlgf ; Set up a logging frame 40153 000171'01 271 01 0 00 000003 addi t1, ^d3 ; Skip past the three arguments 40154 000172'01 254 00 0 01 000000 jrst (t1) ; Finally done 40155 ;[233] Needs plenty registers for intersection transfers 40156 000173'01 265 16 0 00 004124' %wtlgf: saveac ;[233] 40157 000174'01 621 01 0 00 777700 txz t1, klflgs ; Don't mess up addressing 40158 000175'01 200 05 0 00 000001 move q1, t1 ;[233] Save arguments accumulator 40159 000176'01 337 01 0 00 000000* skipg t1, tlgjfn ; Is the transaction log open? 40160 000177'01 263 17 0 00 000000 ret ; Nope, so nothing to do 40161 40162 ;;;; 40163 ;;;; cain t1, .nulio ;[193] Not really going to do anything? 40164 ;;;; ret ;[193] Fine, then don't really do anything 40165 40166 000200'01 474 02 0 00 000000 seto t2, ; Start with time stamp, current date/time. 40167 000201'01 205 03 0 00 400000 movx t3, ot%nda ; No date in stream 40168 000202'01 104 00 0 00 000220 ODTIM% 40169 000203'01 320 14 0 00 000204' erjmps .+1 ; Catch and suppress errors 40170 000204'01 201 02 0 00 000072 movei t2, ":" 40171 000205'01 104 00 0 00 000051 BOUT% 40172 000206'01 320 14 0 00 000207' erjmps .+1 40173 000207'01 201 02 0 00 000040 movei t2, .chspc 40174 000210'01 104 00 0 00 000051 BOUT% 40175 000211'01 320 14 0 00 000212' erjmps .+1 40176 40177 000212'01 120 02 0 05 000000 dmove t2, 0(t5) ; Load string pointer and length 40178 000213'01 322 02 0 00 000225' ifn. t2 ;[216] Load string and (negative) count 40179 000214'01 301 03 0 00 000000 cail t3,0 ;[216] Better be a negative number 40180 000215'01 254 00 0 00 000225' anskp. ;[216] But wasn't 40181 000216'01 254 14 0 00 000007 xsfm q3 ;[233] Get and store current processor flags 40182 000217'01 200 10 0 00 000000# move q4, bigsou ;[233] Load up inter-section transfer address 40183 000220'01 201 11 0 00 000222' movei q5, .+2 ;[233] And the inter-section return adress 40184 000221'01 254 05 0 00 000007 xjrstf q3 ;[233] and take a giant step! 40185 000222'01 201 02 0 00 000040 movei t2, .chspc 40186 000223'01 104 00 0 00 000051 BOUT% 40187 000224'01 320 14 0 00 000225' erjmps .+1 40188 000225'01 endif. 40189 40190 000225'01 337 03 0 05 000002 skipg t3, 2(t5) ;[216] Load a JFN, maybe 40191 000226'01 254 00 0 00 000245' ifskp. ; Some kind of an address 40192 000227'01 337 02 0 03 000000 skipg t2, (t3) ; Pick up the actual JFN 40193 000230'01 254 00 0 00 000245' anskp. ; Unless not holding one 40194 000231'01 302 02 0 00 377777 caie t2, .nulio ; Dumping it? 40195 000232'01 254 00 0 00 000237' ifskp. ; That's easy! 40196 000233'01 120 02 0 00 000000* dmove t2, nul4 ; Constant string and length 40197 000234'01 104 00 0 00 000053 SOUT% 40198 000235'01 320 14 0 00 000236' erjmps .+1 40199 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 20:02 27-Nov-23 Page 6-1 K20SUB MAC 25-Nov-23 13:11 Support for wtlog 40200 000237'01 120 03 0 00 004144' dmove t3, [exp <111110,,js%paf>, 0] 40201 000240'01 104 00 0 00 000030 JFNS% 40202 000241'01 320 14 0 00 000242' erjmps .+1 ; Catch and suppress error 40203 000242'01 endif. ; End NUL: special case 40204 000242'01 201 02 0 00 000040 movei t2, .chspc ;[233] 40205 000243'01 104 00 0 00 000051 BOUT% ;[233] 40206 000244'01 320 14 0 00 000245' erjmps .+1 ;[233] 40207 000245'01 endif. ; End case JFN handling 40208 40209 000245'01 356 00 0 00 000000* aosn scrlft ;[233] ; Wants to suppress trailing CRLF in transaction log? 40210 000246'01 263 17 0 00 000000 ret ;[233] ; Yes, so we're done 40211 40212 000247'01 561 02 0 00 000151* hrroi t2, crlf 40213 000250'01 120 03 0 00 004146' dmove t3,[ exp -2, 0] 40214 000251'01 104 00 0 00 000053 SOUT% 40215 000252'01 320 14 0 00 000253' erjmps .+1 40216 000253'01 263 17 0 00 000000 ret 40217 40218 ;[194] End Code Insertion 40219 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 7 K20SUB MAC 25-Nov-23 13:11 Support for %jserr. 40220 subttl Support for %jserr. 40221 40222 ;[194] Begin Code Insertion 40223 40224 ; Rewritten for maximum reduction of %jserr() macro 40225 ; 40226 ; N.B., If not given a label, the previous version of the macro would 40227 ; do a HALTF% allowing a continue. However, no code existed any 40228 ; longer which leveraged this functionality. It has been 40229 ; removed an replaced with returning +1 if no label is given as 40230 ; passing a +1 to the current macro will do the wrong thing 40231 40232 000254'01 k20hdr: intern k20hdr ; Used by other error routines in k20mit 40233 000254'01 113 105 122 115 111 asciz |KERMIT-20: | ; Start of any error message 40234 40235 000257'01 %%jser: entry %%jser ; Used in other parts of Kermit Planet 40236 000257'01 415 16 0 00 000310' block. ; Enter block context (build stack frame) 40237 000260'01 261 17 0 00 000016 40238 000261'01 265 16 0 00 004150' saveac ; Save a bunch of accumulators 40239 000262'01 621 01 0 00 777700 txz t1, klflgs ; Don't mess up addressing 40240 000263'01 200 12 0 00 000001 move p2,t1 ; Save return accumulator 40241 000264'01 561 01 0 00 000254' hrroi t1, k20hdr ; Load pointer to first part of error 40242 000265'01 104 00 0 00 000313 ESOUT% ;[187] Begin whining, compliantly 40243 000266'01 320 12 0 00 000267' erjmpr .+1 ; Catch and ignore error 40244 000267'01 336 01 0 12 000000 skipn t1, 0(p2) ; Pick up the text pointer 40245 000270'01 254 00 0 00 000275' ifskp. ; That is, if there is one 40246 000271'01 104 00 0 00 000076 PSOUT% ; Give us that bit of news... 40247 000272'01 320 12 0 00 000273' erjmpr .+1 ; Catch and ignore error 40248 000273'01 260 17 0 00 000157' call kserr0 ; Put JSYS error after dash, 40249 000274'01 254 00 0 00 000276' else. ; Otherwise, no need for the dash 40250 000275'01 260 17 0 00 000161' call ksmsg0 ; so right after "?KERMIT-20: " 40251 000276'01 endif. ; End case, auxiliary message 40252 000276'01 561 01 0 00 004164' tmsg < at: > ; Say where it happened. 40253 000277'01 104 00 0 00 000076 40254 000300'01 201 01 0 12 777775 movei t1, -3(p2) ; Calculate address of failing JSYS 40255 000301'01 621 01 0 00 777700 txz t1, klflgs ; Flags aren't part of the address 40256 000302'01 260 17 0 00 004042' call symout ; Type it symbolically 40257 000303'01 561 01 0 00 000247* hrroi t1,crlf ; And a trailing CR-LF. 40258 000304'01 104 00 0 00 000076 PSOUT% 40259 000305'01 320 12 0 00 000306' erjmpr .+1 ; Catch and ignore error 40260 000306'01 200 01 0 12 000001 move t1, 1(p2) ; Load a jump (or return) address 40261 000307'01 263 17 0 00 000000 endbk. ; Exit block context 40262 ; Tears down the stack frame 40263 000310'01 254 00 0 01 000000 jrst (t1) ; Go someplace and do something 40264 40265 .endps code ; Get out of section zero 40266 40267 ;[194] End Code Insertion 40268 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 8 K20SUB MAC 25-Nov-23 13:11 %%smsg documentation and extended section code 40269 subttl %%smsg documentation and extended section code 40270 40271 ;[216] Begin code insertion 40272 ; 40273 ; SOUT% has a bug in certain cases when being passed OWGP's. Like other 40274 ; JSYi, OWGP's work fine for I/O. However, if you use SOUT% to move a 40275 ; string, then SOUT% will occasionally do the wrong thing. Fix by 40276 ; checking here if we have a JFN and, if so, doing the I/O. Otherwise 40277 ; we use MOVSLJ (which is faster than using SOUT% to move data, 40278 ; anyway) 40279 ; 40280 ; Read that last sentence again: incredibly, ALL of the hair with an 40281 ; inter-section call to do the MOVSLJ is FAR faster than the SOUT%! 40282 ; Read it again, it's whaaay faster. 40283 ; 40284 ; Of course, MOVSLJ has its own quirks... You would think that you 40285 ; could use a OWGP that references section zero while executing in any 40286 ; section (such as section zero). I mean it works for IPB, ADJBP, 40287 ; ILDB and IDPB, so what's the problem? MOVSLJ will *NOT* honor a 40288 ; section zero OWGP when executed in section zero! The non-section 40289 ; OWGP increments just fine and both counts decrement, but the section 40290 ; zero pointer is untouched... 40291 ; 40292 ; So we stick with local section zero pointers as the destination, 40293 ; always, hand cast to double pointers and then do an inter-section 40294 ; transfer so that the MOVSLJ will execute in a non-zero section. 40295 ; This is necessary because double word pointers are not honored by 40296 ; ANY code executing in section zero. 40297 ; 40298 ; Actually, SOUT% only works with non-section OWGP's when the output is 40299 ; the terminal. Output to the disk is garbled, but not consistently. 40300 ; So it has to do an inter-section call, too. Bug appears to be BYTBLT 40301 ; in the monitor that is not considering OWGP's from section zero. 40302 ; 40303 ; And, of course, BOUT% doesn't honor *ANY* kind of a OWGP in section 40304 ; zero. EVER... 40305 ; 40306 ; Entry: 40307 ; 40308 ; t1/ String pointer or I/O designator 40309 ; Any string pointer in t1 is expected to be a 40310 ; LOCAL string pointer in section zero space. 40311 ; t2/ ASCII OWGP to Extended Text .PSECT, always 40312 ; t3/ Negative length of string for faster SOUT%'s 40313 ; (If used) 40314 ; 40315 ; Returns: 40316 ; 40317 ; +1 always 40318 ; 40319 ; t1/ Updated, if local pointer 40320 ; t2/ Updated 40321 ; t3/ 0 40322 ; 40323 ; Strings are NUL terminated and ready for append k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 8-1 K20SUB MAC 25-Nov-23 13:11 %%smsg documentation and extended section code 40324 40325 .psect ecode/ronly,ecdorg ;movslj MUST be executed in a non-zero section!!! 40326 000000'02 016 00 0 00 000000 movmsg: movslj 0,0 ; Extended opcode 40327 000001'02 000000 000000 .chnul ; Fill character (never used) 40328 40329 000002'02 123 01 0 00 000000' extmov: extend t1, movmsg ; Copy the data 40330 000003'02 600 00 0 00 000000 nop ; Ignore non-skip (should never happen) 40331 000004'02 200 10 0 00 000011 move q4, q5 ; Load return address 40332 000005'02 254 05 0 00 000007 xjrstf q3 ; Return back downstairs, restore flags 40333 40334 000006'02 104 00 0 00 000053 extsou: SOUT% ; SOUT% from section 1 40335 000007'02 320 14 0 00 000010' erjmps .+1 ; Catch and suppress error 40336 000010'02 200 10 0 00 000011 move q4, q5 ; Load return address 40337 000011'02 254 05 0 00 000007 xjrstf q3 ; Return back downstairs, restoring flags 40338 .endps ecode ; Out of extended code 40339 40340 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 9 K20SUB MAC 25-Nov-23 13:11 %%smsg documentation and extended section code 40341 subttl %%smsg documentation and extended section code 40342 40343 ; See above; arguments are expected to be suitable for a counted SOUT% 40344 40345 .psect const ; Constant pointers go in const 40346 000000'03 000001 000000# giant: extsec,,extmov ; 30 bit address of movslj 40347 000001'03 bigsou: entry bigsou ;[233] Allows k20mit to use 40348 000001'03 000001 000000# extsec,,extsou ; 30 bit address of SOUT% 40349 .endps const ; Close off constants 40350 40351 .psect code ; Back in section zero code 40352 40353 000311'01 %%smsg: entry %%smsg ; World callable 40354 40355 remark ; A minor efficiency hack 40356 000311'01 312 03 0 00 004166' came t3, [-1] ; Is this one dinky byte? 40357 000312'01 254 00 0 00 000321' ifskp. ; Then don't need all the baloney below 40358 000313'01 200 03 0 00 000002 move t3, t2 ; Get a copy of the source pointer 40359 000314'01 134 02 0 00 000003 ildb t2, t3 ; Load that single byte for BOUT% 40360 000315'01 260 17 0 00 000357' call BOUTI% ; Go put it somewhere 40361 000316'01 200 02 0 00 000003 move t2, t3 ; Restore updated source pointer 40362 000317'01 400 03 0 00 000000 setz t3, ; Stomp so looks like a return from SOUT% 40363 000320'01 263 17 0 00 000000 ret ; We're done 40364 000321'01 endif. 40365 40366 remark ; Otherwise, a multi-byte call 40367 000321'01 603 01 0 00 777777 tlne t1, -1 ; JFN will never have any flags 40368 000322'01 254 00 0 00 000331' ifskp. ; It's a JFN 40369 000323'01 265 16 0 00 004167' saveac ; Save linkage registers 40370 000324'01 254 14 0 00 000007 xsfm q3 ; Get and store the flags 40371 000325'01 200 10 0 00 000000# move q4, bigsou ; Load up inter-section transfer address 40372 000326'01 201 11 0 00 000330' movei q5, .+2 ; And the inter-section return adress 40373 000327'01 254 05 0 00 000007 xjrstf q3 ; Take a giant step 40374 000330'01 263 17 0 00 000000 ret ; Return, restoring registers 40375 000331'01 endif. ; End I/O case 40376 40377 remark ; See above; all this hair is faster than a SOUT% 40378 000331'01 265 16 0 00 004201' saveac ; Needs oinky registers 40379 000332'01 210 04 0 00 000003 movn t4, t3 ; movslj wants a positive length 40380 remark ; Cast local section zero to global long 40381 000333'01 510 05 0 00 000001 hllz q1, t1 ; Load destination pointer portion 40382 000334'01 661 05 0 00 000040 txo q1, GP%2WB ; Set the double word pointer bit 40383 000335'01 550 06 0 00 000001 hrrz q2, t1 ; Load address portion (section zero!!!) 40384 000336'01 200 01 0 00 000004 move t1, t4 ; Source length is the same 40385 remark t2, 0 ; Load source pointer (already there) 40386 000337'01 400 03 0 00 000000 setz t3, ; Single word source (OWGP) 40387 40388 000340'01 254 14 0 00 000007 xsfm q3 ; Get and store the flags 40389 000341'01 200 10 0 00 000000# move q4, giant ; Load up inter-section transfer address 40390 000342'01 201 11 0 00 000344' movei q5, %%sms1 ; And the inter-section return adress 40391 000343'01 254 05 0 00 000007 xjrstf q3 ; Take a giant step 40392 40393 000344'01 %%sms1: remark ; Our return address 40394 000344'01 260 17 0 00 003657' call d2sgpc ; Convert double source to single 40395 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 20:02 27-Nov-23 Page 9-1 K20SUB MAC 25-Nov-23 13:11 %%smsg documentation and extended section code 40396 000346'01 200 10 0 00 000001 move q4, t1 ; Store source single pointer 40397 remark ; Hand cast destination to section zero local 40398 000347'01 510 01 0 00 000005 hllz t1, q1 ; Pick up source pointer portion 40399 000350'01 621 01 0 00 000040 txz t1, GP%2WB ; Stomp the source double word pointer bit 40400 000351'01 540 01 0 00 000006 hrr t1, q2 ; Put in the section zero address and that's that 40401 000352'01 200 02 0 00 000010 move t2, q4 ; Load single source pointer 40402 40403 000353'01 200 04 0 00 000001 move t4, t1 ; Load a copy of the final destination 40404 000354'01 400 03 0 00 000000 setz t3, ; Return a zero count 40405 000355'01 136 03 0 00 000004 idpb t3, t4 ; Tie off the string, allow append 40406 40407 000356'01 263 17 0 00 000000 ret ; Phew!! Finally done 40408 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 10 K20SUB MAC 25-Nov-23 13:11 BOUT Internal 40409 subttl BOUT Internal 40410 40411 ; Just like BOUT% except doesn't die on a OWGP to a non-zero section. 40412 ; Doing the ildb bums a JSYS, anyway, so that's not the end of the world 40413 ; 40414 ; t1/ Destination designator 40415 ; t2/ Byte to be output, right-justified 40416 40417 000357'01 BOUTI%: entry BOUTI% ; World callible 40418 000357'01 603 01 0 00 777777 tlne t1, -1 ; Writing to a JFN, per chance? 40419 000360'01 254 00 0 00 000364' ifskp. ; Yes, BOUT% is safe 40420 000361'01 104 00 0 00 000051 BOUT% ; So do it 40421 000362'01 320 14 0 00 000000* erjmps r ; Failed?? Catch and suppress error 40422 000363'01 254 00 0 00 000375' else. ; Otherwise, assume some kind of pointer 40423 000364'01 136 02 0 00 000001 idpb t2, t1 ; So just deposit it 40424 000365'01 320 14 0 00 000366' erjmps .+1 ; Failed?? Catch and suppress error 40425 000366'01 261 17 0 00 000001 push p, t1 ; Save the byte pointer 40426 000367'01 261 17 0 00 000002 push p, t2 ; Save the byte 40427 000370'01 400 02 0 00 000000 setz t2, ; Cons up a NUL 40428 000371'01 136 02 0 00 000001 idpb t2, t1 ; Tie off string, allowing append 40429 000372'01 320 12 0 00 000373' erjmpr .+1 ; Failed?? Catch and ignore error (for debugging) 40430 000373'01 262 17 0 00 000002 pop p, t2 ; Restore the byte 40431 000374'01 262 17 0 00 000001 pop p, t1 ; Restore the byte pointer 40432 000375'01 endif. ; End JSYS/ilpb decision 40433 000375'01 263 17 0 00 000000 ret 40434 40435 ;[216] End code insertion 40436 40437 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 11 K20SUB MAC 25-Nov-23 13:11 Is this a JFN on NUL: or its equivalent? 40438 subttl Is this a JFN on NUL: or its equivalent? 40439 40440 ; Determines whether JFN is actually NUL:, and, if so replaces it 40441 ; with .NULIO, a special pseudo-JFN that is both recognized by 40442 ; Tops-20 and used internally as a talisman. 40443 ; 40444 ; Call: 40445 ; 40446 ; t1/ Candidate JFN (or device) 40447 ; 40448 ; Returns, 40449 ; 40450 ; +1/ t1 unmodified 40451 ; +2/ t1 contains .nulio, JFN released 40452 40453 000376'01 isnulj: entry isnulj ; Keep LINK informed of our location 40454 40455 000376'01 312 01 0 00 004215' came t1, [.dvdes!.dvnul,,-1] ; Typed device directly? 40456 000377'01 254 00 0 00 000403' ifskp. ; We did, so just go with that 40457 000400'01 201 01 0 00 377777 movei t1, .nulio ; Stomp into .nulio, no flags 40458 000401'01 254 00 0 00 000000* retskp ; We're done 40459 000402'01 254 00 0 00 000405' else. ; Otherwise, have to figure it out 40460 000403'01 265 16 0 00 004102' saveac ; Don't trash anything except maybe t1 40461 000404'01 200 05 0 00 000001 move q1, t1 ; Save the JFN with any flags 40462 000405'01 endif. ; .nulio might have flags, actually 40463 40464 000405'01 550 02 0 00 000001 hrrz t2, t1 ; Let's just look at the JFN alone 40465 000406'01 322 02 0 00 000522' jumpe t2, notnul ; Ignore any gubbish 40466 000407'01 306 02 0 00 377777 cain t2, .nulio ; Is some joker trying to get cute? 40467 000410'01 254 00 0 00 000517' jrst yesnul ; It's already NUL: ... 40468 ; Try to weed out some wise guys... 40469 000411'01 306 01 0 00 000100 cain t1, .priin ; Primary Input? 40470 000412'01 254 00 0 00 000522' jrst notnul ; It isn't the NUL: device 40471 000413'01 306 01 0 00 000101 cain t1, .priou ; Primary Output? 40472 000414'01 254 00 0 00 000522' jrst notnul ; It isn't the NUL: device 40473 000415'01 306 01 0 00 777777 cain t1, .cttrm ; Controlling terminal? 40474 000416'01 254 00 0 00 000522' jrst notnul ; It isn't the NUL: device 40475 000417'01 306 01 0 00 677777 cain t1, .sigio ; Signal JFN? 40476 000420'01 254 00 0 00 000522' jrst notnul ; It isn't the NUL: device 40477 ; First see if the argument is a device 40478 000421'01 104 00 0 00 000117 DVCHR% ; Get the characteristics of device 40479 000422'01 320 12 0 00 000424' ifje. r ; Broke on JFN with flags 40480 000423'01 254 00 0 00 000427' 40481 000424'01 200 04 0 00 000001 move t4, t1 ; Save for the curious 40482 000425'01 474 06 0 00 000000 seto q2, ; Flag failed (bogus characteristics) 40483 000426'01 254 00 0 00 000430' else. ; Otherwise, it did work 40484 000427'01 200 06 0 00 000002 move q2, t2 ; Save device characteristics word 40485 000430'01 endif. 40486 ; Now see if a file 40487 000430'01 550 01 0 00 000005 hrrz t1, q1 ; Load JFN, sans flags 40488 000431'01 104 00 0 00 000024 GTSTS% ; Get JFN status 40489 000432'01 320 12 0 00 000434' ifje. r ; Failed?? 40490 000433'01 254 00 0 00 000436' 40491 000434'01 474 04 0 00 000000 seto t4, ; Say it sure isn't a JFN 40492 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 20:02 27-Nov-23 Page 11-1 K20SUB MAC 25-Nov-23 13:11 Is this a JFN on NUL: or its equivalent? 40493 000436'01 200 04 0 00 000002 move t4, t2 ; Save the status bits for the moment 40494 000437'01 endif. 40495 40496 000437'01 415 16 0 00 000446' block. ; Enter block context for better control flow 40497 000440'01 261 17 0 00 000016 40498 000441'01 316 04 0 00 004166' camn t4, [-1] ; GTSTS% blow up? 40499 000442'01 254 00 0 00 000401* retskp ; It did, so no JFN 40500 000443'01 607 04 0 00 000200 txnn t4, gs%nam ; Is this bound to anything? 40501 000444'01 254 00 0 00 000442* retskp ; No, so no JFN 40502 000445'01 263 17 0 00 000000 endbk. ; Fall out of block context 40503 000446'01 254 00 0 00 000455' ifskp. ; Skips if no apparent JFN 40504 000447'01 316 06 0 00 004166' camn q2,[-1] ; Did DVCHR% not work, either? 40505 000450'01 254 00 0 00 000522' jrst notnul ; Didn't, so assume not NUL: 40506 000451'01 135 03 0 00 004216' ldb t3, [pointr q2, dv%typ] ; Pick up the device type 40507 000452'01 302 03 0 00 000015 caie t3, .dvnul ; Wants to just lose data? 40508 000453'01 254 00 0 00 000522' jrst notnul ; Not NUL:, so don't touch it 40509 000454'01 254 00 0 00 000517' jrst yesnul ; It is the NUL: device, but not a JFN 40510 000455'01 endif. 40511 ; Looks like a live JFN 40512 000455'01 550 01 0 00 000005 hrrz t1, q1 ; Try looking at it 40513 000456'01 104 00 0 00 000117 DVCHR% ; Get the characteristics of device 40514 000457'01 320 12 0 00 000522' erjmpr notnul ; GTSTS% just told us it was good... 40515 ; Now see if a file 40516 000460'01 135 03 0 00 004217' ldb t3, [pointr t2, dv%typ] ; Pick up the device type 40517 000461'01 316 06 0 00 004166' camn q2, [-1] ; Did the first DVCHR% fail? 40518 000462'01 254 00 0 00 000470' ifskp. ; No, it worked 40519 000463'01 135 01 0 00 004217' ldb t1, [pointr t2, dv%typ] ; Pick up the device type 40520 000464'01 316 01 0 00 000003 camn t1, t3 ; Are these NOT the same? 40521 000465'01 254 00 0 00 000470' anskp. ; They are, proceed 40522 000466'01 200 03 0 00 000001 move t3, t1 ; They aren't, prefer device 40523 000467'01 400 04 0 00 000000 setz t4, ; Say not open nor bound 40524 000470'01 endif. 40525 40526 000470'01 302 03 0 00 000015 caie t3, .dvnul ; Wants to just lose data? 40527 000471'01 254 00 0 00 000522' jrst notnul ; Not NUL:, so don't touch it 40528 ; It is, so replace the JFN 40529 000472'01 325 04 0 00 000512' ifxn. t4, gs%opn ; Is this thing open? 40530 000473'01 550 01 0 00 000005 hrrz t1, q1 ; Reload JFN, sans flags 40531 000474'01 400 02 0 00 000000 setz t2, ; Let's assume this works... 40532 000475'01 104 00 0 00 000022 CLOSF% ; Politely try to close it 40533 000476'01 320 12 0 00 000500' ifje. r ; Catch and ignore JSYS error 40534 000477'01 254 00 0 00 000501' 40535 000500'01 474 02 0 00 000000 seto t2, ; Flag it didn't want to go away 40536 000501'01 endif. ; End case trying a normal close 40537 000501'01 322 02 0 00 000517' jumpe t2, yesnul ; If it worked, then it's time to leave 40538 000502'01 550 01 0 00 000005 hrrz t1, q1 ; Reload JFN, sans flags 40539 000503'01 661 01 0 00 004000 txo t1, cz%abt ; In this case, try to clobber it 40540 000504'01 400 02 0 00 000000 setz t2, ; Let's assume that works... 40541 000505'01 104 00 0 00 000022 CLOSF% ; Try to close it, rudely 40542 000506'01 320 12 0 00 000510' ifje. r ; Catch and ignore JSYS error 40543 000507'01 254 00 0 00 000511' 40544 000510'01 474 02 0 00 000000 seto t2, ; I guess we must have sticky JFN syndrome 40545 000511'01 endif. ; End case trying a normal close 40546 000511'01 322 02 0 00 000517' jumpe t2, yesnul ; If it worked, then it's time to leave 40547 000512'01 endif. ; Otherwise, fall through and try something else k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 11-2 K20SUB MAC 25-Nov-23 13:11 Is this a JFN on NUL: or its equivalent? 40548 ; Here if not open or we are desperate 40549 000512'01 607 04 0 00 000200 ifxn. t4, gs%nam ; Was it ever bound? 40550 000513'01 254 00 0 00 000517' 40551 000514'01 550 01 0 00 000005 hrrz t1, q1 ; Reload JFN, sans flags 40552 000515'01 104 00 0 00 000023 RLJFN% ; Just toss it 40553 000516'01 320 12 0 00 000517' erjmpr .+1 ; Retrieve and ignore the error 40554 remark yesnul ; Falls through 40555 000517'01 endif. 40556 40557 000517'01 yesnul: remark ; Here if NUL; (JFN already released) 40558 000517'01 201 01 0 00 377777 movei t1, .nulio ; Load our talisman 40559 000520'01 500 01 0 00 000005 hll t1, q1 ; Load any flags, although now phoney 40560 000521'01 254 00 0 00 000444* retskp ; Won!! 40561 40562 000522'01 notnul: remark ; Here if not NUL: or some kooky error 40563 000522'01 200 01 0 00 000005 move t1, q1 ; Restore the calling argument 40564 000523'01 263 17 0 00 000000 ret ; Return +1 40565 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 12 K20SUB MAC 25-Nov-23 13:11 Set up Command State Block to parse from JFN in t1. 40566 subttl Set up Command State Block to parse from JFN in t1. 40567 40568 000524'01 setcsb: entry setcsb 40569 000524'01 337 00 0 00 000001 skipg t1 ; Make sure there's a real JFN. 40570 000525'01 201 01 0 00 000100 movei t1, .priin ; If not, revert. 40571 000526'01 506 01 0 00 000000# hrlm t1, sbk+.cmioj ; Put the input JFN into the CSB. 40572 000527'01 201 02 0 00 000101 movei t2, .priou ; Assume JFN is primary input. 40573 000530'01 302 01 0 00 000100 caie t1, .priin ; Is it? 40574 000531'01 201 02 0 00 377777 movx t2, .nulio ; No, it's a file, so nullify COMND output. 40575 000532'01 542 02 0 00 000000# hrrm t2, sbk+.cmioj ; Put output JFN in CSB. 40576 000533'01 263 17 0 00 000000 ret 40577 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 13 K20SUB MAC 25-Nov-23 13:11 Initialize Fork Capability vector 40578 subttl Initialize Fork Capability vector 40579 40580 ; Can't just blanket enable capabilities, an ACJ might get grumpy... 40581 ; 40582 ; Adapted from SETND2 (SETNOD rewrite) 40583 ; 40584 ; Note: checking for SC%GTB is almost certainly unnecessary as it is 40585 ; unheard of for it NOT to be on and we don't even have to enable it 40586 ; as merely having it is enough. That's good because the EXEC does 40587 ; not enable it. 40588 ; 40589 ; However, the code was fun to write and you never know when you're 40590 ; going to get hit with some fascist system manager's idea of security. 40591 ; 40592 ; Trashes t1-t4 40593 40594 000534'01 inicap: entry inicap ; Inform Link of our location 40595 extern mycaps,capas,bigboy ;and of our necessaries 40596 000534'01 403 02 0 00 000003 setzb t2, t3 ; Cons up a null capability vector 40597 000535'01 124 02 0 00 000000* dmovem t2, mycaps ; Assume we have nothing and that we are nobody 40598 000536'01 124 02 0 00 000000* dmovem t2, capas ; special (also intentionally whacks BIGBOY) 40599 000537'01 201 01 0 00 400000 movei t1, .fhslf ; This fork 40600 000540'01 104 00 0 00 000150 RPCAP% ; Get our capabilities 40601 000541'01 320 12 0 00 000362* erjmpr r ; Give up right now; can't do anything more 40602 40603 remark t2, capas ;[187] Let other code handle this 40604 000542'01 200 04 0 00 000003 move t4, t3 ; Save a copy of what's on 40605 remark t2, badmsk ; t2 is ignored by EPCAP% for .fhslf 40606 000543'01 630 03 0 00 004220' andx t3, badmsk ; Shut off some things that get us into trouble 40607 000544'01 602 02 0 00 600000 txne t2, sc%whl!sc%opr ; Could we hurt anybody? 40608 000545'01 476 00 0 00 000000* setom bigboy ; Yep, flag that we are one of the BIG BOYS 40609 ; Turn on a few things 40610 000546'01 602 02 0 00 001000 txne t2, sc%dna ; Do we have DECnet access? 40611 000547'01 660 03 0 00 001000 txo t3, sc%dna ; Yes, turn it on in case ACJ desires it 40612 000550'01 603 02 0 00 200000 txne t2, sc%gtb ; Do we have GETAB%? 40613 000551'01 661 03 0 00 200000 txo t3, sc%gtb ; Yes, flag other code 40614 000552'01 603 02 0 00 400000 txne t2, sc%ctc ; Do we have ^C? 40615 000553'01 661 03 0 00 400000 txo t3, sc%ctc ; Yes, flag other code 40616 000554'01 124 02 0 00 000535* dmovem t2, mycaps ; Store current capability vector 40617 000555'01 316 03 0 00 000004 camn t3, t4 ; Anything to change, actually? 40618 000556'01 263 17 0 00 000000 ret ; Nope, bum a few JSYi 40619 40620 000557'01 104 00 0 00 000151 EPCAP% ; Diddle the capabiliy vector 40621 000560'01 320 12 0 00 000562' ifje. r ; Failed?? 40622 000561'01 254 00 0 00 000564' 40623 000562'01 200 04 0 00 000001 move t4, t1 ; Save error code for debuggers, otherwise ignore 40624 000563'01 201 01 0 00 400000 movei t1, .fhslf ; Reload fork handle 40625 000564'01 endif. ; End case error handling 40626 ; See if fascist ACJ changed anything 40627 000564'01 104 00 0 00 000150 RPCAP% ; Get the resulting capability vector 40628 000565'01 320 12 0 00 000541* erjmpr r ; Sigh... 40629 000566'01 202 03 0 00 000000# movem t3, mycaps+1 ; Update final capability vector 40630 000567'01 263 17 0 00 000000 ret ; Finally done 40631 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 14 K20SUB MAC 25-Nov-23 13:11 Determine what kind of argument we have 40632 subttl Determine what kind of argument we have 40633 40634 ; Call: 40635 ; 40636 ; t1/ The handle we're trying to puzzle out 40637 ; 40638 ; Return: 40639 ; 40640 ; +1, Couldn't fathom it 40641 ; +2, Figured it out 40642 ; 40643 ; t1/ Appropriate flag set 40644 40645 000570'01 302 01 0 00 777777 argtyp: caie t1, .cttrm ; Called with controlling terminal? 40646 000571'01 254 00 0 00 000574' ifskp. ; That's easy enough 40647 000572'01 205 01 0 00 200000 movx t1, ts%ctm ; Set the controlling terminal flag 40648 000573'01 254 00 0 00 000521* retskp ; Success 40649 000574'01 endif. 40650 40651 000574'01 302 01 0 00 000101 caie t1, .priou ; Called with primary output? 40652 000575'01 254 00 0 00 000600' ifskp. ; That's easy enough 40653 000576'01 205 01 0 00 100000 movx t1, ts%pro ; Set the primary output flag 40654 000577'01 254 00 0 00 000573* retskp ; Success 40655 000600'01 endif. 40656 40657 000600'01 265 16 0 00 004221' saveac ; For calling argument and stack variable 40658 000601'01 200 05 0 00 000001 move q1, t1 ; Save the calling argument 40659 40660 000602'01 620 01 0 00 200000 txz t1, fh%epn ; Shut off extended page number flag 40661 000603'01 302 01 0 00 400000 caie t1, .fhslf ; Called with this fork? 40662 000604'01 254 00 0 00 000607' ifskp. ; That's easy, too 40663 000605'01 205 01 0 00 042000 movx t1, ts%frk!ts%efh ;Set the fork handle flag, explicitly supplied 40664 000606'01 254 00 0 00 000577* retskp ; Success 40665 000607'01 endif. 40666 ; Let's try a little harder 40667 000607'01 265 16 0 00 000000* anstkv (q2, <.rfsfl+1>) ; Allocate stack space for call 40668 000610'01 000000 000005 40669 000611'01 415 06 0 17 777772 40670 000612'01 201 03 0 00 000005 movx t3, <.rfsfl+1> ; Length of RFSTS% block 40671 000613'01 202 03 0 06 000000 movem t3, .rfcnt(q2) ; Store it in block 40672 40673 000614'01 515 01 0 00 400000 hrlzi t1, (rf%lng) ; Using long form 40674 000615'01 540 01 0 00 000005 hrr t1, q1 ; Load original argument (whatever it was) 40675 000616'01 200 02 0 00 000006 move t2, q2 ; Load pointer to block 40676 000617'01 200 03 0 00 000001 move t3, t1 ; Save a copy of JSYS argument 40677 000620'01 104 00 0 00 000156 RFSTS% ; Try to find out status 40678 000621'01 320 12 0 00 000622' erjmpr .+1 ; Side effect t1 with error code 40679 000622'01 312 01 0 00 000003 came t1, t3 ; But!! Did t1 change?? 40680 000623'01 254 00 0 00 000626' ifskp. ; No, so the call succeeded 40681 000624'01 205 01 0 00 042000 movx t1, ts%frk!ts%efh ;Set the fork handle flag, explicitly supplied 40682 000625'01 254 00 0 00 000606* retskp ; Success 40683 000626'01 endif. 40684 40685 000626'01 550 01 0 00 000005 hrrz t1, q1 ; Reload the calling argument 40686 000627'01 104 00 0 00 000024 GTSTS% ; Get the JFN's status k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 14-1 K20SUB MAC 25-Nov-23 13:11 Determine what kind of argument we have 40687 000630'01 320 12 0 00 000632' ifje. r ; If it was a JFN... 40688 000631'01 254 00 0 00 000635' 40689 000632'01 200 03 0 00 000001 move t3, t1 ; Save error for debuggers 40690 000633'01 400 02 0 00 000000 setz t2, ; Clear gs%nam 40691 remark ; Fall out to try device 40692 000634'01 254 00 0 00 000641' else. ; Otherwise, worked 40693 000635'01 607 02 0 00 000200 ifxn. t2, gs%nam ; A bound JFN? 40694 000636'01 254 00 0 00 000641' 40695 000637'01 205 01 0 00 020000 movx t1, ts%jfn ; Yes, set the JFN flag 40696 000640'01 254 00 0 00 000625* retskp ; Success 40697 000641'01 endif. ; End case a real JFN 40698 remark ; Otherwise, fall through to try device 40699 000641'01 endif. 40700 40701 000641'01 200 01 0 00 000005 move t1, q1 ; Reload the calling argument 40702 000642'01 104 00 0 00 000117 DVCHR% ; See if we got a device handle, maybe 40703 000643'01 320 12 0 00 000645' ifje. r ; Failed?? 40704 000644'01 254 00 0 00 000650' 40705 000645'01 200 02 0 00 000001 move t2, t1 ; Save error code for debuggers 40706 000646'01 400 01 0 00 000000 setz t1, ; Return no flags at all 40707 remark ; Fall out to try something else (like what??) 40708 000647'01 254 00 0 00 000652' else. ; Otherwise, worked 40709 000650'01 205 01 0 00 010000 movx t1, ts%dev ; Set the device handle flag 40710 000651'01 254 00 0 00 000640* retskp ; Success 40711 000652'01 endif. 40712 40713 000652'01 263 17 0 00 000000 ret ; Can't figure out what else to try, so fail 40714 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 15 K20SUB MAC 25-Nov-23 13:11 set and unset terminal for binary output 40715 subttl set and unset terminal for binary output 40716 40717 ; Put TTY in binary mode for output only. Still allows normal input, 40718 ; ^C trapping, etc. 40719 40720 000653'01 ttyob: entry ttyob ; Used by k20ioc 40721 000653'01 201 01 0 00 000101 movei t1, .priou ; Get CCOC words 40722 000654'01 104 00 0 00 000112 RFCOC 40723 000655'01 124 02 0 00 000000# dmovem t2, myccoc ; Save em. 40724 dmove t2,[525252525252 ;[194] Make all characters output 40725 000656'01 120 02 0 00 004231' 525252525000] ;[194] with no translation. 40726 000657'01 104 00 0 00 000113 SFCOC 40727 000660'01 201 02 0 00 000044 movei t2, .morxo ; Get tty pause-end-of-page status. 40728 000661'01 104 00 0 00 000077 MTOPR% 40729 000662'01 320 12 0 00 000664' %jserr (,) 40730 000663'01 254 00 0 00 000667' 40731 000664'01 265 01 0 00 000257' 40732 000665'01 000000 000000 40733 000666'01 254 00 0 00 000667' 40734 000667'01 202 03 0 00 000000# movem t3, ttpau ; Save it. 40735 dmove t2, [ .moxof ; Set the terminal pause on command 40736 000670'01 120 02 0 00 004233' .mooff ] ; to no pause on command 40737 000671'01 104 00 0 00 000077 MTOPR% 40738 000672'01 320 12 0 00 000674' %jserr (,) 40739 000673'01 254 00 0 00 000677' 40740 000674'01 265 01 0 00 000257' 40741 000675'01 000000 000000 40742 000676'01 254 00 0 00 000677' 40743 000677'01 263 17 0 00 000000 ret 40744 40745 40746 ; Restore TTY output to condition before TTYOB was called. 40747 40748 000700'01 ttyou: entry ttyou ; Used by k20ioc 40749 000700'01 201 01 0 00 000101 movei t1, .priou ; Restore normal tty output. 40750 000701'01 120 02 0 00 000000# dmove t2, myccoc 40751 000702'01 104 00 0 00 000113 SFCOC 40752 000703'01 320 12 0 00 000705' %jserr (,) 40753 000704'01 254 00 0 00 000710' 40754 000705'01 265 01 0 00 000257' 40755 000706'01 000000 000000 40756 000707'01 254 00 0 00 000710' 40757 000710'01 201 02 0 00 000043 movei t2, .moxof ; Set terminal pause on command 40758 000711'01 200 03 0 00 000000# move t3, ttpau ; to what it used to be. 40759 000712'01 104 00 0 00 000077 MTOPR% 40760 000713'01 320 12 0 00 000715' %jserr (,) 40761 000714'01 254 00 0 00 000720' 40762 000715'01 265 01 0 00 000257' 40763 000716'01 000000 000000 40764 000717'01 254 00 0 00 000720' 40765 000720'01 263 17 0 00 000000 ret 40766 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 16 K20SUB MAC 25-Nov-23 13:11 Save Terminal Characteristics (see following) 40767 subttl Save Terminal Characteristics (see following) 40768 40769 ; Call: 40770 ; 40771 ; t1/ JFN or device or fork handle 40772 ; t2/ Pointer to storage area 40773 ; 40774 ; Return: 40775 ; 40776 ; +1, Not a terminal device or some other significant error 40777 ; +2, Complete Success 40778 ; t3/ Interesting discovery flags 40779 ; 40780 ; Storage will contain as much terminal information as could be 40781 ; reasonably captured. 40782 ; 40783 ; Partially inspired by routines in PA1050 (PAT) which handle setting 40784 ; 'free' CRLF. Called at program startup and also when using another 40785 ; terminal line when running in 'local' mode. 40786 ; 40787 ; 40788 ; N.B., *MUST* be called after INICAP so we can see if we have SC%CTC!! 40789 ; 40790 ; To Do: Maybe check if .priou is .dvpip and don't do this? 40791 40792 000721'01 savtty: entry savtty ; Called from k20mit 40793 000721'01 265 16 0 00 004235' saveac ; Used for loop control and terminal references 40794 000722'01 120 07 0 00 000001 dmove q3, t1 ; Save calling arguments 40795 40796 000723'01 205 03 0 00 400000 movx t3, ts%err ; Assume some kind of failure 40797 000724'01 202 03 0 10 000000 movem t3, $tsflg(q4) ; Store in block 40798 000725'01 202 01 0 10 000001 movem t1, $tsarg(q4) ; Saving calling argument 40799 000726'01 201 03 0 00 601405 movx t3, lstrx1 ; However, we don't have any errors, YET 40800 000727'01 202 03 0 10 000002 movem t3, $tserr(q4) ; So don't assume 40801 000730'01 260 17 0 00 000570' call argtyp ; Determine argument type 40802 000731'01 263 17 0 00 000000 ret ; Failed, don't know what it is 40803 40804 000732'01 437 01 0 10 000000 orb t1, $tsflg(q4) ; Save and use the determined type 40805 000733'01 200 05 0 00 000001 move q1, t1 ; Also keep current flags in a fast place 40806 40807 000734'01 607 05 0 00 100000 ifxn. q1, ts%pro ; Was this primary output? 40808 000735'01 254 00 0 00 000740' 40809 000736'01 661 05 0 00 040000 txo q1, ts%frk ; Yes, so turn it into a fork handle 40810 000737'01 201 07 0 00 400000 movei q3, .fhslf ; Stomp argument to this process 40811 000740'01 endif. 40812 40813 000740'01 607 05 0 00 040000 ifxn. q1, ts%frk ; Fork (or implied fork)? 40814 000741'01 254 00 0 00 000754' 40815 000742'01 200 01 0 00 000007 move t1, q3 ; Yes, load it 40816 000743'01 104 00 0 00 000206 GPJFN% ; Find out primary JFN's 40817 000744'01 320 12 0 00 000746' ifje. r ; Failed?? 40818 000745'01 254 00 0 00 000752' 40819 000746'01 202 01 0 10 000002 movem t1, $tserr(q4) ;Store the error number 40820 000747'01 474 02 0 00 000000 seto t2, ; Force .cttrm 40821 000750'01 200 03 0 00 000001 move t3, t1 ; Reposition the error k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 16-1 K20SUB MAC 25-Nov-23 13:11 Save Terminal Characteristics (see following) 40822 000751'01 254 00 0 00 000753' else. ; Otherwise, there is no error 40823 000752'01 400 03 0 00 000000 setz t3, ; So state as much 40824 000753'01 endif. ; and carry on 40825 000753'01 254 00 0 00 000756' else. ; Otherwise, not using .priou 40826 000754'01 200 02 0 00 000007 move t2, q3 ; Pretend this is .priou 40827 000755'01 201 03 0 00 601405 movx t3, lstrx1 ; And flag no error differently 40828 000756'01 endif. 40829 000756'01 124 02 0 10 000003 dmovem t2, $gpjfn(q4) ; Store appropriately 40830 40831 000757'01 607 05 0 00 010000 ifxn. q1, ts%dev ; Already had a device designator 40832 000760'01 254 00 0 00 000763' 40833 000761'01 200 01 0 00 000007 move t1, q3 ; Yes, use it 40834 000762'01 254 00 0 00 000764' else. ; Otherwise, maybe GPJFN% got something 40835 000763'01 550 01 0 00 000002 hrrz t1, t2 ; Have a look at whatever the primary is 40836 000764'01 endif. 40837 000764'01 104 00 0 00 000117 DVCHR% ; Get the device characteristics 40838 000765'01 320 12 0 00 000767' ifje. r ; Failed?? 40839 000766'01 254 00 0 00 000774' 40840 000767'01 202 01 0 10 000002 movem t1, $tserr(q4) ; Store the error number 40841 000770'01 200 04 0 00 000001 move t4, t1 ; And also for failure specifics 40842 000771'01 400 01 0 00 000000 setz t1, ; Phoney up an impossible designator 40843 000772'01 477 02 0 00 000003 setob t2, t3 ; Yield impossible results 40844 000773'01 254 00 0 00 000775' else. ; Otherwise, worked 40845 000774'01 400 04 0 00 000000 setz t4, ; Therefore, flag this 40846 000775'01 endif. 40847 000775'01 124 01 0 10 000005 dmovem t1, $dvchr(q4) ; Save results 40848 000776'01 124 03 0 10 000007 dmovem t3, $dvchr+2(q4) ; All of them and error (if any) 40849 000777'01 326 04 0 00 000565* jumpn t4, r ; Can't go any further if failed 40850 ; Otherwise, investigate results 40851 001000'01 135 04 0 00 004217' ldb t4,[pointr t2, dv%typ] ; Pick up the device type 40852 001001'01 302 04 0 00 000012 caie t4, .dvtty ; Ok, is this a terminal? 40853 001002'01 263 17 0 00 000000 ret ; No, the rest makes no sense 40854 001003'01 302 01 0 00 777777 caie t1, .cttrm ; Controlling terminal? 40855 001004'01 254 00 0 00 001010' ifskp. ; Yes, let's fix that up 40856 001005'01 200 01 0 00 000003 move t1, t3 ; Load the device type and line number 40857 001006'01 661 01 0 00 600000 txo t1, (.dvdes) ; Turn on the designator bit 40858 001007'01 202 01 0 10 000005 movem t1, $dvchr(q4) ; Replace saved device designator 40859 001010'01 endif. 40860 001010'01 200 06 0 00 000001 move q2, t1 ; Save device in a fast place 40861 40862 remark t1, ; Finally has terminal device 40863 001011'01 104 00 0 00 000112 RFCOC% ; Get the control word 40864 001012'01 320 12 0 00 001014' ifje. r ; Catch and ignore error 40865 001013'01 254 00 0 00 001021' 40866 001014'01 202 01 0 10 000013 movem t1, $ctcoc+2(q4) ;Save the error 40867 001015'01 202 01 0 10 000002 movem t1, $tserr(q4) ; Store the error here, too 40868 001016'01 477 02 0 00 000003 setob t2, t3 ; Fine, no control character output control 40869 001017'01 200 01 0 00 000006 move t1, q2 ; Reload designator 40870 001020'01 254 00 0 00 001022' else. ; Otherwise worked, which is good 40871 001021'01 402 00 0 10 000013 setzm $ctcoc+2(q4) ; Flag no error 40872 001022'01 endif. 40873 001022'01 124 02 0 10 000011 dmovem t2, $ctcoc(q4) ; Store controlling terminal's COC's 40874 40875 001023'01 104 00 0 00 000107 RFMOD% ; Get the JFN mode word 40876 001024'01 320 12 0 00 001026' ifje. r ; Catch and ignore error k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 16-2 K20SUB MAC 25-Nov-23 13:11 Save Terminal Characteristics (see following) 40877 001025'01 254 00 0 00 001033' 40878 001026'01 202 01 0 10 000002 movem t1, $tserr(q4) ; Store the error number 40879 001027'01 474 02 0 00 000000 seto t2, ; Fine, no mode word 40880 001030'01 200 03 0 00 000001 move t3, t1 ; Reposition error 40881 001031'01 200 01 0 00 000006 move t1, q2 ; Reload designator 40882 001032'01 254 00 0 00 001035' else. ; Otherwise, worked 40883 001033'01 621 02 0 00 400000 txz t2, tt%osp ; Clear Control-O 40884 001034'01 400 03 0 00 000000 setz t3, ; Flag no error 40885 001035'01 endif. 40886 001035'01 124 02 0 10 000014 dmovem t2, $ctmod(q4) ; Store controlling terminal's mode word and error 40887 40888 001036'01 201 05 0 00 000006 movei q1, mtoprl ; Load MTOPR% table length 40889 40890 001037'01 do. ; Enter loop context 40891 001037'01 554 02 0 05 001160' hlrz t2, mtoprt(q1) ; Load function to perform 40892 001040'01 104 00 0 00 000077 MTOPR% ; Read the value 40893 001041'01 320 12 0 00 001043' ifje. r ; Catch and ignore error 40894 001042'01 254 00 0 00 001050' 40895 001043'01 202 01 0 10 000002 movem t1, $tserr(q4) ;Store the error number 40896 001044'01 474 03 0 00 000000 seto t3, ; Fine, no value 40897 001045'01 200 04 0 00 000001 move t4, t1 ; Save for debugger 40898 001046'01 200 01 0 00 000006 move t1, q2 ; Reload designator 40899 001047'01 254 00 0 00 001051' else. ; Otherwise, worked 40900 001050'01 400 04 0 00 000000 setz t4, ; Flag no error 40901 001051'01 endif. 40902 001051'01 550 02 0 05 001160' hrrz t2, mtoprt(q1) ; Load location to store 40903 001052'01 270 02 0 00 000010 add t2, q4 ; Calculate correct address in structure 40904 001053'01 124 03 0 02 000000 dmovem t3, (t2) ; store it somewhere 40905 001054'01 365 05 0 00 001037' sojge q1, top. ; Get the next one 40906 001055'01 enddo. ; Exit loop context 40907 40908 001055'01 201 04 0 00 000004 movx t4, <0,,4> ; Load block header word 40909 001056'01 202 04 0 10 000034 movem t4, $morbm(q4) ; Initialize block 40910 remark t1, ; Still has correct designator 40911 001057'01 201 02 0 00 000037 movx t2, .morbm ; Function is to read break mask 40912 001060'01 201 03 0 10 000034 movei t3, $morbm(q4) ; Resolve address of break mask block 40913 001061'01 104 00 0 00 000077 MTOPR% ; Read the value 40914 001062'01 320 12 0 00 001064' ifje. r ; Catch and ignore error 40915 001063'01 254 00 0 00 001074' 40916 001064'01 200 04 0 00 000001 move t4, t1 ; Save for debugger 40917 001065'01 202 01 0 10 000002 movem t1, $tserr(q4) ; Store the error number 40918 001066'01 477 02 0 00 000003 setob t2, t3 ; Fine, no break mask.. 40919 001067'01 124 02 0 10 000034 dmovem t2, $morbm(q4) ; Stomp header and first break word 40920 001070'01 124 02 0 10 000036 dmovem t2, $morbm+2(q4) ;Stomp second and third break word 40921 001071'01 124 03 0 10 000040 dmovem t3, $morbm+4(q4) ;Stomp fourth break word, store error 40922 001072'01 200 01 0 00 000006 move t1, q2 ; Reload designator 40923 001073'01 254 00 0 00 001075' else. ; Otherwise, worked 40924 001074'01 402 00 0 10 000041 setzm $morbm+5(q4) ; Flag no error 40925 001075'01 endif. 40926 ; Finally set large dimension flags 40927 001075'01 120 02 0 10 000016 dmove t2, $morlw(q4) ; Load the terminal width 40928 001076'01 326 03 0 00 001103' ife. t3 ; Was there any error? 40929 001077'01 307 02 0 00 000177 caig t2, ^d127 ; Exceeded seven bits? 40930 001100'01 254 00 0 00 001103' anskp. ; No, STPAR% will work 40931 001101'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 20:02 27-Nov-23 Page 16-3 K20SUB MAC 25-Nov-23 13:11 Save Terminal Characteristics (see following) 40932 001102'01 436 03 0 10 000000 orm t3, $tsflg(q4) ; Record in the flags word 40933 001103'01 endif. 40934 40935 001103'01 120 02 0 10 000020 dmove t2, $morll(q4) ; Load terminal length 40936 001104'01 326 03 0 00 001111' ife. t3 ; Was there any error? 40937 001105'01 307 02 0 00 000177 caig t2, ^d127 ; Exceeded seven bits? 40938 001106'01 254 00 0 00 001111' anskp. ; No, STPAR% will work 40939 001107'01 205 03 0 00 000200 movx t3, ts%lgl ; Load large length flag 40940 001110'01 436 03 0 10 000000 orm t3, $tsflg(q4) ; Record in the flags word 40941 001111'01 endif. 40942 40943 001111'01 200 04 0 10 000000 move t4, $tsflg(q4) ; Load the current flags so far 40944 001112'01 607 04 0 00 002000 ifxn. t4, ts%efh ; Did we have an explicit fork handle? 40945 001113'01 254 00 0 00 001116' 40946 001114'01 200 05 0 10 000001 move q1, $tsarg(q4) ; Yes, let's use it 40947 001115'01 254 00 0 00 001117' else. ; Otherwise, assume job wide teriminal interrupts 40948 001116'01 201 05 0 00 777773 movei q1, .fhjob ; And use this magic handle 40949 001117'01 endif. 40950 40951 001117'01 200 03 0 00 000000# move t3, mycaps+1 ; Load ENABLED capabilities 40952 001120'01 325 03 0 00 001124' ifxn. t3, sc%ctc ; Did we have ^C? 40953 001121'01 205 03 0 00 001000 movx t3, ts%ctc ; Load that we had sc%ctc 40954 001122'01 437 03 0 10 000000 orb t3, $tsflg(q4) ; Record in the flags word and keep handy 40955 001123'01 254 00 0 00 001125' else. ; Otherwise, don't have it 40956 001124'01 200 03 0 10 000000 move t3, $tsflg(q4) ; So load what we do have 40957 001125'01 endif. 40958 40959 001125'01 302 05 0 00 777773 caie q1, .fhjob ; Are we doing job wide? 40960 001126'01 254 00 0 00 001132' ifskp. ; Yes, so let's see if that is possible 40961 001127'01 603 03 0 00 001000 txne t3, ts%ctc ; Did we have ^C? 40962 001130'01 254 00 0 00 001132' anskp. ; Yes, so STIW% on this will work 40963 001131'01 201 05 0 00 400000 movei q1, .fhslf ; No; just this fork's terminal interrupt word 40964 001132'01 endif. ; End case .fhjob specified (or assumed) 40965 40966 001132'01 200 01 0 00 000005 move t1, q1 ; Load terminal interrupt word context 40967 001133'01 202 01 0 10 000042 movem t1, $tif(q4) ; Store what we are using 40968 001134'01 302 01 0 00 777773 caie t1, .fhjob ; Entire job? 40969 001135'01 254 00 0 00 001140' ifskp. ; It is, so won't be getting differed word 40970 001136'01 400 03 0 00 000000 setz t3, ; So stomp it 40971 001137'01 254 00 0 00 001141' else. ; Otherwise, this is a specific process 40972 001140'01 661 01 0 00 400000 txo t1, rt%dim ; So get differed word, just for fun 40973 001141'01 endif. 40974 40975 001141'01 104 00 0 00 000173 RTIW% ; Finally read the terminal interrupt word 40976 001142'01 320 12 0 00 001144' ifje. r ; Catch and handle the error 40977 001143'01 254 00 0 00 001150' 40978 001144'01 202 01 0 10 000045 movem t1, $tiw+2(q4) ; Save the error 40979 001145'01 202 01 0 10 000002 movem t1, $tserr(q4) ; Store the error here, too 40980 001146'01 403 02 0 00 000003 setzb t2, t3 ; Let's say nothing is set 40981 001147'01 254 00 0 00 001151' else. ; Otherwise worked, which is good 40982 001150'01 402 00 0 10 000045 setzm $tiw+2(q4) ; Flag no error 40983 001151'01 endif. 40984 001151'01 124 02 0 10 000043 dmovem t2, $tiw(q4) ; Store terminal interrupt word (and maybe diferred) 40985 40986 001152'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 20:02 27-Nov-23 Page 16-4 K20SUB MAC 25-Nov-23 13:11 Save Terminal Characteristics (see following) 40987 001153'01 302 01 0 00 601405 caie t1, lstrx1 ; Never had any? 40988 001154'01 263 17 0 00 000000 ret ; Fail the call 40989 40990 001155'01 525 03 0 00 377777 movx t3, ^-ts%err ; Load failure bit complement 40991 001156'01 407 03 0 10 000000 andb t3, $tsflg(q4) ; Shut off in flag word 40992 001157'01 254 00 0 00 000651* retskp ; Complete success 40993 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 17 K20SUB MAC 25-Nov-23 13:11 MTOPR% index to structure offset mapping tables 40994 subttl MTOPR% index to structure offset mapping tables 40995 40996 ; Be aware that each pointer is pointing to a double word which 40997 ; holds the value and any error. This is to keep us from restoring 40998 ; a value which was never properly read in the first place and 40999 ; really messing up a possibly already ill terminal. 41000 ; 41001 ; As these are offsets, they are added to an address, which means 41002 ; that the structure can be in any section. 41003 41004 001160'01 000030 000016 mtoprt: .morlw,,$morlw ; Read line width 41005 001161'01 000032 000020 .morll,,$morll ; Read line length 41006 001162'01 000035 000022 .mornt,,$mornt ; Receive system blat 41007 001163'01 000044 000024 .morxo,,$morxo ; Pause end of page 41008 001164'01 000053 000026 .mopcr,,$mopcr ; Read terminal pause and unpause 41009 001165'01 000054 000030 .mortf,,$mortf ; Read other kinds of blat 41010 001166'01 400001 000032 panda < .morlt,,$morlt > ;;Read TVT bits 41011 000006 mtoprl==.-mtoprt-1 ; Calculate table length 41012 41013 001167'01 000031 000016 mtopst: .moslw,,$morlw ; Set line width 41014 001170'01 000033 000020 .mosll,,$morll ; Set line length 41015 001171'01 000034 000022 .mosnt,,$mornt ; Set system blat acceptance 41016 001172'01 000043 000024 .moxof,,$morxo ; Set pause end of page 41017 001173'01 000052 000026 .mopcs,,$mopcr ; Set terminal pause and unpause 41018 001174'01 000055 000030 .mostf,,$mortf ; Set other kinds of blat 41019 001175'01 400002 000032 panda < .moslt,,$morlt > ;;Set TVT bits 41020 000006 mtopsl==.-mtopst-1 ; Calculate table length 41021 41022 ifn , 41023 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 18 K20SUB MAC 25-Nov-23 13:11 Restore Terminal Characteristics 41024 subttl Restore Terminal Characteristics 41025 41026 ; Call: 41027 ; 41028 ; t1/ Takes a pointer to a storage area that was set up by SAVTTY. 41029 ; 41030 ; Restores every parameter that was successfully saved, ignores 41031 ; those that weren't. 41032 ; 41033 ; Return: 41034 ; 41035 ; +1, always 41036 ; 41037 ; t3 has last error, zero if everything restored 41038 ; 41039 ; Terminal characteristics restored or restored mostly. 41040 ; 41041 ; Trashes t1, t2, t3 and t4 41042 ; 41043 ; See above. Do NOT change order of restore because SFMOD%/STPAR% 41044 ; will overwrite the length and width with the wrong things 41045 41046 001176'01 restty: entry restty ; Called from k20mit 41047 001176'01 265 16 0 00 004247' saveac ; Uses plenty more registers... 41048 41049 001177'01 200 05 0 00 000001 move q1, t1 ; Save structure base 41050 001200'01 474 03 0 00 000000 seto t3, ; Assume complete junk 41051 001201'01 332 00 0 05 000010 skipe $dvchr+3(q1) ; Did we ever get a device? 41052 001202'01 263 17 0 00 000000 ret ; No, no way we can restore anything 41053 001203'01 200 06 0 05 000005 move q2, $dvchr(q1) ; Yes, use the device for everything 41054 001204'01 200 01 0 00 000006 move t1, q2 ; Load for JSYi 41055 001205'01 400 07 0 00 000000 setz q3, ; Let's assume everything works 41056 41057 001206'01 332 00 0 05 000013 ifme. $ctcoc+2(q1) ; Did the RFCOC% work 41058 001207'01 254 00 0 00 001216' 41059 001210'01 120 02 0 05 000011 dmove t2, $ctcoc(q1) ; Yes, load controlling terminal's COC's 41060 001211'01 104 00 0 00 000113 SFCOC% ; Put them back 41061 001212'01 320 12 0 00 001214' ifje. r ; Failed?? 41062 001213'01 254 00 0 00 001216' 41063 001214'01 200 07 0 00 000001 move q3, t1 ; Remember that something failed 41064 001215'01 200 01 0 00 000006 move t1, q2 ; Reload designator 41065 001216'01 endif. ; End case SFCOC% failure handling 41066 001216'01 endif. ; End case SFCOC% restore decision 41067 41068 001216'01 332 00 0 05 000015 ifme. $ctmod+1(q1) ; Did RFMOD% work? 41069 001217'01 254 00 0 00 001233' 41070 001220'01 200 02 0 05 000014 move t2, $ctmod(q1) ; Yes, load those bits 41071 001221'01 104 00 0 00 000110 SFMOD% ; Set 'program related' bits 41072 001222'01 320 12 0 00 001224' ifje. r ; Failed?? 41073 001223'01 254 00 0 00 001226' 41074 001224'01 200 07 0 00 000001 move q3, t1 ; Remember that something failed 41075 001225'01 200 01 0 00 000006 move t1, q2 ; Reload designator 41076 001226'01 endif. ; End SFMOD% error handling 41077 001226'01 104 00 0 00 000217 STPAR% ; Set 'mechanical' bits 41078 001227'01 320 12 0 00 001231' ifje. r ; Failed?? k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 18-1 K20SUB MAC 25-Nov-23 13:11 Restore Terminal Characteristics 41079 001230'01 254 00 0 00 001233' 41080 001231'01 200 07 0 00 000001 move q3, t1 ; Remember that something failed 41081 001232'01 200 01 0 00 000006 move t1, q2 ; Reload designator 41082 001233'01 endif. ; End STPAR% error handling 41083 001233'01 endif. ; End mode word restore decision 41084 41085 001233'01 201 10 0 00 000006 movei q4, mtopsl ; Load MTOPR% table length 41086 41087 001234'01 do. ; Enter loop context 41088 001234'01 550 11 0 10 001167' hrrz p1, mtopst(q4) ; Load pointer to stored value offset 41089 001235'01 270 11 0 00 000005 add p1, q1 ; Add in base of table 41090 001236'01 120 03 0 11 000000 dmove t3, (p1) ; Load value and error condition 41091 001237'01 326 04 0 00 001246' ife. t4 ; If no error, then try setting 41092 001240'01 554 02 0 10 001167' hlrz t2, mtopst(q4) ; Load this value's MTOPR% set index 41093 001241'01 104 00 0 00 000077 MTOPR% ; Try setting the value 41094 001242'01 320 12 0 00 001244' ifje. r ; Failed?? 41095 001243'01 254 00 0 00 001246' 41096 001244'01 200 07 0 00 000001 move q3, t1 ; Remember that something failed 41097 001245'01 200 01 0 00 000006 move t1, q2 ; Reload designator 41098 001246'01 endif. ; End MTOPR% error handling 41099 001246'01 endif. ; End MTOPR% restore decision 41100 001246'01 365 10 0 00 001234' sojge q4, top. ; Get the next one 41101 001247'01 enddo. ; Exit loop context 41102 41103 001247'01 332 00 0 05 000041 ifme. $morbm+5(q1) ; Did the read mask work? 41104 001250'01 254 00 0 00 001260' 41105 001251'01 201 02 0 00 000040 movx t2, .mosbm ; Function to set break mask 41106 001252'01 201 03 0 05 000034 movei t3, $morbm(q1) ; Address of four word block to load from 41107 001253'01 104 00 0 00 000077 MTOPR% ; Set the value 41108 001254'01 320 12 0 00 001256' ifje. r ; Failed?? 41109 001255'01 254 00 0 00 001260' 41110 001256'01 200 07 0 00 000001 move q3, t1 ; Remember that something failed 41111 001257'01 200 01 0 00 000006 move t1, q2 ; Reload designator 41112 001260'01 endif. ; End case MTOPR% failure handling 41113 001260'01 endif. ; End case break mask restore decision 41114 41115 001260'01 332 00 0 05 000045 ifme. $tiw+2(q1) ; Were we able to get the terminal interrupt word? 41116 001261'01 254 00 0 00 001270' 41117 001262'01 120 01 0 05 000042 dmove t1, $tif(q1) ; Yes, load context and mask 41118 001263'01 104 00 0 00 000174 STIW% ; Restore somebody's terminal interrupt word 41119 001264'01 320 12 0 00 001266' ifje. r ; Failed?? 41120 001265'01 254 00 0 00 001270' 41121 001266'01 200 07 0 00 000001 move q3, t1 ; Remember that something failed 41122 001267'01 200 01 0 00 000006 move t1, q2 ; Reload designator 41123 001270'01 endif. ; End case STIW% failure handling 41124 001270'01 endif. ; End case STIW% decision 41125 41126 001270'01 200 03 0 00 000007 move t3, q3 ; Has any errors 41127 001271'01 263 17 0 00 000000 ret ; Finally get out of here 41128 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 19 K20SUB MAC 25-Nov-23 13:11 Set Up Local Terminal for Kermit usage 41129 subttl Set Up Local Terminal for Kermit usage 41130 41131 001272'01 setty: entry setty ;[220] Invoked by k20mit 41132 001272'01 260 17 0 00 000000* call udjinf ;[220] Get and update current job information 41133 001273'01 335 04 0 00 000000# skipge t4,jobtab+.jitno ;[220] Load and check current terminal number 41134 001274'01 334 01 0 00 000000# ermsg% (,halt) ;[220] 41135 001275'01 254 00 0 00 001301' 41136 001276'01 202 01 0 00 000140* 41137 001277'01 104 00 0 00 000313 41138 001300'01 254 00 0 00 000000* 41139 000002'03 000000000000# 41140 000000'04 113 105 122 115 111 41141 41142 001301'01 202 04 0 00 000000* movem t4, mytty ;[184] stomp in a possible new line 41143 41144 001302'01 200 01 0 00 000004 move t1, t4 ;[186] Pass in possible new terminal line 41145 001303'01 505 01 0 00 600012 hrli t1,.dvdes!.dvtty ;[186] Turn into a device designator 41146 001304'01 201 02 0 00 000000* movei t2, svstt ;[186] Point to saved start up terminal area 41147 001305'01 260 17 0 00 000721' call savtty ;[186] Save terminal characteristics again 41148 001306'01 334 01 0 00 000000# ermsg% (,halt) ;[186] 41149 001307'01 254 00 0 00 001313' 41150 001310'01 202 01 0 00 001276* 41151 001311'01 104 00 0 00 000313 41152 001312'01 254 00 0 00 001300* 41153 000003'03 000000000000# 41154 000016'04 113 105 122 115 111 41155 41156 41157 001313'01 201 02 0 00 001304* movei t2, svstt ;[194] Point to populated structure 41158 001314'01 332 00 0 02 000010 ifme. $dvchr+3(t2) ;[194] Any error? 41159 001315'01 254 00 0 00 001320' 41160 001316'01 200 03 0 02 000005 move t3, $dvchr(t2) ;[194] None, use what DVCHR% got 41161 001317'01 254 00 0 00 001321' else. ;[194] Otherwise, have to use something 41162 001320'01 201 03 0 00 000101 movei t3, .priou ;[194] Maybe old reliable will work 41163 001321'01 endif. ;[194] End case determining controlling device 41164 001321'01 202 03 0 00 000000* movem t3, $PRIOU ;[194] Store and hope for the best 41165 41166 001322'01 260 17 0 00 001332' call lcltty ;[194] Get a JFN on local terminal 41167 001323'01 334 00 0 00 000000 %ermsg (,halt) ;[186] 41168 001324'01 254 00 0 00 001330' 41169 001325'01 265 01 0 00 000257' 41170 001326'01 000000000000# 41171 001327'01 254 00 0 00 001312* 41172 000032'04 125 156 141 142 154 41173 001330'01 202 01 0 00 000000* movem t1, ttyjfn ;[194] Store for downstream use 41174 001331'01 263 17 0 00 000000 ret 41175 41176 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 20 K20SUB MAC 25-Nov-23 13:11 Acquire JFN on local terminal 41177 subttl Acquire JFN on local terminal 41178 41179 ; Although has a +1/+2 return, it always returns 41180 ; something, even if it is only .priou or .cttrm 41181 ; 41182 ; t1/ JFN open and ready to use 41183 ; 41184 ; To do: if a pipe, maybe change this and just use it? 41185 ; 41186 ; Also: if we are running as local, then we should close the 41187 ; ttyjfn and replace it with .sigio because we shouldn't 41188 ; be diddling the local terminal. 41189 41190 001332'01 lcltty: extern ttyjfn ; In k20mit 41191 001332'01 265 16 0 00 004263' saveac ; Copy of possible open JFN 41192 41193 001333'01 476 00 0 00 000000# setom lcltte ; Whack the error block to detached job 41194 001334'01 200 01 0 00 004271' move t1, [lcltte,,lcltte+1] 41195 001335'01 251 01 0 00 000000# blt t1, lcltef ; The entire block 41196 41197 001336'01 337 05 0 00 001330* skipg q1, ttyjfn ; First, is there something already available? 41198 001337'01 254 00 0 00 001370' jrst getlcl ; Evidently not; let's get a JFN 41199 41200 001340'01 200 01 0 00 000005 move t1, q1 ; Load it for the JSYS to investigate 41201 001341'01 104 00 0 00 000024 GTSTS% ; Let's have a look see 41202 001342'01 320 12 0 00 001344' ifje. r ; Looks like it's defunct, somehow 41203 001343'01 254 00 0 00 001347' 41204 001344'01 202 01 0 00 000000# movem t1, lcltte ; Store the error 41205 001345'01 200 01 0 00 000005 move t1, q1 ; Reload the JFN (or whatever it was) 41206 001346'01 400 02 0 00 000000 setz t2, ; Whack the status 41207 001347'01 endif. 41208 41209 001347'01 641 02 0 00 400200 txc t2,gs%nam!gs%opn ; Complement the required bits 41210 001350'01 643 02 0 00 400200 txce t2,gs%nam!gs%opn ; Is it any good at and is it open? 41211 001351'01 254 00 0 00 001370' jrst getlcl ; No, then go get a JFN 41212 001352'01 607 02 0 00 000400 ifxn. t2,gs%err ; Any kind of error? 41213 001353'01 254 00 0 00 001367' 41214 001354'01 505 01 0 00 004000 hrli t1, (cz%abt) ; Abort the JFN 41215 001355'01 104 00 0 00 000022 CLOSF% ; Try to junk it 41216 001356'01 320 12 0 00 001360' ifje. r ; Failied?? 41217 001357'01 254 00 0 00 001366' 41218 001360'01 202 01 0 00 000000# movem t1, lcltte+1 ; Store the error 41219 001361'01 200 01 0 00 000005 move t1, q1 ; Reload the JFN (or whatever it was) 41220 001362'01 104 00 0 00 000023 RLJFN% ; Just try to let go of it 41221 001363'01 320 12 0 00 001365' ifje. r ; Failied?? 41222 001364'01 254 00 0 00 001366' 41223 001365'01 202 01 0 00 000000# movem t1, lcltte+2 ;Store the error 41224 001366'01 endif. 41225 001366'01 endif. 41226 001366'01 254 00 0 00 001370' jrst getlcl ; Go get a new JFN 41227 001367'01 endif. 41228 001367'01 254 00 0 00 001157* retskp ; Otherwise, get out of here with a JFN 41229 41230 001370'01 getlcl: extern mytty ; Here to get a JFN on the local line 41231 001370'01 402 00 0 00 001336* setzm ttyjfn ; At this point, no JFN anyhow k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 20-1 K20SUB MAC 25-Nov-23 13:11 Acquire JFN on local terminal 41232 001371'01 200 03 0 00 001301* move t3, mytty ; Load my terminal number 41233 001372'01 316 03 0 00 004166' camn t3, [-1] ; Detached?? 41234 001373'01 254 00 0 00 001451' jrst lclerr ; Yes, that will never do.. 41235 001374'01 620 03 0 00 400000 txz t3, .ttdes ; Stomp in case somebody left it on 41236 dmove t1, [-1,,lclnam ; HRROI pointer to place to build name 41237 001375'01 120 01 0 00 004272' .dvdes!.dvtty,,0 ] ; Device designator prototype 41238 001376'01 540 02 0 00 000003 hrr t2, t3 ; My current attached terminal 41239 001377'01 202 02 0 00 000000# movem t2, lcldev ; Store it for later 41240 001400'01 104 00 0 00 000121 DEVST% ; Build the device string 41241 001401'01 320 12 0 00 001403' ifje. r ; Failed?? 41242 001402'01 254 00 0 00 001406' 41243 001403'01 202 01 0 00 000000# movem t1, lcltte+3 ; Save the error 41244 001404'01 254 00 0 00 001451' jrst lclerr ; And give error return 41245 001405'01 254 00 0 00 001411' else. ; Otherwise, worked 41246 001406'01 120 02 0 00 004274' dmove t2, [ exp ":", 0] ; Load final characters 41247 001407'01 136 02 0 00 000001 idpb t2, t1 ; Punctuate the device 41248 001410'01 136 03 0 00 000001 idpb t3, t1 ; Tie off the device string 41249 001411'01 endif. 41250 41251 dmove t1, [ gj%sht!gj%flg ; Want flags 41252 001411'01 120 01 0 00 004276' -1,,lclnam ] ; Point to constructed device name 41253 001412'01 104 00 0 00 000020 GTJFN% ; Try to get a handle 41254 001413'01 320 12 0 00 001415' ifje. r ; Can't on our own silly TTY?? 41255 001414'01 254 00 0 00 001426' 41256 001415'01 202 01 0 00 000000# movem t1, lcltte+4 ; Sigh ... 41257 dmove t1, [ASCIZ /TTY:/ ; Try generic case 41258 001416'01 120 01 0 00 004300' 0 ] ; Certainly null terminated 41259 001417'01 124 01 0 00 000000# dmovem t1, lclnam ; Drop that in 41260 dmove t1, [ gj%sht!gj%flg ; Want flags 41261 001420'01 120 01 0 00 004302' -1,,lclnam ] ; Point to constructed device name 41262 001421'01 104 00 0 00 000020 GTJFN% ; Try to get a handle 41263 001422'01 320 12 0 00 001424' ifje. r ; Failed?? 41264 001423'01 254 00 0 00 001426' 41265 001424'01 202 01 0 00 000000# movem t1, lcltte+5 ; Sigh ... 41266 001425'01 254 00 0 00 001451' jrst lclerr ; Go do general error exit 41267 001426'01 endif. ; End failure recovery failing .. 41268 001426'01 endif. ; End GTJFN% failure analysis and recovery 41269 41270 001426'01 552 01 0 00 000000# hrrzm t1, lcljfn ; Store the JFN 41271 001427'01 512 01 0 00 000000# hllzm t1, lclflg ; And the flags 41272 001430'01 621 01 0 00 777777 tlz t1, -1 ; Don't confuse foolish OPENF% with our flags 41273 remark ; See what fld(.gsimg,of%mod) does here 41274 ; movx t2, fld(8,of%bsz)!of%wr!of%rd ; 8-bit bytes, read & write access. 41275 001431'01 200 02 0 00 004304' movx t2, fld(8,of%bsz)!fld(.gsimg,of%mod)!of%wr!of%rd 41276 001432'01 104 00 0 00 000021 OPENF% ; Finally try to open the silly thing 41277 001433'01 320 12 0 00 001435' ifje. r ; Failed?? 41278 001434'01 254 00 0 00 001446' 41279 001435'01 306 01 0 00 600120 cain t1, opnx1 ; But!! Was error "File already open"? 41280 001436'01 254 00 0 00 001446' anskp. ; That's fine, we can live with that 41281 001437'01 202 01 0 00 000000# movem t1, lcltte+6 ; Otherwise, store the error 41282 001440'01 550 01 0 00 000000# hrrz t1, lcljfn ; Load the JFN 41283 001441'01 104 00 0 00 000023 RLJFN% ; Let go of it 41284 001442'01 320 12 0 00 001444' ifje. r ; Failed?? We just got it! 41285 001443'01 254 00 0 00 001445' 41286 001444'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 20:02 27-Nov-23 Page 20-2 K20SUB MAC 25-Nov-23 13:11 Acquire JFN on local terminal 41287 001445'01 endif. ; And carry on with OPENF% error 41288 001445'01 254 00 0 00 001451' jrst lclerr ; And give error return 41289 001446'01 endif. ; End OPENF% failure handling 41290 41291 001446'01 260 17 0 00 001454' call gdswrp ;[223] Call Get Device Status Wrapper 41292 001447'01 550 01 0 00 000000# hrrz t1, lcljfn ;[223] Load the JFN 41293 001450'01 254 00 0 00 001367* retskp ; Won!! 41294 41295 001451'01 lclerr: remark ; Here if something broke 41296 001451'01 403 01 0 00 000000# setzb t1, lcljfn ; No JFN 41297 001452'01 402 00 0 00 000000# setzm lclflg ; No flags 41298 001453'01 263 17 0 00 000000 ret ; Nothing further we can do... 41299 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 21 K20SUB MAC 25-Nov-23 13:11 Wrapper for Get Device Status 41300 subttl Wrapper for Get Device Status 41301 41302 ;[223] Begin code insertion 41303 41304 ; Assumes lcljfn is set 41305 41306 remark ; These externals are in k20net and k20ioc 41307 extern gndpar ; Get Network Device Parity 41308 extern none ; No parity being done 41309 extern even ; Doing even parity 41310 extern parpko ; Doing parity only on packets 41311 extern parrck ; Checking parity on receive 41312 41313 001454'01 550 01 0 00 000000# gdswrp: hrrz t1, lcljfn ; Load local terminal JFN in t1 41314 001455'01 500 01 0 00 000000# hll t1, lclflg ; and its flags 41315 001456'01 260 17 0 00 000000* call gndpar ; Get 'Network' Device Status 41316 001457'01 400 02 0 00 000000 setz t2, ; Falled, assume refuses parity, then 41317 001460'01 606 02 0 00 000001 ifxn. t2, gd%par ; 'Tolerates' parity? 41318 001461'01 254 00 0 00 001471' 41319 001462'01 476 00 0 00 000000# setom lclpar ; Yes, normalize that 41320 001463'01 606 02 0 00 000010 ifxn. t2, mo%par ; Was the thing doing parity anyway 41321 001464'01 254 00 0 00 001467' 41322 001465'01 201 03 0 00 000000* movei t3, even ; Tops-20 itself only generates even parity 41323 001466'01 254 00 0 00 001470' else. ; Otherwise, we're not doing parity 41324 001467'01 201 03 0 00 000000* movei t3, none ; so set it to 'none' 41325 001470'01 endif. ; End case propagating parity 41326 001470'01 254 00 0 00 001473' else. ; Otherwise, doesn't do parity 41327 001471'01 402 00 0 00 000000# setzm lclpar ; So whack the variable 41328 001472'01 201 03 0 00 001467* movei t3, none ; And flag elsewhere to 'none' 41329 001473'01 endif. 41330 41331 001473'01 202 03 0 00 000000* movem t3, parity ; So make sure we're following local terminal parity 41332 001474'01 402 00 0 00 000000* setzm parpko ; Doing parity for terminal and packets 41333 001475'01 402 00 0 00 000000* setzm parrck ; But we're not checking it on receive 41334 41335 001476'01 263 17 0 00 000000 ret ; Done 41336 41337 ;[223] End code insertion 41338 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 22 K20SUB MAC 25-Nov-23 13:11 Restore start up terminal parameters 41339 subttl Restore start up terminal parameters 41340 41341 ; Assumes correct terminal parameters to restore are the start up ones 41342 41343 001477'01 fixtty: entry fixtty ; World callable 41344 extern svstt, tiword ; Found in K20MIT 41345 41346 001477'01 201 01 0 00 001313* movei t1, svstt ; Load pointer to start up terminal parameter block 41347 001500'01 260 17 0 00 001176' call restty ; Restore the whole kit and kaboodle 41348 001501'01 322 03 0 00 001506' ifn. t3 ; Anything not restore properly? 41349 001502'01 334 01 0 00 000000# ermsg% 41350 001503'01 254 00 0 00 001506' 41351 001504'01 202 01 0 00 001310* 41352 001505'01 104 00 0 00 000313 41353 000004'03 000000000000# 41354 000042'04 113 105 122 115 111 41355 41356 001506'01 endif. ; End case double checking 41357 001506'01 200 03 0 00 000000# move t3, mycaps+1 ; Load enabled capabilities 41358 001507'01 325 03 0 00 001512' ifxn. t3, sc%ctc ; Do we have control-C capapbility? 41359 001510'01 201 01 0 00 777773 movx t1, .fhjob ; Yes, then can grab ^C job wide 41360 001511'01 254 00 0 00 001513' else. ; Otherwise, can only do it for our fork 41361 001512'01 201 01 0 00 400000 movei t1, .fhslf ; So make it process wide, instead 41362 001513'01 endif. ; What about the inferior? 41363 41364 001513'01 200 02 0 00 000000* move t2, tiword ; Load the terminal interrupt word 41365 001514'01 104 00 0 00 000174 STIW ; and set it 41366 001515'01 320 12 0 00 001517' %jserr (,) 41367 001516'01 254 00 0 00 001522' 41368 001517'01 265 01 0 00 000257' 41369 001520'01 000000000000# 41370 001521'01 254 00 0 00 001522' 41371 000060'04 146 151 170 164 164 41372 001522'01 263 17 0 00 000000 ret 41373 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 23 K20SUB MAC 25-Nov-23 13:11 Condition local terminal for use as remote 41374 subttl Condition local terminal for use as remote 41375 41376 ;[151] Set up TTY for linking, and open any logging file. 41377 ; 41378 ;[129] Add TT%DUM 41379 41380 000000 $modof==0 ;[194] Bits we want off 41381 004000 $modof==$modof!tt%eco ;[194] Shutting off echoing 41382 004300 $modof==$modof!tt%dam ;[194] Force binary data mode (whacks field flags) 41383 004314 $modof==$modof!tt%dum ;[194] Force full duplex (whacks field flags) 41384 004334 $modof==$modof!tt%lic ;[194] Do not raise lower case on input 41385 104334 $modof==$modof!tt%wkf ;[194] Don't wakeup on formating control chars 41386 144334 $modof==$modof!tt%wkn ;[194] Don't wakeup on non-formatting control chars 41387 164334 $modof==$modof!tt%wkp ;[194] Don't wakeup on punctuation 41388 174334 $modof==$modof!tt%wka ;[194] Don't wakeup on alphanumerics 41389 000177 174334 $modof==$modof!tt%wid ;[194] Infinite width (0) 41390 037777 174334 $modof==$modof!tt%len ;[194] Infinite length (0) 41391 037777 174374 $modof==$modof!tt%uoc ;[194] Do not indicate upper case 41392 41393 001523'01 037777 174374 modoff: $modof ;[194] Store in code psect 41394 .xcref $modof ;[194] Don't need in cross reference 41395 41396 remark ;[194] Don't translate certain control characters 41397 000000 $modon==0 ;[194] Bits we want on 41398 200000 000000 $modon==$modon!tt%mff ;[194] Mechanical formfeed present 41399 300000 000000 $modon==$modon!tt%tab ;[194] Mechanical tab present 41400 340000 000000 $modon==$modon!tt%lca ;[194] Lower case capabilities present 41401 340000 000002 $modon==$modon!tt%pgm ;[194] Assume doing ^S/^Q 41402 41403 001524'01 340000 000002 modon: $modon ;[194] Store in code psect 41404 .xcref $modon ;[194] Don't need in cross reference 41405 41406 001525'01 ttyini: entry ttyini ;[194] Called from main 41407 extern handsh, flow, halt ;[186] Defined in k20mit 41408 001525'01 336 01 0 00 001370* skipn t1, ttyjfn ;[186] If have a terminal JFN, use it 41409 001526'01 334 00 0 00 000000 %ermsg (,halt) ;[186] 41410 001527'01 254 00 0 00 001533' 41411 001530'01 265 01 0 00 000257' 41412 001531'01 000000000000# 41413 001532'01 254 00 0 00 001327* 41414 000072'04 164 164 171 151 156 41415 001533'01 201 04 0 00 001477* movei t4, svstt ;[186] Point to start up terminal parameter block 41416 001534'01 120 02 0 04 000014 dmove t2, $ctmod(t4) ;[186] Load controlling terminal's mode word and error 41417 001535'01 326 03 0 00 001546' ife. t3 ;[186] Don't have it? 41418 001536'01 104 00 0 00 000107 RFMOD% ;[186] See if we can get it now 41419 001537'01 320 12 0 00 001541' %jserr (,r) ;[186] 41420 001540'01 254 00 0 00 001544' 41421 001541'01 265 01 0 00 000257' 41422 001542'01 000000000000# 41423 001543'01 254 00 0 00 000777* 41424 000104'04 164 164 171 151 156 41425 001544'01 400 03 0 00 000000 setz t3, ;[186] Worked?? Oh well, that's strange, but OK 41426 001545'01 124 02 0 04 000014 dmovem t2, $ctmod(t4) ;[186] Store what SAVTTY should have done 41427 001546'01 endif. ;[186] End case loading mode word 41428 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 23-1 K20SUB MAC 25-Nov-23 13:11 Condition local terminal for use as remote 41429 001546'01 420 02 0 00 001523' andcm t2, modoff ;[194] Shut off what we don't want 41430 001547'01 434 02 0 00 001524' or t2, modon ;[194] Or in what we want on 41431 001550'01 336 00 0 00 000000* skipn handsh ;[155] Doing handshake? 41432 001551'01 336 00 0 00 000000* skipn flow ;[155] Doing flow control? 41433 001552'01 620 02 0 00 000002 txz t2, tt%pgm ; Handshake, or no flow - don't do XON/XOFF. 41434 41435 001553'01 104 00 0 00 000110 SFMOD ; Set the bits 41436 001554'01 320 12 0 00 001556' %jserr (,r) 41437 001555'01 254 00 0 00 001561' 41438 001556'01 265 01 0 00 000257' 41439 001557'01 000000000000# 41440 001560'01 254 00 0 00 001543* 41441 000114'04 164 164 171 151 156 41442 001561'01 104 00 0 00 000217 STPAR ; ...and the other bits... 41443 001562'01 320 12 0 00 001564' %jserr (,r) 41444 001563'01 254 00 0 00 001567' 41445 001564'01 265 01 0 00 000257' 41446 001565'01 000000000000# 41447 001566'01 254 00 0 00 001560* 41448 000124'04 164 164 171 151 156 41449 41450 001567'01 201 01 0 00 777773 movx t1, .fhjob ; Turn off ^C, ^O, ^T interrupts for whole job. 41451 001570'01 200 03 0 00 000000# move t3, mycaps+1 ;[185] Load enabled capabilities 41452 001571'01 607 03 0 00 400000 txnn t3, sc%ctc ; Can only do job wide STIW if we do... 41453 001572'01 201 01 0 00 400000 movei t1, .fhslf ;[185] We don't, so process wide 41454 001573'01 104 00 0 00 000173 RTIW 41455 001574'01 320 12 0 00 001576' %jserr (,r) 41456 001575'01 254 00 0 00 001601' 41457 001576'01 265 01 0 00 000257' 41458 001577'01 000000000000# 41459 001600'01 254 00 0 00 001566* 41460 000135'04 164 164 171 151 156 41461 001601'01 202 02 0 00 001513* movem t2, tiword 41462 41463 001602'01 200 04 0 00 004305' movx t4, <1b<.ticcc>!1b<.ticco>!1b<.ticct>> 41464 001603'01 607 03 0 00 400000 txnn t3, sc%ctc 41465 001604'01 200 04 0 00 004306' movx t4, <1b<.ticco>!1b<.ticct>> 41466 001605'01 630 02 0 00 000004 tdz t2, t4 41467 001606'01 104 00 0 00 000174 STIW 41468 001607'01 320 12 0 00 001611' %jserr (,r) 41469 001610'01 254 00 0 00 001614' 41470 001611'01 265 01 0 00 000257' 41471 001612'01 000000000000# 41472 001613'01 254 00 0 00 001600* 41473 000147'04 164 164 171 151 156 41474 001614'01 263 17 0 00 000000 ret 41475 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 24 K20SUB MAC 25-Nov-23 13:11 Force a JFN to close (or try real hard to) 41476 subttl Force a JFN to close (or try real hard to) 41477 41478 ; Call: 41479 ; 41480 ; t1/ JFN to get rid of 41481 ; 41482 ; +1, JFN could not be released 41483 ; t1, t2, t3 have various errors 41484 ; 41485 ; +2, JFN no longer valid 41486 ; 41487 ; This will force just about any kind of JFN to be gotten rid 41488 ; of except for the case of a file that is still mapped. 41489 41490 extern delayf, delay ; Whether we are waiting for anything 41491 41492 001615'01 frclos: entry frclos ; Called from everywhere 41493 001615'01 265 16 0 00 004263' saveac ; Used for a copy of the JFN 41494 001616'01 553 05 0 00 000001 hrrzs q1, t1 ; Save a copy without flags 41495 001617'01 403 02 0 00 000003 setzb t2, t3 ; Let's assume everything is dandy 41496 ; Let's check a few silly cases 41497 001620'01 322 01 0 00 001450* jumpe t1, rskp ; If no JFN, then nothing to do, anyhow 41498 001621'01 306 01 0 00 377777 cain t1, .nulio ; BUT!! Never opened? 41499 001622'01 254 00 0 00 001620* retskp ; That's fine, we're done already 41500 001623'01 306 01 0 00 000101 cain t1, .priou ; How about primary output? 41501 001624'01 254 00 0 00 001622* retskp ; Don't bother closing it as it was never opened 41502 001625'01 306 01 0 00 000100 cain t1, .priin ; Somebody get mixed up? 41503 001626'01 254 00 0 00 001624* retskp ; That's OK, same deal as .priou 41504 001627'01 306 01 0 00 777777 cain t1, .cttrm ; Controlling terminal? 41505 001630'01 254 00 0 00 001626* retskp ; That won't work, either, but it's fine 41506 ; At this point, have to assume a real JFN 41507 001631'01 336 00 0 00 000000* ifmn. delayf ; Use basic delay (if we have one) 41508 001632'01 254 00 0 00 001640' 41509 001633'01 337 02 0 00 000000* skipg t2, delay ; Load and double check milliseconds 41510 001634'01 254 00 0 00 001640' anskp. ; Some kind of gubbish, don't risk it 41511 001635'01 201 01 0 00 001655' movei t1, frclo1 ; If time out, then hit the abort code 41512 001636'01 260 17 0 00 002303' call timeon ; Set the timer 41513 001637'01 550 01 0 00 000005 hrrz t1, q1 ; And reload the JFN 41514 001640'01 endif. ; Either way, hit the CLOSF% 41515 41516 001640'01 104 00 0 00 000022 CLOSF% ; Politely try to close it 41517 001641'01 320 12 0 00 001643' ifje. r ; Catch and store the error 41518 001642'01 254 00 0 00 001651' 41519 001643'01 306 01 0 00 600150 cain t1, desx1 ; Trying to close complete junk? 41520 001644'01 254 00 0 00 001651' anskp. ; Fine, pretend it's closed .. 41521 001645'01 306 01 0 00 600152 cain t1, desx3 ; No JFN anyway? 41522 001646'01 254 00 0 00 001651' anskp. ; That's fine, too; never had anything to do 41523 001647'01 200 02 0 00 000001 move t2, t1 ; Save the error for downstream processing 41524 001650'01 254 00 0 00 001653' else. ; Otherwise it worked 41525 001651'01 260 17 0 00 001673' call frclot ; Clean up any extent timers 41526 001652'01 254 00 0 00 001630* retskp ; and get out of here 41527 001653'01 endif. ; End CLOSF% interpretation 41528 41529 001653'01 306 03 0 00 600160 cain t3, clsx1 ; If error is NOT "File is not open" 41530 001654'01 254 00 0 00 001666' ifskp. ; Then try harder to close it k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 24-1 K20SUB MAC 25-Nov-23 13:11 Force a JFN to close (or try real hard to) 41531 001655'01 550 01 0 00 000005 frclo1: hrrz t1, q1 ; Reload the JFN 41532 001656'01 505 01 0 00 004000 hrli t1,(cz%abt) ; Set the abort bit, clear others 41533 001657'01 104 00 0 00 000022 CLOSF% ; Try to close it, and be rude about it 41534 001660'01 320 12 0 00 001662' ifje. r ; Catch and store error 41535 001661'01 254 00 0 00 001664' 41536 001662'01 200 03 0 00 000001 move t3, t1 ; Move error to 2nd attempt AC 41537 001663'01 254 00 0 00 001666' else. ; Otherwise, being distictly rude about it worked 41538 001664'01 260 17 0 00 001673' call frclot ; Clean up any extent timers 41539 001665'01 254 00 0 00 001652* retskp ; and give a good return 41540 001666'01 endif. ; End case cz%abt analysis 41541 001666'01 endif. ; End case, other than "File is not open" 41542 41543 remark t3, clsx1 ; Might just need to release it 41544 001666'01 550 01 0 00 000005 hrrz t1, q1 ; Load the JFN 41545 001667'01 104 00 0 00 000023 RLJFN% ; So try that 41546 001670'01 320 12 0 00 001673' erjmpr frclot ; Catch error in t1, return +1 from frclot 41547 41548 001671'01 260 17 0 00 001673' call frclot ; Clean up any extent timers 41549 001672'01 254 00 0 00 001665* retskp ; Otherwise, finally won 41550 41551 001673'01 frclot: remark ; Force close timer clean up 41552 001673'01 336 00 0 00 001631* ifmn. delayf ; Did we set a timer? 41553 001674'01 254 00 0 00 001700' 41554 001675'01 337 00 0 00 001633* skipg delay ; Did we *REALLY* set a timer? 41555 001676'01 254 00 0 00 001700' anskp. ; Nope, so that's easy 41556 001677'01 260 17 0 00 002341' call timdel ; Otherwise, whack the timer 41557 001700'01 endif. ; End timer removal decisioning 41558 001700'01 263 17 0 00 000000 ret ; Returns +1, always 41559 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 25 K20SUB MAC 25-Nov-23 13:11 file transfer error post processing 41560 subttl file transfer error post processing 41561 41562 ; Come here to close a partially received file. It will be discarded 41563 ; or kept, depending on setting of ABTFIL, i.e. SET INCOMPLETE (FILE 41564 ; DISPOSTION). 41565 41566 001701'01 giveup: entry giveup ;[213] Moved from K20MIT to fix 41567 extern abtfil ;[213] Whether to discard a partial file 41568 extern local ;[213] Set if talking to a Kermit server 41569 41570 001701'01 336 00 0 00 000000* ifmn. abtfil ;[134] Do we discard or keep? ;[194] 41571 001702'01 254 00 0 00 001717' 41572 001703'01 265 01 0 00 000170' wtlog (, filjfn) ;[233] Keep. 41573 001704'01 000000000000# 41574 001705'01 777777 777753 41575 001706'01 000000000000# 41576 000160'04 111 156 143 157 155 41577 001707'01 336 00 0 00 000000* ifmn. local ;[194] If local, safe to type 41578 001710'01 254 00 0 00 001714' 41579 001711'01 200 01 0 00 000000# txmsg <[keeping partial file]> ;[194] 41580 001712'01 104 00 0 00 000076 41581 001713'01 320 12 0 00 001714' 41582 000005'03 000000000000# 41583 000165'04 133 153 145 145 160 41584 001714'01 endif. 41585 001714'01 260 17 0 00 001750' call rdclos ; Go close as much of it as we have. 41586 ; fails through to wtlog, below 41587 001715'01 254 00 0 00 001717' anskp. ;[194] Discard it if we have some problem. 41588 001716'01 263 17 0 00 000000 ret ; Closed partial file OK. 41589 001717'01 endif. ;[194] 41590 41591 001717'01 265 01 0 00 000170' wtlog (,filjfn) ;[233] Discard. 41592 001720'01 000000000000# 41593 001721'01 777777 777746 41594 001722'01 000000000000# 41595 000172'04 111 156 143 157 155 41596 001723'01 336 00 0 00 001707* ifmn. local ;[194] If local, safe to type 41597 001724'01 254 00 0 00 001730' 41598 001725'01 200 01 0 00 000000# txmsg <[discarding]> ;[194] Say what we're up to. 41599 001726'01 104 00 0 00 000076 41600 001727'01 320 12 0 00 001730' 41601 000006'03 000000000000# 41602 000200'04 133 144 151 163 143 41603 001730'01 endif. ;[194] 41604 001730'01 337 00 0 00 000000* ifmg. filjfn ; Real file? 41605 001731'01 254 00 0 00 001746' 41606 001732'01 260 17 0 00 002062' call unmapo ; Go unmap the file 41607 001733'01 600 00 0 00 000000 nop ; Don't worry if we can't. 41608 001734'01 550 01 0 00 001730* hrrz t1, filjfn ; Clear out any junk from left half. 41609 001735'01 306 01 0 00 377777 cain t1, .nulio ;[193] Just tossing it anyway? 41610 001736'01 254 00 0 00 001746' anskp. ;[193] Yes, so nothing to ditch 41611 001737'01 661 01 0 00 004000 txo t1, cz%abt ; Discarding, so cancel the file. 41612 001740'01 104 00 0 00 000022 CLOSF% ; Close it. 41613 001741'01 320 12 0 00 001743' ifje. r ;[194] 41614 001742'01 254 00 0 00 001746' k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 25-1 K20SUB MAC 25-Nov-23 13:11 file transfer error post processing 41615 001743'01 550 01 0 00 001734* hrrz t1, filjfn ;[194] On any error, 41616 001744'01 104 00 0 00 000023 RLJFN ; at least try to release the JFN. 41617 001745'01 320 12 0 00 001746' erjmpr .+1 ;[194] Catch and ignore error 41618 001746'01 endif. ;[194] End case CLOSF% recovery (we hope) 41619 001746'01 endif. ;[193] End case actual JFN to close 41620 41621 001746'01 402 00 0 00 001743* setzm filjfn ; Say we have no file. 41622 001747'01 263 17 0 00 000000 ret 41623 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 26 K20SUB MAC 25-Nov-23 13:11 Close the output file, update the FDB, etc... 41624 subttl Close the output file, update the FDB, etc... 41625 41626 ; Return +1 on error, +2 on success. 41627 41628 001750'01 rdclos: entry rdclos ;[213] Moved from k20mit 41629 001750'01 265 16 0 00 004221' saveac ;[232] Needs a few extra registers 41630 extern ebtflg ;[213] Set if doing an 8 bit file 41631 extern tbtflg ;[232] Set if forcing a 36 bit file 41632 extern itsfil ;[213] ITS binary format file 41633 41634 001751'01 337 00 0 00 001746* skipg filjfn ;[103] Output was to a real file? 41635 001752'01 254 00 0 00 002060' jrst rdclsz ;[103] No, skip all this. 41636 001753'01 260 17 0 00 002062' call unmapo ; First, clean out the PMAPing page. 41637 001754'01 263 17 0 00 000000 ret ; Oops, failed, pass it along... 41638 41639 ;[232] Calculate values FIRST 41640 41641 001755'01 120 05 0 00 004307' rdclsv: dmove q1,[exp ^d7,^d5] ;[232] Assume ASCII and its packing factor 41642 001756'01 336 00 0 00 000000* skipn itsfil ;[75] ITS binary file? 41643 001757'01 332 00 0 00 000000* skipe ebtflg ; Or eight-bit mode? 41644 001760'01 120 05 0 00 004311' dmove q1,[exp ^d8,^d4];[232] Then load that value 41645 001761'01 332 00 0 00 000000* skipe tbtflg ;[232] Forcing 36 bit mode? 41646 001762'01 120 05 0 00 004313' dmove q1,[exp ^d36,^d5];[232] Assume words and decode factor 41647 41648 001763'01 302 05 0 00 000044 caie q1, ^d36 ;[232] Forcing 36 bit bytes? 41649 001764'01 254 00 0 00 001774' ifskp. ;[232] Yes, tweak that 41650 001765'01 200 03 0 00 000012 move t3, rchr ;[232] Load number of file bytes 41651 001766'01 400 02 0 00 000000 setz t2, ;[232] No high order!!! 41652 001767'01 234 02 0 00 000006 div t2, q2 ;[232] Compute WORDS used 41653 001770'01 302 03 0 00 000000 caie t3, 0 ;[232] Evenly divided? 41654 001771'01 354 06 0 00 000002 aosa q2, t2 ;[232] No, so bump up a word, store and skip 41655 001772'01 200 06 0 00 000002 move q2, t2 ;[232] Otherwise, just store words 41656 001773'01 254 00 0 00 001775' else. ;[232] Otherwise, no calculations needed 41657 001774'01 200 06 0 00 000012 move q2, rchr ;[232] Just load the number of file bytes 41658 001775'01 endif. ;[232] End case 36 bit fix up 41659 41660 ; Now close the file. 41661 41662 001775'01 550 01 0 00 001751* rdclsa: hrrz t1, filjfn ;[193] Get the JFN. 41663 001776'01 306 01 0 00 377777 cain t1, .nulio ;[193] Tossing? 41664 001777'01 254 00 0 00 002025' jrst rdclsc ;[232] Skip all this fdb stuff 41665 002000'01 661 01 0 00 400000 txo t1, co%nrj ;[193] Set flag for not releasing JFN. 41666 002001'01 104 00 0 00 000022 CLOSF% ; Close it. 41667 002002'01 320 14 0 00 002004' %jsker ,r ; Return error. 41668 002003'01 254 00 0 00 002007' 41669 002004'01 265 01 0 00 000035' 41670 002005'01 000000000000# 41671 002006'01 254 00 0 00 001613* 41672 000203'04 103 141 156 047 164 41673 41674 ; Update FDB information with correct byte size and (word) count 41675 41676 002007'01 505 01 0 00 000011 hrli t1, .fbbyv ;[232] Set the byte size, first. 41677 002010'01 540 01 0 00 001775* hrr t1, filjfn 41678 002011'01 660 00 0 00 000001 txo, t1, k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 26-1 K20SUB MAC 25-Nov-23 13:11 Close the output file, update the FDB, etc... 41679 002012'01 400000 000000 cf%nud ;[232] Don't update disk yet. 41680 002013'01 205 02 0 00 007700 movx t2, fb%bsz ; Byte size field mask. 41681 002014'01 137 05 0 00 004315' dpb q1,[pointr(t3,fb%bsz)] ;[232] Put in proper place 41682 002015'01 104 00 0 00 000064 CHFDB% 41683 002016'01 320 14 0 00 002017' erjmps .+1 ; Keep going if we get an error. 41684 41685 002017'01 505 01 0 00 000012 hrli t1, .fbsiz ; OK, now fix FDB. Set the number of bytes 41686 002020'01 540 01 0 00 002010* hrr t1, filjfn ; Move in the JFN. 41687 002021'01 474 02 0 00 000000 seto t2, ; Change all bits in the word. 41688 002022'01 200 03 0 00 000006 move t3, q2 ;[232] The number of bytes (or words) in the file. 41689 002023'01 104 00 0 00 000064 CHFDB% ;[232] This time, update the FDB 41690 002024'01 320 14 0 00 002025' erjmps .+1 ; Keep going if we get an error. 41691 41692 ;[126] Take care of any transaction logging. 41693 41694 002025'01 333 00 0 00 002020* rdclsc: skiple filjfn ;[193] Real file? 41695 002026'01 337 01 0 00 000176* skipg t1, tlgjfn ; Transaction log? 41696 002027'01 254 00 0 00 002046' jrst rdclsd ;[232] No, skip this. 41697 41698 002030'01 120 02 0 00 000000# smsg (< Written: >) ; Yes, log this info. 41699 002031'01 260 17 0 00 000311' 41700 000007'03 000000000000# 41701 000010'03 777777 777764 41702 000207'04 040 040 040 127 162 41703 002032'01 200 02 0 00 000006 move t2, q2 ;[232] Load the byte count 41704 002033'01 201 03 0 00 000012 movei t3, ^d10 41705 002034'01 104 00 0 00 000224 NOUT 41706 002035'01 320 14 0 00 002036' erjmps .+1 41707 002036'01 201 02 0 00 000040 movei t2, .chspc ;[194] A space 41708 002037'01 104 00 0 00 000051 BOUT 41709 002040'01 320 14 0 00 002041' erjmps .+1 41710 002041'01 200 02 0 00 000005 move t2, q1 ;[232] Load byte size 41711 002042'01 104 00 0 00 000224 NOUT 41712 002043'01 320 14 0 00 002044' erjmps .+1 41713 smsg (<-bit bytes 41714 002044'01 120 02 0 00 000000# >) 41715 002045'01 260 17 0 00 000311' 41716 000011'03 000000000000# 41717 000012'03 777777 777764 41718 000212'04 055 142 151 164 040 41719 41720 41721 ; Finish closing the output file by releasing its JFN. 41722 41723 002046'01 337 00 0 00 002025* rdclsd: skipg filjfn ;[126] ;[194] 41724 002047'01 254 00 0 00 002054' ifskp. ;[194] File was open 41725 002050'01 265 01 0 00 000170' wtlog (,filjfn) ;[233] Transaction log message. 41726 002051'01 000000000000# 41727 002052'01 777777 777771 41728 002053'01 000000000000# 41729 000215'04 103 154 157 163 145 41730 002054'01 endif. ;[194] 41731 002054'01 550 01 0 00 002046* hrrz t1, filjfn ; Release the JFN. 41732 002055'01 302 01 0 00 377777 caie t1, .nulio ;[193] Nothing to release 41733 002056'01 104 00 0 00 000023 RLJFN% k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 26-2 K20SUB MAC 25-Nov-23 13:11 Close the output file, update the FDB, etc... 41734 002057'01 600 00 0 00 000000 nop 41735 41736 002060'01 402 00 0 00 002054* rdclsz: setzm filjfn ; Say we have no more file. 41737 002061'01 254 00 0 00 001672* retskp 41738 41739 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 27 K20SUB MAC 25-Nov-23 13:11 Clean up the file mapping page for an output file. 41740 subttl Clean up the file mapping page for an output file. 41741 41742 ; Returns +1 on failure, +2 on success. 41743 ; On failure, an error packet is sent, which cancels the transfer. 41744 ; 41745 ; Uses t1,t2,t3. 41746 ; 41747 ; Note that unmapping the memory page also makes it disappear. The 41748 ; next write to the page will create a fresh page with all 0's. 41749 ; 41750 ; The trick at the beginning catches the case where the page has 41751 ; already been unmapped because we just filled in the last byte. 41752 ; Since this routine is called both by the page filler (PUTCH) and by 41753 ; the file closer (RDCLOS, to catch a final partial page), we must 41754 ; worry about files that end on a page boundary. 41755 ; 41756 ; Putting an ERJMP after any instruction that references memory will 41757 ; catch "illegal memory read" errors, and will thus prevent us from 41758 ; attempting to unmap a page that has already been unmapped and still 41759 ; has not been written into. 41760 41761 002062'01 unmapo: entry unmapo ;[213] Moved from k20mit 41762 extern pagno ;[213] Present page number in file 41763 41764 002062'01 200 01 0 00 007000 move t1, maporg ;[190] Has the page been used at all? 41765 002063'01 320 14 0 00 002061* erjmps rskp ;[213] No, done. 41766 41767 002064'01 200 01 0 00 004316' movx t1, <.fhslf,,mappag> ; Yes, map them out, our fork,,mapping page 41768 002065'01 514 02 0 00 002060* hrlz t2, filjfn ;[193] file JFN,,... 41769 002066'01 312 02 0 00 004317' came t2,[ (.nulio) ] ;[193] Just dumping it? 41770 002067'01 254 00 0 00 002072' ifskp. ;[193] Yes, so just pitch the memory 41771 002070'01 260 17 0 00 002112' call unmapa ;[213] Unmap and abort 41772 002071'01 254 00 0 00 002063* retskp ;[193] Nothing further to do 41773 002072'01 endif. ;[193] End case cleaning up a NUL: transfer 41774 41775 remark ;[193] Otherwise, had a real file mapped 41776 002072'01 326 12 0 00 002075' ife. rchr ;[213] But!! Did we ever get any data? 41777 002073'01 260 17 0 00 002112' call unmapa ;[213] Unmap and abort 41778 002074'01 254 00 0 00 002071* retskp ;[213] That was easy enough; we're done 41779 002075'01 endif. ;[213] Otherwise, non-zero file 41780 41781 002075'01 540 02 0 00 000000* hrr t2, pagno ; ...page file page number. 41782 002076'01 205 03 0 00 140000 movx t3, pm%rd!pm%wr ; Read and write access. 41783 002077'01 104 00 0 00 000056 PMAP% ; Map it out. 41784 002100'01 320 14 0 00 002102' %jsker (,r) ; Can't - fail. 41785 002101'01 254 00 0 00 002105' 41786 002102'01 265 01 0 00 000035' 41787 002103'01 000000 000000 41788 002104'01 254 00 0 00 002006* 41789 41790 remark ;[193] This isn't really necessary, but.. 41791 002105'01 550 01 0 00 002065* hrrz t1,filjfn ;[193] Load file JFN 41792 002106'01 200 02 0 00 000012 move t2, rchr ;[193] Load current character count 41793 002107'01 104 00 0 00 000027 SFPTR% ;[193] Show for nosey people on SYSDPY 41794 002110'01 320 12 0 00 002111' erjmpr .+1 ;[193] Ignore any error k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 27-1 K20SUB MAC 25-Nov-23 13:11 Clean up the file mapping page for an output file. 41795 002111'01 254 00 0 00 002074* retskp 41796 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 28 K20SUB MAC 25-Nov-23 13:11 Abort an output page 41797 subttl Abort an output page 41798 41799 ; Used to punt a page instead mapping out to disk 41800 ; 41801 ; t1/ fork handle,,page number 41802 ; 41803 ; Typically .fhslf,,file mapping page 41804 ; 41805 ; Returns +1, always 41806 41807 002112'01 unmapa: remark t1, <.fhslf,,mappag> ;[213] Our expectations 41808 002112'01 200 02 0 00 000001 move t2, t1 ;[213] For Case IV, destination is process memory 41809 002113'01 474 01 0 00 000000 seto t1, ;[213] Which we will be whacking 41810 002114'01 400 03 0 00 000000 setz t3, ;[213] No flags, no count 41811 002115'01 104 00 0 00 000056 PMAP% ;[213] Kick the page into oblivion 41812 002116'01 320 14 0 00 002120' %jsker (,r) ;[193] Not promising, but ignore 41813 002117'01 254 00 0 00 002123' 41814 002120'01 265 01 0 00 000035' 41815 002121'01 000000000000# 41816 002122'01 254 00 0 00 002104* 41817 000217'04 103 157 165 154 144 41818 002123'01 263 17 0 00 000000 ret ;[213] And return 41819 41820 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 29 K20SUB MAC 25-Nov-23 13:11 Save and restore terminal lengths (a.k.a., heights) and widths. 41821 subttl Save and restore terminal lengths (a.k.a., heights) and widths. 41822 41823 ;[185] Begin code insertion 41824 ;[185] 41825 ;[185] This is necessary because linear dimensions in excess of seven 41826 ;[185] bits (127) can not be stored in the JFN mode word as saved by 41827 ;[185] SFMOD% and restored by STPAR% 41828 ;[185] 41829 ;[185] As these are stored in halfwords, this allows for a maximum of 41830 ;[185] 262,143 for either a width or a length. As this is two decimal 41831 ;[185] orders of magnitude larger than the highest resolution graphics 41832 ;[185] cards (4096 in 2006), we probably don't have to worry about 41833 ;[185] overflowing the field for the next decade or so. None the 41834 ;[185] less, the MTOPR% does return a FULL 36 bit word; so if we ever 41835 ;[185] overflow 18 bits, then we should change this code. 41836 ;[185] 41837 ;[185] Assumes: 41838 ;[185] 41839 ;[185] t1/ Valid terminal JFN (possibly .PRIOU) 41840 ;[185] t2/ Pointer to block to save length and width 41841 ;[185] 41842 ;[185] Preserves the register file and is completely silent about errors. 41843 41844 002124'01 savlnw: entry savlnw ;[183] Globally available 41845 002124'01 265 16 0 00 004320' saveac ;[185] Do not side-effect the register file! 41846 002125'01 120 04 0 00 000001 dmove t4, t1 ;[185] Preserve JFN, dimension block address 41847 ;[185] 41848 002126'01 104 00 0 00 000117 DVCHR% ;[185] What kind of device is this? 41849 002127'01 320 12 0 00 002122* erjmpr r ;[185] it's a bogus device! 41850 002130'01 135 03 0 00 004217' load t3, dv%typ, t2 ;[185] Get device type field 41851 002131'01 302 03 0 00 000012 caie t3, .dvtty ;[185] Is this a terminal? 41852 002132'01 263 17 0 00 000000 ret ;[185] No, better leave it alone 41853 002133'01 200 01 0 00 000004 move t1, t4 ;[185] Restore the JFN 41854 ;[185] Assume infinite (and therefore useless) 41855 002134'01 403 03 0 05 000000 setzb t3, (q1) ;[185] defaults for width and length 41856 002135'01 201 02 0 00 000032 movx t2, .morll ;[185] Return the terminal page length 41857 002136'01 104 00 0 00 000077 MTOPR% ;[185] Which may be over 127 ... 41858 002137'01 320 14 0 00 002141' erjmps .+2 ;[185] Must be a bogus JFN 41859 002140'01 506 03 0 05 000000 hrlm t3, (q1) ;[185] Save length 41860 002141'01 120 02 0 00 004334' dmove t2,[exp .morlw,0] ;[185] Return the terminal page width. 41861 002142'01 104 00 0 00 000077 MTOPR% ;[185] Which may be over 127 ... 41862 002143'01 320 14 0 00 002145' erjmps .+2 ;[185] Must be a bogus JFN 41863 002144'01 542 03 0 05 000000 hrrm t3, (q1) ;[185] Save length 41864 002145'01 263 17 0 00 000000 ret ;[185] Done, restore register file 41865 41866 002146'01 rstlnw: entry rstlnw ;[194] Globally available 41867 002146'01 265 16 0 00 004320' saveac ;[185] Do not side-effect the register file! 41868 002147'01 120 04 0 00 000001 dmove t4, t1 ;[185] Preserve JFN, dimension block address 41869 ;[185] 41870 002150'01 104 00 0 00 000117 DVCHR% ;[185] What kind of device is this? 41871 002151'01 320 12 0 00 002127* erjmpr r ;[185] it's a bogus device! 41872 002152'01 135 03 0 00 004217' load t3, dv%typ, t2 ;[185] Get device type field 41873 002153'01 302 03 0 00 000012 caie t3, .dvtty ;[185] Is this a terminal? 41874 002154'01 263 17 0 00 000000 ret ;[185] No, better leave it alone 41875 002155'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 20:02 27-Nov-23 Page 29-1 K20SUB MAC 25-Nov-23 13:11 Save and restore terminal lengths (a.k.a., heights) and widths. 41876 ;[185] 41877 002156'01 201 02 0 00 000033 movx t2, .mosll ;[185] Set the terminal page length. 41878 002157'01 554 03 0 05 000000 hlrz t3, (q1) ;[185] Load old width 41879 002160'01 302 03 0 00 000000 caie t3, 0 ;[185] Ever get anything? If not, leave 41880 002161'01 104 00 0 00 000077 MTOPR% ;[185] it alone; otherwise restore it 41881 002162'01 320 14 0 00 002163' erjmps .+1 ;[185] Ignore errors, preserve JFN 41882 002163'01 201 02 0 00 000031 movx t2, .moslw ;[185] Set the terminal page width. 41883 002164'01 550 03 0 05 000000 hrrz t3, (q1) ;[185] Load old width 41884 002165'01 302 03 0 00 000000 caie t3, 0 ;[185] Ever get anything? If not, leave 41885 002166'01 104 00 0 00 000077 MTOPR% ;[185] it alone; otherwise restore it 41886 002167'01 320 14 0 00 002170' erjmps .+1 ;[185] Ignore errors, preserve JFN 41887 002170'01 263 17 0 00 000000 ret ;[185] Done, restore register file 41888 41889 ;[185] End code insertion 41890 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 30 K20SUB MAC 25-Nov-23 13:11 interrupt storage (pure) 41891 subttl interrupt storage (pure) 41892 41893 extern frtrap ;[186] Is in K20NET 41894 emacro < 41895 extern sitrap ;[203] .sigio check is in K20MAC 41896 > 41897 41898 002171'01 000000000000# levtab: pc1 41899 002172'01 000000000000# pc2 41900 002173'01 000000000000# pc3 41901 41902 000000 chntab: phase 0 41903 000000 000001 002357' tmchan: 1,,tmtrap ;[194] ; Timer trap on channel 0, priority 1. 41904 000001 000001 002724' ccchan: 1,,cctrap ; ^C trap on channel 1, same priority. 41905 000002 000002 002741' cachan: 2,,catrap ; ^A trap on channel 2, lower priority. 41906 000003 000002 003173' cxchan: 2,,cxtrap ; ^X trap on channel 3... 41907 000004 000002 003207' czchan: 2,,cztrap ; ^Z trap .... 4 41908 000005 000002 003220' cmchan: 2,,cmtrap ; ^M trap .... 5 41909 000006 block 1 ; .ICAOV==:6, not trapping arithmetic overflow 41910 000007 block 1 ; .ICFOV==:7, not trapping floating overflow 41911 000010 block 1 ; ^d8, Reserved for Digital 41912 000011 block 1 ; .ICPOV==:9, not trapping PDL overflow 41913 000012 block 1 ; .ICEOF==:10, not trapping End-of-File 41914 000013 block 1 ; .ICDAE==:11, not trapping, Data Error 41915 000014 block 1 ; .ICQTA==:12, not trapping Quota/Disk Exceeded 41916 000015 block 1 ; ^d13, Reserved for Digital 41917 000016 block 1 ; .ICTOD==:14, not trapping Time of Day (not implemented) 41918 000017 block 1 ; .ICILI==:15, not trapping Illegal Instruction 41919 000020 block 1 ; .ICIRD==:16, not trapping Illegal Read 41920 000021 block 1 ; .ICIWR==:17, not trapping Illegal Write 41921 000022 block 1 ; .ICIEX==:18, not trapping Illegal Execute (TENEX only) 41922 emacro < 41923 sigchn: 3,,sitrap ;[203] .ICIFT==:19, multiplexed with .SIGIO 41924 >;;emacro 41925 nmacro < block 1 ; .ICIFT==:19, Inferior Fork Termination 41926 000023 >;;nmacro 41927 000024 block 1 ; .ICMSE==:20, not trapping machine resources exhausted 41928 000025 block 1 ; .ICTRU==:21, not trapping to user (?) 41929 000026 block 1 ; .ICNXP==:22, not trapping nonexistent page referenced 41930 000027 000002 003230' cpchan: 2,,cptrap ; ^P trap on channel 23 41931 000030 000003 000000* frkchn: 3,,frtrap ;[186] Fork interrupt on channel 24 41932 000031 000003 003244' cychan: 3,,cytrap ;[187] ^Y trap on channel 25, level 3 41933 000032 000003 000000* dnchan: 3,,dntrap ;[218] For DECnet connection trap 41934 000033 block ^d36-. 41935 002240'01 dephase 41936 41937 ifn <<.-^d36>-chntab>,< ;;Did we get this right? 41938 printx Channel definitions are wrong 41939 end ;;Just stop and get this fixed 41940 > 41941 intern frkchn ;[186] Used by K20NET 41942 41943 remark bits for certain channels 41944 41945 004000 frkchb==:1b ;[186] Bit for fork channel k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 30-1 K20SUB MAC 25-Nov-23 13:11 interrupt storage (pure) 41946 400000 000000 timchb==:1b ;[186] Bit for TIMER% channel 41947 emacro < 41948 sigchb==:1b ;[203] Bit for macro reparse issues channel 41949 >;;emacro 41950 41951 001000 dnchb==:1b ;[218] Bit for DECnet connection channel 41952 extern dntrap ;[218] DECnet connection handler is in k20net 41953 41954 ;[218] DECnet connect interrupt field (ALL OTHERS MUST BE OFF!!!) 41955 032776 776000 dncfld==:fld(dnchan,mo%cdn)!fld(.mocia,mo%ina)!fld(.mocia,mo%dav) 41956 41957 ;[218] DECnet disconnect interrupt field (EVERYTHING MUST BE OFF!!!) 41958 776776 776000 dndfld==:fld(.mocia,mo%cdn)!fld(.mocia,mo%ina)!fld(.mocia,mo%dav) 41959 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 31 K20SUB MAC 25-Nov-23 13:11 timeit -- Creates a TIMER% to pop after an elapsed time 41960 subttl timeit -- Creates a TIMER% to pop after an elapsed time 41961 41962 ; Set a timer. Call with t1/ Address of where to go upon timout. 41963 ; 41964 ;[212] All timeouts are pre-computed to milliseconds; bums the imuli 41965 ; and allows more granular control which is good for testing 41966 ; 41967 ;[218] Can not pass .infin in t2 (with a hrloi t2, 377777, for 41968 ; example) because the math in .TIMBF (just after TIMDL2: in 41969 ; TIMER.MAC) doesn't come out correctly. Use .TIMAL, instead as 41970 ; this will remove all timers. 41971 ; 41972 ; The fact that it removes a job run time limit need not bother 41973 ; Kermit as Kermit never sets this, it is fork unique and is set 41974 ; directly by BATCON on job creation before Kermit is anywhere 41975 ; near in user memory. 41976 ; 41977 ; N.B., Note the order of the TIMER% and AIC% calls 41978 41979 002240'01 400000 000005 alltim: xwd .fhslf, .timal ;[218] Remove ALL timers for this fork 41980 002241'01 000000 000000 0 ;[219] Just in case it wants this 41981 41982 extern adjtim, ldav ; Moved to K20TIM 41983 41984 002242'01 timeit: entry timeit ; Inform LINK of our location and necessaries 41985 extern stimou, intstk, intpc, timerx, curtim 41986 002242'01 337 00 0 00 000000* skipg stimou ;[43] Doing timeouts? 41987 002243'01 263 17 0 00 000000 ret ;[43] No, skip this. 41988 002244'01 262 17 0 00 000002 pop p, t2 ; Get the return address off the stack. 41989 002245'01 202 17 0 00 000000* movem p, intstk ; Save the stack pointer 41990 002246'01 261 17 0 00 000002 push p, t2 ; Put the return address back 41991 002247'01 540 02 0 00 000001 hrr t2, t1 ; Make interrupt PC point to time out addr. 41992 002250'01 202 02 0 00 000000* movem t2, intpc ; Save the PC. 41993 002251'01 120 01 0 00 002240' dmove t1, alltim ;[218] Remove any previous TIMER%'s, FIRST 41994 002252'01 104 00 0 00 000522 TIMER 41995 002253'01 320 12 0 00 002255' ifje. r ;[194] Catch and ignore error 41996 002254'01 254 00 0 00 002257' 41997 002255'01 202 01 0 00 000000# movem t1, ltimde ;[194] Store last timer delete error 41998 002256'01 350 00 0 00 000000* aos timerx ; Count any error. 41999 002257'01 endif. ;[194] 42000 42001 remark ;[218] THEN set the new timer 42002 002257'01 400 01 0 00 000000 setz t1, ;[130] Get 1-minute load average. 42003 002260'01 260 17 0 00 000000* call ldav ;[130] 42004 002261'01 200 02 0 00 002242* move t2, stimou ;[130] Minimum acceptable. 42005 002262'01 260 17 0 00 000000* call adjtim ;[128] Adjust based on load average. 42006 002263'01 202 02 0 00 000000* movem t2, curtim ;[131] Remember this for reporting. 42007 002264'01 200 01 0 00 004336' move t1, [ .fhslf,,.timel ] ; Our process and time from now. 42008 002265'01 201 03 0 00 000000 movx t3, tmchan ;[218] Load timer channel 42009 002266'01 104 00 0 00 000522 TIMER 42010 002267'01 320 12 0 00 002271' ifje. r ;[194] Catch and ignore error 42011 002270'01 254 00 0 00 002274' 42012 002271'01 202 01 0 00 000000# movem t1, ltimcr ;[194] Store last timer creation error 42013 002272'01 350 00 0 00 002256* aos timerx ; If we get an error, count it. 42014 002273'01 254 00 0 00 002302' else. ;[218] Otherwise, worked k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 31-1 K20SUB MAC 25-Nov-23 13:11 timeit -- Creates a TIMER% to pop after an elapsed time 42015 remark ;[218] So safe to turn on the channel 42016 dmove t1, [ .fhslf ;[218] This fork 42017 002274'01 120 01 0 00 004337' timchb ] ;[218] TIMER% channel 42018 002275'01 104 00 0 00 000131 AIC ; Turn the channel on 42019 002276'01 320 12 0 00 002300' ifje. r ;[194] Catch and ignore error 42020 002277'01 254 00 0 00 002302' 42021 002300'01 202 01 0 00 000000# movem t1, laicer ;[194] However, remember it 42022 002301'01 350 00 0 00 000000# aos aicx ;[194] and count it 42023 002302'01 endif. ;[218] 42024 002302'01 endif. ;[194] 42025 42026 002302'01 263 17 0 00 000000 ret 42027 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 32 K20SUB MAC 25-Nov-23 13:11 timeon - Create a TIMER% to pop after an elapsed time 42028 subttl timeon - Create a TIMER% to pop after an elapsed time 42029 42030 ; Set a timer based in input parameter 42031 ; 42032 ; Call: 42033 ; 42034 ; t1/ Address of where to go upon timout. 42035 ; t2/ Time in milliseconds to wait 42036 ; 42037 ; N.B., All timeouts are pre-computed to milliseconds and these are 42038 ; not load average adjusted because that is the responsibility of 42039 ; the caller. The reason for this is, if you are waiting on a 42040 ; network interupt, then the remote system is the major source of 42041 ; delay, not the local one. 42042 ; 42043 ; Note the order of the TIMER% and AIC% calls 42044 42045 002303'01 timeon: entry timeon ; Inform LINK of our location and necessaries 42046 002303'01 200 04 0 00 000002 move t4, t2 ;[218] Let's just get the wait out of the way 42047 002304'01 262 17 0 00 000002 pop p, t2 ; Get the return address off the stack. 42048 002305'01 202 17 0 00 002245* movem p, intstk ; Save the stack pointer 42049 002306'01 261 17 0 00 000002 push p, t2 ; Put the return address back 42050 002307'01 540 02 0 00 000001 hrr t2, t1 ; Make interrupt PC point to time out addr. 42051 002310'01 202 02 0 00 002250* movem t2, intpc ; Save the PC. 42052 002311'01 120 01 0 00 002240' dmove t1, alltim ;[218] Remove any pending timers, FIRST 42053 002312'01 104 00 0 00 000522 TIMER 42054 002313'01 320 12 0 00 002315' ifje. r ;[194] Catch and ignore error 42055 002314'01 254 00 0 00 002317' 42056 002315'01 202 01 0 00 000000# movem t1, ltimde ;[194] Store last timer delete error 42057 002316'01 350 00 0 00 002272* aos timerx ; Count any error. 42058 002317'01 endif. ;[194] 42059 42060 remark ;[218] THEN set the new timer 42061 002317'01 200 01 0 00 004336' move t1, [.fhslf,,.timel] ; Our process and time from now. 42062 002320'01 200 02 0 00 000004 move t2, t4 ;[218] Load hard wall time 42063 002321'01 201 03 0 00 000000 movx t3, tmchan ;[218] Load timer channel 42064 002322'01 104 00 0 00 000522 TIMER% 42065 002323'01 320 12 0 00 002325' ifje. r ;[194] Catch and ignore error 42066 002324'01 254 00 0 00 002330' 42067 002325'01 202 01 0 00 000000# movem t1, ltimcr ;[194] Store last timer creation error 42068 002326'01 350 00 0 00 002316* aos timerx ; If we get an error, count it. 42069 002327'01 254 00 0 00 002336' else. ;[218] Otherwise, worked 42070 remark ;[218] So safe to turn on the channel 42071 dmove t1, [ .fhslf ;[218] This fork 42072 002330'01 120 01 0 00 004337' timchb ] ;[218] TIMER% channel 42073 002331'01 104 00 0 00 000131 AIC% ; Turn the channel on 42074 002332'01 320 12 0 00 002334' ifje. r ;[194] Catch and ignore error 42075 002333'01 254 00 0 00 002336' 42076 002334'01 202 01 0 00 000000# movem t1, laicer ;[194] However, remember it 42077 002335'01 350 00 0 00 000000# aos aicx ;[194] and count it 42078 002336'01 endif. ;[194] 42079 002336'01 endif. ;[194] 42080 42081 002336'01 263 17 0 00 000000 ret 42082 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 33 K20SUB MAC 25-Nov-23 13:11 TIMOFF - Shut off TIMER channel, clear all timers 42083 subttl TIMOFF - Shut off TIMER channel, clear all timers 42084 42085 ; N.B., Note order of DIC% and TIMER%!! 42086 42087 002337'01 timoff: entry timoff ;[194] Identify our location to LINK 42088 002337'01 337 00 0 00 002261* skipg stimou ;[43] Doing timeouts? 42089 002340'01 263 17 0 00 000000 ret ;[43] No, skip this. 42090 42091 002341'01 timdel: entry timdel ;[218] Force a timer delete 42092 002341'01 265 16 0 00 004341' saveac ; Yes, save these ACs. 42093 dmove t1, [ .fhslf ;[218] This fork 42094 002342'01 120 01 0 00 004337' timchb ] ;[218] TIMER% channel 42095 002343'01 104 00 0 00 000133 DIC% ;[194] Shut off before timer can pop! 42096 002344'01 320 12 0 00 002346' ifje. r ;[194] Catch and ignore error 42097 002345'01 254 00 0 00 002350' 42098 002346'01 202 01 0 00 000000# movem t1, ldicer ;[194] However, remember it 42099 002347'01 350 00 0 00 000000# aos dicx ;[194] and count it 42100 002350'01 endif. ;[194] 42101 002350'01 120 01 0 00 002240' dmove t1, alltim ;[218] Whack any and all pending timers 42102 002351'01 104 00 0 00 000522 TIMER 42103 002352'01 320 12 0 00 002354' ifje. r ;[194] Catch and ignore error 42104 002353'01 254 00 0 00 002356' 42105 002354'01 202 01 0 00 000000# movem t1, ltimde ;[194] Store last timer delete error 42106 002355'01 350 00 0 00 002326* aos timerx ; Count any error. 42107 002356'01 endif. ;[194] 42108 42109 002356'01 263 17 0 00 000000 ret 42110 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 34 K20SUB MAC 25-Nov-23 13:11 caltcb -- Calculate TIMER% channel bit 42111 subttl caltcb -- Calculate TIMER% channel bit 42112 42113 repeat 0,< ;[218] 42114 42115 ; Returns the right bit for the timer channel based on the channel 42116 ; number (which is filled in by LINK) in t2, ready for AIC%/DIC% 42117 42118 Replaced: 42119 42120 skipn t2, tmcbit ; Load the TIMER channel bit 42121 call caltcb ; Unless we don't know it, yet 42122 42123 With: 42124 dmove t1, [ .fhslf ;[218] This fork 42125 timchb ] ;[218] TIMER% channel 42126 42127 caltcb: skipe t2, tmcbit ; Did we already do this? 42128 ret ; Yes, get out of here 42129 42130 saveac ; Save any fork handle 42131 move t1, tmcnum ; Pick up TIMER% channel number 42132 move t2, bitnum(t1) ; Convert to a bit, quickly 42133 movem t2, tmcbit ; Save for later reuse 42134 ret ; Finally done 42135 42136 tmcnum: tmchan ; Timer channel number 42137 42138 thisbt==1b0 ; Start out at bit zero for channel 0 42139 42140 bitnum: intern bitnum ; Also used in k20net 42141 xlist ; No need to see all that blat 42142 repeat ^d36, < ;;Iterate through every possible channel 42143 thisbt ;;Drop in this channel's bit 42144 thisbt== ;;Shift over a bit position 42145 > 42146 list ; Turn listing back on 42147 >;[218] 42148 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 35 K20SUB MAC 25-Nov-23 13:11 TMTRAP -- Timer interrupt handler. 42149 subttl TMTRAP -- Timer interrupt handler. 42150 42151 ; N.B., Using a hrli to break out of a JSYS may not a good idea as it 42152 ; blows away all the flags which somebody might want 42153 42154 002357'01 tmtrap: entry tmtrap ; Identify our location for LINK 42155 extern ntimou ; And our additional necessaries 42156 002357'01 261 17 0 00 000001 push p, t1 ; Get a work AC. 42157 002360'01 200 01 0 00 002310* move t1, intpc ; Get the PC we want. 42158 002361'01 661 01 0 00 010000 txo t1, pc%usr ;[194] ;[132] Set user mode to escape from any jsys. 42159 002362'01 202 01 0 00 000000# movem t1, pc1 ; Restore as if we came from there. 42160 002363'01 262 17 0 00 000001 pop p, t1 42161 002364'01 200 17 0 00 002305* move p, intstk ; Pop any junk off the stack. 42162 002365'01 350 00 0 00 000000* aos ntimou ; Count the timeout. 42163 002366'01 104 00 0 00 000136 DEBRK 42164 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 36 K20SUB MAC 25-Nov-23 13:11 Initialize the Priority Interrupt system. 42165 subttl Initialize the Priority Interrupt system. 42166 42167 002367'01 pinit: entry pinit ;[186] Called at start up 42168 dmove t1, [ .fhslf ; This fork. 42169 002367'01 120 01 0 00 004351' levtab,,chntab] ; Say where our tables are. 42170 002370'01 104 00 0 00 000125 SIR% ;[186] Set Interrupt routines 42171 002371'01 320 12 0 00 002373' %jserr(,) ;[186] Or not 42172 002372'01 254 00 0 00 002376' 42173 002373'01 265 01 0 00 000257' 42174 002374'01 000000 000000 42175 002375'01 254 00 0 00 002376' 42176 002376'01 104 00 0 00 000126 EIR% ; Enable the interrupt system. 42177 002377'01 320 12 0 00 002401' %jserr(,) ;[186] Or not 42178 002400'01 254 00 0 00 002404' 42179 002401'01 265 01 0 00 000257' 42180 002402'01 000000 000000 42181 002403'01 254 00 0 00 002404' 42182 002404'01 263 17 0 00 000000 ret 42183 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 37 K20SUB MAC 25-Nov-23 13:11 Enable for Control-C trapping 42184 subttl Enable for Control-C trapping 42185 42186 ; Turn Control-C trap on. Sets things up so that ^C will return control 42187 ; to the instruction FOLLOWING the the call to this routine, with the 42188 ; stack fixed up appropriately, e.g. 42189 ; 42190 ; call ccon ; Turn on ^C trap 42191 ; jrst foo ; What to do if ^C is typed. 42192 ; move x, y ; Execute this after the call to CCON. 42193 ; 42194 ; Returns +2 always. 42195 ; 42196 ;[187] Rewritten to work under batch and not do so many RPCAP%'s and EPCAP%'s 42197 42198 000002 $ccn==2 ; Number of ^C's to get out of ^C trap. 42199 42200 002405'01 ccon: entry ccon 42201 extern ccfail ;[187] 42202 42203 002405'01 335 00 0 00 000000* ifmge. ccfail ;[187] Ever tried this? 42204 002406'01 254 00 0 00 002411' 42205 002407'01 200 03 0 00 000536* move t3, capas ;[187] We have, so load what we got 42206 002410'01 254 00 0 00 002450' jrst ccon2 ;[187] And just go use it 42207 002411'01 endif. ;[187] End case first time through 42208 42209 002411'01 332 03 0 00 002407* skipe t3, capas ;[187] Did we ever look? 42210 002412'01 254 00 0 00 002450' jrst ccon2 ;[187] We did, use what we got 42211 42212 002413'01 201 01 0 00 400000 movei t1, .fhslf ; Read current process capabilities. 42213 002414'01 104 00 0 00 000150 RPCAP% ;[187] Let's have a peek at what we have 42214 002415'01 320 14 0 00 002417' ifje. s ;[187] Catch and suppress error 42215 002416'01 254 00 0 00 002420' 42216 002417'01 120 02 0 00 000554* dmove t2, mycaps ;[187] Use what we first got 42217 002420'01 endif. ;[187] And carry on! 42218 42219 002420'01 336 00 0 00 000000# ifmn. ;[187] Batch frob? 42220 002421'01 254 00 0 00 002427' 42221 002422'01 621 03 0 00 400000 txz t3, sc%ctc ;[187] Say we don't have ^C turned on 42222 002423'01 621 02 0 00 400000 txz t2, sc%ctc ;[187] And that we can't get it, either 42223 002424'01 350 00 0 00 002405* aos ccfail ;[187] Flag other code to not try again 42224 002425'01 202 03 0 00 002411* movem t3, capas ;[187] Stomp the process enabled capas 42225 002426'01 254 00 0 00 002450' jrst ccon2 ;[187] Skip the rest of this cruft 42226 002427'01 endif. ;[187] End batch job case 42227 ;[187] Normal timesharing job from here 42228 002427'01 325 02 0 00 002441' ifxn. t2, sc%ctc ;[187] OK, so can we turn it on? 42229 002430'01 321 03 0 00 002441' andxe. t3, sc%ctc ;[187] And is it currently *NOT* on? 42230 002431'01 661 03 0 00 400000 txo t3, sc%ctc ;[187] So try to turn it on 42231 002432'01 104 00 0 00 000151 EPCAP% ;[187] and do the request 42232 002433'01 320 14 0 00 002434' erjmps .+1 ;[187] Catch and suppress error 42233 002434'01 104 00 0 00 000150 RPCAP% ;[187] Read back; monitor may silently ignore 42234 002435'01 320 14 0 00 002437' ifje. s ;[187] Catch and suppress error 42235 002436'01 254 00 0 00 002441' 42236 002437'01 120 02 0 00 002417* dmove t2, mycaps ;[187] Use what we first got 42237 002440'01 621 03 0 00 400000 txz t3, sc%ctc ;[187] Don't chance it being on 42238 002441'01 endif. ;[187] And get on with it k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 37-1 K20SUB MAC 25-Nov-23 13:11 Enable for Control-C trapping 42239 002441'01 endif. ;[187] End case possible enabling attempt 42240 42241 002441'01 202 03 0 00 002425* movem t3, capas ; Save them. 42242 002442'01 321 03 0 00 002450' ifxe. t3, sc%ctc ;[187] Did it NOT come on?? 42243 002443'01 352 00 0 00 002424* aose ccfail ;[187] Only complain one single time 42244 002444'01 254 00 0 00 002450' anskp. ;[187] Already tried 42245 txmsg <% Kermit-20: Can't enable ^C capability--use ^G instead 42246 002445'01 200 01 0 00 000000# > ;[187] Complain and advise 42247 002446'01 104 00 0 00 000076 42248 002447'01 320 12 0 00 002450' 42249 000013'03 000000000000# 42250 000225'04 045 040 113 145 162 42251 42252 002450'01 endif. ;[187] End case post enable analysis 42253 42254 002450'01 201 01 0 00 000002 ccon2: movei t1, $ccn ; Initialize ^C count to this. 42255 002451'01 202 01 0 00 000000# movem t1, ccn 42256 002452'01 202 17 0 00 000000# movem p, psave ;[27] Save stack pointer. 42257 002453'01 200 01 0 17 000000 move t1, (p) ;[27] And what it points to... 42258 002454'01 202 01 0 00 000000# movem t1, psave2 ;[27] 42259 dmove t1, [ .fhslf ;[187] Now, for this fork, 42260 002455'01 120 01 0 00 004353' 1b ] ;[187] activate channel 1 (^C channel) 42261 002456'01 104 00 0 00 000131 AIC ; ... 42262 002457'01 320 12 0 00 002461' %jserr (,) ;[187] 42263 002460'01 254 00 0 00 002464' 42264 002461'01 265 01 0 00 000257' 42265 002462'01 000000000000# 42266 002463'01 254 00 0 00 002464' 42267 000241'04 125 156 141 142 154 42268 002464'01 200 01 0 00 004355' move t1, [.ticcc,,1] ;[187] Let's assume we have ^C. 42269 002465'01 607 03 0 00 400000 txnn t3, sc%ctc ;[187] Unless we don't... 42270 002466'01 505 01 0 00 000007 hrli t1,.ticcg ;[187] Something familiar, ding! 42271 002467'01 556 01 0 00 000000# hlrzm t1, ccichr ;[219] Store whatever we picked 42272 002470'01 104 00 0 00 000137 ATI 42273 002471'01 320 12 0 00 002473' %jserr (,) ;[187] 42274 002472'01 254 00 0 00 002476' 42275 002473'01 265 01 0 00 000257' 42276 002474'01 000000000000# 42277 002475'01 254 00 0 00 002476' 42278 000253'04 125 156 141 142 154 42279 002476'01 254 00 0 00 002111* retskp 42280 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 38 K20SUB MAC 25-Nov-23 13:11 Turn Control-C trap off 42281 subttl Turn Control-C trap off 42282 42283 002477'01 ccoff: entry ccoff ;[186] 42284 extern srvflg ;[186] 42285 42286 002477'01 332 00 0 00 000143* skipe srvflg ;[81] Being a server? 42287 002500'01 263 17 0 00 000000 ret ;[81] Yes, so don't turn off the ^C trap. 42288 42289 ; Entry point for REALLY turning it off, even if server. 42290 42291 002501'01 ccoff2: entry ccoff2 ;[186] 42292 002501'01 265 16 0 00 004356' saveac ; Save these. 42293 002502'01 402 00 0 00 000000# setzm ccn ; Put ^C count back to 0. 42294 dmove t1, [ .fhslf ;[186] This fork. 42295 002503'01 120 01 0 00 004353' 1b ] ;[186] Deactivate channel 1. 42296 002504'01 104 00 0 00 000133 DIC 42297 002505'01 320 12 0 00 002507' %jserr (,) ;[187] 42298 002506'01 254 00 0 00 002512' 42299 002507'01 265 01 0 00 000257' 42300 002510'01 000000000000# 42301 002511'01 254 00 0 00 002512' 42302 000265'04 125 156 141 142 154 42303 42304 remark ;[219] Take the character off the channel 42305 002512'01 200 01 0 00 000000# move t1, ccichr ;[219] Load the interrupt character we used 42306 002513'01 104 00 0 00 000140 DTI ;[219] Pull it 42307 002514'01 320 12 0 00 002516' %jserr (,) ;[187] 42308 002515'01 254 00 0 00 002521' 42309 002516'01 265 01 0 00 000257' 42310 002517'01 000000000000# 42311 002520'01 254 00 0 00 002521' 42312 000277'04 125 156 141 142 154 42313 42314 002521'01 200 04 0 00 002441* ccoff3: move t4, capas ; Get capabilities. 42315 002522'01 200 01 0 00 004370' move t1, [rt%dim!.fhjob] ;[219] This job, both masks 42316 002523'01 607 04 0 00 400000 txnn t4, sc%ctc ;[219] But!! Could we have set job wide? 42317 002524'01 200 01 0 00 004371' move t1, [rt%dim!.fhslf] ;[219] This process, both masks 42318 002525'01 104 00 0 00 000173 RTIW% ;[187] Get the current interrupt mask 42319 002526'01 320 12 0 00 002530' %jserr (, r) ;[187] 42320 002527'01 254 00 0 00 002533' 42321 002530'01 265 01 0 00 000257' 42322 002531'01 000000000000# 42323 002532'01 254 00 0 00 002151* 42324 000311'04 125 156 141 142 154 42325 42326 002533'01 325 04 0 00 002537' ifxn. t4, sc%ctc ;[187] Did we have ^C? 42327 002534'01 621 02 0 00 040000 txz t2, 1b<.chcnc> ; for ^C... (^C = ASCII 3 = bit 3) 42328 002535'01 621 03 0 00 040000 txz t3, 1b<.chcnc> ;[219] Differed ^C 42329 002536'01 254 00 0 00 002541' else. ;[187] No, so must be on ^G 42330 002537'01 621 02 0 00 002000 txz t2, 1b<.chbel> ;[187] for ^G... (^G = ASCII 7 = bit 7) 42331 002540'01 621 03 0 00 002000 txz t3, 1b<.chbel> ;[219] Differed ^G 42332 002541'01 endif. ;[187] Finally have something to set 42333 002541'01 104 00 0 00 000174 STIW% ;[187] Finally fix up the interrupt mask 42334 002542'01 320 12 0 00 002544' %jserr (, r) ;[187] 42335 002543'01 254 00 0 00 002547' k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 38-1 K20SUB MAC 25-Nov-23 13:11 Turn Control-C trap off 42336 002544'01 265 01 0 00 000257' 42337 002545'01 000000000000# 42338 002546'01 254 00 0 00 002532* 42339 000322'04 125 156 141 142 154 42340 002547'01 263 17 0 00 000000 ret 42341 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 39 K20SUB MAC 25-Nov-23 13:11 Turn on ^A, ^X, and ^Z interrupts 42342 subttl Turn on ^A, ^X, and ^Z interrupts 42343 42344 ;[59] ^A, ^X, and ^Z interrupt control added as part of edit 59. 42345 42346 002550'01 caxzon: entry caxzon ;[186] 42347 extern caseen, cxseen ;[186] 42348 42349 002550'01 402 00 0 00 000000* setzm cxseen ; Say we haven't seen a ^X yet, 42350 002551'01 402 00 0 00 000000* setzm czseen ; nor a ^Z. 42351 002552'01 402 00 0 00 000000* setzm caseen ; ... 42352 002553'01 336 00 0 00 001723* skipn local ; Only do this if local! 42353 002554'01 263 17 0 00 000000 ret 42354 dmove t1, [ .fhslf ;[194] This fork. 42355 002555'01 120 01 0 00 004372' 1b!1b!1b] ;[194] Turn on the channels. 42356 002556'01 104 00 0 00 000131 AIC% 42357 002557'01 200 01 0 00 004374' move t1, [.ticca,,cachan] ; Put ^A on its channel. 42358 002560'01 104 00 0 00 000137 ATI% 42359 002561'01 200 01 0 00 004375' move t1, [.ticcx,,cxchan] ; Put ^X on its channel. 42360 002562'01 104 00 0 00 000137 ATI% 42361 002563'01 200 01 0 00 004376' move t1, [.ticcz,,czchan] ; And ^Z on its. 42362 002564'01 104 00 0 00 000137 ATI% 42363 002565'01 263 17 0 00 000000 ret 42364 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 40 K20SUB MAC 25-Nov-23 13:11 Turn ^M, ^P interrupts on 42365 subttl Turn ^M, ^P interrupts on 42366 42367 002566'01 cmpon: entry cmpon ;[186] 42368 extern cmseen ;[186] 42369 extern cpseen ;[186] 42370 42371 dmove t1, [ .fhslf ;[194] This fork. 42372 002566'01 120 01 0 00 004377' 1b!1b ] ;[194] These channels. 42373 002567'01 104 00 0 00 000131 AIC ; Activate interrupt system. 42374 002570'01 200 01 0 00 004401' move t1, [.ticcm,,cmchan] ; Assign ^M to this channel. 42375 002571'01 104 00 0 00 000137 ATI 42376 002572'01 402 00 0 00 000000* setzm cmseen 42377 002573'01 200 01 0 00 004402' move t1, [.ticcp,,cpchan] ; Assign ^P to this one. 42378 002574'01 104 00 0 00 000137 ATI 42379 002575'01 402 00 0 00 000000* setzm cpseen 42380 002576'01 263 17 0 00 000000 ret 42381 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 41 K20SUB MAC 25-Nov-23 13:11 Turn ^Y interrupts on 42382 subttl Turn ^Y interrupts on 42383 42384 ;[211] All clrbuf enhancements 42385 42386 002577'01 cyon: entry cyon ; World callable 42387 42388 002577'01 402 00 0 00 000000# setzm cyseen ; Haven't seen a Control-Y, yet 42389 dmove t1, [ .fhslf ; This fork and 42390 002600'01 120 01 0 00 004403' 1b ] ; this channel 42391 002601'01 104 00 0 00 000131 AIC% ; Activate interrupt channel 42392 002602'01 320 12 0 00 002604' %jserr (,r) ; Failed it 42393 002603'01 254 00 0 00 002607' 42394 002604'01 265 01 0 00 000257' 42395 002605'01 000000 000000 42396 002606'01 254 00 0 00 002546* 42397 002607'01 200 01 0 00 004405' move t1, [.ticcy,,cychan] 42398 002610'01 104 00 0 00 000137 ATI% ; Assign ^Y to this channel. 42399 002611'01 320 12 0 00 002613' %jserr (,r) ; Failed that 42400 002612'01 254 00 0 00 002616' 42401 002613'01 265 01 0 00 000257' 42402 002614'01 000000 000000 42403 002615'01 254 00 0 00 002606* 42404 42405 002616'01 254 00 0 00 002476* retskp ; Return success 42406 42407 ;[211] End clrbuf enhancement 42408 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 42 K20SUB MAC 25-Nov-23 13:11 Turn off ^A,^X,^Z interrupts 42409 subttl Turn off ^A,^X,^Z interrupts 42410 42411 002617'01 caxzof: entry caxzof ;[186] 42412 42413 002617'01 402 00 0 00 002550* setzm cxseen ; Turn off the flags 42414 002620'01 402 00 0 00 002551* setzm czseen ; ... 42415 002621'01 402 00 0 00 002552* setzm caseen ; ... 42416 002622'01 336 00 0 00 002553* skipn local ; Nothing to do if remote, the interrupts 42417 002623'01 263 17 0 00 000000 ret ; weren't on anyway. 42418 42419 dmove t1, [ .fhslf ;[186] Turn off ^A,^X,^Z traps. 42420 002624'01 120 01 0 00 004372' 1b!1b!1b ] ;[186] Turn off these channels. 42421 002625'01 104 00 0 00 000133 DIC% ; ... 42422 42423 002626'01 201 01 0 00 000001 movx t1, .ticca ;[219] Pull ^A 42424 002627'01 104 00 0 00 000140 DTI% 42425 002630'01 201 01 0 00 000030 movx t1, .ticcx ;[219] Pull ^X 42426 002631'01 104 00 0 00 000140 DTI% 42427 002632'01 201 01 0 00 000032 movx t1, .ticcz ;[219] Pull ^Z 42428 002633'01 104 00 0 00 000140 DTI% 42429 42430 002634'01 200 01 0 00 004371' move t1, [rt%dim!.fhslf] ;[219] This process, both masks 42431 002635'01 104 00 0 00 000173 RTIW% ; Fix up the interrupt mask for ^A,^X,^Z 42432 002636'01 630 02 0 00 004406' txz t2, <1b<.chcna>!1b<.chcnx>!1b<.chcnz>> ;[194] 42433 002637'01 630 03 0 00 004406' txz t3, <1b<.chcna>!1b<.chcnx>!1b<.chcnz>> ;[194] 42434 002640'01 104 00 0 00 000174 STIW% ; ... 42435 002641'01 320 12 0 00 002643' %jserr (,) 42436 002642'01 254 00 0 00 002646' 42437 002643'01 265 01 0 00 000257' 42438 002644'01 000000 000000 42439 002645'01 254 00 0 00 002646' 42440 002646'01 263 17 0 00 000000 ret 42441 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 43 K20SUB MAC 25-Nov-23 13:11 Turn ^M, ^P interrupts off 42442 subttl Turn ^M, ^P interrupts off 42443 42444 002647'01 cmpoff: entry cmpoff ;[186] 42445 42446 dmove t1, [ .fhslf ; Turn off ^M trap. 42447 002647'01 120 01 0 00 004377' 1b!1b ] ; Turn off channels. 42448 002650'01 104 00 0 00 000133 DIC ; ... 42449 42450 002651'01 402 00 0 00 002572* setzm cmseen ;[219] Indicate that there will 42451 002652'01 402 00 0 00 002575* setzm cpseen ;[219] be no more of these 42452 42453 002653'01 201 01 0 00 000015 movx t1, .ticcm ;[219] Pull ^M 42454 002654'01 104 00 0 00 000140 DTI 42455 002655'01 201 01 0 00 000020 movx t1, .ticcp ;[219] Pull ^P 42456 002656'01 104 00 0 00 000140 DTI 42457 42458 002657'01 200 01 0 00 004371' move t1, [rt%dim!.fhslf] ;[219] This process, both masks 42459 002660'01 104 00 0 00 000173 RTIW ; Fix up the terminal interrupt mask 42460 002661'01 621 02 0 00 000022 txz t2, <1b<.chcrt>!1b<.chcnp>> ;[194] for ^M, ^P 42461 002662'01 621 03 0 00 000022 txz t3, <1b<.chcrt>!1b<.chcnp>> ;[219] Differed ^M, ^P 42462 002663'01 104 00 0 00 000174 STIW 42463 002664'01 320 12 0 00 002666' %jserr (,) 42464 002665'01 254 00 0 00 002671' 42465 002666'01 265 01 0 00 000257' 42466 002667'01 000000 000000 42467 002670'01 254 00 0 00 002671' 42468 002671'01 263 17 0 00 000000 ret 42469 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 44 K20SUB MAC 25-Nov-23 13:11 Turn ^Y interrupt off 42470 subttl Turn ^Y interrupt off 42471 42472 ;[211] Begin clrbuf enhancement 42473 42474 002672'01 cyoff: entry cyoff ; Make globally available (to k20par) 42475 42476 dmove t1, [ .fhslf ; This process 42477 002672'01 120 01 0 00 004403' 1b ] ; The Control-Y channel 42478 002673'01 104 00 0 00 000133 DIC% ; Disable its interrupt channel 42479 002674'01 320 12 0 00 002676' %jserr(,) ; Or not, but carry on 42480 002675'01 254 00 0 00 002701' 42481 002676'01 265 01 0 00 000257' 42482 002677'01 000000 000000 42483 002700'01 254 00 0 00 002701' 42484 42485 002701'01 402 00 0 00 000000# setzm cyseen ; Indicate that there will be no more ^Y's 42486 42487 002702'01 201 01 0 00 000031 movx t1, .ticcy ;[219] Pull ^Y 42488 002703'01 104 00 0 00 000140 DTI% ;[219] Deactivate Terminal Interrupt 42489 42490 002704'01 200 01 0 00 004371' move t1, [rt%dim!.fhslf] ;This process, both masks 42491 002705'01 104 00 0 00 000173 RTIW% ; Read our entire terminal interrupt word 42492 002706'01 320 12 0 00 002710' %jserr(,r) ; Or not... Go no further 42493 002707'01 254 00 0 00 002713' 42494 002710'01 265 01 0 00 000257' 42495 002711'01 000000 000000 42496 002712'01 254 00 0 00 002615* 42497 002713'01 620 02 0 00 002000 txz t2, 1b<.chcny> ; Turn off control-Y from immediate mask 42498 002714'01 620 03 0 00 002000 txz t3, 1b<.chcny> ; Turn off control-Y from differred mask 42499 42500 002715'01 104 00 0 00 000174 STIW% ; Finally get the mask cleared up 42501 002716'01 320 12 0 00 002720' %jserr (,) ; Or not... 42502 002717'01 254 00 0 00 002723' 42503 002720'01 265 01 0 00 000257' 42504 002721'01 000000 000000 42505 002722'01 254 00 0 00 002723' 42506 002723'01 263 17 0 00 000000 ret 42507 42508 ;[211] End clrbuf enhancement 42509 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 45 K20SUB MAC 25-Nov-23 13:11 Control-C trap handler 42510 subttl Control-C trap handler 42511 42512 002724'01 373 00 0 00 000000# cctrap: sosle ccn ; Count the ^C's. 42513 002725'01 104 00 0 00 000136 DEBRK% ; If they haven't typed enough, just resume. 42514 002726'01 260 17 0 00 002337' call timoff ; Turn off any timer. 42515 txmsg <^C 42516 002727'01 200 01 0 00 000000# > ;[186] 42517 002730'01 104 00 0 00 000076 42518 002731'01 320 12 0 00 002732' 42519 000014'03 000000000000# 42520 000333'04 136 103 015 012 000 42521 002732'01 200 17 0 00 000000# move p, psave ;[27] Make sure stack pointer is right. 42522 002733'01 200 01 0 00 000000# move t1, psave2 ;[27] And stack top. 42523 002734'01 202 01 0 17 000000 movem t1, (p) ;[27] 42524 002735'01 661 01 0 00 010000 txo t1, pc%usr ;[187] Don't whack the other flags 42525 002736'01 202 01 0 00 000000# movem t1, pc1 ; Put this place into our PC. 42526 002737'01 262 17 0 00 000001 pop p, t1 ;[80] Don't need it on the stack any more. 42527 002740'01 104 00 0 00 000136 DEBRK% ; Resume where stack pointer points. 42528 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 46 K20SUB MAC 25-Nov-23 13:11 Control-A trap handler 42529 subttl Control-A trap handler 42530 42531 ;[61] Give brief progress report at terminal. 42532 42533 002741'01 catrap: remark ;[186] Lots of status variables in k20mit 42534 extern bctu, bytsiz, rcving, ebqflg 42535 extern rptflg, rptot, rtchr, sptot, stchr 42536 extern pagcnt, files, nnak 42537 42538 002741'01 261 17 0 00 000001 push p, t1 ; Save all ACs we might use. 42539 002742'01 261 17 0 00 000002 push p, t2 42540 002743'01 261 17 0 00 000003 push p, t3 42541 002744'01 336 00 0 00 000000* skipn rcving ; Sending or receiving a file? 42542 002745'01 254 00 0 00 003077' jrst catrp1 ; No. 42543 002746'01 201 01 0 00 000101 movei t1, .priou ; Say the filename 42544 002747'01 337 00 0 00 002744* ifmg. rcving 42545 002750'01 254 00 0 00 002754' 42546 smsg (<^A 42547 002751'01 120 02 0 00 000000# Sending >) ; Yes, one... 42548 002752'01 260 17 0 00 000311' 42549 000015'03 000000000000# 42550 000016'03 777777 777763 42551 000334'04 136 101 015 012 040 42552 002753'01 254 00 0 00 002756' else. 42553 smsg (<^A 42554 002754'01 120 02 0 00 000000# Receiving >) ; ...or the other. 42555 002755'01 260 17 0 00 000311' 42556 000017'03 000000000000# 42557 000020'03 777777 777761 42558 000337'04 136 101 015 012 040 42559 002756'01 endif. 42560 002756'01 201 01 0 00 000101 movei t1, .priou ; Say the filename 42561 002757'01 337 02 0 00 002105* skipg t2, filjfn ;[193] Have file JFN? 42562 002760'01 254 00 0 00 002772' ifskp. ;[193] Yeah, try to say something about it 42563 002761'01 302 02 0 00 377777 caie t2, .nulio ;[193] Dumping it? 42564 002762'01 254 00 0 00 002767' ifskp. ;[193] That's easy! 42565 002763'01 120 02 0 00 000000# dxtext (t2,) ;[193] Always same name 42566 000021'03 000000000000# 42567 000022'03 777777 777774 42568 000343'04 116 125 114 072 000 42569 002764'01 104 00 0 00 000053 SOUT% ;[193] Counted SOUT% is faster 42570 002765'01 320 14 0 00 002766' erjmps .+1 ;[193] 42571 002766'01 254 00 0 00 002772' else. ;[193] Otherwise, do it for real 42572 002767'01 400 03 0 00 000004 setz t3, t4 ;[194] 42573 002770'01 104 00 0 00 000030 JFNS% 42574 002771'01 320 14 0 00 002772' erjmps .+1 ;[193] 42575 002772'01 endif. ;[193] End NUL: special case 42576 002772'01 endif. ;[193] End case file JFN handling 42577 002772'01 200 01 0 00 000000# txmsg <, file bytesize > ; File bytesize 42578 002773'01 104 00 0 00 000076 42579 002774'01 320 12 0 00 002775' 42580 000023'03 000000000000# 42581 000344'04 054 040 146 151 154 42582 002775'01 201 01 0 00 000101 numout bytsiz ;[194] Sets t1 to .priou 42583 002776'01 200 02 0 00 000000* k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 46-1 K20SUB MAC 25-Nov-23 13:11 Control-A trap handler 42584 002777'01 201 03 0 00 000012 42585 003000'01 104 00 0 00 000224 42586 003001'01 320 14 0 00 003002' 42587 003002'01 335 00 0 00 002747* ifmge. rcving ; I/O bytesize, only if sending 42588 003003'01 254 00 0 00 003016' 42589 003004'01 120 02 0 00 000000# dxtext (t2,<, i/o bytesize >) ;[194] 42590 000024'03 000000000000# 42591 000025'03 777777 777761 42592 000350'04 054 040 151 057 157 42593 003005'01 104 00 0 00 000053 SOUT% ;[193] Counted SOUT% is faster 42594 003006'01 320 14 0 00 003007' erjmps .+1 ;[193] 42595 003007'01 201 02 0 00 000007 movei t2, ^d7 ;[194] 42596 003010'01 336 00 0 00 001756* skipn itsfil ;[75] 42597 003011'01 332 00 0 00 001757* skipe ebtflg 42598 003012'01 201 02 0 00 000010 movei t2, ^d8 ;[194] (!!) 42599 003013'01 201 03 0 00 000012 movei t3, ^d10 ;[194] 42600 003014'01 104 00 0 00 000224 NOUT% ;[194] 42601 003015'01 320 14 0 00 003016' erjmps .+1 ;[194] 42602 003016'01 endif. ;[194] 42603 003016'01 561 01 0 00 000303* hrroi t1,crlf ;[194] 42604 003017'01 104 00 0 00 000076 PSOUT% ;[194] 42605 003020'01 336 00 0 00 003010* ifmn. itsfil ;[75] 42606 003021'01 254 00 0 00 003025' 42607 003022'01 200 01 0 00 000000# txmsg < (ITS binary)> ;[75] 42608 003023'01 104 00 0 00 000076 42609 003024'01 320 12 0 00 003025' 42610 000026'03 000000000000# 42611 000354'04 040 050 111 124 123 42612 003025'01 endif. 42613 003025'01 336 00 0 00 000000* ifmn. ebqflg ;[88] 42614 003026'01 254 00 0 00 003032' 42615 003027'01 200 01 0 00 000000# txmsg < (8th-bit prefixing)> ;[88] 42616 003030'01 104 00 0 00 000076 42617 003031'01 320 12 0 00 003032' 42618 000027'03 000000000000# 42619 000357'04 040 050 070 164 150 42620 003032'01 endif. 42621 003032'01 336 00 0 00 000000* ifmn. rptflg ;[92] 42622 003033'01 254 00 0 00 003037' 42623 003034'01 200 01 0 00 000000# txmsg < (compression)> ;[92] 42624 003035'01 104 00 0 00 000076 42625 003036'01 320 12 0 00 003037' 42626 000030'03 000000000000# 42627 000364'04 040 050 143 157 155 42628 003037'01 endif. 42629 42630 003037'01 200 01 0 00 000000# txmsg < (block check type > ;[98] 42631 003040'01 104 00 0 00 000076 42632 003041'01 320 12 0 00 003042' 42633 000031'03 000000000000# 42634 000367'04 040 050 142 154 157 42635 003042'01 201 01 0 00 000101 numout bctu ;[98] 42636 003043'01 200 02 0 00 000000* 42637 003044'01 201 03 0 00 000012 42638 003045'01 104 00 0 00 000224 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 46-2 K20SUB MAC 25-Nov-23 13:11 Control-A trap handler 42639 003046'01 320 14 0 00 003047' 42640 003047'01 201 01 0 00 000051 movei t1, ")" ;[98] 42641 003050'01 104 00 0 00 000074 PBOUT ;[98] 42642 003051'01 337 02 0 00 002757* skipg t2, filjfn ;[193] Have file JFN? 42643 003052'01 254 00 0 00 003077' ifskp. ;[193] Yeah, don't lets say something silly 42644 003053'01 306 02 0 00 377777 cain t2, .nulio ;[193] Are we dumping it? 42645 003054'01 254 00 0 00 003077' anskp. ;[193] We are, so bag this because not PMAP%ing anything 42646 txmsg < 42647 003055'01 200 01 0 00 000000# At page > ; What page we're at. 42648 003056'01 104 00 0 00 000076 42649 003057'01 320 12 0 00 003060' 42650 000032'03 000000000000# 42651 000373'04 015 012 040 101 164 42652 003060'01 200 02 0 00 002075* move t2, pagno 42653 003061'01 350 00 0 00 000002 aos t2 42654 003062'01 201 01 0 00 000101 movei t1, .priou ;[194] 42655 003063'01 201 03 0 00 000012 movei T3, ^d10 ;[194] 42656 003064'01 104 00 0 00 000224 NOUT% 42657 003065'01 335 00 0 00 003002* ifmge. rcving ;[194] Out of how many 42658 003066'01 254 00 0 00 003077' 42659 003067'01 200 01 0 00 000000# txmsg < of > ; (which we know only if we're sending) 42660 003070'01 104 00 0 00 000076 42661 003071'01 320 12 0 00 003072' 42662 000033'03 000000000000# 42663 000376'04 040 157 146 040 000 42664 003072'01 201 01 0 00 000101 numout pagcnt 42665 003073'01 200 02 0 00 000000* 42666 003074'01 201 03 0 00 000012 42667 003075'01 104 00 0 00 000224 42668 003076'01 320 14 0 00 003077' 42669 003077'01 endif. ;[194] 42670 003077'01 endif. ;[194] End case of a file that isn't NUL: 42671 42672 catrp1: txmsg < 42673 003077'01 200 01 0 00 000000# Files: > ; Say how many files, 42674 003100'01 104 00 0 00 000076 42675 003101'01 320 12 0 00 003102' 42676 000034'03 000000000000# 42677 000377'04 015 012 040 106 151 42678 003102'01 201 01 0 00 000101 numout files 42679 003103'01 200 02 0 00 000000* 42680 003104'01 201 03 0 00 000012 42681 003105'01 104 00 0 00 000224 42682 003106'01 320 14 0 00 003107' 42683 003107'01 200 01 0 00 000000# txmsg <, packets: > ; packets, 42684 003110'01 104 00 0 00 000076 42685 003111'01 320 12 0 00 003112' 42686 000035'03 000000000000# 42687 000402'04 054 040 160 141 143 42688 003112'01 337 00 0 00 003065* ifmg. rcving ;[194] Positive means sending ... 42689 003113'01 254 00 0 00 003122' 42690 003114'01 201 01 0 00 000101 numout sptot ;[194] 42691 003115'01 200 02 0 00 000000* 42692 003116'01 201 03 0 00 000012 42693 003117'01 104 00 0 00 000224 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 46-3 K20SUB MAC 25-Nov-23 13:11 Control-A trap handler 42694 003120'01 320 14 0 00 003121' 42695 003121'01 254 00 0 00 003127' else. ;[194] 42696 003122'01 201 01 0 00 000101 numout rptot ;[194] 42697 003123'01 200 02 0 00 000000* 42698 003124'01 201 03 0 00 000012 42699 003125'01 104 00 0 00 000224 42700 003126'01 320 14 0 00 003127' 42701 003127'01 endif. ;[194] 42702 003127'01 200 01 0 00 000000# txmsg <, chars: > ; characters, 42703 003130'01 104 00 0 00 000076 42704 003131'01 320 12 0 00 003132' 42705 000036'03 000000000000# 42706 000405'04 054 040 143 150 141 42707 42708 003132'01 337 00 0 00 003112* ifmg. rcving ;[194] Positive means sending .... 42709 003133'01 254 00 0 00 003137' 42710 003134'01 200 02 0 00 000000* move t2, stchr 42711 003135'01 270 02 0 00 000013 add t2, schr 42712 003136'01 254 00 0 00 003141' else. ;[194] Otherwise, receiving 42713 003137'01 200 02 0 00 000000* move t2, rtchr 42714 003140'01 270 02 0 00 000012 add t2, rchr 42715 003141'01 endif. ;[194] 42716 003141'01 201 01 0 00 000101 movei t1, .priou ;[194] 42717 003142'01 201 03 0 00 000012 movei t3, ^d10 ;[194] 42718 003143'01 104 00 0 00 000224 NOUT% ;[194] 42719 txmsg < 42720 003144'01 200 01 0 00 000000# NAKs: > ; NAKS & timeouts. 42721 003145'01 104 00 0 00 000076 42722 003146'01 320 12 0 00 003147' 42723 000037'03 000000000000# 42724 000407'04 015 012 040 116 101 42725 003147'01 201 01 0 00 000101 numout nnak 42726 003150'01 200 02 0 00 000000* 42727 003151'01 201 03 0 00 000012 42728 003152'01 104 00 0 00 000224 42729 003153'01 320 14 0 00 003154' 42730 003154'01 200 01 0 00 000000# txmsg <, timeouts: > 42731 003155'01 104 00 0 00 000076 42732 003156'01 320 12 0 00 003157' 42733 000040'03 000000000000# 42734 000411'04 054 040 164 151 155 42735 003157'01 201 01 0 00 000101 numout ntimou 42736 003160'01 200 02 0 00 002365* 42737 003161'01 201 03 0 00 000012 42738 003162'01 104 00 0 00 000224 42739 003163'01 320 14 0 00 003164' 42740 txmsg < 42741 003164'01 200 01 0 00 000000# > ; End up with a CRLF 42742 003165'01 104 00 0 00 000076 42743 003166'01 320 12 0 00 003167' 42744 000041'03 000000000000# 42745 000414'04 015 012 000 000 000 42746 42747 003167'01 262 17 0 00 000003 pop p, t3 ; Restore ACs. 42748 003170'01 262 17 0 00 000002 pop p, t2 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 46-4 K20SUB MAC 25-Nov-23 13:11 Control-A trap handler 42749 003171'01 262 17 0 00 000001 pop p, t1 42750 42751 003172'01 104 00 0 00 000136 DEBRK% ; Resume. 42752 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 47 K20SUB MAC 25-Nov-23 13:11 Control-X trap handler 42753 subttl Control-X trap handler 42754 42755 ;[59] 42756 42757 003173'01 cxtrap: extern source, dirch ;[186] 42758 42759 003173'01 476 00 0 00 002617* setom cxseen ; Just set the flag & echo the character. 42760 003174'01 261 17 0 00 000001 push p, t1 42761 003175'01 261 17 0 00 000002 push p, t2 42762 003176'01 200 01 0 00 000000* move t1, source ;[140] What's the source of our data? 42763 003177'01 306 01 0 00 000000* cain t1, dirch ;[140] Is it a directory listing? 42764 003200'01 476 00 0 00 002620* setom czseen ;[140] If so, set C-Z flag, too. 42765 003201'01 200 01 0 00 000000# txmsg <^X// > 42766 003202'01 104 00 0 00 000076 42767 003203'01 320 12 0 00 003204' 42768 000042'03 000000000000# 42769 000415'04 136 130 057 057 040 42770 003204'01 262 17 0 00 000002 pop p, t2 42771 003205'01 262 17 0 00 000001 pop p, t1 42772 003206'01 104 00 0 00 000136 DEBRK% 42773 42774 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 48 K20SUB MAC 25-Nov-23 13:11 Control-Z trap handler 42775 subttl Control-Z trap handler 42776 42777 ;[59] 42778 42779 003207'01 476 00 0 00 003200* cztrap: setom czseen ; Just set the flag & echo the character. 42780 003210'01 261 17 0 00 000001 push p, t1 42781 003211'01 261 17 0 00 000002 push p, t2 42782 003212'01 200 01 0 00 000000# txmsg <^Z// > 42783 003213'01 104 00 0 00 000076 42784 003214'01 320 12 0 00 003215' 42785 000043'03 000000000000# 42786 000417'04 136 132 057 057 040 42787 003215'01 262 17 0 00 000002 pop p, t2 42788 003216'01 262 17 0 00 000001 pop p, t1 42789 003217'01 104 00 0 00 000136 DEBRK 42790 42791 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 49 K20SUB MAC 25-Nov-23 13:11 Control-M and -P trap handlers 42792 subttl Control-M and -P trap handlers 42793 42794 ;[165] 42795 42796 003220'01 cmtrap: extern cmseen, cmloc ;[186] 42797 42798 003220'01 476 00 0 00 002651* setom cmseen ; Set ^M flag 42799 003221'01 261 17 0 00 000001 push p, t1 ; Echo CRLF 42800 003222'01 261 17 0 00 000002 push p, t2 42801 txmsg < 42802 003223'01 200 01 0 00 000000# > 42803 003224'01 104 00 0 00 000076 42804 003225'01 320 12 0 00 003226' 42805 000044'03 000000000000# 42806 000421'04 015 012 000 000 000 42807 003226'01 200 01 0 00 000000* move t1, cmloc ; Get place to resume. 42808 003227'01 254 00 0 00 003237' jrst cmptr2 42809 42810 42811 003230'01 cptrap: extern cpseen ;[186] 42812 extern cploc 42813 42814 003230'01 476 00 0 00 002652* setom cpseen ; Set ^P flag 42815 003231'01 261 17 0 00 000001 push p, t1 ; Echo ^P 42816 003232'01 261 17 0 00 000002 push p, t2 42817 txmsg < 42818 003233'01 200 01 0 00 000000# ^P> 42819 003234'01 104 00 0 00 000076 42820 003235'01 320 12 0 00 003236' 42821 000045'03 000000000000# 42822 000422'04 015 012 136 120 000 42823 003236'01 200 01 0 00 000000* move t1, cploc ; Get place to resume. 42824 42825 003237'01 661 01 0 00 010000 cmptr2: txo t1, pc%usr ;[187] Get into user mode 42826 003240'01 202 01 0 00 000000# movem t1, pc2 ; Resume at desired PC. 42827 003241'01 262 17 0 00 000002 pop p, t2 42828 003242'01 262 17 0 00 000001 pop p, t1 42829 003243'01 104 00 0 00 000136 DEBRK 42830 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 50 K20SUB MAC 25-Nov-23 13:11 Control-Y interrupt handler 42831 subttl Control-Y interrupt handler 42832 42833 ;[211] All part of clrbuf changes 42834 ;[218] Not anymore!! 42835 42836 chgsec(code,data) ; Need some storage 42837 000000'05 cyseen: intern cyseen ; Global for k20par and k20net 42838 retsec ; Back to generating code 42839 42840 extern $clrbs ; Reported location of loop sleep (DISMS%) 42841 extern $waitj ;[218] Reported location of DECnet connection wait 42842 42843 003244'01 261 17 0 00 000001 cytrap: push p, t1 ; Save an accumulator 42844 003245'01 261 17 0 00 000016 push p, cx ; Save for frame building 42845 003246'01 550 01 0 00 000000# hrrz t1, pc3 ; Pick up our interrupted location (no flags) 42846 42847 003247'01 415 16 0 00 003256' block. ; Enter block context for better control flow 42848 003250'01 261 17 0 00 000016 42849 003251'01 306 01 0 00 000000* cain t1, $clrbs ; In the buffer clear sleep? 42850 003252'01 254 00 0 00 002616* retskp ; Yes, go dink his PC 42851 003253'01 306 01 0 00 000000* cain t1, $waitj ;[218] In the DECnet connection wait? 42852 003254'01 254 00 0 00 003252* retskp ;[218] Yes, dink that PC, too 42853 003255'01 263 17 0 00 000000 endbk. ; End of block context 42854 003256'01 254 00 0 00 003262' ifskp. ;[218] A known break location!! 42855 003257'01 500 01 0 00 000000# hll t1, pc3 ; Pick up interrupted flags 42856 003260'01 661 01 0 00 010000 txo t1, pc%usr ; Get into user mode 42857 003261'01 202 01 0 00 000000# movem t1, pc3 ; Change DEBRK% action 42858 003262'01 endif. ; That's all, really 42859 42860 003262'01 262 17 0 00 000016 pop p, cx ; Restore frame pointer 42861 003263'01 262 17 0 00 000001 pop p, t1 ; Restore temporary 42862 003264'01 350 00 0 00 000000# aos cyseen ; Set ^Y flag 42863 003265'01 104 00 0 00 000136 DEBRK% 42864 42865 ;[211] End clrbuf changes 42866 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 51 K20SUB MAC 25-Nov-23 13:11 String convert from eight bit to controlified 7 bit 42867 subttl String convert from eight bit to controlified 7 bit 42868 42869 ;[209] Begin code insertion 42870 42871 ; Like echo, except uses VASTLY less JSYS calls and CPU time. 42872 ; However, because we're doing eight bit bytes, the table driven MOVST 42873 ; approach uses vastly more memory. That's fine for modern usage, 42874 ; which has over 30 times the memory for a few hobbiest users. 42875 ; 42876 ; Parity bits are completely stripped, if you want parity, you must 42877 ; check this, beforehand. 42878 42879 ; Define a macro to do random character substitutions 42880 42881 define cncsub(chr1,sub1,chr2,sub2,tab,%org) < 42882 ifb ,< ;;Don't put things in bad places 42883 printx ?Must have a table to store character pair 42884 end ;;Switch to pass 2 42885 > 42886 %org==. ;;Remember where we are 42887 .xcref %org ;;Don't want in CREF, yuck! 42888 suppress %org ;;Generate symbol value largely useless 42889 reloc tab+<<&177>_-1> ;;Gets us to the correct halfword pair 42890 xwd sub1,sub2 ;;Emit the appropriate pair 42891 reloc %org ;;Get back to where we were 42892 .xcref %org ;;Stay out of my cross reference! 42893 if2 < purge %org > ;;Don't need after pass two, either 42894 >;;cncsub 42895 42896 chgsec(code,const) ; Put translate table in the constants psect 42897 42898 remark ; And on to define our piggy tables 42899 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 52 K20SUB MAC 25-Nov-23 13:11 String convert from eight bit to controlified 7 bit 42900 remark Control Character stop table, first half 42901 42902 000000 %cncha==.chnul ; Control character; starts out at .CHNUL 42903 suppress %cncha ; Don't need in symbol table listing 42904 .xcref %cncha ; Nor in cross reference 42905 42906 000046'03 cnrtab: remark ; Appropriately trigger on control chars 42907 000046' %tborg==. ; Mark beginning of table 42908 suppress %tborg ; Don't need in symbol table listing 42909 .xcref %tborg ; Nor in cross reference 42910 42911 xlist ; Don't need to see this blat 42912 list ; Restart the blather 42913 42914 000146' %eocnr==. ; Remember end of control table 42915 suppress %eocnr ; Don't need in symbol table listing 42916 .xcref %eocnr ; Nor in cross reference 42917 42918 000046'03 reloc %tborg ; Get back to the beginning of the table 42919 .xcref %tborg ; Keep off cross reference 42920 42921 xlist ; Any control character will stop us 42922 list ; Restart the blather 42923 42924 remark ; Have to special case rubout 42925 000145'03 000176 500177 cncsub("~","~",.chdel,,cnrtab) 42926 42927 000146'03 reloc %eocnr ; Get to end of first part 42928 .xcref %eocnr ; Nor in cross reference 42929 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 53 K20SUB MAC 25-Nov-23 13:11 String convert from eight bit to controlified 7 bit 42930 remark Control Character stop table, second half 42931 42932 000146'03 cnrt2:! remark ; Have to repeat for the eight bit part... 42933 .xcref cnrt2 ; Not used, so don't cross reference it 42934 suppress cnrt2 ; Surely not needed on the symbol table 42935 000146' %tborg==. ; Mark beginning of table 42936 .xcref %tborg ; Nor in cross reference 42937 42938 xlist ; Don't need to see this blat 42939 list ; Restart the blather 42940 42941 000246' %eocnr==. ; Remember end of second part of control table 42942 .xcref %eocnr ; Nor in cross reference 42943 42944 000146'03 reloc %tborg ; Get back to the beginning of the table 42945 xlist ; Save the trees!!! 42946 list ;;Turn listing back on 42947 42948 remark ; Have to special case rubout 42949 000245'03 000176 500177 cncsub("~","~",.chdel,,cnrt2) 42950 42951 000246'03 reloc %eocnr ; Get to back to end of table 42952 .xcref %eocnr ; Keep temporary off the cross-reference 42953 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 54 K20SUB MAC 25-Nov-23 13:11 String convert from eight bit to controlified 7 bit 42954 remark Control Character substitution table, first half 42955 42956 ; The translate table assumes that exactly a SINGLE character is 42957 ; to be translated and that this is only a control character. 42958 42959 000246'03 crsubt: remark ; Control character substitution table 42960 000246' %tborg==. ; Mark beginning of table 42961 .xcref %tborg ; Keep off cross reference 42962 42963 xlist ; Don't need to see this blat 42964 list ; Restart the blather 42965 42966 000346' %eocnr==. ; Remember end of control table 42967 .xcref %eocnr ; Nor in cross reference 42968 000246'03 reloc %tborg ; Get back to the beginning of the table 42969 .xcref %eocnr ; Keep off cross reference 42970 42971 000246'03 000100 000101 xwd "@","A" ; .chnul goes to ^@, .chcna goes to ^A 42972 xlist ; End of string on .CHNUL, expand others 42973 list 42974 42975 remark ; A few conventions 42976 000263'03 000132 000044 cncsub(.chcnz,"Z",.chesc,"$",crsubt) 42977 000345'03 500176 000077 cncsub("~",,.chdel,"?",crsubt) 42978 42979 000346'03 reloc %eocnr ; Get to end of first part 42980 .xcref %eocnr ; Nor in cross reference 42981 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 55 K20SUB MAC 25-Nov-23 13:11 String convert from eight bit to controlified 7 bit 42982 remark Control Character expansion table, second half 42983 42984 000346'03 crsu2:! remark ; Used for eight bits, ignores parity 42985 .xcref crsu2 ; Not used, so don't cross reference it 42986 suppress crsu2 ; Surely not needed on the symbol table 42987 000346' %tborg==. ; Mark beginning of table 42988 .xcref %tborg ; Nor in cross reference 42989 42990 xlist ; Don't need to see this blat 42991 list ; Restart the blather 42992 42993 000446' %eocnr==. ; Remember end of control table 42994 .xcref %eocnr ; Nor in cross reference 42995 000346'03 reloc %tborg ; Get back to the beginning of the table 42996 .xcref %eocnr ; Keep off cross reference 42997 42998 000346'03 000100 000101 xwd "@","A" ; .chnul goes to ^@, .chcna goes to ^A 42999 xlist ; End of string on .CHNUL, expand others 43000 list 43001 43002 remark ; A few conventions 43003 000363'03 000132 000044 cncsub(.chcnz,"Z",.chesc,"$",crsu2) 43004 000445'03 500176 000077 cncsub("~",,.chdel,"?",crsu2) 43005 43006 000446'03 reloc %eocnr ; Get to back to end of table 43007 .xcref %eocnr ; Keep temporary off the cross-reference 43008 43009 remark After 2nd pass, purge tempories 43010 if2 < purge %cncha,%eocnr, %tborg 43011 purge cnrt2, crsu2> 43012 retsec ; Get out of the constants section 43013 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 56 K20SUB MAC 25-Nov-23 13:11 String convert from eight bit to controlified 7 bit 43014 remark Actual code to convert the string 43015 43016 ; Call: 43017 ; 43018 ; t1/ length of string to convert 43019 ; t2/ point 8, somewhere ; String of eight bit characters to convert 43020 ; 43021 ; Return: 43022 ; 43023 ; +1/ Something got ill 43024 ; +2/ Success! String completely converted (or as much of it as we could) 43025 ; 43026 ; t1/ Remaining length ; How much is left of source string 43027 ; t2/ point 7, somewhere else ; Converted controlified string 43028 ; t3/ negative length ; Ready for SOUT% 43029 ; t4/ point 8, updated ; Where we stopped in the source string 43030 43031 000454 trnchr==^d300 ; Can handle this many characters at once 43032 43033 chgsec(code,data) ; Need some storage for buffers, etc. 43034 000000'05 trnbuf: intern trnbuf ;[221] Let k20pdc see it, too 43035 000000'05 block +1 ; Space for 7 bit characters 43036 retsec ; Re-open executable code 43037 43038 003266'01 015 00 0 00 000000# c87mov: movst 0,cnrtab ; Actual extend instruction being executed 43039 003267'01 000000 000000 .chnul ; Fill character is end of string 43040 43041 003270'01 s8ccv7: entry s8ccv7 ; String eight controlified convert to seven 43042 003270'01 327 01 0 00 003274' ifle. t1 ; Gubbish? 43043 003271'01 200 04 0 00 000002 move t4 ,t2 ; Return whatever they gave us 43044 003272'01 403 02 0 00 000003 setzb t2, t3 ; Then say there is nothing to SOUT% 43045 003273'01 263 17 0 00 000000 ret ; Fail the call 43046 003274'01 endif. 43047 43048 003274'01 265 16 0 00 004221' saveac ; Save more piggy registers 43049 remark q2 aliases t5 ; So t5 must be saved 43050 43051 remark t1, t2 ; Already have source length and pointer 43052 dmove t4, [ trnchr ; Load maximum length of destination 43053 003275'01 120 04 0 00 004407' point 7, trnbuf ] ; Point to destination 43054 003276'01 403 03 0 00 000006 setzb t3, q2 ; Force section local pointers 43055 003277'01 621 01 0 00 700000 txz t1, S!N!M ; Whack translation flags 43056 43057 003300'01 do. ; Enter loop context 43058 003300'01 661 01 0 00 400000 txo t1, S ; Set significance flag (start translating) 43059 003301'01 123 01 0 00 003266' extend t1, c87mov ; Move the string, testing for control chars 43060 003302'01 320 12 0 00 003304' %jserr (, r) ; Pass any machine error back up 43061 003303'01 254 00 0 00 003307' 43062 003304'01 265 01 0 00 000257' 43063 003305'01 000000000000# 43064 003306'01 254 00 0 00 002712* 43065 000423'04 115 117 126 123 124 43066 003307'01 623 01 0 00 200000 txze t1, N ; Bumped into a control character? 43067 003310'01 254 00 0 00 003320' ifskp. ; We did not; exhausted source? 43068 003311'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 20:02 27-Nov-23 Page 56-1 K20SUB MAC 25-Nov-23 13:11 String convert from eight bit to controlified 7 bit 43069 003312'01 323 01 0 00 003326' jumple t1, endlp. ; No more source? We're done 43070 003313'01 334 00 0 00 000000 %ermsg (,r) 43071 003314'01 254 00 0 00 003320' 43072 003315'01 265 01 0 00 000257' 43073 003316'01 000000000000# 43074 003317'01 254 00 0 00 003306* 43075 000426'04 103 157 156 164 162 43076 003320'01 endif. ; Otherwise, we DID hit a control character 43077 003320'01 323 04 0 00 003326' jumple t4, endlp. ; Done if no more destination 43078 003321'01 621 01 0 00 700000 txz t1, S!N!M ; Clear all the flags 43079 003322'01 260 17 0 00 003335' call cnchar ; Otherwise, process a control character 43080 003323'01 263 17 0 00 000000 ret ; Failed, just stop right now 43081 003324'01 323 04 0 00 003326' jumple t4, endlp. ; Done if no more destination space 43082 003325'01 327 01 0 00 003300' jumpg t1, top. ; Keep translating characters until no more 43083 003326'01 enddo. ; Exit loop lexical context 43084 43085 remark t1, ; Still has remaining source length 43086 003326'01 200 03 0 00 000004 move t3, t4 ; Load remaining destination 43087 003327'01 275 03 0 00 000454 subi t3, trnchr ; Calculate negative destination length 43088 003330'01 200 04 0 00 000002 move t4, t2 ; Updated source pointer is here 43089 003331'01 200 02 0 00 004411' move t2, [ point 7, trnbuf ] ; Point to destination 43090 003332'01 254 00 0 00 003254* retskp ; Successful return 43091 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 57 K20SUB MAC 25-Nov-23 13:11 String convert from eight bit to controlified 7 bit 43092 remark Convert control character to ASCII equivalent 43093 43094 ; Assumes s8ccv7 register context and is intmately linked with it 43095 ; 43096 ; t1/ Remaining length of source string 43097 ; t2/ point 8, to current location in source string 43098 ; t3/ Address portion of 30 double word pointer, MUST be zero 43099 ; t4/ Remaining length of destination string 43100 ; q1/ point 7, to current location in destination string 43101 ; q2/ Address portion of 30 double word pointer, MUST be zero 43102 ; 43103 ; Note a subtle difference between this and the escchr routine, which 43104 ; is used to implement C backslash expansion and translation. In that 43105 ; case, the backslash is skipped and the character afterwards is 43106 ; translated (or converted into a number). 43107 ; 43108 ; The enclosing MOVST is now pointing AFTER the control character and 43109 ; has updated the source remaining total to account for the fact that 43110 ; it has been consumed. However, no such thing happens to the 43111 ; destination pointer and count because nothing was ever deposited. 43112 ; 43113 ; Thus some fix-up is necessary prior to excuting the MOVST below so 43114 ; that the correct character is fetched. Similarly, the source 43115 ; counter should NOT be fixed while the destination counter MUST be 43116 ; fixed. 43117 ; 43118 ; It's the kind of edge case that you really have to single step 43119 ; through to see what the machine is actually doing... 43120 ; 43121 ; For the two cases which involve an expansion, no fix up is 43122 ; necessary, because we're skipping the control character and 43123 ; depositing fixed strings. 43124 43125 003333'01 015 00 0 00 000000# chngch: movst 0,crsubt ; Actual extend instruction being executed 43126 003334'01 000000 000000 .chnul ; Fill character is end of string 43127 43128 003335'01 265 16 0 00 004412' cnchar: saveac ; Some extra scratch for calculations 43129 003336'01 135 07 0 00 000002 ldb q3, t2 ; Load character that stopped us 43130 003337'01 306 07 0 00 000015 cain q3, .chcrt ; Carriage return? 43131 003340'01 254 00 0 00 003413' callret schcrt ; Hit special carriage return expansion 43132 003341'01 306 07 0 00 000012 cain q3, .chlfd ; Line feed? 43133 003342'01 254 00 0 00 003450' callret schlfd ; Hit special line feed expansion 43134 43135 003343'01 201 07 0 00 000136 movei q3, "^" ; Load circumflex character 43136 003344'01 136 07 0 00 000005 idpb q3, q1 ; Deposit in destination 43137 003345'01 363 04 0 00 003317* sojle t4, r ; Account for it and return if full 43138 43139 003346'01 621 01 0 00 700000 txz t1, N!M!S ; Stomp flags so math and EXTEND work 43140 003347'01 200 07 0 00 000001 move q3, t1 ; Save source length over extend 43141 003350'01 200 10 0 00 000004 move q4, t4 ; Ditto destination length 43142 43143 003351'01 474 01 0 00 000000 seto t1, ; Have to back up the source pointer to 43144 003352'01 133 01 0 00 000002 adjbp t1, t2 ; BEFORE the offending control character 43145 003353'01 200 02 0 00 000001 move t2, t1 ; Use updated pointer as new source pointer 43146 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 57-1 K20SUB MAC 25-Nov-23 13:11 String convert from eight bit to controlified 7 bit 43147 003354'01 200 01 0 00 004336' move t1,[ S!<^d1> ] ; Only looking at a SINGLE character of source 43148 003355'01 201 04 0 00 000001 movei t4,^d1 ; Don't allow any foolish filling... 43149 003356'01 123 01 0 00 003333' extend t1, chngch ; Change this SINGLE character 43150 003357'01 320 12 0 00 003361' %jserr (, r) ; Pass error up 43151 003360'01 254 00 0 00 003364' 43152 003361'01 265 01 0 00 000257' 43153 003362'01 000000000000# 43154 003363'01 254 00 0 00 003345* 43155 000441'04 103 157 156 164 162 43156 43157 003364'01 607 01 0 00 200000 ifxn. t1, N ; Invalid control character?? 43158 003365'01 254 00 0 00 003377' 43159 003366'01 200 01 0 00 000000# emsg 43160 003367'01 104 00 0 00 000313 43161 000446'03 000000000000# 43162 000450'04 111 154 154 145 147 43163 003370'01 135 01 0 00 000002 ldb t1, t2 ; Pick up what didn't work 43164 003371'01 104 00 0 00 000074 PBOUT% ; Show us 43165 003372'01 561 01 0 00 003016* hrroi t1, crlf ; Load end of line 43166 003373'01 104 00 0 00 000076 PSOUT% ; Print it 43167 003374'01 200 01 0 00 000007 move t1, q3 ; Restore unaltered source length 43168 003375'01 200 04 0 00 000010 move t4, q4 ; Restore unaltered destination length 43169 003376'01 263 17 0 00 000000 ret ; Failure return 43170 003377'01 endif. 43171 43172 003377'01 200 01 0 00 000007 move t1, q3 ; Restore source count, which is already correct 43173 003400'01 375 04 0 00 000010 sosge t4, q4 ; Fix destination count for character deposited 43174 003401'01 263 17 0 00 000000 ret ; Ran out of buffer space 43175 003402'01 254 00 0 00 003332* retskp ; Won!! 43176 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 58 K20SUB MAC 25-Nov-23 13:11 Special Control Character logic 43177 subttl Special Control Character logic 43178 43179 ; Expands carriage return and line feed so we 43180 ; don't overprint or get yucky wrap arounds 43181 ; 43182 ; Both assume: 43183 ; 43184 ; cnchar working context 43185 ; 43186 ; t1/ Remaining length of source string 43187 ; t2/ point 8, to current location in source string 43188 ; t3/ Address portion of 30 double word pointer, MUST be zero 43189 ; t4/ Remaining length of destination string 43190 ; q1/ point 7, to current location in destination string 43191 ; q2/ Address portion of 30 double word pointer, MUST be zero 43192 ; 43193 ; The idea is that the user sees something like ^M 43194 ; ^J splitting lines. Repeated Control-J's are not 43195 ; as graceful, but this is just for buffer review 43196 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 59 K20SUB MAC 25-Nov-23 13:11 Carriage expansion 43197 subttl Carriage expansion 43198 43199 ; Carriage Return puts the control character at END of expansion 43200 43201 003403'01 572321 500000 crtexp: byte (7) "^", "M", .chcrt, .chnul, .chnul 43202 003404'01 572321 505000 byte (7) "^", "M", .chcrt, .chlfd, .chnul 43203 43204 003405'01 000000 000003 crtptr: ^d3 ; String is three bytes long 43205 003406'01 44 07 0 00 003403' point 7, crtexp ; Point to expansion text 43206 003407'01 000000 000004 crtptl: ^d4 ; String is four bytes long 43207 003410'01 44 07 0 00 003404' point 7, crtexp+1 ; Point to text with line feed 43208 43209 003411'01 016 00 0 00 000000 movcrt: movslj 0, 0 ; No accumulator; E1 unused 43210 003412'01 000000 000000 .chnul ; Fill with nul's 43211 43212 003413'01 schcrt: remark q3, q4 ; Already saved by cnchar 43213 003413'01 265 16 0 00 004422' saveac ; Needs another register 43214 43215 003414'01 120 07 0 00 000001 dmove q3, t1 ; Save current source 43216 003415'01 323 07 0 00 003425' ifg. q3 ; Any remaining input? 43217 003416'01 134 01 0 00 000002 ildb t1, t2 ; Yes, pick up the next character 43218 003417'01 302 01 0 00 000012 caie t1, .chlfd ; A line feed?? 43219 003420'01 254 00 0 00 003423' ifskp. ; It is, so will be handled by schlfd 43220 003421'01 120 01 0 00 003405' dmove t1, crtptr ; Load expansion length and pointer 43221 003422'01 254 00 0 00 003424' else. ; Otherwise, drop in a line feed, too 43222 003423'01 120 01 0 00 003407' dmove t1, crtptl ; Load expansion length and pointer 43223 003424'01 endif. ; End case overwrite checking 43224 003424'01 254 00 0 00 003426' else. ; Otherwise, Carriage Return was last character 43225 003425'01 120 01 0 00 003407' dmove t1, crtptl ; So assume no line feed 43226 003426'01 endif. ; End case input buffer checking 43227 43228 003426'01 274 04 0 00 000001 sub t4, t1 ; Subtract from remaining 43229 003427'01 323 04 0 00 003363* jumple t4, r ; Fail if overflowed the beffer 43230 ; Otherwise, safe to move 43231 003430'01 200 11 0 00 000004 move q5, t4 ; Preserve the new length 43232 003431'01 200 04 0 00 000001 move t4, t1 ; Same as source, so no fill 43233 003432'01 123 01 0 00 003411' extend t1, movcrt ; Copy it all over, wee!! 43234 003433'01 320 12 0 00 003435' %jserr (,r) ;?? 43235 003434'01 254 00 0 00 003440' 43236 003435'01 265 01 0 00 000257' 43237 003436'01 000000000000# 43238 003437'01 254 00 0 00 003427* 43239 000456'04 125 156 141 142 154 43240 003440'01 120 01 0 00 000007 dmove t1, q3 ; Restore source 43241 003441'01 200 04 0 00 000011 move t4, q5 ; Restore fixed length 43242 003442'01 254 00 0 00 003402* retskp ; Return, successfully expanded 43243 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 60 K20SUB MAC 25-Nov-23 13:11 Line feed expansion 43244 subttl Line feed expansion 43245 43246 ; Line feed expansion puts the control character BEFORE expansion 43247 43248 003443'01 052751 200000 lfdexp: byte (7) .chlfd, "^", "J", .chnul, .chnul 43249 003444'01 000000 000003 lfdptr: ^d3 ; String is three bytes long 43250 003445'01 44 07 0 00 003443' point 7, lfdexp ; Point to expansion text 43251 003446'01 016 00 0 00 000000 movlfd: movslj 0, 0 ; No accumulator; E1 unused 43252 003447'01 000000 000040 .chspc ; Fill with spaces 43253 43254 003450'01 schlfd: remark q3, q4 ; Already saved by cnchar 43255 003450'01 265 16 0 00 004422' saveac ; Needs another register 43256 43257 003451'01 120 07 0 00 000001 dmove q3, t1 ; Save current source 43258 003452'01 120 01 0 00 003444' dmove t1, lfdptr ; Load expansion length and pointer 43259 003453'01 274 04 0 00 000001 sub t4, t1 ; Subtract from remaining 43260 003454'01 323 04 0 00 003437* jumple t4, r ; Fail if overflowed the beffer 43261 ; Otherwise, safe to move 43262 003455'01 200 11 0 00 000004 move q5, t4 ; Preserve the new length 43263 003456'01 200 04 0 00 000001 move t4, t1 ; Same as source, so no fill 43264 003457'01 123 01 0 00 003446' extend t1, movlfd ; Copy it all over, wee!! 43265 003460'01 320 12 0 00 003462' %jserr (,r) ;?? 43266 003461'01 254 00 0 00 003465' 43267 003462'01 265 01 0 00 000257' 43268 003463'01 000000000000# 43269 003464'01 254 00 0 00 003454* 43270 000465'04 125 156 141 142 154 43271 003465'01 120 01 0 00 000007 dmove t1, q3 ; Restore source 43272 003466'01 200 04 0 00 000011 move t4, q5 ; Restore fixed length 43273 003467'01 254 00 0 00 003442* retskp ; Success 43274 43275 ;[209] End code insertion 43276 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 61 K20SUB MAC 25-Nov-23 13:11 String copy measurement, 9:10pm Thursday, 21 July 2022 43277 subttl String copy measurement, 9:10pm Thursday, 21 July 2022 43278 43279 remark Delimma: What is the fastest way to copy strings? 43280 43281 ; A question had sometimes come up for debate as to whether the string 43282 ; instructions gave any real speed up, the concern being whether the 43283 ; set up cost of conditioning the register file and restoring it was 43284 ; worth using them. 43285 ; 43286 ; Three cases were set up, the first being a typical ildb/idpb loop 43287 ; with the second being a use of movst to move the string until a nul 43288 ; was detected. The third was a mixture; the keywords being moved 43289 ; with a loop and the macro expansions being moved with the movst. 43290 ; This was expected to be have the best performance as macro names 43291 ; (I.E., keywords) are typically not very long. 43292 ; 43293 ; 11 macros were defined, using a total of 80 characters of macro name 43294 ; space and 1365 characters of macro text space. The results are 43295 ; suprising: 43296 ; 43297 ; Case Elapsed CPU All 43298 ; 1 1.360 1.320 times 43299 ; *2 .340 .320 are in 43300 ; 3 1.020 .980 milliseconds 43301 ; 43302 ; By a considerable margin, using solely the movst won. This is why 43303 ; it is used exclusively in the macro garbage collector. Going 43304 ; forward, other cases may be identified in Kermit where it can be 43305 ; used. 43306 ; 43307 ; Older programs which use SOUT% to transfer strings would no doubt 43308 ; benefit substantially. 43309 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 62 K20SUB MAC 25-Nov-23 13:11 Table to move an ASCIZ string 43310 subttl Table to move an ASCIZ string 43311 43312 chgsec(code,const) ; Get into the constants segment 43313 43314 000002 %azchr==.chcnb ; Table starts at Control-B 43315 suppress %azchr ; Don't need in symbol table listing 43316 .xcref %azchr ; Nor in cross reference 43317 43318 000447'03 100000 000001 asztab: xwd eoscod!.chnul, .chcna ; Only stops on a NUL 43319 xlist ; Don't need to see this blat 43320 list ; Restart the blather 43321 43322 if2 < purge %azchr > ; Temporary not needed after 2nd pass 43323 retsec ; Get out of the constants section, into code 43324 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 63 K20SUB MAC 25-Nov-23 13:11 Move an ASCIZ string 43325 subttl Move an ASCIZ string 43326 43327 ; Call: 43328 ; 43329 ; t1/ Source BP (assumed section local) 43330 ; t2/ Destination BP (assumed section local) 43331 ; 43332 ; Return: 43333 ; 43334 ; +1/ Always, but may complain 43335 ; 43336 ; t1/ Updated source pointer 43337 ; t2/ Updated destination pointer 43338 ; t3/ Length of string 43339 ; 43340 ; CAUTION: 43341 ; 43342 ; Like an ildb/idpb loop, this will overwrite all memory if you let it. 43343 ; Make CERTAIN that your strings are NUL terminated!!! 43344 43345 003470'01 movasc: intern movasc ; Also used by k20srv 43346 003470'01 015 00 0 00 000000# movst 0,asztab ; Move characters until hit a NUL 43347 003471'01 000000 000000 .chnul ; Fill character 43348 43349 024000 mxascz==:MAXBUF ; A bizarre length (or ... ?) 43350 43351 003472'01 asczcp: entry asczcp ; Called by everybody 43352 remark ; Assumes can use these 43353 003472'01 261 17 0 00 000005 push p, q1 ; Piggy MOVST gorges on registers 43354 003473'01 261 17 0 00 000006 push p, q2 43355 43356 003474'01 200 05 0 00 000002 move q1, t2 ; Reposition destination for movst 43357 003475'01 200 02 0 00 000001 move t2, t1 ; Reposition source for movst 43358 003476'01 403 03 0 00 000006 setzb t3, q2 ; Force section local pointers 43359 003477'01 200 01 0 00 004430' movx t1, ; Limit source length, start significance 43360 003500'01 201 04 0 00 024000 movx t4, mxascz ; Limit destination length 43361 003501'01 123 01 0 00 003470' extend t1, movasc ; Move characters, doing useless translating 43362 003502'01 600 00 0 00 000000 nop ; Will never +1 because t1 and t4 are equal 43363 003503'01 133 00 0 00 000002 ibp t2 ; Account for .CHNUL in source 43364 003504'01 200 01 0 00 000002 move t1, t2 ; Return updated source pointer 43365 003505'01 136 06 0 00 000005 idpb q2, q1 ; Deposit a NUL at the end 43366 003506'01 200 02 0 00 000005 move t2, q1 ; Return updated destination pointer 43367 003507'01 201 03 0 00 024001 movx t3, ; Account for extra NUL byte 43368 003510'01 274 03 0 00 000004 sub t3, t4 ; Calculate length 43369 43370 003511'01 262 17 0 00 000006 pop p, q2 ; Restore registers and beat it 43371 003512'01 262 17 0 00 000005 pop p, q1 43372 003513'01 263 17 0 00 000000 ret 43373 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 64 K20SUB MAC 25-Nov-23 13:11 Historic MOVSTU Move string, uppercasing any lowercase letters. 43374 subttl Historic MOVSTU Move string, uppercasing any lowercase letters. 43375 43376 ;[245] Begin code removal 43377 43378 ; Eats any leading whitespace. 43379 ; Call with t1/ source pointer 43380 ; t2/ destination pointer 43381 ; Returns with t1, t2 updated, t3/ character count, t4/ 0. 43382 43383 repeat 0,< 43384 remark ; Replaced with an EXTEND instruction 43385 movstu: entry movstu 43386 seto t3, ; Counter, started at -1. 43387 43388 movstx: ildb t4, t1 ; Get a character. 43389 jumpn t3, movsty ; Have we got at least one nonwhitespace? 43390 caie t4, 40 ; No, is this a blank? 43391 cain t4, 11 ; or a tab? 43392 jrst movstx ; One of those, skip it. 43393 movsty: cail t4, "a" ; Convert to upper case if necessary. 43394 caile t4, "z" 43395 skipa 43396 trz t4, 40 43397 idpb t4, t2 ; Copy it. 43398 aos t3 ; Count it. 43399 jumpn t4, movstx ; Everything up to & including the first null. 43400 ret 43401 >;;repeat 0 43402 43403 ;[245] End code removal 43404 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 65 K20SUB MAC 25-Nov-23 13:11 Translation table for MOVST to UPPERcase 43405 subttl Translation table for MOVST to UPPERcase 43406 43407 ;[245] Begin table insertion 43408 43409 chgsec(code,const) ; Translate tables go in constants area 43410 43411 ; Just skips whitespace. Also, can handle 8 bit pointers, but doesn't 43412 ; do anything with a character past .chdel (177). 43413 43414 500002 %ascuh=trmcod!.chcnb ; ASCII values start at Control-B 43415 43416 000547'03 100000 500001 chrshs: xwd eoscod,trmcod!.chcna ; NUL is end of string, ^A is allowed 43417 remark ; Everything terminates, except space and tab 43418 xlist ; Don't need to see all this junk 43419 list ; Restart the blather 43420 000747' %eotuh=. ; Remember end of table 43421 43422 000553'03 reloc chrshs+<<.chbsp>_-1> ; Get to backspace, horizontal tab pair 43423 000553'03 500010 000011 xwd trmcod!.chbsp,.chtab ; Tab does NOT terminate (nor set 'N') 43424 000567'03 reloc chrshs+<<.chspc>_-1> ; Get to space, exclamation point pair 43425 000567'03 000040 500041 xwd .chspc,trmcod!"!" ; Space does NOT terminate (nor set 'N') 43426 43427 000747'03 reloc %eotuh ; Get back to end of table 43428 cleans(<%ascuh,%eotuh>) ; Don't need these temporary symbols 43429 43430 remark Character table just UPPERcases characters, stopping on EOS 43431 43432 000002 %ascus=.chcnb ; ASCII values start at Control-B 43433 43434 000747'03 100000 000001 chrmut: xwd eoscod,.chcna ; NUL is end of string, ^A is allowed 43435 xlist ; Don't need to see all this junk 43436 list ; Restart the blather 43437 001147' %eotup==. ; Remember end of table 43438 43439 remark ; Get to lower case section 43440 001027'03 reloc chrmut+<<"`">_-1> ; Gets us to the corrct halfword pair 43441 001027'03 000140 000101 xwd "`","A" ; Convert lowercase a to UPPERcase A 43442 000102 %ascus="B" ; Starting at lowercase b 43443 xlist ; Don't need to see all this junk 43444 list ; Restart the blather 43445 001044'03 000132 000173 xwd "Z",173 ; Last letter and Left brace 43446 43447 001147'03 reloc %eotup ; Get back to end of table 43448 43449 001147'03 015 00 0 00 000547' chrshe: movst 0, chrshs ; Skip white, but stop on NUL 43450 001150'03 000000 000000 .chnul ; Fill character is end of string 43451 43452 001151'03 015 00 0 00 000747' chrmup: movst 0, chrmut ; Translate table to UPPERcase 43453 001152'03 000000 000000 .chnul ; Fill character is end of string 43454 43455 cleans(<%ascus,%eotup>) ; Don't need these temporary symbols 43456 retsec ; Return to code section 43457 43458 ;[245] End table insertion 43459 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 66 K20SUB MAC 25-Nov-23 13:11 Move string, UPPERcasing any lowercase letters 43460 subttl Move string, UPPERcasing any lowercase letters 43461 43462 ;[245] Begin code insertion 43463 43464 ; Call: 43465 ; 43466 ; t1/ Source ASCII pointer 43467 ; t2/ Destination ASCII pointer 43468 ; 43469 ; Return: +1, always 43470 ; 43471 ; t1/ Updated source ASCII pointer 43472 ; t2/ Updated destination ASCII pointer 43473 ; t3/ Length of destination string, minus any initial whitespace 43474 ; t4/ Zero 43475 ; 43476 ; N.B., Munches initial horizontal white space (.chtab, .chspc) 43477 ; Stops on end of string, a .chnul 43478 43479 003514'01 movstu: entry movstu ; Used in K20MIT, checked in K20PAR 43480 003514'01 265 16 0 00 004235' saveac ; Piggy MOVST wants plenty registers 43481 003515'01 201 07 0 00 024000 movx q3, MAXBUF ; Load maximum length we'll do 43482 003516'01 200 05 0 00 000002 move q1, t2 ; Load destination pointer 43483 003517'01 200 02 0 00 000001 move t2, t1 ; Load source pointer 43484 003520'01 403 03 0 00 000006 setzb t3, q2 ; No non-section zero pointers 43485 003521'01 200 01 0 00 000007 move t1, q3 ; String length 43486 003522'01 200 04 0 00 000001 move t4, t1 ; Assume equal length strings 43487 43488 remark ^-S ; Do NOT set 'S'--NOT translating!! 43489 003523'01 123 01 0 00 000000# extend t1, chrshe ; Use auto-magic and skip horizontal space until EOS 43490 003524'01 600 00 0 00 000000 nop ; Don't need to know about skip/non-skip 43491 43492 003525'01 603 01 0 00 200000 ifxe. t1, N ; Didn't terminate with a non-whitespace? 43493 003526'01 254 00 0 00 003534' 43494 003527'01 621 01 0 00 700000 txz t1, S!N!M ; Didn't so stomp the files 43495 remark N.B., It doesn't matter if t1 is non-zero, string was all whitespace 43496 003530'01 200 01 0 00 000002 move t1, t2 ; Return updated source 43497 003531'01 200 02 0 00 000005 move t2, q1 ; Return destination, which did not change 43498 003532'01 403 03 0 00 000004 setzb t3, t4 ; No length 43499 003533'01 263 17 0 00 000000 ret ; Done squeezing entire string dry 43500 003534'01 endif. ; End case entire string was white space 43501 43502 003534'01 621 01 0 00 700000 txz t1, S!N!M ; Shut off all flags 43503 003535'01 350 10 0 00 000001 aos q4, t1 ; Store character count BEFORE terminator 43504 003536'01 200 03 0 00 000002 move t3, t2 ; Make a copy of the source pointer 43505 003537'01 474 02 0 00 000000 seto t2, ; Direction is backwards 43506 003540'01 133 02 0 00 000003 adjbp t2, t3 ; Back it up by one BEFORE terminator 43507 003541'01 400 03 0 00 000000 setz t3, ; Maintain in-section local pointer 43508 43509 003542'01 661 01 0 00 400000 txo t1, S ; Start translating 43510 003543'01 123 01 0 00 000000# extend t1, chrmup ; Use auto-magic to munch and UPPERcase! 43511 003544'01 600 00 0 00 000000 nop ; Should always skip, since no TRMCOD 43512 43513 003545'01 200 01 0 00 000002 move t1, t2 ; Load final source pointer 43514 003546'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 20:02 27-Nov-23 Page 66-1 K20SUB MAC 25-Nov-23 13:11 Move string, UPPERcasing any lowercase letters 43515 003547'01 200 03 0 00 000007 move t3, q3 ; Load original length 43516 003550'01 274 03 0 00 000004 sub t3, t4 ; Subtract stopping destination length 43517 003551'01 400 04 0 00 000000 setz t4, ; Returns zero in t4 43518 003552'01 136 04 0 00 000002 idpb t4, t2 ; Deposit NUL in destination string 43519 003553'01 271 03 0 00 000001 addi t3, ^d1 ; Account for it in length 43520 003554'01 263 17 0 00 000000 ret ; Done 43521 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 67 K20SUB MAC 25-Nov-23 13:11 Translation tables for Counted MOVST to UPPERcase 43522 subttl Translation tables for Counted MOVST to UPPERcase 43523 43524 ;[245] Begin table insertion 43525 43526 chgsec(code,const) ; Translate tables go in constants area 43527 43528 remark First table just skips the horizontal space 43529 43530 ; Similar to chrmut, but does not munch NUL's, it just skips 43531 ; whitespace. Also, expects 8 bit pointers, but doesn't do anything 43532 ; with a character past .chdel (177) 43533 43534 500000 %ascuw=trmcod!.chnul ; ASCII values start at NUL 43535 43536 001153'03 chrsws: remark ; Everything terminates, except space and tab 43537 xlist ; Don't need to see all this junk 43538 list ; Restart the blather 43539 001353' %eotuw=. ; Remember end of table 43540 43541 001157'03 reloc chrsws+<<.chbsp>_-1> ; Get to backspace, horizontal tab pair 43542 001157'03 500010 000011 xwd trmcod!.chbsp,.chtab ; Tab does NOT terminate (nor set 'N') 43543 001173'03 reloc chrsws+<<.chspc>_-1> ; Get to space, exclamation point pair 43544 001173'03 000040 500041 xwd .chspc,trmcod!"!" ; Space does NOT terminate (nor set 'N') 43545 43546 001353'03 reloc %eotuw ; Get back to end of table 43547 cleans(<%ascuw,%eotuw>) ; Don't need these temporary symbols 43548 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 68 K20SUB MAC 25-Nov-23 13:11 Translation tables for Counted MOVST to UPPERcase 43549 remark Second table does the UPPERcasing, but does not munch NUL's 43550 43551 ; Only uppercases the 26 lowercase letters: a, b, c, d, e, f, g, h, i, 43552 ; j, k, l, m, n, o, p, q, r, s, t, u, v, w, x, y and z. Other 43553 ; characters are left strictly alone. 43554 43555 000000 %ascuc=.chnul ; ASCII values start at NUL (nothing stops it) 43556 43557 001353'03 chrcut: remark ; Table to only uppercase, not NUL's 43558 xlist ; Don't need to see all this junk 43559 list ; Restart the blather 43560 001553' %eotuc==. ; Remember end of table 43561 43562 remark ; Get to lower case section 43563 001433'03 reloc chrcut+<<"`">_-1> ; Gets us to the corrct halfword pair 43564 001433'03 000140 000101 xwd "`","A" ; Convert lowercase a to UPPERcase A 43565 000102 %ascuc="B" ; Starting at lowercase b 43566 xlist ; Don't need to see all this junk 43567 list ; Restart the blather 43568 001450'03 000132 000173 xwd "Z",173 ; Last letter and Left brace 43569 43570 001553'03 reloc %eotuc ; Get back to end of table 43571 cleans(<%ascuc,%eotuc>) ; Don't need these temporary symbols 43572 43573 001553'03 015 00 0 00 001153' chrcsw: movst 0,chrsws ; Translate table to skip initial white space 43574 001554'03 000000 000000 .chnul ; Fill character is end of string 43575 43576 001555'03 015 00 0 00 001353' chrcup: movst 0,chrcut ; Translate table to UPPERcase 43577 001556'03 000000 000000 .chnul ; Fill character is end of string 43578 43579 retsec ; Return to code section 43580 43581 ;[245] End table insertion 43582 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 69 K20SUB MAC 25-Nov-23 13:11 Counted Move string, uppercasing any lowercase letters. 43583 subttl Counted Move string, uppercasing any lowercase letters. 43584 43585 ;[245] Begin code insertion 43586 43587 ; Call: 43588 ; 43589 ; t1/ Source ASCII pointer 43590 ; t2/ Destination ASCII pointer 43591 ; t3/ Count of source string bytes (not including trailing NUL) 43592 ; 43593 ; Return: +1, always 43594 ; 43595 ; t1/ Updated source ASCII pointer 43596 ; t2/ Updated destination ASCII pointer 43597 ; t3/ Length of final string, minus any initial whitespace 43598 ; t4/ Length of source string (which can be used as an internal check) 43599 ; 43600 ; N.B., Munches initial horizontal white space (.chtab, .chspc) 43601 ; Stops when source string count goes to zero and does NOT 43602 ; squeeze out NUL's. Do not include a trailing NUL in the 43603 ; count unless you want it there! 43604 ; 43605 ; After reviewing the tables above, understand that it is a TERRIBLE 43606 ; idea to call this routine after you have put parity on a string. 43607 43608 003555'01 movsuc: entry movsuc ; Used in K20PAR (to check out K20MIT) 43609 003555'01 265 16 0 00 004235' saveac ; Piggy MOVST wants plenty registers 43610 003556'01 200 07 0 00 000003 move q3, t3 ; Preserve length of source string 43611 003557'01 200 05 0 00 000002 move q1, t2 ; Load destination pointer 43612 003560'01 200 02 0 00 000001 move t2, t1 ; Load source pointer 43613 003561'01 403 03 0 00 000006 setzb t3, q2 ; No non-section zero pointers 43614 003562'01 200 01 0 00 000007 move t1, q3 ; Load source length 43615 003563'01 200 04 0 00 000001 move t4, t1 ; Destination will never be longer 43616 43617 remark ^-S ; Do NOT set 'S'--NOT translating!! 43618 003564'01 123 01 0 00 000000# extend t1, chrcsw ; First, skip all the whitespace 43619 003565'01 600 00 0 00 000000 nop ; May never skip since should always trmcod 43620 43621 003566'01 603 01 0 00 200000 ifxe. t1, N ; BUT!! Wasn't it force terminate?? 43622 003567'01 254 00 0 00 003575' 43623 003570'01 200 01 0 00 000002 move t1, t2 ; Return (updated) source string pointer 43624 003571'01 200 02 0 00 000005 move t2, q1 ; Return (unmodified) destination string pointer 43625 003572'01 400 03 0 00 000000 setz t3, ; Final string has no length 43626 003573'01 200 04 0 00 000007 move t4, q3 ; Return (unchanged) original length 43627 003574'01 263 17 0 00 000000 ret ; That was easy enough 43628 003575'01 endif. ; Otherwise, hit non-whitespace 43629 43630 003575'01 621 01 0 00 700000 txz t1, S!N!M ; Shut off all flags 43631 003576'01 350 10 0 00 000001 aos q4, t1 ; Store character count BEFORE terminator 43632 003577'01 200 03 0 00 000002 move t3, t2 ; Make a copy of the source pointer 43633 003600'01 474 02 0 00 000000 seto t2, ; Direction is backwards 43634 003601'01 133 02 0 00 000003 adjbp t2, t3 ; Back it up by one BEFORE terminator 43635 003602'01 400 03 0 00 000000 setz t3, ; Maintain in-section local pointer 43636 43637 003603'01 661 01 0 00 400000 txo t1, S ; Start translating k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 69-1 K20SUB MAC 25-Nov-23 13:11 Counted Move string, uppercasing any lowercase letters. 43638 003604'01 123 01 0 00 000000# extend t1, chrcup ; Use auto-magic to munch and uppercase! 43639 003605'01 600 00 0 00 000000 nop ; Should always skip, since no TRMCOD 43640 43641 003606'01 200 01 0 00 000002 move t1, t2 ; Load final source pointer 43642 003607'01 200 06 0 00 000007 move q2, q3 ; Load original length 43643 003610'01 274 06 0 00 000010 sub q2, q4 ; Calculate how many we skipped 43644 003611'01 200 03 0 00 000007 move t3, q3 ; Load original length 43645 003612'01 274 03 0 00 000006 sub t3, q2 ; Calculate final length of destination string 43646 43647 003613'01 210 02 0 00 000006 movn t2, q2 ; Load characters we skipped (but going backwards) 43648 003614'01 133 02 0 00 000005 adjbp t2, q1 ; Back up to the end of that (shrunken) string) 43649 003615'01 200 04 0 00 000007 move t4, q3 ; Source string length didn't change 43650 003616'01 263 17 0 00 000000 ret ; Done 43651 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 70 K20SUB MAC 25-Nov-23 13:11 Historic IAC code removed from k20mit 43652 subttl Historic IAC code removed from k20mit 43653 43654 ;[247] Begin code removal 43655 43656 repeat 0,< ;;Copied here out of k20mit 43657 move t2, [point 8, sndpkt] ; Yes, must double any IACs. 43658 move t3, [point 8, tvtbuf] ; Copy data field to this place. 43659 spak6a: ildb t1, t2 ; Byte loop. Get one. 43660 jumpe t1, spak6b ; Done? 43661 idpb t1, t3 ; No, copy it. 43662 cain t1, iac ; IAC? 43663 idpb t1, t3 ; Yes, copy it again. 43664 jrst spak6a ; Till done. 43665 spak6b: setz t1, ; Done, make result asciz. 43666 idpb t1, t3 ; ... 43667 move q1, t3 ;[223] Save last pointer 43668 move t2, [point 8, tvtbuf] ; Point to result. 43669 >;;repeat 0 43670 43671 ;[247] End code removal 43672 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 71 K20SUB MAC 25-Nov-23 13:11 iaciac Translation tables 43673 subttl iaciac Translation tables 43674 43675 ;[247] Begin table insertion 43676 43677 ; Background: 43678 ; 43679 ; Telnet uses a special 8-bit character to indicate that the next byte 43680 ; in the terminal stream should be interpreted as a command. This 43681 ; character is known as the IAC character and is octal 377, hex FF and 43682 ; decimal 256. 43683 ; 43684 ; When Kermit-20 is sending binary data, it is possible that a 43685 ; legitimate 377 can be seen in the data stream. Further, a delete or 43686 ; rubout character (octal 177) sent with even parity will also occur. 43687 ; This latter case is perhaps unlikely as TVT transport does not 43688 ; support parity. 43689 ; 43690 ; In either case, the IAC must quoted (meaning doubled) in order to be 43691 ; transmitted properly. This cannot happen with a DECnet NRT 43692 ; transport as signaling is done out-of-band. 43693 ; 43694 ; Kermit-20 previously looped through each packet to determine whether 43695 ; IAC doubling was necessary. Rewriting it to use the EXTEND MOVST 43696 ; instruction is part of ongoing loop elimination and replacement, 43697 ; another example being found [245], above. 43698 43699 chgsec(code,const) ; Translate tables go in constants area 43700 43701 000000 %iachr==.chnul ; 8 bit values start at NUL 43702 43703 001557'03 iactab: xlist ; Save some trees 43704 list ; Turn the blather back on 43705 43706 001757' %eotia==. ; Mark end of table 43707 43708 000177 %eotio==>_-1 ; Calculate offset of IAC pair 43709 001756'03 reloc iactab+%eotio ; Get there in translate table 43710 001756'03 000376 500377 xwd 376,trmcod!iac ; Stop if we hit an IAC 43711 43712 001757'03 reloc %eotia ; Get back to end of table 43713 43714 001757'03 015 00 0 00 001557' chriac: movst 0,iactab ; Stop on an IAC 43715 001760'03 000000 000000 .chnul ; Fill character is end of string 43716 43717 cleans(<%iachr,%eotia,%eotio>) ; Don't need these temporary symbols 43718 retsec ; Return to code section 43719 43720 ;[247] End table insertion 43721 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 72 K20SUB MAC 25-Nov-23 13:11 iaciac Double Interprete As a Command character 43722 subttl iaciac Double Interprete As a Command character 43723 43724 ;[247] Begin code insertion 43725 43726 ; Call: 43727 ; 43728 ; t1/ Source length 43729 ; t2/ Source 8 bit pointer 43730 ; t3/ Destination 8 bit pointer 43731 ; 43732 ; Return: 43733 ; 43734 ; +1, some error 43735 ; 43736 ; T1/ -1 indicates that t2 and t3 pointed to the same string 43737 ; 43738 ; +2, Following registers updated 43739 ; 43740 ; t1/ Length of source string 43741 ; t2/ Updated 43742 ; t3/ Updated 43743 ; t4/ Length of destination string 43744 ; 43745 ; N.B., Because an IAC will be doubled, if T2 and T3 point to the same 43746 ; string, the following character will be TRASHED wth the second 43747 ; IAC. Therefore, DO NOT DO THIS. iaciac will give a fail return 43748 ; with a -1 if it detects this situation. 43749 43750 003617'01 iaciac: entry iaciac ; Called by spak in k20mit and $echo in k20par 43751 003617'01 312 02 0 00 000003 came t2, t3 ; We're not going to overwrite, are we? 43752 003620'01 254 00 0 00 003624' ifskp. ; That's not any good ... 43753 003621'01 474 01 0 00 000000 seto t1, ; Flag the problem 43754 003622'01 263 17 0 00 000000 ret ; Give error return 43755 003623'01 254 00 0 00 003627' else. ; Otherwise, let's get started 43756 003624'01 265 16 0 00 004431' saveac 43757 003625'01 200 11 0 00 000001 move p1, t1 ; Save original source length 43758 003626'01 400 12 0 00 000000 setz p2, ; Zero count of doubles 43759 003627'01 endif. ; End case initial check 43760 43761 remark t2, ; Already has proper source pointer 43762 003627'01 200 05 0 00 000003 move q1, t3 ; Set up destination pointer 43763 003630'01 403 03 0 00 000006 setzb t3, q2 ; Section local pointers 43764 003631'01 200 04 0 00 000001 move t4, t1 ; Load source length 43765 003632'01 242 04 0 00 000001 lsh t4, ^d1 ; Maximum is double the entire string of IAC's... 43766 003633'01 201 07 0 00 000377 movx q3, IAC ; Handy IAC for doubling 43767 003634'01 621 01 0 00 300000 txz t1, N!M ; Turn off status bits 43768 43769 003635'01 do. ; Enter loop lexical context 43770 003635'01 661 01 0 00 400000 txo t1, S ; Start translating immediately 43771 003636'01 123 01 0 00 000000# extend t1, chriac ; Start looking for an IAC 43772 003637'01 600 00 0 00 000000 nop ; Don't care about premature ending 43773 003640'01 607 01 0 00 200000 ifxn. t1, N ; Hit an IAC?? 43774 003641'01 254 00 0 00 003646' 43775 003642'01 136 07 0 00 000005 idpb q3, q1 ; Yes, drop it in 43776 003643'01 136 07 0 00 000005 idpb q3, q1 ; ...Twice... k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 72-1 K20SUB MAC 25-Nov-23 13:11 iaciac Double Interprete As a Command character 43777 003644'01 271 12 0 00 000001 addi p2, ^d1 ; And count an extra character 43778 003645'01 275 04 0 00 000002 subi t4, ^d2 ; Account for two bytes used 43779 003646'01 endif. ; End case of premature termination 43780 003646'01 621 01 0 00 700000 txz t1, S!N!M ; Shut off all MOVST bits for length check 43781 003647'01 323 01 0 00 003652' jumple t1, endlp. ; Break out of loop if source exhausted 43782 003650'01 323 04 0 00 003652' jumple t4, endlp. ; Break out of loop if destination exhausted 43783 003651'01 254 00 0 00 003635' loop. ; Otherwise, more to do 43784 003652'01 enddo. ; End of loop lexical context 43785 43786 003652'01 200 01 0 00 000011 move t1, p1 ; Load source length 43787 remark t2, ; Return updated source pointer 43788 003653'01 200 03 0 00 000005 move t3, q1 ; Return updated destination pointer 43789 003654'01 200 04 0 00 000011 move t4, p1 ; Load source length 43790 003655'01 270 04 0 00 000012 add t4, p2 ; Add in doubled IAC's to get destination 43791 003656'01 254 00 0 00 003467* retskp ; Finally done 43792 43793 ;[247] End code insertion 43794 43795 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 73 K20SUB MAC 25-Nov-23 13:11 Various extended addressing bits 43796 SUBTTL Various extended addressing bits 43797 43798 ;[216] This is all lifted from the Extended Mode FTP Server I wrote --Tom 43799 43800 REMARK Some other stuff which perhaps should have it into MACSYM? 43801 43802 777700 000000 GP%2PF==MASKB(0,11) ; Double word pointer field 43803 770000 000000 GP%2PB==MASKB(0,5) ; Double word pointer position of byte 43804 007700 000000 GP%2SB==MASKB(6,11) ; Double word pointer size of byte 43805 000040 000000 GP%2WB==1B12 ; Double word pointer signal bit 43806 000037 777777 GP%2RS==MASKB(13,35) ; Double word reserved field 43807 377777 777777 GP%2AD==MASKB(1,35) ; Double word 30 bit address, including 43808 ; Indirect bit, index fields 43809 770000 000000 GP%1PF==MASKB(0,5) ; Single word pointer field 43810 007777 777777 GP%1AD==MASKB(6,35) ; Single word FLAT 30 bit address 43811 43812 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 74 K20SUB MAC 25-Nov-23 13:11 Double word to single word routine 43813 subttl Double word to single word routine 43814 43815 ; T2/ Double word pointer to convert 43816 ; T3/ 43817 ; 43818 ; +1 Bogus double word P&S fields 43819 ; +2 Success, coverted single word pointer in T1 43820 ; 43821 ; To do: What happends to the XMOVEI if the address pointer is bogus? 43822 ; (Bits 1 and 2 not [1|0] or [0|1] or non-zero data in reserved 43823 ; bits 2 through 12 in local indirect words) 43824 ; Is there a faster way to do this translation? 43825 43826 003657'01 627 02 0 00 000040 D2SGPC: TXZN T2,GP%2WB ; First things first, check and stomp 43827 003660'01 263 17 0 00 000000 RET ; the double word pointer bit. 43828 003661'01 630 02 0 00 004445' ANDX T2,GP%2PF ; Mask off any reserved or user sillyness 43829 003662'01 201 01 0 00 000031 MOVX T1,%OWMAX-1 ; Start at the end of the table 43830 003663'01 DO. ; Check to see if these are valid P&S 43831 003663'01 316 02 0 01 000000# CAMN T2,OW2DW(T1) ; fields for a one word global pointer 43832 003664'01 254 00 0 00 003666' EXIT. ; Found it! 43833 003665'01 365 01 0 00 003663' SOJGE T1,TOP. ; Get to next table entry 43834 003666'01 ENDDO. ; Until checked beginning 43835 003666'01 305 01 0 00 000000 CAIGE T1,0 ; Did we find a valid entry? 43836 003667'01 263 17 0 00 000000 RET ; Nope, can't do the conversion 43837 003670'01 271 01 0 00 000045 ADDI T1,^D37 ; Offset into proper single word P&S field 43838 003671'01 241 01 0 00 000036 ROT T1,<^D35-POS(GP%1PF)> ;Position to single word P&S field, saving 43839 003672'01 612 01 0 00 004446' TXNE T1,GP%1AD ; possible field overflow. And any junk? 43840 003673'01 263 17 0 00 000000 RET ; Yes, probably a bogus table offset 43841 remark ; Resolve any local or global indirection (impossible) 43842 003674'01 434 01 0 00 000003 IOR T1,T3 ; Load the 30 bit address into the one word 43843 003675'01 254 00 0 00 003656* RETSKP ; global pointer 43844 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 75 K20SUB MAC 25-Nov-23 13:11 One Word to Double word byte pointer translation table 43845 SUBTTL One Word to Double word byte pointer translation table 43846 43847 ; The table is copied from Page 2-85 in the User Operations section of 43848 ; the PDP-10 1982 Processor Reference Manual. Note that there is a 43849 ; documentation error for entry 40; it is listed as 28 and should be 18. 43850 43851 chgsec(code,const) ; Pointer table is considered constant data 43852 43853 001761'03 440600 000000 OW2DW: ; 37 Legal P&S ; 6 Bit Pointers 43854 001762'03 360600 000000 ; 38 Legal P&S 43855 001763'03 300600 000000 ; 39 Legal P&S 43856 001764'03 220600 000000 ; 40 Legal P&S 43857 001765'03 140600 000000 ; 41 Legal P&S 43858 001766'03 060600 000000 ; 42 Legal P&S 43859 001767'03 000600 000000 ; 43 Legal P&S 43860 001770'03 441000 000000 ; 44 Legal P&S ; 8 Bit Pointers 43861 001771'03 341000 000000 ; 45 Legal P&S 43862 001772'03 241000 000000 ; 46 Legal P&S 43863 001773'03 141000 000000 ; 47 Legal P&S 43864 001774'03 041000 000000 ; 48 Legal P&S 43865 001775'03 440700 000000 ; 49 Legal P&S ; 7 Bit Pointers 43866 001776'03 350700 000000 ; 50 Legal P&S 43867 001777'03 260700 000000 ; 51 Legal P&S 43868 002000'03 170700 000000 ; 52 Legal P&S 43869 002001'03 100700 000000 ; 53 Legal P&S 43870 002002'03 010700 000000 ; 54 Legal P&S 43871 002003'03 441100 000000 ; 55 Legal P&S ; 9 Bit Pointers 43872 002004'03 331100 000000 ; 56 Legal P&S 43873 002005'03 221100 000000 ; 57 Legal P&S 43874 002006'03 111100 000000 ; 58 Legal P&S 43875 002007'03 001100 000000 ; 59 Legal P&S 43876 002010'03 442200 000000 ; 60 Legal P&S ; 18 Bit Pointers 43877 002011'03 222200 000000 ; 61 Legal P&S 43878 002012'03 002200 000000 ; 62 Legal P&S 43879 000032 %OWMAX==.-OW2DW ; One Word Maximum byte pointer magic number 43880 .xcref %OWMAX ; Don't need this temporary in the cross reference 43881 suppress %OWMAX ; Don't need this temporary in the symbol listing 43882 43883 IFN <%OWMAX-<^D62-^D37+1>>,^_ 43884 <.fatal Illegal number of one word to double word pointer fields> 43885 43886 if2 < purge %OWMAX > ; Not needed after pass two 43887 retsec ; Restore .psect's 43888 43889 ;[216] End code insertion 43890 43891 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 76 K20SUB MAC 25-Nov-23 13:11 CRC Routines 43892 subttl CRC Routines 43893 43894 ;[66] CRC calculation 43895 ; 43896 ; This routine will calculate the CRC for a string, using the 43897 ; CRC-CCITT polynomial. 43898 ; 43899 ; The string should be the fields of the packet between but not including 43900 ; the and the block check, which is treated as a string of bits with 43901 ; the low order bit of the first character first and the high order bit of the 43902 ; last character last -- this is how the bits arrive on the transmission line. 43903 ; The bit string is divided by the polynomial 43904 ; 43905 ; x^16+x^12+x^5+1 43906 ; 43907 ; The initial value of the CRC is 0. The result is the remainder of this 43908 ; division, used as-is (i.e. not complemented). 43909 ; 43910 ; Contributed by Nick Bush, Stevens Institute of Technology. 43911 ; 43912 ; Call with 43913 ; t1/ length of string 43914 ; t2/ 8-bit byte pointer to string 43915 ; Returns +1 always, with t1/ 16-bit CRC, t2 unchanged. 43916 ; 43917 ; AC usage: 43918 ; t1/ Accumulated CRC 43919 ; q4/ Remaining length 43920 ; q3/ Byte pointer to string 43921 ; q2/ temp 43922 ; q1/ temp 43923 43924 003676'01 crcclc: entry crcclc ; Identify our location for LINK 43925 extern parity,none ; Inform of our necessary 43926 003676'01 265 16 0 00 004447' saveac ; Save q1-q4, and t2. 43927 003677'01 120 07 0 00 000001 dmove q3,t1 ; Get arguments. 43928 003700'01 400 01 0 00 000000 setz t1, ; Initial CRC is 0. 43929 003701'01 200 02 0 00 001473* move t2, parity ;[136] Get parity. 43930 43931 003702'01 do. ;[194] Enter loop context 43932 003702'01 134 05 0 00 000010 ildb q1, q4 ; Get a character. 43933 003703'01 302 02 0 00 001472* caie t2, none ;[136] Parity = NONE? 43934 003704'01 405 05 0 00 000177 andi q1, ^o177 ;[136] No, doing parity, strip parity bit. 43935 003705'01 431 05 0 01 000000 xori q1, (t1) ; Add in with current CRC. 43936 003706'01 135 06 0 00 004463' ldb q2, [point 4,q1,31] ;Get high 4 bits. 43937 003707'01 405 05 0 00 000017 andi q1, ^o17 ; AND low 4 bits. 43938 003710'01 200 05 0 05 000000# move q1, crctb2(q1) ; Get low portion of CRC factor. 43939 003711'01 430 05 0 06 000000# xor q1, crctab(q2) ; Plus high portion. 43940 003712'01 242 01 0 00 777770 lsh t1, -^d8 ; Shift off a byte from previous CRC. 43941 003713'01 430 01 0 00 000005 xor t1, q1 ; Add in new value. 43942 003714'01 367 07 0 00 003702' sojg q3, top. ; Loop for all characters. 43943 003715'01 enddo. ;[194] Fall out of loop context 43944 43945 003715'01 263 17 0 00 000000 ret ; Done, return +1 with CRC in t1. 43946 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 77 K20SUB MAC 25-Nov-23 13:11 Data tables for CRC-CCITT generation 43947 subttl Data tables for CRC-CCITT generation 43948 43949 chgsec(code,const) ;[208] Table goes in constants section 43950 43951 002013'03 000000 000000 crctab: oct 0 43952 002014'03 000000 010201 oct 10201 43953 002015'03 000000 020402 oct 20402 43954 002016'03 000000 030603 oct 30603 43955 002017'03 000000 041004 oct 41004 43956 002020'03 000000 051205 oct 51205 43957 002021'03 000000 061406 oct 61406 43958 002022'03 000000 071607 oct 71607 43959 002023'03 000000 102010 oct 102010 43960 002024'03 000000 112211 oct 112211 43961 002025'03 000000 122412 oct 122412 43962 002026'03 000000 132613 oct 132613 43963 002027'03 000000 143014 oct 143014 43964 002030'03 000000 153215 oct 153215 43965 002031'03 000000 163416 oct 163416 43966 002032'03 000000 173617 oct 173617 43967 43968 002033'03 000000 000000 crctb2: oct 0 43969 002034'03 000000 010611 oct 10611 43970 002035'03 000000 021422 oct 21422 43971 002036'03 000000 031233 oct 31233 43972 002037'03 000000 043044 oct 43044 43973 002040'03 000000 053655 oct 53655 43974 002041'03 000000 062466 oct 62466 43975 002042'03 000000 072277 oct 72277 43976 002043'03 000000 106110 oct 106110 43977 002044'03 000000 116701 oct 116701 43978 002045'03 000000 127532 oct 127532 43979 002046'03 000000 137323 oct 137323 43980 002047'03 000000 145154 oct 145154 43981 002050'03 000000 155745 oct 155745 43982 002051'03 000000 164576 oct 164576 43983 002052'03 000000 174367 oct 174367 43984 retsec ;[208] Re-open executable code 43985 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 78 K20SUB MAC 25-Nov-23 13:11 setgrd - set up guard pages for stacks, etc. 43986 subttl setgrd - set up guard pages for stacks, etc. 43987 43988 ; Lifted from Extended Mode FTP server I wrote, EFTPSA. 43989 ; 43990 ; A guard page is a no-access page, call it 'explode-on-use'. 43991 43992 .endps code ; End code psect 43993 .psect data ; Need some local storage 43994 43995 000075'05 000000 000000 myccoc: 0 ;[161] CCOC words for my tty. 43996 000076'05 000000 000000 0 ;[161] (two of them) 43997 000077'05 000000 000000 ttpau: 0 ;[161] Controlling TTY's pause chars. 43998 43999 000100'05 000000 000000 grdpg2: 0 ; Guard page in memory 44000 000101'05 000000 000000 grdadr: 0 ; Address of same 44001 000102'05 000000 000000 grdhan: 0 ; File handle of guard page 44002 000103'05 000000 000000 grdmap: 0 ; Process handle of guard page 44003 .endps data ; Done with writable storage 44004 44005 .psect datend/ronly,111000 ; Mark the end of the data .psect 44006 000000'06 datgrd: block ^d512 ; So we can drop in a guard page 44007 .endps datend ; Yet doesn't store anything 44008 44009 .psect const ; Table of addresses goes in constants 44010 002053'03 000000 006000 guardp: macgp1 ; Macro guard page 1 (before mapping window) 44011 002054'03 000000 010000 macgp2 ; Second guard page is after file mapping window 44012 002055'03 000000 020000 macgp3 ; Third guard page is after macro storage 44013 002056'03 000000 030000 macgp4 ; Fourth guard page is after garbage collection 44014 emacro < ; Only if I've finished the macro editor ... 44015 macgp5 ; Fifth guard page is after macro editing 44016 >;;emacro 44017 002057'03 000000000000# datgrd ; Put a guard page here, too 44018 002060'03 777777 777777 -1 ; Note list MUST end in -1!! 44019 .endps const ; End of constants 44020 .psect code ; Reopen code psect 44021 44022 003716'01 setgrd: entry setgrd ; Called at start up 44023 003716'01 265 16 0 00 004221' saveac ; Save some scratch registers 44024 003717'01 260 17 0 00 003740' call fepage ; Go find an illegal page 44025 003720'01 263 17 0 00 000000 ret ; But couldn't ... 44026 003721'01 124 01 0 00 000000# dmovem t1, grdpg2 ; Record as guard page double word 44027 003722'01 202 03 0 00 000000# movem t3, grdhan ; Save the file page handle, also 44028 003723'01 550 05 0 00 000001 hrrz q1, t1 ; Load the in-memory guard page 44029 003724'01 505 05 0 00 600000 hrli q1, .fhslf!fh%epn ; Convert to extended page handle in this fork 44030 003725'01 202 05 0 00 000000# movem q1, grdmap ; Save as a guard page mapping 44031 003726'01 415 06 0 00 000000# xmovei q2, guardp ; Load the address of guard page list 44032 44033 003727'01 do. ; Loop, setting up guard pages 44034 003727'01 335 02 0 06 000000 skipge t2, (q2) ; Pick up the guard page address 44035 003730'01 263 17 0 00 000000 ret ; Done, leave 44036 remark Case III: ; Mapping One Process's Pages to Another Process 44037 003731'01 242 02 0 00 777767 adr2pg t2, ; Convert address to page 44038 003732'01 505 02 0 00 600000 hrli t2, .fhslf!fh%epn ; page handle for this process 44039 003733'01 200 01 0 00 000005 move t1, q1 ; Load our base guard page handle 44040 003734'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 20:02 27-Nov-23 Page 78-1 K20SUB MAC 25-Nov-23 13:11 setgrd - set up guard pages for stacks, etc. 44041 003735'01 104 00 0 00 000056 PMAP% ; Finally map in a bogus page 44042 003736'01 320 12 0 00 003737' erjmpr .+1 ; Catch and ignore error 44043 003737'01 344 06 0 00 003727' aoja q2, top. ; Loop for another guard page 44044 003740'01 enddo. ; End of loop lexical context 44045 44046 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 79 K20SUB MAC 25-Nov-23 13:11 FEPAGE - Find an illegal page to map 44047 SUBTTL FEPAGE - Find an illegal page to map 44048 44049 ; Original code lifted from Tops-20 Extended Mode FTP server. 44050 ; 44051 ; Creates a page in the page map that is illegal to reference in *ANY* 44052 ; way, including reading. Does this by first finding a page in our 44053 ; address space that contains a page from our executable and then 44054 ; mapping in a page that file that is known not to exist and cannot be 44055 ; created. 44056 ; 44057 ; I call it an 'Explode-on-Use' page. 44058 ; 44059 44060 ; A guard page is created by mapping in a non-existant page that is 44061 ; past the end of our executable file. The executable file has the 44062 ; following properties: it is not extendable while mapped nor is it 44063 ; copy-on-write. Thus, a write to this file page will fail because 44064 ; the .EXE is locked. A read will fail because the page must be 44065 ; created in order to be read. Since it isn't writable to begin with, 44066 ; it can't be created. 44067 ; 44068 ; See R.E. Gorin, "Introduction to DECSYSTEM-20 Assembly Language 44069 ; Programming", page 443, footnote 3 for further details. Thanks to 44070 ; MRC for suggesting this approach. 44071 ; 44072 ; Returns: 44073 ; 44074 ; T1/ Page number of guard page 44075 ; T2/ 30 bit address of guard page 44076 ; T3/ File window handle of guard page (JFN,,Page number) 44077 ; 44078 ; Note: Maybe I ought to use XRMAP% below in case I have to shuttle 44079 ; through a lot of pages. In practice, however, I rarely have to 44080 ; process more than one page, so it didn't seem worth it and therefore 44081 ; I used a simple RMAP% instead. 44082 ; 44083 ; To do: MRC said that for certain size executable, this code won't 44084 ; work. Check for that size here and do something intelligent 44085 ; if so. Or gronk. 44086 44087 003740'01 265 16 0 00 004464' fepage: saveac ; Needs some registers 44088 003741'01 201 14 0 00 000031 movx p4, ^d25 ; Don't look through more than this many pages 44089 003742'01 415 13 0 00 003742' xmovei p3, . ; Load current executable address 44090 003743'01 242 13 0 00 777767 adr2pg p3, ; Convert address to page which we don't 44091 ; look at because DDT is probably there 44092 003744'01 fndpag: do. ; Now find a page with our JFN in it 44093 003744'01 363 14 0 00 003464* sojle p4, R ; Did this too many times? Return +1 44094 003745'01 350 01 0 00 000013 aos t1, p3 ; Increment and load page number 44095 003746'01 505 01 0 00 600000 hrli t1,.fhslf!fh%epn ; Looking at this fork 44096 003747'01 104 00 0 00 000057 RPACS% ; Find out the access 44097 003750'01 320 12 0 00 003744' erjmpr top. ; Couldn't, go to next page 44098 003751'01 607 02 0 00 010000 txnn t2, pa%pex ; Does the page exist? 44099 003752'01 254 00 0 00 003744' loop. ; No, go look for another one 44100 003753'01 603 02 0 00 000200 txne t2, pa%prv ; Is the page private? 44101 003754'01 254 00 0 00 003744' loop. ; Yes, we need one with a JFN in it k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 79-1 K20SUB MAC 25-Nov-23 13:11 FEPAGE - Find an illegal page to map 44102 003755'01 104 00 0 00 000061 rmap% ; Get a handle on the page 44103 003756'01 320 12 0 00 003744' erjmpr top. ; Gronked, go on to next page 44104 003757'01 607 02 0 00 010000 txnn t2, pa%pex ; Sanity Check: does the page still exist? 44105 003760'01 254 00 0 00 003744' loop. ; No, go look for another one 44106 003761'01 554 01 0 00 000001 hlrz t1, t1 ; Load just the process/file designator 44107 003762'01 306 01 0 00 400000 cain t1, .fhslf ; Quick check, this isn't our own process, is it? 44108 003763'01 254 00 0 00 003744' loop. ; Yah, it is, so worthless; bum the GTSTS% 44109 003764'01 104 00 0 00 000024 GTSTS% ; Otherwise, see if we can use this? 44110 003765'01 320 12 0 00 003744' erjmpr top. ; No JFN, so just go to the next page 44111 003766'01 607 02 0 00 000200 txnn t2, gs%nam ; Is anything in there a JFN? 44112 003767'01 254 00 0 00 003744' loop. ; No, not safe to use 44113 003770'01 607 02 0 00 400000 txnn t2, gs%opn ; Is the file open? 44114 003771'01 254 00 0 00 003744' loop. ; No, won't be able to PMAP% it 44115 003772'01 603 02 0 00 100000 txne t2, gs%wrf ; Better not be for write 44116 003773'01 254 00 0 00 003744' loop. ; It is, will self-create, then 44117 003774'01 607 02 0 00 020000 txnn t2, gs%rnd ; Open for non-append access? 44118 003775'01 254 00 0 00 003744' loop. ; No, will extend then 44119 remark ; If we get here, we fall out of the loop 44120 003776'01 enddo. ; End of loop context 44121 ; Otherwise, we have a safe page to use 44122 003776'01 553 13 0 00 000001 hrrzs p3, t1 ; Save a nice JFN 44123 003777'01 104 00 0 00 000036 SIZEF% ; Get the number of pages in the file 44124 004000'01 320 12 0 00 003744' erjmpr fndpag ; Can't, so keep looking 44125 004001'01 540 01 0 00 000013 hrr t1, p3 ; Load our executable JFN 44126 004002'01 504 01 0 00 000003 hrl t1, t3 ; Start REAL NEAR the end of the file 44127 004003'01 104 00 0 00 000031 FFFFP% ; Find the first unused (free) file page 44128 004004'01 320 12 0 00 003744' erjmpr fndpag ; Can't, so keep looking 44129 004005'01 316 01 0 00 004166' camn t1, [-1] ; None?? 44130 004006'01 254 00 0 00 003744' jrst fndpag ; No, continue the journey 44131 44132 remark ; Otherwise, have a guard page from the file!! 44133 004007'01 200 12 0 00 000001 move p2, t1 ; Save as source designator 44134 44135 remark Case I: ; Mapping File Pages to a Process 44136 004010'01 514 01 0 00 000013 hrlz t1, p3 ; JFN of executable file in the left half 44137 004011'01 540 01 0 00 000012 hrr t1, p2 ; Page number of executable file 44138 dmove t2,[.fhslf!fh%epn,,grdpag ; Fork and page handle 44139 004012'01 120 02 0 00 004476' pm%epn] ; going into any section 44140 004013'01 104 00 0 00 000056 PMAP% ; Finally map in a bogus page 44141 004014'01 320 12 0 00 003744' erjmpr fndpag ; Gronked, try the old way 44142 004015'01 550 04 0 00 000002 hrrz t4, t2 ; Load the page we mapped 44143 004016'01 242 04 0 00 000011 pg2adr t4, ; Convert to address 44144 004017'01 200 01 1 00 000004 move t1, @t4 ; The moment of truth, this should fail 44145 004020'01 320 12 0 00 004022' ifje. r ; Well, did it? 44146 004021'01 254 00 0 00 004030' 44147 remark ; All is well, return the data 44148 004022'01 514 03 0 00 000013 hrlz t3, p3 ; Load executable file JFN 44149 004023'01 540 03 0 00 000012 hrr t3, p2 ; Load the file page number of the guard page 44150 004024'01 550 01 0 00 000002 hrrz t1, t2 ; Load page number of guard page in memory 44151 004025'01 200 02 0 00 000004 move t2, t4 ; Load the address of the guard page in memory 44152 004026'01 254 00 0 00 003675* retskp ; And return success 44153 004027'01 254 00 0 00 004031' else. ; ?? 44154 004030'01 254 00 0 00 003744' jrst fndpag ; Try some more 44155 004031'01 endif. 44156 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 80 K20SUB MAC 25-Nov-23 13:11 fndvec Find and record the symbol table vector 44157 subttl fndvec Find and record the symbol table vector 44158 44159 ; The EXEC shouldn't need this for things like ^T, yet it does... 44160 ; 44161 ; We don't need to do a PDVOP% to find our program data vector 44162 ; address because we are giving it its own .PSECT and therefore 44163 ; are setting the address ourselves 44164 ; 44165 ; We can't have LINK do this because LINK won't write .JBSYM when 44166 ; doing PDV's. 44167 ; 44168 ; Adapted from SETNOD rewrite (SETND2) 44169 ; 44170 ; N.B., While the code will properly find a symbol table in any 44171 ; section, it won't work unless it is run in a non-zero section. 44172 ; Since Kermit is effectively a section zero program with some ASCII 44173 ; data being accessed via one word global pointers, the symbol table 44174 ; and the symbol table vector must also be in section zero. 44175 44176 remark [233] 11:47am Saturday, 31 December 2022 44177 44178 ; The above isn't true, of course, we could use two 18 one word global 44179 ; pointers to fetch and OR two half words or jump into a non-zero 44180 ; section to get the data (see fetch and efetch, below). The problem 44181 ; is that this would have involved some non-obvious modifications to 44182 ; the below and the symbol table lookup routine which I didn't see 44183 ; the value of doing as opposed to finishing the NRT functionality. 44184 ; 44185 ; At the time, I didn't realize that although LINK isn't going to do 44186 ; what we want, there is nothing stopping us from using MACRO itself 44187 ; to deposit values in fixed locations in the 'low segement' area. 44188 ; See the end of this module for a bunch of loc statements, not all of 44189 ; which may be absolutely necessary, strictly speaking. 44190 ; 44191 ; The point was to maintain reverse compatibility with any PA1050 44192 ; based programs or other archaic Tops-20 oddities that hadn't been 44193 ; been upgraded to PDV's (as in, just about all of them), one in 44194 ; particular being the EXEC. 44195 ; 44196 ; The EXEC was modified in edit [T255] to the EXECP.MAC module to 44197 ; handle a 'modern' symbol table vector, which could be in a non-zero 44198 ; section. 44199 44200 ; See commentary below for new version of EXEC [T255] which can handle 44201 ; a modern symbol table vector. This gets the parts of it we want for 44202 ; later. 44203 44204 ifndef .jbsym, <.jbsym==116> ; Low segment symbol table pointer (old style) 44205 ifndef .jbsa , <.jbsa==120> ; Program start address 44206 ifndef .jbff , <.jbff==121> ; Program first free location 44207 ifndef .jbren, <.jbren==124> ; Low segment reenter word 44208 ifndef .jbver, <.jbver==137> ; Low segment version word 44209 44210 004031'01 fndvec: entry fndvec ; Called on start up 44211 remark ; Expects full run of temporaries k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 80-1 K20SUB MAC 25-Nov-23 13:11 fndvec Find and record the symbol table vector 44212 004031'01 265 16 0 00 004221' saveac ; But follow the rules, anyway 44213 004032'01 402 00 0 00 000000# setzm glbsym ; Clear global symbol table flag 44214 004033'01 403 01 0 00 000002 setzb t1, t2 ; Cons up some more zeros 44215 004034'01 124 01 0 00 000000# dmovem t1, symvec ; Stomp symbol vector and defined symbol table 44216 44217 remark ; N.B., DEPENDs on 'low segment' hand crafting, below 44218 004035'01 336 05 0 00 000116 skipn q1,.jbsym ; Nothing there? 44219 004036'01 263 17 0 00 000000 ret ; Nope, that's easy! (but useless) 44220 44221 004037'01 254 05 0 00 004040' xjrstf .+1 ; Go 'upstairs' to grab the value 44222 004040'01 010000 000000 pc%usr ; Don't try to break out of user mode 44223 004041'01 000001 000000# extsec,,fndve1 ; 'long jump' to extended mode operation 44224 .endps code ; Finish execution of section zero code 44225 44226 .psect ecode ; Resuming execution in extended code section 44227 44228 remark Caution ; The stack is ONLY valid in section zero!! 44229 44230 000012'02 fndve1: remark ; N.B., All the indirect addressing is a little slower 44231 000012'02 476 00 1 00 000130' setom @[0,,glbsym] ; Let's assume it's global (which it should be) 44232 000013'02 627 05 0 00 400000 txzn q1, 1b0 ; Just check if it's local (which it shouldn't be) 44233 000014'02 254 00 0 00 000016' ifskp. ; That's strange, but we can fix that up 44234 000015'02 501 05 0 00 000015' xhlli q1,. ; Stomp in the section number 44235 remark @[0,,glbsym] ; So it's still global (heh...) 44236 000016'02 endif. ; 44237 000016'02 202 05 1 00 000131' movem q1, @[0,,symvec] ; Store as symbol table VECTOR 44238 44239 000017'02 336 06 1 00 000005 skipn q2, @q1 ; Pull the vector length (first location) 44240 000020'02 254 00 0 00 000050' jrst fndver ; If we have one... 44241 44242 remark ; Otherwise, there is SOMETHING in there 44243 000021'02 325 06 0 00 000026' ifl. q2 ; Old style symbol table? (shouldn't be up here..) 44244 000022'02 202 06 1 00 000132' movem q2, @[0,,kjbsym] ;That's easy; just use it 44245 000023'02 254 05 0 00 000024' xjrstf .+1 ; And go 'downstairs' to return to caller 44246 000024'02 010000 000000 pc%usr ; Don't try to break out of user mode 44247 000025'02 000000000000# rskp ; Give +2 return 44248 000026'02 endif. ; End case old symbol table pointer in a strange place 44249 44250 remark ; New style symbol table vector! Grovel through it 44251 000026'02 363 06 0 00 000050' sojle q2, fndver ; But!! If nothing is in there, it's all over 44252 000027'02 415 05 0 05 000001 xmovei q1, 1(q1) ; Load address of first subtable 44253 000030'02 do. ; Enter loop context 44254 000030'02 120 01 0 05 000000 dmove t1, .stdat(q1) ; Load ST%TYP and ST%LEN and .STPTR 44255 000031'02 135 03 0 00 000133' ldb t3,[pointr (t1,st%typ)] ; Load table type 44256 000032'02 135 04 0 00 000134' ldb t4,[pointr (t1,st%len)] ; Load table length 44257 000033'02 302 03 0 00 000001 caie t3, .r50d ; Is the type a defined symbol table?? 44258 000034'02 254 00 0 00 000045' ifskp. ; Yes! It is!! 44259 000035'02 323 04 0 00 000045' andg. t4 ; But!! Does it contain any symbols? 44260 000036'02 210 03 0 00 000004 movn t3, t4 ; Load negative of length 44261 000037'02 514 01 0 00 000003 hrlz t1, t3 ; Assumes table is not greater than a section 44262 000040'02 540 01 0 00 000002 hrr t1, t2 ; Now have base of subtable 44263 000041'02 202 01 1 00 000135' movem t1,@[0,,kjbsym] ;Save for symbol table routine 44264 000042'02 254 05 0 00 000043' xjrstf .+1 ; And go 'downstairs' to return to caller 44265 000043'02 010000 000000 pc%usr ; Don't try to break out of user mode 44266 000044'02 000000000000# rskp ; Give +2 return k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 80-2 K20SUB MAC 25-Nov-23 13:11 fndvec Find and record the symbol table vector 44267 000045'02 endif. ; End case defined symbol table 44268 000045'02 415 05 0 05 000003 xmovei q1, .stsiz(q1) ; Load address of next subtable 44269 000046'02 275 06 0 00 000003 subi q2, .stsiz ; Account for words used in symbol block 44270 000047'02 327 06 0 00 000030' jumpg q2, top. ; Look some more, if anything left 44271 000050'02 enddo. ; End of loop context 44272 44273 remark ; If fell through, then never found symbol table 44274 ; Which is an error 44275 44276 000050'02 fndver: remark ; Here on any kind of error 44277 000050'02 402 00 1 00 000136' setzm @[0,,.jbsym] ; .jbsym is gubbish, so stop paying attention 44278 000051'02 402 00 1 00 000137' setzm @[0,,symvec] ; Stomp the symbol table vector too, it's bogus 44279 000052'02 254 05 0 00 000053' xjrstf .+1 ; And go 'downstairs' to return to caller 44280 000053'02 010000 000000 pc%usr ; Don't try to break out of user mode 44281 000054'02 000000000000# r ; Give +1 return 44282 44283 .endps ecode ; Get out of extended code 44284 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 81 K20SUB MAC 25-Nov-23 13:11 Magical symbol table lookup routine 44285 SUBTTL Magical symbol table lookup routine 44286 44287 ; For details, read "Introduction to DECSYSTEM-20 Assembly Language 44288 ; Programming", by Ralph Gorin, published by Digital Press, 1981. 44289 ; 44290 ; Called with desired symbol in T1 44291 44292 .psect code ; Starts out in section zero 44293 44294 004042'01 symout: entry symout ; Declare to the world 44295 004042'01 265 16 0 00 004500' saveac 44296 44297 004043'01 200 06 0 00 000001 move q2, t1 ; Save the desired symbol 44298 004044'01 403 03 0 00 000005 setzb t3 ,q1 ; no current program name or best symbol 44299 004045'01 200 04 0 00 000000# move t4, kjbsym ; Load (fixed to old style symbol table pointer 44300 004046'01 254 05 0 00 004047' xjrstf .+1 ; Go 'upstairs' to symbolically print the value 44301 004047'01 010000 000000 pc%usr ; Don't try to break out of user mode 44302 004050'01 000001 000000# extsec,,symou1 ; 'long jump' to extended mode operation 44303 .endps code ; Finish execution of section zero code 44304 44305 .psect ecode ; Resuming execution in extended code section 44306 44307 remark Caution ; The stack is ONLY valid in section zero!! 44308 44309 000055'02 322 04 0 00 000120' symou1: jumpe t4, plsoff ; Unless we don't have a symbol table 44310 000056'02 574 01 0 00 000004 hlre t1, t4 ; Convert halfword length to fullword 44311 000057'02 274 04 0 00 000001 sub t4, t1 ; -count,,ending address +1 44312 ; And hit search loop 44313 000060'02 do. ; Load this symbol's type 44314 000060'02 135 01 0 00 000140' ldb t1,[point 4,-2(t4),3] 44315 000061'02 322 01 0 00 000076' ifn. t1 ; program names are not relevant 44316 000062'02 303 01 0 00 000002 caile t1, ^o2 ; 0=prog name, 1=global, 2=local 44317 000063'02 254 00 0 00 000076' anskp. ; So skip this symbol 44318 000064'02 200 01 0 04 777777 move t1, -1(t4) ; Load value associated with the symbol 44319 000065'02 312 01 0 00 000006 came t1, q2 ; Is this an exact match, per chance? 44320 000066'02 254 00 0 00 000071' ifskp. ; It is, so no need for an offset 44321 000067'02 200 05 0 00 000004 move q1, t4 ; Just select it 44322 000070'02 254 00 0 00 000100' exit. ; And get out of the loop 44323 000071'02 endif. 44324 000071'02 311 01 0 00 000006 caml t1, q2 ; Is the value before the value sought? 44325 000072'02 254 00 0 00 000076' anskp. ; No, so can't use (would be a negative offset) 44326 000073'02 332 02 0 00 000005 skipe t2, q1 ; Otherwise get the best one so far (if there is one) 44327 000074'02 311 01 0 02 777777 caml t1, -1(t2) ; compare to previous best 44328 000075'02 200 05 0 00 000004 move q1, t4 ; current symbol is best match so far 44329 000076'02 endif. ; End case symbol selection 44330 000076'02 270 04 0 00 000141' add t4, [2000000-2] ; Add 2 in the left, sub 2 in the right 44331 000077'02 321 04 0 00 000060' jumpl t4,top. ; Loop unless control count is exhausted 44332 000100'02 enddo. 44333 44334 000100'02 322 05 0 00 000120' ifn. q1 ; Did we have anything that could help? 44335 000101'02 200 02 0 00 000006 move t2, q2 ; Yes, get desired value 44336 000102'02 274 02 0 05 777777 sub t2, -1(q1) ; Less symbol's value = offset 44337 000103'02 301 02 0 00 000200 cail t2, 200 ; Is the offset small enough to be conceptually useful? 44338 000104'02 254 00 0 00 000120' anskp. ; No, we can't count that high in our head 44339 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 20:02 27-Nov-23 Page 81-1 K20SUB MAC 25-Nov-23 13:11 Magical symbol table lookup routine 44340 000106'02 621 01 0 00 740000 txz t1, ; Clear the symbols' flags 44341 000107'02 do. ; Build us a return address 44342 000107'02 254 14 0 00 000007 xsfm q3 ; Save processor flags 44343 000110'02 415 10 0 00 000114' xmovei q4,endlp. ; Load end of this pseudo-loop (return address) 44344 000111'02 254 05 0 00 000112' xjrstf .+1 ; Go 'downstairs' to use the stack 44345 000112'02 010000 000000 pc%usr ; Don't try to break out of user mode 44346 000113'02 000000 000000# 0,,sqztyo ; 'long jump' to section zero to print symbol name 44347 000114'02 enddo. ; End of this strange call linkage 44348 000114'02 274 06 0 05 777777 sub q2, -1(q1) ; Value we wanted less this symbol's value 44349 000115'02 322 06 0 00 000125' jumpe q2, plsof1 ; If no offset, don't print "+0" 44350 000116'02 201 01 0 00 000053 movei t1, "+" ; Append a plus sign to the output line 44351 000117'02 104 00 0 00 000074 pbout% 44352 000120'02 endif. 44353 44354 000120'02 201 01 0 00 000101 plsoff: movei t1, .priou ; and copy numeric offset to output 44355 000121'02 200 02 0 00 000006 move t2, Q2 ; Load offset from symbol 44356 000122'02 201 03 0 00 000010 movei t3, ^d8 ; Addresses are in octal... 44357 000123'02 104 00 0 00 000224 NOUT% 44358 000124'02 320 12 0 00 000125' erjmpr plsof1 ; Catch and ignore error 44359 000125'02 254 05 0 00 000126' plsof1: xjrstf .+1 ; And go 'downstairs' to return to caller 44360 000126'02 010000 000000 pc%usr ; Don't try to break out of user mode 44361 000127'02 000000000000# r ; Give +1 return 44362 44363 .endps ecode ; Done with non-zero section execution 44364 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 82 K20SUB MAC 25-Nov-23 13:11 recursively convert a 32-bit quantity in T1 from squoze to ASCII 44365 subttl recursively convert a 32-bit quantity in T1 from squoze to ASCII 44366 44367 .psect code ; Needs to be in section zero to use the stack 44368 44369 remark Caution ; Called with inter-section hand crafted JSP-type linkage 44370 44371 ; Call: 44372 ; 44373 ; t1/ SQUOZE word 44374 ; q3/ Processor flags to restore 44375 ; q4/ 30 bit return address 44376 44377 004051'01 261 17 0 00 004064' sqztyo: push p,sqztyr ; Push inter-section return address 44378 004052'01 265 16 0 00 004516' saveac ; Save t2, just in case 44379 44380 004053'01 231 01 0 00 000050 sqzty1: idivi t1, 50 ; divide by 50 to extract a Radix-50 'digit' 44381 004054'01 261 17 0 00 000002 push p, t2 ; save remainder, a Radix-50 character 44382 004055'01 332 00 0 00 000001 skipe t1 ; if T1 is now zero, unwind the stack 44383 004056'01 260 17 0 00 004053' call sqzty1 ; call self again, reducing t1 by an another 'digit' 44384 44385 remark ; If we fall through, then it's type to unwind 44386 004057'01 262 17 0 00 000001 pop p, t1 ; Get characters back in reverse order 44387 004060'01 133 01 0 00 004066' adjbp t1, rdx50c ; Index to the correct character 44388 004061'01 135 01 0 00 000001 ldb t1, t1 ; convert squoze code to ASCII 44389 004062'01 104 00 0 00 000074 pbout% ; Type it 44390 004063'01 263 17 0 00 000000 ret ; Continue unwinding, finally 'returning' below 44391 44392 004064'01 254 00 0 00 004065' sqztyr: jrst .+1 ; This pushed jrst goes to the xjrstf 44393 004065'01 254 05 0 00 000007 xjrstf q3 ; Transfer back to non-section zero caller 44394 44395 004066'01 35 07 0 00 004067' rdx50c: point 7,.+1,6 ; Points to the first character in the string (the space) 44396 004067'01 040 060 061 062 063 ascii " 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ.$%" 44397 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 83 K20SUB MAC 25-Nov-23 13:11 fetch a word from extended address space 44398 subttl fetch a word from extended address space 44399 44400 ;[223] Begin code insertion 44401 44402 ; Call: 44403 ; 44404 ; t1/ Extended address to fetch 44405 ; 44406 ; Return: 44407 ; 44408 ; t1/ Updated in all cases 44409 ; 44410 ; +1/ Possible error code 44411 ; +2/ Value at specified location 44412 44413 repeat 0,< ; Actually turned out to be unnecessary ... 44414 fetch: saveac ; Save a scratch register 44415 xjrstf .+1 ; Go 'upstairs' to grab the value 44416 pc%usr ; Don't try to break out of user mode 44417 extsec,,efetch ; 'long jump' to extended mode operation 44418 44419 .endps code ; Get out of section zero 44420 .psect ecode ; and into non-zero section 44421 44422 efetch: move t2, @t1 ; Grab whatever we've been pointed at 44423 erjmpr fetche ; Unless it was gubbish 44424 44425 move t1, t2 ; Return value in t1 44426 xjrstf .+1 ; Go 'downstairs' to return to caller 44427 pc%usr ; Don't try to break out of user mode 44428 rskp ; Give +2 return 44429 44430 fetche: remark ; Here on addressing error from move 44431 xjrstf .+1 ; Go 'downstairs' to return to caller 44432 pc%usr ; Don't try to break out of user mode 44433 r ; Give +1 return 44434 44435 .endps ecode ; Get out of extended code 44436 .psect code ; And back into section zero code 44437 >;repeat 0 ; End removal 44438 44439 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 84 K20SUB MAC 25-Nov-23 13:11 Kermit Entry Vector and Version 44440 subttl Kermit Entry Vector and Version 44441 44442 ;[197] Moved here to support symbol table fix up, yet some still in k20mit 44443 44444 ; Used to help LINK build version word 44445 44446 extern $verno ; Major version number. 44447 extern $mnver ; Minor version number (minimum: 1). 44448 extern $edno ; Edit number increases independent of version. 44449 extern $who ; Who edited, 0=Columbia. 44450 44451 ; Used to help LINK to build entry vector 44452 44453 extern start ; Regular entry 44454 extern reen ; 'Re-enter' address 44455 44456 ; 'Modern' Tops-20 entry vector 44457 44458 004077'01 254 00 0 00 000000* kermit: jrst start ; Start entry. 44459 004100'01 254 00 0 00 000000* jrst reen ; Re-entry. 44460 k20ver==:FLD($who,VI%WHO)!FLD($verno,VI%MAJ)!FLD($mnver,VI%MIN)!^_ 44461 000000000000# FLD($edno,VI%EDN)!VI%DEC ;;[184] Want decimal version numbers 44462 004101'01 000000000000# k20ver ;[190] 44463 000003 evlen==.-kermit ; Mark for k20mit end statement 44464 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 85 K20SUB MAC 25-Nov-23 13:11 Closing Code particulars 44465 subttl Closing Code particulars 44466 44467 xlist ; Save the trees!! 44468 list ; Resume listing 44469 44470 .endps code ; Close the code .psect 44471 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 86 K20SUB MAC 25-Nov-23 13:11 Data storage, not in global scope 44472 subttl Data storage, not in global scope 44473 44474 .psect data ; Writable 44475 repeat 0,< ;[218] 44476 tmcbit: 0 ;[194] Time channel bit 44477 > ;[218] 44478 000104'05 000000 000000 ccichr: 0 ;[219] Control-C Interrupt Character (we used) 44479 44480 000105'05 000000 000000 aicx: 0 ;[194] Count of AIC% failures 44481 000106'05 000000 601405 laicer: lstrx1 ;[194] Last AIC% error (no error) 44482 000107'05 000000 601405 ltimcr: lstrx1 ;[194] Last TIMER% creation (.timel) error 44483 000110'05 000000 000000 dicx: 0 ;[194] Count of DIC% errors 44484 000111'05 000000 601405 ldicer: lstrx1 ;[194] Last DIC% error (no error) 44485 000112'05 000000 601405 ltimde: lstrx1 ;[194] Last .TIMBF (delete) error 44486 44487 000113'05 000000 000000 glbsym: 0 ;[197] If global (should never be) 44488 000114'05 000000 000000 symvec: 0 ;[197] Address of symbol table vector 44489 000115'05 000000 000000 kjbsym: 0 ;[197] Kermit's defined symbol table 44490 44491 000116'05 000000 000000 ddtf:: 0 ;[197] Debugger present flag 44492 000117'05 lcltte: block 10 ; Last errors encounter by LCLTTY 44493 000127'05 lcltef: remark ; Final location to whack 44494 000127'05 lcldev: block 1 ; Device we're going to try 44495 000130'05 lclnam: block 4 ; Space for constructed terminal 44496 000134'05 lcljfn: block 1 ; JFN we got 44497 000135'05 lclflg: block 1 ; Associated flags (which we don't use) 44498 000136'05 lclpar::block 1 ;[223] Local terminal parity 'toleration' 44499 44500 000137'05 000000 000000 ccn: 0 ;[187] Number of ^C's typed. 44501 000140'05 000000 000000 psave: 0 ; Stack pointer for ^C interrupt. 44502 000141'05 000000 000000 psave2: 0 ; Stack top for ^C interrupt. 44503 000142'05 000000 000000 tsave: 0 ;[132] Same as above, but for timer interrupts. 44504 000143'05 000000 000000 tsave2: 0 ;[132] ... 44505 000144'05 000000 000000 pc1: 0 ;[196] Interrupt PC storage, levels 1, 44506 000145'05 000000 000000 pc2: 0 ; 2, 44507 000146'05 000000 000000 pc3:: 0 ; and 3. 44508 44509 000147'05 605457 664562 'plover' ; Talsiman to see if stomped 44510 .endps data 44511 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 87 K20SUB MAC 25-Nov-23 13:11 Misc. utility .PSECT's 44512 subttl Misc. utility .PSECT's 44513 44514 remark File Mapping Page 44515 .psect filepg,maporg ; File mapping window 44516 000000'07 block maplen ; Reserves a page 44517 .endps ; Allows LINK time checking 44518 44519 remark Guard pages for files and macros 44520 44521 .psect guard/ronly,grdorg ; Declare detonate-on-use page 44522 .endps ; Nothing in it until runtime 44523 44524 .psect guard1/ronly,macgp1 44525 000000'11 007071 727271 'xyzzy' ; Force a magic page... 44526 000001'11 block ^d511 ; Keep LINK up to date on size 44527 .endps guard1 44528 44529 .psect guard2/ronly,macgp2 44530 000000'12 006054 654750 'plugh' ; Force another magic page... 44531 000001'12 block ^d511 ; Keep LINK up to date on size 44532 .endps guard2 44533 44534 .psect guard3/ronly,macgp3 44535 000000'13 605457 664562 'plover' ; Force another magic page... 44536 000001'13 block ^d511 ; Keep LINK up to date on size 44537 .endps guard3 44538 44539 .psect guard4/ronly,macgp4 44540 000000'14 005465 555763 'lumos' ; Force another magic page... 44541 000001'14 block ^d511 ; Keep LINK up to date on size 44542 .endps guard4 44543 44544 emacro < 44545 .psect guard5/ronly,macgp5 44546 'nox' ; Force another magic page... 44547 block ^d511 ; Keep LINK up to date on size 44548 .endps guard5 44549 >;;emacro 44550 44551 remark Symbol table .PSECT 44552 .text "/symseg:psect:symbol" ; Tell LINK where to put the goodies 44553 .psect symbol/ronly,symorg ; Write-Protected symbols 44554 .endps symbol ; Close out the PSECT 44555 44556 remark Seperate patch area .PSECT, otherwise it will be read-only 44557 .text "/patchsize:0" ; Tell LINK not to allocate a patch area 44558 .psect patch,patorg ; Patch area 44559 000000'16 PAT..:: block patlen ; Override LINK 44560 .endps patch ; Close out the PSECT 44561 44562 remark Reserve pages for in-section DDT so code doesn't bump into it 44563 .psect ddt/ronly,700000 ; If DDT is in section 0 44564 000000'17 block 777777-700000+1 ; Reserve last 64 pages 44565 .endps ddt 44566 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 88 K20SUB MAC 25-Nov-23 13:11 PDV setup and location 44567 subttl PDV setup and location 44568 44569 ; This is the Program Data Vector .PSECT. We don't write anything 44570 ; directly in there; we pass switchs to have LINK fill it in for us 44571 44572 .text "/pvblock:psect:pdv" ; Put program PDV's in the PDV .PSECT 44573 .psect pdv/ronly,pdvorg ; Write-Protected PDV! 44574 .endps pdv ; Close out the PSECT 44575 44576 ; Macro to resolve symbols into values for stupid LINK. 44577 ; Note, this must be last or the macro will produce X errors 44578 ; because the symbols haven't been seen yet. Maybe see 44579 ; what IF2 would do if we want to move this around. 44580 44581 define defpdv (name,data) < 44582 .text "/pvdata:'name':#'data" 44583 >;define defpdv 44584 44585 ; Note, although the monitor knows about the reenter address 44586 ; (the PDV offset is .PVREE), LINK doesn't. Sigh... 44587 44588 .text '/pvdata:name:"K20MIT"' ;;Different from save name 44589 defpdv start,\kermit ; Kermit start address 44590 ; defpdv reentr,\reen ; Kermit reenter address (obsolete) 44591 ; remark ; Have to set this in LINK 44592 ; defpdv version,\k20ver ; Kermit version word 44593 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page 89 K20SUB MAC 25-Nov-23 13:11 'Low segment' fix ups 44594 SUBTTL 'Low segment' fix ups 44595 44596 ;[227] Begin code insertion 44597 44598 ;[T255] Build page zero by hand since EXEC can now handle a symbol 44599 ; table in a non-zero section, but LINK doesn't quite set everything 44600 ; up correctly. 44601 ; 44602 ; A multi-section program can get complicated enough so that LINK 44603 ; can't fill in values in the 'low segment' with the 'appropriate' 44604 ; values. The problem is certain programs which don't use PDV's to 44605 ; find this stuff out, the first being an enhanced GLXLIB and the 44606 ; other being the EXEC, which may not be able to tell which PDV to 44607 ; use. 44608 ; 44609 ; Therefore, we issue the /NOINITIAL /NOJOBDAT switches *first* to 44610 ; keep LINK from getting it wrong and poke the values in ourselves, 44611 ; here. See JOBDAT for additional information. 44612 44613 033000 kjbffl== ; Kermit's first free location is after the patch area 44614 44615 ; N.B., This LOC/RELOC Hackery *MUST* take place in the outer-most .PSECT!!!! 44616 44617 000116 loc .jbsym ; Get to symbol table pointer 44618 000116 000001 400000 symorg ; The EXEC can now handle a symbol table vector!! 44619 000120 loc .jbsa ; Get to job start address 44620 000120 033000 000000# xwd kjbffl,kermit ; Note, odd left half 44621 000121 loc .jbff ; Get to first free location 44622 000121 000000 033000 kjbffl ; End defined writable storage 44623 000124 loc .jbren ; The Reenter address 44624 000124 000000000000# reen ; This is all in Kermit's entry vector, actually... 44625 000137 loc .jbver ; Get to the version word 44626 000137 000000000000# k20ver ; Drop Kermit's version in 44627 44628 000000'00 reloc ; Get back ... someplace ... 44629 44630 ;[227] End code insertion 44631 44632 000003 004077' end evlen,,kermit ;[197] Had to get moved here, sigh... NO ERRORS DETECTED PROGRAM BREAK IS 000000 PSECT 1 BREAK IS 004527 FOR CODE PSECT 2 BREAK IS 000142 FOR ECODE PSECT 3 BREAK IS 002061 FOR CONST PSECT 4 BREAK IS 000473 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 20:02 27-Nov-23 Page 89-1 K20SUB MAC 25-Nov-23 13:11 '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.269 125P CORE USED k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page S-1 K20SUB MAC 25-Nov-23 13:11 SYMBOL TABLE AIC 104000 000131 int GJ%SHT 000001 000000 sin OT%NDA 400000 000000 sin SBK 000000 ext AIC% 104000 000131 int GPJFN% 104000 000206 int P 000017 SC%CTC 400000 000000 sin ATI 104000 000137 int GRDORG 033000 spd P1 000011 spd SC%DNA 001000 sin ATI% 104000 000137 int GRDPAG 000033 spd P2 000012 spd SC%GTB 200000 000000 sin ATMBUF 000000 ext GS%ERR 000400 000000 sin P3 000013 spd SC%OPR 200000 sin BADMSK 113777 176377 spd GS%NAM 000200 000000 sin P4 000014 spd SC%WHL 400000 sin BOUT 104000 000051 int GS%OPN 400000 000000 sin P5 000015 spd SCHR 000013 spd BOUT% 104000 000051 int GS%RND 020000 000000 sin PA%PEX 010000 000000 sin SCRLFT 000000 ext CALL 260740 000000 GS%WRF 100000 000000 sin PA%PRV 000200 000000 sin SFCOC 104000 000113 int CALLRE 254000 000000 spd GTJFN% 104000 000020 int PANDAS 000001 sin SFCOC% 104000 000113 int CF%NUD 400000 000000 sin GTSTS% 104000 000024 int PARS1 000000 ext SFMOD 104000 000110 int CHFDB% 104000 000064 int GUARD 000000 ext PARS2 000000 ext SFMOD% 104000 000110 int CJFNBK 000000 ext GUARD1 000000 ext PARS3 000000 ext SFPTR% 104000 000027 int CLOSF% 104000 000022 int GUARD2 000000 ext PARS4 000000 ext SIR% 104000 000125 int CLSX1 600160 int GUARD3 000000 ext PARS5 000000 ext SIZEF% 104000 000036 int CO%NRJ 400000 000000 sin GUARD4 000000 ext PATCH 000000 ext SOUT% 104000 000053 int CODE 000000 ext HALTF% 104000 000170 int PATLEN 002000 spd SPACK 000000 ext CONST 000000 ext IAC 000377 spd PATORG 031000 spd SPSIZ 000000 ext CRLF 000000 ext JFNS% 104000 000030 int PBOUT 104000 000074 int ST%LEN 007777 777777 spd CX 000016 JOBTAB 000000 ext PBOUT% 104000 000074 int ST%TYP 770000 000000 spd CZ%ABT 004000 000000 sin JS%PAF 000001 sin PC%USR 010000 000000 sin STIW 104000 000174 int CZSEEN 000000 ext KJBFFL 033000 spd PDV 000000 ext STIW% 104000 000174 int DATA 000000 ext KLFLGS 777700 000000 spd PDVORG 576000 spd STPAR 104000 000217 int DATEND 000000 ext LSTRX1 601405 int PGSHFT 000011 sin STPAR% 104000 000217 int DDT 000000 ext M 100000 000000 spd PKTNUM 000000 ext STRBUF 000000 ext DEBRK 104000 000136 int 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 DESX1 600150 int MACGP3 020000 spd PM%WR 040000 000000 sin SYMORG 000001 400000 spd DESX3 600152 int MACGP4 030000 spd PMAP% 104000 000056 int T1 000001 spd DEVST% 104000 000121 int MAPLEN 001000 spd PSOUT 104000 000076 int T2 000002 spd DIC 104000 000133 int MAPORG 007000 spd PSOUT% 104000 000076 int T3 000003 spd DIC% 104000 000133 int MAPPAG 000007 spd Q1 000005 spd T4 000004 spd DTI 104000 000140 int MAXBUF 024000 spd Q2 000006 spd T5 000005 spd DTI% 104000 000140 int MAXPKT 000140 spd Q3 000007 spd TIMER 104000 000522 int DV%TYP 000777 000000 sin MO%CDN 777000 000000 sin Q4 000010 spd TIMER% 104000 000522 int DVCHR% 104000 000117 int MO%DAV 777000 sin Q5 000011 spd TLGJFN 000000 ext ECDORG 000001 576000 spd MO%INA 000777 000000 sin R 000000 ext TRMCOD 500000 spd ECODE 000000 ext MO%PAR 000010 sin RCHR 000012 spd TS%CTC 001000 000000 spd EIR% 104000 000126 int MOVSLJ 016000 000000 REEN 000000 ext TS%CTM 200000 000000 spd EOSCOD 100000 spd MOVST 015000 000000 RET 263740 000000 TS%DEV 010000 000000 spd EPCAP% 104000 000151 int MTOPR% 104000 000077 int RF%LNG 400000 000000 sin TS%EFH 002000 000000 spd ERJMPR 320500 000000 int N 200000 000000 spd RFCOC 104000 000112 int TS%ERR 400000 000000 spd ERJMPS 320600 000000 int NDXJFN 000000 ext RFCOC% 104000 000112 int TS%FRK 040000 000000 spd ERRPTR 000000 ext NOP 600000 000000 sin RFMOD% 104000 000107 int TS%JFN 020000 000000 spd ERSTR% 104000 000011 int NOUT 104000 000224 int RFSTS% 104000 000156 int TS%LGL 000200 000000 spd ESOUT% 104000 000313 int NOUT% 104000 000224 int RLJFN 104000 000023 int TS%LGW 000400 000000 spd ETEXT 000000 ext NUL4 000000 ext RLJFN% 104000 000023 int TS%PRO 100000 000000 spd EXTSEC 000001 spd NXTJFN 000000 ext RMAP% 104000 000061 int TT%DAM 000300 sin FB%BSZ 007700 000000 sin ODTIM% 104000 000220 int RPACS% 104000 000057 int TT%DUM 000014 sin FFFFP% 104000 000031 int OF%BSZ 770000 000000 sin RPCAP% 104000 000150 int TT%ECO 004000 sin FH%EPN 200000 sin OF%MOD 007400 000000 sin RSKP 000000 ext TT%LCA 040000 000000 sin FILEPG 000000 ext OF%RD 200000 sin RT%DIM 400000 000000 sin TT%LEN 037600 000000 sin FILJFN 000000 ext OF%WR 100000 sin RTIW 104000 000173 int TT%LIC 000020 sin GD%PAR 000001 sin OPENF% 104000 000021 int RTIW% 104000 000173 int TT%MFF 200000 000000 sin GJ%FLG 000020 000000 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 20:02 27-Nov-23 Page S-2 K20SUB MAC 25-Nov-23 13:11 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 20:02 27-Nov-23 Page S-3 K20SUB MAC 25-Nov-23 13:11 SYMBOL TABLE FOR PSECT CODE ABTFIL 001701' ext CZSEEN 003207' ext KRXPTR 000032' SBK 000000 ext ADJTIM 002262' ext CZTRAP 003207' KSERR0 000157' SCHCRT 003413' ALLTIM 002240' D2SGPC 003657' KSMSG0 000161' SCHLFD 003450' ARGTYP 000570' DELAY 001675' ext LCLERR 001451' SCRLFT 000245' ext ASCZCP 003472' ent DELAYF 001673' ext LCLTTY 001332' SETCSB 000524' ent BCTU 003043' ext DIRCH 003177' ext LDAV 002260' ext SETGRD 003716' ent BIGBOY 000545' ext DNCFLD 032776 776000 sin LEVTAB 002171' SETTY 001272' ent BLANKL 000030 spd DNCHAN 000032 LFDEXP 003443' SOURCE 003176' ext BLANKS 000000' DNCHB 001000 sin LFDPTR 003444' SPACK 000141' ext BOUTI% 000357' ent DNDFLD 776776 776000 sin LOCAL 002622' ext SPSIZ 000104' ext BYTSIZ 002776' ext DNTRAP 002226' ext MODOFF 001523' SPTOT 003115' ext C87MOV 003266' EBQFLG 003025' ext MODON 001524' SQZTY1 004053' CACHAN 000002 EBTFLG 003011' ext MOVASC 003470' int SQZTYO 004051' CAPAS 002521' ext ERRPTR 001504' ext MOVCRT 003411' SQZTYR 004064' CASEEN 002621' ext EVEN 001465' ext MOVLFD 003446' SRVFLG 002477' ext CATRAP 002741' EVLEN 000003 spd MOVSTU 003514' ent START 004077' ext CATRP1 003077' FEPAGE 003740' MOVSUC 003555' ent STCHR 003134' ext CAXZOF 002617' ent FILES 003103' ext MTOPRL 000006 spd STIMOU 002337' ext CAXZON 002550' ent FILJFN 003051' ext MTOPRT 001160' SUBBP 000077' ext CCCHAN 000001 FIXTTY 001477' ent MTOPSL 000006 spd SVSTT 001533' ext CCFAIL 002443' ext FLOW 001551' ext MTOPST 001167' SYMOUT 004042' ent CCOFF 002477' ent FNDPAG 003744' MXASCZ 024000 sin TBTFLG 001761' ext CCOFF2 002501' ent FNDVEC 004031' ent MYCAPS 002437' ext TIMCHB 400000 000000 sin CCOFF3 002521' FRCLO1 001655' MYTTY 001371' ext TIMDEL 002341' ent CCON 002405' ent FRCLOS 001615' ent NNAK 003150' ext TIMEIT 002242' ent CCON2 002450' FRCLOT 001673' NONE 003703' ext TIMEON 002303' ent CCTRAP 002724' FRKCHB 004000 sin NOTNUL 000522' TIMERX 002355' ext CHNGCH 003333' FRKCHN 000030 int NTIMOU 003160' ext TIMOFF 002337' ent CHNTAB 002174' FRTRAP 002224' ext NUL4 000233' ext TIWORD 001601' ext CMCHAN 000005 GDSWRP 001454' PAGCNT 003073' ext TLGJFN 002026' ext CMLOC 003226' ext GETLCL 001370' PAGNO 003060' ext TMCHAN 000000 CMPOFF 002647' ent GIVEUP 001701' ent PARITY 003701' ext TMTRAP 002357' ent CMPON 002566' ent GNDPAR 001456' ext PARPKO 001474' ext TRNCHR 000454 spd CMPTR2 003237' GP%1AD 007777 777777 spd PARRCK 001475' ext TTYINI 001525' ent CMSEEN 003220' ext GP%1PF 770000 000000 spd PINIT 002367' ent TTYJFN 001525' ext CMTRAP 003220' GP%2AD 377777 777777 spd PKTNUM 000136' ext TTYOB 000653' ent CNCHAR 003335' GP%2PB 770000 000000 spd R 003744' ext TTYOU 000700' ent CPCHAN 000027 GP%2PF 777700 000000 spd RCVING 003132' ext UDJINF 001272' ext CPLOC 003236' ext GP%2RS 000037 777777 spd RDCLOS 001750' ent UNMAPA 002112' CPSEEN 003230' ext GP%2SB 007700 000000 spd RDCLSA 001775' UNMAPO 002062' ent CPTRAP 003230' GP%2WB 000040 000000 spd RDCLSC 002025' YESNUL 000517' CRCCLC 003676' ent HALT 001532' ext RDCLSD 002046' $CCN 000002 spd CRLF 003372' ext HANDSH 001550' ext RDCLSV 001755' $CLRBS 003251' ext CRTEXP 003403' IACIAC 003617' ent RDCLSZ 002060' $EDNO 000000 ext CRTPTL 003407' INICAP 000534' ent RDX50C 004066' $MNVER 000000 ext CRTPTR 003405' INTPC 002360' ext REEN 004100' ext $MODOF 037777 174374 spd CURTIM 002263' ext INTSTK 002364' ext RESTTY 001176' ent $MODON 340000 000002 spd CXCHAN 000003 ISNULJ 000376' ent RPTFLG 003032' ext $PRIOU 001321' ext CXSEEN 003173' ext ITSFIL 003020' ext RPTOT 003123' ext $VERNO 000000 ext CXTRAP 003173' JOBTAB 000000 ext RSKP 004026' ext $WAITJ 003253' ext CYCHAN 000031 K20HDR 000254' int RSTLNW 002146' ent $WHO 000000 ext CYOFF 002672' ent K20PTR 000033' RTCHR 003137' ext %%JSER 000257' ent CYON 002577' ent K20VER 000000000000# pol S8CCV7 003270' ent %%KRBF 000032' ext CYTRAP 003244' KERMIT 004077' SAVLNW 002124' ent %%KRMS 000035' ent CZCHAN 000004 KRXBLT 000030' SAVTTY 000721' ent %%SMS1 000344' k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page S-4 K20SUB MAC 25-Nov-23 13:11 SYMBOL TABLE FOR PSECT CODE %%SMSG 000311' ent ..0320 000740' spd ..0620 001266' spd ..1226 002300' spd %KERMS 000133' ent ..0326 000754' spd ..0621 001270' spd ..1227 002302' spd %WTLGF 000173' ..0333 000756' spd ..0631 001320' spd ..1235 002315' spd %WTLOG 000170' ent ..0340 000746' spd ..0636 001321' spd ..1236 002317' spd ..0002 000130' spd ..0341 000752' spd ..0645 001344' spd ..1244 002325' spd ..0010 000047' spd ..0342 000753' spd ..0646 001347' spd ..1245 002330' spd ..0011 000052' spd ..0343 000763' spd ..0650 001367' spd ..1246 002336' spd ..0016 000065' spd ..0350 000764' spd ..0662 001360' spd ..1253 002334' spd ..0025 000054' spd ..0355 000767' spd ..0663 001366' spd ..1254 002336' spd ..0026 000060' spd ..0356 000774' spd ..0671 001365' spd ..1262 002346' spd ..0027 000102' spd ..0357 000775' spd ..0672 001366' spd ..1263 002350' spd ..0034 000103' spd ..0364 001010' spd ..0700 001403' spd ..1271 002354' spd ..0035 000126' spd ..0372 001014' spd ..0701 001406' spd ..1272 002356' spd ..0043 000153' spd ..0373 001021' spd ..0702 001411' spd ..1302 002411' spd ..0051 000225' spd ..0374 001022' spd ..0707 001415' spd ..1314 002417' spd ..0063 000245' spd ..0401 001026' spd ..0710 001426' spd ..1315 002420' spd ..0071 000237' spd ..0402 001033' spd ..0716 001424' spd ..1317 002427' spd ..0072 000242' spd ..0403 001035' spd ..0717 001426' spd ..1325 002441' spd ..0074 000310' spd ..0411 001037' spd ..0725 001435' spd ..1337 002437' spd ..0101 000275' spd ..0412 001055' spd ..0726 001446' spd ..1340 002441' spd ..0102 000276' spd ..0417 001043' spd ..0734 001444' spd ..1342 002450' spd ..0107 000321' spd ..0420 001050' spd ..0735 001445' spd ..1371 002537' spd ..0115 000331' spd ..0421 001051' spd ..0737 001471' spd ..1376 002541' spd ..0123 000364' spd ..0426 001064' spd ..0744 001473' spd ..1431 002754' spd ..0124 000375' spd ..0427 001074' spd ..0745 001467' spd ..1436 002756' spd ..0131 000403' spd ..0430 001075' spd ..0752 001470' spd ..1451 002772' spd ..0132 000405' spd ..0431 001103' spd ..0753 001506' spd ..1457 002767' spd ..0137 000424' spd ..0437 001111' spd ..0764 001512' spd ..1460 002772' spd ..0140 000427' spd ..0445 001116' spd ..0771 001513' spd ..1466 003016' spd ..0141 000430' spd ..0452 001117' spd ..0777 001546' spd ..1477 003025' spd ..0146 000434' spd ..0453 001124' spd ..1024 001640' spd ..1507 003032' spd ..0147 000436' spd ..0460 001125' spd ..1036 001643' spd ..1517 003037' spd ..0150 000437' spd ..0465 001132' spd ..1037 001651' spd ..1535 003077' spd ..0152 000446' spd ..0473 001140' spd ..1040 001653' spd ..1541 003077' spd ..0157 000455' spd ..0474 001141' spd ..1045 001666' spd ..1555 003122' spd ..0165 000470' spd ..0501 001144' spd ..1053 001662' spd ..1562 003127' spd ..0167 000512' spd ..0502 001150' spd ..1054 001664' spd ..1565 003137' spd ..0201 000500' spd ..0503 001151' spd ..1055 001666' spd ..1572 003141' spd ..0202 000501' spd ..0504 001216' spd ..1056 001700' spd ..1612 003256' spd ..0210 000510' spd ..0516 001214' spd ..1064 001717' spd ..1617 003262' spd ..0211 000511' spd ..0517 001216' spd ..1074 001714' spd ..1627 003274' spd ..0213 000517' spd ..0521 001233' spd ..1106 001730' spd ..1642 003300' spd ..0225 000562' spd ..0533 001224' spd ..1116 001746' spd ..1643 003326' spd ..0226 000564' spd ..0534 001226' spd ..1130 001743' spd ..1653 003320' spd ..0234 000574' spd ..0542 001231' spd ..1131 001746' spd ..1662 003377' spd ..0242 000600' spd ..0543 001233' spd ..1137 001774' spd ..1672 003425' spd ..0250 000607' spd ..0552 001234' spd ..1140 001775' spd ..1677 003426' spd ..0256 000626' spd ..0553 001247' spd ..1156 002054' spd ..1704 003423' spd ..0264 000632' spd ..0554 001246' spd ..1166 002072' spd ..1705 003424' spd ..0265 000635' spd ..0566 001244' spd ..1170 002075' spd ..1714 003534' spd ..0266 000641' spd ..0567 001246' spd ..1210 002255' spd ..1722 003575' spd ..0267 000641' spd ..0571 001260' spd ..1211 002257' spd ..1734 003624' spd ..0301 000645' spd ..0603 001256' spd ..1217 002271' spd ..1735 003627' spd ..0302 000650' spd ..0604 001260' spd ..1220 002274' spd ..1743 003635' spd ..0303 000652' spd ..0606 001270' spd ..1221 002302' spd ..1744 003652' spd k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page S-5 K20SUB MAC 25-Nov-23 13:11 SYMBOL TABLE FOR PSECT CODE ..1745 003646' spd ..1760 003663' spd ..1761 003666' spd ..1767 003702' spd ..1770 003715' spd ..1776 003727' spd ..1777 003740' spd ..2005 003744' spd ..2006 003776' spd ..2013 004022' spd ..2014 004030' spd ..2015 004031' 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 000607' ext k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page S-6 K20SUB MAC 25-Nov-23 13:11 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' ..2022 000016' spd ..2024 000026' spd ..2037 000030' spd ..2040 000050' spd ..2045 000045' spd ..2054 000060' spd ..2055 000100' spd ..2056 000076' spd ..2070 000071' spd ..2072 000120' spd ..2105 000107' spd ..2106 000114' spd ..TX1 740000 000000 spd ..TX2 000001 spd k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page S-7 K20SUB MAC 25-Nov-23 13:11 SYMBOL TABLE FOR PSECT CONST ASZTAB 000447' BIGSOU 000001' ent CHRCSW 001553' CHRCUP 001555' CHRCUT 001353' CHRIAC 001757' CHRMUP 001151' CHRMUT 000747' CHRSHE 001147' CHRSHS 000547' CHRSWS 001153' CNRTAB 000046' CRCTAB 002013' CRCTB2 002033' CRSUBT 000246' GIANT 000000' GUARDP 002053' IACTAB 001557' OW2DW 001761' k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page S-8 K20SUB MAC 25-Nov-23 13:11 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 20:02 27-Nov-23 Page S-9 K20SUB MAC 25-Nov-23 13:11 SYMBOL TABLE FOR PSECT DATEND DATGRD 000000' k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 20:02 27-Nov-23 Page S-10 K20SUB MAC 25-Nov-23 13:11 SYMBOL TABLE FOR PSECT PATCH PAT.. 000000' int k20hlp - Kermit-20 Help Text MACRO %53B(1254)-4 20:02 27-Nov-23 Page 1 K20HLP MAC 25-Nov-23 13:34 Help Text. ;[18] Lengthy help messages added in edit [18]. 44633 title k20hlp - Kermit-20 Help Text 44634 subttl Help Text. ;[18] Lengthy help messages added in edit [18]. 44635 44636 search monsym,k20unv ; Wants parsing and Kermit .PSECT definitions 44637 cmdacs ^ ; Clean up p1-p4 definitions 44638 44639 sall ; Tidy listing 44640 .directive flblst ; We don't need to see all the ASCIZ bytes... 44641 k20hlp - Kermit-20 Help Text MACRO %53B(1254)-4 20:02 27-Nov-23 Page 2 K20HLP MAC 25-Nov-23 13:34 Notes and Cautions 44642 subttl Notes and Cautions 44643 44644 remark Virtual address space decisions 44645 44646 ; The vast majority of the help text (over 32 pages of ASCII data) has 44647 ; been moved out of section 0 into section 1. This is to free up some 44648 ; virtual address space in section 0. 44649 ; 44650 ; However, it also has the benefit of a smaller working set size as 44651 ; the help text is typically seldom referenced. This will make Kermit 44652 ; more likely to be selected to run and cause less impact to Tops-20. 44653 ; 44654 ; Perhaps more significant is the fact that such a layout uses less 44655 ; cache space. This will result in faster performance on both the 44656 ; MCA25 and other implementations with cache memories, including the 44657 ; cache on systems hosting simulators. 44658 44659 remark Virtual address space cautions 44660 44661 ; Be aware that the help semantic action routine ($help in k20par) 44662 ; uses an address calculation to determine whether the result of the 44663 ; parse is either a macro whose text needs displaying or a simple text 44664 ; to just type. 44665 ; 44666 ; This is almost a hack in a single section program where there can be 44667 ; no issue of in-section address aliasing. It can get you into real 44668 ; trouble if you are using multiple sections. Thus, care must be 44669 ; taken to ensure that the in-section addresses of the macro table and 44670 ; help text do NOT conflict. 44671 ; 44672 ; See the calculations for hlporg in k20unv.mac for further details. 44673 k20hlp - Kermit-20 Help Text MACRO %53B(1254)-4 20:02 27-Nov-23 Page 3 K20HLP MAC 25-Nov-23 13:34 Table of help commands 44674 subttl Table of help commands 44675 44676 .psect code/ronly ; %key macros will put text in the text .psect 44677 44678 000000'02 000000 000000 %table(hlptab,G) ;[194] ;[18] 44679 000001'02 000000# 000000# %key2 <36-bit-bytes>,h36bb ;[232] 44680 000000'03 063 066 055 142 151 44681 000002'02 000000# 000000# %key2 ,hbye 44682 000003'03 142 171 145 000 000 44683 000003'02 000000# 000000# %key2 ,hcescp 44684 000004'03 103 055 145 163 143 44685 000004'02 000000# 000000# %key2 ,hcaptu ;[230] 44686 000010'03 143 141 160 164 165 44687 000005'02 000000# 000000# %key2 ,hclear 44688 000012'03 143 154 145 141 162 44689 000006'02 000000# 000000# %key2 ,hclose 44690 000014'03 143 154 157 163 145 44691 000007'02 000000# 000000# %key2 ,hconne 44692 000016'03 143 157 156 156 145 44693 000010'02 000000# 000000# %key2 ,hcchar 44694 000020'03 143 157 156 164 162 44695 000011'02 000000# 000000# %key2 ,hcwd 44696 000024'03 143 167 144 000 000 44697 000012'02 000000# 000000# %key2 ,hdebug ;[239] 44698 000025'03 144 145 142 165 147 44699 000013'02 000000# 000000# %key2 ,hdefin 44700 000027'03 144 145 146 151 156 44701 000014'02 000000# 000000# %key2 ,hdele 44702 000031'03 144 145 154 145 164 44703 000015'02 000000# 000000# %key2 ,hdire 44704 000033'03 144 151 162 145 143 44705 000016'02 000000# 000000# %key2 ,hecho 44706 000035'03 145 143 150 157 000 44707 000017'02 000000# 000000# %key2 ,hexit 44708 000036'03 145 170 151 164 000 44709 000020'02 000000# 000000# %key2 ,hfinis 44710 000037'03 146 151 156 151 163 44711 000021'02 000000# 000000# %key2 ,hget 44712 000041'03 147 145 164 000 000 44713 000022'02 000000# 000000# %key2 ,hhelp 44714 000042'03 150 145 154 160 000 44715 000023'02 000000# 000000# %key2 ,hinput 44716 000043'03 151 156 160 165 164 44717 000024'02 000000# 000000# %key2 ,hkermi 44718 000045'03 153 145 162 155 151 44719 000025'02 000000# 000000# %key2 ,hline 44720 000047'03 154 151 156 145 000 44721 000026'02 000000# 000000# %key2 ,hlocal 44722 000050'03 154 157 143 141 154 44723 000027'02 000000# 000000# %key2 ,hlog 44724 000052'03 154 157 147 000 000 44725 000030'02 000000# 000000# %key2 ,houtpu 44726 000053'03 157 165 164 160 165 44727 000031'02 000000# 000000# %key2 ,hpause 44728 000055'03 160 141 165 163 145 k20hlp - Kermit-20 Help Text MACRO %53B(1254)-4 20:02 27-Nov-23 Page 3-1 K20HLP MAC 25-Nov-23 13:34 Table of help commands 44729 000032'02 000000# 000000# %key2 ,hpromp 44730 000057'03 160 162 157 155 160 44731 000033'02 000000# 000000# %key2 ,hpush 44732 000061'03 160 165 163 150 000 44733 000034'02 000000# 000000# %key2 ,hpwd 44734 000062'03 160 167 144 000 000 44735 000035'02 000000# 000000# %key2 ,hquit 44736 000063'03 161 165 151 164 000 44737 000036'02 000000# 000000# %key2 , hsquo 44738 000064'03 161 165 157 164 145 44739 000037'02 000000# 000000# %key2 ,hrecei 44740 000070'03 162 145 143 145 151 44741 000040'02 000000# 000000# %key2 ,hremot 44742 000072'03 162 145 155 157 164 44743 000041'02 000000# 000000# %key2 ,hretur ;[237] 44744 000074'03 162 145 164 165 162 44745 000042'02 000000# 000000# %key2 ,hrun 44746 000076'03 162 165 156 000 000 44747 000043'02 000000# 000000# %key2 ,hsend 44748 000077'03 163 145 156 144 000 44749 000044'02 000000# 000000# %key2 ,hserve 44750 000100'03 163 145 162 166 145 44751 000045'02 000000# 000000# %key2 ,hset 44752 000102'03 163 145 164 000 000 44753 000046'02 000000# 000000# %key2 ,hshow 44754 000103'03 163 150 157 167 000 44755 000047'02 000000# 000000# %key2 ,hspace 44756 000104'03 163 160 141 143 145 44757 000050'02 000000# 000000# %key2 ,hstatu 44758 000106'03 163 164 141 164 151 44759 000051'02 000000# 000000# %key2 ,hstatl 44760 000111'03 163 164 141 164 165 44761 000052'02 000000# 000000# %key2 ,htake 44762 000113'03 164 141 153 145 000 44763 000053'02 000000# 000000# %key2