K20UNV - Kermit-20 Universal Symbols and Macros MACRO %53B(1254)-4 15:18 11-Jun-23 Page 1 K20UNV MAC 9-Jun-23 13:46 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 15:18 11-Jun-23 Page 1-1 K20UNV MAC 9-Jun-23 13:46 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 15:18 11-Jun-23 Page 2 K20UNV MAC 9-Jun-23 13:46 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 15:18 11-Jun-23 Page 3 K20UNV MAC 9-Jun-23 13:46 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 15:18 11-Jun-23 Page 4 K20UNV MAC 9-Jun-23 13:46 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 15:18 11-Jun-23 Page 4-1 K20UNV MAC 9-Jun-23 13:46 Handy macros for address conversion 194 > K20UNV - Kermit-20 Universal Symbols and Macros MACRO %53B(1254)-4 15:18 11-Jun-23 Page 5 K20UNV MAC 9-Jun-23 13:46 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 15:18 11-Jun-23 Page 6 K20UNV MAC 9-Jun-23 13:46 .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 15:18 11-Jun-23 Page 7 K20UNV MAC 9-Jun-23 13:46 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 15:18 11-Jun-23 Page 8 K20UNV MAC 9-Jun-23 13:46 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 15:18 11-Jun-23 Page 8-1 K20UNV MAC 9-Jun-23 13:46 Various MACRO sizings 289 ifl ,<.fatal Maximum password will exceed packet length> 290 K20UNV - Kermit-20 Universal Symbols and Macros MACRO %53B(1254)-4 15:18 11-Jun-23 Page 9 K20UNV MAC 9-Jun-23 13:46 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 15:18 11-Jun-23 Page 10 K20UNV MAC 9-Jun-23 13:46 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 8901 000316'02 000000000000# 8902 000317'02 44 07 0 00 002131' 8903 000320'02 44 07 0 00 002134' 8904 000321'02 000006 000000 hsfdb2: flddb. .cmkey,,sethlp,, 8905 000322'02 000000000000# 8906 000323'02 44 07 0 00 002136' 8907 000324'02 44 07 0 00 002134' 8908 8909 cleans() 8910 8911 ;[214] Begin table and linkage definitions 8912 8913 ; Commands which require additional sub-commands or more granular help 8914 ; can be dealt with by: 8915 ; 8916 ; 1) Creating an additional entry in the sub-help (subhlp) table 8917 ; with the hclip macro. 8918 ; 2) Creating function descriptor block with pointers to the 8919 ; default help and to individual help text keyword (or switch) 8920 ; tables. 8921 ; 3) The parse tables for individual help are then created in 8922 ; k20hlp. 8923 ; 4) Wonderfully informative help text is written. 8924 ; [That's the goal, anyway] 8925 ; 8926 ; The block. statement with the nested do. functions conceptually as a 8927 ; kind of a cross between a switch statement and a skip chain yet 8928 ; effectively executes as a skip chain. The efficiency of this linear 8929 ; approach may need to be revisited if we create a lot of multi-level 8930 ; help (Tops-10 Kermit does this) 8931 8932 000325'02 010004 000330' $hdefi: flddb. .cmcfm,,,,,$hdef1 8933 000326'02 000000 000000 8934 000327'02 44 07 0 00 002141' 8935 000330'02 003004 000000 $hdef1: flddb. .cmswi,,defhlp##,,, 8936 000331'02 000000000000# 8937 000332'02 44 07 0 00 002147' 8938 8939 000333'02 010004 000336' $hclea: flddb. .cmcfm,,,,,$hcle1 8940 000334'02 000000 000000 8941 000335'02 44 07 0 00 002153' 8942 000336'02 003004 000000 $hcle1: flddb. .cmswi,,clrhlp##,,, 8943 000337'02 000000000000# 8944 000340'02 44 07 0 00 002161' 8945 8946 000341'02 010004 000344' $hloca: flddb. .cmcfm,,,,,$hloc1 8947 000342'02 000000 000000 8948 000343'02 44 07 0 00 002165' 8949 000344'02 000004 000000 $hloc1: flddb. .cmkey,,lclhlp##,,, k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 25-1 K20PAR MAC 7-Jun-23 14:23 HELP command parsing 8950 000345'02 000000000000# 8951 000346'02 44 07 0 00 002173' 8952 8953 000347'02 010004 000352' $hremo: flddb. .cmcfm,,,,,$hrem1 8954 000350'02 000000 000000 8955 000351'02 44 07 0 00 002177' 8956 000352'02 000004 000000 $hrem1: flddb. .cmkey,,remhlp##,,, 8957 000353'02 000000000000# 8958 000354'02 44 07 0 00 002205' 8959 8960 000355'02 010004 000360' $htime: flddb. .cmcfm,,,,,$htim1 8961 000356'02 000000 000000 8962 000357'02 44 07 0 00 002211' 8963 000360'02 003004 000000 $htim1: flddb. .cmswi,,timhlp##,,, 8964 000361'02 000000000000# 8965 000362'02 44 07 0 00 002217' 8966 8967 cleans(<$hdef1,$hcle1,$hloc1,$hrem1,$htim1>) 8968 8969 ; N.B., Although most help text resides in section one, the TBLUK% 8970 ; table only stores 18 bit addresses. Therefore, we must clip the 8971 ; section number or LINK will remind us that it is doing it for us. 8972 ; 8973 ; Such action may or may not be desired. In our case, it is 8974 ; exactly what we want, so we clip the address here to keep from 8975 ; constantly seeing LINK's advisory messages. 8976 8977 define hclip (hbase,%hb,%fb) < ;;All 214, used to add secondary help 8978 extern hbase ;;All should be found in k20hlp, section 1 8979 %hb==<<'hbase>&.rhalf> ;;Clip down to 18 bits (we know the section) 8980 %fb==<<$'hbase>&.rhalf> ;;Clip down to 18 bits (we know the section) 8981 xwd %hb,%fb ;;Make a table entry 8982 cleans(<%hb,%fb>) ;;Clean up generated symbols 8983 > 8984 000363'02 000000# 000000# subhlp: hclip (hdefin) ;;Sub-help for DEFINE command 8985 000364'02 000000# 000000# hclip (hclear) ;;Sub-help for CLEAR command 8986 000365'02 000000# 000000# hclip (hlocal) ;;Sub-help for LOCAL command 8987 000366'02 000000# 000000# hclip (hremot) ;;Sub-help for REMOTE command 8988 000367'02 000000# 000000# hclip (htime) ;;Sub-help for TIME command 8989 000005 subcnt==.-subhlp ; Number of items in sub-help table 8990 8991 000370'02 000002 000000 hlpfdb: flddb. .cmkey,,hlptab,, 8992 000371'02 000000000000# 8993 000372'02 000000 000000 8994 000373'02 44 07 0 00 002222' 8995 retsec ;;Back in code 8996 8997 ;[214] End table and linkage definitions 8998 8999 001244'01 200 16 0 00 000000# .help: guide ;[18] HELP 9000 001245'01 260 17 0 00 001200* 9001 000374'02 000000000000# 9002 000335'04 141 142 157 165 164 9003 001246'01 201 01 0 00 000000# movei t1, hlpfdb 9004 001247'01 260 17 0 00 001164* call rfield ;[67] k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 25-2 K20PAR MAC 7-Jun-23 14:23 HELP command parsing 9005 001250'01 200 02 0 02 000000 move t2, (t2) ; Get help text address. 9006 001251'01 202 02 0 00 001241* movem t2, pars3 9007 001252'01 402 00 0 00 001012* setzm pars4 ;[214] Let's assume it isn't a macro 9008 001253'01 553 00 0 00 000002 hrrzs t2 ;[67] 9009 001254'01 201 04 0 00 000004 movx t4, subcnt-1 ;[214] Load count of sub-help tables 9010 ;[214] Used as an index, actually 9011 remark ;[214] Note, SET must be last because of macros 9012 001255'01 415 16 0 00 001314' block. ;[214] Enter block context for better control 9013 001256'01 261 17 0 00 000016 9014 001257'01 do. ;[214] Enter loop context 9015 001257'01 554 03 0 04 000000# hlrz t3, subhlp(t4) ;[214] Load sub-help table in section offset 9016 001260'01 312 02 0 00 000003 came t2, t3 ;[214] Secondary help we know about? 9017 001261'01 254 00 0 00 001275' ifskp. ;[214] Yes, handle that 9018 001262'01 200 16 0 00 000000# guide ;[214] Tell them they can ask about sub-commands 9019 001263'01 260 17 0 00 001245* 9020 000375'02 000000000000# 9021 000337'04 151 164 145 155 000 9022 001264'01 550 01 0 04 000000# hrrz t1, subhlp(t4) ;[214] Load secondary help fdb 9023 001265'01 260 17 0 00 001247* call rfield ;[214] Maybe get item they want help for 9024 001266'01 135 01 0 00 005021' ldb t1, [pointr (.cmfnp(t3),cm%fnc)] ;[214] Get function code. 9025 001267'01 302 01 0 00 000010 caie t1, .cmcfm ;[214] Wanted general help? 9026 001270'01 254 00 0 00 001273' ifskp. ;[214] They did 9027 001271'01 554 02 0 04 000000# hlrz t2, subhlp(t4) ;[214] So load the general help again 9028 001272'01 254 00 0 00 000034* retskp ;[214] Signal completely done with parse 9029 001273'01 endif. ;[214] End case general REMOTE help 9030 001273'01 550 02 0 02 000000 hrrz t2, (t2) ;[214] Get switch help text address. 9031 001274'01 263 17 0 00 000000 ret ;[214] Break out of the block, non-skip 9032 001275'01 endif. ;[214] End case REMOTE picked 9033 001275'01 365 04 0 00 001257' sojge t4, top. ;[214] Try next sub-help 9034 001276'01 enddo. ;[214] End loop logical context 9035 9036 remark ;[214] If none of the above, do SET last 9037 001276'01 302 02 0 00 000000* caie t2, hset ;[214] Do they want help for SET? 9038 001277'01 254 00 0 00 001313' ifskp. ;[214] They did 9039 001300'01 200 16 0 00 000000# guide ;[67] Yes, give guide word. 9040 001301'01 260 17 0 00 001263* 9041 000376'02 000000000000# 9042 000340'04 160 141 162 141 155 9043 001302'01 201 01 0 00 000000# movei t1, hsfdb1 ;[77] Parse from macro or SET keyword table. 9044 001303'01 260 17 0 00 001265* call rfield ;[67] Get SET option they want help for. 9045 001304'01 553 00 0 00 000003 hrrzs t3 ;[77] Which function descriptor block was used? 9046 001305'01 302 03 0 00 000000# caie t3, hsfdb1 ;[77] The macro table? 9047 001306'01 254 00 0 00 001311' ifskp. ;[214] Yes, let semantic action know 9048 001307'01 476 00 0 00 001252* setom pars4 ;[214] More of a flag than a parse product 9049 001310'01 254 00 0 00 001312' else. ;[214] Otherwise, it was a SET option 9050 001311'01 200 02 0 02 000000 move t2, (t2) ;[67] Yes, don't do indirection 9051 001312'01 endif. ;[214] End case macro name or keywork 9052 001312'01 263 17 0 00 000000 ret ;[214] Break out of the block. 9053 001313'01 endif. ;[214] End case of set 9054 001313'01 263 17 0 00 000000 endbk. ;[214] End of block frame 9055 001314'01 254 00 0 00 001316' ifskp. ;[214] +2 means completely done 9056 remark ;[214] so DON'T confirm 9057 001315'01 254 00 0 00 001317' else. ;[214] Otherwise it must be confirmed first 9058 001316'01 260 17 0 00 001202* confrm ;[67] 9059 001317'01 endif. k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 25-3 K20PAR MAC 7-Jun-23 14:23 HELP command parsing 9060 9061 001317'01 202 02 0 00 001251* movem t2, pars3 ;[67] SET... 9062 001320'01 263 17 0 00 000000 ret 9063 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 26 K20PAR MAC 7-Jun-23 14:23 HELP command semantic action 9064 subttl HELP command semantic action 9065 9066 remark The below is out of date, see [214], above 9067 9068 ; N.B., DEPENDs on help text not having the same in-section address 9069 ; as the macro table. In a single section program, this is, of course, 9070 ; impossble. However, the help text is now in section one, so it can't 9071 ; occupy the same set of in-section (18 bit) addresses. This is a form 9072 ; aliasing and is addressed by judicious .PSECT layout. 9073 9074 remark Display a macro, if that is what they want help on 9075 9076 ;[214] extern mactbx ;[203] Moved to K20MAC 9077 9078 001321'01 550 03 0 00 001317* $help: hrrz t3, pars3 ;[77] Special case for help about macro. 9079 001322'01 336 00 0 00 001307* skipn pars4 ;[214] Is it macro keyword? 9080 001323'01 254 00 0 00 001342' jrst $help2 ;[214] Nope, just type the text 9081 repeat 0,< ;[214] Remove address decisioning 9082 cail t3, mactab+1 9083 caile t3, mactbx 9084 jrst $help2 9085 >;;repeat 0 ;[214] End address decisioning removal 9086 txmsg < 9087 001324'01 200 01 0 00 000000# "> 9088 001325'01 104 00 0 00 000076 9089 001326'01 320 12 0 00 001327' 9090 000377'02 000000000000# 9091 000342'04 015 012 042 000 000 9092 001327'01 564 01 0 03 000000 hlro t1, (t3) 9093 001330'01 104 00 0 00 000076 PSOUT 9094 txmsg <" is a SET macro defined to be: 9095 001331'01 200 01 0 00 000000# > 9096 001332'01 104 00 0 00 000076 9097 001333'01 320 12 0 00 001334' 9098 000400'02 000000000000# 9099 000343'04 042 040 151 163 040 9100 9101 001334'01 560 01 0 03 000000 hrro t1, (t3) 9102 001335'01 104 00 0 00 000076 PSOUT 9103 txmsg < 9104 001336'01 200 01 0 00 000000# > 9105 001337'01 104 00 0 00 000076 9106 001340'01 320 12 0 00 001341' 9107 000401'02 000000000000# 9108 000353'04 015 012 000 000 000 9109 001341'01 263 17 0 00 000000 ret 9110 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 27 K20PAR MAC 7-Jun-23 14:23 HELP command semantic action 9111 remark Otherwise, display the help text 9112 9113 ; N.B., The comparison code is actually a kind of a kludge because it 9114 ; uses 18 bit addresses. Since hset is in section 0 in the TEXT 9115 ; .PSECT, whereas ALL other help text is in section one, how can we 9116 ; handle possible inter-section address clash? 9117 ; 9118 ; The answer is to keep the data in completely different parts of 9119 ; the respective sections so that there is no possibility of clash. 9120 ; 9121 ; 1) hset is VERY high in section zero's address space, past what 9122 ; would be called the "high segment" in Tops-10; something after 9123 ; page 500. 9124 ; 9125 ; 2) The HELP .PSECT starts in section one, page 1, which gives us 9126 ; some 510 pages for help text which may be enough to help Frank 9127 ; write another book. 9128 9129 ; Define 30 bit address section portion of ASCII pointer (also used in k20mit) 9130 610001 000000 hlpntr==:<.P07!>> ;;Forces LINK polish fix-up 9131 9132 001342'01 550 01 0 00 001321* $help2: hrrz t1, pars3 ;[194] Load in-section portion of address 9133 001343'01 302 01 0 00 001276* caie t1, hset## ;[194] They want help for SET? 9134 001344'01 254 00 0 00 001347' ifskp. ;[194] Yes, this is here we use in section 0 9135 001345'01 661 01 0 00 777777 tlo t1, -1 ;[194] So let Tops-20 handle it 9136 001346'01 254 00 0 00 001350' else. ;[194] Otherwise, it's an inter-section reference 9137 001347'01 661 01 0 00 610001 txo t1, hlpntr ;[194] Turn into a one word global pointer 9138 001350'01 endif. ;[194] PSOUT% should be happy with either 9139 9140 001350'01 104 00 0 00 000076 PSOUT 9141 001351'01 561 01 0 00 001045* hrroi t1, crlf 9142 001352'01 104 00 0 00 000076 PSOUT 9143 001353'01 263 17 0 00 000000 ret 9144 9145 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 28 K20PAR MAC 7-Jun-23 14:23 LOG command tables 9146 subttl LOG command tables 9147 9148 000402'02 000000 000000 %table(logtab) 9149 000403'02 000000# 000002 %key2 ,2 ;[143] 9150 000426'03 144 145 142 165 147 9151 000404'02 000000# 000001 %key2 ,1 9152 000430'03 163 145 163 163 151 9153 000405'02 000000# 000000 %key2 ,0 9154 000432'03 164 162 141 156 163 9155 000402'02 000003 000003 %tbend 9156 9157 000406'02 000000 000000 %table(dbstab) ;[41] (this table) 9158 000407'02 000000# 000007 %key2 <7>,7 9159 000435'03 067 000 000 000 000 9160 000410'02 000000# 000010 %key2 <8>,8 9161 000436'03 070 000 000 000 000 9162 000406'02 000002 000002 %tbend 9163 9164 ;[222] Default command filespec fields for .CMFIL: 9165 9166 chgsec(code,const) ;;Table is not in code, it's in const 9167 000411'02 600020 777777 logbk: gj%fou!gj%new!gj%flg!fld(-1,.rhalf) ;[222] Must NOT be an existing file!! 9168 000412'02 000000 000000 0 ;[222] ; .gjsrc: Leave JFN's alone 9169 000413'02 000000 000000 0 ;[222] ; .gjdev: Use default for device 9170 000414'02 000000 000000 0 ;[222] ; .gjdir: Use default for directory 9171 000415'02 000000 000000 0 ;[222] ; .gjnam: Will be filled in 9172 000416'02 000000000000# cascii () ;[222] ; .gjext: Default extension is .LOG 9173 000354'04 114 117 107 000 000 9174 000417'02 000000000000# 0 ;[222] ; .gjpro: Use system or directory default protection 9175 000420'02 000000 000000 0 ;[222] ; .gjact: Use job default account 9176 000010 logbkl==<.-logbk> ;[222] ; Length of this GTJFN argument block. 9177 9178 000421'02 000000000000# lognam: cascii () ;[222] Default transaction log 9179 000355'04 124 122 101 116 123 9180 000422'02 000000000000# cascii () ;[222] Default session log 9181 000360'04 123 105 123 123 111 9182 000423'02 000000000000# cascii () ;[222] & default debugging log 9183 000362'04 104 105 102 125 107 9184 retsec ;;Back to where-ever we started from 9185 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 29 K20PAR MAC 7-Jun-23 14:23 LOG command parsing 9186 subttl LOG command parsing 9187 9188 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 9189 000424'02 000002 000000 logfdb: flddb. .cmkey,,logtab,, ; Parse what kind of log. 9190 000425'02 000000 000402' 9191 000426'02 000000 000000 9192 000427'02 44 07 0 00 002224' 9193 000430'02 006000 000000 lgfidb: flddb. .cmfil 9194 000431'02 000000 000000 9195 000432'02 000006 000000 lgbzfd: flddb. .cmkey,,dbstab,,7 ;[41] 9196 000433'02 000000 000406' 9197 000434'02 44 07 0 00 002226' 9198 000435'02 44 07 0 00 002233' 9199 retsec ;;Back to where-ever we started from 9200 9201 001354'01 200 16 0 00 000000# .log: guide ; Give guide word 9202 001355'01 260 17 0 00 001301* 9203 000436'02 000000000000# 9204 000364'04 167 150 141 164 000 9205 001356'01 201 01 0 00 000000# movei t1, logfdb 9206 001357'01 260 17 0 00 001303* call rfield 9207 001360'01 550 02 0 02 000000 hrrz t2, (t2) 9208 001361'01 202 02 0 00 001214* movem t2, pars2 9209 9210 001362'01 332 01 0 00 001342* skipe t1, pars3 ; Release any piled up JFNs from reparsing 9211 001363'01 104 00 0 00 000023 RLJFN 9212 001364'01 320 12 0 00 001365' erjmpr .+1 ; Catch and ignore any error 9213 001365'01 402 00 0 00 001362* setzm pars3 ;[194] Either way, no JFN parsed 9214 9215 001366'01 200 16 0 00 000000# guide ; Guide 9216 001367'01 260 17 0 00 001355* 9217 000437'02 000000000000# 9218 000365'04 164 157 040 146 151 9219 001370'01 201 01 0 00 000010 movx t1, logbkl ;[222] Space for GTJFN% block 9220 dmove t2, [ logbk ;[222] Source is our default GTJFN% block 9221 001371'01 120 02 0 00 005126' cjfnbk ] ;[222] Destination is COMND% GTJFN block 9222 001372'01 123 01 0 00 005122' xblt. t1 ;[222] Pop it into place 9223 9224 001373'01 200 02 0 00 001361* move t2, pars2 ;[222] Load the log table type 9225 001374'01 200 01 0 02 000000# move t1, lognam(t2) ;[222] Pick up the pointer for that 9226 001375'01 202 01 0 00 000000# movem t1, cjfnbk+.gjnam ;[222] Store as the default filename 9227 001376'01 201 01 0 00 000000# movei t1, lgfidb ;[222] Parse general file properly defaulted 9228 001377'01 260 17 0 00 001357* call rfield ; Parse log filespec. 9229 9230 001400'01 550 01 0 00 000002 hrrz t1, t2 ;[222] Load the JFN we got 9231 001401'01 260 17 0 00 001237* call isnulj ;[222] Is it NUL:? 9232 001402'01 600 00 0 00 000000 nop ;[222] No, but that's fine 9233 001403'01 552 01 0 00 001365* hrrzm t1, pars3 ;[222] Stash JFN here 9234 001404'01 200 02 0 00 001373* move t2, pars2 ;[143] Debugging log? 9235 001405'01 306 02 0 00 000002 cain t2, 2 ;[194] If not debugging 9236 001406'01 254 00 0 00 001411' ifskp. ;[194] Then nothing further to parse 9237 001407'01 260 17 0 00 001316* confrm ;[143] No, get confirmation 9238 001410'01 263 17 0 00 000000 ret ;[143] and return. 9239 001411'01 endif. ;[194] 9240 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 29-1 K20PAR MAC 7-Jun-23 14:23 LOG command parsing 9241 001411'01 200 16 0 00 000000# guide ;[41] Yes, parse the file byte size. 9242 001412'01 260 17 0 00 001367* 9243 000440'02 000000000000# 9244 000367'04 167 151 164 150 040 9245 001413'01 201 01 0 00 000000# movei t1, lgbzfd 9246 001414'01 260 17 0 00 001377* call rfield ;[41] Parse it. Defaults to 7. 9247 001415'01 550 02 0 02 000000 hrrz t2, (t2) ;[41] Get result. 9248 001416'01 202 02 0 00 001322* movem t2, pars4 ;[41] Save it. 9249 001417'01 200 16 0 00 000000# guide ;[41] Comforting guide... 9250 001420'01 260 17 0 00 001412* 9251 000441'02 000000000000# 9252 000373'04 142 151 164 163 000 9253 001421'01 260 17 0 00 001407* confrm 9254 001422'01 263 17 0 00 000000 ret 9255 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 30 K20PAR MAC 7-Jun-23 14:23 Open the desired log. 9256 subttl Open the desired log. 9257 9258 extern logbsz ;[194] Log file byte size 9259 extern frclos ;[194] Force close 9260 9261 001423'01 logdsp: remark ;[194] Log open dispatch table 9262 001423'01 000000 001442' $logt ;[194] Open transaction log 9263 001424'01 000000 001521' $logs ;[194] Open Session log 9264 001425'01 000000 001572' $logd ;[194] Open debugging log 9265 000003 logmax==.-logdsp ;[194] Maximum log file type 9266 9267 001426'01 331 01 0 00 001404* $log: skipl t1, pars2 ; What kind of log? 9268 001427'01 254 00 0 00 001433' ifskp. ;[194] The bad kind ... 9269 001430'01 200 01 0 00 000000# emsg ;[194] 9270 001431'01 104 00 0 00 000313 9271 000442'02 000000000000# 9272 000374'04 116 145 147 141 164 9273 001432'01 263 17 0 00 000000 ret ;[194] Go no further 9274 001433'01 endif. ;[194] 9275 001433'01 305 01 0 00 000003 caige t1, logmax ;[194] Out of range? 9276 001434'01 254 00 0 00 001440' ifskp. ;[194] Yeah, probably out of date 9277 001435'01 200 01 0 00 000000# emsg ;[194] 9278 001436'01 104 00 0 00 000313 9279 000443'02 000000000000# 9280 000406'04 114 157 147 147 151 9281 001437'01 263 17 0 00 000000 ret ;[194] Go no further 9282 001440'01 endif. ;[194] 9283 9284 remark ;[194] Otherwise, safe to dispatch 9285 001440'01 265 16 0 00 005036' saveac ;[198] Save q1 for everybody to play with 9286 001441'01 254 00 1 01 001423' jrst @logdsp(t1) ; Dispatch 9287 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 31 K20PAR MAC 7-Jun-23 14:23 Open transaction log semantic action 9288 subttl Open transaction log semantic action 9289 9290 ;[126] Begin code addition 9291 9292 001442'01 265 16 0 00 005036' $logt: saveac ;[221] Stores final JFN we're going to try 9293 001443'01 337 01 0 00 001112* skipg t1, tlgjfn ;[195] Already had a transaction log open? 9294 001444'01 254 00 0 00 001454' ifskp. ;[195] We did 9295 001445'01 402 00 0 00 001443* setzm tlgjfn ; In case of failure. 9296 001446'01 260 17 0 00 000732* call frclos ;[194] Force close 9297 001447'01 334 01 0 00 000000# ermsg% (, r) 9298 001450'01 254 00 0 00 001454' 9299 001451'01 202 01 0 00 000000* 9300 001452'01 104 00 0 00 000313 9301 001453'01 254 00 0 00 001224* 9302 000444'02 000000000000# 9303 000415'04 113 105 122 115 111 9304 9305 001454'01 endif. ;[195] 9306 9307 001454'01 260 17 0 00 001764' call nulogj ;[198] Go figure out the logging JFN 9308 001455'01 263 17 0 00 000000 ret ;[198] Failed; we've already whined about it 9309 001456'01 200 05 0 00 000001 move q1, t1 ;[221] Store whatever we're going to use 9310 001457'01 321 03 0 00 001505' ifxe. t3, gs%opn ;[198] Not open? 9311 001460'01 306 01 0 00 377777 cain t1, .nulio ;[221] Special JFN? 9312 001461'01 254 00 0 00 001505' anskp. ;[221] Doesn't need to be opened 9313 001462'01 200 03 0 00 000002 move t3, t2 ;[222] Otherwise, store the OPENF% bits 9314 001463'01 104 00 0 00 000021 OPENF ;[198] and try to open it 9315 001464'01 320 12 0 00 001466' ifje. r ;[198] Failed?? 9316 001465'01 254 00 0 00 001505' 9317 001466'01 302 01 0 00 600120 caie t1, opnx1 ; Already open? 9318 001467'01 254 00 0 00 001472' ifskp. ;[195] Yes, that's odd, but OK... 9319 001470'01 200 01 0 00 000005 move t1, q1 ;[194] Restore the JFN and carry on 9320 001471'01 254 00 0 00 001505' else. ;[194] Otherwise, a worse error 9321 001472'01 302 01 0 00 600130 caie t1, opnx9 ;[222] Invalid simulaneous access??? 9322 001473'01 254 00 0 00 001477' ifskp. ;[222] Yep, gj%new!gj%new didn't work 9323 001474'01 260 17 0 00 001646' call nxthgh ;[222] Get and open the next highest JFN 9324 001475'01 254 00 0 00 001477' anskp. ;[222] But couldn't 9325 remark ;[222] Otherwise, falls out to movem 9326 001476'01 254 00 0 00 001505' else. ;[222] Otherwise, so other kind of error 9327 001477'01 200 04 0 00 000001 move t4, t1 ;[194] Save error for a debugger 9328 001500'01 334 00 0 00 000000 %ermsg (,$loge) ;[221] 9329 001501'01 254 00 0 00 001505' 9330 001502'01 265 01 0 00 001222* 9331 001503'01 000000000000# 9332 001504'01 254 00 0 00 001757' 9333 000430'04 125 156 141 142 154 9334 001505'01 endif. ;[222] End attempted opnx9 recovery 9335 001505'01 endif. ;[194] End OPENF% error recovery 9336 001505'01 endif. ;[194] End OPENF% error analysis 9337 001505'01 endif. ;[194] End case opening the transaction log 9338 9339 001505'01 202 01 0 00 001445* movem t1, tlgjfn ; Save the jfn. 9340 001506'01 120 02 0 00 000000# smsg () 9341 001507'01 260 17 0 00 000000* 9342 000445'02 000000000000# k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 31-1 K20PAR MAC 7-Jun-23 14:23 Open transaction log semantic action 9343 000446'02 777777 777740 9344 000437'04 113 105 122 115 111 9345 dmove t2, [ -1 ; Write header in log file. 9346 001510'01 120 02 0 00 005130' ot%ntm!ot%day!ot%fdy!ot%fmn!ot%4yr] 9347 001511'01 104 00 0 00 000220 ODTIM 9348 001512'01 120 02 0 00 005132' dmove t2, [exp <-1,,crlflf>, -^d4 ] 9349 001513'01 104 00 0 00 000053 SOUT ;[194] Counted tie off 9350 001514'01 265 01 0 00 001106* wtlog (, tlgjfn) 9351 001515'01 000000000000# 9352 001516'01 777777 777764 9353 001517'01 000000000000# 9354 000446'04 117 160 145 156 145 9355 001520'01 263 17 0 00 000000 ret 9356 9357 ;[126] End of addition. 9358 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 32 K20PAR MAC 7-Jun-23 14:23 Open session log semantic action 9359 subttl Open session log semantic action 9360 9361 ;[194] If log is opened again without being closed beforehand, then 9362 ; JFN's can wind up being lost. 9363 9364 001521'01 265 16 0 00 005036' $logs: saveac ;[221] Needs an accumulator 9365 001522'01 337 01 0 00 001143* skipg t1, sesjfn ;[195] Already had a session log open? 9366 001523'01 254 00 0 00 001535' ifskp. ;[195] We did 9367 001524'01 402 00 0 00 001522* setzm sesjfn ; In case of failure. 9368 001525'01 402 00 0 00 001144* setzm sesflg ;[198] Stomp session flag, too 9369 001526'01 260 17 0 00 001446* call frclos ;[194] Force close 9370 001527'01 334 01 0 00 000000# ermsg% (, r) 9371 001530'01 254 00 0 00 001534' 9372 001531'01 202 01 0 00 001451* 9373 001532'01 104 00 0 00 000313 9374 001533'01 254 00 0 00 001453* 9375 000447'02 000000000000# 9376 000451'04 113 105 122 115 111 9377 9378 001534'01 254 00 0 00 001536' else. ;[198] Otherwise, decondition further logic 9379 001535'01 402 00 0 00 001525* setzm sesflg ;[198] Stomp session flag 9380 001536'01 endif. ;[195] 9381 9382 001536'01 260 17 0 00 001764' call nulogj ;[198] Go figure out the logging JFN 9383 001537'01 263 17 0 00 000000 ret ;[198] Failed; we've already whined about it 9384 001540'01 200 05 0 00 000001 move q1, t1 ;[221] Save whatever we're going to use 9385 001541'01 321 03 0 00 001567' ifxe. t3, gs%opn ;[198] Not open? 9386 001542'01 306 01 0 00 377777 cain t1, .nulio ;[221] Special JFN? 9387 001543'01 254 00 0 00 001567' anskp. ;[221] Doesn't need to be opened 9388 001544'01 200 03 0 00 000002 move t3, t2 ;[222] Otherwise, store the OPENF% bits 9389 001545'01 104 00 0 00 000021 OPENF ; Open now, avoid being stomped by CLZFFs. 9390 001546'01 320 12 0 00 001550' ifje. r ;[198] Failed?? 9391 001547'01 254 00 0 00 001567' 9392 001550'01 302 01 0 00 600120 caie t1, opnx1 ; Already open? 9393 001551'01 254 00 0 00 001554' ifskp. ;[195] Yes, that's odd, but OK... 9394 001552'01 200 01 0 00 000005 move t1, q1 ;[194] Restore the JFN and carry on 9395 001553'01 254 00 0 00 001567' else. ;[194] Otherwise, a worse error 9396 001554'01 302 01 0 00 600130 caie t1, opnx9 ;[222] Invalid simulaneous access??? 9397 001555'01 254 00 0 00 001561' ifskp. ;[222] Yep, gj%new!gj%new didn't work 9398 001556'01 260 17 0 00 001646' call nxthgh ;[222] Get and open the next highest JFN 9399 001557'01 254 00 0 00 001561' anskp. ;[222] But couldn't 9400 remark ;[222] Otherwise, falls out to movem 9401 001560'01 254 00 0 00 001567' else. ;[222] Otherwise, so other kind of error 9402 001561'01 200 04 0 00 000001 move t4, t1 ;[194] Save error for a debugger 9403 001562'01 334 00 0 00 000000 %ermsg (,$loge) ;[221] 9404 001563'01 254 00 0 00 001567' 9405 001564'01 265 01 0 00 001502* 9406 001565'01 000000000000# 9407 001566'01 254 00 0 00 001757' 9408 000463'04 125 156 141 142 154 9409 001567'01 endif. ;[222] End opnx9 recovery 9410 001567'01 endif. ;[194] End OPENF% error recovery 9411 001567'01 endif. ;[194] End OPENF% error analysis 9412 001567'01 endif. ;[198] End case opening the session log 9413 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 32-1 K20PAR MAC 7-Jun-23 14:23 Open session log semantic action 9414 remark ;[195] Otherwise, everything is dandy 9415 001567'01 552 01 0 00 001524* hrrzm t1, sesjfn ;[195] Save the open JFN. 9416 001570'01 476 00 0 00 001535* setom sesflg ;[195] Flag session logging is active 9417 001571'01 263 17 0 00 000000 ret 9418 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 33 K20PAR MAC 7-Jun-23 14:23 Open debugging log semantic action 9419 subttl Open debugging log semantic action 9420 9421 001572'01 265 16 0 00 005036' $logd: saveac ;[221] Accumulator for JFN 9422 001573'01 337 01 0 00 001063* skipg t1, logjfn ;[195] Already had a debugging log open? 9423 001574'01 254 00 0 00 001604' ifskp. ;[195] We did 9424 001575'01 402 00 0 00 001573* setzm logjfn ; In case of failure. 9425 001576'01 260 17 0 00 001526* call frclos ;[194] Force close 9426 001577'01 334 01 0 00 000000# ermsg% (, r) 9427 001600'01 254 00 0 00 001604' 9428 001601'01 202 01 0 00 001531* 9429 001602'01 104 00 0 00 000313 9430 001603'01 254 00 0 00 001533* 9431 000450'02 000000000000# 9432 000471'04 113 105 122 115 111 9433 9434 001604'01 endif. ;[195] 9435 9436 001604'01 260 17 0 00 001764' call nulogj ;[198] Go figure out the logging JFN 9437 001605'01 263 17 0 00 000000 ret ;[198] Failed; we've already whined about it 9438 001606'01 200 05 0 00 000001 move q1, t1 ;[221] Save the accumulator 9439 001607'01 200 04 0 00 001416* move t4, pars4 ;[198] ;[41] Load the bytesize we wanted. 9440 001610'01 202 04 0 00 000000* movem t4, logbsz ;[41] Save bytesize for SHOW command. 9441 001611'01 321 03 0 00 001642' ifxe. t3, gs%opn ;[198] Not open? 9442 001612'01 302 04 0 00 000010 caie t4, ^d8 ;[41] 8-bit requested? 9443 001613'01 254 00 0 00 001615' ifskp. ;[198] Whoops, better fix the mode word 9444 001614'01 137 04 0 00 005134' dpb t4,[pointr (t2,of%bsz)];[198] Overwrite the 7... 9445 001615'01 endif. ;[198] End case byte size fix up 9446 001615'01 306 01 0 00 377777 cain t1, .nulio ;[221] Special JFN? 9447 001616'01 254 00 0 00 001642' anskp. ;[221] Doesn't need to be opened 9448 001617'01 200 03 0 00 000002 move t3, t2 ;[222] Otherwise, store the OPENF% bits 9449 001620'01 104 00 0 00 000021 OPENF% ;[38] 9450 001621'01 320 12 0 00 001623' ifje. r ;[198] Failed?? 9451 001622'01 254 00 0 00 001642' 9452 001623'01 302 01 0 00 600120 caie t1, opnx1 ; Already open? 9453 001624'01 254 00 0 00 001627' ifskp. ;[195] Yes, that's odd, but OK... 9454 001625'01 200 01 0 00 000005 move t1, q1 ;[194] Restore the JFN and carry on 9455 001626'01 254 00 0 00 001642' else. ;[194] Otherwise, a worse error 9456 001627'01 302 01 0 00 600130 caie t1, opnx9 ;[222] Invalid simulaneous access??? 9457 001630'01 254 00 0 00 001634' ifskp. ;[222] Yep, gj%new!gj%new didn't work 9458 001631'01 260 17 0 00 001646' call nxthgh ;[222] Get and open the next highest JFN 9459 001632'01 254 00 0 00 001634' anskp. ;[222] But couldn't 9460 remark ;[222] Otherwise, falls out to movem 9461 001633'01 254 00 0 00 001642' else. ;[222] Otherwise, so other kind of error 9462 001634'01 200 04 0 00 000001 move t4, t1 ;[194] Save error for a debugger 9463 001635'01 334 00 0 00 000000 %ermsg (,$loge) ;[221] 9464 001636'01 254 00 0 00 001642' 9465 001637'01 265 01 0 00 001564* 9466 001640'01 000000000000# 9467 001641'01 254 00 0 00 001757' 9468 000504'04 125 156 141 142 154 9469 001642'01 endif. ;[222] End opnx9 error recovery 9470 001642'01 endif. ;[194] End OPENF% error recovery 9471 001642'01 endif. ;[194] End OPENF% error analysis 9472 001642'01 endif. ;[198] End case opening the session log 9473 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 33-1 K20PAR MAC 7-Jun-23 14:23 Open debugging log semantic action 9474 remark ;[195] Otherwise, everything is dandy 9475 001642'01 202 01 0 00 001575* movem t1, logjfn ;[38] Opened OK, save it. 9476 001643'01 336 00 0 00 000014 skipn debug ;[41] Was debugging asked for? 9477 001644'01 201 14 0 00 000001 movei debug, 1 ;[41] Not yet, so set default debugging. 9478 001645'01 263 17 0 00 000000 ret 9479 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 34 K20PAR MAC 7-Jun-23 14:23 Get next higher generation 9480 subttl Get next higher generation 9481 9482 ; gj%new!gj%fou will only work for a file which has been saved at 9483 ; least once. Otherwise, the file does not exist on disk yet and 9484 ; GTJFN% can return the JFN of a file that is actually already open 9485 ; (in another job). 9486 9487 ; Call: 9488 ; 9489 ; q1/ JFN that failed open with opnx9 9490 ; t3/ Failing OPENF%'s bits 9491 ; 9492 ; Return: 9493 ; 9494 ; +1/ Failed, q1 unchanged 9495 ; +2/ Worked, q1 has an OPEN JFN 9496 9497 ; Fields for file with no generation number 9498 9499 100000 000000 fnogen==fld(.jsaof, js%dev) ;[222] Always want device 9500 110000 000000 fnogen==fnogen!fld(.jsaof, js%dir) ;[222] Full directory 9501 111000 000000 fnogen==fnogen!fld(.jsaof, js%nam) ;[222] File Name 9502 111100 000000 fnogen==fnogen!fld(.jsaof, js%typ) ;[222] File Type (or Extension) 9503 111100 000001 fnogen==fnogen!js%paf ;[222] Punctuate all fields 9504 9505 001646'01 265 16 0 00 005060' nxthgh: saveac ;[222] Needs some control variables 9506 001647'01 200 06 0 00 000003 move q2, t3 ;[222] Save the OPENF% bits 9507 001650'01 561 01 0 00 000776* hrroi t1, atmbuf ;[222] Get a place to do JFNS% 9508 001651'01 550 02 0 00 000005 hrrz t2, q1 ;[222] Load the JFN 9509 dmove t3, [ fld(.jsaof, js%gen) ;[222] Just want the (bad) generation number 9510 001652'01 120 03 0 00 005135' 0 ] ;[222] No goofy prefix, whatever that is 9511 001653'01 104 00 0 00 000030 JFNS% ;[222] Get just that 9512 001654'01 320 12 0 00 001656' %jsErr (,r) 9513 001655'01 254 00 0 00 001661' 9514 001656'01 265 01 0 00 001637* 9515 001657'01 000000000000# 9516 001660'01 254 00 0 00 001603* 9517 000512'04 112 106 116 123 045 9518 001661'01 561 01 0 00 001650* hrroi t1, atmbuf ;[222] Point at the atom buffer again 9519 001662'01 201 03 0 00 000012 movei t3, ^d10 ;[222] Generations are in base 10 9520 001663'01 104 00 0 00 000225 NIN% ;[222] Convert to internal binary format 9521 001664'01 320 12 0 00 001666' %jsErr (,r) 9522 001665'01 254 00 0 00 001671' 9523 001666'01 265 01 0 00 001656* 9524 001667'01 000000000000# 9525 001670'01 254 00 0 00 001660* 9526 000527'04 116 111 116 045 040 9527 001671'01 350 07 0 00 000002 aos q3, t2 ;[222] Calculate and save the next highest 9528 001672'01 561 01 0 00 001661* hrroi t1, atmbuf ;[222] Get a place to do another JFNS% 9529 001673'01 550 02 0 00 000005 hrrz t2, q1 ;[222] Load the JFN again 9530 dmove t3, [ fnogen ;[222] Do everything EXCEPT the generation 9531 001674'01 120 03 0 00 005137' 0 ] ;[222] No goofy prefix, whatever that is 9532 001675'01 104 00 0 00 000030 JFNS% ;[222] Get just that 9533 001676'01 320 12 0 00 001700' %jsErr (<2nd JFNS% failure recovering from invalid simultaneous access>,r) 9534 001677'01 254 00 0 00 001703' k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 34-1 K20PAR MAC 7-Jun-23 14:23 Get next higher generation 9535 001700'01 265 01 0 00 001666* 9536 001701'01 000000000000# 9537 001702'01 254 00 0 00 001670* 9538 000544'04 062 156 144 040 112 9539 001703'01 201 03 0 00 000056 movei t3, "." ;[222] Punctuation for generation number to come 9540 001704'01 136 03 0 00 000001 idpb t3, t1 ;[222] Append it 9541 001705'01 200 10 0 00 000001 move q4, t1 ;[222] Save where to append the generation 9542 001706'01 201 04 0 00 000036 movei t4, ^d30 ;[222] Only try 30 generations 9543 9544 001707'01 do. ;[222] Enter loop context 9545 001707'01 200 01 0 00 000010 move t1, q4 ;[222] Where to append the current generation 9546 001710'01 200 02 0 00 000007 move t2, q3 ;[222] Load current highest generation 9547 001711'01 201 03 0 00 000012 movei t3, ^d10 ;[222] Output in base 10 9548 001712'01 104 00 0 00 000224 NOUT% ;[222] Convert to internal binary format 9549 001713'01 320 12 0 00 001715' %jsErr (,r) 9550 001714'01 254 00 0 00 001720' 9551 001715'01 265 01 0 00 001700* 9552 001716'01 000000000000# 9553 001717'01 254 00 0 00 001702* 9554 000561'04 116 117 125 124 045 9555 dmove t1, [ ;[222] May no catch existing files, but... 9556 gj%new!gj%flg ;[222] New file, return flags 9557 001720'01 120 01 0 00 005141' -1,,atmbuf ] ;[222] Point to what we just built 9558 001721'01 104 00 0 00 000020 GTJFN% ;[222] Get a JFN on the next highest generation 9559 001722'01 320 12 0 00 001724' %jsErr (,r) 9560 001723'01 254 00 0 00 001727' 9561 001724'01 265 01 0 00 001715* 9562 001725'01 000000000000# 9563 001726'01 254 00 0 00 001717* 9564 000576'04 107 124 112 106 116 9565 001727'01 510 03 0 00 000001 hllz t3, t1 ;[222] Grab the flags 9566 001730'01 621 01 0 00 777777 tlz t1, -1 ;[222] Stomp them 9567 001731'01 250 01 0 00 000005 exch t1, q1 ;[222] Use as current JFN 9568 001732'01 104 00 0 00 000023 RLJFN% ;[222] Toss the one that didn't work 9569 001733'01 320 12 0 00 001735' %jsErr (,r) 9570 001734'01 254 00 0 00 001740' 9571 001735'01 265 01 0 00 001724* 9572 001736'01 000000000000# 9573 001737'01 254 00 0 00 001726* 9574 000613'04 122 114 112 106 116 9575 001740'01 550 01 0 00 000005 hrrz t1, q1 ;[222] Load the new JFN 9576 001741'01 200 02 0 00 000006 move t2, q2 ;[222] Load original OPENF% bits 9577 001742'01 104 00 0 00 000021 OPENF% ;[222] And try it again 9578 001743'01 320 12 0 00 001745' ifje. r ;[222] But failed 9579 001744'01 254 00 0 00 001756' 9580 001745'01 302 01 0 00 600130 caie t1, opnx9 ;[222] Bumped into another one? 9581 001746'01 334 00 0 00 000000 %ermsg (,r) 9582 001747'01 254 00 0 00 001753' 9583 001750'01 265 01 0 00 001735* 9584 001751'01 000000000000# 9585 001752'01 254 00 0 00 001737* 9586 000630'04 117 120 105 116 106 9587 001753'01 363 04 0 00 001752* sojle t4, r ;[222] Only do this so many times 9588 001754'01 344 07 0 00 001707' aoja q3, top. ;[222] Otherwise, try another generation 9589 001755'01 254 00 0 00 001757' else. ;[222] Otherwise, worked k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 34-2 K20PAR MAC 7-Jun-23 14:23 Get next higher generation 9590 001756'01 254 00 0 00 001272* retskp ;[222] Return success 9591 001757'01 endif. ;[222] End OPENF% analysis 9592 001757'01 enddo. ;[222] End loop context 9593 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 35 K20PAR MAC 7-Jun-23 14:23 Handle log file open errors 9594 subttl Handle log file open errors 9595 9596 ; Assumes Q1 has a JFN 9597 9598 001757'01 550 01 0 00 000005 $loge: hrrz t1, q1 ;[221] Load the JFN 9599 001760'01 322 01 0 00 001753* jumpe t1, R ;[222] Don't try to release gubbish 9600 001761'01 260 17 0 00 001576* call frclos ;[221] Force it closed or release it 9601 001762'01 600 00 0 00 000000 nop ;[221] Ignore error return when trying to recover 9602 001763'01 263 17 0 00 000000 ret ;[221] Done 9603 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 36 K20PAR MAC 7-Jun-23 14:23 Set up a log file JFN, special casing NUL: 9604 subttl Set up a log file JFN, special casing NUL: 9605 9606 ; Call: 9607 ; 9608 ; pars3/ Some kind of JFN, which is very carefully checked 9609 ; 9610 ; +1 Failed 9611 ; +2 t1/ JFN ready to be opened or .nulio 9612 ; t2/ OPENF% bits, basically of%wr and maybe of%app 9613 ; Assumes 7 bit mode, which would need to be overriden 9614 ; t3/ Results of GTSTS% (which are simulated for .nulio) 9615 ; pars3/ Updated in case of .nulio 9616 9617 001764'01 265 16 0 00 005104' nulogj: saveac ;[198] Saves a copy of the JFN 9618 9619 001765'01 415 16 0 00 001775' block. ;[194] Enter block context for better control flow 9620 001766'01 261 17 0 00 000016 9621 001767'01 337 05 0 00 001403* skipg q1, pars3 ;[194] Load and check the parsed JFN 9622 001770'01 263 17 0 00 000000 ret ;[194] It was junk... 9623 001771'01 621 05 0 00 777777 tlz q1, -1 ;[194] Shut off any flags 9624 001772'01 322 05 0 00 001760* jumpe q1, r ;[194] Zero is junk, too 9625 001773'01 254 00 0 00 001756* retskp ;[194] Otherwise, passes lexical checks 9626 001774'01 263 17 0 00 000000 endbk. ;[194] Exit block. context 9627 001775'01 254 00 0 00 002000' ifskp. ;[194] Passed? 9628 001776'01 200 01 0 00 000005 move t1, q1 ;[194] Yes, do some further checking 9629 001777'01 254 00 0 00 002005' else. ;[194] Otherwise, something wasn't right 9630 002000'01 334 01 0 00 000000# ermsg% (, r) 9631 002001'01 254 00 0 00 002005' 9632 002002'01 202 01 0 00 001601* 9633 002003'01 104 00 0 00 000313 9634 002004'01 254 00 0 00 001772* 9635 000451'02 000000000000# 9636 000644'04 113 105 122 115 111 9637 9638 002005'01 endif. ;[194] End sanity check 9639 9640 remark t1, q1 ;[194] t1 is loaded at this point 9641 002005'01 260 17 0 00 001401* call isnulj ;[194] Allow them to log to NUL: quickly 9642 002006'01 254 00 0 00 002013' ifskp. ;[194] It's NUL: 9643 002007'01 553 05 0 00 000001 hrrzs q1, t1 ;[194] Clear 'flags' and cache JFN 9644 002010'01 202 01 0 00 001767* movem t1, pars3 ;[194] Store .nulio as parse item 9645 002011'01 205 06 0 00 501200 movx q2, ;[198] Pretend some likley bits 9646 002012'01 254 00 0 00 002071' else. ;[194] Otherwise, a real file 9647 002013'01 104 00 0 00 000024 GTSTS% ;[198] Let's have a look at the file 9648 002014'01 320 12 0 00 002016' %jserr (,r) ;[198] 9649 002015'01 254 00 0 00 002021' 9650 002016'01 265 01 0 00 001750* 9651 002017'01 000000000000# 9652 002020'01 254 00 0 00 002004* 9653 000655'04 125 156 141 142 154 9654 002021'01 200 06 0 00 000002 move q2, t2 ;[198] Save the status 9655 002022'01 603 02 0 00 000200 ifxe. t2, gs%nam ;[198] Some kind of gubbish? 9656 002023'01 254 00 0 00 002031' 9657 002024'01 334 01 0 00 000000# ermsg% (, r) ;[198] 9658 002025'01 254 00 0 00 002031' k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 36-1 K20PAR MAC 7-Jun-23 14:23 Set up a log file JFN, special casing NUL: 9659 002026'01 202 01 0 00 002002* 9660 002027'01 104 00 0 00 000313 9661 002030'01 254 00 0 00 002020* 9662 000452'02 000000000000# 9663 000664'04 113 105 122 115 111 9664 9665 002031'01 endif. ;[198] 9666 002031'01 607 02 0 00 000400 ifxn. t2, gs%err ;[198] Some kind of error? 9667 002032'01 254 00 0 00 002040' 9668 002033'01 334 01 0 00 000000# ermsg% (, r) ;[198] 9669 002034'01 254 00 0 00 002040' 9670 002035'01 202 01 0 00 002026* 9671 002036'01 104 00 0 00 000313 9672 002037'01 254 00 0 00 002030* 9673 000453'02 000000000000# 9674 000675'04 113 105 122 115 111 9675 9676 002040'01 endif. ;[198] 9677 002040'01 603 02 0 00 400000 txne t2, gs%opn ;[198] Is it already open? 9678 002041'01 254 00 0 00 002071' anskp. ;[198] It is, so we're done 9679 002042'01 104 00 0 00 000117 DVCHR% ;[198] Let's find out about the device 9680 002043'01 320 12 0 00 002045' %jserr (,r) ;[198] 9681 002044'01 254 00 0 00 002050' 9682 002045'01 265 01 0 00 002016* 9683 002046'01 000000000000# 9684 002047'01 254 00 0 00 002037* 9685 000711'04 117 160 145 156 040 9686 002050'01 135 03 0 00 005143' ldb t3,[pointr t2, dv%typ] ;[198] Pick up the device type 9687 002051'01 302 03 0 00 000000 caie t3, .dvdsk ;[198] Is this a disk? 9688 002052'01 254 00 0 00 002067' ifskp. ;[198] Yes, safe to query the fdb (I hope) 9689 002053'01 200 01 0 00 000005 move t1, q1 ;[198] Load the JFN 9690 dmove t2, [1,,.fbctl ;[198] Get the file descriptor control word 9691 002054'01 120 02 0 00 005144' t4 ] ;[198] Put it in t4 9692 002055'01 104 00 0 00 000063 GTFDB% ;[198] Pull it from the file descriptor block. 9693 002056'01 320 12 0 00 002060' ifje. r ;[198] Sigh... 9694 002057'01 254 00 0 00 002063' 9695 002060'01 200 03 0 00 000001 move t3, t1 ;[198] Save the error for debuggers 9696 002061'01 474 02 0 00 000000 seto t2, ;[198] Assume not appending 9697 002062'01 200 01 0 00 000005 move t1, q1 ;[198] Reload the JFN 9698 002063'01 endif. ;[198] 9699 002063'01 603 02 0 00 100000 txne t2, fb%nex ;[198] Doesn't exist yet? 9700 002064'01 254 00 0 00 002067' anskp. ;[198] Then it is silly to try to append 9701 remark fb%nxf!fb%wnc ;[198] Not closed in some way; try not to overwrite 9702 remark t1, q1 ;[198] t1 is still loaded (or reloaded) at this point 9703 002065'01 200 02 0 00 005146' movx t2, of%wr!of%app!fld(7,of%bsz) ;[198] Write/append access, 7-bit bytes. 9704 002066'01 254 00 0 00 002071' else. ;[198] Otherwise, assume not appending 9705 002067'01 200 01 0 00 000005 move t1, q1 ;[198] Reload load the JFN 9706 002070'01 200 02 0 00 005147' movx t2, of%wr!fld(7,of%bsz) ;[198] Write access, 7-bit bytes. 9707 002071'01 endif. ;[198] 9708 002071'01 endif. ;[198] End .nulio special casing 9709 002071'01 200 03 0 00 000006 move t3, q2 ;[198] Return GTSTS% 9710 9711 002072'01 254 00 0 00 001773* retskp ;[198] Succeeded at something, anyway... 9712 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 37 K20PAR MAC 7-Jun-23 14:23 PAUSE command 9713 subttl PAUSE command 9714 9715 chgsec(code,const) ;;FDB's are not in code, they're in const 9716 000454'02 015006 000000 paufdb: flddb. .cmflt,,^d10,,<1> 9717 000455'02 000000 000012 9718 000456'02 44 07 0 00 002234' 9719 000457'02 44 07 0 00 002017' 9720 retsec ;;Back to where-ever we started from 9721 9722 002073'01 200 16 0 00 000000# .pause: guide (seconds) 9723 002074'01 260 17 0 00 001420* 9724 000460'02 000000000000# 9725 000722'04 163 145 143 157 156 9726 002075'01 201 01 0 00 000000# movei t1, paufdb 9727 002076'01 260 17 0 00 001414* call rfield ;[194] Parse for the floating number 9728 9729 002077'01 325 02 0 00 002103' ifl. t2 ;[194] Is the number in the right range? 9730 002100'01 200 01 0 00 000000# emsg ;[187] 9731 002101'01 104 00 0 00 000313 9732 000461'02 000000000000# 9733 000724'04 116 145 147 141 164 9734 002102'01 254 00 0 00 000205* jrst cmder1 ;[194] Allow reparse 9735 002103'01 endif. ;[194] 9736 9737 remark ;[212] When chksec works, it works completely 9738 002103'01 260 17 0 00 000000' call chksec ;[196] Ensure number is in correct range 9739 002104'01 254 00 0 00 002111' ifskp. ;[196] Check and convert OK? 9740 002105'01 336 00 0 00 000000* skipn definf ;[212] Yes; in a DEFINE command? 9741 002106'01 260 17 0 00 001421* confrm ;[212] No, confirm the line 9742 002107'01 263 17 0 00 000000 ret ;[212] And done 9743 002110'01 254 00 0 00 002114' else. ;[196] Otherwise, couldn't swallow something 9744 002111'01 200 01 0 00 000000# emsg ;[196] 9745 002112'01 104 00 0 00 000313 9746 000462'02 000000000000# 9747 000733'04 120 141 165 163 145 9748 002113'01 254 00 0 00 002102* jrst cmder1 ;[196] Allow reparse 9749 002114'01 endif. ;[196] End case checking and conversion 9750 9751 remark Pause semantic action 9752 9753 002114'01 337 01 0 00 001607* $pause: skipg t1, pars4 ;[196] Load the milliseconds 9754 002115'01 263 17 0 00 000000 ret ;[196] Unless there weren't any 9755 002116'01 104 00 0 00 000167 DISMS ; Sleep. 9756 002117'01 320 12 0 00 002120' erjmpr .+1 ;[194] Catch and ignore error 9757 002120'01 263 17 0 00 000000 ret 9758 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 38 K20PAR MAC 7-Jun-23 14:23 PROMPT command 9759 subttl PROMPT command 9760 9761 ; Parse the rest of the PROMPT command. 9762 9763 002121'01 260 17 0 00 002106* .promp: confrm ; Confirm. 9764 002122'01 263 17 0 00 000000 ret 9765 9766 remark PROMPT command execution. 9767 9768 002123'01 402 00 0 00 001054* $promp: setzm f$exit ; Reset exit flag. 9769 002124'01 263 17 0 00 000000 ret 9770 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 39 K20PAR MAC 7-Jun-23 14:23 PUSH command 9771 subttl PUSH command 9772 9773 002125'01 260 17 0 00 002121* .push: confrm 9774 002126'01 263 17 0 00 000000 ret 9775 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 40 K20PAR MAC 7-Jun-23 14:23 RECEIVE command 9776 subttl RECEIVE command 9777 9778 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 9779 000463'02 005005 000466' recfdb: flddb. .cmofi,cm%sdh,,,,recfd1 ;[231] 9780 000464'02 000000 000000 9781 000465'02 44 07 0 00 002242' 9782 000466'02 010005 000000 recfd1: flddb. .cmcfm,cm%sdh,, 9783 000467'02 000000 000000 9784 000470'02 44 07 0 00 002251' 9785 000471'02 010000 000000 reccfm: flddb. .cmcfm 9786 000472'02 000000 000000 9787 retsec ;;Back to where-ever we started from 9788 cleans() 9789 9790 ; Parse a filespec or just confirmation. 9791 9792 002127'01 200 16 0 00 000000# .recv: guide ; First, issue guide word. 9793 002130'01 260 17 0 00 002074* 9794 000473'02 000000000000# 9795 000740'04 151 156 164 157 040 9796 002131'01 201 01 0 00 000000# movei t1, recfdb 9797 002132'01 260 17 0 00 002076* call rfield ; Parse a file spec or a confirm. 9798 002133'01 135 03 0 00 005021' ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 9799 002134'01 302 03 0 00 000005 caie t3, .cmofi ; Is it an input file spec? 9800 002135'01 263 17 0 00 000000 ret ; If not it must be a confirm, so done. 9801 9802 002136'01 202 02 0 00 001205* movem t2, filjfn ; Filespec, so save the JFN, 9803 002137'01 201 01 0 00 000000# movei t1, reccfm ; and parse the confirmation. 9804 002140'01 260 17 0 00 000000* call rflde 9805 002141'01 254 00 0 00 002150' ifskp. ;[193] Confirmed! 9806 002142'01 550 01 0 00 002136* hrrz t1, filjfn ;[193] Load output file JFN 9807 002143'01 260 17 0 00 002005* call isnulj ;[193] Is it NUL:? 9808 002144'01 263 17 0 00 000000 ret ;[193] No, we're done 9809 002145'01 202 01 0 00 002142* movem t1, filjfn ;[193] Stomp in as JFN 9810 002146'01 200 02 0 00 000001 move t2, t1 ;[193] And also for anyone who wants it, downstream 9811 002147'01 263 17 0 00 000000 ret ;[193] Finally get out of here 9812 002150'01 endif. ;[193] End case .CMCFM 9813 9814 ; Parse error handler. 9815 9816 002150'01 337 01 0 00 002145* skipg t1, filjfn ; Release any JFN. 9817 002151'01 254 00 0 00 002156' ifskp. ;[193] Have...something 9818 002152'01 306 01 0 00 377777 cain t1, .nulio ;[193] Special NUL:? 9819 002153'01 254 00 0 00 002156' anskp. ;[193] Yes, that does not need releasing 9820 002154'01 104 00 0 00 000023 RLJFN% 9821 002155'01 320 12 0 00 002156' erjmpr .+1 ;[193] Retrieve and ignore any errors. 9822 002156'01 endif. ;[193] End case releasing a JFN 9823 002156'01 402 00 0 00 002150* setzm filjfn ; Zero the JFN to indicate we don't have one. 9824 002157'01 200 01 0 00 000000# emsg ;[187] Issue our own parse message 9825 002160'01 104 00 0 00 000313 9826 000474'02 000000000000# 9827 000742'04 116 157 164 040 143 9828 002161'01 254 00 0 00 002113* jrst cmder1 ; and get back inside CMD to clean up. 9829 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 41 K20PAR MAC 7-Jun-23 14:23 SHOW command parser 9830 subttl SHOW command parser 9831 9832 remark SHOW keyword table 9833 9834 ; All display routines moved to k20dsp 9835 9836 000475'02 000000 000000 %table(shotab) ;[39] (this whole keyword table) 9837 000476'02 000000# 000000 %key2 ,0 9838 000437'03 141 154 154 000 000 9839 000477'02 000000# 000000* %key2 ,$shday## ;[194] 9840 000440'03 144 141 171 164 151 9841 000500'02 000000# 000000* %key2 ,$shdeb## ;[194] 9842 000442'03 144 145 142 165 147 9843 000501'02 000000# 000000* %key2 ,$shfil## ;[194] 9844 000444'03 146 151 154 145 055 9845 000502'02 000000# 000000* %key2 ,$shinp## ;[160] ;[194] 9846 000446'03 151 156 160 165 164 9847 000503'02 000000# 000000* %key2 ,$shlin## ;[194] 9848 000451'03 154 151 156 145 000 9849 000504'02 000000# 000000* %key2 ,$shmac## ;[77] ;[194] 9850 000452'03 155 141 143 162 157 9851 000505'02 000000# 000000* %key2 ,$shpkt## ;[194] 9852 000454'03 160 141 143 153 145 9853 000506'02 000000# 000000* %keyf3 ,$stat##, cm%inv ;[186] Tom gets sleepy... 9854 000457'03 002000 000001 9855 000460'03 163 164 141 164 151 9856 000507'02 000000# 000000* %key2 ,$shtim## ;[194] 9857 000463'03 164 151 155 151 156 9858 000510'02 000000# 000000* %key2 ,$shver## ;[194] 9859 000466'03 166 145 162 163 151 9860 000475'02 000013 000013 %tbend 9861 9862 remark SHOW command parser 9863 9864 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 9865 000511'02 000004 000514' shomac: flddb. .cmkey,,mactab,,,shofdb 9866 000512'02 000000000000# 9867 000513'02 44 07 0 00 002260' 9868 000514'02 000006 000520' shofdb: flddb. .cmkey,,shotab,,,shcnfm 9869 000515'02 000000 000475' 9870 000516'02 44 07 0 00 002262' 9871 000517'02 44 07 0 00 002265' 9872 000520'02 010004 000000 shcnfm: flddb. .cmcfm,,, ;[201] Macros and allow confirm 9873 000521'02 000000 000000 9874 000522'02 44 07 0 00 002266' 9875 retsec ;;Back to where-ever we started from 9876 cleans() 9877 9878 002162'01 554 04 0 00 000000* .show: hlrz t4, mactab ;[201] Load count of items (macros) in table 9879 002163'01 326 04 0 00 002170' ife. t4 ;[201] No macros defined? 9880 002164'01 200 16 0 00 000000# guide ; SHOW command 9881 002165'01 260 17 0 00 002130* 9882 000523'02 000000000000# 9883 000745'04 160 141 162 141 155 9884 002166'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 15:18 11-Jun-23 Page 41-1 K20PAR MAC 7-Jun-23 14:23 SHOW command parser 9885 002167'01 254 00 0 00 002173' else. ;[201] Otherwise, could select a macro 9886 002170'01 200 16 0 00 000000# guide ;[201] 9887 002171'01 260 17 0 00 002165* 9888 000524'02 000000000000# 9889 000750'04 160 141 162 141 155 9890 002172'01 201 01 0 00 000000# movei t1, shomac ;[201] Either macro or parameter 9891 002173'01 endif. ;[201] 9892 002173'01 260 17 0 00 002132* call rfield ;[201] Try to parse something 9893 002174'01 135 04 0 00 005021' ldb t4, [pointr (.cmfnp(t3),cm%fnc)] ;[201] Get function code. 9894 002175'01 302 04 0 00 000010 caie t4, .cmcfm ;[201] Was this a confirm? 9895 002176'01 254 00 0 00 002203' ifskp. ;[201] It was, so 9896 002177'01 400 02 0 00 000000 setz t2, ;[201] Load talisman for all 9897 002200'01 124 02 0 00 001426* dmovem t2, pars2 ;[201] Save tweaked parse results 9898 002201'01 202 04 0 00 002114* movem t4, pars4 ;[201] Also the function code 9899 002202'01 254 00 0 00 002206' else. ;[201] No, so tie off the line 9900 002203'01 124 02 0 00 002200* dmovem t2, pars2 ;[201] Save raw parse results 9901 002204'01 202 04 0 00 002201* movem t4, pars4 ;[201] Also the function code 9902 002205'01 260 17 0 00 002125* confrm ;[201] Does not modify t1, t2, t3, t4 9903 002206'01 endif. ;[201] End case line not confirmed 9904 9905 002206'01 263 17 0 00 000000 ret 9906 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 42 K20PAR MAC 7-Jun-23 14:23 SHOW command semantic action driver 9907 subttl SHOW command semantic action driver 9908 9909 002207'01 474 01 0 00 000000 $show: seto t1, ;[201] Assume showing macros 9910 002210'01 120 02 0 00 002203* dmove t2, pars2 ;[201] Load raw (or tweaked) results 9911 002211'01 200 04 0 00 002204* move t4, pars4 ;[201] and the function code 9912 9913 002212'01 302 04 0 00 000010 caie t4, .cmcfm ;[201] Just a confirm? 9914 002213'01 254 00 0 00 002216' ifskp. ;[201] Yes, phony that up 9915 002214'01 403 01 0 00 000002 setzb t1, t2 ;[201] Say a keyword from parameter table 9916 002215'01 254 00 0 00 002223' else. ;[201] No, let's look a little further 9917 002216'01 621 03 0 00 777777 tlz t3, -1 ;[201] Stomp given address 9918 002217'01 302 03 0 00 000000# caie t3, shofdb ;[201] Wanted to show a parameter? 9919 002220'01 254 00 0 00 002223' anskp. ;[201] No, a macro 9920 002221'01 550 02 0 02 000000 hrrz t2, (t2) ;[201] Pick up the key table entry data 9921 002222'01 400 01 0 00 000000 setz t1, ;[201] Flag that it is a parameter 9922 002223'01 endif. ;[201] End case keyword table decode 9923 9924 002223'01 326 01 0 00 002233' ife. t1 ;[201] Was this a parameter? 9925 002224'01 326 02 0 00 002227' ife. t2 ;[201] All (or confirm)? 9926 002225'01 515 05 0 00 600000 hrlzi q1,() ;[201] Never return from each one 9927 002226'01 254 00 0 00 000000* callret $shtop## ;[201] Start from the top and do all 9928 002227'01 endif. ;[201] End case All or Confirm 9929 002227'01 200 05 0 00 005033' move q1, [ret] ;[201] A single item, so return after it 9930 002230'01 561 01 0 00 001351* hrroi t1, crlf ;[39] Single SHOW item. 9931 002231'01 104 00 0 00 000076 PSOUT% ;[201] Emit blank line, 9932 002232'01 254 00 0 02 000000 jrst (t2) ;[39] then go show the requested stuff. 9933 002233'01 endif. ;[201] 9934 9935 002233'01 200 01 0 00 000000# txmsg < > ;[201] Space over twice 9936 002234'01 104 00 0 00 000076 9937 002235'01 320 12 0 00 002236' 9938 000525'02 000000000000# 9939 000754'04 040 040 000 000 000 9940 002236'01 564 01 0 02 000000 hlro t1, (t2) ;[201] Point to macro name. 9941 002237'01 104 00 0 00 000076 PSOUT% ;[201] Print it. 9942 002240'01 200 01 0 00 000000# txmsg < = > ;[201] Show equivalence 9943 002241'01 104 00 0 00 000076 9944 002242'01 320 12 0 00 002243' 9945 000526'02 000000000000# 9946 000755'04 040 075 040 000 000 9947 002243'01 560 01 0 02 000000 hrro t1, (t2) ;[201] Point to body of macro 9948 002244'01 104 00 0 00 000076 PSOUT% ;[201] Print that 9949 002245'01 260 17 0 00 000000* call ifcrlf ;[201] Maybe do a CRLF 9950 9951 002246'01 263 17 0 00 000000 ret ;[201] Finally done 9952 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 43 K20PAR MAC 7-Jun-23 14:23 TAKE command parsing 9953 subttl TAKE command parsing 9954 9955 ; Default command filespec fields for .CMFIL: 9956 9957 chgsec(code,const) ;;FDB's are not in code, they're in const 9958 000527'02 100000 000000 defbk: gj%old ; Must be existing file. 9959 repeat 4,<0> ; Normal defaults for dev:name. 9960 000530'02 000000 000000 9961 000531'02 000000 000000 9962 000532'02 000000 000000 9963 000533'02 000000 000000 9964 000534'02 000000000000# cascii () ; Default extension is .CMD. 9965 000756'04 103 115 104 000 000 9966 000535'02 000000000000# 0 ; Default protection, 9967 000536'02 000000 000000 0 ; and account. 9968 000010 defbkl==<.-defbk> ; Length of this GTJFN argument block. 9969 9970 000537'02 006000 000000 takfdb: flddb. .cmfil 9971 000540'02 000000 000000 9972 retsec ;;Back to where-ever we started from 9973 9974 002247'01 200 01 0 00 005150' .take: movx t1, cz%ncl!.fhslf ; Release non-open jfn's. 9975 002250'01 104 00 0 00 000034 CLZFF 9976 002251'01 200 16 0 00 000000# guide 9977 002252'01 260 17 0 00 002171* 9978 000541'02 000000000000# 9979 000757'04 143 157 155 155 141 9980 002253'01 200 01 0 00 005151' move t1, [defbk,,cjfnbk] ; Insert our file parsing defaults. 9981 002254'01 251 01 0 00 000000# blt t1, cjfnbk+defbkl 9982 002255'01 201 01 0 00 000000# movei t1, takfdb 9983 002256'01 260 17 0 00 001234* call cfield 9984 002257'01 202 02 0 00 002210* movem t2, pars2 ; Here's the JFN just parsed. 9985 002260'01 263 17 0 00 000000 ret 9986 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 44 K20PAR MAC 7-Jun-23 14:23 TAKE command semantic action 9987 subttl TAKE command semantic action 9988 9989 ; added as edit 78. 9990 9991 002261'01 200 01 0 00 000061* $take: move t1, takdep ; How deep are we? 9992 002262'01 307 01 0 00 000024 caig t1, takel ;[194] Too deep? 9993 002263'01 254 00 0 00 002267' ifskp. ;[194] Indeed 9994 002264'01 200 01 0 00 000000# emsg ;[187] 9995 002265'01 104 00 0 00 000313 9996 000542'02 000000000000# 9997 000763'04 124 101 113 105 040 9998 002266'01 263 17 0 00 000000 ret ;[194] don't do it. 9999 002267'01 endif. ;[194] 10000 002267'01 200 01 0 00 000000* move t1, takjfn ; There's room, get current TAKE file jfn. 10001 002270'01 200 02 0 00 000000* move t2, takep ; Push it on the stack 10002 002271'01 261 02 0 00 000001 push t2, t1 ; ... 10003 002272'01 202 02 0 00 002270* movem t2, takep ; ... 10004 002273'01 350 00 0 00 002261* aos takdep ; Remember what level we're on. 10005 10006 002274'01 200 01 0 00 002257* move t1, pars2 ; Get JFN that was parsed 10007 002275'01 202 01 0 00 002267* movem t1, takjfn ; ... 10008 002276'01 200 02 0 00 005152' movx t2, fld(7,of%bsz)!of%rd ; 7-bit i/o, read access. 10009 002277'01 104 00 0 00 000021 OPENF 10010 002300'01 320 12 0 00 002302' %jserr (,$takex) 10011 002301'01 254 00 0 00 002305' 10012 002302'01 265 01 0 00 002045* 10013 002303'01 000000 000000 10014 002304'01 254 00 0 00 002306' 10015 002305'01 254 00 0 00 000000* callret setcsb ; Opened OK, go set up command state block. 10016 10017 ; Error opening command file. 10018 10019 002306'01 260 17 0 00 002320' $takex: call popjfn ; Remove offending JFN from TAKE stack. 10020 002307'01 604 00 0 00 000000 ifnsk. ;[194] 10021 002310'01 254 00 0 00 002314' 10022 002311'01 200 01 0 00 000000# emsg ;[187] 10023 002312'01 104 00 0 00 000313 10024 000543'02 000000000000# 10025 000772'04 124 101 113 105 040 10026 002313'01 263 17 0 00 000000 ret 10027 002314'01 endif. ;[194] 10028 10029 002314'01 200 01 0 00 005150' movx t1, cz%ncl!.fhslf ; Release extraneous JFNs. 10030 002315'01 104 00 0 00 000034 CLZFF 10031 002316'01 320 16 0 00 002317' erjmp .+1 10032 002317'01 263 17 0 00 000000 ret 10033 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 45 K20PAR MAC 7-Jun-23 14:23 POPJFN 10034 subttl POPJFN 10035 10036 ; Routine to pop a command file JFN off the JFN stack. 10037 ; 10038 ; Enter with current command file jfn in TAKJFN. 10039 ; 10040 ; Returns: 10041 ; +1 if stack empty, 10042 ; +2 otherwise, with popped jfn in TAKJFN. 10043 10044 002320'01 popjfn: entry popjfn ; Also found in K20IOC 10045 002320'01 337 00 0 00 002273* skipg takdep ; Back at top level? 10046 002321'01 263 17 0 00 000000 ret ; Yes, return silently. 10047 10048 ; Close current command file. 10049 10050 002322'01 337 01 0 00 002275* skipg t1, takjfn ;[209] Load the JFN (if there is one) 10051 002323'01 254 00 0 00 002336' ifskp. ;[209] There is, so let's get on with it 10052 002324'01 402 00 0 00 002322* setzm takjfn ;[209] Stomp it, no matter what 10053 002325'01 621 01 0 00 777777 tlz t1, -1 ;[209] Whack any flags 10054 002326'01 306 01 0 00 377777 cain t1, .nulio ;[209] This kind of confusion?? 10055 002327'01 254 00 0 00 002336' anskp. ;[209] Actually, yes, so don't bother 10056 002330'01 104 00 0 00 000022 CLOSF ;[209] Real enough; close it 10057 002331'01 320 12 0 00 002333' %jserr (,) ; Just print message on error. 10058 002332'01 254 00 0 00 002336' 10059 002333'01 265 01 0 00 002302* 10060 002334'01 000000 000000 10061 002335'01 254 00 0 00 002336' 10062 002336'01 endif. ;[209] Either way, carry on 10063 10064 ; Return to previous one. 10065 10066 002336'01 200 02 0 00 002272* move t2, takep ; Get the TAKE stack pointer 10067 002337'01 262 02 0 00 000001 pop t2, t1 ; and the previous TAKE file JFN, 10068 002340'01 202 02 0 00 002336* movem t2, takep ; restore them, 10069 002341'01 202 01 0 00 002324* movem t1, takjfn ; ... 10070 002342'01 260 17 0 00 002305* call setcsb ; and also restore the command state block. 10071 002343'01 370 00 0 00 002320* sos takdep ; Decrement the depth indicator 10072 002344'01 254 00 0 00 002072* retskp ; Return successfully. 10073 10074 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 46 K20PAR MAC 7-Jun-23 14:23 Process initialization file. 10075 subttl Process initialization file. 10076 10077 ;[79] INIFIL added 10078 ; 10079 ;[85] Returns +1 if there was no init file, +2 if there was. 10080 ; 10081 ;[220] Rewritten to not assume PS: is the login structure 10082 ; Also unrolled the loop (prior to maybe redoing with movslj) 10083 10084 remark 1 2 3 4 5 10085 002345'01 456132 246622 kerini: byte (7) "K","E","R","M","I" 10086 002346'01 521351 147222 byte (7) "T",".","I","N","I" 10087 10088 002347'01 inifil: entry inifil ;[220] Invoked by k20mit 10089 002347'01 265 16 0 00 005036' saveac ;[220] Needs an index variable 10090 002350'01 265 16 0 00 000000* anstkv (q1,dirmxw) ;[220] Allocate space for login directory 10091 002351'01 000000 000012 10092 002352'01 415 05 0 17 777765 10093 10094 002353'01 560 01 0 00 000005 hrro t1, q1 ;[220] Build Tops-20 pointer to stack 10095 002354'01 200 02 0 00 000000# move t2, .jilno+jobtab ;[220] Job's logged in directory number 10096 002355'01 104 00 0 00 000041 DIRST% ;[220] Build the entire directory 10097 002356'01 320 12 0 00 002360' %jserr (,r) ;[220] Punt 10098 002357'01 254 00 0 00 002363' 10099 002360'01 265 01 0 00 002333* 10100 002361'01 000000000000# 10101 002362'01 254 00 0 00 002047* 10102 001000'04 125 156 141 142 154 10103 10104 002363'01 120 03 0 00 002345' dmove t3, kerini ;[220] Load file name 10105 repeat ^d5,< ;;[220] Do the first word 10106 lshc t2, ^d7 ;;[220] Load a character in t2 10107 idpb t2, t1 ;;[220] Append to directory specification 10108 > ;;[220] End of first word 10109 002364'01 246 02 0 00 000007 10110 002365'01 136 02 0 00 000001 10111 002366'01 246 02 0 00 000007 10112 002367'01 136 02 0 00 000001 10113 002370'01 246 02 0 00 000007 10114 002371'01 136 02 0 00 000001 10115 002372'01 246 02 0 00 000007 10116 002373'01 136 02 0 00 000001 10117 002374'01 246 02 0 00 000007 10118 002375'01 136 02 0 00 000001 10119 10120 repeat ^d5,< ;;[220] Do the second word 10121 lshc t3, ^d7 ;;[220] Load a character in t3 10122 idpb t3, t1 ;;[220] Append to directory specification 10123 > ;;[220] End of first word 10124 002376'01 246 03 0 00 000007 10125 002377'01 136 03 0 00 000001 10126 002400'01 246 03 0 00 000007 10127 002401'01 136 03 0 00 000001 10128 002402'01 246 03 0 00 000007 10129 002403'01 136 03 0 00 000001 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 46-1 K20PAR MAC 7-Jun-23 14:23 Process initialization file. 10130 002404'01 246 03 0 00 000007 10131 002405'01 136 03 0 00 000001 10132 002406'01 246 03 0 00 000007 10133 002407'01 136 03 0 00 000001 10134 10135 002410'01 400 03 0 00 000000 setz t3, ;[220] Cons up a zero 10136 002411'01 136 03 0 00 000001 idpb t3, t1 ;[220] Tie off the file specification 10137 10138 002412'01 205 01 0 00 100001 movx t1, gj%old!gj%sht ;[220] Existing file, only 10139 002413'01 560 02 0 00 000005 hrro t2, q1 ;[220] Build Tops-20 pointer to completed specification 10140 002414'01 104 00 0 00 000020 GTJFN% ;[220] Get JFN on it. 10141 002415'01 320 12 0 00 002362* erjmpr r ;[220] If we can't, return silently. 10142 002416'01 552 01 0 00 002274* hrrzm t1, pars2 ; Got one, pretend we parsed it. 10143 002417'01 476 00 0 00 000000* setom iniflg ;[83] Flag that we're doing init file. 10144 002420'01 260 17 0 00 002261' call $take ; Go TAKE the file. 10145 002421'01 254 00 0 00 002344* retskp ;[85] 10146 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 47 K20PAR MAC 7-Jun-23 14:23 SEND command 10147 subttl SEND command 10148 10149 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 10150 000544'02 006004 000000 sndfdb: flddb. .cmfil,,,,, 10151 000545'02 000000 000000 10152 000546'02 44 07 0 00 002273' 10153 000547'02 010004 000552' sasfdb: flddb. .cmcfm,,,,,sasfd1 10154 000550'02 000000 000000 10155 000551'02 44 07 0 00 002302' 10156 000552'02 021004 000555' sasfd1: flddb. .cmqst,,,,,sasfd2 10157 000553'02 000000 000000 10158 000554'02 44 07 0 00 002307' 10159 000555'02 017004 000000 sasfd2: flddb. .cmtxt,,, 10160 000556'02 000000 000000 10161 000557'02 44 07 0 00 002307' 10162 000560'02 010004 000563' saifdb: flddb. .cmcfm,,,,,saifd1 10163 000561'02 000000 000000 10164 000562'02 44 07 0 00 002321' 10165 000563'02 006004 000000 saifd1: flddb. .cmfil,,, 10166 000564'02 000000 000000 10167 000565'02 44 07 0 00 002325' 10168 000566'02 010000 000000 sndcfm: flddb. .cmcfm 10169 000567'02 000000 000000 10170 retsec ;;Back to where-ever we started from 10171 cleans() 10172 10173 002422'01 200 16 0 00 000000# .send: guide ; Issue guide words. 10174 002423'01 260 17 0 00 002252* 10175 000570'02 000000000000# 10176 001010'04 146 162 157 155 040 10177 002424'01 200 02 0 00 000000# move t2, cjfnbk+.gjgen ; Get the JFN flag bits. 10178 002425'01 661 02 0 00 100100 txo t2, gj%ifg!gj%old ; Old file(s), allow wild cards. 10179 002426'01 620 02 0 00 777777 trz t2, -1 ;[172] Default to most recent generation only. 10180 002427'01 202 02 0 00 000000# movem t2, cjfnbk+.gjgen ; Return the JFN flag bits. 10181 002430'01 402 00 0 00 000000# setzm cjfnbk+.gjext ;[172] No default extension. 10182 10183 002431'01 201 01 0 00 000000# movei t1, sndfdb 10184 002432'01 260 17 0 00 002173* call rfield ; Parse a file spec or a confirm. 10185 002433'01 200 01 0 00 000002 move t1, t2 ;[193] Position the JFN 10186 002434'01 260 17 0 00 002143* call isnulj ;[193] Find out if it's NUL: 10187 002435'01 600 00 0 00 000000 nop ;[193] No, it isn't, but we don't care 10188 002436'01 202 01 0 00 002416* movem t1, pars2 ;[193] 10189 10190 002437'01 603 01 0 00 770000 ifxe. t1, gj%wld ;[193] Any wildcards in it? 10191 002440'01 254 00 0 00 002445' 10192 002441'01 200 16 0 00 000000# guide ;[96] No, then let them choose a new name. 10193 002442'01 260 17 0 00 002423* 10194 000571'02 000000000000# 10195 001013'04 141 163 000 000 000 10196 002443'01 201 01 0 00 000000# movei t1, sasfdb 10197 002444'01 254 00 0 00 002450' else. ;[194] Otherwise, something was wildcarded 10198 002445'01 200 16 0 00 000000# guide ; prompt for initial. 10199 002446'01 260 17 0 00 002442* 10200 000572'02 000000000000# 10201 001014'04 151 156 151 164 151 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 47-1 K20PAR MAC 7-Jun-23 14:23 SEND command 10202 002447'01 201 01 0 00 000000# movei t1, saifdb 10203 002450'01 endif. ;[194] 10204 10205 002450'01 260 17 0 00 002140* call rflde ; Parse the field. 10206 002451'01 254 00 0 00 002505' jrst .sende ;[63] Handle errors explicitly. 10207 002452'01 135 03 0 00 005021' ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 10208 002453'01 306 03 0 00 000021 cain t3, .cmqst ;[208] Quoted string? 10209 002454'01 201 03 0 00 000017 movei t3, .cmtxt ;[208] Pretend it's text (because it is) 10210 002455'01 202 03 0 00 002010* movem t3, pars3 ;[96] Save it for execution. 10211 10212 002456'01 306 03 0 00 000010 cain t3, .cmcfm ; Confirmation? 10213 002457'01 263 17 0 00 000000 ret ; Yes, just return. 10214 10215 002460'01 302 03 0 00 000006 caie t3, .cmfil ;[96] File? 10216 002461'01 254 00 0 00 002473' ifskp. ;[194] Yes 10217 002462'01 200 01 0 00 000002 move t1, t2 ;[193] Position the JFN 10218 002463'01 260 17 0 00 002434* call isnulj ;[193] Find out if it's NUL: 10219 002464'01 334 00 0 00 000000 skipa ;[193] No, it isn't, but we don't care 10220 002465'01 200 02 0 00 000001 move t2, t1 ;[193] Reposition so stored properly 10221 002466'01 542 02 0 00 002436* hrrm t2, pars2 ;[117] Initial filespec - substitute it. 10222 002467'01 201 01 0 00 000000# movei t1, sndcfm ; Get command confirmation. 10223 002470'01 260 17 0 00 002450* call rflde 10224 002471'01 254 00 0 00 002505' jrst .sende ;[194] Didn't confirm, parse error 10225 002472'01 263 17 0 00 000000 ret 10226 002473'01 endif. ;[194] 10227 10228 ;[96] If they gave an alternate name, copy it out of the atom buffer. 10229 10230 002473'01 302 03 0 00 000017 caie t3, .cmtxt ; Text? 10231 002474'01 254 00 0 00 002505' jrst .sende ; No, error. 10232 ; Copy the string out of the atom buffer. 10233 dmove t1, [point 7, atmbuf 10234 002475'01 120 01 0 00 005153' point 7, buffer] 10235 002476'01 402 00 0 00 001227* setzm buffer 10236 002477'01 260 17 0 00 000000* call movstu 10237 002500'01 326 03 0 00 002503' ife. t3 ;[194] If nothing, act like we parsed a confirm. 10238 002501'01 201 03 0 00 000010 movei t3, .cmcfm 10239 002502'01 202 03 0 00 002455* movem t3, pars3 10240 002503'01 endif. ;[194] 10241 002503'01 260 17 0 00 002205* confrm ;[208] And tie off the line 10242 002504'01 263 17 0 00 000000 ret 10243 10244 002505'01 333 01 0 00 002156* .sende: skiple t1, filjfn ;[194] Error - get the JFN. 10245 002506'01 104 00 0 00 000023 RLJFN% ; Release it. 10246 002507'01 320 12 0 00 002510' erjmpr .+1 ;[194] Catch and ignore any errors. 10247 002510'01 402 00 0 00 002505* setzm filjfn ; Nullify the JFN. 10248 002511'01 200 01 0 00 000000# emsg 10249 002512'01 104 00 0 00 000313 10250 000573'02 000000000000# 10251 001016'04 116 157 164 040 143 10252 002513'01 254 00 0 00 002161* jrst cmder1 10253 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 48 K20PAR MAC 7-Jun-23 14:23 SERVER command 10254 subttl SERVER command 10255 10256 002514'01 260 17 0 00 002503* .serve: confrm ; Confirm. 10257 002515'01 263 17 0 00 000000 ret 10258 10259 remark Execute the SERVER command. 10260 10261 ;[144] Remove test for remote mode operation. KERMIT-20 works fine as 10262 ; a server over an assigned line, although the messages may look a bit 10263 ; strange. 10264 10265 002516'01 $serve: extern getcom 10266 002516'01 260 17 0 00 000000* call getcom ; Go serve. 10267 ;[137] setzm f$exit ;[110] Return to command mode if they ^C out. 10268 002517'01 263 17 0 00 000000 ret 10269 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 49 K20PAR MAC 7-Jun-23 14:23 CONNECT command, kind of like SET LINE 10270 subttl CONNECT command, kind of like SET LINE 10271 10272 ;N.B., Remove abbreviation if we ever do pipes 10273 10274 000574'02 000000 000000 %table(pseutb) ;[186] 10275 000575'02 000000# 000576' %keyf3

, %pseud, 10276 000470'03 002000 000005 10277 000471'03 160 000 000 000 000 10278 ; %key2 , .dvpip ;[186] Loopback to same job (subfork) 10279 000576'02 000000# 000013 %pseud: %key2 , .dvpty ;[186] Loopback to another job 10280 000472'03 160 163 145 165 144 10281 000577'02 000000# 000013 %keyf3 , .dvpty, cm%inv ;[186] another way of saying pseudo 10282 000476'03 002000 000001 10283 000477'03 160 164 171 000 000 10284 000574'02 000003 000003 %tbend ;[186] 10285 10286 cleans(<%pseud>) ;;Clean up working symbol 10287 10288 000600'02 000000 000000 %table(mantab) ;[205] 10289 000601'02 000000# 000015 %key2 ,.dvnul ;[205] Close open connection (if open) 10290 000500'03 143 154 157 163 145 10291 000602'02 000000# 777774 %key2 ,.fhinf ;[205] Clobber terminal fork 10292 000502'03 153 151 154 154 000 10293 000600'02 000002 000002 %tbend ;[205] 10294 10295 000603'02 000000 000000 %table(conswi) ;[205] 10296 000604'02 000000# 777777 %key2 ,-1 ;[205] Don't create (or resume) transfer fork 10297 000503'03 163 164 141 171 000 10298 000605'02 000000# 000610' %keyf3 , %tim, ;[218] 10299 000504'03 002000 000005 10300 000505'03 164 000 000 000 000 10301 000606'02 000000# 000610' %keyf3 , %tim, ;[218] 10302 000506'03 002000 000005 10303 000507'03 164 151 000 000 000 10304 000607'02 000000# 000610' %keyf3 , %tim, ;[218] 10305 000510'03 002000 000005 10306 000511'03 164 151 155 000 000 10307 000610'02 000000# 000000 %tim: %key2 ,0 ;[218] Override default timeout 10308 000512'03 164 151 155 145 157 10309 000611'02 000000# 000000 %keyf3 , 0, cm%inv ;[218] Another way I mistype this 10310 000514'03 002000 000001 10311 000515'03 164 151 155 157 165 10312 000603'02 000006 000006 %tbend ;[205] 10313 10314 cleans(<%tim>) ;;Clean up working symbol 10315 10316 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 10317 000612'02 001004 000615' confdb: flddb. .cmnum,,^d8,,,confd1 10318 000613'02 000000 000010 10319 000614'02 44 07 0 00 002334' 10320 000615'02 000004 000620' confd1: flddb. .cmkey,,pseutb,,,confd2 10321 000616'02 000000 000574' 10322 000617'02 44 07 0 00 002344' 10323 000620'02 000004 000623' confd2: flddb. .cmkey,,mantab,,,confd3 10324 000621'02 000000 000600' k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 49-1 K20PAR MAC 7-Jun-23 14:23 CONNECT command, kind of like SET LINE 10325 000622'02 44 07 0 00 002353' 10326 000623'02 026044 000626' confd3: flddb. .cmnod,cm%nsf,,,,confd4 10327 000624'02 000000 000000 10328 000625'02 44 07 0 00 002361' 10329 000626'02 010004 000000 confd4: flddb. .cmcfm,,, 10330 000627'02 000000 000000 10331 000630'02 44 07 0 00 002366' 10332 000631'02 003000 000633' cswfdb: flddb. .cmswi,,conswi,,,cswfd1 10333 000632'02 000000 000603' 10334 000633'02 010004 000000 cswfd1: flddb. .cmcfm,,, ;[218] 10335 000634'02 000000 000000 10336 000635'02 44 07 0 00 002376' 10337 000636'02 013005 000641' scmfdb: flddb. .cmcma,cm%sdh,,,,scmfd1 10338 000637'02 000000 000000 10339 000640'02 44 07 0 00 002404' 10340 000641'02 010000 000000 scmfd1: flddb. .cmcfm 10341 000642'02 000000 000000 10342 retsec ;;Back to where-ever we started from 10343 cleans() 10344 10345 002520'01 476 00 0 00 002502* .conne: setom pars3 ;[186] Let's assume parsing fails 10346 002521'01 476 00 0 00 002211* setom pars4 ;[186] Fails completely, actually 10347 002522'01 402 00 0 00 000223* setzm pars5 ;[205] Assume not staying home 10348 002523'01 402 00 0 00 000224* setzm pars6 ;[218] Assume not overriding timeout 10349 10350 002524'01 200 16 0 00 000000# guide 10351 002525'01 260 17 0 00 002446* 10352 000643'02 000000000000# 10353 001021'04 164 157 040 164 164 10354 remark ;[205] Don't reorder the flddb.'s! 10355 002526'01 201 01 0 00 000000# movei t1, confdb 10356 002527'01 260 17 0 00 002432* call rfield ; Parse a tty number. 10357 002530'01 135 04 0 00 005021' ldb t4, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 10358 10359 002531'01 265 16 0 00 005104' .conn1: saveac ;[205] Needs another temporary 10360 002532'01 265 16 0 00 002350* anstkv (q2,^d4) ;[205] Copy of node name, if parsed 10361 002533'01 000000 000004 10362 002534'01 415 06 0 17 777773 10363 10364 002535'01 306 04 0 00 000000 cain t4, .cmkey ;[186] Any kind of keyword has a device type 10365 002536'01 550 05 0 02 000000 hrrz t5, (t2) ;[186] Get the requested device type 10366 002537'01 306 04 0 00 000026 cain t4, .cmnod ;[186] Parsed a node? 10367 002540'01 201 05 0 00 000022 movei t5, .dvdcn ;[186] Force DECnet client 10368 002541'01 306 04 0 00 000001 cain t4, .cmnum ;[186] Is it a number? 10369 002542'01 200 05 0 00 000002 move t5, t2 ;[186] Put in the terminal line number 10370 10371 002543'01 302 04 0 00 000010 caie t4, .cmcfm ;[186] Just gave us a confirm? 10372 002544'01 254 00 0 00 002547' ifskp. ;[186] That's fine, means reconnect 10373 002545'01 124 04 0 00 002520* dmovem t4, pars3 ;[186] Store parse type and device type or unit 10374 002546'01 263 17 0 00 000000 ret ;[186] Done with parse 10375 002547'01 endif. 10376 002547'01 332 00 0 00 002105* skipe definf ;[205] Not in a DEFINE? 10377 002550'01 254 00 0 00 002612' jrst .conn2 ;[205] No, we are; so go get cute with that 10378 ;[205] Store 20 characters of atom buffer 10379 002551'01 120 01 0 00 001672* dmove t1, atmbuf ;[205] Load first ten characters of the atom buffer k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 49-2 K20PAR MAC 7-Jun-23 14:23 CONNECT command, kind of like SET LINE 10380 002552'01 124 01 0 06 000000 dmovem t1, 0(q2) ;[205] Tuck them away 10381 002553'01 120 01 0 00 000000# dmove t1, atmbuf+2 ;[205] Next ten characters of the atom buffer 10382 002554'01 124 01 0 06 000002 dmovem t1, 2(q2) ;[205] Tuck those away 10383 10384 002555'01 do. ;[218] Enter loop context to parse switches 10385 002555'01 201 01 0 00 000000# movei t1, cswfdb 10386 002556'01 260 17 0 00 002527* call rfield ;[218] Parse something 10387 002557'01 135 03 0 00 005021' ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 10388 002560'01 306 03 0 00 000010 cain t3, .cmcfm ;[218] Finally confirmed? 10389 002561'01 254 00 0 00 002603' exit. ;[218] Yes, break out of the loop 10390 002562'01 570 01 0 02 000000 hrre t1, (t2) ;[218] Pick up the switch value 10391 002563'01 325 01 0 00 002566' ifl. t1 ;[218] Negative?? 10392 002564'01 476 00 0 00 002522* setom pars5 ;[218] Flag connection to stay at Kermit command level 10393 002565'01 254 00 0 00 002555' loop. ;[218] Go get some more goodies 10394 002566'01 endif. ;[218] End case /stay switch 10395 002566'01 415 16 0 00 002602' block. ;[218] Will need a stack frame 10396 002567'01 261 17 0 00 000016 10397 002570'01 265 16 0 00 005155' saveac ;[218] Needs some registers (also, see ret below) 10398 002571'01 120 05 0 00 002521* dmove q1, pars4 ;[218] Save whatever might already be parsed 10399 002572'01 200 07 0 00 002547* move q3, definf ;[218] Save the define context 10400 002573'01 476 00 0 00 002572* setom definf ;[218] Stomp, so it doesn't parse a confirm 10401 002574'01 260 17 0 00 004643' call .setim ;[218] Parse a floating point time 10402 002575'01 200 01 0 00 002571* move t1, pars4 ;[218] Load computed milliseconds 10403 002576'01 202 01 0 00 002523* movem t1, pars6 ;[218] Hand it off to waitcn 10404 002577'01 124 05 0 00 002575* dmovem q1, pars4 ;[218] Store what might allready be parsed 10405 002600'01 202 07 0 00 002573* movem q3, definf ;[218] Restore whatever the define context was 10406 002601'01 263 17 0 00 000000 endbk. ;[218] End block context, restore registers 10407 002602'01 254 00 0 00 002555' loop. ;[218] Restored q1,q2,q3 and loop 10408 002603'01 enddo. ;[218] End of loop lexical context 10409 10410 002603'01 120 01 0 06 000000 dmove t1, 0(q2) ;[205] Load ten characters of the saved atom buffer 10411 002604'01 124 01 0 00 002551* dmovem t1, atmbuf ;[205] And put them back 10412 002605'01 120 01 0 06 000002 dmove t1, 2(q2) ;[205] Next ten characters of the saved atom buffer 10413 002606'01 124 01 0 00 000000# dmovem t1, atmbuf+2 ;[205] And put those back 10414 002607'01 402 00 0 00 000000# setzm atmbuf+5 ;[205] Make sure string is tied off 10415 10416 002610'01 124 04 0 00 002545* dmovem t4, pars3 ;[186] Store parse type and device type or unit 10417 002611'01 263 17 0 00 000000 ret 10418 10419 002612'01 .conn2: remark ;[205] Handle /stay in a define 10420 002612'01 124 04 0 00 002610* dmovem t4, pars3 ;[186] Store parse type and device type or unit 10421 002613'01 263 17 0 00 000000 ret 10422 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 50 K20PAR MAC 7-Jun-23 14:23 SET command 10423 subttl SET command 10424 10425 ;[77] Parse SET command. (This routine rewritten for edit 77.) 10426 10427 extern mactab ;[203] Macro table is in K20MAC 10428 10429 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 10430 000644'02 000004 000647' sfdb1: flddb. .cmkey,,mactab,,,sfdb2 10431 000645'02 000000000000# 10432 000646'02 44 07 0 00 002131' 10433 000647'02 000000 000000 sfdb2: flddb. .cmkey,,settab 10434 000650'02 000000 000651' 10435 retsec ;;Back to where-ever we started from 10436 10437 002614'01 554 02 0 00 002162* .set: hlrz t2, mactab ; Anything in macro table? 10438 002615'01 322 02 0 00 002624' ifn. t2 ;[194] If so, include them too. 10439 002616'01 332 00 0 00 002600* skipe definf ; Unless we're defining a macro. 10440 002617'01 254 00 0 00 002624' anskp. ;[194] Don't allow recursive definitions! 10441 002620'01 332 00 0 00 000000# skipe mdone ;[203] Not expanding the macro? 10442 002621'01 254 00 0 00 002624' anskp. ;[203] No, we are; so only do keywords 10443 002622'01 201 01 0 00 000000# movei t1, sfdb1 ; Macro table is searched first. 10444 002623'01 254 00 0 00 002625' else. ;[194] No macros or defining one 10445 002624'01 201 01 0 00 000000# movei t1, sfdb2 ; Normal SET command table. 10446 002625'01 endif. ;[194] 10447 002625'01 260 17 0 00 002556* call rfield ; Parse a keyword. 10448 10449 002626'01 .set2: entry .set2 ;[203] Linkage from K20MAC 10450 002626'01 553 00 0 00 000003 hrrzs t3 ; See which function descriptor block was used. 10451 002627'01 302 03 0 00 000000# caie t3, sfdb1 ;[194] The macro table? 10452 002630'01 254 00 0 00 002640' ifskp. ;[194] Indeed 10453 002631'01 550 01 0 02 000000 hrrz t1, (t2) ;[194] Yes, get the data. 10454 002632'01 505 01 0 00 440700 hrli t1, (point 7,) ; This will be a pointer to the macro text. 10455 002633'01 202 01 0 00 002466* movem t1, pars2 ; Save it. 10456 002634'01 260 17 0 00 002514* confrm ; Get confirmation. 10457 002635'01 476 00 0 00 000000# setom macrof ; Set the macro flag. 10458 002636'01 263 17 0 00 000000 ret ; No more to do. 10459 002637'01 254 00 0 00 002641' else. ;[194] Not from macro table 10460 002640'01 402 00 0 00 000000# setzm macrof ; Assume regular SET keyword was parsed. 10461 002641'01 endif. ;[194] End case parsing a macro name 10462 10463 002641'01 550 02 0 02 000000 hrrz t2, (t2) ; Get the command routine addresses. 10464 002642'01 202 02 0 00 002633* movem t2, pars2 ; Save into pars2. 10465 002643'01 554 01 0 02 000000 hlrz t1, (t2) ; Get the next level routine. 10466 002644'01 260 17 0 01 000000 call (t1) ; Call it. 10467 10468 ; If doing a DEFINE, loop through SET commands until CR typed. 10469 10470 002645'01 336 00 0 00 002616* skipn definf ; Doing DEFINE? If so, allow comma here. 10471 002646'01 263 17 0 00 000000 ret 10472 002647'01 201 01 0 00 000000# movei t1, scmfdb 10473 002650'01 260 17 0 00 002625* call rfield 10474 002651'01 135 03 0 00 005021' ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 10475 002652'01 306 03 0 00 000013 cain t3, .cmcma ; Comma? 10476 002653'01 254 00 0 00 002614' jrst .set ; Yes, go back & get another SET parameter. 10477 002654'01 263 17 0 00 000000 ret ; Confirmation, done. k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 50-1 K20PAR MAC 7-Jun-23 14:23 SET command 10478 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 51 K20PAR MAC 7-Jun-23 14:23 SET command action routines. 10479 subttl SET command action routines. 10480 10481 ; SET ... command dispatcher. 10482 10483 002655'01 $set: entry $set ;[194] Maybe move this? 10484 002655'01 332 00 0 00 000000# ifme. macrof ;[203] If no macro used, just do the set 10485 002656'01 254 00 0 00 002663' 10486 002657'01 200 02 0 00 002642* move t2, pars2 ; Get back data value. 10487 002660'01 550 01 0 02 000000 hrrz t1, (t2) ; Get evaluation routine. 10488 002661'01 260 17 0 01 000000 call (t1) ; Call it. 10489 002662'01 263 17 0 00 000000 ret 10490 002663'01 endif. ;[203] 10491 10492 002663'01 200 01 0 00 002657* $set2: move t1, pars2 ; Pointer to macro text (SET operands) 10493 002664'01 202 01 0 00 000000# movem t1, macxp 10494 ;* PSOUT ; echo it for debugging... 10495 002665'01 476 00 0 00 000000# setom mdone ; Say macro not done yet. 10496 10497 ; Loop to copy one set command into the command buffer. 10498 10499 002666'01 201 01 0 00 000000# $set3: movei t1,cmdbln*5 ;[192] Max characters in command buffer 10500 002667'01 202 01 0 00 000000# movem t1,sbk+.cmcnt ;[192] Say it's completely empty 10501 002670'01 402 00 0 00 000000# setzm sbk+.cminc ;[192] No unparsed characters yet 10502 002671'01 200 01 0 00 005167' move t1, [ascii/set /] ; Fake a SET command (don't nul terminate) 10503 002672'01 202 01 0 00 000000* movem t1, cmdbuf 10504 002673'01 201 02 0 00 000004 movei t2, ^d4 ;[192] Characters in "SET " 10505 002674'01 272 02 0 00 000000# addm t2, sbk+.cminc ;[192] Bump count of UNparsed characters 10506 002675'01 211 02 0 00 000004 movni t2, ^d4 ;[192] Characters in "SET " 10507 002676'01 272 02 0 00 000000# addm t2, sbk+.cmcnt ;[192] Reduce remaining space 10508 002677'01 200 02 0 00 005170' move t2, [point 7, cmdbuf, 27] ; Copy them to after "set " 10509 002700'01 202 02 0 00 000000# movem t2, sbk+.cmptr 10510 10511 ; Loop for each character. 10512 10513 ; To do: why are we putting a line feed back into the buffer? 10514 10515 002701'01 $set4: do. ;[203] Enter loop context 10516 002701'01 134 01 0 00 000000# ildb t1, macxp ; Get a character from the macro text 10517 002702'01 306 01 0 00 000015 cain t1, .chcrt ;[192] A carriage return? 10518 002703'01 201 01 0 00 000054 movei t1, "," ;[192] Hi! Guess what, now you're a comma! 10519 002704'01 306 01 0 00 000012 cain t1, .chlfd ;[192] A line feed? 10520 002705'01 254 00 0 00 002701' loop. ;[192] Silently swallow it 10521 002706'01 322 01 0 00 002730' jumpe t1, endlp. ;[192] If null, done. 10522 002707'01 302 01 0 00 000054 caie t1, "," ;[194] A comma? 10523 002710'01 254 00 0 00 002724' ifskp. ;[194] It is 10524 002711'01 201 01 0 00 000015 movei t1, .chcrt ;[194] Substitute a carriage return. 10525 002712'01 136 01 0 00 000002 idpb t1, t2 ;[203] Drop into command buffer 10526 002713'01 350 00 0 00 000000# aos sbk+.cminc ;[203] Account for character in there 10527 002714'01 370 00 0 00 000000# sos sbk+.cmcnt ;[203] Subtract from remaining 10528 002715'01 201 01 0 00 000012 movei t1, .chlfd ; And a linefeed... 10529 002716'01 136 01 0 00 000002 idpb t1, t2 ;[203] Drop that into command buffer, too 10530 002717'01 350 00 0 00 000000# aos sbk+.cminc ;[203] Account for character in there 10531 002720'01 370 00 0 00 000000# sos sbk+.cmcnt ;[203] Subtract from remaining 10532 002721'01 400 01 0 00 000000 setz t1, ; And a null... 10533 002722'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 15:18 11-Jun-23 Page 51-1 K20PAR MAC 7-Jun-23 14:23 SET command action routines. 10534 002723'01 254 00 0 00 002742' jrst $set6 ; Go execute this part of the macro 10535 002724'01 endif. ;[194] 10536 002724'01 136 01 0 00 000002 idpb t1, t2 ; Not a comma, copy the character. 10537 002725'01 350 00 0 00 000000# aos sbk+.cminc ;[192] Account for it in the CSB 10538 002726'01 370 00 0 00 000000# sos sbk+.cmcnt ;[192] and decrement remaining count 10539 002727'01 254 00 0 00 002701' loop. ;[203] And copy some more, wee!! 10540 002730'01 enddo. ;[203] Exit loop lexical context 10541 10542 ; Get here at end of null-terminated macro body. 10543 10544 002730'01 $set5: remark ;[192] Fix the CSB back up 10545 002730'01 200 01 0 00 005171' move t1, [point 7, cmdbuf] ;[192] Point to beginning of command buffer 10546 002731'01 202 01 0 00 000000# movem t1, sbk+.cmptr ;[192] Stomp that in; nothing to parse 10547 002732'01 201 01 0 00 000000# movei t1,cmdbln*5 ;[192] Max characters in command buffer 10548 002733'01 202 01 0 00 000000# movem t1,sbk+.cmcnt ;[192] Say it's completely empty 10549 002734'01 402 00 0 00 000000# setzm sbk+.cminc ;[192] No unparsed characters yet 10550 002735'01 403 01 0 00 000002 setzb t1, t2 ;[192] Cons up ten .CHNUL's 10551 002736'01 124 01 0 00 002672* dmovem t1, cmdbuf ;[192] Scrub the atom buffer an itty bit 10552 002737'01 502 01 0 00 000000* hllm t1, sbk ;[192] Zero the CSB flags. 10553 002740'01 402 00 0 00 000000# setzm mdone ;[192] Flag that we're done interpreting the macro. 10554 002741'01 263 17 0 00 000000 ret ;[192] Get out of here 10555 10556 002742'01 402 00 0 00 000000* $set6: setzm pars1 ;[203] Expanding a macro doesn't hit parse: in 10557 002743'01 200 01 0 00 005172' move t1, [pars1,,pars2] ;[203] the main parsing loop, so we must clean 10558 002744'01 251 01 0 00 000000* blt t1, parsx ;[203] out the previous parse values here 10559 10560 ;* hrroi t1, cmdbuf ; Echo the command. 10561 ;* PSOUT ; ... 10562 10563 002745'01 553 00 0 00 002737* hrrzs sbk ;[203] Zero the CSB flags. 10564 002746'01 260 17 0 00 002614' call .set ; Go parse the string. 10565 002747'01 260 17 0 00 002655' call $set ; Go execute what was parsed. 10566 002750'01 332 00 0 00 000000# skipe mdone ;[203] No more? 10567 002751'01 254 00 0 00 002666' jrst $set3 ;[203] Nope, go do the rest of them. 10568 002752'01 263 17 0 00 000000 ret ; Otherwise, all done 10569 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 52 K20PAR MAC 7-Jun-23 14:23 SET keyword table 10570 subttl SET keyword table 10571 10572 000651'02 000000 000000 %table(settab,G) ;[203] Also used by K20MAC 10573 000652'02 000000# 000000# %key3 , .setbc, $setbc ;[98] 10574 000517'03 142 154 157 143 153 10575 000522'03 000000# 000000# 10576 000653'02 000000# 000000# %key3 , .setbr, $setbr 10577 000523'03 142 162 145 141 153 10578 000525'03 000000# 000000# 10579 000654'02 000000# 000000# %key3 , .setdb, $setdb 10580 000526'03 144 145 142 165 147 10581 000530'03 000000# 000000# 10582 000655'02 000000# 000000# %key3 , .setdl, $setdl ;[194] 10583 000531'03 144 145 154 141 171 10584 000533'03 000000# 000000# 10585 000656'02 000000# 000000# %key3 , .setdu, $setdu ;[194] 10586 000534'03 144 165 160 154 145 10587 000536'03 000000# 000000# 10588 000657'02 000000# 000000# %key3 , .setes, $setes ;[194] 10589 000537'03 145 163 143 141 160 10590 000541'03 000000# 000000# 10591 000660'02 000000# 000000# %key3 , .setex, $setex ;[143] ;[194] 10592 000542'03 145 170 160 165 156 10593 000544'03 000000# 000000# 10594 000661'02 000000# 000000# %key3 , .setfi, $setfi ;[194] 10595 000545'03 146 151 154 145 000 10596 000546'03 000000# 000000# 10597 000662'02 000000# 000000# %key3 , .setfl, $setfl ;[143] ;[194] 10598 000547'03 146 154 157 167 055 10599 000552'03 000000# 000000# 10600 000663'02 000000# 000000# %key3 , .setha, $setha ;[76] 10601 000553'03 150 141 156 144 163 10602 000555'03 000000# 000000# 10603 000664'02 000000# 000000# %key3 , .seths, $setln## ;[194] 10604 000556'03 150 157 163 164 000 10605 000557'03 000000# 000000* 10606 000665'02 000000# 000000# %key3 , .setab, $setab ;[194] 10607 000560'03 151 156 143 157 155 10608 000563'03 000000# 000000# 10609 000666'02 000000# 000000# %key3 , .setin##, $setrs ;[160] ;[194] 10610 000564'03 151 156 160 165 164 10611 000566'03 000000* 000000# 10612 000667'02 000000# 000000# %key3 , .setit, $setit ;[194] 10613 000567'03 111 124 123 055 142 10614 000572'03 000000# 000000# 10615 000670'02 000000# 000000# %key3 , .setln, $setln## ;[186] ;[194] 10616 000573'03 154 151 156 145 000 10617 000574'03 000000# 000557* 10618 000671'02 000000# 000000# %key3 , .setpa##, $setpa## ;[194] 10619 000575'03 160 141 162 151 164 10620 000577'03 000000* 000000* 10621 000672'02 000000# 000000# %key3 , .setpr, $setpr ;[194] 10622 000600'03 160 162 157 155 160 10623 000602'03 000000# 000000# 10624 000673'02 000000# 000000# %key3 , .setrc, $setrs ;[194] k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 52-1 K20PAR MAC 7-Jun-23 14:23 SET keyword table 10625 000603'03 162 145 143 145 151 10626 000605'03 000000# 000000# 10627 000674'02 000000# 000000# %key3 , .setre, $setre ;[194] 10628 000606'03 162 145 164 162 171 10629 000610'03 000000# 000000# 10630 000675'02 000000# 000676' %keyf3 , %snd3, 10631 000611'03 002000 000005 10632 000612'03 163 145 000 000 000 10633 000676'02 000000# 000000# %snd3: %key3 , .setsn, $setrs ;[194] 10634 000613'03 163 145 156 144 000 10635 000614'03 000000# 000000# 10636 000677'02 000000# 000000# %keyf4 , .setim, $setst, cm%inv ;[212] Tops-10 has it here 10637 000615'03 002000 000001 10638 000616'03 163 145 162 166 145 10639 000621'03 000000# 000000# 10640 000700'02 000000# 000000# %key3 , .setxp, $setsp ;[194] 10641 000622'03 163 160 145 145 144 10642 000624'03 000000# 000000# 10643 000701'02 000000# 000000# %keyf4 , .setim, $setst, cm%inv ;[212] keep typing this.. 10644 000625'03 002000 000001 10645 000626'03 163 162 166 055 164 10646 000631'03 000000# 000000# 10647 000702'02 000000# 000000# %key3 , .setta, $setta ;[129] ;[194] 10648 000632'03 124 126 124 055 102 10649 000635'03 000000# 000000# 10650 000651'02 000031 000031 %tbend 10651 10652 cleans(<%snd3>) ;;Clean up generated symbol 10653 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 53 K20PAR MAC 7-Jun-23 14:23 SET BLOCK-CHECK command 10654 subttl SET BLOCK-CHECK command 10655 10656 ;[98] (This command added as part of edit 98) 10657 10658 000703'02 000000 000000 %table(bctab) 10659 000704'02 000000# 000061 %key2 <1-character-checksum>, "1" 10660 000636'03 061 055 143 150 141 10661 000705'02 000000# 000062 %key2 <2-character-checksum>, "2" 10662 000643'03 062 055 143 150 141 10663 000706'02 000000# 000063 %key2 <3-character-crc>, "3" 10664 000650'03 063 055 143 150 141 10665 000703'02 000003 000003 %tbend 10666 10667 chgsec(code,const) ;;FDB's are not in code, they're in const 10668 000707'02 000002 000000 sbcfdb: flddb. .cmkey,,bctab,,<1> 10669 000710'02 000000 000703' 10670 000711'02 000000 000000 10671 000712'02 44 07 0 00 002017' 10672 retsec ;;Back to where-ever we started from 10673 10674 002753'01 200 16 0 00 000000# .setbc: guide ; Issue guide words 10675 002754'01 260 17 0 00 002525* 10676 000713'02 000000000000# 10677 001026'04 164 171 160 145 040 10678 002755'01 201 01 0 00 000000# movei t1, sbcfdb 10679 002756'01 260 17 0 00 002650* call rfield ; Parse keyword, default is "1". 10680 002757'01 550 02 0 02 000000 hrrz t2, (t2) ; Save the value we parsed. 10681 002760'01 202 02 0 00 002612* movem t2, pars3 10682 002761'01 336 00 0 00 002645* skipn definf ; In a DEFINE command? 10683 002762'01 260 17 0 00 002634* confrm ; No, make them type a carriage return. 10684 002763'01 263 17 0 00 000000 ret 10685 10686 remark SET BLOCK-CHECK command execution. 10687 10688 002764'01 $setbc: extern bctr ; Our necessary 10689 002764'01 200 01 0 00 002760* move t1, pars3 ; Get what was parsed. 10690 002765'01 202 01 0 00 000000* movem t1, bctr ; Save it as "block check type requested". 10691 002766'01 263 17 0 00 000000 ret 10692 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 54 K20PAR MAC 7-Jun-23 14:23 SET BREAK command 10693 subttl SET BREAK command 10694 10695 chgsec(code,const) ;;FDB's are not in code, they're in const 10696 000714'02 001004 000000 sbrfdb: flddb. .cmnum,,^d10, 10697 000715'02 000000 000012 10698 000716'02 44 07 0 00 002413' 10699 retsec ;;Back to where-ever we started from 10700 10701 002767'01 200 16 0 00 000000# .setbr: guide (nulls) 10702 002770'01 260 17 0 00 002754* 10703 000717'02 000000000000# 10704 001030'04 156 165 154 154 163 10705 002771'01 201 01 0 00 000000# movei t1, sbrfdb 10706 002772'01 260 17 0 00 002756* call rfield 10707 10708 002773'01 325 02 0 00 002777' ifl. t2 ;[194] Negative nulls are silly 10709 002774'01 200 01 0 00 000000# emsg ;[194] 10710 002775'01 104 00 0 00 000313 10711 000720'02 000000000000# 10712 001032'04 101 040 156 145 147 10713 002776'01 254 00 0 00 002513* jrst cmder1 ;[194] 10714 002777'01 endif. ;[194] 10715 10716 002777'01 307 02 0 00 000100 caig t2, maxnul ;[194] 10717 003000'01 254 00 0 00 003011' ifskp. ;[194] Exceeded maximum 10718 003001'01 200 01 0 00 000000# emsg ;[194] 10719 003002'01 104 00 0 00 000313 10720 000721'02 000000000000# 10721 001042'04 124 157 157 040 155 10722 003003'01 201 01 0 00 000101 numout [maxnul] ;[194] 10723 003004'01 200 02 0 00 005173' 10724 003005'01 201 03 0 00 000012 10725 003006'01 104 00 0 00 000224 10726 003007'01 320 14 0 00 003010' 10727 003010'01 254 00 0 00 002776* jrst cmder1 ;[194] 10728 003011'01 endif. ;[194] 10729 10730 003011'01 202 02 0 00 002764* movem t2, pars3 10731 003012'01 336 00 0 00 002761* skipn definf ;[77] In DEFINE? 10732 003013'01 260 17 0 00 002762* confrm ;[77] No, get confirmation. 10733 003014'01 263 17 0 00 000000 ret 10734 10735 remark SET BREAK command execution. 10736 10737 003015'01 $setbr: extern brk ; Our necessary 10738 003015'01 200 02 0 00 003011* move t2, pars3 ; Execute SET BREAK. 10739 003016'01 202 02 0 00 000000* movem t2, brk 10740 003017'01 263 17 0 00 000000 ret 10741 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 55 K20PAR MAC 7-Jun-23 14:23 SET DEBUG command 10742 subttl SET DEBUG command 10743 10744 000722'02 000000 000000 %table(dbgswi) ;[221] 10745 000723'02 000000# 000000 %key2 , 0 ;[221] If setting decode flag 10746 000654'03 144 145 143 157 144 10747 000722'02 000001 000001 %tbend ;[221] 10748 10749 000724'02 000000 000000 %table(dbgtab) 10750 000725'02 000000# 000000 %key2 , 0 10751 000656'03 157 146 146 000 000 10752 000726'02 000000# 000002 %key2 , 2 ;[22] 10753 000657'03 160 141 143 153 145 10754 000727'02 000000# 000001 %key2 , 1 ;[22] 10755 000661'03 163 164 141 164 145 10756 000724'02 000003 000003 %tbend 10757 10758 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 10759 000730'02 000002 000000 sdbfdb: flddb. .cmkey,,dbgtab,,states 10760 000731'02 000000 000724' 10761 000732'02 000000 000000 10762 000733'02 44 07 0 00 002425' 10763 000734'02 003004 000737' sdbswi: flddb. .cmswi,,dbgswi,,,sdbsw1 10764 000735'02 000000 000722' 10765 000736'02 44 07 0 00 002427' 10766 000737'02 010000 000000 sdbsw1: flddb. .cmcfm ;[221] Parse either the switch or a confirm 10767 000740'02 000000 000000 10768 sdbswo: flddb. .cmswi,,dbgswi,,, ;;[221] 10771 000742'02 000000 000722' 10772 000743'02 44 07 0 00 002435' 10773 retsec ;;Back to where-ever we started from 10774 cleans() 10775 10776 003020'01 200 16 0 00 000000# .setdb: guide ;[217] 11125 003262'01 104 00 0 00 000313 11126 001064'02 000000000000# 11127 001105'04 101 040 156 145 147 11128 003263'01 263 17 0 00 000000 ret ;[217] Failure return 11129 003264'01 endif. ;[217] 11130 11131 003264'01 305 06 0 00 000200 caige q2, 200 ;[217] Absurdly large? 11132 003265'01 254 00 0 00 003271' ifskp. ;[217] Give that a special squawk 11133 003266'01 200 01 0 00 000000# emsg ;[217] 11134 003267'01 104 00 0 00 000313 11135 001065'02 000000000000# 11136 001120'04 101 040 156 165 155 11137 003270'01 263 17 0 00 000000 ret ;[217] Failure return 11138 003271'01 endif. ;[217] 11139 11140 003271'01 306 06 0 00 000177 cain q2, 177 ;[194] But! Maybe a rubout? 11141 003272'01 254 00 0 00 003064* retskp ;[217] It is, this is fine 11142 11143 003273'01 302 06 0 00 000003 caie q2, .chcnc ;[217] ^C? 11144 003274'01 254 00 0 00 003300' ifskp. ;[217] That is never a good idea 11145 003275'01 200 01 0 00 000000# emsg ;[217] 11146 003276'01 104 00 0 00 000313 11147 001066'02 000000000000# 11148 001134'04 115 141 171 040 156 11149 003277'01 263 17 0 00 000000 ret ;[217] Failure return 11150 003300'01 endif. ;[217] 11151 11152 003300'01 336 04 0 00 000000* skipn t4, handsh ;[217] Are we doing handshaking? 11153 003301'01 254 00 0 00 003315' ifskp. ;[217] We are, so check if this conflicts 11154 003302'01 312 06 0 00 000004 came q2, t4 ;[217] Same thing? 11155 003303'01 254 00 0 00 003315' anskp. ;[217] Nope, but still need to check further 11156 003304'01 200 01 0 00 000000# emsg ;[217] k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 59-2 K20PAR MAC 7-Jun-23 14:23 SET ESCAPE command 11157 003305'01 104 00 0 00 000313 11158 001067'02 000000000000# 11159 001146'04 115 141 171 040 156 11160 003306'01 200 01 0 00 000006 move t1, q2 ;[217] Load the control character 11161 003307'01 271 01 0 00 000100 addi t1, "@" ;[217] Bring into printable range 11162 003310'01 104 00 0 00 000074 PBOUT% ;[217] and type it 11163 003311'01 200 01 0 00 000000# txmsg < as an escape character because this is the handshake character> 11164 003312'01 104 00 0 00 000076 11165 003313'01 320 12 0 00 003314' 11166 001070'02 000000000000# 11167 001153'04 040 141 163 040 141 11168 003314'01 263 17 0 00 000000 ret ;[217] Failure return 11169 003315'01 endif. ;[217] 11170 11171 003315'01 302 06 0 00 000007 caie q2, .chbel ;[217] ^G? 11172 003316'01 254 00 0 00 003332' ifskp. ;[217] That is never a good idea 11173 003317'01 200 01 0 00 000000* move t1, capas ;[217] Pick up our capabilities 11174 003320'01 603 01 0 00 400000 txne t1, sc%ctc ;[217] Do we have ^C? 11175 003321'01 254 00 0 00 003272* retskp ;[217] Yes, this is fine 11176 003322'01 336 00 0 00 000000# ifmn. ;[217] Are we a batch frob? 11177 003323'01 254 00 0 00 003327' 11178 003324'01 200 01 0 00 000000# emsg ;[217] 11179 003325'01 104 00 0 00 000313 11180 001071'02 000000000000# 11181 001170'04 115 141 171 040 156 11182 003326'01 254 00 0 00 003331' else. ;[217] Otherwise, slightly different message 11183 emsg 11185 003330'01 104 00 0 00 000313 11186 001072'02 000000000000# 11187 001204'04 115 141 171 040 156 11188 003331'01 endif. ;[217] Either way, it's bad... 11189 003331'01 263 17 0 00 000000 ret ;[217] Failure return 11190 003332'01 endif. ;[217] 11191 11192 003332'01 302 06 0 00 000023 caie q2, .chcns ;[217] ^S? 11193 003333'01 254 00 0 00 003341' ifskp. ;[217] Not not be available 11194 003334'01 336 00 0 00 000000* skipn flow ;[217] Are we running XON-XOFF? 11195 003335'01 254 00 0 00 003321* retskp ;[217] Nope, so that's fine 11196 emsg 11198 003337'01 104 00 0 00 000313 11199 001073'02 000000000000# 11200 001223'04 115 141 171 040 156 11201 003340'01 263 17 0 00 000000 ret ;[217] Failure return 11202 003341'01 endif. ;[217] 11203 11204 003341'01 302 06 0 00 000021 caie q2, .chcnq ;[217] ^Q? 11205 003342'01 254 00 0 00 003350' ifskp. ;[217] Not not be available 11206 003343'01 336 00 0 00 003334* skipn flow ;[217] Are we running XON-XOFF? 11207 003344'01 254 00 0 00 003335* retskp ;[217] Nope, so that's fine 11208 emsg 11210 003346'01 104 00 0 00 000313 11211 001074'02 000000000000# k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 59-3 K20PAR MAC 7-Jun-23 14:23 SET ESCAPE command 11212 001243'04 115 141 171 040 156 11213 003347'01 263 17 0 00 000000 ret ;[217] Failure return 11214 003350'01 endif. ;[217] 11215 11216 003350'01 307 06 0 00 000037 caig q2, .chcun ;[217] Past Control-_ (underscore)? 11217 003351'01 254 00 0 00 003344* retskp ;[217] No, so it's passed all the checks 11218 11219 003352'01 200 01 0 00 000000# emsg <"> ;[217] Begin the blat 11220 003353'01 104 00 0 00 000313 11221 001075'02 000000000000# 11222 001263'04 042 000 000 000 000 11223 003354'01 200 01 0 00 000006 move t1, q2 ;[217] Load the proposed control 11224 003355'01 104 00 0 00 000074 PBOUT% ;[217] character and type it 11225 003356'01 200 01 0 00 000000# txmsg <" is not in ASCII control range, 0-37 or 177> 11226 003357'01 104 00 0 00 000076 11227 003360'01 320 12 0 00 003361' 11228 001076'02 000000000000# 11229 001264'04 042 040 151 163 040 11230 003361'01 263 17 0 00 000000 ret ;[217] Failure return 11231 003362'01 263 17 0 00 000000 endbk. ;[217] End block context 11232 003363'01 254 00 0 00 003370' ifskp. ;[217] Passed +2 means passed muster 11233 003364'01 202 06 0 00 003170* movem q2, pars3 ;[217] So let's use it 11234 003365'01 306 10 0 00 000010 cain q4, .cmcfm ;[217] Original intent was to default everything? 11235 003366'01 263 17 0 00 000000 ret ;[217] It was, so don't confirm the confirm. 11236 003367'01 254 00 0 00 003371' else. ;[217] Otherwise, we've complained 11237 003370'01 254 00 0 00 003150* jrst cmder1 ;[217] Allow ^H 11238 003371'01 endif. ;[217] Otherwise, fall through 11239 11240 003371'01 336 00 0 00 003207* skipn definf ;[77] In DEFINE? 11241 003372'01 260 17 0 00 003166* confrm ;[77] No, get confirmation. 11242 003373'01 263 17 0 00 000000 ret 11243 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 60 K20PAR MAC 7-Jun-23 14:23 SET ESCAPE command 11244 remark SET ESCAPE comand semantic action 11245 11246 003374'01 $setes: extern escape ; Our necessary 11247 003374'01 200 01 0 00 003364* move t1, pars3 ;[16] ESCAPE. Get what we parsed. 11248 003375'01 202 01 0 00 000000* movem t1, escape 11249 003376'01 263 17 0 00 000000 ret 11250 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 61 K20PAR MAC 7-Jun-23 14:23 SET EXPUNGE command 11251 subttl SET EXPUNGE command 11252 11253 001077'02 000000 000000 %table(offon) ; Table for parsing ON or OFF. 11254 001100'02 000000# 000000 %key2 , 0 11255 000717'03 157 146 146 000 000 11256 001101'02 000000# 000001 %key2 , 1 11257 000720'03 157 156 000 000 000 11258 001077'02 000002 000002 %tbend 11259 11260 chgsec(code,const) ;;FDB's are not in code, they're in const 11261 001102'02 000002 000000 sexfdb: flddb. .cmkey,,offon,,on 11262 001103'02 000000 001077' 11263 001104'02 000000 000000 11264 001105'02 44 07 0 00 002225' 11265 retsec ;;Back to where-ever we started from 11266 11267 003377'01 200 16 0 00 000000# .setex: guide 11268 003400'01 260 17 0 00 003175* 11269 001106'02 000000000000# 11270 001275'04 144 145 154 145 164 11271 003401'01 201 01 0 00 000000# movei t1, sexfdb ; Yet consistent naming, sigh... 11272 003402'01 260 17 0 00 003162* call rfield ; Parse a keyword. 11273 003403'01 550 02 0 02 000000 hrrz t2, (t2) ; Get the value for the keyword (0 or 1). 11274 003404'01 202 02 0 00 003374* movem t2, pars3 ; Save into pars3. 11275 003405'01 336 00 0 00 003371* skipn definf ;[77] In DEFINE? 11276 003406'01 260 17 0 00 003372* confrm ;[77] No, get confirmation. 11277 003407'01 263 17 0 00 000000 ret 11278 11279 remark SET EXPUNGE semantic action 11280 11281 003410'01 $setex: extern expung ; Our necessary 11282 003410'01 200 01 0 00 003404* move t1, pars3 ;[143] SET EXPUNGE 11283 003411'01 202 01 0 00 000000* movem t1, expung 11284 003412'01 263 17 0 00 000000 ret 11285 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 62 K20PAR MAC 7-Jun-23 14:23 SET FILE parse tables 11286 subttl SET FILE parse tables 11287 11288 001107'02 000000 000000 %table(sfitab) ; Table of file parameters to SET. 11289 001110'02 000000# 000000 %key2 ,0 11290 000721'03 142 171 164 145 163 11291 001111'02 000000# 000001 %key2 ,1 11292 000723'03 156 141 155 151 156 11293 001107'02 000002 000002 %tbend 11294 11295 001112'02 000000 000000 %table(sfbtab) ; file bytesize keyword table. 11296 001113'02 000000# 000002 %key2 <36-bit>, 2 ;[232] 11297 000725'03 063 066 055 142 151 11298 001114'02 000000# 000000 %key2 <7-bit>, 0 11299 000727'03 067 055 142 151 164 11300 001115'02 000000# 000001 %key2 <8-bit>, 1 11301 000731'03 070 055 142 151 164 11302 001116'02 000000# 000003 %key2 , 3 ;[232] 11303 000733'03 141 165 164 157 000 11304 001117'02 000000# 000001 %key2 , 1 11305 000734'03 145 151 147 150 164 11306 001120'02 000000# 000000 %key2 , 0 11307 000736'03 163 145 166 145 156 11308 001121'02 000000# 000002 %key2 , 2 ;[232] 11309 000740'03 164 150 151 162 164 11310 001112'02 000007 000007 %tbend 11311 11312 001122'02 000000 000000 %table(fntab) ;[194] ; file name translation keywords. 11313 001123'02 000000# 000001 %key2 ,1 ;[194] 11314 000743'03 156 157 162 155 141 11315 001124'02 000000# 000000 %key2 ,0 ;[194] 11316 000746'03 165 156 164 162 141 11317 001122'02 000002 000002 %tbend ;[194] 11318 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 63 K20PAR MAC 7-Jun-23 14:23 SET FILE command 11319 subttl SET FILE command 11320 11321 ; The following ruse using chained FDB's allows the old-style command to 11322 ; be parsed most of the time, like "SET FILE 8". 11323 11324 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 11325 001125'02 000002 001131' sfifd1: flddb. .cmkey,,sfitab,,,sfifd2 11326 001126'02 000000 001107' 11327 001127'02 000000 000000 11328 001130'02 44 07 0 00 002650' 11329 001131'02 000006 000000 sfifd2: flddb. .cmkey,,sfbtab,, 11330 001132'02 000000 001112' 11331 001133'02 44 07 0 00 002652' 11332 001134'02 44 07 0 00 002657' 11333 001135'02 000002 000000 sftfd3: flddb. .cmkey,,fntab,, ;[84] 11334 001136'02 000000 001122' 11335 001137'02 000000 000000 11336 001140'02 44 07 0 00 002660' 11337 retsec ;;Back to where-ever we started from 11338 11339 003413'01 200 16 0 00 000000# .setfi: guide ;[84] SET FILE 11340 003414'01 260 17 0 00 003400* 11341 001141'02 000000000000# 11342 001303'04 160 141 162 141 155 11343 003415'01 201 01 0 00 000000# movei t1, sfifd1 11344 003416'01 260 17 0 00 003402* call rfield 11345 003417'01 550 02 0 02 000000 hrrz t2, (t2) 11346 003420'01 553 00 0 00 000003 hrrzs t3 ;[84] Which function descriptor block was used? 11347 003421'01 402 00 0 00 003410* setzm pars3 ;[84] Assume they specified a bytesize. 11348 003422'01 306 03 0 00 000000# cain t3, sfifd2 ;[84] They specified a bytesize? 11349 003423'01 254 00 0 00 003434' ifskp. ;[194] Nope, parse for it 11350 003424'01 202 02 0 00 003421* movem t2, pars3 11351 003425'01 200 16 0 00 000000# guide 11352 003426'01 260 17 0 00 003414* 11353 001142'02 000000000000# 11354 001305'04 164 157 000 000 000 11355 003427'01 201 01 0 00 000000# movei t1, sfifd2 ;[194] Let's assume didn't specify the bytesize, yet 11356 003430'01 332 00 0 00 003424* skipe pars3 ;[84] But!! Did they? 11357 003431'01 201 01 0 00 000000# movei t1,sftfd3 ;[194] They did, so parse the filename translation 11358 003432'01 260 17 0 00 003416* call rfield ; Parse a keyword. 11359 003433'01 550 02 0 02 000000 hrrz t2, (t2) ; Get the value for the keyword (0 or 1). 11360 003434'01 endif. ;[196] Otherwise, so don't parse it again. 11361 11362 003434'01 202 02 0 00 003151* movem t2, pars4 ;[84] Save here. 11363 003435'01 336 00 0 00 003405* skipn definf ;[77] In DEFINE? 11364 003436'01 260 17 0 00 003406* confrm ;[77] No, get confirmation. 11365 003437'01 263 17 0 00 000000 ret 11366 11367 remark SET FILE semantic action 11368 11369 003440'01 336 01 0 00 003430* $setfi: skipn t1, pars3 ;[84] Which file parameter are we setting? 11370 003441'01 254 00 0 00 003452' jrst $setf8 ;[84] Bytesize, go do that. 11371 remark $setfn ;[194] Beware! Falls through to $setfn 11372 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 64 K20PAR MAC 7-Jun-23 14:23 FILE NAMING semantic action 11373 subttl FILE NAMING semantic action 11374 11375 003442'01 $setfn: remark $setfn ; Called by... NOBODY!! (see above) 11376 extern xfnflg ; and of our necessary 11377 003442'01 376 00 0 00 000001 sosn t1 ;[194] Do we have to get a little fancier? 11378 003443'01 254 00 0 00 003447' ifskp. ;[194] Yep, looks like it 11379 003444'01 200 01 0 00 000000# emsg ;[187] if more file parameters 11380 003445'01 104 00 0 00 000313 11381 001143'02 000000000000# 11382 001306'04 111 155 160 157 163 11383 003446'01 263 17 0 00 000000 ret ;[84] are added... 11384 003447'01 endif. ;[194] 11385 003447'01 200 01 0 00 003434* move t1, pars4 ;[84] OK, get the value. 11386 003450'01 202 01 0 00 000000* movem t1, xfnflg ;[84] Save it. 11387 003451'01 263 17 0 00 000000 ret ;[84] Done. 11388 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 65 K20PAR MAC 7-Jun-23 14:23 FILE BYTESIZE semantic action 11389 subttl FILE BYTESIZE semantic action 11390 11391 003452'01 $setf8: remark $setf8 ; Jumped to by $setfi 11392 extern autbyt, ebtflg, tbtflg ; Our necessaries 11393 003452'01 200 01 0 00 003447* move t1, pars4 ; BYTESIZE... Get the value of the flag. 11394 003453'01 254 00 1 01 003454' jrst @fbytet(t1) ;[232] Go set the variables appropriately 11395 11396 003454'01 000000 003460' fbytet: fbyte7 ;[232] Seven bit files 11397 003455'01 000000 003464' fbyte8 ;[232] Eight bit files 11398 003456'01 000000 003470' fbyt36 ;[232] Thirty-six bit files 11399 003457'01 000000 003475' fbytea ;[232] Auto-byte (only 7 or 8 for now) 11400 11401 003460'01 fbyte7: remark ;[232] Here to force 7 bit 11402 003460'01 402 00 0 00 000000* setzm autbyt ;[232] Never autobyting 11403 003461'01 402 00 0 00 000000* setzm ebtflg ;[232] Clear eight bit flag 11404 003462'01 402 00 0 00 000000* setzm tbtflg ;[232] Clear 36 bit flag 11405 003463'01 263 17 0 00 000000 ret ;[232] Done 11406 11407 003464'01 fbyte8: remark ;[232] Here to force 8 bit files 11408 003464'01 402 00 0 00 003460* setzm autbyt ;[232] Never autobyting 11409 003465'01 476 00 0 00 003461* setom ebtflg ;[232] Set eight bit flag 11410 003466'01 402 00 0 00 003462* setzm tbtflg ;[232] Clear 36 bit flag 11411 003467'01 263 17 0 00 000000 ret ;[232] Done 11412 11413 003470'01 fbyt36: remark ;[232] Here if forceing thirty-six bit files 11414 003470'01 402 00 0 00 000000* setzm itsflg ;[232] Clear ITS Binary 11415 003471'01 402 00 0 00 003464* setzm autbyt ;[232] Never autobyting 11416 003472'01 402 00 0 00 003465* setzm ebtflg ;[232] Clear eight bit flag 11417 003473'01 476 00 0 00 003466* setom tbtflg ;[232] Set 36 bit flag 11418 003474'01 263 17 0 00 000000 ret ;[232] Done 11419 11420 003475'01 fbytea: remark ;[232] Here for 7/8 bit auto-byte 11421 003475'01 476 00 0 00 003471* setom autbyt ;[194] If so, say so, 11422 003476'01 402 00 0 00 003472* setzm ebtflg ; and say this not so. 11423 003477'01 402 00 0 00 003473* setzm tbtflg ;[232] If autobyte, then never 36 bit 11424 003500'01 263 17 0 00 000000 ret ;[232] Done 11425 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 66 K20PAR MAC 7-Jun-23 14:23 SET FLOW-CONTROL command 11426 subttl SET FLOW-CONTROL command 11427 11428 001144'02 000000 000000 %table(flotab) ; Flow-Control keywords 11429 001145'02 000000# 000000 %key2 , 0 11430 000751'03 156 157 156 145 000 11431 001146'02 000000# 000000 %keyf3 , 0, cm%inv 11432 000752'03 002000 000001 11433 000753'03 157 146 146 000 000 11434 001147'02 000000# 000001 %keyf3 , 1, cm%inv 11435 000754'03 002000 000001 11436 000755'03 157 156 000 000 000 11437 001150'02 000000# 000001 %key2 , 1 11438 000756'03 130 117 116 055 130 11439 001144'02 000004 000004 %tbend 11440 11441 chgsec(code,const) ;;FDB's are not in code, they're in const 11442 001151'02 000002 000000 sflfdb: flddb. .cmkey,,flotab,,XON-XOFF 11443 001152'02 000000 001144' 11444 001153'02 000000 000000 11445 001154'02 44 07 0 00 002663' 11446 retsec ;;Back to where-ever we started from 11447 11448 003501'01 201 01 0 00 000000# .setfl: movei t1, sflfdb 11449 003502'01 260 17 0 00 003432* call rfield ; Parse a keyword. 11450 003503'01 550 02 0 02 000000 hrrz t2, (t2) ; Get the value for the keyword (0 or 1). 11451 003504'01 202 02 0 00 003440* movem t2, pars3 ; Save into pars3. 11452 003505'01 336 00 0 00 003435* skipn definf ; In DEFINE? 11453 003506'01 260 17 0 00 003436* confrm ; No, get confirmation. 11454 003507'01 263 17 0 00 000000 ret 11455 11456 remark SET FLOW-CONTROL semantic action 11457 11458 003510'01 $setfl: extern handsh, flow ; And of our necessaries 11459 003510'01 332 01 0 00 003504* skipe t1, pars3 ; Get flow control option. 11460 003511'01 402 00 0 00 003300* setzm handsh ; If nonzero, turn off handshake. 11461 003512'01 202 01 0 00 003343* movem t1, flow 11462 003513'01 263 17 0 00 000000 ret 11463 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 67 K20PAR MAC 7-Jun-23 14:23 SET HANDSHAKE command 11464 subttl SET HANDSHAKE command 11465 11466 ;[217] Although little used and probably rarely necessary, make entering 11467 ; a character here as 'easy' as it is for changing the escape character. 11468 11469 001155'02 000000 000000 %table(hshtab) ; Handshake keywords (recommended) 11470 001156'02 000000# 000007 %key2 , .chbel ;[217] ^G 11471 000760'03 142 145 154 154 000 11472 001157'02 000000# 000015 %key2 , .chcrt ;[217] ^M or carriage return 11473 000761'03 103 122 000 000 000 11474 001160'02 000000# 000033 %key2 , .chesc ;[217] Escape or "altmode" 11475 000762'03 105 123 103 000 000 11476 001161'02 000000# 000012 %key2 , .chlfd ;[217] ^J or line-feed 11477 000763'03 114 106 000 000 000 11478 001162'02 000000# 000000 %key2 , .chnul ;[217] Special cased 11479 000764'03 156 157 156 145 000 11480 001163'02 000000# 000023 %key2 , .chcns ;[217] ^S 11481 000765'03 130 117 106 106 000 11482 001164'02 000000# 000021 %key2 , .chcnq ;[217] ^Q 11483 000766'03 130 117 116 000 000 11484 001155'02 000007 000007 %tbend 11485 11486 chgsec(code,const) ;;FDB's are not in code, they're in const 11487 001165'02 013001 001167' hndfdm: flddb. .cmcma,cm%sdh,,,,hndfdb ;[217] Used when unwinding a macro 11488 001166'02 000000 000000 11489 001167'02 010004 001172' hndfdb: flddb. .cmcfm,,,,,hndfd1 11490 001170'02 000000 000000 11491 001171'02 44 07 0 00 002665' 11492 001172'02 000004 001175' hndfd1: flddb. .cmkey,,hshtab,,,hndfd2 11493 001173'02 000000 001155' 11494 001174'02 44 07 0 00 002674' 11495 001175'02 001004 001200' hndfd2: flddb. .cmnum,,^d8,,,hndfd3 11496 001176'02 000000 000010 11497 001177'02 44 07 0 00 002474' 11498 001200'02 023004 000000 hndfd3: flddb. .cmtok,,token(<^>),,, 11499 001201'02 440700 002507' 11500 001202'02 44 07 0 00 002510' 11501 retsec ;;Back to where-ever we started from 11502 11503 cleans() 11504 11505 003514'01 265 16 0 00 005022' .setha: saveac ;[217] Needs registers 11506 003515'01 200 16 0 00 000000# guide ;[217] 11507 003516'01 260 17 0 00 003426* 11508 001203'02 000000000000# 11509 001313'04 143 150 141 162 141 11510 11511 003517'01 201 01 0 00 000000# movei t1, hndfdb ;[217] Parse a couple of alternatives 11512 003520'01 332 00 0 00 000000# skipe mdone ;[217] Unwinding a macro? 11513 003521'01 201 01 0 00 000000# movei t1, hndfdm ;[217] Yes, allow a comma to squeak through 11514 11515 003522'01 260 17 0 00 003227* call rflde ;[217] Try to get one of them 11516 003523'01 254 00 0 00 003530' ifskp. ;[217] Worked!! 11517 003524'01 120 06 0 00 000002 dmove q2, t2 ;[217] Save partial parse results 11518 003525'01 135 05 0 00 005174' ldb q1, [pointr (.cmfnp(q3),cm%fnc)] ;[217] Get function code. k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 67-1 K20PAR MAC 7-Jun-23 14:23 SET HANDSHAKE command 11519 003526'01 200 10 0 00 000005 move q4, q1 ;[217] Save for downstream 11520 003527'01 254 00 0 00 003533' else. ;[217] Otherwise, failed the parse 11521 003530'01 336 00 0 00 003505* skipn definf ;[217] In DEFINE? 11522 003531'01 254 00 0 00 003240* jrst cmderr ;[217] No, then a definite parse error; allow retry 11523 003532'01 263 17 0 00 000000 ret ;[217] Return into DEFINE and see if that chokes 11524 003533'01 endif. ;[217] End handling COMND% returns 11525 11526 003533'01 302 05 0 00 000013 caie q1, .cmcma ;[217] Parsed a comma? 11527 003534'01 254 00 0 00 003537' ifskp. ;[217] We did, so must be unwinding a macro 11528 003535'01 201 05 0 00 000010 movei q1, .cmcfm ;[217] Turn it into a confirm and carry on 11529 003536'01 200 10 0 00 000005 move q4, q1 ;[217] Stomp into downstream, too 11530 003537'01 endif. 11531 11532 003537'01 302 05 0 00 000010 caie q1, .cmcfm ;[217] A confirm is very special cased 11533 003540'01 254 00 0 00 003544' ifskp. ;[217] It was, so default it 11534 003541'01 201 02 0 00 000023 movei t2, .chcns ;[217] Replace parse value with ^S 11535 003542'01 202 02 0 00 003510* movem t2, pars3 ;[217] Save where $setha wants to find it 11536 003543'01 263 17 0 00 000000 ret ;[217] Done, nothing left to parse 11537 003544'01 endif. ;[217] 11538 11539 003544'01 302 05 0 00 000000 caie q1, .cmkey ;[217] Common mnemonic? 11540 003545'01 254 00 0 00 003550' ifskp. ;[217] It was, so translate it by getting 11541 003546'01 550 02 0 06 000000 hrrz t2, (q2) ;[217] the keyword's associated value. 11542 003547'01 254 00 0 00 003600' jrst .seth1 ;[217] Make sure nothing bad leaked through 11543 003550'01 endif. ;[217] 11544 11545 003550'01 306 05 0 00 000001 cain q1, .cmnum ;[217] Number? 11546 003551'01 254 00 0 00 003600' jrst .seth1 ;[217] Must range check user specified value 11547 11548 remark q1, .cmtok ;[217] Otherwise, must have been a token 11549 dmove t1, [ esctkn ;[217] Possible mnemonics 11550 003552'01 120 01 0 00 005200' cm%xif ] ;[217] Load the no indirection flag 11551 003553'01 436 02 0 00 000000# orm t2, sbk+.cmflg ;[217] And dink the COMND% state block 11552 003554'01 260 17 0 00 003522* call rflde ;[217] Try to get one of them 11553 003555'01 254 00 0 00 003563' ifskp. ;[217] Worked!! 11554 003556'01 135 05 0 00 005021' ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ;[217] Get function code. 11555 003557'01 120 06 0 00 000002 dmove q2, t2 ;[217] Save parse data and fdb selection 11556 remark q4, ;[217] But don't touch original parse 11557 003560'01 205 04 0 00 002000 movx t4, cm%xif ;[217] Load indirection flag again 11558 003561'01 412 04 0 00 000000# andcam t4, sbk+.cmflg ;[217] And restore the COMND% state block 11559 003562'01 254 00 0 00 003566' else. ;[217] Otherwise, failed the parse 11560 003563'01 205 04 0 00 002000 movx t4, cm%xif ;[217] Load indirection flag again 11561 003564'01 412 04 0 00 000000# andcam t4, sbk+.cmflg ;[217] restore the COMND% state block 11562 003565'01 254 00 0 00 003531* jrst cmderr ;[217] And handle the parse error, allowing reparse 11563 003566'01 endif. ;[217] End handling COMND% returns 11564 11565 003566'01 302 05 0 00 000000 caie q1, .cmkey ;[217] Was this relatively easy? 11566 003567'01 254 00 0 00 003572' ifskp. ;[217] Yep, let's grab and convert the character 11567 003570'01 550 02 0 06 000000 hrrz t2, (q2) ;[217] Pick up what would be the jump address 11568 003571'01 254 00 0 00 003600' jrst .seth1 ;[217] Make sure nothing bad leaked through 11569 003572'01 endif. 11570 11571 remark q1, .cmtok ;[217] A token is somewhat more difficult 11572 003572'01 621 07 0 00 777777 tlz q3, -1 ;[217] Isolate fdb we actually used 11573 003573'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 15:18 11-Jun-23 Page 67-2 K20PAR MAC 7-Jun-23 14:23 SET HANDSHAKE command 11574 003574'01 134 02 0 00 000006 ildb t2, q2 ;[217] Load the token character (only one) 11575 003575'01 275 02 0 00 000100 subi t2, "@" ;[217] Bring down to control character range 11576 003576'01 316 02 0 00 005177' camn t2, [-21] ;[217] Was this our rubout hack? 11577 003577'01 201 02 0 00 000177 movei t2, 177 ;[217] Stomp in the correct value 11578 remark .seth1 ;[217] Make sure nothing bad leaked through 11579 11580 003600'01 .seth1: remark ;[217] Expects character to check in t2 11581 003600'01 325 02 0 00 003604' ifl. t2 ;[217] True gubbish? 11582 003601'01 200 01 0 00 000000# emsg ;[217] 11583 003602'01 104 00 0 00 000313 11584 001204'02 000000000000# 11585 001321'04 101 040 156 145 147 11586 003603'01 254 00 0 00 003370* jrst cmder1 ;[217] Failure, but allow reparse 11587 003604'01 endif. ;[217] 11588 11589 003604'01 305 02 0 00 000200 caige t2, 200 ;[217] Absurdly large? 11590 003605'01 254 00 0 00 003611' ifskp. ;[217] Give that a special squawk 11591 003606'01 200 01 0 00 000000# emsg <7 bit ASCII is not defined for values of octal 200 or above> ;[217] 11592 003607'01 104 00 0 00 000313 11593 001205'02 000000000000# 11594 001336'04 067 040 142 151 164 11595 003610'01 254 00 0 00 003603* jrst cmder1 ;[217] Failure, but allow reparse 11596 003611'01 endif. ;[217] 11597 11598 003611'01 307 02 0 00 000037 caig t2, 37 ; Control character? 11599 003612'01 254 00 0 00 003626' ifskp. ; Isn't 11600 003613'01 306 02 0 00 000177 cain t2, 177 ; Rubout? 11601 003614'01 254 00 0 00 003626' anskp. ; It is, so that's fine 11602 003615'01 200 04 0 00 000002 move t4, t2 ;[217] Isn't so let's start complaining 11603 003616'01 200 01 0 00 000000# emsg <"> ;" ;[217] Begin with a double quote 11604 003617'01 104 00 0 00 000313 11605 001206'02 000000000000# 11606 001352'04 042 000 000 000 000 11607 003620'01 200 01 0 00 000004 move t1, t4 ;[217] Load the poor character 11608 003621'01 104 00 0 00 000074 PBOUT% ;[217] Display what is wrong 11609 003622'01 200 01 0 00 000000# txmsg <" is not in ASCII control range, 0-37 or 177> ;[187] " Font crock 11610 003623'01 104 00 0 00 000076 11611 003624'01 320 12 0 00 003625' 11612 001207'02 000000000000# 11613 001353'04 042 040 151 163 040 11614 003625'01 254 00 0 00 003610* jrst cmder1 ;[194] 11615 003626'01 endif. ;[194] 11616 11617 003626'01 202 02 0 00 003542* .seth2: movem t2, pars3 ; Save into pars3. 11618 003627'01 306 10 0 00 000010 cain q4, .cmcfm ;[217] Original intent was to default everything? 11619 003630'01 263 17 0 00 000000 ret ;[217] Yes, do not confirm the confirmation 11620 003631'01 336 00 0 00 003530* skipn definf ;[77] In DEFINE? 11621 003632'01 260 17 0 00 003506* confrm ;[77] No, get confirmation. 11622 003633'01 263 17 0 00 000000 ret 11623 11624 11625 remark SET HANDSHAKE semantic action 11626 11627 003634'01 $setha: remark flow, handsh ; Necessaries defined above 11628 003634'01 332 01 0 00 003626* skipe t1, pars3 ;[143] Get the handshake option. k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 67-3 K20PAR MAC 7-Jun-23 14:23 SET HANDSHAKE command 11629 003635'01 402 00 0 00 003512* setzm flow ;[143] If nonzero, turn off flow control. 11630 003636'01 260 17 1 00 001015* call @parity ;[223] Compute any parity 11631 003637'01 202 01 0 00 003511* movem t1, handsh ; Save it. 11632 003640'01 263 17 0 00 000000 ret ; Done. 11633 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 68 K20PAR MAC 7-Jun-23 14:23 SET HOST command 11634 subttl SET HOST command 11635 11636 ;[186] SET HOST is basically a restricted form of SET LINE with no .CMNUM 11637 11638 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 11639 001210'02 000004 001213' shsfdb: flddb. .cmkey,,pseutb,,,shsfd1 11640 001211'02 000000 000574' 11641 001212'02 44 07 0 00 002704' 11642 001213'02 026044 001216' shsfd1: flddb. .cmnod,cm%nsf,,,,shsfd2 11643 001214'02 000000 000000 11644 001215'02 44 07 0 00 002707' 11645 001216'02 010005 000000 shsfd2: flddb. .cmcfm,cm%sdh,,,, ;[186] 11646 001217'02 000000 000000 11647 001220'02 44 07 0 00 002721' 11648 retsec ;;Back to where-ever we started from 11649 cleans() 11650 11651 003641'01 200 16 0 00 000000# .seths: guide ;[186] 11652 003642'01 260 17 0 00 003516* 11653 001221'02 000000000000# 11654 001364'04 154 157 143 141 154 11655 003643'01 403 01 0 00 000002 setzb t1,t2 ;[186] Cons up 10 .CHNUL's 11656 003644'01 124 01 0 00 002604* dmovem t1,atmbuf ;[186] Scrub a bit of the atom buffer 11657 003645'01 201 01 0 00 000000# movei t1, shsfdb ;[186] Allow NRT and pseudo-terminal 11658 003646'01 260 17 0 00 003502* call rfield ; Parse a keyword or node (NO CONFIRM!) ;[186] 11659 003647'01 135 04 0 00 005021' ldb t4, [pointr (.cmfnp(t3),cm%fnc)] ;[186] Get function code. 11660 003650'01 254 00 0 00 003660' callret .setl1 ;[186] Same parsing semantics 11661 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 69 K20PAR MAC 7-Jun-23 14:23 SET LINE command 11662 subttl SET LINE command 11663 11664 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 11665 001222'02 001004 001225' slnfdb: flddb. .cmnum,,^d8,,,slnfd1 11666 001223'02 000000 000010 11667 001224'02 44 07 0 00 002727' 11668 001225'02 000004 001230' slnfd1: flddb. .cmkey,,pseutb,,,slnfd2 11669 001226'02 000000 000574' 11670 001227'02 44 07 0 00 002704' 11671 001230'02 026044 001233' slnfd2: flddb. .cmnod,cm%nsf,,,,slnfd3 11672 001231'02 000000 000000 11673 001232'02 44 07 0 00 002707' 11674 001233'02 010005 000000 slnfd3: flddb. .cmcfm,cm%sdh,,,, 11675 001234'02 000000 000000 11676 001235'02 44 07 0 00 002735' 11677 retsec ;;Back to where-ever we started from 11678 cleans() 11679 11680 003651'01 200 16 0 00 000000# .setln: guide 11681 003652'01 260 17 0 00 003642* 11682 001236'02 000000000000# 11683 001373'04 164 157 040 160 150 11684 003653'01 403 01 0 00 000002 setzb t1,t2 ;[186] Cons up 10 .CHNUL's 11685 003654'01 124 01 0 00 003644* dmovem t1,atmbuf ;[186] Scrub a bit of the atom buffer 11686 003655'01 201 01 0 00 000000# movei t1, slnfdb ;[186] Allow NRT and pseudo-terminal 11687 003656'01 260 17 0 00 003646* call rfield ; Parse a tty number. 11688 003657'01 135 04 0 00 005021' ldb t4, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 11689 11690 003660'01 306 04 0 00 000000 .setl1: cain t4, .cmkey ;[186] Parsed a keyword 11691 003661'01 254 00 0 00 002531' callret .conn1 ;[186] Handle as in CONNECT 11692 003662'01 306 04 0 00 000026 cain t4, .cmnod ;[186] Is it a DECnet node? 11693 003663'01 254 00 0 00 002531' callret .conn1 ;[186] Handle as in CONNECT 11694 003664'01 306 04 0 00 000001 cain t4, .cmnum ; Is it a TTY number? 11695 003665'01 254 00 0 00 002531' callret .conn1 ;[186] Handle as in CONNECT 11696 003666'01 302 04 0 00 000010 caie t4, .cmcfm ;[186] Confirmed? 11697 003667'01 254 00 0 00 003673' ifskp. ;[186] Break the connection 11698 dmove t1, [ .cmcfm ;[186] Pass that special situation back 11699 003670'01 120 01 0 00 005202' .dvnul ] ;[186] And that the keyword was "close" 11700 003671'01 124 01 0 00 003634* dmovem t1, pars3 ;[186] Side effect the parse variables 11701 003672'01 263 17 0 00 000000 ret ;[186] Done 11702 003673'01 endif. ;[186] 11703 11704 003673'01 334 01 0 00 000000# ermsg% (,r) ;[186] 11705 003674'01 254 00 0 00 003700' 11706 003675'01 202 01 0 00 002035* 11707 003676'01 104 00 0 00 000313 11708 003677'01 254 00 0 00 002415* 11709 001237'02 000000000000# 11710 001405'04 113 105 122 115 111 11711 11712 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 70 K20PAR MAC 7-Jun-23 14:23 SET INCOMPLETE command 11713 subttl SET INCOMPLETE command 11714 11715 001240'02 000000 000000 %table(inctab) ;[194] 11716 001241'02 000000# 000000 %key2 , 0 ;[194] 11717 000767'03 144 151 163 143 141 11718 001242'02 000000# 000001 %key2 , 1 ;[194] 11719 000771'03 153 145 145 160 000 11720 001240'02 000002 000002 %tbend ;[194] 11721 11722 chgsec(code,const) ;;FDB's are not in code, they're in const 11723 001243'02 000002 000000 stbfdb: flddb. .cmkey,,inctab,,,, ;[194] 11724 001244'02 000000 001240' 11725 001245'02 000000 000000 11726 001246'02 44 07 0 00 002741' 11727 retsec ;;Back to where-ever we started from 11728 11729 003700'01 200 16 0 00 000000# .setab: guide ;[42] SET INCOMPLETE (file disposition) 11730 003701'01 260 17 0 00 003652* 11731 001247'02 000000000000# 11732 001416'04 146 151 154 145 040 11733 003702'01 201 01 0 00 000000# movei t1, stbfdb ;[194] 11734 003703'01 260 17 0 00 003656* call rfield ; Parse & confirm. 11735 003704'01 550 02 0 02 000000 hrrz t2, (t2) 11736 003705'01 202 02 0 00 003671* movem t2, pars3 11737 003706'01 336 00 0 00 003631* skipn definf ;[77] In DEFINE? 11738 003707'01 260 17 0 00 003632* confrm ;[77] No, get confirmation. 11739 003710'01 263 17 0 00 000000 ret 11740 11741 remark SET INCOMPLETE semantic action 11742 11743 003711'01 $setab: extern abtfil ; Our necessary 11744 003711'01 200 01 0 00 003705* move t1, pars3 ; Just save what we parsed. 11745 003712'01 202 01 0 00 000000* movem t1, abtfil 11746 003713'01 263 17 0 00 000000 ret 11747 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 71 K20PAR MAC 7-Jun-23 14:23 SET SEND/RECEIVE command dispatcher. 11748 subttl SET SEND/RECEIVE command dispatcher. 11749 11750 003714'01 550 01 1 00 003711* $setrs: hrrz t1, @pars3 ;[223] ; SEND/RECEIVE. Address of variable to set. 11751 003715'01 200 02 0 00 003452* move t2, pars4 ; The value that was parsed. 11752 003716'01 336 03 0 00 002564* skipn t3, pars5 ;[196] Do we have a tertiary (double) value? 11753 003717'01 254 00 0 00 003724' ifskp. ;[196] Yes 11754 003720'01 316 03 0 00 005016' camn t3, [ .infin ] ;[212] Our talsiman for zero? 11755 003721'01 400 03 0 00 000000 setz t3, ;[212] Stomp appropriately 11756 003722'01 124 02 0 01 000000 dmovem t2, (t1) ;[196] Save a double value 11757 003723'01 254 00 0 00 003725' else. ;[196] No, it's a single value 11758 003724'01 202 02 0 01 000000 movem t2, (t1) ; Save the value. 11759 003725'01 endif. ;[196] 11760 003725'01 263 17 0 00 000000 ret 11761 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 72 K20PAR MAC 7-Jun-23 14:23 SET ITS-BINARY command 11762 subttl SET ITS-BINARY command 11763 11764 chgsec(code,const) ;;FDB's are not in code, they're in const 11765 001250'02 000002 000000 sitfdb: flddb. .cmkey,,offon,,on 11766 001251'02 000000 001077' 11767 001252'02 000000 000000 11768 001253'02 44 07 0 00 002225' 11769 retsec ;;Back to where-ever we started from 11770 11771 003726'01 200 16 0 00 000000# .setit: guide ; Issue guide word. 11772 003727'01 260 17 0 00 003701* 11773 001254'02 000000000000# 11774 001422'04 146 157 162 155 141 11775 003730'01 201 01 0 00 000000# movei t1, sitfdb 11776 003731'01 260 17 0 00 003703* call rfield ; Parse a keyword. 11777 003732'01 550 02 0 02 000000 hrrz t2, (t2) ; Get the value for the keyword (0 or 1). 11778 003733'01 202 02 0 00 003714* movem t2, pars3 ; Save into pars3. 11779 003734'01 336 00 0 00 003706* skipn definf ;[77] In DEFINE? 11780 003735'01 260 17 0 00 003707* confrm ;[77] No, get confirmation. 11781 003736'01 263 17 0 00 000000 ret 11782 11783 remark SET ITS-BINARY semantic action 11784 11785 003737'01 $setit: extern itsflg ; and of our necessary 11786 003737'01 200 01 0 00 003733* move t1, pars3 ; Just save the value in the ITS flag. 11787 003740'01 202 01 0 00 003470* movem t1, itsflg 11788 003741'01 476 00 0 00 003475* setom autbyt ;[232] Force auto-byte 11789 003742'01 402 00 0 00 003477* setzm tbtflg ;[232] Clear 36 bit byte size 11790 003743'01 402 00 0 00 003476* setzm ebtflg ;[232] Clear 8 bit byte size 11791 003744'01 263 17 0 00 000000 ret 11792 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 73 K20PAR MAC 7-Jun-23 14:23 SET prompt command 11793 subttl SET prompt command 11794 11795 ; Originally [137], but greatly rewritten here. Also allows prompt 11796 ; to be part of DEFINE. The advantage is that you can have the macro 11797 ; set the prompt to be the name of the macro, which can help you recall 11798 ; what parameters you have in effect. 11799 ; 11800 ; Added C-escape-sequence expansion to actually count the string in 11801 ; the atom buffer. Added character counting and limits to eliminate 11802 ; the dreaded Charlie C. Kim effect, an early indication of the necessity 11803 ; of the Kermit protocol. 11804 11805 ; N.B., Note how argument is passed in .CMDEF, this is a MACRO limitation 11806 11807 chgsec(code,const) ;;FDB's are not in code, they're in const 11808 001255'02 021006 001261' kprmpt: fld(.cmqst,cm%fnc)!cm%hpp!cm%dpp!kprmp1 ;[190] .cmfnp 11809 001256'02 000000 000000 0 ;[190] .cmdat (none) 11810 001257'02 000000000000# cascii () ;[190] .cmhlp 11811 001424'04 113 105 122 115 111 11812 001260'02 000000000000# cascii ("Kermit-20>") ;[190] .cmdef 11813 001432'04 042 113 145 162 155 11814 001261'02 017004 000000 kprmp1: fld(.cmtxt,cm%fnc)!cm%hpp ;[190] .cmfnp 11815 001262'02 000000 000000 0 ;[190] .cmdat (none) 11816 001263'02 000000000000# cascii () ;[190] .cmhlp 11817 001435'04 113 105 122 115 111 11818 retsec ;;Restore psects 11819 11820 extern chrtab ,cescxp ;[203] C-escape-sequence expansion 11821 11822 003745'01 200 16 0 00 000000# .setpr: guide ; Parse the rest of the SET PROMPT command. 11823 003746'01 260 17 0 00 003727* 11824 001264'02 000000000000# 11825 001443'04 164 157 000 000 000 11826 003747'01 403 01 0 00 000002 setzb t1, t2 ;[190] Cons up some .chnul 11827 003750'01 124 01 0 00 003654* dmovem t1, atmbuf ;[190] Give the atom buffer a scrub a dub 11828 003751'01 336 00 0 00 000407* ifmn. vtermf ;[186] If virtual terminal, then use local name 11829 003752'01 254 00 0 00 003765' 11830 003753'01 265 16 0 00 002532* anstkv (t4,^d4) ;[190] Build the fdb on the fly 11831 003754'01 000000 000004 11832 003755'01 415 04 0 17 777773 11833 003756'01 120 01 0 00 000000# dmove t1, kprmpt ;[190] Load fdb and default (none) 11834 003757'01 124 01 0 04 000000 dmovem t1, .cmfnp(t4) ;[190] Store both in dynamic block 11835 003760'01 200 01 0 00 000000# move t1,kprmpt+.cmhlp ;[190] Load the help text pointer 11836 003761'01 561 02 0 00 000000* hrroi t2, myprom ;[190] But default prompt is our node name 11837 003762'01 124 01 0 04 000002 dmovem t1, .cmhlp(t4) ;[190] Store both in dynamic block 11838 003763'01 200 01 0 00 000004 move t1, t4 ;[190] Load pointer to new fdb 11839 003764'01 254 00 0 00 003766' else. ;[190] Otherwise use vanilla default 11840 003765'01 201 01 0 00 000000# movei t1, kprmpt ;[190] Original prompt 11841 003766'01 endif. ;[190] End dynamic fdb build 11842 11843 003766'01 260 17 0 00 003731* call rfield ;[190] Parse for some kind of string 11844 dmove t1, [point 7, prompt ;[203] Expand the atom buffer 11845 003767'01 120 01 0 00 005204' point 7, atmbuf] ;[203] into here. 11846 dmove t3, [ probln-1 ;[203] Prompt length limit (include NUL) 11847 003770'01 120 03 0 00 005206' chrtab ] ;[203] Not doing upper casing k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 73-1 K20PAR MAC 7-Jun-23 14:23 SET prompt command 11848 003771'01 260 17 0 00 001021* call cescxp ;[203] Expand any C-escape-sequences 11849 003772'01 254 00 0 00 004003' ifskp. ;[203] Worked!!!! 11850 003773'01 302 03 0 00 000162 caie t3, ;[203] OK, so... Did we actually do anything? 11851 003774'01 254 00 0 00 004000' ifskp. ;[203] No, blow out of here 11852 003775'01 200 01 0 00 000000# emsg ;[203] 11853 003776'01 104 00 0 00 000313 11854 001265'02 000000000000# 11855 001444'04 105 155 160 164 171 11856 003777'01 254 00 0 00 003625* jrst cmder1 ;[203] Allow reparse 11857 004000'01 endif. 11858 004000'01 271 03 0 00 000001 addi t3, ^d1 ;[203] Account for the trailing NUL 11859 004001'01 202 03 0 00 003737* movem t3, pars3 ;[203] Store length for semantic action 11860 004002'01 254 00 0 00 004004' else. ;[203] Something failed 11861 remark cescxp ;[203] Sub-routine already whined for us 11862 004003'01 254 00 0 00 003777* jrst cmder1 ;[203] Allow reparse 11863 004004'01 endif. ;[203] End escape result processing 11864 004004'01 336 00 0 00 003734* skipn definf ;[77] In DEFINE? 11865 004005'01 260 17 0 00 003735* confrm ;[77] No, get confirmation. 11866 11867 004006'01 263 17 0 00 000000 ret 11868 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 74 K20PAR MAC 7-Jun-23 14:23 Execute the SET PROMPT command. 11869 subttl Execute the SET PROMPT command. 11870 11871 ; Rewritten for [194] and [203] 11872 11873 ; Quickly copies the expanded, length checked string that 11874 ; .setpr built in the temporary prompt holding area. 11875 11876 004007'01 016 00 0 00 000000 movprm: movslj 0,0 ;[203] Move string left justified (fastest) 11877 004010'01 000000 000000 .chnul ;[203] No fill, actually 11878 11879 004011'01 265 16 0 00 005104' $setpr: saveac ;[203] Don't let piggy movslj trash these 11880 004012'01 337 01 0 00 004001* skipg t1, pars3 ;[203] Check and load length (which includes NUL) 11881 004013'01 263 17 0 00 000000 ret ;[203] Punt if nothing or gubbish 11882 004014'01 200 02 0 00 005210' move t2,[point 7,prompt] ;[203] Source 11883 004015'01 403 03 0 00 000006 setzb t3, q2 ;[203] Section local pointers 11884 004016'01 200 04 0 00 000001 move t4, t1 ;[203] Equal lengths; no filling 11885 004017'01 200 05 0 00 005211' move q1,[point 7, prompx] ;[203] What dpromp will use 11886 004020'01 123 01 0 00 004007' extend t1, movprm ;[203] Copy the string over, wee!! 11887 004021'01 600 00 0 00 000000 nop ;[203] Ignore +1 which should never happen 11888 004022'01 263 17 0 00 000000 ret ;[203] That's it, really 11889 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 75 K20PAR MAC 7-Jun-23 14:23 SET RETRY command 11890 subttl SET RETRY command 11891 11892 001266'02 000000 000000 %table(retrtb) ;[194] 11893 001267'02 000000# 000000 %key2 ,0 ;[194] 11894 000772'03 151 156 151 164 151 11895 001270'02 000000# 000001 %key2 ,1 ;[194] 11896 000776'03 160 141 143 153 145 11897 001266'02 000002 000002 %tbend ;[194] 11898 11899 chgsec(code,const) ;;FDB's are not in code, they're in const 11900 001271'02 000002 000000 srefdb: flddb. .cmkey,,retrtb,,,, ;[194] 11901 001272'02 000000 001266' 11902 001273'02 000000 000000 11903 001274'02 44 07 0 00 002743' 11904 001275'02 001006 000000 srifdb: flddb. .cmnum,,^d10,,5,, 11905 001276'02 000000 000012 11906 001277'02 44 07 0 00 002745' 11907 001300'02 44 07 0 00 001767' 11908 001301'02 001006 000000 srpfdb: flddb. .cmnum,,^d10,,16 11909 001302'02 000000 000012 11910 001303'02 44 07 0 00 002760' 11911 001304'02 44 07 0 00 002772' 11912 retsec ;;Back to where-ever we started from 11913 11914 004023'01 200 16 0 00 000000# .setre: guide ;[37] SET RETRY 11915 004024'01 260 17 0 00 003746* 11916 001305'02 000000000000# 11917 001450'04 155 141 170 151 155 11918 004025'01 201 01 0 00 000000# movei t1, srefdb ;[194] 11919 004026'01 260 17 0 00 003766* call rfield 11920 004027'01 550 02 0 02 000000 hrrz t2, (t2) ; Get the keyword index 11921 004030'01 202 02 0 00 004012* movem t2, pars3 11922 004031'01 200 16 0 00 000000# guide ; Prompt for the value 11923 004032'01 260 17 0 00 004024* 11924 001306'02 000000000000# 11925 001453'04 164 157 000 000 000 11926 004033'01 201 01 0 00 000000# movei t1, srifdb ;[194] Let's assume it was initial-connection 11927 004034'01 332 00 0 00 004030* skipe pars3 ;[194] But!! Was it? 11928 004035'01 201 01 0 00 000000# movei t1, srpfdb ;[194] No, doing it for packets 11929 004036'01 260 17 0 00 004026* call rfield 11930 004037'01 202 02 0 00 003715* movem t2, pars4 11931 11932 004040'01 325 02 0 00 004060' ifl. t2 ;[194] Negative counts are silly 11933 004041'01 200 01 0 00 000000# emsg ;[187] 11934 004042'01 104 00 0 00 000313 11935 001307'02 000000000000# 11936 001454'04 101 040 156 145 147 11937 004043'01 336 00 0 00 004034* ifmn. pars3 ;[194] Set if packets 11938 004044'01 254 00 0 00 004051' 11939 004045'01 200 01 0 00 000000# txmsg ;[194] 11940 004046'01 104 00 0 00 000076 11941 004047'01 320 12 0 00 004050' 11942 001310'02 000000000000# 11943 001462'04 160 141 143 153 145 11944 004050'01 254 00 0 00 004054' else. ;[187] k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 75-1 K20PAR MAC 7-Jun-23 14:23 SET RETRY command 11945 004051'01 200 01 0 00 000000# txmsg ;[194] 11946 004052'01 104 00 0 00 000076 11947 004053'01 320 12 0 00 004054' 11948 001311'02 000000000000# 11949 001465'04 151 156 151 164 151 11950 004054'01 endif. ;[187] 11951 004054'01 200 01 0 00 000000# txmsg < is illogical> ;[194] Go tell 'em, Spock-o 11952 004055'01 104 00 0 00 000076 11953 004056'01 320 12 0 00 004057' 11954 001312'02 000000000000# 11955 001473'04 040 151 163 040 151 11956 004057'01 254 00 0 00 004003* jrst cmder1 ;[194] 11957 004060'01 endif. ;[194] 11958 11959 004060'01 336 00 0 00 004004* skipn definf ;[77] In DEFINE? 11960 004061'01 260 17 0 00 004005* confrm ;[77] No, get confirmation. 11961 004062'01 263 17 0 00 000000 ret 11962 11963 remark SET RETRY semantic action 11964 11965 004063'01 $setre: extern imxtry, maxtry ; Our necessaries 11966 004063'01 120 01 0 00 004043* dmove t1, pars3 ;[37] SET RETRY 11967 remark t2, pars4 ;[194] 11968 004064'01 202 02 1 01 005212' movem t2, @[exp imxtry, maxtry](t1) 11969 004065'01 263 17 0 00 000000 ret 11970 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 76 K20PAR MAC 7-Jun-23 14:23 SET SPEED (BAUD RATE) 11971 subttl SET SPEED (BAUD RATE) 11972 11973 001313'02 000000 000000 %table(baudtb) ;Table of DH11 supported speeds 11974 001314'02 000000# 000156 %key2 <110>,^d110 11975 001000'03 061 061 060 000 000 11976 001315'02 000000# 002260 %key2 <1200>,^d1200 11977 001001'03 061 062 060 060 000 11978 001316'02 000000# 000226 %key2 <150>,^d150 11979 001002'03 061 065 060 000 000 11980 001317'02 000000# 003410 %key2 <1800>,^d1800 11981 001003'03 061 070 060 060 000 11982 001320'02 000000# 003720 %key2 <2000>,^d2000 11983 001004'03 062 060 060 060 000 11984 001321'02 000000# 004540 %key2 <2400>,^d2400 11985 001005'03 062 064 060 060 000 11986 001322'02 000000# 000454 %key2 <300>,^d300 11987 001006'03 063 060 060 000 000 11988 001323'02 000000# 007020 %key2 <3600>,^d3600 11989 001007'03 063 066 060 060 000 11990 001324'02 000000# 011300 %key2 <4800>,^d4800 11991 001010'03 064 070 060 060 000 11992 001325'02 000000# 001130 %key2 <600>,^d600 11993 001011'03 066 060 060 000 000 11994 001326'02 000000# 016040 %key2 <7200>,^d7200 11995 001012'03 067 062 060 060 000 11996 001327'02 000000# 022600 %key2 <9600>,^d9600 11997 001013'03 071 066 060 060 000 11998 001313'02 000014 000014 %tbend 11999 12000 chgsec(code,const) ;;FDB's are not in code, they're in const 12001 001330'02 000000 000000 sxpfdb: flddb. .cmkey,,baudtb 12002 001331'02 000000 001313' 12003 retsec ;;Back to where-ever we started from 12004 12005 004066'01 200 16 0 00 000000# .setxp: guide 12006 004067'01 260 17 0 00 004032* 12007 001332'02 000000000000# 12008 001476'04 164 157 000 000 000 12009 004070'01 201 01 0 00 000000# movei t1, sxpfdb 12010 004071'01 260 17 0 00 004036* call rfield 12011 004072'01 550 02 0 02 000000 hrrz t2, (t2) ; Get the value for the keyword (0 or 1). 12012 004073'01 202 02 0 00 004063* movem t2, pars3 ; Save into pars3. 12013 004074'01 336 00 0 00 004060* skipn definf ;[77] In DEFINE? 12014 004075'01 260 17 0 00 004061* confrm ;[77] No, get confirmation. 12015 004076'01 263 17 0 00 000000 ret 12016 12017 remark SET SPEED semantic action 12018 12019 004077'01 $setsp: extern netjfn, vtermf ;[194] Our necessaries 12020 extern speed, setspd ;[194] These, too 12021 extern ttyjfn ;[186] 12022 12023 004077'01 336 00 0 00 003751* ifmn. vtermf ;[186] SET SPEED is senseless if virtual 12024 004100'01 254 00 0 00 004110' 12025 004101'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 15:18 11-Jun-23 Page 76-1 K20PAR MAC 7-Jun-23 14:23 SET SPEED (BAUD RATE) 12026 004102'01 476 00 0 00 000000* setom setspd ;[186] Kind of set the speed... 12027 004103'01 334 00 0 00 000000 %ermsg (,r) 12028 004104'01 254 00 0 00 004110' 12029 004105'01 265 01 0 00 002360* 12030 004106'01 000000000000# 12031 004107'01 254 00 0 00 003677* 12032 001477'04 103 141 156 040 156 12033 004110'01 endif. ;[186] End case non-physical terminal 12034 12035 004110'01 200 03 0 00 004073* move t3, pars3 ; Get the speed that was parsed. 12036 004111'01 202 03 0 00 004101* movem t3, speed ; Record it. 12037 004112'01 337 01 0 00 000000* skipg t1, netjfn ;[186] Get the output terminal JFN. 12038 004113'01 200 01 0 00 001031* move t1, ttyjfn ;[186] Unless using local terminal 12039 004114'01 201 02 0 00 000026 movx t2, .mospd ; Speed to set. 12040 004115'01 504 03 0 00 004111* hrl t3, speed ; Input and output speeds the same. 12041 004116'01 104 00 0 00 000077 MTOPR ; Attempt to set it. 12042 004117'01 320 12 0 00 004121' %jserr (,r) 12043 004120'01 254 00 0 00 004124' 12044 004121'01 265 01 0 00 004105* 12045 004122'01 000000 000000 12046 004123'01 254 00 0 00 004107* 12047 004124'01 476 00 0 00 004102* setom setspd ;[161] Flag that speed was explicitly set. 12048 004125'01 263 17 0 00 000000 ret 12049 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 77 K20PAR MAC 7-Jun-23 14:23 SET SERVER-TIMEOUT semantic action 12050 subttl SET SERVER-TIMEOUT semantic action 12051 12052 ; Command is at a higher level because this is where Kermit-10 puts it 12053 ; and I keep mixing the two up. 12054 ; 12055 ; Further, it seems counter-intuitive to put server-timeout in as a 12056 ; receive option when what is actually happening is that the server is 12057 ; *sending* and not recieving. 12058 ; 12059 ; None the less, this way to do it is invisible and the other is 12060 ; visible because that's the way it's always been. 12061 ; 12062 ; Parse is handled by common .setim. 12063 12064 004126'01 120 01 0 00 004037* $setst: dmove t1, pars4 ;[217] Load milliseconds and floating seconds 12065 004127'01 124 01 0 00 000000* dmovem t1, srvtim## ;[217] Store them 12066 004130'01 263 17 0 00 000000 ret ;[217] That's it, really 12067 12068 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 78 K20PAR MAC 7-Jun-23 14:23 SET TVT-BINARY command 12069 subttl SET TVT-BINARY command 12070 12071 001333'02 000000 000000 %table(tvtkey) ;[182] Table for parsing TVT keywords 12072 001334'02 000000# 000000# %key3 , 0, 1 ;[182] Figure it out for me 12073 001014'03 141 165 164 157 155 12074 001016'03 000000 000001 12075 001335'02 000000# 000000# %key3 , 0, 0 ;[182] Override to never negotiate 12076 001017'03 157 146 146 000 000 12077 001020'03 000000 000000 12078 001336'02 000000# 000000# %key3 , 1, 0 ;[182] Override to ALWAYS negotiate 12079 001021'03 157 156 000 000 000 12080 001022'03 000001 000000 12081 001333'02 000003 000003 %tbend ;[182] Which will break on LAT, CTERM, etc.. 12082 12083 chgsec(code,const) ;;FDB's are not in code, they're in const 12084 001337'02 000002 000000 stafdb: flddb. .cmkey,,tvtkey,,automatic ;[194] 12085 001340'02 000000 001333' 12086 001341'02 000000 000000 12087 001342'02 44 07 0 00 002773' 12088 retsec ;;Back to where-ever we started from 12089 12090 004131'01 200 16 0 00 000000# .setta: guide 12091 004132'01 260 17 0 00 004067* 12092 001343'02 000000000000# 12093 001511'04 156 145 147 157 164 12094 004133'01 201 01 0 00 000000# movei t1, stafdb ;[182] 12095 004134'01 260 17 0 00 004071* call rfield ; Parse a keyword. 12096 004135'01 550 02 0 02 000000 hrrz t2, (t2) ; Get the value for the keyword (0 or 1). 12097 004136'01 202 02 0 00 004110* movem t2, pars3 ; Save into pars3. 12098 004137'01 336 00 0 00 004074* skipn definf ;[77] In DEFINE? 12099 004140'01 260 17 0 00 004075* confrm ;[77] No, get confirmation. 12100 004141'01 263 17 0 00 000000 ret 12101 12102 remark SET TVT-BINARY semantic action 12103 12104 ; Request binary-mode negotion with ARPAnet TAC. 12105 ; 12106 ;[129] This command added as part of edit 129. 12107 ;[182] Help message updated for automatic mode 12108 12109 004142'01 $setta: extern tvtflg, tvtchk ;[194] Our necessaries 12110 extern chktvt ;[194] Ditto 12111 12112 004142'01 200 01 0 00 004136* move t1, pars3 ; Get the value that was parsed. 12113 004143'01 200 02 0 01 000000 move t2,(t1) ;[182] De-reference to get values 12114 004144'01 550 03 0 00 000002 hrrz t3,t2 ;[182] Right halfword is automatic mode 12115 004145'01 554 02 0 00 000002 hlrz t2,t2 ;[182] Left halfword is the TVT-Binary mode 12116 004146'01 326 03 0 00 004151' ife. t3 ;[194] Setting automatic mode? 12117 004147'01 124 02 0 00 000000* dmovem t2,tvtflg ;[182] No, override both TVT line 12118 004150'01 263 17 0 00 000000 ret ;[182] and turn off line discovery 12119 004151'01 endif. ;[194] 12120 12121 004151'01 250 03 0 00 000000* exch t3, tvtchk ;[182] Update TVT checking mode, get old mode 12122 004152'01 326 03 0 00 004123* jumpn t3,R ;[182] Wants automatic and it was already set? 12123 004153'01 332 00 0 00 004077* skipe vtermf ;[186] Virtual terminal? k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 78-1 K20PAR MAC 7-Jun-23 14:23 SET TVT-BINARY command 12124 004154'01 263 17 0 00 000000 ret ;[186] NRT and PTY don't do TVT 12125 004155'01 260 17 0 00 000000* call chktvt ;[182] Went from override to automatic, check 12126 004156'01 263 17 0 00 000000 ret ; Done. 12127 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 79 K20PAR MAC 7-Jun-23 14:23 SET RECEIVE parameters 12128 subttl SET RECEIVE parameters 12129 12130 001344'02 000000 000000 %table(srtabl) 12131 001345'02 000000# 000000# %key3 , .seteo, reolch## 12132 001023'03 145 156 144 055 157 12133 001026'03 000000# 000000* 12134 001346'02 000000# 000000# %key3 , .setpk, rpsiz## 12135 001027'03 160 141 143 153 145 12136 001032'03 000000# 000000* 12137 001347'02 000000# 000000# %key3 , .setpc, rpadch## 12138 001033'03 160 141 144 143 150 12139 001035'03 000000# 000000* 12140 001350'02 000000# 000000# %key3 , .setpd, rpadn## 12141 001036'03 160 141 144 144 151 12142 001040'03 000000# 000000* 12143 001351'02 000000# 000000# %key3 , .srpau, rpause## ;[36] 12144 001041'03 160 141 165 163 145 12145 001043'03 000000# 000000* 12146 001352'02 000000# 000000# %key3 , .setqu, rquote## 12147 001044'03 161 165 157 164 145 12148 001046'03 000000# 000000* 12149 001353'02 000000# 000000# %key3 , .setim, srvtim## ;[137] 12150 001047'03 163 145 162 166 145 12151 001052'03 000000# 000000* 12152 001354'02 000000# 000000# %keyf4 , .setim, srvtim##, cm%inv ;[212] keep typing this.. 12153 001053'03 002000 000001 12154 001054'03 163 162 166 055 164 12155 001057'03 000000# 001052* 12156 001355'02 000000# 000000# %key3 , .setsp, rsthdr## ;[18] 12157 001060'03 163 164 141 162 164 12158 001064'03 000000# 000000* 12159 001356'02 000000# 000000# %key3 , .setim, rtimou## 12160 001065'03 164 151 155 145 157 12161 001067'03 000000# 000000* 12162 001344'02 000012 000012 %tbend 12163 12164 chgsec(code,const) ;;FDB's are not in code, they're in const 12165 001357'02 000000 000000 srcfdb: flddb. .cmkey,,srtabl,,, 12166 001360'02 000000 001344' 12167 retsec ;;Back to where-ever we started from 12168 12169 004157'01 201 01 0 00 000000# .setrc: movei t1, srcfdb ; SET RECEIVE ... 12170 004160'01 260 17 0 00 004134* call rfield ; Parse a keyword. 12171 004161'01 550 02 0 02 000000 hrrz t2, (t2) ; Get the command routine addresses. 12172 004162'01 202 02 0 00 004142* movem t2, pars3 ; Save into pars3. 12173 004163'01 554 01 0 02 000000 hlrz t1, (t2) ; Get the next level routine. 12174 004164'01 260 17 0 01 000000 call (t1) ; Call it. 12175 004165'01 263 17 0 00 000000 ret 12176 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 80 K20PAR MAC 7-Jun-23 14:23 SET SEND parameters 12177 subttl SET SEND parameters 12178 12179 001361'02 000000 000000 %table(sstabl) 12180 001362'02 000000# 000000# %key3 , .seteo, seolch## 12181 001070'03 145 156 144 055 157 12182 001073'03 000000# 000000* 12183 001363'02 000000# 000000# %key3 , .setpk, spsiz## 12184 001074'03 160 141 143 153 145 12185 001077'03 000000# 000000* 12186 001364'02 000000# 000000# %key3 , .setpc, spadch## 12187 001100'03 160 141 144 143 150 12188 001102'03 000000# 000000* 12189 001365'02 000000# 000000# %key3 , .setpd, spadn## 12190 001103'03 160 141 144 144 151 12191 001105'03 000000# 000000* 12192 001366'02 000000# 000000# %key3 , .sspau, spause## ;[35] 12193 001106'03 160 141 165 163 145 12194 001110'03 000000# 000000* 12195 001367'02 000000# 000000# %key3 , .setqu, squote## 12196 001111'03 161 165 157 164 145 12197 001113'03 000000# 000000* 12198 001370'02 000000# 000000# %key3 , .setsp, ssthdr## ;[18] 12199 001114'03 163 164 141 162 164 12200 001120'03 000000# 000000* 12201 001371'02 000000# 000000# %key3 , .setim, stimou## 12202 001121'03 164 151 155 145 157 12203 001123'03 000000# 000000* 12204 001361'02 000010 000010 %tbend 12205 12206 chgsec(code,const) ;;FDB's are not in code, they're in const 12207 001372'02 000000 000000 ssnfdb: flddb. .cmkey,,sstabl,,, 12208 001373'02 000000 001361' 12209 retsec ;;Back to where-ever we started from 12210 12211 004166'01 201 01 0 00 000000# .setsn: movei t1, ssnfdb ; SET SEND ... 12212 004167'01 260 17 0 00 004160* call rfield ; Parse a keyword. 12213 004170'01 550 02 0 02 000000 hrrz t2, (t2) ; Get the command routine addresses. 12214 004171'01 202 02 0 00 004162* movem t2, pars3 ; Save into pars3. 12215 004172'01 554 01 0 02 000000 hlrz t1, (t2) ; Get the next level routine. 12216 004173'01 260 17 0 01 000000 call (t1) ; Call it. 12217 004174'01 263 17 0 00 000000 ret 12218 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 81 K20PAR MAC 7-Jun-23 14:23 SET SEND/RECEIVE END-OF-LINE secondary parsing 12219 subttl SET SEND/RECEIVE END-OF-LINE secondary parsing 12220 12221 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 12222 001374'02 013001 001376' eolfdm: flddb. .cmcma,cm%sdh,,,,eolfdb ;[217] Used when unwinding a macro 12223 001375'02 000000 000000 12224 001376'02 010004 001401' eolfdb: flddb. .cmcfm,,,,,eolfd1 12225 001377'02 000000 000000 12226 001400'02 44 07 0 00 002775' 12227 001401'02 001004 001404' eolfd1: flddb. .cmnum,,^d8,,,eolfd2 12228 001402'02 000000 000010 12229 001403'02 44 07 0 00 002474' 12230 001404'02 023004 000000 eolfd2: flddb. .cmtok,,token(<^>),,, 12231 001405'02 440700 002507' 12232 001406'02 44 07 0 00 002510' 12233 retsec ;;Back to where-ever we started from 12234 cleans() 12235 12236 004175'01 265 16 0 00 005022' .seteo: saveac ;[217] Needs registers 12237 004176'01 200 16 0 00 000000# guide 12238 004177'01 260 17 0 00 004132* 12239 001407'02 000000000000# 12240 001514'04 164 157 000 000 000 12241 004200'01 201 01 0 00 000000# movei t1, eolfdb ;[217] Point to enhanced parse list 12242 004201'01 332 00 0 00 000000# skipe mdone ;[217] Unwinding a macro? 12243 004202'01 201 01 0 00 000000# movei t1, eolfdm ;[217] Yes, allow a comma to squeak through 12244 12245 004203'01 260 17 0 00 003554* call rflde ;[217] Try to get one of them 12246 004204'01 254 00 0 00 004211' ifskp. ;[217] Worked!! 12247 004205'01 120 06 0 00 000002 dmove q2, t2 ;[217] Save some of the parse results 12248 004206'01 135 05 0 00 005174' ldb q1, [pointr (.cmfnp(q3),cm%fnc)] ;[217] Get function code. 12249 004207'01 200 10 0 00 000005 move q4, q1 ;[217] Save original parse 12250 004210'01 254 00 0 00 004214' else. ;[217] Otherwise, failed the parse 12251 004211'01 336 00 0 00 004137* skipn definf ;[217] In DEFINE? 12252 004212'01 254 00 0 00 003565* jrst cmderr ;[217] No, then a definite parse error; allow retry 12253 004213'01 263 17 0 00 000000 ret ;[217] Return into DEFINE and see if that chokes 12254 004214'01 endif. ;[217] End handling COMND% returns 12255 12256 004214'01 302 05 0 00 000013 caie q1, .cmcma ;[217] Parsed a comma? 12257 004215'01 254 00 0 00 004220' ifskp. ;[217] We did, so must be unwinding a macro 12258 004216'01 201 05 0 00 000010 movei q1, .cmcfm ;[217] Turn it into a confirm and carry on 12259 004217'01 200 10 0 00 000005 move q4, q1 ;[217] Stomp it in as a confirm 12260 004220'01 endif. 12261 12262 004220'01 302 05 0 00 000010 caie q1, .cmcfm ;[217] A confirm is very special cased 12263 004221'01 254 00 0 00 004226' ifskp. ;[217] It was, so default it 12264 004222'01 201 01 0 00 000015 movei t1, .chcrt ;[217] Replace parse value with carriage return 12265 004223'01 260 17 1 00 003636* call @parity ;[223] Put any necessary parity on it 12266 004224'01 202 01 0 00 004126* movem t1, pars4 ;[217] Save the EOL char we parsed. 12267 004225'01 263 17 0 00 000000 ret ;[217] Done, nothing left to parse 12268 004226'01 endif. ;[217] 12269 12270 004226'01 306 05 0 00 000001 cain q1, .cmnum ;[217] Number? 12271 004227'01 254 00 0 00 004261' jrst .sete1 ;[217] Yes, this must be checked 12272 12273 remark q1, .cmtok ;[217] Otherwise, must have been a token k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 81-1 K20PAR MAC 7-Jun-23 14:23 SET SEND/RECEIVE END-OF-LINE secondary parsing 12274 dmove t1, [ esctkn ;[217] Possible mnemonics 12275 004230'01 120 01 0 00 005214' cm%xif ] ;[217] Load the no indirection flag 12276 004231'01 436 02 0 00 000000# orm t2, sbk+.cmflg ;[217] And dink the COMND% state block 12277 004232'01 260 17 0 00 004203* call rflde ;[217] Try to get one of them 12278 004233'01 254 00 0 00 004241' ifskp. ;[217] Worked!! 12279 004234'01 135 05 0 00 005021' ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ;[217] Get function code. 12280 004235'01 120 06 0 00 000002 dmove q2, t2 ;[217] Save parse data and fdb selection 12281 remark q4, ;[217] Leave original parse item alone 12282 004236'01 205 04 0 00 002000 movx t4, cm%xif ;[217] Load indirection flag again 12283 004237'01 412 04 0 00 000000# andcam t4, sbk+.cmflg ;[217] And restore the COMND% state block 12284 004240'01 254 00 0 00 004244' else. ;[217] Otherwise, failed the parse 12285 004241'01 205 04 0 00 002000 movx t4, cm%xif ;[217] Load indirection flag again 12286 004242'01 412 04 0 00 000000# andcam t4, sbk+.cmflg ;[217] restore the COMND% state block 12287 004243'01 254 00 0 00 004212* jrst cmderr ;[217] And handle the parse error, allowing reparse 12288 004244'01 endif. ;[217] End handling COMND% returns 12289 12290 004244'01 302 05 0 00 000000 caie q1, .cmkey ;[217] Was this relatively easy? 12291 004245'01 254 00 0 00 004250' ifskp. ;[217] Yep, let's grab and convert the character 12292 004246'01 550 02 0 06 000000 hrrz t2, (q2) ;[217] Pick up what would be the jump address 12293 004247'01 254 00 0 00 004261' jrst .sete1 ;[217] Make sure a valid choice 12294 004250'01 endif. 12295 12296 remark q1, .cmtok ;[217] A token is somewhat more difficult 12297 004250'01 621 07 0 00 777777 tlz q3, -1 ;[217] Isolate fdb we actually used 12298 004251'01 200 06 0 07 000001 move q2, .cmdat(q3) ;[217] Pick up the byte pointer to the character 12299 004252'01 134 02 0 00 000006 ildb t2, q2 ;[217] Load the token character (only one) 12300 004253'01 275 02 0 00 000100 subi t2, "@" ;[217] Bring down to control character range 12301 004254'01 312 02 0 00 005177' came t2, [-21] ;[217] Typed a rubout? 12302 004255'01 254 00 0 00 004261' ifskp. ;[217] Not valid as EOL 12303 004256'01 200 01 0 00 000000# emsg ;[217] Whine 12304 004257'01 104 00 0 00 000313 12305 001410'02 000000000000# 12306 001515'04 115 141 171 040 156 12307 004260'01 254 00 0 00 004057* jrst cmder1 ;[217] Allow a retry 12308 004261'01 endif. ;[217] Otherwise, no need to check hardwired values 12309 remark .sete1 ;[217] Double check for other funnyness 12310 12311 004261'01 325 02 0 00 004265' .sete1: ifl. t2 ;[194] A negative ASCII character value is silly 12312 004262'01 200 01 0 00 000000# emsg ;[217] So whine about it 12313 004263'01 104 00 0 00 000313 12314 001411'02 000000000000# 12315 001527'04 116 145 147 141 164 12316 004264'01 254 00 0 00 004260* jrst cmder1 ;[217] Allow retry (^H) 12317 004265'01 endif. ;[217] 12318 12319 004265'01 305 02 0 00 000200 caige t2, 200 ;[217] Out of ASCII range? 12320 004266'01 254 00 0 00 004272' ifskp. ;[217] Yep, can't handle that, either 12321 004267'01 200 01 0 00 000000# emsg ;[217] Complain 12322 004270'01 104 00 0 00 000313 12323 001412'02 000000000000# 12324 001535'04 101 116 123 111 040 12325 004271'01 254 00 0 00 004264* jrst cmder1 ;[217] Allow retry (^H) 12326 004272'01 endif. ;[217] 12327 12328 004272'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 15:18 11-Jun-23 Page 81-2 K20PAR MAC 7-Jun-23 14:23 SET SEND/RECEIVE END-OF-LINE secondary parsing 12329 004273'01 254 00 0 00 004304' jrst seteor ;[194] No, give error message 12330 12331 004274'01 .sete2: remark ;[217] Here when we don't need to check (or just did) 12332 004274'01 200 01 0 00 000002 move t1, t2 ;[223] Load the character 12333 004275'01 260 17 1 00 004223* call @parity ;[223] Put any necessary parity on it 12334 004276'01 202 01 0 00 004224* movem t1, pars4 ;[223] Save the EOL char we parsed. 12335 remark ;[217] These two instructions are unnecessary, but... 12336 004277'01 306 10 0 00 000010 cain q4, .cmcfm ;[217] Wanted default? 12337 004300'01 263 17 0 00 000000 ret ;[217] Yes, don't confirm the confirmation 12338 004301'01 336 00 0 00 004211* skipn definf ;[77] In DEFINE? 12339 004302'01 260 17 0 00 004140* confrm ;[77] No, get confirmation. 12340 004303'01 263 17 0 00 000000 ret 12341 12342 004304'01 200 04 0 00 000002 seteor: move t4, t2 ;[217] Let's tuck that poor character out of the way 12343 004305'01 200 01 0 00 000000# emsg <"> ;" ;[217] Fire up the complaint department 12344 004306'01 104 00 0 00 000313 12345 001413'02 000000000000# 12346 001550'04 042 000 000 000 000 12347 004307'01 200 01 0 00 000004 move t1, t4 ;[217] Let's expose the bad character 12348 004310'01 260 17 0 00 000000* call putc ;[217] Print it 12349 004311'01 200 01 0 00 000000# txmsg <" is an invalid EOL character> ;[217] " Font crock 12350 004312'01 104 00 0 00 000076 12351 004313'01 320 12 0 00 004314' 12352 001414'02 000000000000# 12353 001551'04 042 040 151 163 040 12354 004314'01 254 00 0 00 004271* jrst cmder1 ;[194] Allow command retry 12355 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 82 K20PAR MAC 7-Jun-23 14:23 SET SEND/RECEIVE PACKET-LENGTH secondary parsing 12356 subttl SET SEND/RECEIVE PACKET-LENGTH secondary parsing 12357 12358 chgsec(code,const) ;;FDB's are not in code, they're in const 12359 001415'02 001005 000000 spkfdb: flddb. .cmnum,cm%sdh,^d10,,, ;[194] 12360 001416'02 000000 000012 12361 001417'02 44 07 0 00 003006' 12362 retsec ;;Back to where-ever we started from 12363 12364 004315'01 200 16 0 00 000000# .setpk: guide 12365 004316'01 260 17 0 00 004177* 12366 001420'02 000000000000# 12367 001557'04 164 157 000 000 000 12368 004317'01 201 01 0 00 000000# movei t1, spkfdb ;[194] 12369 004320'01 260 17 0 00 004167* call rfield ; Parse the packet size. 12370 004321'01 307 02 0 00 000012 caig t2, ^d10 ;[194] Is the number in the right range? 12371 004322'01 254 00 0 00 004331' jrst setpke ;[194] Too small 12372 004323'01 303 02 0 00 021450 caile t2, ^d9000 ;[179] (was ^d94) 12373 004324'01 254 00 0 00 004331' jrst setpke ;[194] Too big 12374 004325'01 202 02 0 00 004276* movem t2, pars4 ; Save the packet size. 12375 004326'01 336 00 0 00 004301* skipn definf ;[77] In DEFINE? 12376 004327'01 260 17 0 00 004302* confrm ;[77] No, get confirmation. 12377 004330'01 263 17 0 00 000000 ret 12378 12379 004331'01 200 01 0 00 000000# setpke: emsg ;[187] 12380 004332'01 104 00 0 00 000313 12381 001421'02 000000000000# 12382 001560'04 111 154 154 145 147 12383 remark ;Maybe type the bad size? 12384 004333'01 254 00 0 00 004314* jrst cmder1 12385 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 83 K20PAR MAC 7-Jun-23 14:23 SET SEND/RECEIVE PADCHAR secondary parsing 12386 subttl SET SEND/RECEIVE PADCHAR secondary parsing 12387 12388 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 12389 001422'02 013001 001424' pdcfdm: flddb. .cmcma,cm%sdh,,,,pdcfdb ;[217] Used when unwinding a macro 12390 001423'02 000000 000000 12391 001424'02 010004 001427' pdcfdb: flddb. .cmcfm,,,,,pdcfd1 12392 001425'02 000000 000000 12393 001426'02 44 07 0 00 003015' 12394 001427'02 001004 001432' pdcfd1: flddb. .cmnum,,^d8,,,pdcfd2 12395 001430'02 000000 000010 12396 001431'02 44 07 0 00 003026' 12397 001432'02 023004 000000 pdcfd2: flddb. .cmtok,,token(<^>),,, 12398 001433'02 440700 002507' 12399 001434'02 44 07 0 00 002510' 12400 retsec 12401 cleans() 12402 12403 004334'01 265 16 0 00 005022' .setpc: saveac ;[217] Needs registers 12404 004335'01 200 16 0 00 000000# guide 12405 004336'01 260 17 0 00 004316* 12406 001435'02 000000000000# 12407 001564'04 164 157 000 000 000 12408 004337'01 201 01 0 00 000000# movei t1, pdcfdb ;[217] Point to enhanced parse list 12409 004340'01 332 00 0 00 000000# skipe mdone ;[217] Unwinding a macro? 12410 004341'01 201 01 0 00 000000# movei t1, pdcfdm ;[217] Yes, allow a comma to squeak through 12411 12412 004342'01 260 17 0 00 004232* call rflde ;[217] Try to get something 12413 004343'01 254 00 0 00 004350' ifskp. ;[217] Worked!! 12414 004344'01 120 06 0 00 000002 dmove q2, t2 ;[217] Partially save the parse results 12415 004345'01 135 05 0 00 005174' ldb q1, [pointr (.cmfnp(q3),cm%fnc)] ;[217] Get function code. 12416 004346'01 200 10 0 00 000005 move q4, q1 ;[217] Save a copy for downstream 12417 004347'01 254 00 0 00 004353' else. ;[217] Otherwise, failed the parse 12418 004350'01 336 00 0 00 004326* skipn definf ;[217] In DEFINE? 12419 004351'01 254 00 0 00 004243* jrst cmderr ;[217] No, then a definite parse error; allow retry 12420 004352'01 263 17 0 00 000000 ret ;[217] Return into DEFINE and see if that chokes 12421 004353'01 endif. ;[217] End handling COMND% returns 12422 12423 004353'01 302 05 0 00 000013 caie q1, .cmcma ;[217] Parsed a comma? 12424 004354'01 254 00 0 00 004357' ifskp. ;[217] We did, so must be unwinding a macro 12425 004355'01 201 05 0 00 000010 movei q1, .cmcfm ;[217] Turn it into a confirm and carry on 12426 004356'01 200 10 0 00 000005 move q4, q1 ;[217] Stomp for downstream 12427 004357'01 endif. 12428 12429 004357'01 302 05 0 00 000010 caie q1, .cmcfm ;[217] A confirm is very special cased 12430 004360'01 254 00 0 00 004365' ifskp. ;[217] It was, so default it 12431 004361'01 201 01 0 00 000000 movei t1, .chnul ;[217] Replace parse value with NUL (ASCII 0) 12432 004362'01 260 17 1 00 004275* call @parity ;[223] Apply any necessary parity 12433 004363'01 202 01 0 00 004325* movem t1, pars4 ;[217] Save the EOL char we parsed. 12434 004364'01 263 17 0 00 000000 ret ;[217] Done, nothing left to parse 12435 004365'01 endif. ;[217] 12436 12437 004365'01 306 05 0 00 000001 cain q1, .cmnum ;[217] Number? 12438 004366'01 254 00 0 00 004415' jrst .setp1 ;[217] Yes, this must be checked 12439 12440 remark q1, .cmtok ;[217] Otherwise, must have been a token k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 83-1 K20PAR MAC 7-Jun-23 14:23 SET SEND/RECEIVE PADCHAR secondary parsing 12441 dmove t1, [ esctkn ;[217] Possible mnemonics 12442 004367'01 120 01 0 00 005216' cm%xif ] ;[217] Load the no indirection flag 12443 004370'01 436 02 0 00 000000# orm t2, sbk+.cmflg ;[217] And dink the COMND% state block 12444 004371'01 260 17 0 00 004342* call rflde ;[217] Try to get one of them 12445 004372'01 254 00 0 00 004400' ifskp. ;[217] Worked!! 12446 004373'01 135 05 0 00 005021' ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ;[217] Get function code. 12447 004374'01 120 06 0 00 000002 dmove q2, t2 ;[217] Save parse data and fdb selection 12448 remark q4, ;[217] Don't touch!! 12449 004375'01 205 04 0 00 002000 movx t4, cm%xif ;[217] Load indirection flag again 12450 004376'01 412 04 0 00 000000# andcam t4, sbk+.cmflg ;[217] And restore the COMND% state block 12451 004377'01 254 00 0 00 004403' else. ;[217] Otherwise, failed the parse 12452 004400'01 205 04 0 00 002000 movx t4, cm%xif ;[217] Load indirection flag again 12453 004401'01 412 04 0 00 000000# andcam t4, sbk+.cmflg ;[217] restore the COMND% state block 12454 004402'01 254 00 0 00 004351* jrst cmderr ;[217] And handle the parse error, allowing reparse 12455 004403'01 endif. ;[217] End handling COMND% returns 12456 12457 004403'01 302 05 0 00 000000 caie q1, .cmkey ;[217] Was this relatively easy? 12458 004404'01 254 00 0 00 004407' ifskp. ;[217] Yep, let's grab and convert the character 12459 004405'01 550 02 0 06 000000 hrrz t2, (q2) ;[217] Pick up what would be the jump address 12460 004406'01 254 00 0 00 004415' jrst .setp1 ;[217] No need to check, these are all fine 12461 004407'01 endif. 12462 12463 remark q1, .cmtok ;[217] A token is somewhat more difficult 12464 004407'01 621 07 0 00 777777 tlz q3, -1 ;[217] Isolate fdb we actually used 12465 004410'01 200 06 0 07 000001 move q2, .cmdat(q3) ;[217] Pick up the byte pointer to the character 12466 004411'01 134 02 0 00 000006 ildb t2, q2 ;[217] Load the token character (only one) 12467 004412'01 275 02 0 00 000100 subi t2, "@" ;[217] Bring down to control character range 12468 004413'01 316 02 0 00 005177' camn t2, [-21] ;[217] Was this our rubout hack? 12469 004414'01 201 02 0 00 000177 movei t2, 177 ;[217] Stomp in the correct value 12470 remark .setp1 ;[217] Falls through to check 12471 12472 004415'01 325 02 0 00 004421' .setp1: ifl. t2 ;[194] A negative ASCII character value is silly 12473 004416'01 200 01 0 00 000000# emsg ;[217] So whine about it 12474 004417'01 104 00 0 00 000313 12475 001436'02 000000000000# 12476 001565'04 116 145 147 141 164 12477 004420'01 254 00 0 00 004333* jrst cmder1 ;[217] Allow retry (^H) 12478 004421'01 endif. ;[217] 12479 12480 004421'01 305 02 0 00 000200 caige t2, 200 ;[217] Out of ASCII range? 12481 004422'01 254 00 0 00 004426' ifskp. ;[217] Yep, can't handle that, either 12482 004423'01 200 01 0 00 000000# emsg ;[217] Complain 12483 004424'01 104 00 0 00 000313 12484 001437'02 000000000000# 12485 001573'04 101 116 123 111 040 12486 004425'01 254 00 0 00 004420* jrst cmder1 ;[217] Allow retry (^H) 12487 004426'01 endif. ;[217] 12488 12489 004426'01 307 02 0 00 000037 caig t2, .chcun ; ...37 octal? 12490 004427'01 254 00 0 00 004433' ifskp. ;[194] Out of control character range 12491 004430'01 306 02 0 00 000177 cain t2, .chdel ;[149] But!! Is it a DEL? 12492 004431'01 254 00 0 00 004433' anskp. ;[194] It is, so that's fine 12493 004432'01 254 00 0 00 004443' jrst setpce ;[194] Otherwise, give error message 12494 004433'01 endif. ;[194] 12495 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 83-2 K20PAR MAC 7-Jun-23 14:23 SET SEND/RECEIVE PADCHAR secondary parsing 12496 004433'01 200 01 0 00 000002 .setp2: move t1, t2 ;[223] Load the character 12497 004434'01 260 17 1 00 004362* call @parity ;[223] Compute any parity 12498 004435'01 202 01 0 00 004363* movem t1, pars4 ;[223] Save the padding char 12499 004436'01 306 10 0 00 000010 cain q4, .cmcfm ;[217] Did we already take all defaults? 12500 004437'01 263 17 0 00 000000 ret ;[217] Yes, don't confirm the confirmation 12501 004440'01 336 00 0 00 004350* skipn definf ;[77] In DEFINE? 12502 004441'01 260 17 0 00 004327* confrm ;[77] No, get confirmation. 12503 004442'01 263 17 0 00 000000 ret ; Yes, OK. 12504 12505 004443'01 200 04 0 00 000002 setpce: move t4, t2 ;[217] Save the poor character 12506 004444'01 200 01 0 00 000000# emsg <"> ;" ;[217] Begin whining 12507 004445'01 104 00 0 00 000313 12508 001440'02 000000000000# 12509 001606'04 042 000 000 000 000 12510 004446'01 200 01 0 00 000004 move t1, t4 ;[217] Load the failing character 12511 004447'01 260 17 0 00 004310* call putc ;[217] Expose it to the world 12512 004450'01 200 01 0 00 000000# txmsg <" is not a valid padding character> ;[217] "Font crock 12513 004451'01 104 00 0 00 000076 12514 004452'01 320 12 0 00 004453' 12515 001441'02 000000000000# 12516 001607'04 042 040 151 163 040 12517 004453'01 254 00 0 00 004425* jrst cmder1 ;[194] and allow command retry. 12518 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 84 K20PAR MAC 7-Jun-23 14:23 SET SEND/RECEIVE PADDING secondary parsing 12519 subttl SET SEND/RECEIVE PADDING secondary parsing 12520 12521 chgsec(code,const) ;;FDB's are not in code, they're in const 12522 001442'02 001006 000000 spdfdb: flddb. .cmnum,,^d10,,<0>, 12523 001443'02 000000 000012 12524 001444'02 44 07 0 00 003037' 12525 001445'02 44 07 0 00 003047' 12526 retsec ;;Back to where-ever we started from 12527 12528 004454'01 200 16 0 00 000000# .setpd: guide 12529 004455'01 260 17 0 00 004336* 12530 001446'02 000000000000# 12531 001616'04 164 157 000 000 000 12532 004456'01 201 01 0 00 000000# movei t1, spdfdb 12533 004457'01 260 17 0 00 004320* call rfield ; Parse the number of padding chars. 12534 004460'01 325 02 0 00 004464' ifl. t2 ;[194] Negative padding is silly 12535 004461'01 200 01 0 00 000000# emsg ;[194] 12536 004462'01 104 00 0 00 000313 12537 001447'02 000000000000# 12538 001617'04 101 040 156 145 147 12539 004463'01 254 00 0 00 004453* jrst cmder1 ;[194] 12540 004464'01 endif. ;[194] 12541 004464'01 307 02 0 00 002000 caig t2, dpadmx ;[194] Rediculously large? 12542 004465'01 254 00 0 00 004471' ifskp. ;[194] Yep, we could go days before sending 12543 004466'01 200 01 0 00 000000# emsg 12544 004467'01 104 00 0 00 000313 12545 001450'02 000000000000# 12546 001627'04 115 141 170 151 155 12547 004470'01 254 00 0 00 004463* jrst cmder1 ;[194] Allow reparse 12548 004471'01 endif. ;[194] 12549 004471'01 202 02 0 00 004435* movem t2, pars4 ; Save the number. 12550 004472'01 336 00 0 00 004440* skipn definf ;[77] In DEFINE? 12551 004473'01 260 17 0 00 004441* confrm ;[77] No, get confirmation. 12552 004474'01 263 17 0 00 000000 ret 12553 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 85 K20PAR MAC 7-Jun-23 14:23 SET SEND/RECEIVE pause secondary parsing 12554 subttl SET SEND/RECEIVE pause secondary parsing 12555 12556 ;[196] Do the calculation from floating (fractional) seconds to 12557 ; integer milliseconds ONCE, here. Doing it every single packet is a 12558 ; pretty gauche use of the processor as it does have other things to 12559 ; do... 12560 12561 chgsec(code,const) ;;FDB's are not in code, they're in const 12562 001451'02 015006 000000 fsrpau: flddb. .cmflt,,,,<0> 12563 001452'02 000000 000000 12564 001453'02 44 07 0 00 003050' 12565 001454'02 44 07 0 00 003047' 12566 001455'02 015006 000000 fsspau: flddb. .cmflt,,,,<0> 12567 001456'02 000000 000000 12568 001457'02 44 07 0 00 003061' 12569 001460'02 44 07 0 00 003047' 12570 retsec ;;Back to where-ever we started from 12571 12572 004475'01 334 01 0 00 005220' .srpau: skipa t1, [fsrpau] ;[196] Address of receive pause fdb 12573 004476'01 201 01 0 00 000000# .sspau: movei t1, fsspau ;[196] Address of send pause fdb 12574 004477'01 200 16 0 00 000000# guide ;[194] 12575 004500'01 260 17 0 00 004455* 12576 001461'02 000000000000# 12577 001636'04 142 145 164 167 145 12578 004501'01 260 17 0 00 004457* call rfield ;[36] pause parsing common code. 12579 004502'01 200 16 0 00 000000# guide 12580 004503'01 260 17 0 00 004500* 12581 001462'02 000000000000# 12582 001642'04 163 145 143 157 156 12583 12584 004504'01 325 02 0 00 004510' ifl. t2 ;[194] Is the number in the right range? 12585 004505'01 200 01 0 00 000000# emsg ;[187] 12586 004506'01 104 00 0 00 000313 12587 001463'02 000000000000# 12588 001644'04 116 145 147 141 164 12589 004507'01 254 00 0 00 004470* jrst cmder1 ;[194] Allow reparse 12590 004510'01 endif. ;[194] 12591 12592 remark ;[212] When chksec works, it works completely 12593 004510'01 260 17 0 00 000000' call chksec ;[196] Ensure number is in correct range 12594 004511'01 254 00 0 00 004513' ifskp. ;[196] Check and convert OK? 12595 remark ;[196] Yes, must confirm later, maybe 12596 004512'01 254 00 0 00 004516' else. ;[196] Otherwise, couldn't swallow something 12597 004513'01 200 01 0 00 000000# emsg ;[187] 12598 004514'01 104 00 0 00 000313 12599 001464'02 000000000000# 12600 001653'04 111 156 164 145 162 12601 004515'01 254 00 0 00 004507* jrst cmder1 ;[194] Allow reparse 12602 004516'01 endif. ;[212] End range check 12603 12604 004516'01 337 01 0 00 004471* skipg t1, pars4 ;[212] Load non-zero milliseconds 12605 004517'01 254 00 0 00 004525' ifskp. ;[212] Let's range check that 12606 004520'01 307 01 0 00 267460 caig t1, maxtim ;[212] Over 94 seconds? 12607 004521'01 254 00 0 00 004525' anskp. ;[212] Nope, safe to use 12608 004522'01 200 01 0 00 000000# emsg ;[212] k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 85-1 K20PAR MAC 7-Jun-23 14:23 SET SEND/RECEIVE pause secondary parsing 12609 004523'01 104 00 0 00 000313 12610 001465'02 000000000000# 12611 001664'04 120 141 165 163 145 12612 004524'01 254 00 0 00 004515* jrst cmder1 ;[212] Out 12613 004525'01 endif. 12614 12615 004525'01 336 00 0 00 004472* skipn definf ;[77] In DEFINE? 12616 004526'01 260 17 0 00 004473* confrm ;[77] No, get confirmation. 12617 004527'01 263 17 0 00 000000 ret 12618 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 86 K20PAR MAC 7-Jun-23 14:23 SET SEND/RECEIVE QUOTE character tables and token definitions 12619 subttl SET SEND/RECEIVE QUOTE character tables and token definitions 12620 12621 define qchrs (c) < ;;[217] Define macro to populate the table 12622 xlist ;;[217] Don't need to see this in the listing 12623 irpc c,< ;;[217] Go through all the characters 12624 %key2 <'c>,<"'c"> ;;[217] Emit character and its ASCII code 12625 >;;irpc ;;[217] End of argument expansion 12626 list ;;[217] Turn the listing back on 12627 >;;qchrs ;;[217] End of macro definition 12628 12629 001466'02 000000 000000 %table(qchtb) ;;[217] Printable character table 12630 qchrs (0123456789) ;;[217] 'Easy' printable numerals 12631 qchrs (ABCDEFGHIJKLMNOPQRSTUVWXYZ) ;;[217] 'Easy' printable characters 12632 001466'02 000044 000044 %tbend ;[217] End of 'easy' table 12633 12634 ;N.B., a number of characters simply do NOT work as tokens 12635 12636 001533'02 000000 000000 %table() ;;[217] Token mnemonics 12637 001534'02 000000# 777700 %key2 ,<-"@"> ;[217] Kind of chokes on this sometimes 12638 001170'03 141 164 055 163 151 12639 001535'02 000000# 777724 %key2 ,<-","> ;[217] Clashes with define 12640 001172'03 143 157 155 155 141 12641 001536'02 000000# 777723 %key2 ,<-"-"> ;[217] Parsed as line continuation, always 12642 001174'03 144 141 163 150 000 12643 001537'02 000000# 777737 %key2 ,<-"!"> ;[217] Parsed as comment, always... 12644 001175'03 145 170 143 154 141 12645 001540'02 000000# 777723 %keyf3 ,<-"-">,cm%inv ;[217] Parsed as line continuation, always 12646 001201'03 002000 000001 12647 001202'03 155 151 156 165 163 12648 001541'02 000000# 777701 %key2 ,<-"?"> ;[217] Parsed as choices display, always... 12649 001205'03 161 165 145 163 164 12650 001542'02 000000# 777705 %key2 ,<-";"> ;[217] Parsed as comment, always... 12651 001210'03 163 145 155 151 143 12652 001533'02 000007 000007 %tbend ;[217] End of mnemonic table 12653 12654 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 12655 001543'02 013001 001545' qoufdm: flddb. .cmcma,cm%sdh,,,,qoufdb ;[217] Used when unwinding a macro 12656 001544'02 000000 000000 12657 001545'02 qoufdb: remark ;[217] First parse the 'easy' stuff... 12658 001545'02 010004 001550' flddb. .cmcfm,,,,,qf1 12659 001546'02 000000 000000 12660 001547'02 44 07 0 00 003072' 12661 001550'02 001004 001553' qf1: flddb. .cmnum,,^d8,,,qf2 12662 001551'02 000000 000010 12663 001552'02 44 07 0 00 003104' 12664 001553'02 000004 001556' qf2: flddb. .cmkey,,qchtb,,,qf3 12665 001554'02 000000 001466' 12666 001555'02 44 07 0 00 003117' 12667 001556'02 000004 001561' qf3: flddb. .cmkey,,toktab,,,q01 12668 001557'02 000000 001533' 12669 001560'02 44 07 0 00 003124' 12670 cleans() 12671 12672 ; N.B., have to use literals here for tokens or flddb. will choke. 12673 ; Maybe rewrite this to special case .cmtok, like fldtk.? k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 86-1 K20PAR MAC 7-Jun-23 14:23 SET SEND/RECEIVE QUOTE character tables and token definitions 12674 ; 12675 ; Also can't do a point 7,xx,6 for a token because COMND% won't work with that... 12676 12677 001561'02 023004 001564' q01: flddb. .cmtok,,,,,q02 12678 001562'02 44 07 0 00 003136' 12679 001563'02 44 07 0 00 003137' 12680 001564'02 023004 001567' q02: flddb. .cmtok,,token(<#>),,,q03 12681 001565'02 440700 003146' 12682 001566'02 44 07 0 00 003147' 12683 001567'02 023004 001572' q03: flddb. .cmtok,,token(<$>),,,q04 12684 001570'02 440700 003155' 12685 001571'02 44 07 0 00 003156' 12686 001572'02 023004 001575' q04: flddb. .cmtok,,token(<%>),,,q05 12687 001573'02 440700 003165' 12688 001574'02 44 07 0 00 003166' 12689 001575'02 023004 001600' q05: flddb. .cmtok,,token(<&>),,,q06 12690 001576'02 440700 003175' 12691 001577'02 44 07 0 00 003176' 12692 001600'02 023004 001603' q06: flddb. .cmtok,,,,,q07 12693 001601'02 44 07 0 00 003204' 12694 001602'02 44 07 0 00 003205' 12695 001603'02 023004 001606' q07: flddb. .cmtok,,,,,q08 12696 001604'02 44 07 0 00 003214' 12697 001605'02 44 07 0 00 003215' 12698 001606'02 023004 001611' q08: flddb. .cmtok,,,,,q09 12699 001607'02 44 07 0 00 003224' 12700 001610'02 44 07 0 00 003225' 12701 001611'02 023004 001614' q09: flddb. .cmtok,,token(<*>),,,q10 12702 001612'02 440700 003235' 12703 001613'02 44 07 0 00 003236' 12704 001614'02 023004 001617' q10: flddb. .cmtok,,token(<+>),,,q13 12705 001615'02 440700 003244' 12706 001616'02 44 07 0 00 003245' 12707 001617'02 023004 001622' q13: flddb. .cmtok,,token(<.>),,,q14 12708 001620'02 440700 002130' 12709 001621'02 44 07 0 00 003253' 12710 001622'02 023004 001625' q14: flddb. .cmtok,,token(),,,q15 12711 001623'02 440700 002635' 12712 001624'02 44 07 0 00 003261' 12713 001625'02 023004 001630' q15: flddb. .cmtok,,token(<:>),,,q17 12714 001626'02 440700 003270' 12715 001627'02 44 07 0 00 003271' 12716 001630'02 023004 001633' q17: fld(.cmtok,cm%fnc)!cm%hpp!q18 12717 001631'02 44 07 0 00 003276' point 7, [asciz /),,,q19 12720 001634'02 440700 003307' 12721 001635'02 44 07 0 00 003310' 12722 001636'02 023004 001641' q19: fld(.cmtok,cm%fnc)!cm%hpp!q21 12723 001637'02 44 07 0 00 003317' point 7, [asciz />/] 12724 001640'02 44 07 0 00 003320' point 7, [asciz /to specify a right angle bracket, type/] 12725 001641'02 023004 001644' q21: flddb. .cmtok,,token(<[>),,,q22 12726 001642'02 440700 002551' 12727 001643'02 44 07 0 00 003330' 12728 001644'02 023004 001647' q22: flddb. .cmtok,,token(<\>),,,q23 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 86-2 K20PAR MAC 7-Jun-23 14:23 SET SEND/RECEIVE QUOTE character tables and token definitions 12729 001645'02 440700 002562' 12730 001646'02 44 07 0 00 003337' 12731 001647'02 023004 001652' q23: flddb. .cmtok,,token(<]>),,,q24 12732 001650'02 440700 002575' 12733 001651'02 44 07 0 00 003345' 12734 001652'02 023004 001655' q24: flddb. .cmtok,,token(<^>),,,q25 12735 001653'02 440700 002507' 12736 001654'02 44 07 0 00 003354' 12737 001655'02 023004 001660' q25: flddb. .cmtok,,token(<_>),,,q26 12738 001656'02 440700 002622' 12739 001657'02 44 07 0 00 003361' 12740 001660'02 023004 001663' q26: flddb. .cmtok,,token(<`>),,,q27 12741 001661'02 440700 003370' 12742 001662'02 44 07 0 00 003371' 12743 001663'02 023004 001666' q27: flddb. .cmtok,,token(<{>),,,q28 12744 001664'02 440700 003377' 12745 001665'02 44 07 0 00 003400' 12746 001666'02 023004 001671' q28: flddb. .cmtok,,token(<|>),,,q29 12747 001667'02 440700 003410' 12748 001670'02 44 07 0 00 003411' 12749 001671'02 023004 001674' q29: flddb. .cmtok,,token(<}>),,,q30 12750 001672'02 440700 003420' 12751 001673'02 44 07 0 00 003421' 12752 001674'02 023004 000000 q30: flddb. .cmtok,,token(<~>),,, 12753 001675'02 440700 003431' 12754 001676'02 44 07 0 00 003432' 12755 12756 define qcln (p,b,n) < ;;[217] Clean up massive token usage 12757 xlist ;;[217] We don't need to see the blat 12758 irpc n,< ;;[217] Go through all the numeric suffix's 12759 'p q'b'n ;;[217] pseudo-op and its symbol 12760 >;;irpc ;;[217] End of argument expansion 12761 list ;;[217] Reenable the blat 12762 >;;qcln ;;[217] End of macro definition 12763 12764 define qkey (k) < 12765 xlist ;;[217] Save the trees!!! 12766 irp k,< 12767 qcln(<'k>,0,<123456789>) 12768 qcln(<'k>,1,<0345789>) 12769 qcln(<'k>,2,<123456789>) 12770 qcln(<'k>,3,<0>) 12771 >;;irp 12772 list ;;[217] Turn listing back on 12773 >;;qkey 12774 12775 ;[217] Keep useless symbols away from DDT and off the 12776 ;[217] cross-reference and symbol table listings 12777 12778 qkey(<.noddt,.xcref,suppress>) 12779 12780 ;[217] If second pass, don't need them at all nor the worker macros 12781 12782 if2 < qkey() ;;[217] Ditch all those useless labels 12783 purge qchrs ;;[217] Ditch the macro for quote characters k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 86-3 K20PAR MAC 7-Jun-23 14:23 SET SEND/RECEIVE QUOTE character tables and token definitions 12784 purge qkey ;;[217] Get rid of the driver to punt symbols 12785 purge qcln ;;[217] Ditch the remote macro with the symbol list 12786 >;if2 12787 12788 001677'02 35 07 0 00 000000* qchrpt: point 7, atmbuf, 6 ;[217] Character in atom buffer 12789 retsec ;[217] Finally back in code 12790 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 87 K20PAR MAC 7-Jun-23 14:23 SET SEND/RECEIVE QUOTE secondary parsing 12791 subttl SET SEND/RECEIVE QUOTE secondary parsing 12792 12793 004530'01 265 16 0 00 005022' .setqu: saveac ;[217] Wants some registers 12794 004531'01 200 16 0 00 000000# guide 12795 004532'01 260 17 0 00 004503* 12796 001700'02 000000000000# 12797 001673'04 164 157 000 000 000 12798 dmove t1, [ qoufdb ;[217] Point to our parsing extravaganza 12799 004533'01 120 01 0 00 005221' cm%xif ] ;[217] Load the no indirection flag 12800 004534'01 436 02 0 00 000000# orm t2, sbk+.cmflg ;[217] And dink the COMND% state block 12801 004535'01 332 00 0 00 000000# skipe mdone ;[217] Unwinding a macro? 12802 004536'01 201 01 0 00 000000# movei t1, qoufdm ;[217] If unwinding a macro, allow a comma 12803 12804 004537'01 260 17 0 00 004371* call rflde ;[217] Try to get one of them 12805 004540'01 254 00 0 00 004547' ifskp. ;[217] Worked!! 12806 004541'01 120 06 0 00 000002 dmove q2, t2 ;[217] Save some of the parse results 12807 004542'01 135 05 0 00 005174' ldb q1, [pointr (.cmfnp(q3),cm%fnc)] ;[217] Pick up the function code 12808 004543'01 200 10 0 00 000005 move q4, q1 ;[217] Save a copy for downstream 12809 004544'01 205 04 0 00 002000 movx t4, cm%xif ;[217] Load indirection flag again 12810 004545'01 412 04 0 00 000000# andcam t4, sbk+.cmflg ;[217] And restore the COMND% state block 12811 004546'01 254 00 0 00 004552' else. ;[217] Otherwise, failed the parse 12812 004547'01 205 04 0 00 002000 movx t4, cm%xif ;[217] Load indirection flag again 12813 004550'01 412 04 0 00 000000# andcam t4, sbk+.cmflg ;[217] restore the COMND% state block 12814 004551'01 254 00 0 00 004402* jrst cmderr ;[217] And handle the parse error, allowing reparse 12815 004552'01 endif. ;[217] End handling COMND% returns 12816 12817 004552'01 302 05 0 00 000013 caie q1, .cmcma ;[217] A comma? (must be unwinding) 12818 004553'01 254 00 0 00 004556' ifskp. ;[217] Yes, so handle it like a default 12819 004554'01 201 05 0 00 000010 movei q1, .cmcfm ;[217] Just turn it into a confirm 12820 004555'01 200 10 0 00 000005 move q4, q1 ;[217] Update downstream's copy 12821 004556'01 endif. ;[217] and let the confirm code handle it 12822 12823 004556'01 302 05 0 00 000010 caie q1, .cmcfm ;[217] Wants the default? 12824 004557'01 254 00 0 00 004563' ifskp. ;[217] Yes, that's easy 12825 004560'01 201 02 0 00 000043 movei t2, "#" ;[217] Default quote character 12826 004561'01 202 02 0 00 004516* movem t2, pars4 ;[217] Pass to semantic action 12827 004562'01 263 17 0 00 000000 ret ;[217] Done, no need to parse further 12828 004563'01 endif. ;[217] End case .cmcfm 12829 12830 004563'01 302 05 0 00 000000 caie q1, .cmkey ;[217] A keyword? 12831 004564'01 254 00 0 00 004573' ifskp. ;[217] It is, let's investigate 12832 004565'01 570 04 0 06 000000 hrre t4,(q2) ;[217] Pick up the dispatch address 12833 004566'01 325 04 0 00 004571' ifl. t4 ;[217] Negative? 12834 004567'01 210 02 0 00 000004 movn t2, t4 ;[217] It's one of our mnemonics 12835 004570'01 254 00 0 00 004572' else. ;[217] Otherwise, go grab the 12836 004571'01 135 02 0 00 000000# ldb t2, qchrpt ;[217] character from the atom buffer 12837 004572'01 endif. ;[217] Either way, have something 12838 004572'01 254 00 0 00 004607' jrst .setq1 ;[217] so go check it 12839 004573'01 endif. ;[217] End case .cmkey 12840 12841 004573'01 302 05 0 00 000023 caie q1, .cmtok ;[217] Something from the long list of tokens? 12842 004574'01 254 00 0 00 004601' ifskp. ;[217] Yes, hairy, but doable 12843 004575'01 621 07 0 00 777777 tlz q3, -1 ;[217] Isolate fdb we actually used 12844 004576'01 200 04 0 07 000001 move t4, .cmdat(q3) ;[217] Pick up the byte pointer to the character 12845 004577'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 15:18 11-Jun-23 Page 87-1 K20PAR MAC 7-Jun-23 14:23 SET SEND/RECEIVE QUOTE secondary parsing 12846 004600'01 254 00 0 00 004607' jrst .setq1 ;[217] Go check it 12847 004601'01 endif. ;[217] End case .cmtok 12848 12849 004601'01 302 05 0 00 000001 caie q1, .cmnum ;[217] Specified it as an octal number? 12850 004602'01 254 00 0 00 004604' ifskp. ;[217] He did 12851 004603'01 254 00 0 00 004607' jrst .setq1 ;[217] So let's check it 12852 004604'01 endif. ;[217] End case .cmnum 12853 12854 004604'01 200 01 0 00 000000# emsg ;[217] OK, we're confused... 12855 004605'01 104 00 0 00 000313 12856 001701'02 000000000000# 12857 001674'04 123 105 124 040 121 12858 004606'01 254 00 0 00 004524* jrst cmder1 ;[217] Allow a reparse 12859 12860 004607'01 307 02 0 00 000040 .setq1: caig t2, .chspc ;[21] Printable? 12861 004610'01 254 00 0 00 004621' jrst setque ;[194] No (N.B., does not allow space) 12862 004611'01 303 02 0 00 000176 caile t2, "~" ;[21] Past squiggle? 12863 004612'01 254 00 0 00 004621' jrst setque ;[194] Yes, then can't use it 12864 004613'01 202 02 0 00 004561* movem t2, pars4 ;[21] OK, stash it. 12865 004614'01 306 10 0 00 000010 cain q4, .cmcfm ;[217] Defaulted everything? 12866 004615'01 263 17 0 00 000000 ret ;[217] Yes, don't reconfirm the confirm 12867 004616'01 336 00 0 00 004525* skipn definf ;[77] In DEFINE? 12868 004617'01 260 17 0 00 004526* confrm ;[77] No, get confirmation. 12869 004620'01 263 17 0 00 000000 ret 12870 12871 004621'01 200 04 0 00 000002 setque: move t4, t2 ;[217] Get the poor character out of the way 12872 004622'01 325 04 0 00 004626' ifl. t4 ;[194] A negative ASCII character value is silly 12873 004623'01 200 01 0 00 000000# emsg ;[217] So whine about it 12874 004624'01 104 00 0 00 000313 12875 001702'02 000000000000# 12876 001703'04 116 145 147 141 164 12877 004625'01 254 00 0 00 004606* jrst cmder1 ;[217] Allow retry (^H) 12878 004626'01 endif. ;[217] 12879 12880 004626'01 305 04 0 00 000200 caige t4, 200 ;[217] Out of ASCII range? 12881 004627'01 254 00 0 00 004633' ifskp. ;[217] Yep, can't handle that, either 12882 004630'01 200 01 0 00 000000# emsg ;[217] Complain 12883 004631'01 104 00 0 00 000313 12884 001703'02 000000000000# 12885 001711'04 101 116 123 111 040 12886 004632'01 254 00 0 00 004625* jrst cmder1 ;[217] Allow retry (^H) 12887 004633'01 endif. ;[217] 12888 12889 remark ;[217] Otherwise, handle general case 12890 004633'01 200 01 0 00 000000# emsg ;" 12891 004634'01 104 00 0 00 000313 12892 001704'02 000000000000# 12893 001724'04 101 040 161 165 157 12894 004635'01 200 01 0 00 000004 move t1, t4 ;[217] Load the poor character 12895 004636'01 260 17 0 00 004447* call putc ;[217] Print it 12896 004637'01 200 01 0 00 000000# txmsg <" is not.> ;[217] " Font crock mode 12897 004640'01 104 00 0 00 000076 12898 004641'01 320 12 0 00 004642' 12899 001705'02 000000000000# 12900 001742'04 042 040 151 163 040 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 87-2 K20PAR MAC 7-Jun-23 14:23 SET SEND/RECEIVE QUOTE secondary parsing 12901 004642'01 254 00 0 00 004632* jrst cmder1 ;[194] and allow command retry. 12902 k20par - Kermit-20 Parsing and Semantic Action Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 88 K20PAR MAC 7-Jun-23 14:23 SET SEND/RECEIVE TIMEOUT secondary parsing 12903 subttl SET SEND/RECEIVE TIMEOUT secondary parsing 12904 12905 chgsec(code,const) ;;FDB's are not in code, they're in const 12906 001706'02 015004 000000 stifdb: flddb. .cmflt,,^d10, 12907 001707'02 000000 000012 12908 001710'02 44 07 0 00 003437' 12909 retsec ;;Back to where-ever we started from 12910 12911 004643'01 200 16 0 00 000000# .setim: guide 12912 004644'01 260 17 0 00 004532* 12913 001711'02 000000000000# 12914 001744'04 164 157 000 000 000 12915 004645'01 201 01 0 00 000000# movei t1, stifdb ;[212] 12916 004646'01 260 17 0 00 004501* call rfield ; Parse the number. 12917 004647'01 200 16 0 00 000000# guide 12918 004650'01 260 17 0 00 004644* 12919 001712'02 000000000000# 12920 001745'04 163 145 143 157 156 12921 12922 004651'01 325 02 0 00 004655' ifl. t2 ;[212] Is the number in the right range? 12923 004652'01 200 01 0 00 000000# emsg ;[212] 12924 004653'01 104 00 0 00 000313 12925 001713'02 000000000000# 12926 001747'04 116 145 147 141 164 12927 004654'01 254 00 0 00 004642* jrst cmder1 ;[212] allow reparse 12928 004655'01 endif. ;[212] 12929 12930 remark ;[212] When chksec works, it works completely 12931 004655'01 260 17 0 00 000000' call chksec ;[212] Ensure number is in correct range 12932 004656'01 254 00 0 00 004660' ifskp. ;[196] Check and convert OK? 12933 remark ;[196] Yes, must confirm later, maybe 12934 004657'01 254 00 0 00 004663' else. ;[196] Otherwise, couldn't swallow something 12935 004660'01 200 01 0 00 000000# emsg ; Macro definition 13227 000003'01 260 17 0 00 000000* 13228 000007'02 000000000000# 13229 000000'04 141 040 123 105 124 13230 movei t1, [ 13231 flddb. .cmswi,,tabswi,,,[ 13232 flddb. .cmkey,,mactab,,,[ 13233 flddb. .cmqst,,,,,[ 13234 flddb. .cmfld,,,,, 13235 000004'01 201 01 0 00 002434' ]]]] 13236 13237 000005'01 260 17 0 00 000000* call rfield ; Get the macro name 13238 000006'01 135 05 0 00 002437' ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 13239 000007'01 306 05 0 00 000003 cain q1, .cmswi ; Table function? 13240 000010'01 254 00 0 00 000555' callret tablem ; Hand off to table maintenance 13241 13242 ; If this is an existing macro, there is no need to reinsert it 13243 13244 000011'01 302 05 0 00 000000 caie q1, .cmkey ; A keyword (I.E., existing macro?) 13245 000012'01 254 00 0 00 000020' ifskp. ; It is, so just use it 13246 000013'01 202 02 0 00 000000# movem t2, tbent ; Save the table entry 13247 000014'01 554 01 0 02 000000 hlrz t1, (t2) ; Pull the address of the keyword 13248 000015'01 505 01 0 00 440700 hrli t1, (point 7,0) ; Turn into a local pointer 13249 000016'01 202 01 0 00 000000# movem t1, onamp ; This is the beginning of the string 13250 000017'01 254 00 0 00 000044' jrst .defi5 ; Skip accumulating the cruft 13251 000020'01 endif. 13252 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 2-1 K20MAC MAC 1-Apr-23 22:30 DEFINE command parsing 13253 ; Doesn't appear to be existing, so let's take a snapshot of the atom buffer 13254 13255 dmove t1, [ point 7,atmbuf ; Source is the atom buffer 13256 000020'01 120 01 0 00 002440' point 7,namatm ] ; Destination is a snapshot of it 13257 000021'01 202 02 0 00 000000# movem t2, onamp ; Beginning of candidate name stirng 13258 000022'01 260 17 0 00 000000* call asczcp ; Copy the ASCIZ string over 13259 000023'01 202 03 0 00 000000* movem t3, namlen ; Save the length of what we copied 13260 13261 ; BUT!! They might have put the keyword in double quotes, so check 13262 13263 000024'01 201 01 0 00 000000# movei t1, mactab ; Load the address of the keyword table 13264 000025'01 200 02 0 00 000000# move t2, onamp ; Pointer to proposed macro name 13265 000026'01 104 00 0 00 000537 TBLUK% ; Go have a look 13266 000027'01 320 12 0 00 000031' %jserr (,cmder1) ; Flame out, allow reparse 13267 000030'01 254 00 0 00 000034' 13268 000031'01 265 01 0 00 000000* 13269 000032'01 000000 000000 13270 000033'01 254 00 0 00 000000* 13271 13272 000034'01 607 02 0 00 040000 ifxn. t2, tl%exm ; So does it make anything EXACTLY? 13273 000035'01 254 00 0 00 000044' 13274 000036'01 202 01 0 00 000000# movem t1, tbent ; Save the table entry 13275 000037'01 554 04 0 01 000000 hlrz t4, (t1) ; Pick up the keyword address 13276 000040'01 505 04 0 00 440700 hrli t4, (point 7,0) ; Turn into a local pointer 13277 000041'01 202 04 0 00 000000# movem t4, onamp ; This is the beginning of the string 13278 000042'01 201 05 0 00 000000 movei q1, .cmkey ; Say we matched a keyword 13279 000043'01 254 00 0 00 000044' jrst .defi5 ; and skip accumulating cruft 13280 000044'01 endif. 13281 13282 ; Let them type CR here to undefine the macro, or else jump into the SET 13283 ; command parser to let them define a new macro, or redefine an old one. 13284 13285 000044'01 302 05 0 00 000000 .defi5: caie q1, .cmkey ; Exists? 13286 000045'01 254 00 0 00 000051' ifskp. ; Yes, so different guidance 13287 000046'01 200 16 0 00 000000# guide ; 13288 000047'01 260 17 0 00 000003* 13289 000010'02 000000000000# 13290 000004'04 164 157 040 165 156 13291 000050'01 254 00 0 00 000053' else. ; Otherwise, doing it from scratch 13292 000051'01 200 16 0 00 000000# guide ; Prompt with guide words. 13293 000052'01 260 17 0 00 000047* 13294 000011'02 000000000000# 13295 000011'04 164 157 040 123 105 13296 000053'01 endif. ; 13297 13298 000053'01 200 01 0 00 000000# move t1, sbk+.cmptr ; Get current pointer from comnd state block. 13299 000054'01 202 01 0 00 000000# movem t1, macptr ; Save it as pointer to macro body. 13300 13301 000055'01 476 00 0 00 000000# .defi6: setom definf ; Flag that we're doing a DEFINE. 13302 000056'01 201 01 0 00 002442' movei t1, [flddb. .cmkey,,settab,,,] ; Assume defining 13303 000057'01 306 05 0 00 000000 cain q1, .cmkey 13304 movei t1, [flddb. .cmcfm,,,,,[ 13305 flddb. .cmswi,,defswi,,,[ 13306 000060'01 201 01 0 00 002462' flddb. .cmkey,,settab,,,]]] ; 13307 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 15:18 11-Jun-23 Page 2-2 K20MAC MAC 1-Apr-23 22:30 DEFINE command parsing 13308 000062'01 135 03 0 00 002437' ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 13309 000063'01 476 00 0 00 000000# setom undeff ; Assume we're undefining? 13310 000064'01 302 03 0 00 000003 caie t3, .cmswi ; Only uses switches to undefine 13311 000065'01 254 00 0 00 000070' ifskp. ; But must confirm the switch 13312 000066'01 550 01 0 02 000000 hrrz t1, (t2) ; Pick up secondary parse 13313 000067'01 254 00 0 01 000000 jrst (t1) ; And go there 13314 000070'01 endif. 13315 13316 000070'01 306 03 0 00 000010 cain t3, .cmcfm ; Parsed a CR? (if so, then undefing) 13317 000071'01 263 17 0 00 000000 ret ; Yes, so done. 13318 13319 000072'01 402 00 0 00 000000# setzm undeff ; No, we're defining after all. 13320 000073'01 254 00 0 00 000000* callret .set2 ; Go parse SET commands. 13321 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 3 K20MAC MAC 1-Apr-23 22:30 DEFINE command execution 13322 subttl DEFINE command execution 13323 13324 000074'01 $defin: entry $defin ; Invoked by K20PAR 13325 000074'01 265 16 0 00 002465' saveac ; Needs some extra registers 13326 000075'01 402 00 0 00 000000# setzm definf ; Clear define flag 13327 000076'01 332 00 0 00 000000# skipe undeff ; Define or Undefine? 13328 000077'01 254 00 0 00 000241' jrst $defi7 ; Undefine, go do that. 13329 13330 ;[82] remark Uncomment to Echo back what was typed... 13331 ;[82] move t1, onamp ; Name 13332 ;[82] PSOUT 13333 ;[82] txmsg < = > 13334 ;[82] move t1, macptr ; Text 13335 ;[82] PSOUT 13336 13337 000100'01 200 01 0 00 000000# move t1, macptr ; Load pointer to accumulated text 13338 000101'01 200 02 0 00 002477' move t2, [point 7,expatm] ; And a pointer to the macro text expansion buffer 13339 000102'01 260 17 0 00 000022* call asczcp ; Copy the ASCIZ string over 13340 000103'01 202 03 0 00 000000* movem t3, explen ; Save the length of what we copied 13341 13342 ; Here to figure out if we have enough room before we try the insert. 13343 ; Assumes all initial pointers started out on word boundaries 13344 13345 ; First, we'll do the name, checking to ensure that we are reusing an 13346 ; existing keyword, if it exists 13347 13348 000104'01 550 05 0 00 000000# hrrz q1, onamp ; Load the macro name pointer 13349 000105'01 305 05 0 00 000000# caige q1, mactab ; Could be in the macro table? 13350 000106'01 254 00 0 00 000113' ifskp. ; Yes, let's check a little further 13351 000107'01 301 05 0 00 000000# cail q1, macx ; But not off the end? 13352 000110'01 254 00 0 00 000113' anskp. ; Was outside, so must insert 13353 000111'01 400 05 0 00 000000 setz q1, ; So no words here because reusing 13354 000112'01 254 00 0 00 000123' else. ; Not an existing keyword 13355 000113'01 200 05 0 00 000023* move q1, namlen ; Load length of macro name candidate 13356 000114'01 200 02 0 00 002441' move t2, [point 7,namatm] ; Load pointer to same 13357 000115'01 133 05 0 00 000002 adjbp q1, t2 ; Calculate the ending pointer 13358 000116'01 302 05 0 00 440700 caie q1, 440700 ; On a word boundary? 13359 000117'01 271 05 0 00 000001 addi q1, ^d1 ; No, round up a word 13360 000120'01 621 05 0 00 777777 tlz q1, -1 ; Shut off the pointer part 13361 000121'01 621 02 0 00 777777 tlz t2, -1 ; in both pointers 13362 000122'01 274 05 0 00 000002 sub q1, t2 ; Now have required words 13363 000123'01 endif. ; Either way, something useful in t1 13364 13365 ; Now the body or expansion, which is somewhat more straightforward 13366 13367 000123'01 200 06 0 00 000103* move q2, explen ; Load length of macro expansion text 13368 000124'01 200 02 0 00 002477' move t2, [point 7,expatm] ; Load pointer to same 13369 000125'01 133 06 0 00 000002 adjbp q2, t2 ; Calculate the ending pointer 13370 000126'01 302 06 0 00 440700 caie q2, 440700 ; On a word boundary? 13371 000127'01 271 06 0 00 000001 addi q2, ^d1 ; No, round up a word 13372 000130'01 621 06 0 00 777777 tlz q2, -1 ; Shut off the pointer part 13373 000131'01 621 02 0 00 777777 tlz t2, -1 ; in both pointers 13374 000132'01 274 06 0 00 000002 sub q2, t2 ; Now have required words 13375 13376 ; Now see if we would go off the end k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 3-1 K20MAC MAC 1-Apr-23 22:30 DEFINE command execution 13377 13378 000133'01 200 01 0 00 000000# $defad: move t1, macbp ; Load the current top of macro text 13379 000134'01 621 01 0 00 777777 tlz t1, -1 ; Shut off pointer (assumes always a word boundary) 13380 000135'01 270 01 0 00 000005 add t1, q1 ; Add in name length in words (if any) 13381 000136'01 270 01 0 00 000006 add t1, q2 ; Add in macro body length in words 13382 000137'01 301 01 0 00 000000# cail t1, macx ; But not off the end? 13383 000140'01 334 00 0 00 000000 %ermsg (,r) 13384 000141'01 254 00 0 00 000145' 13385 000142'01 265 01 0 00 000031* 13386 000143'01 000000000000# 13387 000144'01 254 00 0 00 000000* 13388 000013'04 115 141 143 162 157 13389 13390 ; What about the TBLUK% table? Is that full? 13391 13392 000145'01 550 01 0 00 000000# hrrz t1, mactab ; Load maximum possible entries 13393 000146'01 554 02 0 00 000000# hlrz t2, mactab ; Load current entry count 13394 000147'01 274 01 0 00 000002 sub t1, t2 ; See if any room 13395 000150'01 327 01 0 00 000157' ifle. t1 ; Nothing left or phonkey? 13396 000151'01 323 05 0 00 000157' andg. q1 ; And we're adding a keyword? 13397 000152'01 334 00 0 00 000000 %ermsg (,r) 13398 000153'01 254 00 0 00 000157' 13399 000154'01 265 01 0 00 000142* 13400 000155'01 000000000000# 13401 000156'01 254 00 0 00 000144* 13402 000024'04 115 141 170 151 155 13403 000157'01 endif. 13404 13405 ; OK, let's copy everything over (maybe) 13406 13407 000157'01 326 05 0 00 000163' ife. q1 ; Reusing a keyword? 13408 000160'01 550 07 0 00 000000# hrrz q3, onamp ; Yes, get its address 13409 000161'01 550 03 0 00 000000# hrrz t3, macbp ; Macro text goes directly in 13410 000162'01 254 00 0 00 000170' else. ; Otherwise, copy it in and use that 13411 000163'01 550 07 0 00 000000# hrrz q3, macbp ; Use word address of keyword location 13412 000164'01 200 01 0 00 000005 move t1, q1 ; Number of words to copy 13413 000165'01 201 02 0 00 000000* movei t2, namatm ; Source is the name that was in the atom buff 13414 000166'01 200 03 0 00 000007 move t3, q3 ; Destination in macro storage 13415 000167'01 123 01 0 00 002500' xblt. t1 ; And transfer it over 13416 000170'01 endif. 13417 13418 000170'01 200 01 0 00 000006 move t1, q2 ; Load length of expansion 13419 000171'01 201 02 0 00 000000* movei t2, expatm ; Source is expansion or body text we got 13420 000172'01 200 10 0 00 000003 move q4, t3 ; Begin storing where we left off 13421 000173'01 123 01 0 00 002500' xblt. t1 ; And pop that over 13422 000174'01 505 03 0 00 440700 hrli t3, (point 7,0) ; Turn into a pointer on a WORD boundaru 13423 000175'01 202 03 0 00 000000# movem t3, macbp ; And store as new top of storage 13424 13425 ; Finally either tweak the table or add the entry 13426 13427 000176'01 326 05 0 00 000227' ife. q1 ; Existing keyword? 13428 000177'01 332 01 0 00 000000# skipe t1, tbent ; Do we already have it? 13429 000200'01 254 00 0 00 000225' ifskp. ; No, go get find it 13430 000201'01 201 01 0 00 000000# movei t1, mactab ; Yes, let's find the entry 13431 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 15:18 11-Jun-23 Page 3-2 K20MAC MAC 1-Apr-23 22:30 DEFINE command execution 13432 000203'01 104 00 0 00 000537 TBLUK% ; See if it's in there (better be!) 13433 000204'01 320 12 0 00 000206' %jserr (,r) 13434 000205'01 254 00 0 00 000211' 13435 000206'01 265 01 0 00 000154* 13436 000207'01 000000000000# 13437 000210'01 254 00 0 00 000156* 13438 000035'04 123 145 141 162 143 13439 000211'01 603 02 0 00 040000 ifxe. t2, tl%exm ; Not there? 13440 000212'01 254 00 0 00 000225' 13441 000213'01 200 01 0 00 000000# emsg ;" font crock mode 13442 000214'01 104 00 0 00 000313 13443 000012'02 000000000000# 13444 000044'04 103 157 165 154 144 13445 000215'01 561 01 0 00 000000* hrroi t1, atmbuf ; Point at what we were looking for 13446 000216'01 104 00 0 00 000076 PSOUT% ; Type what we got told was in there 13447 000217'01 200 01 0 00 000000# txmsg <"> ;" font crock mode 13448 000220'01 104 00 0 00 000076 13449 000221'01 320 12 0 00 000222' 13450 000013'02 000000000000# 13451 000054'04 042 000 000 000 000 13452 000222'01 561 01 0 00 000000* hrroi t1, crlf ; Tie off the line 13453 000223'01 104 00 0 00 000076 PSOUT% 13454 000224'01 263 17 0 00 000000 ret ; Nothing further we can do, so leave 13455 000225'01 endif. ; End case looking for the macro name 13456 000225'01 endif. ; End case already have the table offset 13457 000225'01 542 10 0 01 000000 hrrm q4, (t1) ; Stomp in address of new body 13458 000226'01 263 17 0 00 000000 ret ; That's it, really 13459 000227'01 endif. ; End case replacing macro body 13460 13461 ; Otherwise, add

to macro keyword table. 13462 13463 000227'01 201 01 0 00 000000# movei t1, mactab ; Stick it in the macro table. 13464 000230'01 514 02 0 00 000007 hrlz t2, q3 ; Address of keyword,, 13465 000231'01 540 02 0 00 000010 hrr t2, q4 ; argument (address of body) 13466 000232'01 104 00 0 00 000536 TBADD% ; Inserting it should always work 13467 000233'01 320 12 0 00 000235' %jserr (,r) ; Must have missed a case, above 13468 000234'01 254 00 0 00 000240' 13469 000235'01 265 01 0 00 000206* 13470 000236'01 000000000000# 13471 000237'01 254 00 0 00 000210* 13472 000055'04 105 162 162 157 162 13473 000240'01 263 17 0 00 000000 ret 13474 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 4 K20MAC MAC 1-Apr-23 22:30 /UNDEFINE processing 13475 subttl /UNDEFINE processing 13476 13477 ; Come here directly to undefine an existing macro. 13478 ; First look it up. We should ALWAYS find it because we don't come 13479 ; here unless we had a keyword match in the first place. 13480 13481 000241'01 332 02 0 00 000000# $defi7: skipe t2, tbent ; Do we already have the keyword? 13482 000242'01 254 00 0 00 000267' ifskp. ; No, go get it 13483 000243'01 201 01 0 00 000000# movei t1, mactab ; Yes, look up its address in the kwd table. 13484 000244'01 200 02 0 00 000000# move t2, onamp ; Pointer to macro name. 13485 000245'01 104 00 0 00 000537 TBLUK% ; See if it's in there (should be) 13486 000246'01 320 12 0 00 000250' %jserr (,r) 13487 000247'01 254 00 0 00 000253' 13488 000250'01 265 01 0 00 000235* 13489 000251'01 000000000000# 13490 000252'01 254 00 0 00 000237* 13491 000062'04 103 157 165 154 144 13492 000253'01 603 02 0 00 040000 ifxe. t2, tl%exm ;[194] Found an exact match? 13493 000254'01 254 00 0 00 000266' 13494 000255'01 200 01 0 00 000000# txmsg <% "> ;[194] ;" No, warn. 13495 000256'01 104 00 0 00 000076 13496 000257'01 320 12 0 00 000260' 13497 000014'02 000000000000# 13498 000074'04 045 040 042 000 000 13499 000260'01 200 01 0 00 000000# move t1, onamp 13500 000261'01 104 00 0 00 000076 PSOUT 13501 000262'01 200 01 0 00 000000# txmsg < " not found in SET macro table> ;[194] ;" Font crock 13502 000263'01 104 00 0 00 000076 13503 000264'01 320 12 0 00 000265' 13504 000015'02 000000000000# 13505 000075'04 040 042 040 156 157 13506 000265'01 263 17 0 00 000000 ret 13507 000266'01 endif. ;[194] 13508 000266'01 200 02 0 00 000001 move t2, t1 ; The address we just got. 13509 000267'01 endif. ; End case didn't already have entry 13510 13511 ; Using the table index just obtained, delete the entry. 13512 13513 000267'01 201 01 0 00 000000# movei t1, mactab 13514 remark t2, ; Either already had it or found it 13515 000270'01 104 00 0 00 000535 TBDEL% ; Delete the old entry. 13516 000271'01 320 12 0 00 000273' %jserr (,r) 13517 000272'01 254 00 0 00 000276' 13518 000273'01 265 01 0 00 000250* 13519 000274'01 000000000000# 13520 000275'01 254 00 0 00 000252* 13521 000104'04 103 157 165 154 144 13522 000276'01 263 17 0 00 000000 ret 13523 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 5 K20MAC MAC 1-Apr-23 22:30 /UNDEFINE parsing 13524 subttl /UNDEFINE parsing 13525 13526 000277'01 260 17 0 00 000000* .undef: confrm ; Confirm the line 13527 000300'01 263 17 0 00 000000 ret ; Done 13528 13529 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 6 K20MAC MAC 1-Apr-23 22:30 /DUPLICATE parsing 13530 subttl /DUPLICATE parsing 13531 13532 000301'01 200 16 0 00 000000# .dupli: guide ; Macro definition 13533 000302'01 260 17 0 00 000052* 13534 000016'02 000000000000# 13535 000116'04 164 157 040 141 040 13536 movei t1, [ 13537 flddb. .cmqst,,,,,[ 13538 flddb. .cmfld,,,,, 13539 000303'01 201 01 0 00 002525' ]] 13540 13541 000304'01 260 17 0 00 000061* call rfield ; Get the macro name 13542 dmove t1, [ mactab ; Load the address of the keyword table 13543 000305'01 120 01 0 00 002530' point 7, atmbuf ] ; And a pointer to the atom buffer 13544 000306'01 104 00 0 00 000537 TBLUK% ; See if it's in there (shouldn't be) 13545 000307'01 320 12 0 00 000311' %jserr (,cmder1) ; Fail, allow a ^H 13546 000310'01 254 00 0 00 000314' 13547 000311'01 265 01 0 00 000273* 13548 000312'01 000000 000000 13549 000313'01 254 00 0 00 000033* 13550 13551 000314'01 607 02 0 00 040000 ifxn. t2, tl%exm ; Found an exact match? 13552 000315'01 254 00 0 00 000326' 13553 000316'01 200 01 0 00 000000# emsg ;" font crock mode 13554 000317'01 104 00 0 00 000313 13555 000017'02 000000000000# 13556 000123'04 124 150 145 040 162 13557 000320'01 561 01 0 00 000215* hrroi t1, atmbuf ; Point to the atom buffer 13558 000321'01 104 00 0 00 000076 PSOUT% ; Type the new name which won't work 13559 000322'01 200 01 0 00 000000# txmsg <" already exists> ;" font crock mode 13560 000323'01 104 00 0 00 000076 13561 000324'01 320 12 0 00 000325' 13562 000020'02 000000000000# 13563 000132'04 042 040 141 154 162 13564 000325'01 254 00 0 00 000313* jrst cmder1 ; Allow ^H 13565 000326'01 endif. 13566 13567 dmove t1, [point 7, atmbuf ; Load pointer to new keyword 13568 000326'01 120 01 0 00 002440' point 7, namatm] ; And a pointer to the macro name buffer 13569 000327'01 260 17 0 00 000102* call asczcp ; Copy the ASCIZ string over 13570 000330'01 202 03 0 00 000113* movem t3, namlen ; Save the length of what we copied 13571 13572 000331'01 260 17 0 00 000277* confrm ; Tie off the line 13573 13574 000332'01 201 01 0 00 002532' movei t1, [.dupli,,$dupli] ;Load our own semantic action 13575 000333'01 202 01 0 00 000000* movem t1, pars1 ; Stomp top-level parse, we're taking it from here 13576 000334'01 263 17 0 00 000000 ret ; Return into /DUPLICATE semantic action 13577 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 7 K20MAC MAC 1-Apr-23 22:30 /DUPLICATE semantic action 13578 subttl /DUPLICATE semantic action 13579 13580 000335'01 265 16 0 00 002465' $dupli: saveac ; MUST have same register usage as $defin!! 13581 000336'01 332 10 0 00 000000# skipe q4, tbent ; Already have the table address? 13582 000337'01 254 00 0 00 000366' ifskp. ; No, go find it 13583 000340'01 201 01 0 00 000000# movei t1, mactab ; Load the address of the keyword table 13584 000341'01 200 02 0 00 000000# move t2, onamp ; And the keyword text pointer 13585 000342'01 104 00 0 00 000537 TBLUK% ; See if it's in there (should be) 13586 000343'01 320 12 0 00 000345' %jserr (,r) 13587 000344'01 254 00 0 00 000350' 13588 000345'01 265 01 0 00 000311* 13589 000346'01 000000000000# 13590 000347'01 254 00 0 00 000275* 13591 000136'04 105 162 162 157 162 13592 000350'01 603 02 0 00 040000 ifxe. t2, tl%exm ; Found an exact match? 13593 000351'01 254 00 0 00 000365' 13594 000352'01 200 01 0 00 000000# emsg ;" No, bomb 13595 000353'01 104 00 0 00 000313 13596 000021'02 000000000000# 13597 000147'04 103 157 165 154 144 13598 000354'01 561 01 0 00 000165* hrroi t1, namatm ; Point at what we should have found 13599 000355'01 104 00 0 00 000076 PSOUT% ; Type it 13600 000356'01 200 01 0 00 000000# txmsg <" macro in order to duplicate it> 13601 000357'01 104 00 0 00 000076 13602 000360'01 320 12 0 00 000361' 13603 000022'02 000000000000# 13604 000154'04 042 040 155 141 143 13605 000361'01 561 01 0 00 000222* hrroi t1, crlf ; Tie off the line 13606 000362'01 104 00 0 00 000076 PSOUT% 13607 000363'01 263 17 0 00 000000 ret ; Get out of here 13608 000364'01 254 00 0 00 000366' else. ; Otherwise, found something 13609 000365'01 200 10 0 00 000001 move q4, t1 ; Save the table entry 13610 000366'01 endif. ; End case looking for the keyword 13611 000366'01 endif. ; End case already had it 13612 13613 ; Now the calculate the size in words of the new keyword 13614 13615 000366'01 200 05 0 00 000330* move q1, namlen ; Load length of macro expansion text 13616 000367'01 200 02 0 00 002441' move t2, [point 7,namatm] ; Load pointer to same 13617 000370'01 133 05 0 00 000002 adjbp q1, t2 ; Calculate the ending pointer 13618 000371'01 302 05 0 00 440700 caie q1, 440700 ; On a word boundary? 13619 000372'01 271 05 0 00 000001 addi q1, ^d1 ; No, round up a word 13620 000373'01 621 05 0 00 777777 tlz q1, -1 ; Shut off the pointer part 13621 000374'01 621 02 0 00 777777 tlz t2, -1 ; in both pointers 13622 000375'01 274 05 0 00 000002 sub q1, t2 ; Now have required words 13623 13624 ; Take a copy of the expansion text for the macro 13625 13626 000376'01 550 01 0 10 000000 hrrz t1, (q4) ; Get address of text 13627 000377'01 505 01 0 00 440700 hrli t1, (point 7,0) ; Now have our source 13628 000400'01 200 02 0 00 002477' move t2, [ point 7, expatm ] ; Put it in as new expansion 13629 000401'01 260 17 0 00 000327* call asczcp ; Copy the ASCIZ string over 13630 000402'01 202 03 0 00 000123* movem t3, explen ; And store the length 13631 13632 ; And figure out how long that was in words k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 7-1 K20MAC MAC 1-Apr-23 22:30 /DUPLICATE semantic action 13633 13634 000403'01 200 06 0 00 000003 move q2, t3 ; Put the length where $defad wants it 13635 000404'01 200 02 0 00 002477' move t2, [ point 7, expatm ] ; Point to base of expansion 13636 000405'01 133 06 0 00 000002 adjbp q2, t2 ; Calculate the ending pointer 13637 000406'01 302 06 0 00 440700 caie q2, 440700 ; On a word boundary? 13638 000407'01 271 06 0 00 000001 addi q2, ^d1 ; No, round up a word 13639 000410'01 621 06 0 00 777777 tlz q2, -1 ; Shut off the pointer part 13640 000411'01 621 02 0 00 777777 tlz t2, -1 ; in both pointers 13641 000412'01 274 06 0 00 000002 sub q2, t2 ; Now have required words 13642 13643 ; Join $defad at the point of adding something 13644 13645 000413'01 254 00 0 00 000133' callret $defad ; And just add every 13646 000414'01 263 17 0 00 000000 ret 13647 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 8 K20MAC MAC 1-Apr-23 22:30 /REMOVE parsing 13648 subttl /REMOVE parsing 13649 13650 emacro < 13651 13652 .mremo: remark need to parse for the set parameter here 13653 confrm ; Tie off the line 13654 13655 movei t1, [.mremo,,$mremo] ;Load our own semantic action 13656 movem t1, pars1 ; Stomp top-level parse, we're taking it from here 13657 ret ; Return into /RENAME semantic action 13658 13659 >;;emacro 13660 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 9 K20MAC MAC 1-Apr-23 22:30 /REMOVE semantic action 13661 subttl /REMOVE semantic action 13662 13663 emacro < 13664 13665 $mremo: saveac ; Needs a lot of registers 13666 13667 skipe q4, tbent ; Already have the table address? 13668 ifskp. ; No, go find it 13669 movei t1, mactab ; Load the address of the keyword table 13670 move t2, onamp ; And the keyword text pointer 13671 TBLUK% ; See if it's in there (should be) 13672 %jserr (,r) 13673 ifxe. t2, tl%exm ; Found an exact match? 13674 emsg ;" No, bomb 13675 hrroi t1, namatm ; Point at what we should have found 13676 PSOUT% ; Type it 13677 txmsg <" macro in order to remove from it> 13678 hrroi t1, crlf ; Tie off the line 13679 PSOUT% 13680 ret ; Get out of here 13681 else. ; Otherwise, found something 13682 move q4, t1 ; Save the table entry 13683 endif. ; End case looking for the keyword 13684 endif. ; End case already had it 13685 13686 remark ; Toss anything in the macro editor 13687 seto t1, ; Case IV, deleting process memory 13688 dmove t2, [ .fhslf,,medpg ; This process, page number of medit psect 13689 pm%cnt!fld(edpgs,pm%rpt) ] ; Number of pages to toss 13690 PMAP% ; Trim our working set 13691 %jserr (,) ; Odd... but continue 13692 13693 remark ; Set up editing table prototype 13694 xmovei t3, medorg ; Load base of .psect 13695 dmove t1, [ 0,,MACMAX ; TBLUK% table has no entries now 13696 0 ] ; Stomp the 2nd location, just in case 13697 dmovem t1, (t3) ; Now have an empty table 13698 xmovei q3, MACMAX+1(t3) ; Now have top of macro text editing area 13699 dmove t1, q3 ; Load information for splitter 13700 call csplit ; Split the text into keyword names and data 13701 >;;emacro 13702 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 10 K20MAC MAC 1-Apr-23 22:30 Takes a pointer to macro text and splits it up with COMND% 13703 subttl Takes a pointer to macro text and splits it up with COMND% 13704 13705 ; t1/ Top of editing area to stash things 13706 ; t2/ TBLUK% entry of existing macro 13707 13708 ;N.B., assumes editing area is zeroed!! 13709 13710 emacro < 13711 13712 csplit: saveac 13713 move q3, t1 ; Save top of macro insertion 13714 hrli q4, (point 7,0) ; Build a section local pointer 13715 hrr q4, (t2) ; Get address of macro text 13716 13717 do. ; Enter loop context 13718 call splini ; Initialize for parsing from string 13719 move q2, t2 ; Put the CMDBUF pointer in a safe place 13720 call prepar ; Prepare to parse 13721 jumpe t1,endlp. ; Done at end of string 13722 move q1, t1 ; Save it 13723 call dopair ; Do a set pair 13724 cain q1, .chlfd ; Line Feed? 13725 exit. ; Yes, last command in text 13726 loop. ; Next pair 13727 enddo. ; Exit loop lexical context 13728 13729 call splfix ; Fix the CSB up 13730 ret ; Done 13731 13732 >;;emacro 13733 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 11 K20MAC MAC 1-Apr-23 22:30 Do a SET paramater-value pair 13734 subttl Do a SET paramater-value pair 13735 13736 ; N.B., might not just be a pair, could be secondary parsing 13737 ; 13738 ; Maybe put the .sigio stuff in when debugging? Gives real nasty 13739 ; error because we can't trap it. 13740 13741 emacro < 13742 13743 ccrlf: point 7, crlf 13744 -^d2 13745 13746 dopair: saveac ; Needs to save a few things 13747 13748 move q1, sbk+.cmioj ; Load current input and output JFN pair 13749 hrli t1, .sigio ; Set to blow up on a read 13750 hrr t1, q1 ; Let it blat if it wants to 13751 movem t1, sbk+.cmioj ; Set up our trick wire 13752 13753 movei t1, [ flddb. .cmkey,,settab ] 13754 call rflde ; Parse just the SET keyword 13755 %ermsg (,r) ; Leave 13756 ldb t4, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 13757 move q2, t2 ; Keep selected item safe 13758 13759 hlro t1,(q2) ; Show parameter name (keyword 13760 psout% 13761 call csbinf ; Maybe type out interesting CSB stuff 13762 hrrz t4, (q2) ; Get parser and action for parameter valud 13763 hlrz t1, (t4) ; This is the parser portion 13764 13765 setom definf ; Fake we're defining 13766 call (t1) ; Parse the rest of something 13767 setzm definf ; Out of phoney define 13768 13769 move t1, q1 ; Load saved in and out JFN pair 13770 movem t1, sbk+.cmioj ; Restore to the SBK 13771 13772 hrroi t1, atmbuf ; Point to what we parsed 13773 PSOUT% 13774 call csbinf 13775 13776 hrroi t1, crlf 13777 psout 13778 ret 13779 13780 >;;emacro 13781 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 12 K20MAC MAC 1-Apr-23 22:30 Display Useful CSB Information 13782 subttl Display Useful CSB Information 13783 13784 emacro < 13785 13786 csbinf: skipg t4, sbk+.cminc ; Anything left to parse? 13787 ifskp. ; It appears so 13788 cain t4, ^d1 ; One dinky character? 13789 anskp. ; Yep; don't let's bother with that 13790 movei t1, .priou ; Going to terminal 13791 movei t2, .chtab ; Space over 13792 BOUT% ; Do it 13793 erjmps .+1 ; Catch and suppress error 13794 move t2, t4 13795 movei t3, ^d10 13796 NOUT% 13797 erjmps .+1 ; Catch and suppress error 13798 movei t2, "," ; Quote it to be sure 13799 BOUT% ; Do it 13800 movei t2, "'" ; Quote it to be sure 13801 BOUT% ; Do it 13802 erjmps .+1 ; Catch and suppress error 13803 move t2, sbk+.cmptr ; Point to rest of text 13804 movn t3, t4 ; Counted SOUT% 13805 SOUT% ; See what's left 13806 erjmpr .+1 ; Catch and ignore error 13807 movei t2, "'" ; Quote it to be sure 13808 BOUT% ; Do it 13809 erjmps .+1 ; Catch and suppress error 13810 movei t2, .chtab ; Space over 13811 BOUT% ; Do it 13812 erjmps .+1 ; Catch and suppress error 13813 else. ; Otherwise, just tab over 13814 movei t1, .chtab ; Space over 13815 PBOUT% 13816 PBOUT% 13817 endif. 13818 ret 13819 >;;emacro 13820 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 13 K20MAC MAC 1-Apr-23 22:30 .SIGIO Input handler 13821 subttl .SIGIO Input handler 13822 13823 emacro < 13824 ; N.B., This code doesn't work. It will *NEVER* work unless a 13825 ; significant change is made to Tops-20. 13826 ; 13827 ; .SIGIO is unfortunately hard wired to be multiplexed on channel 13828 ; 19 (along with address break), which is Inferior Fork Termination 13829 ; (.ICIFT). Tops-20 very reasonably does not allow a fork to catch 13830 ; its own termination. 13831 ; 13832 ; I would have thought a more obvious approach would have been to 13833 ; implement .SIGIO in a similar fashion to the .TICTI/.TICTO 13834 ; terminal codes (interrupt on type-in/output detected), the 13835 ; difference being that if you didn't handle .SIGIO, it's goes 13836 ; 'upstairs' like other panic channels. 13837 ; 13838 ; For debugging, using .SIGIO still helps because if you mess up 13839 ; the pointers in the CSB, then the fork will terminate and you can 13840 ; investigate with DDT instead of going into a terminal wait. 13841 13842 repeat 0,< ; See above, can't use this, ever 13843 extern pc3 ; Globalized in K20SUB 13844 13845 sitrap: intern sitrap ; K20SUB needs the address in CHNTAB 13846 13847 aos sintn ; Count a signal just because ... 13848 push p, t1 ; Save an accumulator 13849 push p, t2 ; And another one 13850 push p, t3 ; One more!!! 13851 13852 move t1, pc3 ; Pick up our interrupted location 13853 ifxe. t1, pc%usr ; We are only breaking out of a JSYS 13854 hrrz t2, t1 ; PC is where the JSYS will return 13855 subi t2, ^d1 ; So fix it to look at the JSYS 13856 hllz t3, (t2) ; Isolate the left half word 13857 txz t3, 777 ; Want just the opcode 13858 came t3, [ COMND% ] ; Trying to parse something? 13859 anskp. ; Nope, we're done 13860 txo t1, pc%usr ; Force user mode 13861 movem t1, pc3 ; Change DEBRK% action 13862 movx t1, cm%nop ; Force a parse failure 13863 else. ; Otherwise, leave everything alone 13864 setz t1, ; And no flag fix up 13865 endif. 13866 13867 sitepi: pop p, t3 ; Signal trap epilogue 13868 pop p, t2 ; Restores ac2 and ac3 immediately 13869 orm t1, (p) ; Or in any flags before restore 13870 pop p, t1 ; Restore modified or unmodified 13871 13872 DEBRK% ; Done 13873 >;;End Repeat 0 13874 >;;emacro 13875 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 14 K20MAC MAC 1-Apr-23 22:30 Turn .sigio interrupts on and off 13876 subttl Turn .sigio interrupts on and off 13877 13878 emacro < 13879 repeat 0,< ; See above, will never work 13880 extern sigchb ; Defined in K20SUB 13881 13882 dosigh: .fhslf ; This process 13883 sigchb ; .SIGIO channel bit 13884 13885 tsigon: dmove t1, dosigh ; Turn on the signal I/O handler 13886 AIC% ; Enable to catch it 13887 %jserr (,) ; Odd, but carry on 13888 ret 13889 13890 sigoff: dmove t1, dosigh ; Turn off the signal I/O handler 13891 DIC% ; Enable to catch it 13892 %jserr (,) ; Odd, but carry on 13893 ret 13894 >;;End Repeat 0 13895 >;;emacro 13896 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 15 K20MAC MAC 1-Apr-23 22:30 COMND% Command State Block Initialization/Fix Up 13897 subttl COMND% Command State Block Initialization/Fix Up 13898 13899 emacro < 13900 splini: remark ; Split initialization 13901 remark ; Tweak the csb to parse from string 13902 dmove t2,[point 7,cmdbuf ;Point to beginning of command buffer 13903 cmdbln*5 ] ; Max characters in command buffer 13904 dmovem t2, sbk+.cmptr ; Stomp both in; beginning of parse 13905 setzm sbk+.cminc ; No unparsed characters, yet... 13906 ret 13907 13908 splfix: remark ; Done parsing, fix the CSB back up 13909 dmove t1,[point 7,cmdbuf ;Point to beginning of command buffer 13910 cmdbln*5 ] ; Max characters in command buffer 13911 dmovem t1, sbk+.cmptr ; Stomp both in; nothing left to parse 13912 setzm sbk+.cminc ; No unparsed characters anymore 13913 setzb t1, t2 ; Cons up ten .CHNUL's 13914 dmovem t1, cmdbuf ; Scrub the command buffer an itty bit 13915 hllm t1, sbk ; Zero the CSB flags. 13916 ret 13917 13918 >;;emacro 13919 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 16 K20MAC MAC 1-Apr-23 22:30 Prepare CSB and CMDBUF to parse from string 13920 subttl Prepare CSB and CMDBUF to parse from string 13921 13922 ; Expects 13923 ; 13924 ; q4/ Pointer to macro text 13925 ; q2/ Pointer to command buffer 13926 ; 13927 ; Returns: 13928 ; 13929 ; t1/ Terminating character 13930 ; 13931 ; CMDBUF filled 13932 ; CSB conditioned 13933 13934 emacro < 13935 13936 prepar: do. ; Enter loop context 13937 ildb t1, q4 ; Get a character from the macro text 13938 jumpe t1, endlp. ; Exit routine on end of string 13939 cain t1, .chcrt ; A carriage return? 13940 movei t1, .chlfd ; Turn into what COMND% wants ... 13941 idpb t1, q2 ; Copy the character into the command buffer 13942 aos sbk+.cminc ; Account for character to be parsed 13943 sos sbk+.cmcnt ; Account for character storage used 13944 cain t1, .chlfd ; A line feed? 13945 exit. ; Last command on line 13946 cain t1, "," ; Hit a comma? 13947 exit. ; Yes, SET pair seperator 13948 loop. ; Process next character 13949 enddo. ; End loop lexical context 13950 13951 ret ; And done 13952 >;;emacro 13953 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 17 K20MAC MAC 1-Apr-23 22:30 msplit - Takes a macro text and splits it up 13954 subttl msplit - Takes a macro text and splits it up 13955 13956 ; t1/ Top of editing area to stash things 13957 ; t2/ TBLUK% entry of existing macro 13958 ; 13959 ; First attempt, abandoned for using COMND% based approach 13960 ; 13961 ;N.B., assumes editing area is zeroed!! 13962 13963 emacro < 13964 repeat 0,< 13965 msplit: saveac 13966 move q3, t1 ; Save top of macro insertion 13967 hrli q4, (point 7,0) ; Build a section local pointer 13968 hrr q4, (t2) ; Get address of macro text 13969 13970 do. ; Enter main loop context 13971 move q1, q3 ; This will be a SET keyword 13972 hrrz t2, q1 ; Pointer starts there 13973 hrli t2, (point 7,0) ; Build a section local pointer 13974 setz t3, ; No beginning of keyword, yet 13975 do. ; Enter keyword identification loop 13976 ildb t1, q4 ; Pick up a byte of keyword 13977 block. ; Enter block context for easier control flow 13978 jumpe t1, rskp ; End of string? That's odd 13979 cain t1, .chspc ; Space? 13980 retskp ; End of keyword 13981 cain t1, .chtab ; Tab? 13982 retskp ; End of keyword 13983 cain t1, .chlpa ; Left parenthesis? 13984 retskp ; COMND% will break on that 13985 ret ; None of the above 13986 endbk. ; Exit block context 13987 ifskp. ; Hit a break character 13988 jumpn t3, endlp. ; If started significance, this a break, so leave 13989 loop. ; Nope, swallow it and get another 13990 else. ; Otherwise, signicant 13991 idpb t1, t2 ; Deposit in keyword area 13992 aoja t3, top. ; Flag start of significance 13993 endif. 13994 enddo. ; End keyword indentification loop 13995 ife. t1 ; Should not hit end of string after keyword 13996 move t1, q3 ; Load updated top of text area 13997 ret ; And stop 13998 endif. 13999 caie t2, 440700 ; On a word boundary? 14000 addi t2, ^d1 ; No, round up a word 14001 hrrz q2, t2 ; This will be the SET parameter 14002 move q3, q2 ; Also new top of storage 14003 setzb t3, t4 ; Haven't seen any characters, yet 14004 do. ; Enter value identification loop 14005 ildb t1, q4 ; Pick up a byte of keyword 14006 block. ; Enter block context for easier control flow 14007 cain t1, .chspc ; Space? 14008 retskp ; Reset value length counter k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 17-1 K20MAC MAC 1-Apr-23 22:30 msplit - Takes a macro text and splits it up 14009 cain t1, .chtab ; Tab? 14010 retskp ; Reset value length counter 14011 cain t1, .chrpa ; Right parenthesis? 14012 retskp ; Reset value length counter 14013 ife. t1 ; .chnul?? 14014 seto t4, ; Flag end of keyword value 14015 ret ; But count it 14016 endif. 14017 caie t1, "," ; Value terminator? 14018 ifskp. ; Yes, we have the value for this keyword 14019 seto t4, ; Flag end of keyword value 14020 ret ; But count it 14021 endif. 14022 ret ; Some other character, count it 14023 endbk. ; End block context 14024 ifskp. ; +2 means hit a seperator character 14025 setz t3, ; Reset the counter 14026 loop. ; And get another character 14027 else. ; Otherwise, count towards a keyword 14028 jumpn t4, endlp. ; Break loop on end of keyword value 14029 aoja t3, top. ; Count the character and loop 14030 endif. ; End of block exit handling 14031 enddo. ; End search loop 14032 ife. t3 ; Never found a value? 14033 addi q3, ^d1 ; Leave a word of .chnul's 14034 else. ; Otherwise have to play with pointers 14035 move t1, q2 ; Destination is top of storage 14036 hrli t1,(point 7,0) ; Turn into a word based pointer 14037 movn t2, t3 ; Load negatve keyword length 14038 subi t2, ^d1 ; Don't copy the comma or .chnul 14039 adjbp t2, q4 ; Back up to beginning of keyword 14040 do. ; And copy the keyword over 14041 ildb t4, t2 ; Pick up a byte from macro text 14042 idpb t4, t1 ; And put into edit area 14043 sojg t3, top. ; Do all of them 14044 enddo. 14045 caie t1, 440700 ; Ended on a word boundary? 14046 addi t1, ^d1 ; No, round up a word 14047 hrrz q3, t1 ; Set new top of storage 14048 endif. 14049 14050 movei t1, medorg ; Address of keyword table 14051 hrlz t2, q1 ; Load address of keyword text 14052 hrr t2, q2 ; Identified value 14053 TBADD% ; Cross our fingers and insert 14054 %jserr (,) ;Carry on 14055 ldb t1, q4 ; Load stopping character 14056 jumpe t1, endlp. ; End of macro text, done 14057 loop. ; Look for next keyword value pair 14058 enddo. ; End of split loop 14059 14060 move t1, q3 ; Load updated top of text area 14061 ret 14062 >;;repeat 0 14063 >;;emacro k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 17-2 K20MAC MAC 1-Apr-23 22:30 msplit - Takes a macro text and splits it up 14064 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 18 K20MAC MAC 1-Apr-23 22:30 /RENAME parsing 14065 subttl /RENAME parsing 14066 14067 000415'01 200 16 0 00 000000# .renam: guide ; Macro definition 14068 000416'01 260 17 0 00 000302* 14069 000023'02 000000000000# 14070 000163'04 164 157 040 141 040 14071 movei t1, [ 14072 flddb. .cmqst,,,,,[ 14073 flddb. .cmfld,,,,, 14074 000417'01 201 01 0 00 002525' ]] 14075 14076 000420'01 260 17 0 00 000304* call rfield ; Get the new name for the macro 14077 14078 dmove t1, [ mactab ; Load the address of the keyword table 14079 000421'01 120 01 0 00 002533' point 7, atmbuf ] ; And a pointer to the atom buffer 14080 000422'01 104 00 0 00 000537 TBLUK% ; See if it's in there (shouldn't be) 14081 000423'01 320 12 0 00 000425' %jserr (,cmder1) ; Fail, allow a ^H 14082 000424'01 254 00 0 00 000430' 14083 000425'01 265 01 0 00 000345* 14084 000426'01 000000 000000 14085 000427'01 254 00 0 00 000325* 14086 14087 000430'01 607 02 0 00 040000 ifxn. t2, tl%exm ; Found an exact match? 14088 000431'01 254 00 0 00 000442' 14089 000432'01 200 01 0 00 000000# emsg ;" font crock mode 14090 000433'01 104 00 0 00 000313 14091 000024'02 000000000000# 14092 000170'04 124 150 145 040 162 14093 000434'01 561 01 0 00 000320* hrroi t1, atmbuf ; Point to the atom buffer 14094 000435'01 104 00 0 00 000076 PSOUT% ; Type the new name which won't work 14095 000436'01 200 01 0 00 000000# txmsg <" already exists> ;" font crock mode 14096 000437'01 104 00 0 00 000076 14097 000440'01 320 12 0 00 000441' 14098 000025'02 000000000000# 14099 000177'04 042 040 141 154 162 14100 000441'01 254 00 0 00 000427* jrst cmder1 ; Allow ^H 14101 000442'01 endif. 14102 14103 dmove t1, [point 7, atmbuf ; Load pointer to new keyword 14104 000442'01 120 01 0 00 002440' point 7, namatm] ; And a pointer to the macro name buffer 14105 000443'01 260 17 0 00 000401* call asczcp ; Copy the ASCIZ string over 14106 000444'01 202 03 0 00 000366* movem t3, namlen ; Save the length of what we copied 14107 14108 000445'01 260 17 0 00 000331* confrm ; Tie off the line 14109 14110 000446'01 201 01 0 00 002535' movei t1, [.renam,,$renam] ;Load our own semantic action 14111 000447'01 202 01 0 00 000333* movem t1, pars1 ; Stomp top-level parse, we're taking it from here 14112 000450'01 263 17 0 00 000000 ret ; Return into /RENAME semantic action 14113 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 19 K20MAC MAC 1-Apr-23 22:30 /RENAME semantic action 14114 subttl /RENAME semantic action 14115 14116 000451'01 265 16 0 00 002465' $renam: saveac ; Doesn't link with $define 14117 000452'01 332 10 0 00 000000# skipe q4, tbent ; Do we already have the keyword address? 14118 000453'01 254 00 0 00 000502' ifskp. ; Nope, go get it 14119 000454'01 201 01 0 00 000000# movei t1, mactab ; Load the address of the keyword table 14120 000455'01 200 02 0 00 000000# move t2, onamp ; And the keyword text pointer we started with 14121 000456'01 104 00 0 00 000537 TBLUK% ; See if it's in there (it betterbe) 14122 000457'01 320 12 0 00 000461' %jserr (,r) 14123 000460'01 254 00 0 00 000464' 14124 000461'01 265 01 0 00 000425* 14125 000462'01 000000000000# 14126 000463'01 254 00 0 00 000347* 14127 000203'04 105 162 162 157 162 14128 000464'01 603 02 0 00 040000 ifxe. t2, tl%exm ; Found an exact match? 14129 000465'01 254 00 0 00 000501' 14130 000466'01 200 01 0 00 000000# emsg ;" No, bomb 14131 000467'01 104 00 0 00 000313 14132 000026'02 000000000000# 14133 000213'04 103 157 165 154 144 14134 000470'01 561 01 0 00 000354* hrroi t1, namatm ; Point at what we should have found 14135 000471'01 104 00 0 00 000076 PSOUT% ; Type it 14136 000472'01 200 01 0 00 000000# txmsg <" macro in order to duplicate it> 14137 000473'01 104 00 0 00 000076 14138 000474'01 320 12 0 00 000475' 14139 000027'02 000000000000# 14140 000220'04 042 040 155 141 143 14141 000475'01 561 01 0 00 000361* hrroi t1, crlf ; Tie off the line 14142 000476'01 104 00 0 00 000076 PSOUT% 14143 000477'01 263 17 0 00 000000 ret ; Get out of here 14144 000500'01 254 00 0 00 000502' else. ; Otherwise, have something 14145 000501'01 200 10 0 00 000001 move q4, t1 ; Save the table entry 14146 000502'01 endif. ; End case looking for macro name 14147 000502'01 endif. ; End case already had the keyword address 14148 14149 ; Calculate the size of the new macro name in words 14150 14151 000502'01 200 05 0 00 000444* move q1, namlen ; Load length of macro name in characters 14152 000503'01 200 02 0 00 002441' move t2, [point 7,namatm] ; Load pointer to same 14153 000504'01 133 05 0 00 000002 adjbp q1, t2 ; Calculate the ending pointer 14154 000505'01 302 05 0 00 440700 caie q1, 440700 ; On a word boundary? 14155 000506'01 271 05 0 00 000001 addi q1, ^d1 ; No, round up a word 14156 000507'01 621 05 0 00 777777 tlz q1, -1 ; Shut off the pointer part 14157 000510'01 621 02 0 00 777777 tlz t2, -1 ; in both pointers 14158 000511'01 274 05 0 00 000002 sub q1, t2 ; Now have required words to transfer new name 14159 14160 ; But!! Would putting it in the table take us over the end? 14161 14162 000512'01 200 01 0 00 000000# move t1, macbp ; Load the current top of macro text 14163 000513'01 621 01 0 00 777777 tlz t1, -1 ; Shut off pointer (its always a word boundary) 14164 000514'01 270 01 0 00 000005 add t1, q1 ; Add in the new name's length in words 14165 000515'01 301 01 0 00 000000# cail t1, macx ; Not off the end, I hope? 14166 000516'01 334 00 0 00 000000 %ermsg (,r) 14167 000517'01 254 00 0 00 000523' 14168 000520'01 265 01 0 00 000461* k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 19-1 K20MAC MAC 1-Apr-23 22:30 /RENAME semantic action 14169 000521'01 000000000000# 14170 000522'01 254 00 0 00 000463* 14171 000227'04 115 141 143 162 157 14172 14173 ; Ok, so safe to pop the name into the macro table 14174 14175 000523'01 550 07 0 00 000000# hrrz q3, macbp ; Use word address of keyword location 14176 000524'01 200 01 0 00 000005 move t1, q1 ; Number of words to copy 14177 000525'01 201 02 0 00 000470* movei t2, namatm ; Source is the name that was in the atom buffer 14178 000526'01 200 03 0 00 000007 move t3, q3 ; Destination is in macro storage 14179 000527'01 123 01 0 00 002500' xblt. t1 ; And transfer it over 14180 000530'01 505 03 0 00 440700 hrli t3, (point 7,0) ; Turn final address into a word aligned pointer 14181 000531'01 202 03 0 00 000000# movem t3, macbp ; Set new top of macro storage 14182 14183 ; Now build the TBLUK% table entry to insert 14184 14185 000532'01 514 06 0 00 000007 hrlz q2, q3 ; Keyword is what we just copied in 14186 000533'01 540 06 0 10 000000 hrr q2, (q4) ; But the macro text remains the same 14187 14188 ; First, remove the old keyword so we don't have to check the table entry count 14189 14190 000534'01 201 01 0 00 000000# movei t1, mactab ; Load the address of the macro table 14191 000535'01 200 02 0 00 000010 move t2, q4 ; And the address of the keyword entry 14192 000536'01 104 00 0 00 000535 TBDEL% ; Remove (should always work since just found it) 14193 000537'01 320 12 0 00 000541' %jserr (,r) ;?? 14194 000540'01 254 00 0 00 000544' 14195 000541'01 265 01 0 00 000520* 14196 000542'01 000000000000# 14197 000543'01 254 00 0 00 000522* 14198 000240'04 122 145 156 141 155 14199 14200 ; Finally insert ours; should work because previously checked 14201 14202 000544'01 201 01 0 00 000000# movei t1, mactab ; Load the address of the macro table 14203 000545'01 200 02 0 00 000006 move t2, q2 ; And our new keyword entry 14204 000546'01 104 00 0 00 000536 TBADD% ; Enter it in the TBLUK% table 14205 000547'01 320 12 0 00 000551' %jserr (,r) 14206 000550'01 254 00 0 00 000554' 14207 000551'01 265 01 0 00 000541* 14208 000552'01 000000000000# 14209 000553'01 254 00 0 00 000543* 14210 000251'04 122 145 156 141 155 14211 14212 000554'01 263 17 0 00 000000 ret 14213 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 20 K20MAC MAC 1-Apr-23 22:30 DEFINE macro table maintenance functions 14214 subttl DEFINE macro table maintenance functions 14215 14216 ; Begin code insertion 14217 14218 000030'02 000000 000000 %table(tabswi) ; Table maintenance switches 14219 000031'02 000000# 000000# %key3 , .mcomp, $mcomp ; Garbage collect 14220 000015'03 143 157 155 160 141 14221 000017'03 000000# 000000# 14222 000032'02 000000# 000000# %key3 , .mdump, $mdump ; Write a macros in binary format 14223 000020'03 144 165 155 160 000 14224 000021'03 000000# 000000# 14225 000033'02 000000# 000000# %keyf4 , .mrese, $mrese, cm%inv ; (sleepy Tom...) 14226 000022'03 002000 000001 14227 000023'03 151 156 164 151 141 14228 000025'03 000000# 000000# 14229 000034'02 000000# 000000# %key3 , .mmap, $mmap ; Directly use macros from binary file 14230 000026'03 155 141 160 000 000 14231 000027'03 000000# 000000# 14232 000035'02 000000# 000000# %key3 , .mrese, $mrese ; Whack everything 14233 000030'03 162 145 163 145 164 14234 000032'03 000000# 000000# 14235 000036'02 000000# 000000# %key3 , .msave, $msave ; Save macros in ASCII format 14236 000033'03 163 141 166 145 000 14237 000034'03 000000# 000000# 14238 000037'02 000000# 000000# %key3 , .msumm, $msumm ; Summary of table usage 14239 000035'03 163 165 155 155 141 14240 000037'03 000000# 000000# 14241 000030'02 000007 000007 %tbend 14242 14243 000555'01 550 04 0 02 000000 tablem: hrrz t4, (t2) ; Get the command routine addresses. 14244 000556'01 202 04 0 00 000447* movem t4, pars1 ; Stomp top-level parse, we're taking it from here 14245 000557'01 554 01 0 04 000000 hlrz t1, (t4) ; Get the syntax routine 14246 000560'01 254 00 0 01 000000 callret (t1) ; Call it and carry on 14247 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 21 K20MAC MAC 1-Apr-23 22:30 Parse the /DUMP switch 14248 subttl Parse the /DUMP switch 14249 14250 ; Tries for a device first as this is more efficient for NUL: and 14251 ; catches more errors earlier and more easily. 14252 14253 ; Default command filespec fields for .CMFIL: 14254 14255 000561'01 600020 777777 dmpbk: gj%flg!gj%fou!gj%new!fld(.gjnhg,.rhalf) ; .GJGEN 14256 000562'01 000100 000101 .priin,,.priou ; .GJSRC (ignored if COMND%) 14257 000563'01 000000 000000 0 ; .GJDEV (do not default the device) 14258 000564'01 000000 000000 0 ; .GJDIR (do not default the directory) 14259 000565'01 000000 000000 0 ; .GJNAM (do not default the name) 14260 000566'01 000000000000# eascii () ; .GJEXT (default extension is .BIN) 14261 000261'04 102 111 116 000 000 14262 000567'01 000000000000# 0 ; .GJPRO (use system default protection) 14263 000570'01 000000 000000 0 ; .GJACT (use job's current account) 14264 000010 dmpbkl==<.-dmpbk> ; Length of this GTJFN argument block. 14265 14266 000571'01 265 16 0 00 002465' .mdump: saveac ; Protect some registers 14267 000572'01 200 01 0 00 002536' movx t1, cz%ncl!.fhslf ; Release non-open JFN's on reparse 14268 000573'01 104 00 0 00 000034 CLZFF% 14269 000574'01 320 12 0 00 000575' erjmpr .+1 ; Catch and ignore errors 14270 000575'01 200 16 0 00 000000# guide 14271 000576'01 260 17 0 00 000416* 14272 000040'02 000000000000# 14273 000262'04 155 141 143 162 157 14274 000577'01 200 01 0 00 002537' move t1, [dmpbk,,cjfnbk] ; Insert our file parsing defaults. 14275 000600'01 251 01 0 00 000000# blt t1, cjfnbk+dmpbkl 14276 14277 movei t1, [ ; Catch bare device 14278 flddb. .cmfil,,,,,[ 14279 000601'01 201 01 0 00 002550' flddb. .cmdev,cm%sdh,,,,]] 14280 000602'01 260 17 0 00 000420* call rfield ; Ask them to supply the file 14281 000603'01 135 05 0 00 002437' ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 14282 000604'01 200 06 0 00 000002 move q2, t2 ; Save parsed data (device or JFN) 14283 14284 000605'01 200 01 0 00 000006 move t1, q2 ; Load parse item for DVCHR% 14285 000606'01 302 05 0 00 000016 caie q1, .cmdev ; Typed a bare device? 14286 000607'01 621 01 0 00 777777 tlz t1, -1 ; Shut off flags so DVCHR% doesn't choke 14287 000610'01 104 00 0 00 000117 DVCHR% ; and find out about it 14288 000611'01 320 12 0 00 000613' %jserr (,r) 14289 000612'01 254 00 0 00 000616' 14290 000613'01 265 01 0 00 000551* 14291 000614'01 000000000000# 14292 000615'01 254 00 0 00 000553* 14293 000267'04 125 156 141 142 154 14294 000616'01 135 07 0 00 002553' ldb q3, [pointr t2, dv%typ] ; Pick up the device type 14295 14296 000617'01 302 05 0 00 000016 caie q1, .cmdev ; Typed a bare device? 14297 000620'01 254 00 0 00 000647' ifskp. ; Yes, see what it is 14298 000621'01 302 07 0 00 000015 caie q3, .dvnul ; NUL:? 14299 000622'01 254 00 0 00 000627' ifskp. ; Yes, we can simulate that 14300 000623'01 260 17 0 00 000445* confrm ; Confirm the selection 14301 000624'01 200 01 0 00 002554' movx t1, ;Use special designator and flags 14302 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 15:18 11-Jun-23 Page 21-1 K20MAC MAC 1-Apr-23 22:30 Parse the /DUMP switch 14303 000626'01 263 17 0 00 000000 ret ; Done with this special case 14304 000627'01 endif. ; Any other device is NOT VALID 14305 14306 000627'01 302 07 0 00 000000 caie q3, .dvdsk ; Bare device? 14307 000630'01 254 00 0 00 000646' ifskp. ; Yes, but needs a file name 14308 000631'01 200 01 0 00 000000# emsg ; First part of blat 14309 000632'01 104 00 0 00 000313 14310 000041'02 000000000000# 14311 000302'04 124 150 145 040 000 14312 000633'01 200 02 0 00 000006 move t2, q2 ; Load whatever we parsed 14313 000634'01 201 01 0 00 000101 movei t1, .priou ; Output to the terminal 14314 000635'01 104 00 0 00 000121 DEVST% ; Write the device name into the AC's 14315 000636'01 320 12 0 00 000640' %jserr (,cmder1) 14316 000637'01 254 00 0 00 000643' 14317 000640'01 265 01 0 00 000613* 14318 000641'01 000000000000# 14319 000642'01 254 00 0 00 000441* 14320 000303'04 125 156 141 142 154 14321 000643'01 200 01 0 00 000000# sxtext (t1,<: structure needs a file specification>) 14322 000042'02 000000000000# 14323 000314'04 072 040 163 164 162 14324 000644'01 104 00 0 00 000076 PSOUT% ; Finish the informative blat 14325 000645'01 254 00 0 00 000642* jrst cmder1 ; Allow reparse 14326 000646'01 endif. ; Any other device is NOT VALID 14327 14328 000646'01 254 00 0 00 000670' jrst .mdmpe ; Otherwise, handle as a general parse error 14329 000647'01 endif. ; End case .cmdev 14330 14331 remark .cmfil ; Everything else is a file 14332 14333 000647'01 302 07 0 00 000015 caie q3, .dvnul ; A JFN on NUL:?? 14334 000650'01 254 00 0 00 000663' ifskp. ; Yes, we can simulate that 14335 000651'01 260 17 0 00 000623* confrm ; Confirm the selection 14336 000652'01 200 01 0 00 000006 move t1, q2 ; Load parsed JFN 14337 000653'01 260 17 0 00 000000* call isnulj ; Convert it to a special JFN, releasing original 14338 000654'01 334 01 0 00 000000# ermsg% (,cmder1) ; Allow ^H 14339 000655'01 254 00 0 00 000661' 14340 000656'01 202 01 0 00 000000* 14341 000657'01 104 00 0 00 000313 14342 000660'01 254 00 0 00 000645* 14343 000043'02 000000000000# 14344 000324'04 113 105 122 115 111 14345 14346 000661'01 202 01 0 00 000625* movem t1, pars2 ; Store the JFN and original parse flags 14347 000662'01 263 17 0 00 000000 ret ; Done with this second special NUL: case 14348 000663'01 endif. 14349 14350 000663'01 302 07 0 00 000000 caie q3, .dvdsk ; Was this a structure? 14351 000664'01 254 00 0 00 000670' jrst .mdmpe ; No, any other device is NOT VALID 14352 14353 000665'01 260 17 0 00 000651* confrm ; Otherwise, fine; confirm selection 14354 000666'01 202 06 0 00 000661* movem q2, pars2 ; Store the JFN and flags 14355 000667'01 263 17 0 00 000000 ret ; Done with the parse 14356 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 22 K20MAC MAC 1-Apr-23 22:30 Parse the /DUMP switch 14357 remark Here for common parse errors 14358 14359 000670'01 200 01 0 00 000000# .mdmpe: emsg ; Begin whining 14360 000671'01 104 00 0 00 000313 14361 000044'02 000000000000# 14362 000336'04 124 150 145 040 000 14363 000672'01 201 01 0 00 000101 movei t1, .priou ; Output to terminal, always 14364 000673'01 302 05 0 00 000016 caie q1, .cmdev ; Device? 14365 000674'01 254 00 0 00 000705' ifskp. ; Yes, use DEVST% 14366 000675'01 200 02 0 00 000006 move t2, q2 ; Load whatever we parsed 14367 000676'01 104 00 0 00 000121 DEVST% ; Write the device name into the AC's 14368 000677'01 320 12 0 00 000701' %jserr (,cmder1) 14369 000700'01 254 00 0 00 000704' 14370 000701'01 265 01 0 00 000640* 14371 000702'01 000000000000# 14372 000703'01 254 00 0 00 000660* 14373 000337'04 125 156 141 142 154 14374 000704'01 254 00 0 00 000715' else. ; Otherwise, DEVST% will choke on the JFN 14375 000705'01 550 02 0 00 000006 hrrz t2, q2 ; Load just the JFN 14376 dmove t3, [ ; Just want the device name, no punctuation 14377 fld(.jsaof,js%dev) 14378 000706'01 120 03 0 00 002555' 0 ] ; No odd prefix, whatever that is 14379 000707'01 104 00 0 00 000030 JFNS% ; Convert to something readable 14380 000710'01 320 12 0 00 000712' %jserr (,cmder1) 14381 000711'01 254 00 0 00 000715' 14382 000712'01 265 01 0 00 000701* 14383 000713'01 000000000000# 14384 000714'01 254 00 0 00 000703* 14385 000347'04 125 156 141 142 154 14386 000715'01 endif. ; Either way, error should be more informative 14387 14388 000715'01 200 01 0 00 000000# txmsg <: device does not have binary dumping capabilities> 14389 000716'01 104 00 0 00 000076 14390 000717'01 320 12 0 00 000720' 14391 000045'02 000000000000# 14392 000361'04 072 040 144 145 166 14393 000720'01 561 01 0 00 000475* hrroi t1, crlf ; Newline 14394 000721'01 104 00 0 00 000076 PSOUT% ; Tie off the blat 14395 000722'01 320 12 0 00 000723' erjmpr .+1 ; Catch and ignore that error, too 14396 14397 000723'01 302 05 0 00 000006 caie q1, .cmfil ; Had we parsed a file, actually? 14398 000724'01 254 00 0 00 000730' ifskp. ; Yes, then have a little clean up to do 14399 000725'01 550 01 0 00 000006 hrrz t1, q2 ; Load our poor JFN, sans flags 14400 000726'01 104 00 0 00 000023 RLJFN% ; Toss it; can't use it 14401 000727'01 320 12 0 00 000714* erjmpr cmder1 ; Ignore error and beat it 14402 000730'01 endif. 14403 14404 000730'01 254 00 0 00 000727* jrst cmder1 ; Allow ^H 14405 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 23 K20MAC MAC 1-Apr-23 22:30 Execute the /DUMP switch 14406 subttl Execute the /DUMP switch 14407 14408 000731'01 265 16 0 00 002465' $mdump: saveac ; Wants a few accumulators 14409 14410 000732'01 200 05 0 00 000666* move q1, pars2 ; Load the JFN and flags 14411 000733'01 550 01 0 00 000005 hrrz t1, q1 ; Look at just the JFN 14412 000734'01 306 01 0 00 377777 cain t1, .nulio ; Special cased? 14413 000735'01 254 00 0 00 000745' ifskp. ; No, have to really open the file 14414 000736'01 200 02 0 00 002557' movx t2, 14415 000737'01 104 00 0 00 000021 OPENF% ; Try to create the file 14416 000740'01 320 12 0 00 000742' %jserr (,$mdmpe) 14417 000741'01 254 00 0 00 000745' 14418 000742'01 265 01 0 00 000712* 14419 000743'01 000000000000# 14420 000744'01 254 00 0 00 001060' 14421 000374'04 125 156 141 142 154 14422 000745'01 endif. ; End case file not on NUL: 14423 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 24 K20MAC MAC 1-Apr-23 22:30 Set up to dump the macros into binary file 14424 subttl Set up to dump the macros into binary file 14425 14426 ; N.B., Although the mapping direction seems non-intuitive here, 14427 ; what's actually happening is that we are reserving space in the 14428 ; output file to populate as we will. If we don't touch a page, it 14429 ; won't exist in the file, effectively showing up as a 'hole'. 14430 14431 remark PMAP% Case IV: deleting process memory 14432 000745'01 474 01 0 00 000000 seto t1, ; Don't want anything in gc .psect 14433 dmove t2, [ .fhslf,,gcpag ; This process, page number of gc psect 14434 000746'01 120 02 0 00 002560' pm%cnt!fld(gcpgs,pm%rpt) ] ; Number of pages to toss 14435 000747'01 104 00 0 00 000056 PMAP% ; Kick them all into oblivion 14436 000750'01 320 12 0 00 000752' %jserr (,$mdmpe) 14437 000751'01 254 00 0 00 000755' 14438 000752'01 265 01 0 00 000742* 14439 000753'01 000000000000# 14440 000754'01 254 00 0 00 001060' 14441 000404'04 125 156 141 142 154 14442 14443 remark PMAP% Case I: Mapping File Pages to a Process 14444 000755'01 514 01 0 00 000005 hrlz t1, q1 ; 'Input' file, page zero 14445 000756'01 316 01 0 00 002562' camn t1, [.nulio,,0] ; NUL:? 14446 000757'01 254 00 0 00 000767' ifskp. ; No, do the page map for real 14447 dmove t2, [ .fhslf,,gcpag ; This process, page number of gc psect 14448 000760'01 120 02 0 00 002563' pm%wr!pm%cnt!fld(gcpgs,pm%rpt) ] ; Number of pages to reserve 14449 000761'01 104 00 0 00 000056 PMAP% ; And get ready to drop data into them 14450 000762'01 320 12 0 00 000764' %jserr (,$mdmpe) 14451 000763'01 254 00 0 00 000767' 14452 000764'01 265 01 0 00 000752* 14453 000765'01 000000000000# 14454 000766'01 254 00 0 00 001060' 14455 000416'04 125 156 141 142 154 14456 000767'01 endif. ; End setting up a real file 14457 14458 remark ; Set up loop context 14459 remark q1, ; Has JFN and flags 14460 000767'01 201 06 0 00 000007 movx q2, gcpgs ; Load pages in table psect 14461 14462 dmove q3, [ macorg ; Source is the macros .psect 14463 000770'01 120 07 0 00 002565' gcorg ] ; Destination is garbage collection .psect 14464 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 25 K20MAC MAC 1-Apr-23 22:30 Loop to map out pages appropriately 14465 subttl Loop to map out pages appropriately 14466 14467 000771'01 do. ; Enter loop context 14468 000771'01 200 01 0 00 000007 move t1, q3 ; Load current macros address 14469 000772'01 242 01 0 00 777767 lsh t1, -^d9 ; Turn into a page number 14470 000773'01 505 01 0 00 400000 hrli t1, .fhslf ; This process 14471 000774'01 104 00 0 00 000057 RPACS% ; Find out what's in there 14472 000775'01 320 12 0 00 000777' ifje. r ; Catch and ignore error 14473 000776'01 254 00 0 00 001000' 14474 000777'01 400 02 0 00 000000 setz t2, ; Assume the page doesn't exist 14475 001000'01 endif. 14476 001000'01 607 02 0 00 010000 ifxn. t2, pa%pex ; Does the page exist? 14477 001001'01 254 00 0 00 001007' 14478 001002'01 607 02 0 00 100000 andxn. t2, pa%rd ; *AND* ... Can we read it? 14479 001003'01 254 00 0 00 001007' 14480 001004'01 201 01 0 00 001000 movei t1, ^d512 ; Yep, load the eternal page size 14481 001005'01 120 02 0 00 000007 dmove t2, q3 ; Load source and destination address 14482 001006'01 123 01 0 00 002500' xblt. t1 ; And put into the macros psect 14483 001007'01 endif. 14484 001007'01 363 06 0 00 001012' sojle q2, endlp. ; Exit when nothing left to do 14485 001010'01 114 07 0 00 002567' dadd q3, [exp ^d512,^d512 ] ; Step to next set of addresses 14486 001011'01 254 00 0 00 000771' loop. 14487 001012'01 enddo. ; Exit loop lexical context 14488 14489 remark ; Loop exit post processing 14490 14491 remark PMAP% Case IV: deleting process memory (but not really) 14492 001012'01 474 01 0 00 000000 seto t1, ; Don't want anything in gc .psect 14493 dmove t2, [ .fhslf,,gcpag ; This process, page number of gc psect 14494 001013'01 120 02 0 00 002560' pm%cnt!fld(gcpgs,pm%rpt) ] ; Number of pages to remove 14495 001014'01 104 00 0 00 000056 PMAP% ; Kick them all over to DDMP 14496 001015'01 320 12 0 00 001017' %jserr (,$mdmpe) 14497 001016'01 254 00 0 00 001022' 14498 001017'01 265 01 0 00 000764* 14499 001020'01 000000000000# 14500 001021'01 254 00 0 00 001060' 14501 000427'04 125 156 141 142 154 14502 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 26 K20MAC MAC 1-Apr-23 22:30 Loop to map out pages appropriately 14503 remark Binary file Epilogue 14504 14505 001022'01 550 01 0 00 000005 hrrz t1, q1 ; Load the file JFN 14506 001023'01 306 01 0 00 377777 cain t1, .nulio ; NUL:? 14507 001024'01 254 00 0 00 001054' ifskp. ; No, a real file 14508 001025'01 661 01 0 00 400000 txo t1, co%nrj ; Keep the JFN 14509 001026'01 104 00 0 00 000022 CLOSF% ; Close the file, mostly 14510 001027'01 320 12 0 00 001031' %jsErr (, $mdmpe) 14511 001030'01 254 00 0 00 001034' 14512 001031'01 265 01 0 00 001017* 14513 001032'01 000000000000# 14514 001033'01 254 00 0 00 001060' 14515 000437'04 125 156 141 142 154 14516 001034'01 505 01 0 00 000012 hrli t1, .fbsiz ; Set the number of macros as bytes 14517 001035'01 474 02 0 00 000000 seto t2, ; Changing all the bits in the word 14518 001036'01 554 03 0 00 000000# hlrz t3, mactab ; Load current macro count 14519 001037'01 104 00 0 00 000064 CHFDB% ; Set that for the curious 14520 001040'01 320 12 0 00 001042' %jsErr (,) 14521 001041'01 254 00 0 00 001045' 14522 001042'01 265 01 0 00 001031* 14523 001043'01 000000000000# 14524 001044'01 254 00 0 00 001045' 14525 000446'04 125 156 141 142 154 14526 001045'01 550 01 0 00 000005 hrrz t1, q1 ; Load the JFN one last time 14527 001046'01 104 00 0 00 000023 RLJFN% ; And toss it 14528 001047'01 320 12 0 00 001051' %jsErr (,) 14529 001050'01 254 00 0 00 001054' 14530 001051'01 265 01 0 00 001042* 14531 001052'01 000000000000# 14532 001053'01 254 00 0 00 001054' 14533 000460'04 125 156 141 142 154 14534 001054'01 endif. ; End case not NUL: 14535 14536 001054'01 200 01 0 00 000000# txmsg 14537 001055'01 104 00 0 00 000076 14538 001056'01 320 12 0 00 001057' 14539 000046'02 000000000000# 14540 000471'04 127 162 157 164 145 14541 001057'01 254 00 0 00 002067' callret $msumm ; Give us some summary information 14542 remark ret ; $msumm returns for us 14543 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 27 K20MAC MAC 1-Apr-23 22:30 Error handling 14544 subttl Error handling 14545 14546 001060'01 $mdmpe: remark ; Here to handle errors 14547 001060'01 474 01 0 00 000000 seto t1, ; Case IV, deleting process memory 14548 dmove t2, [ .fhslf,,gcpag ; This process, page number of gc psect 14549 001061'01 120 02 0 00 002560' pm%cnt!fld(gcpgs,pm%rpt) ] ; Number of pages to toss 14550 001062'01 104 00 0 00 000056 PMAP% ; Trim our working set 14551 001063'01 320 12 0 00 001065' %jserr (,) 14552 001064'01 254 00 0 00 001070' 14553 001065'01 265 01 0 00 001051* 14554 001066'01 000000000000# 14555 001067'01 254 00 0 00 001070' 14556 000473'04 102 151 156 141 162 14557 14558 001070'01 332 01 0 00 000005 skipe t1, q1 ; Didn't have a JFN? 14559 001071'01 260 17 0 00 000000* call frclos ; We did, go get rid of it 14560 001072'01 600 00 0 00 000000 nop ; Ignore any goofy error 14561 001073'01 263 17 0 00 000000 ret ; Done 14562 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 28 K20MAC MAC 1-Apr-23 22:30 Parse the /MAP switch 14563 subttl Parse the /MAP switch 14564 14565 ; Tries for a device first as this is more efficient for NUL: and 14566 ; catches more errors earlier and more easily. 14567 14568 ; Default command filespec fields for .CMFIL: 14569 14570 001074'01 100020 000000 mapbk: gj%flg!gj%old ; Must be existing file. 14571 repeat 4,<0> ; Normal defaults for dev:name. 14572 001075'01 000000 000000 14573 001076'01 000000 000000 14574 001077'01 000000 000000 14575 001100'01 000000 000000 14576 001101'01 000000000000# eascii () ; Default extension is .BIN. 14577 000505'04 102 111 116 000 000 14578 001102'01 000000000000# 0 ; Default protection, 14579 001103'01 000000 000000 0 ; and account. 14580 000010 mapbkl==<.-mapbk> ; Length of this GTJFN argument block. 14581 14582 001104'01 265 16 0 00 002465' .mmap: saveac ; Protect some registers 14583 001105'01 200 01 0 00 002536' movx t1, cz%ncl!.fhslf ; Release non-open JFN's on reparse 14584 001106'01 104 00 0 00 000034 CLZFF% 14585 001107'01 320 12 0 00 001110' erjmpr .+1 ; Catch and ignore errors 14586 001110'01 200 16 0 00 000000# guide 14587 001111'01 260 17 0 00 000576* 14588 000047'02 000000000000# 14589 000506'04 142 151 156 141 162 14590 001112'01 200 01 0 00 002571' move t1, [mapbk,,cjfnbk] ; Insert our file parsing defaults. 14591 001113'01 251 01 0 00 000000# blt t1, cjfnbk+mapbkl 14592 14593 movei t1, [ ; Catch bare device 14594 flddb. .cmfil,,,,,[ 14595 001114'01 201 01 0 00 002601' flddb. .cmdev,cm%sdh,,,,]] 14596 001115'01 260 17 0 00 000602* call rfield ; Ask them to supply the file 14597 001116'01 135 05 0 00 002437' ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 14598 001117'01 200 06 0 00 000002 move q2, t2 ; Save parsed data (device or JFN) 14599 14600 001120'01 200 01 0 00 000006 move t1, q2 ; Load parse item for DVCHR% 14601 001121'01 302 05 0 00 000016 caie q1, .cmdev ; Typed a bare device? 14602 001122'01 621 01 0 00 777777 tlz t1, -1 ; Shut off flags so DVCHR% doesn't choke 14603 001123'01 104 00 0 00 000117 DVCHR% ; and find out about it 14604 001124'01 320 12 0 00 001126' %jserr (,r) 14605 001125'01 254 00 0 00 001131' 14606 001126'01 265 01 0 00 001065* 14607 001127'01 000000000000# 14608 001130'01 254 00 0 00 000615* 14609 000512'04 125 156 141 142 154 14610 001131'01 135 07 0 00 002553' ldb q3, [pointr t2, dv%typ] ; Pick up the device type 14611 14612 001132'01 302 05 0 00 000016 caie q1, .cmdev ; Typed a bare device? 14613 001133'01 254 00 0 00 001162' ifskp. ; Yes, see what it is 14614 001134'01 302 07 0 00 000015 caie q3, .dvnul ; NUL:? 14615 001135'01 254 00 0 00 001142' ifskp. ; Yes, we can simulate that 14616 001136'01 260 17 0 00 000665* confrm ; Confirm the selection 14617 001137'01 200 01 0 00 002554' movx t1, ;Use special designator and flags k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 28-1 K20MAC MAC 1-Apr-23 22:30 Parse the /MAP switch 14618 001140'01 202 01 0 00 000732* movem t1, pars2 ; Store the JFN and (phoney) flags 14619 001141'01 263 17 0 00 000000 ret ; Done with this special case 14620 001142'01 endif. ; Any other device is NOT VALID 14621 14622 001142'01 302 07 0 00 000000 caie q3, .dvdsk ; Bare device? 14623 001143'01 254 00 0 00 001161' ifskp. ; Yes, but needs a file name 14624 001144'01 200 01 0 00 000000# emsg ; First part of blat 14625 001145'01 104 00 0 00 000313 14626 000050'02 000000000000# 14627 000525'04 124 150 145 040 000 14628 001146'01 200 02 0 00 000006 move t2, q2 ; Load whatever we parsed 14629 001147'01 201 01 0 00 000101 movei t1, .priou ; Output to terminal 14630 001150'01 104 00 0 00 000121 DEVST% ; Write the device name into the AC's 14631 001151'01 320 12 0 00 001153' %jserr (,cmder1) 14632 001152'01 254 00 0 00 001156' 14633 001153'01 265 01 0 00 001126* 14634 001154'01 000000000000# 14635 001155'01 254 00 0 00 000730* 14636 000526'04 125 156 141 142 154 14637 001156'01 200 01 0 00 000000# emsg <: structure needs a file specification> 14638 001157'01 104 00 0 00 000313 14639 000051'02 000000000000# 14640 000537'04 072 040 163 164 162 14641 001160'01 254 00 0 00 001155* jrst cmder1 ; Allow reparse 14642 001161'01 endif. ; Any other device is NOT VALID 14643 14644 001161'01 254 00 0 00 001203' jrst .mmape ; Handle as a general parse error 14645 001162'01 endif. ; End case .cmdev 14646 14647 remark .cmfil ; Everything else is a file 14648 14649 001162'01 302 07 0 00 000015 caie q3, .dvnul ; A JFN on NUL:?? 14650 001163'01 254 00 0 00 001176' ifskp. ; Yes, we can simulate that 14651 001164'01 260 17 0 00 001136* confrm ; Confirm the selection 14652 001165'01 200 01 0 00 000006 move t1, q2 ; Load parsed JFN 14653 001166'01 260 17 0 00 000653* call isnulj ; Convert it to a special JFN, releasing original 14654 001167'01 334 01 0 00 000000# ermsg% (,cmder1) ; Allow ^H 14655 001170'01 254 00 0 00 001174' 14656 001171'01 202 01 0 00 000656* 14657 001172'01 104 00 0 00 000313 14658 001173'01 254 00 0 00 001160* 14659 000052'02 000000000000# 14660 000547'04 113 105 122 115 111 14661 14662 001174'01 202 01 0 00 001140* movem t1, pars2 ; Store the JFN and original parse flags 14663 001175'01 263 17 0 00 000000 ret ; Done with this second special NUL: case 14664 001176'01 endif. 14665 14666 001176'01 302 07 0 00 000000 caie q3, .dvdsk ; Was this a structure? 14667 001177'01 254 00 0 00 001203' jrst .mmape ; No, any other device is NOT VALID 14668 14669 001200'01 260 17 0 00 001164* confrm ; Otherwise, fine; confirm selection 14670 001201'01 202 06 0 00 001174* movem q2, pars2 ; Store the JFN and flags 14671 001202'01 263 17 0 00 000000 ret ; Done with the parse 14672 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 29 K20MAC MAC 1-Apr-23 22:30 Parse the /MAP switch 14673 remark Here for common parse errors 14674 14675 001203'01 200 01 0 00 000000# .mmape: emsg ; Begin whining 14676 001204'01 104 00 0 00 000313 14677 000053'02 000000000000# 14678 000561'04 124 150 145 040 000 14679 14680 001205'01 201 01 0 00 000101 movei t1, .priou ; Output to terminal, always 14681 001206'01 302 05 0 00 000016 caie q1, .cmdev ; Device? 14682 001207'01 254 00 0 00 001220' ifskp. ; Yes, use DEVST% 14683 001210'01 200 02 0 00 000006 move t2, q2 ; Load whatever we parsed 14684 001211'01 104 00 0 00 000121 DEVST% ; Write the device name into the AC's 14685 001212'01 320 12 0 00 001214' %jserr (,cmder1) 14686 001213'01 254 00 0 00 001217' 14687 001214'01 265 01 0 00 001153* 14688 001215'01 000000000000# 14689 001216'01 254 00 0 00 001173* 14690 000562'04 125 156 141 142 154 14691 001217'01 254 00 0 00 001230' else. ; Otherwise, DEVST% will choke on the JFN 14692 001220'01 550 02 0 00 000006 hrrz t2, q2 ; Load just the JFN 14693 dmove t3, [ ; Just want the device name, no punctuation 14694 fld(.jsaof,js%dev) 14695 001221'01 120 03 0 00 002555' 0 ] ; No odd prefix, whatever that is 14696 001222'01 104 00 0 00 000030 JFNS% ; Convert to something readable 14697 001223'01 320 12 0 00 001225' %jserr (,cmder1) 14698 001224'01 254 00 0 00 001230' 14699 001225'01 265 01 0 00 001214* 14700 001226'01 000000000000# 14701 001227'01 254 00 0 00 001216* 14702 000572'04 125 156 141 142 154 14703 001230'01 endif. ; Either way, error should be more informative 14704 14705 001230'01 200 01 0 00 000000# txmsg <: device does not have binary mapping capabilities> 14706 001231'01 104 00 0 00 000076 14707 001232'01 320 12 0 00 001233' 14708 000054'02 000000000000# 14709 000604'04 072 040 144 145 166 14710 001233'01 561 01 0 00 000720* hrroi t1, crlf ; Newline 14711 001234'01 104 00 0 00 000076 PSOUT% ; Tie off the blat 14712 001235'01 320 12 0 00 001236' erjmpr .+1 ; Catch and ignore that error, too 14713 14714 001236'01 302 05 0 00 000006 caie q1, .cmfil ; Had we parsed a file, actually? 14715 001237'01 254 00 0 00 001243' ifskp. ; Yes, then have a little clean up to do 14716 001240'01 550 01 0 00 000006 hrrz t1, q2 ; Load our poor JFN, sans flags 14717 001241'01 104 00 0 00 000023 RLJFN% ; Toss it; can't use it 14718 001242'01 320 12 0 00 001227* erjmpr cmder1 ; Ignore error and beat it 14719 001243'01 endif. 14720 14721 001243'01 254 00 0 00 001242* jrst cmder1 ; Allow ^H 14722 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 30 K20MAC MAC 1-Apr-23 22:30 Execute the /MAP switch 14723 subttl Execute the /MAP switch 14724 14725 001244'01 265 16 0 00 002465' $mmap: saveac ; Wants a few accumulators 14726 001245'01 403 05 0 00 000006 setzb q1, q2 ; Zero local JFN and input file size (pages) 14727 14728 001246'01 200 05 0 00 001201* move q1, pars2 ; Load the JFN and flags 14729 001247'01 550 01 0 00 000005 hrrz t1, q1 ; Look at just the JFN 14730 001250'01 306 01 0 00 377777 cain t1, .nulio ; Special cased? 14731 001251'01 254 00 0 00 001404' jrst $mmapn ; Yes, go do it 14732 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 31 K20MAC MAC 1-Apr-23 22:30 Set up and check to map a real binary file 14733 subttl Set up and check to map a real binary file 14734 14735 001252'01 104 00 0 00 000036 SIZEF% ; Find out about the file 14736 001253'01 320 12 0 00 001255' %jserr (,r) ; Go no further 14737 001254'01 254 00 0 00 001260' 14738 001255'01 265 01 0 00 001225* 14739 001256'01 000000000000# 14740 001257'01 254 00 0 00 001130* 14741 000617'04 102 151 156 141 162 14742 001260'01 322 02 0 00 001404' jumpe t2, $mmapn ; No macros written? Assume empty, then 14743 001261'01 322 03 0 00 001404' jumpe t3, $mmapn ; Empty file? Treat as NUL: case 14744 14745 001262'01 303 02 0 00 000252 caile t2, macmax ; Too many macros? 14746 001263'01 334 00 0 00 000000 %ermsg (,$mmape) 14747 001264'01 254 00 0 00 001270' 14748 001265'01 265 01 0 00 001255* 14749 001266'01 000000000000# 14750 001267'01 254 00 0 00 001400' 14751 000630'04 124 157 157 040 155 14752 001270'01 303 03 0 00 000007 caile t3, macpgs ; Too large? 14753 001271'01 334 00 0 00 000000 %ermsg (,$mmape) 14754 001272'01 254 00 0 00 001276' 14755 001273'01 265 01 0 00 001265* 14756 001274'01 000000000000# 14757 001275'01 254 00 0 00 001400' 14758 000641'04 102 151 156 141 162 14759 001276'01 200 06 0 00 000003 move q2, t3 ; Save binary file size (in pages) 14760 ; Read-Only, force open even if PMAP%'ed 14761 001277'01 200 02 0 00 002604' movx t2, 14762 001300'01 104 00 0 00 000021 OPENF% ; Try to open the file 14763 001301'01 320 12 0 00 001303' %jserr (,$mmape) 14764 001302'01 254 00 0 00 001306' 14765 001303'01 265 01 0 00 001273* 14766 001304'01 000000000000# 14767 001305'01 254 00 0 00 001400' 14768 000650'04 125 156 141 142 154 14769 14770 remark PMAP% Case IV, deleting process memory 14771 001306'01 474 01 0 00 000000 seto t1, ; Don't want anything in gc .psect 14772 dmove t2, [ .fhslf,,gcpag ; This process, page number of gc psect 14773 001307'01 120 02 0 00 002560' pm%cnt!fld(gcpgs,pm%rpt) ] ; Number of pages to toss 14774 001310'01 104 00 0 00 000056 PMAP% ; Kick them all into oblivion 14775 001311'01 320 12 0 00 001313' %jserr (,$mmape) 14776 001312'01 254 00 0 00 001316' 14777 001313'01 265 01 0 00 001303* 14778 001314'01 000000000000# 14779 001315'01 254 00 0 00 001400' 14780 000660'04 125 156 141 142 154 14781 14782 remark PMAP% Case IV, deleting process memory 14783 001316'01 474 01 0 00 000000 seto t1, ; Don't want anything in macros .psect 14784 dmove t2, [ .fhslf,,macpag ; This process, page number of macros psect 14785 001317'01 120 02 0 00 002605' pm%cnt!fld(macpgs,pm%rpt) ] ; Number of pages to toss 14786 001320'01 104 00 0 00 000056 PMAP% ; Kick them all into oblivion 14787 001321'01 320 12 0 00 001323' %jserr (,$mmapi) k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 31-1 K20MAC MAC 1-Apr-23 22:30 Set up and check to map a real binary file 14788 001322'01 254 00 0 00 001326' 14789 001323'01 265 01 0 00 001313* 14790 001324'01 000000000000# 14791 001325'01 254 00 0 00 001407' 14792 000671'04 125 156 141 142 154 14793 14794 remark PMAP% Case I: Mapping File Pages to a Process 14795 001326'01 514 01 0 00 000005 hrlz t1, q1 ; File JFN, starting from page zero 14796 001327'01 200 02 0 00 002560' movx t2, <.fhslf,, gcpag> ; Put them into the *garbage collection* area 14797 001330'01 200 03 0 00 000006 move t3, q2 ; Get page count 14798 001331'01 302 03 0 00 000001 caie t3, ^d1 ; Only a single page? 14799 001332'01 661 03 0 00 400000 txo t3, pm%cnt ; No, turn on repeat (slower, even for 1 page) 14800 001333'01 661 03 0 00 110000 txo t3, pm%rd!pm%pld ; Get them all in fast 14801 001334'01 104 00 0 00 000056 PMAP% ; And do the I/O 14802 001335'01 320 12 0 00 001337' %jserr (,$mmapi) 14803 001336'01 254 00 0 00 001342' 14804 001337'01 265 01 0 00 001323* 14805 001340'01 000000000000# 14806 001341'01 254 00 0 00 001407' 14807 000704'04 125 156 141 142 154 14808 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 32 K20MAC MAC 1-Apr-23 22:30 Loop to copy pages appropriately 14809 subttl Loop to copy pages appropriately 14810 14811 ; Do we have to check the file page if there's nothing there or the memory? 14812 14813 001342'01 200 04 0 00 000006 move t4, q2 ; Load size as a count 14814 dmove q3, [ gcorg ; Source is garbage collection .psect 14815 001343'01 120 07 0 00 002607' macorg ] ; Destination is the macros .psect 14816 14817 001344'01 do. ; Enter loop context 14818 001344'01 200 01 0 00 000007 move t1, q3 ; Load current gc address 14819 001345'01 242 01 0 00 777767 lsh t1, -^d9 ; Turn into a page number 14820 001346'01 505 01 0 00 400000 hrli t1, .fhslf ; This process 14821 001347'01 104 00 0 00 000057 RPACS% ; Find out what's in there 14822 001350'01 320 12 0 00 001352' ifje. r ; Catch and ignore error 14823 001351'01 254 00 0 00 001353' 14824 001352'01 400 02 0 00 000000 setz t2, ; Assume the page doesn't exist 14825 001353'01 endif. 14826 001353'01 607 02 0 00 010000 ifxn. t2, pa%pex ; Does the page exist? 14827 001354'01 254 00 0 00 001362' 14828 001355'01 607 02 0 00 100000 andxn. t2, pa%rd ; *AND* ... Can we read it? 14829 001356'01 254 00 0 00 001362' 14830 001357'01 201 01 0 00 001000 movei t1, ^d512 ; Yep, load the eternal page size 14831 001360'01 120 02 0 00 000007 dmove t2, q3 ; Load source and destination address 14832 001361'01 123 01 0 00 002500' xblt. t1 ; And put into the macros psect 14833 001362'01 endif. 14834 001362'01 363 04 0 00 001365' sojle t4, endlp. ; Exit when nothing left to do 14835 001363'01 114 07 0 00 002567' dadd q3, [exp ^d512,^d512 ] ; Step to next set of addresses 14836 001364'01 254 00 0 00 001344' loop. ; And go around again 14837 001365'01 enddo. ; Exit loop lexical context 14838 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 33 K20MAC MAC 1-Apr-23 22:30 Loop to copy pages appropriately 14839 remark Binary input file Epilogue 14840 14841 remark Toss the file pages we mapped into the garbage collector 14842 dmove t1, [ -1 ; Case IV, deleting process memory 14843 001365'01 120 01 0 00 002611' .fhslf,,gcpag ] ; This process, page number of gc psect 14844 001366'01 200 03 0 00 000006 move t3, q2 ; Get page count 14845 001367'01 302 03 0 00 000001 caie t3, ^d1 ; Only a single page? 14846 001370'01 661 03 0 00 400000 txo t3, pm%cnt ; No, turn on repeat (slower, even for 1 page) 14847 001371'01 104 00 0 00 000056 PMAP% ; Get rid of them so we can close the file 14848 001372'01 320 12 0 00 001374' %jserr (,) ; Odd... but carry on 14849 001373'01 254 00 0 00 001377' 14850 001374'01 265 01 0 00 001337* 14851 001375'01 000000000000# 14852 001376'01 254 00 0 00 001377' 14853 000716'04 102 151 156 141 162 14854 001377'01 260 17 0 00 002067' call $msumm ; Give us some summary information 14855 14856 remark $mmape ; Falls through to close the JFN 14857 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 34 K20MAC MAC 1-Apr-23 22:30 Error handling, NUL: mapping special case and Initialization 14858 subttl Error handling, NUL: mapping special case and Initialization 14859 14860 001400'01 $mmape: remark ; Here if some other error 14861 001400'01 332 01 0 00 000005 skipe t1, q1 ; Didn't have a JFN? 14862 001401'01 260 17 0 00 001071* call frclos ; We did, go get rid of it 14863 001402'01 600 00 0 00 000000 nop ; Ignore any goofy error 14864 001403'01 263 17 0 00 000000 ret ; But leave the current macro table alone 14865 14866 001404'01 260 17 0 00 001407' $mmapn: call $mmapi ; Whack everything (types summary) 14867 001405'01 260 17 0 00 001400' call $mmape ; Toss any JFN's 14868 001406'01 263 17 0 00 000000 ret ; That was easy enough 14869 14870 001407'01 $mmapi: remark ; Here to initialize for mapping 14871 001407'01 260 17 0 00 001423' call $mrese ; Whack the macros .psect 14872 remark ; Toss anything in garbage collector 14873 001410'01 474 01 0 00 000000 seto t1, ; Case IV, deleting process memory 14874 dmove t2, [ .fhslf,,gcpag ; This process, page number of gc psect 14875 001411'01 120 02 0 00 002560' pm%cnt!fld(gcpgs,pm%rpt) ] ; Number of pages to toss 14876 001412'01 104 00 0 00 000056 PMAP% ; Trim our working set 14877 001413'01 320 12 0 00 001415' %jserr (,) ; Odd... but continue 14878 001414'01 254 00 0 00 001420' 14879 001415'01 265 01 0 00 001374* 14880 001416'01 000000000000# 14881 001417'01 254 00 0 00 001420' 14882 000725'04 102 151 156 141 162 14883 001420'01 263 17 0 00 000000 ret ; Done 14884 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 35 K20MAC MAC 1-Apr-23 22:30 Here to whack all the macros 14885 subttl Here to whack all the macros 14886 14887 remark parse the rest of /RESET 14888 14889 001421'01 260 17 0 00 001200* .mrese: confrm ; Just confirm 14890 001422'01 263 17 0 00 000000 ret ; Then return so we can get on with it 14891 14892 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 36 K20MAC MAC 1-Apr-23 22:30 Execute the /RESET 14893 subttl Execute the /RESET 14894 14895 001423'01 474 01 0 00 000000 $mrese: seto t1, ; Case IV, deleting process memory 14896 dmove t2, [ .fhslf,,macpag ; This process, page number of macros psect 14897 001424'01 120 02 0 00 002605' pm%cnt!fld(macpgs,pm%rpt) ] ; Number of pages to toss 14898 001425'01 104 00 0 00 000056 PMAP% ; Kick them all into oblivion 14899 001426'01 320 12 0 00 001430' ifje. r ; Failed?? 14900 001427'01 254 00 0 00 001443' 14901 001430'01 200 04 0 00 000001 move t4, t1 ; Save the error code 14902 001431'01 201 01 0 00 006777 movx t1, maclen-1 ; Whack the buffer the old fashioned way 14903 001432'01 402 00 0 00 011000 setzm macorg ; Stomp the first location to zero 14904 dmove t2, [ macorg ; Then transfering the first word 14905 001433'01 120 02 0 00 002613' macorg+1 ] ;To the second 14906 001434'01 123 01 0 00 002500' xblt. t1 ; It's turtles all the way down! 14907 001435'01 600 00 0 00 000000 nop ; Ignore the error, we're trying hard enough 14908 001436'01 334 00 0 00 000000 %ermsg (,) 14909 001437'01 254 00 0 00 001443' 14910 001440'01 265 01 0 00 001415* 14911 001441'01 000000000000# 14912 001442'01 254 00 0 00 001443' 14913 000737'04 103 157 165 154 144 14914 001443'01 endif. ; Not promising, but carry on 14915 14916 001443'01 402 00 0 00 000000# setzm onamp ; No previous pointer 14917 dmove t1, [ 0,,MACMAX ; TBLUK% table has no entries now 14918 001444'01 120 01 0 00 002615' 0 ] ; Stomp the 2nd location, just in case 14919 001445'01 124 01 0 00 000000# dmovem t1, mactab ; Now have an empty table 14920 001446'01 200 01 0 00 002617' move t1,[point 7, macbuf] ; Point to beginning of macro storage 14921 001447'01 202 01 0 00 000000# movem t1, macbp ; Stomp into the new table 14922 emacro < 14923 remark ; Toss anything in the macro editor 14924 seto t1, ; Case IV, deleting process memory 14925 dmove t2, [ .fhslf,,medpg ; This process, page number of medit psect 14926 pm%cnt!fld(edpgs,pm%rpt) ] ; Number of pages to toss 14927 PMAP% ; Trim our working set 14928 %jserr (,) ; Odd... but continue 14929 >;; emacro 14930 remark $msumm ; They can do a /summary 14931 ; if they want to know 14932 001450'01 263 17 0 00 000000 ret 14933 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 37 K20MAC MAC 1-Apr-23 22:30 Parse the /SAVE switch 14934 subttl Parse the /SAVE switch 14935 14936 ; Tries for a device first as this is more efficient for NUL: and 14937 ; catches more errors earlier and more easily. 14938 14939 ; Default command filespec fields for .CMFIL: 14940 14941 001451'01 600020 777777 savbk: gj%flg!gj%fou!gj%new!fld(.gjnhg,.rhalf) ; .GJGEN 14942 001452'01 000100 000101 .priin,,.priou ; .GJSRC (ignored if COMND%) 14943 001453'01 000000 000000 0 ; .GJDEV (do not default the device) 14944 001454'01 000000 000000 0 ; .GJDIR (do not default the directory) 14945 001455'01 000000 000000 0 ; .GJNAM (do not default the name) 14946 001456'01 000000000000# eascii () ; .GJEXT (default extension is .CMD) 14947 000750'04 103 115 104 000 000 14948 001457'01 000000000000# 0 ; .GJPRO (use system default protection) 14949 001460'01 000000 000000 0 ; .GJACT (use job's current account) 14950 000010 savbkl==<.-savbk> ; Length of this GTJFN argument block. 14951 14952 001461'01 265 16 0 00 002465' .msave: saveac ; Protect some registers 14953 001462'01 200 01 0 00 002536' movx t1, cz%ncl!.fhslf ; Release non-open JFN's on reparse 14954 001463'01 104 00 0 00 000034 CLZFF% 14955 001464'01 320 12 0 00 001465' erjmpr .+1 ; Catch and ignore errors 14956 001465'01 200 16 0 00 000000# guide 14957 001466'01 260 17 0 00 001111* 14958 000055'02 000000000000# 14959 000751'04 155 141 143 162 157 14960 001467'01 200 01 0 00 002620' move t1, [savbk,,cjfnbk] ; Insert our file parsing defaults. 14961 001470'01 251 01 0 00 000000# blt t1, cjfnbk+savbkl 14962 14963 movei t1, [ ; Catch bare device 14964 flddb. .cmfil,,,,,[ 14965 001471'01 201 01 0 00 002626' flddb. .cmdev,cm%sdh,,,,]] 14966 001472'01 260 17 0 00 001115* call rfield ; Ask them to supply the file 14967 001473'01 135 05 0 00 002437' ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 14968 001474'01 200 06 0 00 000002 move q2, t2 ; Save parsed data (device or JFN) 14969 14970 001475'01 200 01 0 00 000006 move t1, q2 ; Load parse item for DVCHR% 14971 001476'01 302 05 0 00 000016 caie q1, .cmdev ; Typed a bare device? 14972 001477'01 621 01 0 00 777777 tlz t1, -1 ; Shut off flags so DVCHR% doesn't choke 14973 001500'01 104 00 0 00 000117 DVCHR% ; and find out about it 14974 001501'01 320 12 0 00 001503' %jserr (,r) 14975 001502'01 254 00 0 00 001506' 14976 001503'01 265 01 0 00 001440* 14977 001504'01 000000000000# 14978 001505'01 254 00 0 00 001257* 14979 000756'04 125 156 141 142 154 14980 001506'01 200 10 0 00 000001 move q4, t1 ; Store the device designator 14981 001507'01 135 07 0 00 002553' ldb q3, [pointr t2, dv%typ] ; Pick up the device type 14982 14983 001510'01 302 05 0 00 000016 caie q1, .cmdev ; Typed a bare device? 14984 001511'01 254 00 0 00 001566' ifskp. ; Yes, see what it is 14985 001512'01 302 07 0 00 000012 caie q3, .dvtty ; A terminal? 14986 001513'01 254 00 0 00 001541' ifskp. ; Yes, maybe show the user what we'd write 14987 001514'01 550 01 0 00 000010 hrrz t1, q4 ; Load the terminal number 14988 001515'01 316 01 0 00 000000* camn t1, mytty ; Not mine? k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 37-1 K20MAC MAC 1-Apr-23 22:30 Parse the /SAVE switch 14989 001516'01 254 00 0 00 001535' ifskp. ; Nope, disallow it 14990 001517'01 200 01 0 00 000000# emsg 14991 001520'01 104 00 0 00 000313 14992 000056'02 000000000000# 14993 000771'04 131 157 165 040 141 14994 001521'01 201 01 0 00 000101 movei t1, .priou ; Text is coming out on the terminal 14995 001522'01 200 02 0 00 000006 move t2, q2 ; Load the device designator 14996 001523'01 104 00 0 00 000121 DEVST% ; Convert device to string 14997 001524'01 320 12 0 00 001526' %jserr (,r) 14998 001525'01 254 00 0 00 001531' 14999 001526'01 265 01 0 00 001503* 15000 001527'01 000000000000# 15001 001530'01 254 00 0 00 001505* 15002 000776'04 125 156 141 142 154 15003 001531'01 200 01 0 00 000000# txmsg <:> 15004 001532'01 104 00 0 00 000076 15005 001533'01 320 12 0 00 001534' 15006 000057'02 000000000000# 15007 001007'04 072 000 000 000 000 15008 001534'01 254 00 0 00 001243* jrst cmder1 ; Allow ^H 15009 001535'01 endif. 15010 001535'01 260 17 0 00 001421* confrm ; Confirm the selection 15011 001536'01 200 01 0 00 002631' movx t1, ;Use special designator and flags 15012 001537'01 202 01 0 00 001246* movem t1, pars2 ; Store the JFN and (phoney) flags 15013 001540'01 263 17 0 00 000000 ret ; Done with this special case 15014 001541'01 endif. ; Any other device is NOT VALID 15015 15016 001541'01 302 07 0 00 000015 caie q3, .dvnul ; NUL:? 15017 001542'01 254 00 0 00 001547' ifskp. ; Yes, we can simulate that 15018 001543'01 260 17 0 00 001535* confrm ; Confirm the selection 15019 001544'01 200 01 0 00 002554' movx t1, ;Use special designator and flags 15020 001545'01 202 01 0 00 001537* movem t1, pars2 ; Store the JFN and (phoney) flags 15021 001546'01 263 17 0 00 000000 ret ; Done with this special case 15022 001547'01 endif. ; Any other device is NOT VALID 15023 15024 001547'01 302 07 0 00 000000 caie q3, .dvdsk ; Bare device? 15025 001550'01 254 00 0 00 001565' ifskp. ; Yes, but needs a file name 15026 001551'01 200 01 0 00 000000# emsg ; First part of blat 15027 001552'01 104 00 0 00 000313 15028 000060'02 000000000000# 15029 001010'04 124 150 145 040 000 15030 001553'01 200 02 0 00 000006 move t2, q2 ; Load whatever we parsed 15031 001554'01 201 01 0 00 000101 movei t1, .priou ; Output to the terminal 15032 001555'01 104 00 0 00 000121 DEVST% ; Write the device name into the AC's 15033 001556'01 320 12 0 00 001560' %jserr (,cmder1) 15034 001557'01 254 00 0 00 001563' 15035 001560'01 265 01 0 00 001526* 15036 001561'01 000000000000# 15037 001562'01 254 00 0 00 001534* 15038 001011'04 125 156 141 142 154 15039 001563'01 200 01 0 00 000000# sxtext (t1,<: structure needs a file specification>) 15040 000061'02 000000000000# 15041 001022'04 072 040 163 164 162 15042 001564'01 254 00 0 00 001562* jrst cmder1 ; Allow reparse 15043 001565'01 endif. ; Any other device is NOT VALID k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 37-2 K20MAC MAC 1-Apr-23 22:30 Parse the /SAVE switch 15044 15045 001565'01 254 00 0 00 001646' jrst .msve ; Otherwise, handle as a general parse error 15046 001566'01 endif. ; End case .cmdev 15047 15048 remark .cmfil ; Everything else is a file 15049 15050 001566'01 302 07 0 00 000012 caie q3, .dvtty ; A JFN on a terminal? 15051 001567'01 254 00 0 00 001625' ifskp. ; Yes, maybe show the user what we'd write 15052 001570'01 550 01 0 00 000010 hrrz t1, q4 ; Load the terminal number 15053 001571'01 312 01 0 00 001515* came t1, mytty ; Mine? 15054 001572'01 254 00 0 00 001577' ifskp. ; Yep 15055 001573'01 550 01 0 00 000006 hrrz t1, q2 ; Load the JFN 15056 001574'01 104 00 0 00 000023 RLJFN% ; Punt it, we won't be using it 15057 001575'01 320 12 0 00 001576' erjmpr .+1 ; Just strange... 15058 001576'01 254 00 0 00 001621' else. ; Nope, disallow it 15059 001577'01 200 01 0 00 000000# emsg 15060 001600'01 104 00 0 00 000313 15061 000062'02 000000000000# 15062 001032'04 131 157 165 040 141 15063 001601'01 201 01 0 00 000101 movei t1, .priou ; Text is coming out on the terminal 15064 001602'01 550 02 0 00 000006 hrrz t2, q2 ; Load just the JFN 15065 dmove t3, [ ; DEVST% will choke on a JFN... 15066 fld(.jsaof,js%dev) ;Just want the device name, no punctuation 15067 001603'01 120 03 0 00 002555' 0 ] ; No odd prefix, whatever that is 15068 001604'01 104 00 0 00 000030 JFNS% ; Convert to something readable 15069 001605'01 320 12 0 00 001607' %jserr (,cmder1) 15070 001606'01 254 00 0 00 001612' 15071 001607'01 265 01 0 00 001560* 15072 001610'01 000000000000# 15073 001611'01 254 00 0 00 001564* 15074 001037'04 125 156 141 142 154 15075 001612'01 200 01 0 00 000000# txmsg <:> 15076 001613'01 104 00 0 00 000076 15077 001614'01 320 12 0 00 001615' 15078 000063'02 000000000000# 15079 001051'04 072 000 000 000 000 15080 001615'01 550 01 0 00 000006 hrrz t1, q2 ; Load the JFN 15081 001616'01 104 00 0 00 000023 RLJFN% ; Chuck it, we can't use it 15082 001617'01 320 12 0 00 001620' erjmpr .+1 ; Just strange... 15083 001620'01 254 00 0 00 001611* jrst cmder1 ; Allow ^H 15084 001621'01 endif. 15085 15086 001621'01 260 17 0 00 001543* confrm ; Confirm the selection 15087 001622'01 200 01 0 00 002631' movx t1, ;Use special designator and flags 15088 001623'01 202 01 0 00 001545* movem t1, pars2 ; Store the JFN and (phoney) flags 15089 001624'01 263 17 0 00 000000 ret ; Done with this special case 15090 001625'01 endif. ; Any other terminal is NOT valid 15091 15092 001625'01 302 07 0 00 000015 caie q3, .dvnul ; A JFN on NUL:?? 15093 001626'01 254 00 0 00 001641' ifskp. ; Yes, we can simulate that 15094 001627'01 260 17 0 00 001621* confrm ; Confirm the selection 15095 001630'01 200 01 0 00 000006 move t1, q2 ; Load parsed JFN 15096 001631'01 260 17 0 00 001166* call isnulj ; Convert it to a special JFN, releasing original 15097 001632'01 334 01 0 00 000000# ermsg% (,cmder1) ; Allow ^H 15098 001633'01 254 00 0 00 001637' k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 37-3 K20MAC MAC 1-Apr-23 22:30 Parse the /SAVE switch 15099 001634'01 202 01 0 00 001171* 15100 001635'01 104 00 0 00 000313 15101 001636'01 254 00 0 00 001620* 15102 000064'02 000000000000# 15103 001052'04 113 105 122 115 111 15104 15105 001637'01 202 01 0 00 001623* movem t1, pars2 ; Store the JFN and original parse flags 15106 001640'01 263 17 0 00 000000 ret ; Done with this second special NUL: case 15107 001641'01 endif. 15108 15109 001641'01 302 07 0 00 000000 caie q3, .dvdsk ; Was this a structure? 15110 001642'01 254 00 0 00 001646' jrst .msve ; No, any other device is NOT VALID 15111 15112 001643'01 260 17 0 00 001627* confrm ; Otherwise, fine; confirm selection 15113 001644'01 202 06 0 00 001637* movem q2, pars2 ; Store the JFN and flags 15114 001645'01 263 17 0 00 000000 ret ; Done with the parse 15115 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 38 K20MAC MAC 1-Apr-23 22:30 Parse the /SAVE switch 15116 remark Here for common parse errors 15117 15118 001646'01 200 01 0 00 000000# .msve: emsg ; Begin whining 15119 001647'01 104 00 0 00 000313 15120 000065'02 000000000000# 15121 001064'04 124 150 145 040 000 15122 15123 001650'01 201 01 0 00 000101 movei t1, .priou ; Output to terminal, always 15124 001651'01 302 05 0 00 000016 caie q1, .cmdev ; Device? 15125 001652'01 254 00 0 00 001663' ifskp. ; Yes, use DEVST% 15126 001653'01 200 02 0 00 000006 move t2, q2 ; Load whatever we parsed 15127 001654'01 104 00 0 00 000121 DEVST% ; Write the device name into the AC's 15128 001655'01 320 12 0 00 001657' %jserr (,cmder1) 15129 001656'01 254 00 0 00 001662' 15130 001657'01 265 01 0 00 001607* 15131 001660'01 000000000000# 15132 001661'01 254 00 0 00 001636* 15133 001065'04 125 156 141 142 154 15134 001662'01 254 00 0 00 001673' else. ; Otherwise, DEVST% will choke on the JFN 15135 001663'01 550 02 0 00 000006 hrrz t2, q2 ; Load just the JFN 15136 dmove t3, [ ; Just want the device name, no punctuation 15137 fld(.jsaof,js%dev) 15138 001664'01 120 03 0 00 002555' 0 ] ; No odd prefix, whatever that is 15139 001665'01 104 00 0 00 000030 JFNS% ; Convert to something readable 15140 001666'01 320 12 0 00 001670' %jserr (,cmder1) 15141 001667'01 254 00 0 00 001673' 15142 001670'01 265 01 0 00 001657* 15143 001671'01 000000000000# 15144 001672'01 254 00 0 00 001661* 15145 001075'04 125 156 141 142 154 15146 001673'01 endif. ; Either way, error should be more informative 15147 15148 001673'01 200 01 0 00 000000# txmsg <: device is not valid for saving macros> 15149 001674'01 104 00 0 00 000076 15150 001675'01 320 12 0 00 001676' 15151 000066'02 000000000000# 15152 001107'04 072 040 144 145 166 15153 001676'01 561 01 0 00 001233* hrroi t1, crlf ; Newline 15154 001677'01 104 00 0 00 000076 PSOUT% ; Tie off the blat 15155 001700'01 320 12 0 00 001701' erjmpr .+1 ; Catch and ignore that error, too 15156 15157 001701'01 302 05 0 00 000006 caie q1, .cmfil ; Had we parsed a file, actually? 15158 001702'01 254 00 0 00 001706' ifskp. ; Yes, then have a little clean up to do 15159 001703'01 550 01 0 00 000006 hrrz t1, q2 ; Load our poor JFN, sans flags 15160 001704'01 104 00 0 00 000023 RLJFN% ; Toss it; can't use it 15161 001705'01 320 12 0 00 001672* erjmpr cmder1 ; Ignore error and beat it 15162 001706'01 endif. 15163 15164 001706'01 254 00 0 00 001705* jrst cmder1 ; Allow ^H 15165 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 39 K20MAC MAC 1-Apr-23 22:30 Execute the /SAVE switch 15166 subttl Execute the /SAVE switch 15167 15168 ; Not that fast. If you want fast, use /DUMP 15169 15170 001707'01 265 16 0 00 002465' $msave: saveac ; Wants a few accumulators 15171 15172 001710'01 554 06 0 00 000000# hlrz q2, mactab ; Load the macro count 15173 001711'01 326 06 0 00 001716' ife. q2 ; BUT!! Anything to save, really? 15174 txmsg <% No macros to save 15175 001712'01 200 01 0 00 000000# > ; Give a mild scolding 15176 001713'01 104 00 0 00 000076 15177 001714'01 320 12 0 00 001715' 15178 000067'02 000000000000# 15179 001117'04 045 040 116 157 040 15180 15181 001715'01 254 00 0 00 002061' jrst $msve ; And go flush the JFN 15182 001716'01 endif. 15183 15184 001716'01 200 05 0 00 001644* move q1, pars2 ; Load the JFN and flags 15185 001717'01 550 01 0 00 000005 hrrz t1, q1 ; Look at just the JFN 15186 001720'01 306 01 0 00 377777 cain t1, .nulio ; Special cased? 15187 001721'01 254 00 0 00 001733' ifskp. ; No, we're going to have to open it 15188 001722'01 306 01 0 00 000101 cain t1, .priou ; Unless it is primary output 15189 001723'01 254 00 0 00 001733' anskp. ; It is, don't bother 15190 001724'01 200 02 0 00 002632' movx t2, 15191 001725'01 104 00 0 00 000021 OPENF% ; Try to create the file 15192 001726'01 320 12 0 00 001730' %jserr (,$msve) 15193 001727'01 254 00 0 00 001733' 15194 001730'01 265 01 0 00 001670* 15195 001731'01 000000000000# 15196 001732'01 254 00 0 00 002061' 15197 001124'04 125 156 141 142 154 15198 001733'01 endif. 15199 15200 remark t1, ; Either way, t1 has something SOUT% can use 15201 001733'01 400 04 0 00 000000 setz t4, ; For uncounted SOUT%, always stop on a NUL 15202 001734'01 201 07 0 00 000000# movei q3, mactab+1 ; Start at the beginning of the table 15203 15204 001735'01 do. ; Enter loop context 15205 001735'01 120 02 0 00 000000# dxtext (t2,) ; Issue the command (NOTE TRAILING SPACE!!) 15206 000070'02 000000000000# 15207 000071'02 777777 777771 15208 001132'04 144 145 146 151 156 15209 001736'01 104 00 0 00 000053 SOUT% ; Start out with that 15210 001737'01 320 12 0 00 001741' %jserr (,$msve) 15211 001740'01 254 00 0 00 001744' 15212 001741'01 265 01 0 00 001730* 15213 001742'01 000000000000# 15214 001743'01 254 00 0 00 002061' 15215 001134'04 125 156 141 142 154 15216 001744'01 554 02 0 07 000000 hlrz t2, (q3) ; Address of macro name 15217 001745'01 505 02 0 00 440700 hrli t2, (point 7,0) ; Turn into a section local pointer 15218 001746'01 400 03 0 00 000000 setz t3, ; Uncounted, stop on a NUL 15219 001747'01 104 00 0 00 000053 SOUT% ; Write that 15220 001750'01 320 12 0 00 001752' %jserr (,$msve) k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 39-1 K20MAC MAC 1-Apr-23 22:30 Execute the /SAVE switch 15221 001751'01 254 00 0 00 001755' 15222 001752'01 265 01 0 00 001741* 15223 001753'01 000000000000# 15224 001754'01 254 00 0 00 002061' 15225 001143'04 125 156 141 142 154 15226 001755'01 201 02 0 00 000040 movei t2, .chspc ; Seperate macro name and body 15227 001756'01 104 00 0 00 000051 BOUT% ; Emit the space 15228 001757'01 550 02 0 07 000000 hrrz t2, (q3) ; Address of macro body 15229 001760'01 505 02 0 00 440700 hrli t2, (point 7,0) ; Turn into a section local pointer 15230 001761'01 400 03 0 00 000000 setz t3, ; Uncounted, stop on a NUL 15231 001762'01 104 00 0 00 000053 SOUT% ; Write that 15232 001763'01 320 12 0 00 001765' %jserr (,$msve) 15233 001764'01 254 00 0 00 001770' 15234 001765'01 265 01 0 00 001752* 15235 001766'01 000000000000# 15236 001767'01 254 00 0 00 002061' 15237 001151'04 125 156 141 142 154 15238 remark ; All have CRLF 15239 001770'01 363 06 0 00 001772' sojle q2, endlp. ; At end? Then stop 15240 001771'01 344 07 0 00 001735' aoja q3, top. ; Otherwise, do next table entry 15241 001772'01 enddo. ; End loop lexical context 15242 15243 001772'01 306 01 0 00 377777 cain t1, .nulio ; Not writing to NUL:? 15244 001773'01 254 00 0 00 002014' ifskp. ; Nope, then we should have a byte count 15245 001774'01 306 01 0 00 000101 cain t1, .priou ; Unless it's primary output 15246 001775'01 254 00 0 00 002014' anskp. ; That won't have one, either 15247 001776'01 104 00 0 00 000043 RFPTR% ; See how much we've written 15248 001777'01 320 12 0 00 002001' %jsErr (, $msve) 15249 002000'01 254 00 0 00 002004' 15250 002001'01 265 01 0 00 001765* 15251 002002'01 000000000000# 15252 002003'01 254 00 0 00 002061' 15253 001157'04 125 156 141 142 154 15254 002004'01 200 07 0 00 000002 move q3, t2 ; Save the (non-negative) byte count 15255 002005'01 104 00 0 00 000022 CLOSF% ; Completely close the (disk) file 15256 002006'01 320 12 0 00 002010' %jsErr (, $msve) 15257 002007'01 254 00 0 00 002013' 15258 002010'01 265 01 0 00 002001* 15259 002011'01 000000000000# 15260 002012'01 254 00 0 00 002061' 15261 001166'04 125 156 141 142 154 15262 002013'01 254 00 0 00 002015' else. ; Neither NUL: nor TTY: will have byte counts 15263 002014'01 474 07 0 00 000000 seto q3, ; Flag that 15264 002015'01 endif. 15265 15266 002015'01 200 01 0 00 000000# txmsg 15267 002016'01 104 00 0 00 000076 15268 002017'01 320 12 0 00 002020' 15269 000072'02 000000000000# 15270 001174'04 127 162 157 164 145 15271 002020'01 201 01 0 00 000101 movei t1, .priou ; Typing to terminal 15272 002021'01 554 02 0 00 000000# hlrz t2, mactab ; Number of macros 15273 002022'01 201 03 0 00 000012 movei t3, ^d10 ; All numbers are in base ten 15274 002023'01 200 04 0 00 000002 move t4, t2 ; Save the count 15275 002024'01 104 00 0 00 000224 NOUT% k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 39-2 K20MAC MAC 1-Apr-23 22:30 Execute the /SAVE switch 15276 002025'01 320 14 0 00 000001 erjmps +1 ; Catch and suppress error 15277 002026'01 200 01 0 00 000000# txmsg < macro> ; Assume singular 15278 002027'01 104 00 0 00 000076 15279 002030'01 320 12 0 00 002031' 15280 000073'02 000000000000# 15281 001176'04 040 155 141 143 162 15282 002031'01 306 04 0 00 000001 cain t4, ^d1 ; BUT! Non-plural or zero? 15283 002032'01 254 00 0 00 002036' ifskp. ; Nope, have to inflect because we're grammatical 15284 002033'01 201 01 0 00 000163 movei t1, "s" ; Pluralizer 15285 002034'01 104 00 0 00 000074 PBOUT% ; Properly inflect 15286 002035'01 320 14 0 00 000001 erjmps +1 ; Catch and suppress error 15287 002036'01 endif. 15288 15289 002036'01 321 07 0 00 002056' ifge. q3 ; Could we count the data? 15290 002037'01 200 01 0 00 000000# txmsg <, > ; Yes, so type it 15291 002040'01 104 00 0 00 000076 15292 002041'01 320 12 0 00 002042' 15293 000074'02 000000000000# 15294 001200'04 054 040 000 000 000 15295 002042'01 201 01 0 00 000101 movei t1, .priou ; Typing to terminal 15296 002043'01 200 02 0 00 000007 move t2, q3 ; Number of characters written 15297 002044'01 104 00 0 00 000224 NOUT% 15298 002045'01 320 14 0 00 000001 erjmps +1 ; Catch and suppress error 15299 002046'01 200 01 0 00 000000# txmsg < character> ; Assume singular 15300 002047'01 104 00 0 00 000076 15301 002050'01 320 12 0 00 002051' 15302 000075'02 000000000000# 15303 001201'04 040 143 150 141 162 15304 002051'01 306 04 0 00 000001 cain t4, ^d1 ; BUT! Non-plural or zero? 15305 002052'01 254 00 0 00 002056' ifskp. ; Nope, have to inflect because we're grammatical 15306 002053'01 201 01 0 00 000163 movei t1, "s" ; Pluralizer 15307 002054'01 104 00 0 00 000074 PBOUT% ; Properly inflect 15308 002055'01 320 14 0 00 000001 erjmps +1 ; Catch and suppress error 15309 002056'01 endif. 15310 002056'01 endif. 15311 15312 002056'01 561 01 0 00 001676* hrroi t1, crlf ; Tie off the line 15313 002057'01 104 00 0 00 000076 PSOUT% 15314 15315 002060'01 263 17 0 00 000000 ret ; Finally done 15316 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 40 K20MAC MAC 1-Apr-23 22:30 Error handling 15317 subttl Error handling 15318 15319 002061'01 $msve: remark ; Here to handle errors 15320 002061'01 332 01 0 00 000005 skipe t1, q1 ; Didn't have a JFN? 15321 002062'01 260 17 0 00 001401* call frclos ; We did, go get rid of it 15322 002063'01 600 00 0 00 000000 nop ; Ignore any goofy error 15323 002064'01 263 17 0 00 000000 ret ; Done 15324 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 41 K20MAC MAC 1-Apr-23 22:30 Provide summary information 15325 subttl Provide summary information 15326 15327 002065'01 260 17 0 00 001643* .msumm: confrm ; Tie off the line 15328 002066'01 263 17 0 00 000000 ret 15329 15330 002067'01 200 01 0 00 000000# $msumm: txmsg 15331 002070'01 104 00 0 00 000076 15332 002071'01 320 12 0 00 002072' 15333 000076'02 000000000000# 15334 001204'04 115 141 143 162 157 15335 002072'01 201 01 0 00 000101 movei t1, .priou ; This terminal 15336 002073'01 554 02 0 00 000000# hlrz t2, mactab ; Load macro keyword table entries 15337 002074'01 200 04 0 00 000002 move t4, t2 ; Tuck that away for later 15338 002075'01 201 03 0 00 000012 movei t3, ^d10 ; It's in base ten 15339 002076'01 104 00 0 00 000224 NOUT% ; Type it 15340 002077'01 320 12 0 00 002101' %jserr (,) ; Dubious, but carry on 15341 002100'01 254 00 0 00 002104' 15342 002101'01 265 01 0 00 002010* 15343 002102'01 000000 000000 15344 002103'01 254 00 0 00 002104' 15345 002104'01 200 01 0 00 000000# txmsg < used, > 15346 002105'01 104 00 0 00 000076 15347 002106'01 320 12 0 00 002107' 15348 000077'02 000000000000# 15349 001206'04 040 165 163 145 144 15350 002107'01 201 01 0 00 000101 movei t1, .priou ; This terminal 15351 002110'01 550 02 0 00 000000# hrrz t2, mactab ; Load maximum macro keyword table entries 15352 002111'01 274 02 0 00 000004 sub t2, t4 ; Yields remaining 15353 002112'01 104 00 0 00 000224 NOUT% ; Type that 15354 002113'01 320 12 0 00 002115' %jserr (,) ; Sigh... Carry on 15355 002114'01 254 00 0 00 002120' 15356 002115'01 265 01 0 00 002101* 15357 002116'01 000000 000000 15358 002117'01 254 00 0 00 002120' 15359 txmsg < remaining. 15360 002120'01 200 01 0 00 000000# Available storage: > 15361 002121'01 104 00 0 00 000076 15362 002122'01 320 12 0 00 002123' 15363 000100'02 000000000000# 15364 001210'04 040 162 145 155 141 15365 15366 002123'01 260 17 0 00 002143' call $mchrs ; Get us some other table numbers 15367 002124'01 200 02 0 00 000001 move t2, t1 ; Load total storage 15368 002125'01 200 04 0 00 000001 move t4, t1 ; Save a copy 15369 002126'01 201 01 0 00 000101 movei t1, .priou ; This terminal 15370 002127'01 201 03 0 00 000012 movei t3, ^d10 ; Base ten 15371 002130'01 104 00 0 00 000224 NOUT% ; Convert to external and display 15372 002131'01 320 12 0 00 002132' erjmpr .+1 ; Catch and ignore error 15373 002132'01 200 01 0 00 000000# txmsg < character> ; Assume (rare) singular case) 15374 002133'01 104 00 0 00 000076 15375 002134'01 320 12 0 00 002135' 15376 000101'02 000000000000# 15377 001217'04 040 143 150 141 162 15378 002135'01 201 01 0 00 000163 movei t1,"s" ;[203] Load inflection 15379 002136'01 302 04 0 00 000001 caie t4,^d1 ;[203] Singular case? k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 41-1 K20MAC MAC 1-Apr-23 22:30 Provide summary information 15380 002137'01 104 00 0 00 000074 PBOUT% ;[203] No, must inflect it 15381 15382 002140'01 561 01 0 00 002056* hrroi t1, crlf 15383 002141'01 104 00 0 00 000076 PSOUT% 15384 002142'01 263 17 0 00 000000 ret 15385 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 42 K20MAC MAC 1-Apr-23 22:30 Provide some table information to caller 15386 subttl Provide some table information to caller 15387 15388 ; Returns: 15389 ; 15390 ; t1/ characters available in macro table 15391 15392 002143'01 $mchrs: entry $mchrs ; Called by k20dsp 15393 002143'01 265 16 0 00 002633' saveac ; Be extra tidy 15394 15395 002144'01 201 01 0 00 000000# movei t1, macx ; Load end of macro table 15396 002145'01 200 02 0 00 000000# move t2, macbp ; Load end of macro expansions 15397 002146'01 554 03 0 00 000002 hlrz t3, t2 ; Load the byte pointer 15398 002147'01 302 03 0 00 440700 caie t3, 440700 ; On a word boundary? 15399 002150'01 271 02 0 00 000001 addi t2,^d1 ; No, round up a word 15400 002151'01 621 02 0 00 777777 tlz t2, -1 ; Shut off the byte pointer 15401 002152'01 274 01 0 00 000002 sub t1, t2 ; Calculate remaining words 15402 002153'01 221 01 0 00 000005 imuli t1, ^d5 ; Have total characters 15403 002154'01 263 17 0 00 000000 ret 15404 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 43 K20MAC MAC 1-Apr-23 22:30 Garbage collection 15405 subttl Garbage collection 15406 15407 remark Parsing 15408 15409 002155'01 260 17 0 00 002065* .mcomp: confrm ; Tie off the line 15410 002156'01 263 17 0 00 000000 ret ; Then get going on processing 15411 15412 remark Semantic action 15413 15414 extern ehptim ; Display elapsed processor ticks 15415 15416 002157'01 $mcomp: remark ; Garbage collection prologue 15417 002157'01 265 16 0 00 002465' saveac ; Will need some registers for control 15418 002160'01 200 01 0 00 000000# txmsg ; Set up for some blat 15419 002161'01 104 00 0 00 000076 15420 002162'01 320 12 0 00 002163' 15421 000102'02 000000000000# 15422 001222'04 102 145 146 157 162 15423 002163'01 260 17 0 00 002067' call $msumm ; Display macro table usage 15424 15425 002164'01 260 17 0 00 000000* call statim ; Record start time garbage collection run 15426 002165'01 201 01 0 00 000001 movx t1, .hprnt ; Request current CPU time used 15427 002166'01 104 00 0 00 000501 HPTIM% ; by this process 15428 002167'01 320 12 0 00 002171' %jserr (,r) ; Fail and don't do anything more 15429 002170'01 254 00 0 00 002174' 15430 002171'01 265 01 0 00 002115* 15431 002172'01 000000 000000 15432 002173'01 254 00 0 00 001530* 15433 002174'01 200 10 0 00 000001 move q4, t1 ; Store that 15434 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 44 K20MAC MAC 1-Apr-23 22:30 Garbage collection 15435 remark Set up loop context 15436 15437 remark ; First copy current macro .psect to the GC 15438 002175'01 554 05 0 00 000000# hlrz q1, mactab ; Save count of current entries 15439 002176'01 326 05 0 00 002203' ife. q1 ; Wait a second, is there anything to do? 15440 txmsg <% No macros, nothing to compact 15441 002177'01 200 01 0 00 000000# > ; Some minor scolding blat 15442 002200'01 104 00 0 00 000076 15443 002201'01 320 12 0 00 002202' 15444 000103'02 000000000000# 15445 001224'04 045 040 116 157 040 15446 15447 002202'01 263 17 0 00 000000 ret ; That all, we're done 15448 002203'01 endif. 15449 15450 002203'01 201 01 0 00 007000 movx t1, maclen ; Length of both .psect's 15451 dmove t2, [ macorg ; Source is first word of macro psect 15452 002204'01 120 02 0 00 002565' gcorg ] ; Destination is first word of gc psect 15453 002205'01 123 01 0 00 002500' xblt. t1 ; Copy entire macros psect to gc psect 15454 002206'01 600 00 0 00 000000 nop ; Ignore any skip nonsense 15455 002207'01 260 17 0 00 001423' call $mrese ; Now completely destroy the macros psect 15456 15457 002210'01 201 01 0 00 000001 movei t1, ^d1 ; Account for the header word 15458 002211'01 270 01 0 00 000005 add t1, q1 ; Only put back the TBLUK% entries 15459 dmove t2, [ gcorg ; Source is first word of gc psect (previous mactab 15460 002212'01 120 02 0 00 002607' macorg ] ; Destination is first word of macro psect 15461 002213'01 123 01 0 00 002500' xblt. t1 ; Only copy the in use part of the table 15462 002214'01 600 00 0 00 000000 nop ; Ignore any skip nonsense 15463 15464 002215'01 201 06 0 00 011001 movei q2, macorg+1 ; First slot in macro table 15465 dmove t1, [ gcorg ; Load first address of garbage collection 15466 002216'01 120 01 0 00 002607' macorg ] ; End first slot of macro table 15467 002217'01 317 01 0 00 000002 camg t1, t2 ; macros should be before garbage collection 15468 002220'01 250 01 0 00 000002 exch 1, t2 ; But they're not (??) 15469 002221'01 274 01 0 00 000002 sub t1, t2 ; Calculate address offset between tables 15470 002222'01 200 07 0 00 000001 move q3, t1 ; Store that 15471 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 45 K20MAC MAC 1-Apr-23 22:30 Garbage collection 15472 remark Get down to some serious byte banging 15473 15474 ; The garbage collection algorythm is trivial. We've copyed the entire 15475 ; macros psect to the gc psect, stomped the macros psect and then only 15476 ; copied the used entries in the keyword table back. 15477 ; 15478 ; Here, using the keyword table as a basis, we copy over each keyword 15479 ; and text that is pointed to by an entry and fix the pointers 15480 ; accordingly. Anything that doesn't get copied is orphaned data and 15481 ; is no longer necessary. Once this is done, we toss the gc psect. 15482 15483 002223'01 do. ; Enter loop 15484 002223'01 260 17 0 00 002320' call mkeycp ; Copy the keyword (macro name) 15485 002224'01 260 17 0 00 002335' call mtxtcp ; Copy the text of the macro over 15486 002225'01 271 06 0 00 000001 addi q2, ^d1 ; Step to next slot in macro table 15487 002226'01 367 05 0 00 002223' sojg q1, top. ; And do the remaining 15488 002227'01 enddo. ; End loop lexical context 15489 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 46 K20MAC MAC 1-Apr-23 22:30 Garbage collection 15490 remark Compact epilogue, displays more data 15491 15492 002227'01 201 01 0 00 000001 movx t1, .hprnt ; Request current CPU time 15493 002230'01 104 00 0 00 000501 HPTIM% ; now that we're done 15494 002231'01 320 12 0 00 002233' %jserr (,r) ; Fail and don't do anything more 15495 002232'01 254 00 0 00 002236' 15496 002233'01 265 01 0 00 002171* 15497 002234'01 000000 000000 15498 002235'01 254 00 0 00 002173* 15499 002236'01 315 01 0 00 000010 camge t1, q4 ; Did it wrap around 15500 002237'01 250 01 0 00 000010 exch t1, q4 ; It did, fix that 15501 002240'01 276 01 0 00 000010 subm t1, q4 ; Get and store the difference in HP ticks 15502 15503 002241'01 260 17 0 00 000000* call endtim ; Take a snapshot from right now 15504 002242'01 260 17 0 00 000000* call elptim ; Calculates elapsed time 15505 15506 002243'01 200 01 0 00 000000# txmsg ; Give interesting post blat 15507 002244'01 104 00 0 00 000076 15508 002245'01 320 12 0 00 002246' 15509 000104'02 000000000000# 15510 001233'04 101 146 164 145 162 15511 002246'01 260 17 0 00 002067' call $msumm ; Display macro table usage 15512 15513 002247'01 201 02 0 00 000000* movei t2, ewallt ; Load pointer to elapsed wall time 15514 002250'01 120 03 0 02 000017 dmove t3, .datus(t2) ; Load elapsed HPTIM% double word 15515 002251'01 434 03 0 00 000004 or t3, t4 ; Will print if either high or low order 15516 002252'01 322 03 0 00 002263' ifn. t3 ; Did this take any time, actually? 15517 002253'01 200 07 0 00 000003 move q3, t3 ; It did, so save as a talisman 15518 002254'01 200 01 0 00 000000# txmsg ; Seperate from characters cleared 15519 002255'01 104 00 0 00 000076 15520 002256'01 320 12 0 00 002257' 15521 000105'02 000000000000# 15522 001235'04 105 154 141 160 163 15523 002257'01 201 01 0 00 000101 movei t1, .priou ; Going to terminal 15524 002260'01 260 17 0 00 000000* call durtim ; Nicely print the duration 15525 002261'01 600 00 0 00 000000 nop ; Ignore any goofy return 15526 002262'01 254 00 0 00 002264' else. ; Else did nothing 15527 002263'01 400 07 0 00 000000 setz q3, ; So flag this 15528 002264'01 endif. ; End case positive elapsed time 15529 15530 ; Note a small hack for ehptim: it now takes a pointer to a signed 15531 ; double word instead a signed single word. It happens that we have 15532 ; the value in q4, that q3 is free, that there will never be any high 15533 ; order and that ehptim does not modify either one. Thus, we pass 15534 ; it a pointer to that double word accumulator pair and everything 15535 ; works fine. For the moment... Until something changes... 15536 15537 002264'01 323 10 0 00 002305' ifg. q4 ; Any CPU time taken? 15538 002265'01 322 07 0 00 002271' ifn. q3 ; Displayed any elapsed time? 15539 002266'01 200 01 0 00 000000# txmsg <, > ; Yes, space over 15540 002267'01 104 00 0 00 000076 15541 002270'01 320 12 0 00 002271' 15542 000106'02 000000000000# 15543 001237'04 054 040 000 000 000 15544 002271'01 endif. k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 46-1 K20MAC MAC 1-Apr-23 22:30 Garbage collection 15545 002271'01 200 01 0 00 000000# txmsg ; Introduce processor blat 15546 002272'01 104 00 0 00 000076 15547 002273'01 320 12 0 00 002274' 15548 000107'02 000000000000# 15549 001240'04 103 120 125 072 040 15550 002274'01 201 01 0 00 000101 movei t1, .priou ; Going to terminal 15551 002275'01 201 02 0 00 000000# movei t2, mecpu ; Load pointer to macro elapsed CPU 15552 remark .datet ;[221] Don't touch!! This should ALWAYS be zero 15553 002276'01 400 07 0 00 000000 setz q3, ;[221] Clear double word of HP ticks (q3 untouched) 15554 002277'01 124 07 0 02 000017 dmovem q3, .datus(t2) ;[221] Store elapsed DK10 15555 002300'01 201 10 0 02 000017 movei q4, .datus(t2) ;[221] Now point to it 15556 002301'01 250 02 0 00 000010 exch t2, q4 ;[221] Pass in pointer to DK10 ticks, actually 15557 002302'01 400 03 0 00 000000 setz t3, ;[221] Don't suppress leading seconds 15558 002303'01 260 17 0 00 000000* call ehptim ; Display elapsed HP ticks 15559 002304'01 600 00 0 00 000000 nop ;[221] Ignore non-fatal +1 15560 002305'01 endif. ; End CPU display 15561 15562 002305'01 561 01 0 00 002140* hrroi t1, crlf ; Tie off the line 15563 002306'01 104 00 0 00 000076 PSOUT% 15564 15565 remark ; Now that we're done, don't need the gc psect 15566 002307'01 474 01 0 00 000000 seto t1, ; Case IV, deleting process memory 15567 dmove t2, [ .fhslf,,gcpag ; This process, page number of gc psect 15568 002310'01 120 02 0 00 002560' pm%cnt!fld(gcpgs,pm%rpt) ] ; Number of pages to toss 15569 002311'01 104 00 0 00 000056 PMAP% ; Trim our working set 15570 002312'01 320 12 0 00 002314' %jserr (,) ; Odd... but continue 15571 002313'01 254 00 0 00 002317' 15572 002314'01 265 01 0 00 002233* 15573 002315'01 000000000000# 15574 002316'01 254 00 0 00 002317' 15575 001242'04 120 157 163 164 040 15576 15577 002317'01 263 17 0 00 000000 ret ; Don't forget to finally return 15578 15579 chgsec(code,data) ;;Some temporary storage 15580 000000'05 mecpu: XList ; Save a few trees 15581 List ; Turn the listing back on 15582 15583 retsec ;;Restore .PSECT assumptions 15584 15585 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 47 K20MAC MAC 1-Apr-23 22:30 String copy measurement, 9:10pm Thursday, 21 July 1920 15586 subttl String copy measurement, 9:10pm Thursday, 21 July 1920 15587 15588 ; A question had sometimes come up for debate as to whether the string 15589 ; instructions gave any real speed up, the concern being whether the 15590 ; set up cost of conditioning the register file and restoring it was 15591 ; worth using them. 15592 ; 15593 ; Three cases were set up, the first being a typical ildb/idpb loop 15594 ; with the second being a use of movst to move the string until a nul 15595 ; was detected. The third was a mixture; the keywords being moved 15596 ; with a loop and the macro expansions being moved with the movst. 15597 ; This was expected to be have the best performance as macro names 15598 ; (I.E., keywords) are typically not very long. 15599 ; 15600 ; 11 macros were defined, using a total of 80 characters of macro name 15601 ; space and 1365 characters of macro text space. The results are 15602 ; suprising: 15603 ; 15604 ; Case Elapsed CPU All 15605 ; 1 1.360 1.320 times 15606 ; *2 .340 .320 are in 15607 ; 3 1.020 .980 milliseconds 15608 ; 15609 ; By a considerable margin, using solely the movst won. This is why 15610 ; it is used exclusively, below. Going forward, other cases may be 15611 ; identified in Kermit where it can be used. 15612 15613 extern asczcp ; Extended instruction to move ASCIZ 15614 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 48 K20MAC MAC 1-Apr-23 22:30 Routine to copy keyword (macro name) data 15615 subttl Routine to copy keyword (macro name) data 15616 15617 ; Expects: 15618 ; 15619 ; q2/ Address of current keyword entry 15620 ; q3/ Word offset between tables 15621 ; 15622 ; Returns: 15623 ; 15624 ; +1, always 15625 15626 002320'01 mkeycp: remark ; Copy the keyword (macro name) 15627 002320'01 554 01 0 06 000000 hlrz t1, (q2) ; Pick up keyword address 15628 002321'01 270 01 0 00 000007 add t1, q3 ; add in offset 15629 002322'01 505 01 0 00 440700 hrli t1, (point 7,0) ; Now have a source pointer 15630 002323'01 200 02 0 00 000000# move t2, macbp ; Point to our (scrubbed) macro table 15631 002324'01 506 02 0 06 000000 hrlm t2, (q2) ; Stomp in as the new keyword address 15632 002325'01 260 17 0 00 000443* call asczcp ; Copy the ASCIZ string 15633 002326'01 554 04 0 00 000002 hlrz t4, t2 ; Load the destination pointer portion 15634 002327'01 306 04 0 00 440700 cain t4, 440700 ; On a word boundary? (1 in 5 chance) 15635 002330'01 254 00 0 00 002333' ifskp. ; Nope, fix 15636 002331'01 271 02 0 00 000001 addi t2, ^d1 ; Round up a word 15637 002332'01 505 02 0 00 440700 hrli t2, 440700 ; Stomp in the right magic 15638 002333'01 endif. ; Ready for any future usage 15639 002333'01 202 02 0 00 000000# movem t2, macbp ; Point to our (scrubbed) macro table 15640 002334'01 263 17 0 00 000000 ret ; All is well, return 15641 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 49 K20MAC MAC 1-Apr-23 22:30 Routine to copy macro text (macro expansion) data 15642 subttl Routine to copy macro text (macro expansion) data 15643 15644 ; Expects: 15645 ; 15646 ; q2/ Address of current keyword entry 15647 ; q3/ Word offset between tables 15648 ; 15649 ; Returns: 15650 ; 15651 ; +1, Always 15652 15653 extern asczcp ; Extended instruction to move ASCIZ 15654 15655 002335'01 mtxtcp: remark ; Copy the text of the macro over 15656 002335'01 550 01 0 06 000000 hrrz t1, (q2) ; Pick up expansion address 15657 002336'01 270 01 0 00 000007 add t1, q3 ; add in offset 15658 002337'01 505 01 0 00 440700 hrli t1, (point 7,0) ; Now have a source pointer 15659 002340'01 200 02 0 00 000000# move t2, macbp ; Point to our (scrubbed) macro text table 15660 002341'01 542 02 0 06 000000 hrrm t2, (q2) ; Stomp in as the new text address 15661 002342'01 260 17 0 00 002325* call asczcp ; Maybe will even save some cpu time 15662 002343'01 554 04 0 00 000002 hlrz t4, t2 ; Load the destination pointer portion 15663 002344'01 306 04 0 00 440700 cain t4, 440700 ; On a word boundary? (1 in 5 chance) 15664 002345'01 254 00 0 00 002350' ifskp. ; Nope, fix 15665 002346'01 271 02 0 00 000001 addi t2, ^d1 ; Round up a word 15666 002347'01 505 02 0 00 440700 hrli t2, 440700 ; Stomp in the right magic 15667 002350'01 endif. ; Ready for any future usage 15668 002350'01 202 02 0 00 000000# movem t2, macbp ; And update global storage 15669 002351'01 263 17 0 00 000000 ret ; All is well, return 15670 15671 .endps code 15672 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 50 K20MAC MAC 1-Apr-23 22:30 Additional writable storage areas 15673 subttl Additional writable storage areas 15674 15675 .psect data 15676 000021'05 000000 000000 onamp: 0 ;[77] Previous NAMP. 15677 000022'05 000000 000000 tbent: 0 ; TBLUK% entry of existing keyword 15678 000023'05 000000 000000 sintn: 0 ; Number of signal I/O traps we've seen 15679 15680 extern namlen,namatm,explen,expatm 15681 15682 remark definf,undeff ; Must be whacked on every parse 15683 000024'05 000000 000000 definf:: 0 ;[77] DEFINE flag nonzero if parsing DEFINE. 15684 000025'05 000000 000000 undeff:: 0 ;[77] UNDEFF flag nonzero if DEFINE x . 15685 000026'05 000000 000000 macptr:: 0 ;[77] Pointer to start of macro text in CSB. 15686 15687 .endps data 15688 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 51 K20MAC MAC 1-Apr-23 22:30 Macros storage areas 15689 subttl Macros storage areas 15690 15691 ;N.B, Do NOT put anything into this .PSECT without updating the 15692 ; calculations for maclen in k20unv!!! 15693 15694 .psect macros,macorg ; Storage for macros 15695 15696 ; The TBLUK% table, with one predefined macro for Columbia's IBM 15697 ; system. Users can remove this definition by typing "define ibm", or 15698 ; they can replace it. KERMIT-20 maintainers can remove it for their 15699 ; site by replacing the contents of MACTAB (first word) with 15700 ; 0,,MACMAX, or can change it to be anything they like. 15701 ; 15702 ; Kept for historical reasons and for any take files that depend on it. 15703 ; 15704 ; Be aware that the calculations for .psect size account for the IBM 15705 ; keyword and the cooresponding macro body. If you do change this to 15706 ; be something else, then take a look at calculations in k20unv that are 15707 ; driven off of macmax. 15708 ; 15709 ; You need only change the slop calculations that are done with adslop. 15710 ; 15711 ; mactab MUST be the first location in the .psect!! Garbage collection 15712 ; depends on this. 15713 15714 000000'06 mactab: intern mactab ;[194] 15715 000000'06 000001 000252 1,,macmax ;[77] Macro keyword TBLUK format table. 15716 000001'06 000255' 000256' ibmkey,,ibmmac ; Where is my 3276?? 15717 000002'06 block macmax-1 ;[77] Macro keyword table. 15718 000253'06 mactbx: block 1 ;[214] ; Tiny bit of slop 15719 15720 ; This pointer has to be in here so that /MAP restores them. No 15721 ; TBADD% should ever overwrite it because the maximum count (in the 15722 ; right halfword of TBLUK% table) can not be exceeded. 15723 15724 000254'06 44 07 0 00 000267' macbp: point 7, m1stf ; First free location in macro (expansion) table 15725 15726 ; Both macro names and bodies are allocated out of the same block of 15727 ; storage, which allows for more flexible management, Note that the 15728 ; macro buffer MUST be the last item in the .PSECT in order to get the 15729 ; benefit of guard page two, which follows. 15730 15731 000255'06 macbuf: remark ; Here are the macros 15732 000255'06 111 102 115 000 000 ibmkey:! asciz /IBM/ ; Macro name 15733 000256'06 160 141 162 151 164 ibmmac:! asciz/parity mark, duplex half, handshake xon 15734 / ; Yummy half duplex!! 15735 000267'06 m1stf:! .xcref m1stf ; Don't need this in the cross reference 15736 suppress m1stf ; Nor in the symbol table listing 15737 000267'06 block mnblen ; Space for the names 15738 001013'06 block mtblen ; Space for the expansions 15739 006777'06 macx: block 1 ;[77] End of macro text buffer, with padding. 15740 15741 if2 < purge m1stf > ; Not needed after second pass 15742 .endps macros 15743 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 51-1 K20MAC MAC 1-Apr-23 22:30 Macros storage areas 15744 .psect gc,gcorg ; psect for garbage collections 15745 000000'07 block maclen ; same size as for macros 15746 .endps gc 15747 15748 emacro < 15749 .psect medit,medorg ; psect for macro editing 15750 block maclen ; same size as for macros 15751 .endps medit ; Probably far too large 15752 >;;emacro 15753 k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 52 K20MAC MAC 1-Apr-23 22:30 History and Motivation 15754 subttl History and Motivation 15755 15756 ; The is all part of edit 203 15757 15758 ;PS:KERMIT.MAC.288, 27-Oct-83 18:55:44, Frank 15759 ;[77] Add DEFINE command for SET macros. Remove hardwired SET IBM. 15760 15761 ; The DEFINE command for SET macros is quite old, having been added by 15762 ; Frank da Cruz as part of edit 77 on 27-Oct-83. It predates the 15763 ; availability of extended sections and read-only .psects (perhaps 15764 ; even .psects themselves) 15765 ; 15766 ; It's fine for what it does, meaning loading up a bunch of macros 15767 ; from a KERMIT.INI file, and clearly functioned fine for years, if 15768 ; not decades. 15769 ; 15770 ; However, during the DECnet NRT work, it became increasingly 15771 ; aggressively used, which revealed some limitations: 15772 ; 15773 ; DEFINE assumed that you are always creating a macro and thus copies 15774 ; whatever is in the atom buffer into the name table. This means 15775 ; that, in addition to not freeing up any name or macro space, 15776 ; undefining a macro would actually use *more* name space. 15777 ; 15778 ; Because this copy happened during the parse and not after the 15779 ; command had been confirmed, if the user started defining a macro, 15780 ; changed his mind and typed a ^U, space in the name table would still 15781 ; be usurped for each and every reparse. 15782 ; 15783 ; Thus, during the process of either learning the DEFINE command or 15784 ; trying different parameters, the user could run out of space without 15785 ; actually having accomplished anything. There was no remedy to this 15786 ; except to exit and run a fresh copy of Kermit. 15787 ; 15788 ; The out of space check was not reliable. First, it checked to see 15789 ; if the macro name and text space was already full at the beginning 15790 ; of the parse. These checks simply looked to see if the macro name 15791 ; and table space had started to go past the marked end of tables. 15792 ; Overwrites were prevented by having a certain amount of slop for the 15793 ; definition to expand into. 15794 ; 15795 ; However, once the check was passed, Kermit did no further checking, 15796 ; meaning the user could blithly continue typing, overwriting whatever 15797 ; happened to be after the tables. This, coupled with the reparse 15798 ; phenomena previously described could produce some pretty quirky 15799 ; behavior, if not downright crashes. 15800 ; 15801 ; Another non-critical limitation was that there was was no way to 15802 ; make modifications to a macro once it was defined. Any change meant 15803 ; that you had to basically type the whole macro in again. 15804 ; 15805 ; As a practical matter, while SET macros could be read in via the 15806 ; execution of a TAKE file, there was no way to write them out. 15807 ; 15808 ; Fixing the problems above and adding the extra functionality proved k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 52-1 K20MAC MAC 1-Apr-23 22:30 History and Motivation 15809 ; so massive an addition that all the code got moved into this 15810 ; seperate module. 15811 ; 15812 ; That being said, the original logic is largely kept, the bulk of the 15813 ; code being extra functionality. k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page 53 K20MAC MAC 1-Apr-23 22:30 History and Motivation 15814 15815 subttl Random Notes 15816 15817 ; Using a quoted strings allows an easy define of a name that is 15818 ; similar to an existing name by not selecting from the keyword table. 15819 ; 15820 ; Better, it allows for consistent use of escape recognition when 15821 ; specifying the SET commands. 15822 15823 .xcmsy ;[194] Ditch MACSYM junk 15824 15825 end NO ERRORS DETECTED PROGRAM BREAK IS 000000 PSECT 1 BREAK IS 002663 FOR CODE PSECT 2 BREAK IS 000110 FOR CONST PSECT 3 BREAK IS 000040 FOR TEXT PSECT 4 BREAK IS 001252 FOR ETEXT PSECT 5 BREAK IS 000027 FOR DATA PSECT 6 BREAK IS 007000 FOR MACROS PSECT 7 BREAK IS 007000 FOR GC CPU TIME USED 00:00.893 107P CORE USED k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page S-1 K20MAC MAC 1-Apr-23 22:30 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 15:18 11-Jun-23 Page S-2 K20MAC MAC 1-Apr-23 22:30 SYMBOL TABLE FOR PSECT CODE ASCZCP 002342' ext ..0025 000044' spd ..0753 001565' spd ATMBUF 002534' ext ..0037 000051' spd ..0770 001625' spd CFMRTN 002155' ext ..0040 000053' spd ..0776 001577' spd CJFNBK 002620' ext ..0051 000070' spd ..0777 001621' spd CMDER1 001706' ext ..0057 000113' spd ..1013 001641' spd CRLF 002305' ext ..0060 000123' spd ..1026 001663' spd DMPBK 000561' ..0063 000157' spd ..1027 001673' spd DMPBKL 000010 spd ..0073 000163' spd ..1044 001706' spd DURTIM 002260' ext ..0100 000170' spd ..1046 001716' spd EHPTIM 002303' ext ..0101 000227' spd ..1062 001733' spd ELPTIM 002242' ext ..0113 000225' spd ..1074 001735' spd ENDTIM 002241' ext ..0120 000225' spd ..1075 001772' spd ERRPTR 001634' ext ..0141 000267' spd ..1116 002014' spd EWALLT 002247' ext ..0146 000266' spd ..1117 002015' spd EXPATM 002477' ext ..0170 000326' spd ..1136 002036' spd EXPLEN 000402' ext ..0206 000366' spd ..1140 002056' spd FRCLOS 002062' ext ..0213 000365' spd ..1156 002056' spd ISNULJ 001631' ext ..0220 000366' spd ..1203 002203' spd MAPBK 001074' ..0232 000442' spd ..1220 002223' spd MAPBKL 000010 spd ..0250 000502' spd ..1221 002227' spd MKEYCP 002320' ..0255 000501' spd ..1227 002263' spd MTXTCP 002335' ..0262 000502' spd ..1234 002264' spd MYTTY 001571' ext ..0332 000647' spd ..1237 002305' spd NAMATM 002441' ext ..0340 000627' spd ..1245 002271' spd NAMLEN 000502' ext ..0346 000646' spd ..1266 002333' spd NOIRTN 001466' ext ..0363 000663' spd ..1274 002350' spd PARS1 000556' ext ..0376 000705' spd ..IFT 100000 000001 spd PARS2 001716' ext ..0377 000715' spd ..JX1 100000 000000 spd R 002235' ext ..0414 000730' spd ..MX1 000001 spd RFIELD 001472' ext ..0422 000745' spd ..MX2 000001 spd SAVBK 001451' ..0436 000767' spd ..TX1 400000 000000 spd SAVBKL 000010 spd ..0450 000771' spd ..TX2 000001 spd SBK 000000 ext ..0451 001012' spd ..XX 006004 002540' spd SETTAB 000000 ext ..0456 000777' spd .DEFI5 000044' STATIM 002164' 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 002155' $DEFIN 000074' ent ..0536 001142' spd .MDMPE 000670' $DUPLI 000335' ..0544 001161' spd .MDUMP 000571' $MCHRS 002143' ent ..0561 001176' spd .MMAP 001104' $MCOMP 002157' ..0574 001220' spd .MMAPE 001203' $MDMPE 001060' ..0575 001230' spd .MRESE 001421' $MDUMP 000731' ..0612 001243' spd .MSAVE 001461' $MMAP 001244' ..0644 001344' spd .MSUMM 002065' $MMAPE 001400' ..0645 001365' spd .MSVE 001646' $MMAPI 001407' ..0652 001352' spd .RENAM 000415' $MMAPN 001404' ..0653 001353' spd .SET2 000073' ext $MRESE 001423' ..0655 001362' spd .UNDEF 000277' $MSAVE 001707' ..0675 001430' spd $MSUMM 002067' ..0676 001443' spd $MSVE 002061' ..0714 001566' spd $RENAM 000451' ..0722 001541' spd %%JSER 002314' ext ..0730 001535' spd ..0020 000020' spd ..0745 001547' spd k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page S-3 K20MAC MAC 1-Apr-23 22:30 SYMBOL TABLE FOR PSECT CONST DEFSWI 000000' TABSWI 000030' %DUPL 000004' spd k20mac - Kermit-20 DEFINE macro Implementation MACRO %53B(1254)-4 15:18 11-Jun-23 Page S-4 K20MAC MAC 1-Apr-23 22:30 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 15:18 11-Jun-23 Page S-5 K20MAC MAC 1-Apr-23 22:30 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 15:18 11-Jun-23 Page 1 K20IOC MAC 20-Jan-23 21:49 15826 Title K20IOC Kermit Input/Output statement Control 15827 15828 search monsym,macsym,cmd,k20unv ;[194] 15829 cmdacs ^ ;Clean up p1-p4 definitions 15830 15831 sall ; tidy listing, please 15832 .directive flblst ; We don't need to see all the ASCIZ bytes... 15833 15834 ;N.B., although this module is new with a large amount of rewrites, 15835 ; some attempt has been made to keep old edit numbers for cross- 15836 ; reference purposes. 15837 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 2 K20IOC MAC 20-Jan-23 21:49 External routines and storage 15838 subttl External routines and storage 15839 15840 remark common parsing external data 15841 15842 extern pars1 ; Data from first parse. 15843 extern pars2 ; Data from second parse. 15844 extern pars3 ; Data from third parse. 15845 extern pars4 ; Data from fourth parse. 15846 extern pars5 ;[41] ... 15847 extern pars6 ;[209] If $INPUT is not getting driven by .INPUT 15848 extern pars7 ;[229] If TRANSMIT is sending some kind of EOF 15849 extern pars8 ;[229] If $INPUT matching should not type anything 15850 extern buffer ; Used for foreign file names and string conversion 15851 15852 remark cmd storage used 15853 15854 extern sbk ; Command State Block (CSB) 15855 extern atmbuf ; Atom buffer 15856 extern atmbln ; Length of atom buffer (in words) 15857 15858 remark Linkages with the main and other parsers 15859 15860 extern chksec ; k20par: See if we got a silly floating point value 15861 extern definf ; k20mac: Set if we are defining a macro 15862 15863 remark Various JFN's and related control storage 15864 15865 extern netjfn ; Network JFN, if not a remote Kermit 15866 extern ttyjfn ; User's terminal JFN, if remote Kermit 15867 extern takjfn ; JFN of current TAKE file 15868 extern popjfn ; Routine to switch between takjfn's 15869 extern sesjfn ; JFN for session logging file 15870 extern sesflg ; Control flag for active usage of same 15871 extern filjfn ; Current open file 15872 extern cjfnbk ; COMND%'s GTJFN% block 15873 extern isnulj ; Determine if this JFN is on NUL: 15874 extern frclos ; Force a JFN to close (or release it) 15875 15876 remark Handshke, Parity and Duplex Handling 15877 15878 extern handsh ; Handshake character (if any) 15879 extern parity ; Points to whatever parity (routine) we're using 15880 extern duplex ; Who is doing the echoing remote host or us 15881 15882 remark User and Network terminal handling 15883 15884 extern chklin ; Check line (or NRT or PTY) status 15885 extern carier ; Line carrier (or good NRT or PTY JFN) 15886 extern doarpa ; Set up for network binary (if on a TVT) 15887 extern vtermf ; Virtual terminal flag (NRT, PTY, PIP eventually) 15888 extern ttyob ; Put local terminal in binary mode 15889 extern ttyou ; Put local terminal back in user mode 15890 extern dobits ; Set terminal line for transparent I/O 15891 extern unbits ; Undo effects of dobits 15892 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 2-1 K20IOC MAC 20-Jan-23 21:49 External routines and storage 15893 remark Various performance counters for the interested 15894 15895 extern nbict ; Network BIN% count 15896 extern nsici ; Network SIN%'s count (total issued) 15897 extern nsimx ; Network SIN% maximum length 15898 extern nsitc ; Network SIN%'s total characters read 15899 15900 extern vsoct ; Virtual Terminal SOUTR%'s Issued 15901 extern vsotc ; Virtual Terminal SOUTR% Total Characters 15902 extern vsomx ; Virtual Terminal SOUTR% Maximum length 15903 15904 remark Terminal and TIMER% interrupt handling 15905 15906 extern ccon ; Turn ^C handling on 15907 extern ccoff2 ; FORCE ^C handling off 15908 extern cmpon ; Turn ^M and ^P handling on 15909 extern cmpoff ; Turn ^M and ^P handling off 15910 extern cmseen ; ^M seen 15911 extern cmloc ; Location transfer execution to on ^M 15912 extern cpseen ; ^P seen 15913 extern cploc ; Location transfer execution to on ^P 15914 repeat 0,< 15915 extern intpc ; PC to restore on timer interrupt. 15916 extern intstk ; Stack pointer to restore on timer interrupt. 15917 extern timchb ; TIMER% interrupt chanel bit 15918 > 15919 extern timeon ;[209] Set up a TIMER% 15920 extern timdel ;[209] Delete any pending TIMER%'s 15921 15922 remark Buffer and Strings 15923 15924 extern strc ; Counter for, and... 15925 extern strptr ; pointer into the... 15926 extern strbuf ; Gigantic string buffer (1,000 words!!) 15927 extern strbf2 ; Another one 15928 15929 remark Networking Linkages and variables 15930 15931 extern clrest ;[209] Return estimate of available data 15932 extern clrbuf ;[209] Clear monitor buffers 15933 extern local ;[209] Non-zero if a local Kermit 15934 15935 remark Other random useful things 15936 15937 extern %%jser ; JSYS error handler (for %jserr macro) 15938 extern errptr ; Pointer to error text (for ermsg% macro) 15939 extern crlf ; byte (7) .chcrt, .chlfd, .chnul 15940 extern jobtab ; Result of GETJI%; used to determine batchness 15941 extern nul4 ; Negative counted pointer to "NUL:" 15942 15943 .psect code/ronly ; Pure code, pure heaven 15944 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 3 K20IOC MAC 20-Jan-23 21:49 SET INPUT command initial parsing 15945 subttl SET INPUT command initial parsing 15946 15947 000000'02 000000 000000 %table(sintab) 15948 000001'02 000000# 000000# %key3 , .sinca, incase 15949 000000'03 143 141 163 145 000 15950 000001'03 000000# 000000# 15951 000002'02 000000# 000000# %key3 , .sindt, indeft 15952 000002'03 144 145 146 141 165 15953 000006'03 000000# 000000# 15954 000003'02 000000# 000000# %key3 , .sinse, indefs ;[209] 15955 000007'03 163 145 141 162 143 15956 000012'03 000000# 000000# 15957 000004'02 000000# 000000# %key3 , .sinta, intima 15958 000013'03 164 151 155 145 157 15959 000016'03 000000# 000000# 15960 000000'02 000004 000004 %tbend 15961 15962 ; SET INPUT parsing, like SET SEND/RECEIVE -- an extra level of parsing. 15963 15964 chgsec(code,const) ;;FDB's go in const .psect 15965 000005'02 000000 000000 tinfdb: flddb. .cmkey,,sintab 15966 000006'02 000000 000000' 15967 retsec ;;Return to code .psect 15968 15969 000000'01 .setin: entry .setin ;[209] Invoked from k20par 15970 000000'01 201 01 0 00 000000# movei t1, tinfdb ;[209] 15971 000001'01 260 17 0 00 000000* call rfield ; Parse a keyword. 15972 000002'01 550 02 0 02 000000 hrrz t2, (t2) ; Get the command routine addresses. 15973 000003'01 202 02 0 00 000000* movem t2, pars3 ; Save into pars3. 15974 000004'01 554 01 0 02 000000 hlrz t1, (t2) ; Get the next level routine. 15975 000005'01 260 17 0 01 000000 call (t1) ; Call it. 15976 000006'01 263 17 0 00 000000 ret 15977 15978 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 4 K20IOC MAC 20-Jan-23 21:49 SET INPUT CASE parsing 15979 subttl SET INPUT CASE parsing 15980 15981 000007'02 000000 000000 %table(castab) ; Case table. 15982 000010'02 000000# 000000 %key2 , 0 15983 000017'03 151 147 156 157 162 15984 000011'02 000000# 000001 %key2 , 1 15985 000021'03 157 142 163 145 162 15986 000012'02 000000# 000001 %keyf3 , 1, cm%inv ;[212] Tom gets sleepy... 15987 000023'03 002000 000001 15988 000024'03 162 145 163 160 145 15989 000007'02 000003 000003 %tbend 15990 15991 chgsec(code,const) ;;FDB's go in const .psect 15992 000013'02 000000 000015' incfdb: flddb. .cmkey,,castab,,,incfd1 15993 000014'02 000000 000007' 15994 000015'02 010004 000000 incfd1: flddb. .cmcfm,,, 15995 000016'02 000000 000000 15996 000017'02 44 07 0 00 003535' 15997 retsec ;;Get back into code .psect 15998 cleans() ;;Clean out temporary symbols 15999 16000 000007'01 265 16 0 00 003663' .sinca: saveac ;[209] Need to remember function code 16001 000010'01 200 16 0 00 000000# guide ; SET INPUT CASE 16002 000011'01 260 17 0 00 000000* 16003 000020'02 000000000000# 16004 000000'04 146 157 162 040 155 16005 000012'01 201 01 0 00 000000# movei t1, incfdb 16006 000013'01 260 17 0 00 000001* call rfield ;[209] Parse a keyword or default 16007 16008 000014'01 135 05 0 00 003671' ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ;[209] Pick up function code 16009 000015'01 302 05 0 00 000010 caie q1, .cmcfm ;[209] Want's default? 16010 000016'01 254 00 0 00 000021' ifskp. ;[209] That's easy, give him the default 16011 000017'01 400 02 0 00 000000 setz t2, ;[209] This is the parse value for "ignore" 16012 000020'01 254 00 0 00 000022' else. ;[209] Otherwise, handle the keyword 16013 000021'01 550 02 0 02 000000 hrrz t2, (t2) ; Get the value for the keyword (0 or 1). 16014 000022'01 endif. ;[209] 16015 000022'01 202 02 0 00 000000* movem t2, pars4 ; Save into pars4. 16016 16017 000023'01 306 05 0 00 000010 cain q1, .cmcfm ;[209] Was default requested? 16018 000024'01 263 17 0 00 000000 ret ;[209] It was, so don't reconfirm a confirmation 16019 000025'01 336 00 0 00 000000* skipn definf ; In DEFINE? 16020 000026'01 260 17 0 00 000000* confrm ; No, get confirmation. 16021 000027'01 263 17 0 00 000000 ret 16022 16023 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 5 K20IOC MAC 20-Jan-23 21:49 SET INPUT DEFAULT-TIMEOUT parsing 16024 subttl SET INPUT DEFAULT-TIMEOUT parsing 16025 16026 ; N.B., When chksec succeeds, it succeeds completely, putting the 16027 ; calculated millisecond value in pars4 and the floating point 16028 ; seconds in pars5. Both are displayed by SHOW INPUT because the 16029 ; floating point is easier to read, the milliseconds perhaps being 16030 ; of interest to debuggers, mathematicians and the curious. 16031 16032 chgsec(code,const) ;;Chained FDB's go in const .psect 16033 000021'02 015004 000024' indfdb: flddb. .cmflt,,,,,indfd1 16034 000022'02 000000 000000 16035 000023'02 44 07 0 00 003544' 16036 000024'02 010004 000000 indfd1: flddb. .cmcfm,,,,, 16037 000025'02 000000 000000 16038 000026'02 44 07 0 00 003553' 16039 retsec ;;Get back into code .psect 16040 cleans() ;;Keep listing tidy 16041 16042 000030'01 265 16 0 00 003663' .sindt: saveac ;[209] Need to remember function code 16043 000031'01 200 16 0 00 000000# guide 16044 000032'01 260 17 0 00 000011* 16045 000027'02 000000000000# 16046 000003'04 146 157 162 040 111 16047 000033'01 201 01 0 00 000000# movei t1, indfdb ; Various alteratives 16048 000034'01 260 17 0 00 000013* call rfield ; Try to get one of them 16049 16050 000035'01 135 05 0 00 003671' ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ;[209] Pick up function code 16051 000036'01 302 05 0 00 000010 caie q1, .cmcfm ;[209] Want's default? 16052 000037'01 254 00 0 00 000042' ifskp. ;[209] That's easy, give him the default 16053 000040'01 205 02 0 00 204500 movx t2, <10.> ;[209] Ten seconds in floating point 16054 000041'01 254 00 0 00 000046' else. ;[209] Otherwise, better sanity check it 16055 000042'01 325 02 0 00 000046' ifl. t2 ;[209] Is the number deeply silly?? 16056 000043'01 200 01 0 00 000000# emsg ;[209] 16057 000044'01 104 00 0 00 000313 16058 000030'02 000000000000# 16059 000007'04 101 040 156 145 147 16060 000045'01 254 00 0 00 000000* jrst cmder1 ;[209] However, allow reparse 16061 000046'01 endif. ;[209] End non-default initial check 16062 000046'01 endif. ;[209] Either way, t2 has a floating point value 16063 16064 remark ;[212] When chksec works, it works completely 16065 000046'01 260 17 0 00 000000* call chksec ;[196] Ensure number is in correct range 16066 000047'01 254 00 0 00 000056' ifskp. ;[196] Check and convert OK? 16067 000050'01 306 05 0 00 000010 cain q1, .cmcfm ;[209] It did. Was default requested? 16068 000051'01 263 17 0 00 000000 ret ;[209] It was, so don't reconfirm a confirmation 16069 000052'01 336 00 0 00 000025* skipn definf ; In DEFINE? 16070 000053'01 260 17 0 00 000026* confrm ; No, get confirmation. 16071 000054'01 263 17 0 00 000000 ret ;[212] Either way, we're done 16072 000055'01 254 00 0 00 000061' else. ;[196] Otherwise, couldn't swallow something 16073 000056'01 200 01 0 00 000000# emsg ;[196] 16074 000057'01 104 00 0 00 000313 16075 000031'02 000000000000# 16076 000020'04 111 156 160 165 164 16077 000060'01 254 00 0 00 000045* jrst cmder1 ;[196] Allow reparse 16078 000061'01 endif. ;[196] End case checking and conversion K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 5-1 K20IOC MAC 20-Jan-23 21:49 SET INPUT DEFAULT-TIMEOUT parsing 16079 16080 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 6 K20IOC MAC 20-Jan-23 21:49 SET INPUT SEARCH-DEFAULT parsing 16081 subttl SET INPUT SEARCH-DEFAULT parsing 16082 16083 ;[209] Begin code insertion 16084 16085 ; Calls the string parsing portion (.INPU1) to get the string and 16086 ; build the appropriate storage. Then hijacks the rest of the parse 16087 ; to get our semantic action routine called instead of having a value 16088 ; be set. 16089 ; 16090 ; Because of the design of the main parser to allow macro definitions 16091 ; and to be compliant with that paradigm, this involves an extra level 16092 ; of indirection, as seen below 16093 16094 000061'01 000000 000067' $sinsi: $sinse ; Indirect call 16095 16096 000062'01 260 17 0 00 000211' .sinse: call .inpu1 ; Parse just as if it were typed to INPUT 16097 000063'01 510 01 1 00 000000* hllz t1, @pars2 ; Load invoking keyword (SET INPUT) 16098 000064'01 541 01 0 00 000061' hrri t1, $sinsi ; Load indirected address of our semantic action 16099 000065'01 202 01 0 00 000063* movem t1, pars2 ; and take over the rest of the parse 16100 000066'01 263 17 0 00 000000 ret ; Return below 16101 16102 000067'01 265 16 0 00 003672' $sinse: saveac ; Needs some registers 16103 000070'01 333 05 0 00 000000* skiple q1, strc ; Did it get any characters? 16104 000071'01 254 00 0 00 000074' ifskp. ; No, so go with old reliable 16105 000072'01 402 00 0 00 000000# setzm indefw ; Flag no default (nothing for xblt.) 16106 000073'01 263 17 0 00 000000 ret ; Done 16107 000074'01 endif. 16108 16109 000074'01 200 02 0 00 000005 move t2, q1 ; Load character count 16110 000075'01 400 01 0 00 000000 setz t1, ; Cast positive word to signed long 16111 000076'01 235 01 0 00 000005 divi t1, ^d5 ; Convert to word count, five characters per word 16112 000077'01 322 02 0 00 000102' ifn. t2 ; Any remainder? 16113 000100'01 350 06 0 00 000001 aos q2, t1 ; Round up a word and store 16114 000101'01 254 00 0 00 000103' else. ; Otherwise, it fit exactly 16115 000102'01 200 06 0 00 000001 move q2, t1 ; So no need to round 16116 000103'01 endif. 16117 16118 remark t1, ; Still has word count 16119 000103'01 550 02 0 00 000000* hrrz t2, strptr ; Load whatever address the string pointer points to 16120 000104'01 201 03 0 00 000000# movei t3, indefs ; And storing it in our defaulting buffer 16121 000105'01 123 01 0 00 003702' xblt. t1 ; Tuck away for when needed 16122 16123 000106'01 124 05 0 00 000000# dmovem q1, indefc ; Store character and word count 16124 000107'01 263 17 0 00 000000 ret ; Finally done 16125 16126 ;[209] End code insertion 16127 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 7 K20IOC MAC 20-Jan-23 21:49 SET INPUT TIMEOUT-ACTION parsing 16128 subttl SET INPUT TIMEOUT-ACTION parsing 16129 16130 000032'02 000000 000000 %table(itatab) ; INPUT timeout action table 16131 000033'02 000000# 000000 %keyf3 , 0, cm%inv ;[186] Tom gets sleepy... 16132 000026'03 002000 000001 16133 000027'03 143 157 156 164 151 16134 000034'02 000000# 000000 %key2 , 0 16135 000031'03 160 162 157 143 145 16136 000035'02 000000# 000001 %key2 , 1 16137 000033'03 161 165 151 164 000 16138 000036'02 000000# 000001 %keyf3 , 1, cm%inv ;[186] Tom gets sleepy... 16139 000034'03 002000 000001 16140 000035'03 163 164 157 160 000 16141 000032'02 000004 000004 %tbend 16142 16143 chgsec(code,const) ;;FDB's go in const psect 16144 000037'02 000000 000041' intfdb: flddb. .cmkey,,itatab,,,intfd1 16145 000040'02 000000 000032' 16146 000041'02 010004 000000 intfd1: flddb. .cmcfm,,,,, 16147 000042'02 000000 000000 16148 000043'02 44 07 0 00 003563' 16149 retsec 16150 cleans() 16151 16152 000110'01 265 16 0 00 003663' .sinta: saveac ;[209] Need to remember function code 16153 000111'01 200 16 0 00 000000# guide 16154 000112'01 260 17 0 00 000032* 16155 000044'02 000000000000# 16156 000027'04 146 157 162 040 143 16157 000113'01 201 01 0 00 000000# movei t1, intfdb ;[209] Load parse fdb address 16158 000114'01 260 17 0 00 000034* call rfield ;[209] And see what he wants 16159 16160 000115'01 135 05 0 00 003671' ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ;[209] Pick up function code 16161 000116'01 302 05 0 00 000010 caie q1, .cmcfm ;[209] Want's default? 16162 000117'01 254 00 0 00 000122' ifskp. ;[209] That's easy, give him the default 16163 000120'01 400 02 0 00 000000 setz t2, ;[209] This is the parse value for "proceed" 16164 000121'01 254 00 0 00 000123' else. ;[209] Otherwise, handle the keyword 16165 000122'01 550 02 0 02 000000 hrrz t2, (t2) ; Get the value for the keyword (0 or 1). 16166 000123'01 endif. ;[209] Either way, have something in t2 16167 16168 000123'01 202 02 0 00 000022* movem t2, pars4 ; Save into pars4. 16169 16170 000124'01 306 05 0 00 000010 cain q1, .cmcfm ;[209] Was default requested? 16171 000125'01 263 17 0 00 000000 ret ;[209] It was, so don't reconfirm a confirmation 16172 000126'01 336 00 0 00 000052* skipn definf ; In DEFINE? 16173 000127'01 260 17 0 00 000053* confrm ; No, get confirmation. 16174 000130'01 263 17 0 00 000000 ret 16175 16176 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 8 K20IOC MAC 20-Jan-23 21:49 INPUT command parsing 16177 subttl INPUT command parsing 16178 16179 ; The previous approach relied on defaulting a value to skip a field 16180 ; which limited the operation of question mark and escape recognition. 16181 ; The parsing logic now offers to directly go to textual input so that 16182 ; this option shows up in the question mark menu. 16183 ; 16184 ; It makes either learning the command or being reminded about it a 16185 ; more pleasing if not easier experience. It also cuts COMND% 16186 ; overhead down by a JSYS, which is probably not detectable in all but 16187 ; the most extreme of circumstances. 16188 ; 16189 ; This all works because we don't need to default the parse to know 16190 ; what the default values are. 16191 ; 16192 ; INPUT and OUTPUT were all revisited because making Kermit Batch 16193 ; compliant forced far greater usage for testing purposes. 16194 16195 remark Switch values for INPUT and TRANSMIT 16196 16197 000000 %eofsw==0 ;[229] We parsed the EOF switch 16198 000001 %silsw==1 ;[229] We parsed the 'silent' switch 16199 000002 %timsw==2 ;[229] We parsed the 'timeout' switch 16200 16201 ;[229] %table puts stuff in the correct .psect 16202 16203 000045'02 000000 000000 %table (inpswi) ;[229] The INPUT switch table 16204 000046'02 000000# 000001 %key2 , %silsw ;[229] Tells $input to shut up about matches 16205 000036'03 163 151 154 145 156 16206 000045'02 000001 000001 %tbend ;[229] End of table 16207 16208 chgsec(code,const) ;;Chained FDB's go in const 16209 000047'02 003000 000051' inpswf: flddb. .cmswi,,inpswi,,,inpfdb 16210 000050'02 000000 000045' 16211 000051'02 015004 000054' inpfdb: flddb. .cmflt,,^d10,,,txtfdb 16212 000052'02 000000 000012 16213 000053'02 44 07 0 00 003573' 16214 000054'02 010004 000057' txtfdb: flddb. .cmcfm,,,,,txtfd1 16215 000055'02 000000 000000 16216 000056'02 44 07 0 00 003603' 16217 000057'02 021004 000062' txtfd1: flddb. .cmqst,,,,,txtfd2 16218 000060'02 000000 000000 16219 000061'02 44 07 0 00 003611' 16220 000062'02 017004 000000 txtfd2: flddb. .cmtxt,,,,, 16221 000063'02 000000 000000 16222 000064'02 44 07 0 00 003621' 16223 retsec ;;Return to code .psect 16224 cleans() ;;Clean up the symbol table 16225 16226 000131'01 .input: entry .input ; Invoked from K20PAR 16227 000131'01 265 16 0 00 003663' saveac ;[212] Used for control flow 16228 remark buffer ;[209] Preserve buffer across calls!!! 16229 16230 000132'01 200 16 0 00 000000# guide 16231 000133'01 260 17 0 00 000112* K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 8-1 K20IOC MAC 20-Jan-23 21:49 INPUT command parsing 16232 000065'02 000000000000# 16233 000033'04 164 151 155 145 157 16234 16235 000134'01 403 01 0 00 000002 .inpu0: setzb t1, t2 ;[209] Cons up some .chnuls 16236 000135'01 124 01 0 00 000000* dmovem t1, atmbuf ;[209] Give the atom buffer a good scrub a dub 16237 000136'01 201 01 0 00 000000# movei t1, inpswf ;[212] Pointer to full menu 16238 000137'01 260 17 0 00 000114* call rfield ;[190] Finally parse something 16239 000140'01 135 05 0 00 003671' ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ;[212] Get function code. 16240 16241 000141'01 302 05 0 00 000003 caie q1, .cmswi ;[229] Did we get a switch? 16242 000142'01 254 00 0 00 000162' ifskp. ;[229] We did, handle it 16243 000143'01 415 16 0 00 000154' block. ;[229] Enter block for better control flow 16244 000144'01 261 17 0 00 000016 16245 000145'01 550 07 0 02 000000 hrrz q3, (t2) ;[229] Pick up the switch value 16246 000146'01 302 07 0 00 000001 caie q3, %silsw ;[229] Parsed the 'silent' switch? 16247 000147'01 254 00 0 00 000152' ifskp. ;[229] We did, so that should be easy enough 16248 000150'01 476 00 0 00 000000* setom pars8 ;[229] Just flag it in the parse block 16249 000151'01 254 00 0 00 000000* retskp ;[229] Return for next switch 16250 000152'01 endif. ;[229] End 'silent' switch case 16251 000152'01 263 17 0 00 000000 ret ;[229] Otherwise, some kind of bogus switch 16252 000153'01 263 17 0 00 000000 endbk. ;[229] End Block context 16253 000154'01 254 00 0 00 000157' ifskp. ;[229] Successful switch parse 16254 000155'01 254 00 0 00 000134' jrst .inpu0 ;[229] Go see if more switches (or device or file) 16255 000156'01 254 00 0 00 000162' else. ;[229] Otherwise, some kind of error 16256 000157'01 200 01 0 00 000000# emsg ;[229] This is an internal programming error 16257 000160'01 104 00 0 00 000313 16258 000066'02 000000000000# 16259 000035'04 125 156 153 156 157 16260 000161'01 254 00 0 00 000060* jrst cmder1 ;[229] However, allow reparse 16261 000162'01 endif. ;[229] End of switch block processing 16262 000162'01 endif. ;[229] End of .cmswi case 16263 16264 000162'01 302 05 0 00 000010 caie q1, .cmcfm ;[209] Confirmation? 16265 000163'01 254 00 0 00 000167' ifskp. ;[209] Yes, let's default everything 16266 000164'01 120 01 0 00 000000# dmove t1, indeft ;[209] Load default millisecond and floating values 16267 000165'01 124 01 0 00 000123* dmovem t1, pars4 ;[209] Store them as if they were parsed 16268 000166'01 254 00 0 00 000220' jrst .inpu2 ;[209] Go handle it as if we parsed this as a string 16269 000167'01 endif. ;[209] Either way, must 'recompile' the search 16270 16271 000167'01 302 05 0 00 000015 caie q1, .cmflt ;[212] Parsed a floating number? 16272 000170'01 254 00 0 00 000206' ifskp. ;[212] Yes, check it 16273 000171'01 325 02 0 00 000176' ifl. t2 ;[212] Is the number in the right range? 16274 000172'01 200 01 0 00 000000# emsg ;[212] Yah silly!! 16275 000173'01 104 00 0 00 000313 16276 000067'02 000000000000# 16277 000042'04 101 040 156 145 147 16278 000174'01 254 00 0 00 000161* jrst cmder1 ;[212] Allow reparse 16279 000175'01 254 00 0 00 000205' else. 16280 000176'01 260 17 0 00 000046* call chksec ;[212] Ensure number is in correct range 16281 000177'01 254 00 0 00 000202' ifskp. ;[212] Check and convert OK? Then side-effect variables 16282 000200'01 254 00 0 00 000211' jrst .inpu1 ;[212] Yes, then carry on to parse a string to find 16283 000201'01 254 00 0 00 000205' else. ;[212] Otherwise, couldn't swallow something 16284 000202'01 200 01 0 00 000000# emsg ;[212] 16285 000203'01 104 00 0 00 000313 16286 000070'02 000000000000# K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 8-2 K20IOC MAC 20-Jan-23 21:49 INPUT command parsing 16287 000052'04 111 156 160 165 164 16288 000204'01 254 00 0 00 000174* jrst cmder1 ;[212] Allow reparse 16289 000205'01 endif. ;[212] End case checking and conversion 16290 000205'01 endif. ;[212] End case special messaging check 16291 remark ;[212] Falls out to parse txtfdb 16292 000205'01 254 00 0 00 000211' else. ;[212] Else never got a number 16293 000206'01 120 01 0 00 000000# dmove t1, indeft ;[212] Load default millisecond and floating values 16294 000207'01 124 01 0 00 000165* dmovem t1, pars4 ;[212] Store them as if they were parsed 16295 000210'01 254 00 0 00 000220' jrst .inpu2 ;[212] Go handle the string we parsed 16296 000211'01 endif. ;[212] End case parsed a floating nuber (or not) 16297 16298 ;[208] Originally shut off indirection, but since quoted strings allow us 16299 ; to put in an at-sign (@) as well as escape sequences, this was 16300 ; removed to allow backward compatibility with any take files which 16301 ; rely on this. 16302 16303 000211'01 200 16 0 00 000000# .inpu1: guide ;[190] Guide us to type the next thing 16304 000212'01 260 17 0 00 000133* 16305 000071'02 000000000000# 16306 000061'04 163 164 162 151 156 16307 000213'01 403 01 0 00 000002 setzb t1, t2 ;[209] Cons up some .chnuls 16308 000214'01 124 01 0 00 000135* dmovem t1, atmbuf ;[209] Give the atom buffer a good scrub a dub 16309 000215'01 201 01 0 00 000000# movei t1, txtfdb ;[209] Parse some kind of input text 16310 000216'01 260 17 0 00 000137* call rfield ;[209] Get an input string 16311 000217'01 135 05 0 00 003671' ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ;[212] Get function code again 16312 16313 000220'01 .inpu2: remark ;[209] Here if .cmcfm was only thing typed 16314 000220'01 302 05 0 00 000010 caie q1, .cmcfm ;[209] Confirmation? 16315 000221'01 254 00 0 00 000232' ifskp. ;[209] Yes, let's default the search 16316 000222'01 333 01 0 00 000000# skiple t1, indefw ;[209] But!! Do we have a default string? 16317 000223'01 254 00 0 00 000227' ifskp. ;[209] No, so use wired default 16318 000224'01 205 01 0 00 064240 movx t1, < byte (7) .chcrt, .chlfd > ;[209] Which fits in 18 bits 16319 000225'01 202 01 0 00 000214* movem t1, atmbuf ;[209] Store NUL terminated bare CR-LF sequence 16320 000226'01 254 00 0 00 000231' else. ;[209] Otherwise, have a default, so drop that in 16321 dmove t2, [ indefs ;[209] Load address of default expanded string 16322 000227'01 120 02 0 00 003703' atmbuf] ;[209] Load address of match string buffer 16323 000230'01 123 01 0 00 003702' xblt. t1 ;[209] Stomp into place 16324 000231'01 endif. ;[209] End case hardwired default 16325 000231'01 202 05 0 00 000003* movem q1, pars3 ;[209] Let any caller know what we're doing 16326 000232'01 endif. ;[209] Continue with atom buffer properly conditioned 16327 16328 000232'01 403 01 0 00 000002 setzb t1, t2 ;[209] Cons up some NUL's 16329 000233'01 124 01 0 00 000000* dmovem t1, strbuf ;[209] Get string match buffer into a known state 16330 000234'01 200 02 0 00 003705' move t2,[point 7,atmbuf] ;[209] Let's see what's in the atom buffer 16331 000235'01 134 01 0 00 000002 ildb t1, t2 ;[209] Get the first byte 16332 000236'01 322 01 0 00 000244' ifn. t1 ;[209] Only if not .CHNUL 16333 000237'01 260 17 0 00 001237' call bsrchs ;[209] Build a search string from it 16334 000240'01 254 00 0 00 000204* jrst cmder1 ;[209] Failed, allow reparse 16335 000241'01 336 00 0 00 000233* skipn strbuf ;[209] Did anything go in there?? 16336 000242'01 254 00 0 00 000244' anskp. ;[209] Nope, maybe was a "\0" or some such 16337 000243'01 254 00 0 00 000245' else. ;[209] Otherwise, some bad thing 16338 000244'01 402 00 0 00 000070* setzm strc ;[209] We surely have no characters to match 16339 000245'01 endif. ;[209] Otherwise, not searching (sigh) 16340 000245'01 402 00 0 00 000000* setzm pars6 ;[209] Say we're handling the control-C 16341 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 15:18 11-Jun-23 Page 8-3 K20IOC MAC 20-Jan-23 21:49 INPUT command parsing 16342 000247'01 254 00 0 00 000253' ifskp. ;[209] Don't reconfirm, that's confusing 16343 000250'01 332 00 0 00 000126* skipe definf ;[209] BUT!! Are we defining a macro? 16344 000251'01 254 00 0 00 000253' anskp. ;[209] We are, let .define confirm for us 16345 000252'01 260 17 0 00 000127* confrm ;[209] Tie off the line 16346 000253'01 endif. ;[209] 16347 000253'01 263 17 0 00 000000 ret 16348 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 9 K20IOC MAC 20-Jan-23 21:49 INPUT command semantic action 16349 subttl INPUT command semantic action 16350 16351 ;N.B., Note the reordering of the timing JSYi in the routine. The 16352 ; purpose is to prevent us from getting caught with some stray 16353 ; TIMER% interrupt. So we clear timers BEFORE activating the timer 16354 ; channel and disable the channel BEFORE clearing any timers. 16355 16356 000254'01 $input: entry $input ;[194] 16357 16358 000254'01 337 02 0 00 000207* skipg t2, pars4 ;[212] Integer milliseconds 16359 000255'01 254 00 0 00 000262' ifskp. ;[212] Wants time outs, so set them 16360 000256'01 332 00 0 00 000245* skipe pars6 ;[229] Did we already do this? 16361 000257'01 254 00 0 00 000262' anskp. ;[229] Yes, so don't stomp TRANSMIT 16362 000260'01 201 01 0 00 000543' movei t1, looptm ;[209] Go to loop time out exit 16363 000261'01 260 17 0 00 000000* call timeon ;[209] Set the timer for it 16364 000262'01 endif. ;[212] 16365 16366 ; Condition line, set up Control-C trap 16367 16368 000262'01 332 00 0 00 000256* $inp4a: ifme. pars6 ;[209] Are we handling the ^C? 16369 000263'01 254 00 0 00 000266' 16370 000264'01 260 17 0 00 000000* call ccon ; Turn on ^C trap. 16371 000265'01 254 00 0 00 000410' jrst $inpuy ; If ^C typed, go to this place. 16372 000266'01 endif. ;[209] End case possible ^C override 16373 000266'01 332 00 0 00 000000* ifme. vtermf ;[194] Calls only make sense for terminals 16374 000267'01 254 00 0 00 000276' 16375 000270'01 332 00 0 00 000262* skipe pars6 ;[209] Is somebody else doing this? 16376 000271'01 254 00 0 00 000277' jrst $inpu5 ;[209] Yes, so leave the terminal alone 16377 000272'01 260 17 0 00 000000* call dobits ; Condition the line for i/o. 16378 000273'01 263 17 0 00 000000 ret ; Pass along any failure. 16379 000274'01 260 17 0 00 000000* call ttyob ; Put TTY in binary mode for output only. 16380 remark ;[209] Fall through to legacy code 16381 000275'01 254 00 0 00 000277' else. ;[209] Otherwise, use enhanced network I/O 16382 000276'01 254 00 0 00 000432' callret netins ;[209] Dispatch to Network Input Matcher 16383 000277'01 endif. ;[186] Otherwise, MTOPR%'s will blow up 16384 16385 000277'01 200 04 0 00 003706' $inpu5: move t4, [point 7, strbuf] ; Point to the search string. 16386 16387 000300'01 336 00 0 00 000244* $inpu6: skipn strc ; Is there a search string? 16388 000301'01 254 00 0 00 000304' jrst $inpu7 ; No, just go forever. 16389 000302'01 134 03 0 00 000004 ildb t3, t4 ; Get a character from search string. 16390 000303'01 322 03 0 00 000411' jumpe t3, $inpux ; If no more, then success. 16391 ;... K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 10 K20IOC MAC 20-Jan-23 21:49 INPUT command semantic action 16392 16393 ;...$INPUT, cont'd 16394 16395 ; Get & echo a character, compare with current position in search string. 16396 16397 ;[204] Maybe rethink this BIN% loop, it's got a high JSYS overhead 16398 ; In other words, when should we call netins? 16399 16400 000304'01 337 01 0 00 000000* $inpu7: skipg t1, netjfn ;[186] Now get a character from the line. 16401 000305'01 200 01 0 00 000000* move t1, ttyjfn ;[186] Not network, using local 16402 000306'01 400 02 0 00 000000 setz t2, 16403 000307'01 104 00 0 00 000050 BIN 16404 000310'01 320 12 0 00 000312' ifje. r ;[186] Failed?? 16405 000311'01 254 00 0 00 000321' 16406 000312'01 302 01 0 00 600220 caie t1, IOX4 ;[186] Unexpected end of file? 16407 000313'01 334 00 0 00 000000 %ermsg (,$inpux) ;[186] Something else, so just drop dead 16408 000314'01 254 00 0 00 000320' 16409 000315'01 265 01 0 00 000000* 16410 000316'01 000000 000000 16411 000317'01 254 00 0 00 000411' 16412 000320'01 254 00 0 00 000345' jrst $inpu9 ;[186] Handle like a time out 16413 000321'01 endif. ;[186] 16414 000321'01 405 02 0 00 000177 andi t2, ^o177 ; Strip any parity. 16415 000322'01 332 00 0 00 000150* ifme. pars8 ;[229] Only if not /SILENT 16416 000323'01 254 00 0 00 000326' 16417 000324'01 200 01 0 00 000002 move t1, t2 ; Echo the character. 16418 000325'01 104 00 0 00 000074 PBOUT 16419 000326'01 endif. ;[229] 16420 16421 000326'01 337 01 0 00 000000* skipg t1, sesjfn ;[195] Session logging? 16422 000327'01 254 00 0 00 000334' ifskp. ;[195] Some kind of JFN 16423 000330'01 336 00 0 00 000000* skipn sesflg ;[195] Is logging active? 16424 000331'01 254 00 0 00 000334' anskp. ;[195] No, so don't log it 16425 000332'01 104 00 0 00 000051 BOUT ; Yes, record the character in the log. 16426 000333'01 320 12 0 00 000334' erjmpr .+1 ;[195] Catch and ignore error 16427 000334'01 endif. ;[195] 16428 16429 000334'01 332 00 0 00 000000# ifme. incase ;[194] Case-INsensitive compare? 16430 000335'01 254 00 0 00 000342' 16431 000336'01 301 02 0 00 000141 cail t2, "a" ; No, is this a lower case letter? 16432 000337'01 303 02 0 00 000172 caile t2, "z" 16433 000340'01 254 00 0 00 000342' anskp. ;[194] Not lower case 16434 000341'01 620 02 0 00 000040 txz t2, 40 ; Yes, convert to upper. 16435 000342'01 endif. ;[194] 16436 16437 000342'01 316 02 0 00 000003 camn t2, t3 ; Compare OK? 16438 000343'01 254 00 0 00 000300' jrst $inpu6 ; Yes, get next from string and comm line. 16439 000344'01 254 00 0 00 000277' jrst $inpu5 ; No, rewind search string, get next from line. 16440 16441 ; Come here upon input timeout. 16442 16443 000345'01 332 00 0 00 000000# $inpu9: ifme. intima ;[187] Proceeding? 16444 000346'01 254 00 0 00 000353' 16445 txmsg < 16446 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 15:18 11-Jun-23 Page 10-1 K20IOC MAC 20-Jan-23 21:49 INPUT command semantic action 16447 000350'01 104 00 0 00 000076 16448 000351'01 320 12 0 00 000352' 16449 000072'02 000000000000# 16450 000065'04 015 012 045 113 105 16451 000352'01 254 00 0 00 000355' else. ;[187] Otherwise an error, so not proceeding 16452 000353'01 200 01 0 00 000000# emsg ;[187] ;" 16453 000354'01 104 00 0 00 000313 16454 000073'02 000000000000# 16455 000076'04 113 105 122 115 111 16456 000355'01 endif. ;[187] Error message if quitting (for batch) 16457 16458 000355'01 561 01 0 00 000241* hrroi t1, strbuf ; Tell what string we couldn't find. 16459 000356'01 104 00 0 00 000076 PSOUT 16460 16461 000357'01 332 00 0 00 000000# ifme. intima ;[187] Proceeding? 16462 000360'01 254 00 0 00 000365' 16463 txmsg <", proceeding... 16464 000361'01 200 01 0 00 000000# > ;" ;[187] Say what we're doing, proceeding 16465 000362'01 104 00 0 00 000076 16466 000363'01 320 12 0 00 000364' 16467 000074'02 000000000000# 16468 000107'04 042 054 040 160 162 16469 16470 000364'01 254 00 0 00 000411' jrst $inpux ; Proceeding, just exit from the INPUT command. 16471 000365'01 endif. ;[187] 16472 16473 remark ;[187] Otherwise, not going any further 16474 000365'01 200 01 0 00 000000# txmsg <", quitting > ;" ;[187] ... quitting. 16475 000366'01 104 00 0 00 000076 16476 000367'01 320 12 0 00 000370' 16477 000075'02 000000000000# 16478 000113'04 042 054 040 161 165 16479 16480 000370'01 337 02 0 00 000000* skipg t2, takjfn ;[209] Quitting, are we in a file? 16481 000371'01 254 00 0 00 000406' ifskp. ;[209] We are, so blat and close it 16482 000372'01 201 01 0 00 000101 movei t1, .priou ;[209] No matter what, all output to terminal 16483 000373'01 621 02 0 00 777777 tlz t2, -1 ;[209] Shut off any GTJFN% flags 16484 000374'01 302 02 0 00 377777 caie t2, .nulio ;[209] Just testing? 16485 000375'01 254 00 0 00 000403' ifskp. ;[209] Yes, so special case that 16486 000376'01 120 02 0 00 000000* dmove t2, nul4 ;[209] Load counted special string 16487 000377'01 400 04 0 00 000000 setz t4, ;[209] Just in case 16488 000400'01 104 00 0 00 000053 SOUT% ;[209] Write the NUL: device name 16489 000401'01 320 12 0 00 000402' erjmpr .+1 ;[209] Catch and quietly ignore error 16490 000402'01 254 00 0 00 000406' else. ;[209] Otherwise, a bona fide JFN 16491 000403'01 403 03 0 00 000004 setzb t3, t4 ;[209] No flags and no prefix (whatever that is) 16492 000404'01 104 00 0 00 000030 JFNS% ;[209] Type the actual file name 16493 000405'01 320 12 0 00 000406' erjmpr .+1 ;[209] Catch and quietly ignore error 16494 000406'01 endif. ;[209] End typing some kind of file name 16495 000406'01 endif. 16496 16497 000406'01 561 01 0 00 000000* hrroi t1,crlf ;[209] Tie off the line 16498 000407'01 104 00 0 00 000076 PSOUT% 16499 16500 000410'01 260 17 0 00 000000* $inpuy: call popjfn ; Pop the TAKE file JFN from the TAKE stack. 16501 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 10-2 K20IOC MAC 20-Jan-23 21:49 INPUT command semantic action 16502 ; Exit thru here, turning off timer, restore line to previous condition. 16503 16504 000411'01 332 00 0 00 000270* $inpux: ifme. pars6 ;[209] Am I handling the ^C? 16505 000412'01 254 00 0 00 000420' 16506 000413'01 260 17 0 00 000000* call ccoff2 ; Turn off ^C trap. 16507 000414'01 332 00 0 00 000266* ifme. vtermf ;[186] Calls only make sense if not virtual 16508 000415'01 254 00 0 00 000420' 16509 000416'01 260 17 0 00 000000* call unbits ; Restore the line 16510 000417'01 260 17 0 00 000000* call ttyou ; Restore controlling tty output. 16511 000420'01 endif. ;[186] Otherwise, MTOPR%'s will break 16512 000420'01 endif. ;[209] End case possible ^C override 16513 16514 000420'01 337 00 0 00 000254* skipg pars4 ;[212] Integer millisecond sleep? 16515 000421'01 254 00 0 00 000423' ifskp. ;[212] Yes, shut off the timers, etc 16516 000422'01 260 17 0 00 000000* call timdel ;[209] Whack any future timers 16517 000423'01 endif. ;[212] End case positive intervale 16518 16519 000423'01 332 00 0 00 000411* skipe pars6 ;[209] Repeated internal call from $TRANS? 16520 000424'01 263 17 0 00 000000 ret ;[209] We're done 16521 16522 000425'01 $inpcl: remark ;[209] Have to clean up post $input 16523 000425'01 403 01 0 00 000002 setzb t1, t2 ;[209] Cons up a double word of zeros 16524 000426'01 124 01 0 00 000300* dmovem t1, strc ;[209] No string, so no length 16525 remark strptr ;[209] Not pointing anywhere 16526 000427'01 124 01 0 00 000355* dmovem t1, strbuf ;[209] Stomp a bit of the search buffer and 16527 000430'01 124 01 0 00 000000* dmovem t1, strbf2 ;[209] also a bit of the translation buffer 16528 remark buffer ;[209] Preserve buffer across calls 16529 16530 000431'01 263 17 0 00 000000 ret 16531 16532 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 11 K20IOC MAC 20-Jan-23 21:49 Network Input Searcher 16533 subttl Network Input Searcher 16534 16535 ;[209] Begin Code Addition 16536 16537 ; Expects bsrchs to have been called for a search structure 16538 ; inpcnt and inpptr to have been kept up to date from last call 16539 16540 000432'01 265 16 0 00 003707' netins: saveac 16541 16542 000433'01 120 05 0 00 000000# dmove q1, inpcnt ; Load current place in input buffer 16543 000434'01 337 07 0 00 000304* skipg q3, netjfn ; Assume network (which can be a physical line) 16544 000435'01 200 07 0 00 000305* move q3, ttyjfn ; Not network, so using login terminal 16545 000436'01 621 07 0 00 777777 tlz q3, -1 ; Either way, no flags 16546 16547 000437'01 do. ; Enter loop context 16548 000437'01 305 05 0 00 005000 caige q1, strblc ; First of all, can we swallow anything else? 16549 000440'01 254 00 0 00 000451' ifskp. ; Nope, try to drain a little off 16550 000441'01 307 05 0 00 000000 caig q1,0 ; BUT!! Nothing read? 16551 000442'01 254 00 0 00 000451' anskp. ; Then go read something 16552 000443'01 200 10 0 00 000005 move q4, q1 ; Save current length 16553 000444'01 260 17 0 00 000563' call matchs ; See if we can match anything 16554 000445'01 334 00 0 00 000000 skipa ; Didn't... 16555 000446'01 254 00 0 00 000537' exit. ; Did!!!!! 16556 000447'01 301 05 0 00 000010 cail q1, q4 ; Was this helpful in any way? 16557 000450'01 254 00 0 00 000545' jrst loopov ; No, we're wedged and can't go any futher.. 16558 000451'01 endif. 16559 000451'01 415 16 0 00 000462' block. ; Kind of clunky, but needed for control flow 16560 000452'01 261 17 0 00 000016 16561 000453'01 do. ; Enter inner loop 16562 000453'01 322 05 0 00 000000* jumpe q1, R ; If nothing read, break out 16563 000454'01 315 05 0 00 000426* camge q1, strc ; Do we have enough to match? 16564 000455'01 263 17 0 00 000000 ret ; No, then get out of loop and block context 16565 000456'01 260 17 0 00 000563' call matchs ; See if we can match anything 16566 000457'01 254 00 0 00 000453' loop. ; Nope, see if we can try again 16567 000460'01 254 00 0 00 000151* retskp ; We did, so pass that on 16568 000461'01 enddo. ; Exit loop lexical context 16569 000461'01 263 17 0 00 000000 endbk. ; Exit Block Context 16570 000462'01 254 00 0 00 000464' ifskp. ; Handle +2 from inner loop 16571 000463'01 254 00 0 00 000537' exit. ; Exit out main loop success!! 16572 000464'01 endif. 16573 000464'01 200 01 0 00 000007 move t1, q3 ; Load JFN to read from 16574 000465'01 104 00 0 00 000050 BIN% ; Wait for something from somebody 16575 000466'01 320 12 0 00 000470' %jserr (,loopio) ;[186] No, die. 16576 000467'01 254 00 0 00 000473' 16577 000470'01 265 01 0 00 000315* 16578 000471'01 000000000000# 16579 000472'01 254 00 0 00 000541' 16580 000116'04 103 157 165 154 144 16581 000473'01 350 00 0 00 000000* aos nbict ;[204] Count a network BIN% 16582 000474'01 271 05 0 00 000001 addi q1, ^d1 ; Count a character to do 16583 000475'01 136 02 0 00 000006 idpb t2, q2 ; Drop into the output buffer 16584 000476'01 260 17 0 00 000000* call clrest ; Find out how much, if anything, remains 16585 000477'01 254 00 0 00 000541' jrst loopio ; Already complained, so break loop context 16586 000500'01 201 03 0 00 005000 movei t3, strblc ; Load maximum buffer length 16587 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 15:18 11-Jun-23 Page 11-1 K20IOC MAC 20-Jan-23 21:49 Network Input Searcher 16588 000502'01 274 03 0 00 000001 sub t3, t1 ; Next, subtract how much we could use 16589 000503'01 305 03 0 00 000000 caige t3, 0 ; Not enough buffer space? 16590 000504'01 270 01 0 00 000003 add t1, t3 ; 'Subtract' off the excess (add negative) 16591 000505'01 323 01 0 00 000532' ifg. t1 ; OK, is there anything for us to read? 16592 000506'01 270 05 0 00 000001 add q1, t1 ; Accumulate in total 16593 000507'01 313 01 0 00 000000* camle t1, nsimx ; Smaller than biggest? 16594 000510'01 202 01 0 00 000507* movem t1, nsimx ; Nope, we have a new winner 16595 000511'01 272 01 0 00 000000* addm t1, nsitc ; Update Network SIN% total characters read 16596 000512'01 350 00 0 00 000000* aos nsici ; Update Network SIN%'s Issued 16597 000513'01 210 03 0 00 000001 movn t3, t1 ; Load exact amount to read 16598 000514'01 200 01 0 00 000007 move t1, q3 ; Reload the JFN 16599 000515'01 200 02 0 00 000006 move t2, q2 ; Keep reading into the buffer 16600 000516'01 104 00 0 00 000052 SIN% ; Get that data! 16601 000517'01 320 12 0 00 000521' ifje. r ; Failed?? 16602 000520'01 254 00 0 00 000531' 16603 000521'01 200 06 0 00 000002 move q2, t2 ; Update what we did read 16604 000522'01 270 05 0 00 000003 add q1, t3 ; 'Subtract' from used (t3 is negative) 16605 000523'01 272 03 0 00 000511* addm t3, nsitc ; Correct Network SIN% total characters NOT read 16606 000524'01 334 00 0 00 000000 %ermsg (,loopio) ; No, go drop dead 16607 000525'01 254 00 0 00 000531' 16608 000526'01 265 01 0 00 000470* 16609 000527'01 000000000000# 16610 000530'01 254 00 0 00 000541' 16611 000125'04 103 157 165 154 144 16612 000531'01 endif. 16613 000531'01 200 06 0 00 000002 move q2, t2 ; Keep track of where we are in the buffer 16614 000532'01 endif. ; End data read 16615 000532'01 315 05 0 00 000454* camge q1, strc ; Do we have enough to match? 16616 000533'01 254 00 0 00 000437' loop. ; No, get some more goodies 16617 000534'01 260 17 0 00 000563' call matchs ; See if we can match the search string 16618 000535'01 254 00 0 00 000437' loop. ; Didn't match 16619 000536'01 254 00 0 00 000537' exit. ; We did, so we're done 16620 000537'01 enddo. ; Exit loop context 16621 16622 000537'01 124 05 0 00 000000# dmovem q1, inpcnt ; Store updated buffer count and position 16623 000540'01 254 00 0 00 000411' jrst $inpux ; Success!!! 16624 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 12 K20IOC MAC 20-Jan-23 21:49 Various loop error handlers 16625 subttl Various loop error handlers 16626 16627 000541'01 loopio: remark ; Here for an I/O error 16628 000541'01 124 05 0 00 000000# dmovem q1, inpcnt ; Store updated buffer count and position 16629 000542'01 254 00 0 00 000410' jrst $inpuy ; Pop any take JFN's, disable ^C, timers, Etc. 16630 16631 000543'01 looptm: remark ; Here for assumed timer errors 16632 000543'01 124 05 0 00 000000# dmovem q1, inpcnt ; Store updated buffer count and position 16633 000544'01 254 00 0 00 000345' jrst $inpu9 16634 16635 16636 remark Common Buffer overflow handler 16637 16638 000545'01 loopov: remark ;[209] Here for buffer buffer full 16639 000545'01 124 05 0 00 000000# dmovem q1, inpcnt ; Store updated buffer count and position 16640 000546'01 334 01 0 00 000000# ermsg%(,$inpux) ;[209] Gronk on buffer overflow 16641 000547'01 254 00 0 00 000553' 16642 000550'01 202 01 0 00 000000* 16643 000551'01 104 00 0 00 000313 16644 000552'01 254 00 0 00 000411' 16645 000076'02 000000000000# 16646 000133'04 113 105 122 115 111 16647 16648 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 13 K20IOC MAC 20-Jan-23 21:49 Match String Overview and String Instructions 16649 subttl Match String Overview and String Instructions 16650 16651 ; The purpose of the routine below is to change the former search 16652 ; search paradigm from a byte at a time comparison to support a 16653 ; buffered approach while also benefiting from the use of string 16654 ; instructions. 16655 ; 16656 ; It is not the overhead of a ildb/idpb loop that is being saved so 16657 ; much as the JSYS overhead. For every character, both a BIN% and a 16658 ; BOUT% were needed, which involves the maximum context switching 16659 ; overhead with all that implies. 16660 ; 16661 ; Here, the maximum JSYi that will be executed for any read and print 16662 ; will be 4 of them: BIN%, SIBE%, SIN% and SOUT% (both counted for 16663 ; speed). This means that if you read more than two characters, you 16664 ; are going to win. 16665 ; 16666 ; This code is driven by the main loop in netins, which reads as much 16667 ; input as it can get until the threshold of the length of the search 16668 ; string is hit. At that point, this routine is invoked to see if 16669 ; there is a match. 16670 ; 16671 ; Simply put, the code uses a MOVST to trigger on the first character 16672 ; of the string. If the character is never hit, then the search 16673 ; criteria are not met and we return +1. In this case, we have 16674 ; effectedly searched through the entire contents of the buffer and 16675 ; need merely print and reset it via the ntriger exit. If the 16676 ; character is hit, then a CMPSE instruction is used to determine if 16677 ; the rest of the string matches. 16678 ; 16679 ; Whatever does not match is printed and removed from the network 16680 ; buffer. This operation is known here as a 'pull up' and is done 16681 ; with a MOVSLJ. 16682 ; 16683 ; Some of the extra code here is to handle caseless compares. Because 16684 ; the string compare instructions are case sensitive, we have to 16685 ; uppercase everythingt we compare first. 16686 ; 16687 ; However, the bulk of the code is to handle buffer management and, in 16688 ; particular, all the edge cases: single character search strings, a 16689 ; single character the buffer, matching on the last character, but 16690 ; still having remaining characters to compare, Etc. 16691 16692 remark ; Various Extended Instructions 16693 16694 000553'01 015 00 0 00 000000# m1stch: movst 0, sertab ; Use constructed trigger table 16695 000554'01 000000 000000 .chnul ; No fill, acually 16696 16697 000555'01 016 00 0 00 000000 movsup: movslj 0,0 ; Move string left justified (fastest) 16698 000556'01 000000 000000 .chnul ; Fill character (never used in this case) 16699 16700 000557'01 cmprmn: intern cmprmn ; Also used in k20tim to double check parity 16701 000557'01 002 00 0 00 000000 cmpse 0,0 ; Compare and skip if equal 16702 000560'01 000000 000000 .chnul ; Fill character 1 16703 000561'01 000000 000000 .chnul ; Fill character 2 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 13-1 K20IOC MAC 20-Jan-23 21:49 Match String Overview and String Instructions 16704 16705 000562'01 44 07 0 00 000430* str2bp: point 7, strbf2 ; Handy place to dump translated data 16706 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 14 K20IOC MAC 20-Jan-23 21:49 Match String Routine 16707 subttl Match String Routine 16708 16709 ; Entry 16710 ; 16711 ; q1/ Count of characters in network buffer 16712 ; q2/ Pointer into network buffer 16713 ; 16714 ; Exit: 16715 ; 16716 ; +1/ Didn't find the search string 16717 ; +2/ Successfully found the first instance of it (there may be others) 16718 ; 16719 ; In both cases, return with: 16720 ; 16721 ; q1/ Updated count of characters in network buffer 16722 ; q2/ Updated pointer to the end network buffer 16723 ; 16724 ; These are are either directly returned by matchs or indirectly by 16725 ; ntrigr. 16726 ; 16727 ; Note, we always have to back the source pointer up before the match 16728 ; character so that we can match the entire string. If we've skipped 16729 ; the match character and just compare the suffix string (like we used 16730 ; to do...) and it is the last thing in the buffer, then we will do 16731 ; the wrong thing after we come back from refilling the buffer (like 16732 ; we did in an earlier version...) 16733 ; 16734 ; To do: Possibly some of the exit code is really replicated. Maybe 16735 ; see what could be reasonably combined. On the other hand, it 16736 ; finally works... 16737 ; 16738 ; If doing an exact match, could bum the second MOVST which is just 16739 ; then a MOVSLJ. Would need to fix up the linkages. And it 16740 ; finally works... 16741 16742 000563'01 327 05 0 00 000572' matchs: ifle. q1 ; First of all, is there anything to do? 16743 000564'01 334 01 0 00 000000# ermsg% (,r) ; Program logic error 16744 000565'01 254 00 0 00 000571' 16745 000566'01 202 01 0 00 000550* 16746 000567'01 104 00 0 00 000313 16747 000570'01 254 00 0 00 000453* 16748 000077'02 000000000000# 16749 000142'04 113 105 122 115 111 16750 16751 000571'01 254 00 0 00 000600' else. ; Otherwise, do we have enough to chew on? 16752 000572'01 315 05 0 00 000532* camge q1, strc ; Enough to match our search string? 16753 000573'01 334 01 0 00 000000# ermsg% (,r) ; Another bogon 16754 000574'01 254 00 0 00 000600' 16755 000575'01 202 01 0 00 000566* 16756 000576'01 104 00 0 00 000313 16757 000577'01 254 00 0 00 000570* 16758 000100'02 000000000000# 16759 000155'04 113 105 122 115 111 16760 16761 000600'01 endif. ; OK, so let's try to do something useful K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 14-1 K20IOC MAC 20-Jan-23 21:49 Match String Routine 16762 16763 000600'01 265 16 0 00 003721' saveac 16764 000601'01 120 07 0 00 000005 dmove q3, q1 ; Save current network buffer length and position 16765 16766 000602'01 210 02 0 00 000007 movn t2, q3 ; Load negative count of buffer contents 16767 000603'01 133 02 0 00 000010 adjbp t2, q4 ; Back source up to beginning of network data 16768 000604'01 200 11 0 00 000002 move q5, t2 ; Save beginning of network data for later 16769 000605'01 332 00 0 00 000572* ifme. strc ; But!! Anything to search for?? 16770 000606'01 254 00 0 00 000612' 16771 000607'01 400 01 0 00 000000 setz t1, ; Fine, say we looked through all of it 16772 000610'01 260 17 0 00 001027' call ntrigr ; Go ditch all of it 16773 000611'01 254 00 0 00 000460* retskp ; Return success; matching everying ... 16774 000612'01 endif. 16775 16776 000612'01 200 01 0 00 000007 move t1, q3 ; Length we'll look at; total contents 16777 000613'01 200 04 0 00 000001 move t4, t1 ; Force equal lengths so no filling occurs 16778 000614'01 200 14 0 00 000001 move p4, t1 ; Save this length for later 16779 000615'01 200 05 0 00 000562' move q1, str2bp ; Destination is the translation buffer 16780 000616'01 403 03 0 00 000006 setzb t3, q2 ; Force section local pointers 16781 000617'01 621 01 0 00 700000 txz t1, S!N!M ; No need to translate until we hit the match 16782 000620'01 123 01 0 00 000553' extend t1, m1stch ; Trigger on MOVST termination code 16783 000621'01 600 00 0 00 000000 nop ; Ignore any skip (which should never happen) 16784 000622'01 120 12 0 00 000001 dmove p2, t1 ; Save remaining characters and position 16785 000623'01 607 01 0 00 200000 txnn t1, N ; Did we find anything? 16786 000624'01 254 00 0 00 001027' callret ntrigr ; No, go blat, reset the network buffer and return 16787 16788 remark ; Hit trigger, was this the only thing we needed to find? 16789 000625'01 621 01 0 00 700000 txz t1, S!N!M ; Stomp any flags 16790 000626'01 621 12 0 00 700000 txz p2, S!N!M ; in the copy, too 16791 000627'01 200 04 0 00 000605* move t4, strc ; Load match length 16792 000630'01 302 04 0 00 000001 caie t4, ^d1 ; Search string was only one dinky character? 16793 000631'01 254 00 0 00 000665' ifskp. ; Yep, we're done 16794 000632'01 200 14 0 00 000007 move p4, q3 ; Load original length 16795 000633'01 274 14 0 00 000012 sub p4, p2 ; Compute consumed characters 16796 000634'01 332 00 0 00 000322* ifme. pars8 ;[229] Only if not /SILENT 16797 000635'01 254 00 0 00 000650' 16798 000636'01 201 01 0 00 000101 movei t1, .priou ; Typing on the terminal 16799 000637'01 200 02 0 00 000011 move t2, q5 ; Source is where we started 16800 000640'01 210 03 0 00 000014 movn t3, p4 ; How much we'll type 16801 000641'01 325 03 0 00 000650' ifl. t3 ; Don't print if we computed gubbish 16802 000642'01 104 00 0 00 000053 SOUT% ; Counted SOUT% to terminal 16803 000643'01 320 12 0 00 000645' %jserr (,) 16804 000644'01 254 00 0 00 000650' 16805 000645'01 265 01 0 00 000526* 16806 000646'01 000000000000# 16807 000647'01 254 00 0 00 000650' 16808 000172'04 120 162 151 156 164 16809 000650'01 endif. 16810 000650'01 endif. ;[229] 16811 000650'01 120 01 0 00 000012 dmove t1, p2 ; Source is where MOVST stopped 16812 000651'01 326 01 0 00 000655' ife. t1 ; Was this at the END of the buffer? 16813 000652'01 400 05 0 00 000000 setz q1, ; Yes, so just zero out the count 16814 000653'01 200 06 0 00 000011 move q2, q5 ; and reset to the beginning of the buffer 16815 000654'01 254 00 0 00 000611* retskp ; About as easy as it gets 16816 000655'01 endif. ; Otherwise, pull the string up K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 14-2 K20IOC MAC 20-Jan-23 21:49 Match String Routine 16817 000655'01 200 04 0 00 000001 move t4, t1 ; Force no filling to occur 16818 000656'01 200 05 0 00 000011 move q1, q5 ; Goes to top of buffer 16819 000657'01 403 03 0 00 000006 setzb t3, q2 ; Just in case 16820 000660'01 123 01 0 00 000555' extend t1, movsup ; Move the string up 16821 000661'01 600 00 0 00 000000 nop ; Ignore +1 (which should never happen) 16822 000662'01 200 06 0 00 000005 move q2, q1 ; Ending destination is where we can now append 16823 000663'01 200 05 0 00 000012 move q1, p2 ; And load characters remaining in buffer 16824 000664'01 254 00 0 00 000654* retskp ; Return success 16825 000665'01 endif. ; Otherwise, do the non-single character case 16826 16827 remark ; First, fix up the pointers to match the string 16828 000665'01 474 13 0 00 000000 seto p3, ; Back up before the skip character 16829 000666'01 133 13 0 00 000002 adjbp p3, t2 ; So we can match the entire string 16830 000667'01 350 12 0 00 000001 aos p2, t1 ; Account for an inconsumed character (preserves flags) 16831 remark p4, ; Still has original length from above 16832 000670'01 200 15 0 00 000562' move p5, str2bp ; Always reset the destination pointer 16833 16834 remark ; Calculate match position 16835 000671'01 200 04 0 00 000007 move t4, q3 ; Load original length 16836 000672'01 274 04 0 00 000001 sub t4, t1 ; Calculate total done 16837 16838 remark ; Handle case of match being first character 16839 000673'01 307 04 0 00 000000 caig t4,0 ; Anything to print? 16840 000674'01 254 00 0 00 000676' ifskp. ; Yes, wasn't the first character 16841 000675'01 260 17 0 00 001061' call netprn ; Print what we've seen and what will get tossed 16842 000676'01 endif. 16843 16844 remark ; What we've printed is no longer relevant, chuck it 16845 000676'01 316 07 0 00 000012 camn q3, p2 ; But!! Did we not match at the first character?? 16846 000677'01 254 00 0 00 000711' ifskp. ; We did not, so do the pull up 16847 000700'01 120 01 0 00 000012 dmove t1, p2 ; Source is the last thing we've looked at 16848 000701'01 200 04 0 00 000001 move t4, t1 ; Force no use of fill characters 16849 000702'01 200 05 0 00 000011 move q1, q5 ; Destination is top of buffer 16850 000703'01 403 03 0 00 000006 setzb t3, q2 ; Force section local pointers 16851 000704'01 123 01 0 00 000555' extend t1, movsup ; Move the string up 16852 000705'01 600 00 0 00 000000 nop ; Ignore +1 (which should never happen) 16853 000706'01 200 07 0 00 000012 move q3, p2 ; Update reduced number of characters in network buffer 16854 000707'01 200 10 0 00 000005 move q4, q1 ; New append is ending destination of MOVSLJ 16855 remark p2, ; Unchanged, same number of characters 16856 000710'01 200 13 0 00 000011 move p3, q5 ; But we can start looking at the top of the buffer 16857 000711'01 endif. ; End case of non-1st character in buffer 16858 16859 000711'01 200 01 0 00 000627* move t1, strc ; Load length of match string 16860 000712'01 317 01 0 00 000007 camg t1, q3 ; Is there enough space to do the compare? 16861 000713'01 254 00 0 00 000716' ifskp. ; Nope, so must get some more network data 16862 000714'01 120 05 0 00 000007 dmove q1, q3 ; Return updated pointers 16863 000715'01 263 17 0 00 000000 ret ; Return +1, no match 16864 000716'01 endif. 16865 16866 remark t1, ; Already has source comparsion base length 16867 000716'01 200 11 0 00 000001 move q5, t1 ; No more pull up, so q5 is free 16868 000717'01 200 02 0 00 000013 move t2, p3 ; Where to start translating from 16869 000720'01 200 04 0 00 000001 move t4, t1 ; Transferring or translating equal lengths 16870 000721'01 200 05 0 00 000015 move q1, p5 ; Where to translate to (in translation buffer) 16871 000722'01 403 03 0 00 000006 setzb t3, q2 ; Force local pointers K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 14-3 K20IOC MAC 20-Jan-23 21:49 Match String Routine 16872 16873 remark ; A small optmization 16874 000723'01 332 00 0 00 000000# ifme. incase ; Case insensitive? 16875 000724'01 254 00 0 00 000731' 16876 000725'01 661 01 0 00 400000 txo t1, S ; Immediately start translating 16877 000726'01 123 01 0 00 000000# extend t1, trnbas ; Move the remaining characters 16878 000727'01 600 00 0 00 000000 nop ; Ignore non-skip 16879 000730'01 254 00 0 00 000733' else. ; Otherwise, case sensitive 16880 000731'01 123 01 0 00 000555' extend t1, movsup ; So just copy them and do nothing further 16881 000732'01 600 00 0 00 000000 nop ; Ignore non-skip (which should never happen) 16882 000733'01 endif. 16883 16884 remark ; Set up for the string compare 16885 000733'01 200 01 0 00 000011 move t1, q5 ; Load source length 16886 000734'01 200 02 0 00 000103* move t2, strptr ; Load pointer to search string 16887 000735'01 200 04 0 00 000001 move t4, t1 ; substrings are same length 16888 000736'01 200 05 0 00 000015 move q1, p5 ; Where we wrote the (translated) network data 16889 remark t3, q2 ; These are still zero, forcing local pointers 16890 000737'01 474 00 0 00 000000 seto f, ; Let's assume a match 16891 000740'01 123 01 0 00 000557' extend t1, cmprmn ; Finally, let's compare something!! 16892 000741'01 400 00 0 00 000000 setz f, ; Not the same... 16893 16894 000742'01 326 00 0 00 000766' ife. f ; Didn't match? 16895 000743'01 200 01 0 00 000000# move t1, trgchr ; Load the original trigger character and 16896 000744'01 332 00 0 00 000634* ifme. pars8 ;[229] Not if /SILENT 16897 000745'01 254 00 0 00 000747' 16898 000746'01 104 00 0 00 000074 PBOUT% ; print only that because we're skipping it 16899 000747'01 endif. ;[229] 16900 000747'01 337 01 0 00 000326* skipg t1, sesjfn ; Session logging? 16901 000750'01 254 00 0 00 000754' ifskp. ; Yes, so let's put it in there, too 16902 000751'01 200 02 0 00 000000# move t2, trgchr ; Load the original trigger character again 16903 000752'01 104 00 0 00 000051 BOUT% ; And put it into the log 16904 000753'01 320 12 0 00 000754' erjmpr .+1 ; Catch and ignore error 16905 000754'01 endif. ; End case session logging 16906 000754'01 370 01 0 00 000012 sos t1, p2 ; Account for consumed match character 16907 000755'01 200 04 0 00 000001 move t4, t1 ; Prevent any filling 16908 000756'01 200 05 0 00 000013 move q1, p3 ; Destination is where we started translating from 16909 000757'01 201 02 0 00 000001 movei t2, ^d1 ; Source is one character after that so we 16910 000760'01 133 02 0 00 000005 adjbp t2, q1 ; Overwrite the match character 16911 remark t3, q2 ; These are still zero, forcing local pointers 16912 000761'01 123 01 0 00 000555' extend t1, movsup ; Shift them all up a byte 16913 000762'01 600 00 0 00 000000 nop ; Ignore non-skip (which should never happen) 16914 000763'01 200 06 0 00 000005 move q2, q1 ; Last destination address is where we can append 16915 000764'01 200 05 0 00 000012 move q1, p2 ; New total 16916 000765'01 263 17 0 00 000000 ret ; Return non-match, boo... 16917 000766'01 endif. 16918 ; Otherwise, matched!!! 16919 remark ; Must print the rest of the compared string 16920 000766'01 332 00 0 00 000744* ifme. pars8 ;[229] Only if not /SILENT 16921 000767'01 254 00 0 00 001001' 16922 000770'01 201 01 0 00 000101 movei t1, .priou ; User's terminal 16923 000771'01 200 02 0 00 000013 move t2, p3 ; Where the match started 16924 000772'01 210 03 0 00 000011 movn t3, q5 ; Rest of search string length 16925 000773'01 104 00 0 00 000053 SOUT% ; Counted SOUT% is faster 16926 000774'01 320 12 0 00 000776' %jserr (,) ; Odd but carry on K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 14-4 K20IOC MAC 20-Jan-23 21:49 Match String Routine 16927 000775'01 254 00 0 00 001001' 16928 000776'01 265 01 0 00 000645* 16929 000777'01 000000000000# 16930 001000'01 254 00 0 00 001001' 16931 000205'04 125 156 141 142 154 16932 001001'01 endif. ;[229] 16933 16934 001001'01 337 01 0 00 000747* skipg t1, sesjfn ; Session logging? 16935 001002'01 254 00 0 00 001007' ifskp. ; Yes, so let's put it in there, too 16936 001003'01 200 02 0 00 000013 move t2, p3 ; Where the match started 16937 001004'01 210 03 0 00 000011 movn t3, q5 ; Rest of search string length 16938 001005'01 104 00 0 00 000053 SOUT% ; Counted SOUT% is faster 16939 001006'01 320 12 0 00 001007' erjmpr .+1 ; Catch and ignore error 16940 001007'01 endif. ; End case session logging 16941 16942 remark ; Is this really correct? 16943 001007'01 274 12 0 00 000011 sub p2, q5 ; Account for characters consumed 16944 001010'01 327 12 0 00 001014' ifle. p2 ; Nothing left? 16945 001011'01 400 05 0 00 000000 setz q1, ; No characters in buffer 16946 001012'01 200 06 0 00 000013 move q2, p3 ; Start from where compared because that's gone now 16947 001013'01 254 00 0 00 000664* retskp ; Return success!!!!! 16948 001014'01 endif. 16949 16950 remark ; What we've done is no longer relevant for pull up 16951 001014'01 200 01 0 00 000012 move t1, p2 ; New length includes consumed characters 16952 001015'01 200 02 0 00 000011 move t2, q5 ; What we've consumed 16953 001016'01 133 02 0 00 000013 adjbp t2, p3 ; Source is post transfer 16954 001017'01 200 04 0 00 000001 move t4, t1 ; Same length 16955 001020'01 200 05 0 00 000013 move q1, p3 ; Destination is pretransfer 16956 001021'01 403 03 0 00 000006 setzb t3, q2 ; Force section local pointers 16957 001022'01 123 01 0 00 000555' extend t1, movsup ; Move the string up 16958 001023'01 600 00 0 00 000000 nop ; Ignore +1 (which should never happen) 16959 001024'01 200 06 0 00 000005 move q2, q1 ; Return new append position 16960 001025'01 200 05 0 00 000012 move q1, p2 ; Return existing characters 16961 16962 001026'01 254 00 0 00 001013* retskp ; Return success!!!!! 16963 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 15 K20IOC MAC 20-Jan-23 21:49 No trigger character seen 16964 subttl No trigger character seen 16965 16966 ; Entry: matchs register context 16967 ; 16968 ; AC block from movst 16969 ; 16970 ; t1/ Remaining characters in network input buffer 16971 ; t2/ Pointer to where the first character match happened in the input buffer 16972 ; *** OR *** where we ended (for a .CHNUL, for example) 16973 ; t3/ Zero, section local pointers 16974 ; t4/ Remaing characters in translation buffer 16975 ; q1/ Pointer to where we stopped in the translation buffer 16976 ; q2/ Zero, section local pointers 16977 ; 16978 ; N.B. Since we never hit the trigger character, t1 and t4 WILL be equal 16979 ; on entry because we stopped consuming source and storing in the 16980 ; destination translation area. 16981 ; 16982 ; Set by matchs at the time of calling 16983 ; 16984 ; q3/ Original buffer length of network data 16985 ; q4/ Original pointer to end of network data buffer 16986 ; q5/ Pointer to beginning of network data buffer 16987 ; p1/ Aliased from q5, don't use! 16988 ; p2/ Remaining source length 16989 ; p3/ Updated pointer, which was based on q5 16990 ; p4/ [Not in use, yet] 16991 ; p5/ [Not in use, yet] 16992 ; 16993 ; Exit: 16994 ; 16995 ; q1/ Updated count of characters in buffer 16996 ; q2/ Updated pointer into buffer 16997 16998 001027'01 ntrigr: remark ; Here if extend never hit the trigger character 16999 remark ; Assumes saved by matchs 17000 remark ; also saved by matchs 17001 17002 001027'01 621 01 0 00 700000 txz t1, S!N!M ; Shut off any flags from MOVST 17003 001030'01 200 04 0 00 000007 move t4, q3 ; Load original length 17004 001031'01 274 04 0 00 000001 sub t4, t1 ; Calculate total data done 17005 001032'01 327 04 0 00 001041' ifle. t4 ; Did we actually do anything or get anything odd? 17006 001033'01 120 05 0 00 000007 dmove q1, q3 ; Restore original buffer position 17007 001034'01 334 01 0 00 000000# ermsg% (<1st character MOVST doesn't appear to have done anything>,r) 17008 001035'01 254 00 0 00 001041' 17009 001036'01 202 01 0 00 000575* 17010 001037'01 104 00 0 00 000313 17011 001040'01 254 00 0 00 000577* 17012 000101'02 000000000000# 17013 000215'04 113 105 122 115 111 17014 17015 001041'01 endif. ; End sanity check 17016 17017 001041'01 260 17 0 00 001061' call netprn ; Print outstanding network data 17018 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 15-1 K20IOC MAC 20-Jan-23 21:49 No trigger character seen 17019 001042'01 312 04 0 00 000007 came t4, q3 ; Looked though everything? 17020 001043'01 254 00 0 00 001047' ifskp. ; We did, so reset count and pointer 17021 001044'01 400 05 0 00 000000 setz q1, ; Nothing left to look at 17022 001045'01 200 06 0 00 000011 move q2, q5 ; Load reset pointer 17023 001046'01 263 17 0 00 000000 ret ; And done, +1 17024 001047'01 endif. 17025 ; Otherwise, have to 'pull up' the data 17026 001047'01 621 12 0 00 700000 txz p2, S!N!M ; Don't want any flags from now on 17027 001050'01 120 01 0 00 000012 dmove t1, p2 ; Source is where we stopped in the buffer 17028 001051'01 200 04 0 00 000001 move t4, t1 ; Destination length is the same as source length 17029 001052'01 200 05 0 00 000011 move q1, q5 ; It's going to the top of the buffer 17030 001053'01 403 03 0 00 000006 setzb t3, q2 ; Force section local pointers 17031 001054'01 123 01 0 00 000555' extend t1, movsup ; Pull the rest of the string up 17032 001055'01 600 00 0 00 000000 nop ; Ignore non-skip return (should never happen) 17033 001056'01 200 06 0 00 000005 move q2, q1 ; Append position is wherever MOVSLJ left it 17034 001057'01 200 05 0 00 000012 move q1, p2 ; New length is whatever we didn't look at 17035 001060'01 263 17 0 00 000000 ret ; Returns +1 17036 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 16 K20IOC MAC 20-Jan-23 21:49 Network Print 17037 subttl Network Print 17038 17039 ; Entry: 17040 ; 17041 ; q5/ Pointer to start printing from 17042 ; t4/ Count of characters to print 17043 ; 17044 ; Returns: 17045 ; 17046 ; +1, always, no registers modified 17047 17048 001061'01 322 04 0 00 001040* netprn: jumpe t4, r ; If nothing to do, don't do anything 17049 001062'01 265 16 0 00 003737' saveac ; Don't step on a single thing 17050 001063'01 332 00 0 00 000766* ifme. pars8 ;[229] Only if not /SILENT 17051 001064'01 254 00 0 00 001076' 17052 001065'01 210 03 0 00 000004 movn t3, t4 ; Load negative count of data 17053 001066'01 200 02 0 00 000011 move t2, q5 ; And the beginning of it 17054 001067'01 201 01 0 00 000101 movei t1, .priou ; Our happy terminal 17055 001070'01 104 00 0 00 000053 SOUT% ; Blat how much we've done so far 17056 001071'01 320 12 0 00 001073' %jserr (,) ; Odd but carry on 17057 001072'01 254 00 0 00 001076' 17058 001073'01 265 01 0 00 000776* 17059 001074'01 000000000000# 17060 001075'01 254 00 0 00 001076' 17061 000233'04 125 156 141 142 154 17062 001076'01 endif. ;[229] 17063 17064 001076'01 337 01 0 00 001001* skipg t1, sesjfn ; Session logging? 17065 001077'01 263 17 0 00 000000 ret ; No, we're done 17066 17067 remark ; Yes, so let's put it in there, too 17068 001100'01 200 02 0 00 000011 move t2, q5 ; And the beginning of it 17069 001101'01 210 03 0 00 000004 movn t3, t4 ; Load negative count of data 17070 001102'01 104 00 0 00 000053 SOUT% ; Counted SOUT% is faster 17071 001103'01 320 12 0 00 001104' erjmpr .+1 ; Catch and ignore error 17072 17073 001104'01 263 17 0 00 000000 ret 17074 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 17 K20IOC MAC 20-Jan-23 21:49 Clear Buffered Network Data 17075 subttl Clear Buffered Network Data 17076 17077 ; Returns number cleared 17078 17079 001105'01 inpclr: entry inpclr ; Used by k20net 17080 001105'01 265 16 0 00 003672' saveac ; Used by inpbfc 17081 17082 001106'01 120 05 0 00 000000# dmove q1, inpcnt ; Set calling context 17083 001107'01 260 17 0 00 001117' call inpbfc ; Check buffer constency 17084 001110'01 263 17 0 00 000000 ret ; Bad, don't touch 17085 001111'01 272 05 0 00 000000# addm q1, inpcbf ; Otherwise, count is good, add to tally 17086 001112'01 120 01 0 00 000000# dmove t1, inpini ; Load INPUT initialization data 17087 001113'01 124 01 0 00 000000# dmovem t1, inpcnt ; Whack the buffer 17088 001114'01 200 01 0 00 000005 move t1, q1 ; Return what we cleared 17089 001115'01 263 17 0 00 000000 ret 17090 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 18 K20IOC MAC 20-Jan-23 21:49 INPUT buffer checking and error handling 17091 subttl INPUT buffer checking and error handling 17092 17093 remark ; Input buffer check 17094 17095 ; Call 17096 ; 17097 ; q1/ Current inpcnt, count of characters in buffer 17098 ; q2 Current inpptr, append pointer 17099 ; 17100 ; +1, Something bad 17101 ; +2, Good 17102 ; t1/ Start of text 17103 ; 17104 ; Register usage 17105 ; 17106 ; q3/ Earliest possible byte pointer 17107 ; q4/ Last possible byte pointer 17108 ; q5/ Beginning of current text in buffer 17109 17110 001116'01 44 07 0 00 000000# bufbeg: point 7, inpbuf ; Assembled beginning of buffer 17111 17112 001117'01 inpbfc: entry inpbfc ; Called from k20par 17113 001117'01 265 16 0 00 003751' saveac ; Some internal storage 17114 remark ; Leave these alone!! 17115 001120'01 200 01 0 00 001116' move t1, bufbeg ; Load assembler beginning 17116 001121'01 200 02 0 00 000001 move t2,t1 ; Save a copy 17117 17118 001122'01 133 00 0 00 000001 ibp t1 ; Bump into the first word 17119 001123'01 474 07 0 00 000000 seto q3, ; Back up by one 17120 001124'01 133 07 0 00 000001 adjbp q3, t1 ; Puts it into previous word 17121 001125'01 201 10 0 00 005000 movx q4, strblc ; Load maximum count 17122 001126'01 133 10 0 00 000002 adjbp q4, t2 ; Puts past last word 17123 17124 remark ; First, check the length 17125 001127'01 305 05 0 00 000000 caige q1, 0 ; Bogus count?? 17126 001130'01 334 01 0 00 000000# ermsg% (,inpbfa) 17127 001131'01 254 00 0 00 001135' 17128 001132'01 202 01 0 00 001036* 17129 001133'01 104 00 0 00 000313 17130 001134'01 254 00 0 00 001234' 17131 000102'02 000000000000# 17132 000243'04 113 105 122 115 111 17133 17134 001135'01 303 05 0 00 005000 caile q1, strblc ; Absurdly large? 17135 001136'01 334 01 0 00 000000# ermsg% (,inpbfa) 17136 001137'01 254 00 0 00 001143' 17137 001140'01 202 01 0 00 001132* 17138 001141'01 104 00 0 00 000313 17139 001142'01 254 00 0 00 001234' 17140 000103'02 000000000000# 17141 000253'04 113 105 122 115 111 17142 17143 17144 remark ; Check append pointer 17145 001143'01 550 03 0 00 000006 hrrz t3, q2 ; Load current buffer append address K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 18-1 K20IOC MAC 20-Jan-23 21:49 INPUT buffer checking and error handling 17146 001144'01 550 04 0 00 000007 hrrz t4, q3 ; And the earliest possible address 17147 001145'01 313 03 0 00 000004 camle t3, t4 ; Before or at last? 17148 001146'01 254 00 0 00 001156' ifskp. ; Yes, could be bad 17149 001147'01 316 06 0 00 000007 camn q2, q3 ; Unless on exact address 17150 001150'01 254 00 0 00 001156' anskp. ; That's fine 17151 001151'01 334 01 0 00 000000# ermsg% (,inpbtc) 17152 001152'01 254 00 0 00 001156' 17153 001153'01 202 01 0 00 001140* 17154 001154'01 104 00 0 00 000313 17155 001155'01 254 00 0 00 001233' 17156 000104'02 000000000000# 17157 000263'04 113 105 122 115 111 17158 17159 001156'01 endif. 17160 17161 001156'01 550 04 0 00 000010 hrrz t4, q4 ; Load last possible address 17162 001157'01 315 03 0 00 000004 camge t3, t4 ; After or at last? 17163 001160'01 254 00 0 00 001170' ifskp. ; Yes, could be bad 17164 001161'01 316 06 0 00 000010 camn q2, q4 ; Unless on exact address 17165 001162'01 254 00 0 00 001170' anskp. ; That's fine 17166 001163'01 334 01 0 00 000000# ermsg% (,inpbtc) 17167 001164'01 254 00 0 00 001170' 17168 001165'01 202 01 0 00 001153* 17169 001166'01 104 00 0 00 000313 17170 001167'01 254 00 0 00 001233' 17171 000105'02 000000000000# 17172 000300'04 113 105 122 115 111 17173 17174 001170'01 endif. 17175 17176 001170'01 323 05 0 00 001221' ifg. q1 ; But!! Is there anything to do? 17177 remark ; Calculate and check start of text 17178 001171'01 210 11 0 00 000005 movn q5, q1 ; Load negative current buffer length 17179 001172'01 133 11 0 00 000006 adjbp q5, q2 ; Calculates beginning of input area 17180 17181 001173'01 550 03 0 00 000011 hrrz t3, q5 ; Load address of start of text 17182 001174'01 550 04 0 00 000007 hrrz t4, q3 ; And the earliest possible address 17183 001175'01 313 03 0 00 000004 camle t3, t4 ; Before or at last? 17184 001176'01 254 00 0 00 001206' ifskp. ; Yes, could be bad 17185 001177'01 316 11 0 00 000007 camn q5, q3 ; Unless on exact address 17186 001200'01 254 00 0 00 001206' anskp. ; That's fine 17187 001201'01 334 01 0 00 000000# ermsg% (,inpbtc) 17188 001202'01 254 00 0 00 001206' 17189 001203'01 202 01 0 00 001165* 17190 001204'01 104 00 0 00 000313 17191 001205'01 254 00 0 00 001233' 17192 000106'02 000000000000# 17193 000313'04 113 105 122 115 111 17194 17195 001206'01 endif. 17196 17197 001206'01 550 04 0 00 000010 hrrz t4, q4 ; Load last possible address 17198 001207'01 315 03 0 00 000004 camge t3, t4 ; After or at last? 17199 001210'01 254 00 0 00 001220' ifskp. ; Yes, could be bad 17200 001211'01 316 06 0 00 000010 camn q2, q4 ; Unless on exact address K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 18-2 K20IOC MAC 20-Jan-23 21:49 INPUT buffer checking and error handling 17201 001212'01 254 00 0 00 001220' anskp. ; That's fine 17202 001213'01 334 01 0 00 000000# ermsg% (,inpbtc) 17203 001214'01 254 00 0 00 001220' 17204 001215'01 202 01 0 00 001203* 17205 001216'01 104 00 0 00 000313 17206 001217'01 254 00 0 00 001233' 17207 000107'02 000000000000# 17208 000330'04 113 105 122 115 111 17209 17210 001220'01 endif. 17211 001220'01 254 00 0 00 001222' else. ; Otherwise, nothing to compute or check 17212 001221'01 200 11 0 00 000007 move q5, q3 ; Current append IS the start of text 17213 001222'01 endif. 17214 17215 remark ; Everything looks, good but can we get anything? 17216 001222'01 200 02 0 00 000011 move t2, q5 ; Load the start of buffer pointer 17217 001223'01 134 04 0 00 000002 ildb t4, t2 ; Pick up the first character 17218 001224'01 320 12 0 00 001226' %jserr (,inpbtc) 17219 001225'01 254 00 0 00 001231' 17220 001226'01 265 01 0 00 001073* 17221 001227'01 000000000000# 17222 001230'01 254 00 0 00 001233' 17223 000343'04 102 165 146 146 145 17224 17225 001231'01 200 01 0 00 000011 move t1, q5 ; Return current input position 17226 001232'01 254 00 0 00 001026* retskp ; Finally return success 17227 17228 17229 remark Error handler 17230 17231 001233'01 272 05 0 00 000000# inpbtc: addm q1, inpcbf ; Otherwise, count is good, add to tally 17232 001234'01 400 05 0 00 000000 inpbfa: setz q1, ; Whack the buffer; nothing in there 17233 001235'01 200 06 0 00 001116' move q2, bufbeg ; and point to the beginning 17234 001236'01 263 17 0 00 000000 ret ; Return the bad news 17235 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 19 K20IOC MAC 20-Jan-23 21:49 Debug Print, call with a JSP CX 17236 subttl Debug Print, call with a JSP CX 17237 17238 ; Was used to catch all the edge cases when doing buffered reads 17239 17240 repeat 0,< ; But it's debugged now. I hope... 17241 17242 debprn: push p, t1 17243 push p, t2 17244 push p, t3 17245 txmsg < 17246 Entry: > 17247 call prnbuf 17248 pop p, t3 17249 pop p, t2 17250 pop p, t1 17251 call (cx) ;;No arguments to skip 17252 ifskp. 17253 push p, t1 17254 push p, t2 17255 push p, t3 17256 txmsg < 17257 retskp: > 17258 call prnbuf 17259 pop p, t3 17260 pop p, t2 17261 pop p, t1 17262 aos (p) 17263 else. 17264 push p, t1 17265 push p, t2 17266 push p, t3 17267 txmsg < 17268 ret: > 17269 call prnbuf 17270 pop p, t3 17271 pop p, t2 17272 pop p, t1 17273 endif. 17274 ret 17275 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 20 K20IOC MAC 20-Jan-23 21:49 Debug Print, call with a JSP CX 17276 remark The symbol being displayed is what the buffer pointer is 17277 17278 prnbuf: movei t1, .priou 17279 move t2, q1 17280 movei t3, ^d10 17281 NOUT% 17282 erjmpr .+1 17283 txmsg <, > 17284 hrrz t1, q2 17285 push p, cx 17286 call symout## 17287 pop p, cx 17288 ifg. q1 17289 caile q1, strblc 17290 anskp. 17291 txmsg <,' 17292 '> 17293 movei t1, .priou 17294 movn t2, q1 17295 adjbp t2, q2 17296 movn t3, q1 17297 SOUT% 17298 erjmpr .+1 17299 txmsg <' 17300 17301 > 17302 else. 17303 ifn. q1 17304 txmsg <, *** absurd length *** 17305 17306 > 17307 else. 17308 txmsg < 17309 17310 > 17311 endif. 17312 endif. 17313 ret 17314 >;repeat 0 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 21 K20IOC MAC 20-Jan-23 21:49 Builds a Search String 17315 subttl Builds a Search String 17316 17317 ; Call: 17318 ; 17319 ; Something in the atom buffer to search for. Does the following, 17320 ; in order, 17321 ; 17322 ; 1) Translates C escape sequences to the indicated character 17323 ; 2) Builds search MOVST table 17324 ; 17325 ; Returns +1, If error 17326 ; +2. Success!! 17327 ; 17328 ; strbuf/ Converted 7-bit ASCIZ string 17329 ; strptr/ 7 bit pointer to the above 17330 ; strc/ Length of converted string 17331 ; sertab/ MOVST table to stop on first letter of search string 17332 ; 17333 ; Unlike getss, will not allow string buffer to be overwritten 17334 17335 001237'01 265 16 0 00 003763' bsrchs: saveac ; Needs some temporaries 17336 dmove t1, [ ; Set up for expansion 17337 point 7,strbuf ; Destination is string buffer 17338 001240'01 120 01 0 00 003775' point 7,atmbuf] ; Source is the typed in string 17339 001241'01 120 05 0 00 000001 dmove q1, t1 ; Save destination and source pointers 17340 001242'01 202 01 0 00 000734* movem t1, strptr ; Save destination pointer for later 17341 17342 001243'01 134 03 0 00 000006 ildb t3, q2 ; And pick up the first source character 17343 001244'01 322 03 0 00 001260' ifn. t3 ; Anything to do, actually? 17344 dmove t3, [ strblc ; Load string's length in characters 17345 001245'01 120 03 0 00 003777' chrtup ] ; Assume (common) case insensitive compare 17346 001246'01 332 00 0 00 000000# skipe incase ; But!! Case-INsensitive compare? 17347 001247'01 201 04 0 00 000000# movei t4, chrtab ; Ok, so case sensitive, then 17348 001250'01 260 17 0 00 003101' call cescxp ; Expand any escape characters 17349 001251'01 334 00 0 00 000000 %ermsg (,r) ; pass +1 up 17350 001252'01 254 00 0 00 001256' 17351 001253'01 265 01 0 00 001226* 17352 001254'01 000000000000# 17353 001255'01 254 00 0 00 001061* 17354 000351'04 105 162 162 157 162 17355 001256'01 202 03 0 00 000711* movem t3, strc ; Store the length of the target string 17356 001257'01 254 00 0 00 001264' else. ; Otherwise, nothing in there 17357 001260'01 402 00 0 00 001256* setzm strc ; So zero the string counter 17358 001261'01 403 02 0 00 000003 setzb t2, t3 ; And scrub a dub 17359 001262'01 124 02 0 00 000427* dmovem t2, strbuf ; the destination buffer 17360 001263'01 254 00 0 00 001232* retskp ; Nothing else to do 17361 001264'01 endif. ; End case something to do 17362 17363 001264'01 134 07 0 00 000005 ildb q3, q1 ; Pick up first expanded character 17364 001265'01 322 07 0 00 001263* jumpe q3, RSKP ; Can't match on NUL 17365 ; Otherwise, build a search translation table 17366 001266'01 201 01 0 00 000200 movx t1, sertln ; Length of search table in words 17367 dmove t2, [ btrnsu ; Uppercasing base table with no stop characters 17368 001267'01 120 02 0 00 004001' sertab ] ; Destination in writable storage to be modified 17369 001270'01 332 00 0 00 000000# skipe incase ; But!! Case-INsensitive compare? K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 21-1 K20IOC MAC 20-Jan-23 21:49 Builds a Search String 17370 001271'01 201 02 0 00 000000# movei t2, btrnst ; No, so use exact matching table, then 17371 17372 001272'01 550 04 0 00 000002 hrrz t4, t2 ; Pick up address of base table 17373 001273'01 505 04 0 00 015000 hrli t4, (movst 0,0) ; Build instruction 17374 001274'01 202 04 0 00 000000# movem t4, trnbas ; Store as instructon to do 17375 001275'01 402 00 0 00 000000# setzm trnbas+1 ; Fill character is .chnul 17376 001276'01 123 01 0 00 003702' xblt. t1 ; Drop into place 17377 17378 001277'01 202 07 0 00 000000# movem q3, trgchr ; Might be the right character 17379 001300'01 200 01 0 00 000007 move t1, q3 ; Load the character 17380 001301'01 260 17 0 00 001321' call mrktab ; Mark the table to stop on this character 17381 001302'01 332 00 0 00 000000# skipe incase ; But!! Case-INsensitive compare? 17382 001303'01 254 00 0 00 001265* retskp ; No, so case sensitive and we're done 17383 17384 001304'01 200 01 0 00 000007 move t1, q3 ; Otherwise, load the character again 17385 001305'01 301 01 0 00 000141 cail t1, "a" ; Is this a lower case letter? 17386 001306'01 303 01 0 00 000172 caile t1, "z" 17387 001307'01 254 00 0 00 001313' jrst bsrch1 ; No, see if UPPER case 17388 001310'01 620 01 0 00 000040 txz t1, 40 ; Yes, convert to UPPER case 17389 001311'01 202 01 0 00 000000# movem t1, trgchr ; And save as the trigger character 17390 001312'01 254 00 0 00 001317' jrst bsrch2 ; Now go poke the table 17391 17392 001313'01 301 01 0 00 000101 bsrch1: cail t1, "A" ; No, is this an UPPER case letter? 17393 001314'01 303 01 0 00 000132 caile t1, "Z" ; If neither UPPER or lower, 17394 001315'01 254 00 0 00 001303* retskp ; we're done 17395 001316'01 660 01 0 00 000040 txo t1, 40 ; Yes, convert to lower case 17396 remark bsrch2 ; Falls through to tweak the table again 17397 17398 001317'01 260 17 0 00 001321' bsrch2: call mrktab ; Mark the table to stop on this character 17399 001320'01 254 00 0 00 001315* retskp ; Return success 17400 17401 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 22 K20IOC MAC 20-Jan-23 21:49 Given a character Mark a translate Table to stop on it 17402 subttl Given a character Mark a translate Table to stop on it 17403 17404 ; Call: 17405 ; 17406 ; t1/ Character to stop on 17407 ; 17408 ; Returns: +1, always 17409 ; 17410 ; Search table (sertab) with appropriate character pair updated 17411 ; 17412 ; To do, the indexed xct is extremely cute, but probably not really 17413 ; fast. Probably could just have done an txnn/ifskp./else./endif. 17414 ; and maybe even bummed the lsh. Even with all the extra jrst's, 17415 ; it would probably be faster. 17416 ; 17417 ; Vanity, vanity, vanity... 17418 17419 001321'01 265 16 0 00 003737' mrktab: saveac ; Don't touch the temporaries 17420 001322'01 246 01 0 00 777777 lshc t1, ^d<-1> ; Divide by two, shifting odd bit into bit zero 17421 001323'01 242 02 0 00 777735 lsh t2, ^d<-35> ; Shift remainder into bit zero 17422 001324'01 200 03 0 01 000000# move t3, sertab(t1) ; Load character pair 17423 xct [tlo t3,TRMCOD ; Even, pick up left half 17424 001325'01 256 00 0 02 004003' tro t3,TRMCOD](t2) ; Odd, pick up right half 17425 001326'01 202 03 0 01 000000# movem t3, sertab(t1) ; Store back into table 17426 001327'01 263 17 0 00 000000 ret ; Done 17427 17428 ;[209] End code insertion 17429 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 23 K20IOC MAC 20-Jan-23 21:49 OUTPUT command parsing 17430 subttl OUTPUT command parsing 17431 17432 ;[208] Originally shut off indirection, but since quoted strings allow 17433 ; us to put in an at-sign (@) as well as escape sequences, this was 17434 ; removed to allow backward compatibility with any take files which 17435 ; rely on this. 17436 17437 chgsec(code,const) ;;Chained FDB's go in const 17438 000110'02 010004 000113' outfdb: flddb. .cmcfm,,,,,outfd1 17439 000111'02 000000 000000 17440 000112'02 44 07 0 00 003631' 17441 000113'02 021004 000116' outfd1: flddb. .cmqst,,,,,outfd2 17442 000114'02 000000 000000 17443 000115'02 44 07 0 00 003640' 17444 000116'02 017004 000000 outfd2: flddb. .cmtxt,,,,, ;[208] 17445 000117'02 000000 000000 17446 000120'02 44 07 0 00 003647' 17447 retsec ;;Return to code psect 17448 cleans() ;;Clean up working symbols 17449 17450 17451 001330'01 .outpu: entry .output ; Invoked by k20par 17452 001330'01 200 16 0 00 000000# guide (string) ; Parse OUTPUT command. 17453 001331'01 260 17 0 00 000212* 17454 000121'02 000000000000# 17455 000360'04 163 164 162 151 156 17456 001332'01 201 01 0 00 000000# movei t1, outfdb ;[208] Load pointer to chained fdb's 17457 001333'01 260 17 0 00 000216* call rfield ;[208] Parse for something 17458 001334'01 135 03 0 00 003671' ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ;[208] Get what was parsed 17459 001335'01 302 03 0 00 000010 caie t3, .cmcfm ;[208] Parsed a confirm? 17460 001336'01 254 00 0 00 001342' ifskp. ;[208] We did, so fix up the atom buffer 17461 001337'01 205 01 0 00 064000 movx t1, ;[208] Load a carriage return 17462 001340'01 202 01 0 00 000225* movem t1, atmbuf ;[208] Stomp the atom buffer 17463 001341'01 254 00 0 00 001343' else. ;[208] Otherwise, the atom buffer is valid 17464 001342'01 260 17 0 00 000252* confrm ;[208] But must be confirmed 17465 001343'01 endif. ;[208] End parse check 17466 001343'01 263 17 0 00 000000 ret 17467 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 24 K20IOC MAC 20-Jan-23 21:49 OUTPUT command execution 17468 subttl OUTPUT command execution 17469 17470 001344'01 $outpu: entry $output ;[209] Invoked by k20par 17471 001344'01 265 16 0 00 004005' saveac ;[223] Save registers for piggy MOVST 17472 17473 remark ;[209] Expand the C escape characters 17474 dmove t1, [ ;[209] Set up for expansion 17475 point 8,strbuf ;[209] Destination buffer is eight bit 17476 001345'01 120 01 0 00 004021' point 7,atmbuf] ;[209] Source is atom buffer in seven bit 17477 dmove t3, [ atmbln*5 ;[209] Source is as large as atom buffer 17478 001346'01 120 03 0 00 004023' chrtab ] ;[209] Respect case on expansion 17479 001347'01 260 17 0 00 003101' call cescxp ;[209] Expand string into output buffer 17480 001350'01 334 00 0 00 000000 %ermsg (,r) ;[209] Don't go any further 17481 001351'01 254 00 0 00 001355' 17482 001352'01 265 01 0 00 001253* 17483 001353'01 000000000000# 17484 001354'01 254 00 0 00 001255* 17485 000362'04 105 162 162 157 162 17486 001355'01 200 11 0 00 000003 move q5, t3 ;[223] Save length of destination 17487 17488 001356'01 337 01 0 00 000434* $outp4: skipg t1, netjfn ;[186] Comm line designator. 17489 001357'01 200 01 0 00 000435* move t1, ttyjfn ;[186] Not remote, using local 17490 001360'01 260 17 0 00 000000* call chklin ; Whatever it is, check it 17491 001361'01 332 00 0 00 000000* ifme. carier ; No carrier? 17492 001362'01 254 00 0 00 001370' 17493 001363'01 334 00 0 00 000000 %ermsg (,r) 17494 001364'01 254 00 0 00 001370' 17495 001365'01 265 01 0 00 001352* 17496 001366'01 000000000000# 17497 001367'01 254 00 0 00 001354* 17498 000371'04 125 156 141 142 154 17499 001370'01 endif. 17500 001370'01 200 02 0 00 004021' move t2, [point 8, strbuf] ; Point to converted string 17501 001371'01 210 03 0 00 000011 movn t3, q5 ;[186] Counted string (gives length of record) 17502 001372'01 400 04 0 00 000000 setz t4, ;[186] Just in case (still NUL terminated) 17503 001373'01 336 00 0 00 000000# skipn parpko ;[223] Don't do this if doing packets only 17504 001374'01 260 17 0 00 003544' call putpar ;[223] Otherwise, maybe put some parity on it 17505 001375'01 104 00 0 00 000532 SOUTR% ;[186] Push it over the network. 17506 001376'01 320 12 0 00 001400' %jserr (,) 17507 001377'01 254 00 0 00 001403' 17508 001400'01 265 01 0 00 001365* 17509 001401'01 000000000000# 17510 001402'01 254 00 0 00 001403' 17511 000402'04 103 141 156 047 164 17512 17513 001403'01 350 00 0 00 000000* aos vsoct ;[204] Count a SOUTR% done 17514 001404'01 272 11 0 00 000000* addm q5, vsotc ;[204] Update tally of SOUTR% bytes 17515 001405'01 313 11 0 00 000000* camle q5, vsomx ;[204] Length than or equal to the maximum seen? 17516 001406'01 202 11 0 00 001405* movem q5, vsomx ;[204] Nope, we have a new maximum! 17517 17518 001407'01 336 00 0 00 000000* skipn duplex ; Half duplex connection? 17519 001410'01 263 17 0 00 000000 ret ; No, host will echo. 17520 17521 001411'01 201 01 0 00 000101 movei t1, .priou ; Yes, do it ourselves. 17522 001412'01 200 02 0 00 004021' move t2, [point 8, strbuf] ; Point to string again. K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 24-1 K20IOC MAC 20-Jan-23 21:49 OUTPUT command execution 17523 001413'01 210 03 0 00 000011 movn t3, q5 ;[186] Counted string (faster) 17524 001414'01 400 04 0 00 000000 setz t4, ;[186] Just in case (still NUL terminated) 17525 001415'01 104 00 0 00 000053 SOUT% 17526 001416'01 320 12 0 00 001417' erjmpr .+1 ;[195] 17527 17528 001417'01 337 01 0 00 001076* skipg t1, sesjfn ;[195] Session logging? 17529 001420'01 254 00 0 00 001433' ifskp. ;[195] A JFN exists 17530 001421'01 336 00 0 00 000330* skipn sesflg ;[195] Is logging active? 17531 001422'01 254 00 0 00 001433' anskp. ;[195] No, so don't bother 17532 001423'01 306 01 0 00 377777 cain t1, .nulio ;[193] Just dumping it? 17533 001424'01 254 00 0 00 001433' anskp. ;[193] If so, we're done 17534 001425'01 200 02 0 00 004021' move t2, [point 8, strbuf] ; Yes, point again. 17535 001426'01 210 03 0 00 000011 movn t3, q5 ;[186] Counted string (faster) 17536 001427'01 400 04 0 00 000000 setz t4, ;[186] Just in case (still NUL terminated) 17537 001430'01 403 03 0 00 000004 setzb t3, t4 17538 001431'01 104 00 0 00 000053 SOUT 17539 001432'01 320 12 0 00 001433' erjmpr .+1 ;[195] 17540 001433'01 endif. ;[195] 17541 17542 001433'01 263 17 0 00 000000 ret ; Done. 17543 17544 ;[209] End code replacement 17545 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 25 K20IOC MAC 20-Jan-23 21:49 TRANSMIT [file] parsing [165] 17546 subttl TRANSMIT [file] parsing [165] 17547 17548 ;[209] Begin code replacement 17549 ; 17550 ; Moved here from k20mit and rewritten to be able drive buffered I/O. 17551 ; 17552 ; Tries for a device first as this is more efficient for NUL: and 17553 ; catches more errors earlier and more easily. Can sometimes make 17554 ; recognition not work intuitively by picking a bogus device over 17555 ; a non-existant file. 17556 ; 17557 ; Default command filespec fields for .CMFIL. These are only given 17558 ; so that we may get the flags returned by GTJFN% (which are currently 17559 ; unused) 17560 17561 chgsec(code,const) ;;GTJFN defaults are not in code, they're in const 17562 17563 000122'02 100020 000000 trnbk: gj%flg!gj%old!fld(.gjdef,.rhalf) ; .GJGEN 17564 000123'02 000100 000101 .priin,,.priou ; .GJSRC (ignored if COMND%) 17565 000124'02 000000 000000 0 ; .GJDEV (do not default the device) 17566 000125'02 000000 000000 0 ; .GJDIR (do not default the directory) 17567 000126'02 000000 000000 0 ; .GJNAM (do not default the name) 17568 000127'02 000000 000000 0 ; .GJEXT (do not default the extension) 17569 000130'02 000000 000000 0 ; .GJPRO (use system default protection) 17570 000131'02 000000 000000 0 ; .GJACT (use job's current account) 17571 000010 trnbkl==<.-trnbk> ; Length of this GTJFN argument block. 17572 retsec ;;[229] Back to where-ever we started from 17573 17574 ;[229] %table puts stuff in the correct .psect 17575 17576 000132'02 000000 000000 %table (trnswi) ;[229] The translate switch table 17577 000133'02 000000# 000000 %key2 , %eofsw ;[229] The EOF switch parses a restricted token set 17578 000040'03 105 117 106 000 000 17579 000134'02 000000# 000001 %key2 , %silsw ;[229] Tells $input to shut up about matches 17580 000041'03 163 151 154 145 156 17581 000135'02 000000# 000002 %key2 , %timsw ;[229] In case we don't want to wait forever ... 17582 000043'03 164 151 155 145 157 17583 000132'02 000003 000003 %tbend ;[229] End of table 17584 17585 remark Lifted from k20par 17586 17587 ;N.B., have to use literals here or flddb. will choke. Maybe rewrite 17588 ; this to special case .cmtok, like fldtk.? 17589 17590 define token (c) < ;;[217] Define token 17591 ;;[217] All these literals, yuck... 17592 >;;token ;;[217] 17593 17594 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 17595 000136'02 023004 000141' tranft: flddb. .cmtok,,token(<>),,,tranf1 17596 000137'02 440700 003653' 17597 000140'02 44 07 0 00 003654' 17598 000141'02 023004 000144' tranf1: flddb. .cmtok,,token(<>),,,tranf2 17599 000142'02 440700 003665' 17600 000143'02 44 07 0 00 003666' K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 25-1 K20IOC MAC 20-Jan-23 21:49 TRANSMIT [file] parsing [165] 17601 000144'02 023004 000147' tranf2: flddb. .cmtok,,token(<$>),,,tranf3 17602 000145'02 440700 003674' 17603 000146'02 44 07 0 00 003675' 17604 000147'02 023005 000000 tranf3: flddb. .cmtok,cm%sdh,token(<>),,, 17605 000150'02 440700 003706' 17606 000151'02 44 07 0 00 003707' 17607 17608 000152'02 003000 000154' tranfs: flddb. .cmswi,,trnswi,,,tranfd ;[229] Maybe get a transmit switch 17609 000153'02 000000 000132' 17610 000154'02 006000 000156' tranfd: flddb. .cmfil,,,,,tranf4 17611 000155'02 000000 000000 17612 000156'02 016001 000000 tranf4: flddb. .cmdev,cm%sdh,,,, ;[229] Catch bare device 17613 000157'02 000000 000000 17614 17615 000160'02 015006 000000 timfdb: flddb. .cmflt,,^d10,,<10>, 17616 000161'02 000000 000012 17617 000162'02 44 07 0 00 003573' 17618 000163'02 44 07 0 00 003720' 17619 retsec ;;[229] Back to where-ever we started from 17620 remark ;;[229] Punt temporary symbols 17621 cleans() 17622 17623 001434'01 .trans: entry .trans ; Invoked from k20par 17624 001434'01 265 16 0 00 004005' saveac ; Protect some registers 17625 17626 001435'01 200 01 0 00 004025' movx t1, cz%ncl!.fhslf ; Release non-open JFN's on reparse 17627 001436'01 104 00 0 00 000034 CLZFF% 17628 001437'01 320 12 0 00 001440' erjmpr .+1 ; Catch and ignore errors 17629 17630 001440'01 200 01 0 00 004026' move t1, [trnbk,,cjfnbk] ; Insert our file parsing defaults. 17631 001441'01 251 01 0 00 000000# blt t1, cjfnbk+trnbkl 17632 17633 001442'01 201 11 0 00 000000# movei q5, tranfs ;[229] Doing a full complement of switches 17634 17635 001443'01 200 16 0 00 000000# .tran0: guide 17636 001444'01 260 17 0 00 001331* 17637 000164'02 000000000000# 17638 000407'04 146 151 154 145 040 17639 001445'01 .tran1: remark ;[229] Here when looping on switches 17640 001445'01 201 01 0 00 000011 movei t1, q5 ;[229] Look for switch, device or file 17641 001446'01 260 17 0 00 001333* call rfield ;[229] Ask them to type something 17642 001447'01 200 06 0 00 000002 move q2, t2 ;[229] Save whatever parsed data we got 17643 001450'01 135 05 0 00 003671' ldb q1, [pointr (.cmfnp(t3),cm%fnc)] ;[229] Pick up function code 17644 001451'01 302 05 0 00 000003 caie q1, .cmswi ;[229] Did we get a switch? 17645 001452'01 254 00 0 00 001525' jrst .tran2 ;[229] No, just go handle the device or file 17646 001453'01 415 16 0 00 001517' block. ;[229] Enter block for better control flow 17647 001454'01 261 17 0 00 000016 17648 001455'01 550 07 0 06 000000 hrrz q3, (q2) ;[229] Pick up the switch value 17649 001456'01 302 07 0 00 000000 caie q3, %eofsw ;[229] Parsed the EOF switch? 17650 001457'01 254 00 0 00 001472' ifskp. ;[229] We did, so pick up its argument 17651 001460'01 201 01 0 00 000000# movei t1, tranft ;[229] Look for an EOF token 17652 001461'01 260 17 0 00 001446* call rfield ;[229] Ask them to type one of them 17653 001462'01 621 03 0 00 777777 tlz t3, -1 ;[229] Isolate fdb we actually used 17654 001463'01 200 02 0 03 000001 move t2, .cmdat(t3) ;[229] Pick up the byte pointer to the character 17655 001464'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 15:18 11-Jun-23 Page 25-2 K20IOC MAC 20-Jan-23 21:49 TRANSMIT [file] parsing [165] 17656 001465'01 306 01 0 00 000044 cain t1, "$" ;[229] Our goofy escape synonym? 17657 001466'01 201 01 0 00 000033 movei t1, .chesc ;[229] Yes, transmogrify it 17658 001467'01 260 17 1 00 000000* call @parity ;[229] And put parity on it (if doing parity) 17659 001470'01 202 01 0 00 000000* movem t1, pars7 ;[229] Save EOF character 17660 001471'01 254 00 0 00 001320* retskp ;[229] Return for next switch 17661 001472'01 endif. ;[229] End EOF switch case 17662 001472'01 302 07 0 00 000001 caie q3, %silsw ;[229] Parsed the 'silent' switch? 17663 001473'01 254 00 0 00 001476' ifskp. ;[229] We did, so that should be easy enough 17664 001474'01 476 00 0 00 001063* setom pars8 ;[229] Just flag it in the parse block 17665 001475'01 254 00 0 00 001471* retskp ;[229] Return for next switch 17666 001476'01 endif. ;[229] End 'silent' switch case 17667 001476'01 302 07 0 00 000002 caie q3, %timsw ;[229] Wants a timeout? 17668 001477'01 254 00 0 00 001515' ifskp. ;[229] Give him a time out 17669 001500'01 201 01 0 00 000000# movei t1, timfdb ;[229] Look for a time out number (floating) 17670 001501'01 260 17 0 00 001461* call rfield ;[229] Ask them to type one it 17671 001502'01 325 02 0 00 001506' ifl. t2 ;[229] Is the number in the right range? 17672 001503'01 200 01 0 00 000000# emsg ;[229] Must be superluminal... 17673 001504'01 104 00 0 00 000313 17674 000165'02 000000000000# 17675 000414'04 101 040 156 145 147 17676 001505'01 254 00 0 00 000240* jrst cmder1 ;[229] Yet allow reparse 17677 001506'01 endif. ;[229] End initial sanity checking 17678 001506'01 260 17 0 00 000176* call chksec ;[229] Ensure number is in correct range 17679 001507'01 254 00 0 00 001512' ifskp. ;[229] Check and convert OK? Then side-effect variables 17680 001510'01 254 00 0 00 001475* retskp ;[229] And get out of the parse block. 17681 001511'01 254 00 0 00 001515' else. ;[229] Otherwise, couldn't swallow something 17682 001512'01 200 01 0 00 000000# emsg ;[229] 17683 001513'01 104 00 0 00 000313 17684 000166'02 000000000000# 17685 000423'04 123 160 145 143 151 17686 001514'01 254 00 0 00 001505* jrst cmder1 ;[229] Yet allow reparse 17687 001515'01 endif. ;[229] End case checking and conversion 17688 001515'01 endif. ;[229] End case timeout switch 17689 001515'01 263 17 0 00 000000 ret ;[229] Otherwise, some kind of bogus switch 17690 001516'01 263 17 0 00 000000 endbk. ;[229] End Block context 17691 001517'01 254 00 0 00 001522' ifskp. ;[229] Successful switch parse 17692 001520'01 254 00 0 00 001445' jrst .tran1 ;[229] Go see if more switches (or device or file) 17693 001521'01 254 00 0 00 001525' else. ;[229] Otherwise, some kind of error 17694 001522'01 200 01 0 00 000000# emsg ;[229] An internal programming error.. 17695 001523'01 104 00 0 00 000313 17696 000167'02 000000000000# 17697 000434'04 125 156 153 156 157 17698 001524'01 254 00 0 00 001514* jrst cmder1 ;[229] However, allow reparse 17699 001525'01 endif. ;[229] End of switch block processing 17700 17701 001525'01 200 01 0 00 000006 .tran2: move t1, q2 ;[229] Load parsed data for DVCHR% 17702 001526'01 302 05 0 00 000016 caie q1, .cmdev ; Typed a bare device? 17703 001527'01 621 01 0 00 777777 tlz t1, -1 ; Shut off flags so DVCHR% doesn't choke 17704 001530'01 104 00 0 00 000117 DVCHR% ; and find out about it 17705 001531'01 320 12 0 00 001533' %jserr (,r) 17706 001532'01 254 00 0 00 001536' 17707 001533'01 265 01 0 00 001400* 17708 001534'01 000000000000# 17709 001535'01 254 00 0 00 001367* 17710 000443'04 125 156 141 142 154 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 25-3 K20IOC MAC 20-Jan-23 21:49 TRANSMIT [file] parsing [165] 17711 001536'01 135 07 0 00 004027' ldb q3, [pointr t2, dv%typ] ; Pick up the device type 17712 17713 001537'01 302 05 0 00 000016 caie q1, .cmdev ; Typed a bare device? 17714 001540'01 254 00 0 00 001565' ifskp. ; Yes, see what it is 17715 001541'01 302 07 0 00 000015 caie q3, .dvnul ; NUL:? 17716 001542'01 254 00 0 00 001545' ifskp. ; Yes, we can simulate that 17717 001543'01 200 06 0 00 004030' movx q2, ;Use special designator and flags 17718 001544'01 254 00 0 00 001602' jrst .tran3 ;[229] Done with this special case 17719 001545'01 endif. ; Any other device is NOT VALID 17720 17721 001545'01 302 07 0 00 000000 caie q3, .dvdsk ; Bare device? 17722 001546'01 254 00 0 00 001564' ifskp. ; Yes, but needs a file name 17723 001547'01 200 01 0 00 000000# emsg ; First part of blat 17724 001550'01 104 00 0 00 000313 17725 000170'02 000000000000# 17726 000456'04 124 150 145 040 000 17727 001551'01 200 02 0 00 000006 move t2, q2 ; Load whatever we parsed 17728 001552'01 201 01 0 00 000101 movei t1, .priou ; Output to the terminal 17729 001553'01 104 00 0 00 000121 DEVST% ; Write the device name into the AC's 17730 001554'01 320 12 0 00 001556' %jserr (,cmder1) 17731 001555'01 254 00 0 00 001561' 17732 001556'01 265 01 0 00 001533* 17733 001557'01 000000000000# 17734 001560'01 254 00 0 00 001524* 17735 000457'04 125 156 141 142 154 17736 001561'01 200 01 0 00 000000# sxtext (t1,<: structure needs a file specification>) 17737 000171'02 000000000000# 17738 000470'04 072 040 163 164 162 17739 001562'01 104 00 0 00 000076 PSOUT% ; Finish the informative blat 17740 001563'01 254 00 0 00 001560* jrst cmder1 ; Allow reparse 17741 001564'01 endif. ; Any other device is NOT VALID 17742 17743 001564'01 254 00 0 00 001623' jrst .trane ; Otherwise, handle as a general parse error 17744 001565'01 endif. ; End case .cmdev 17745 17746 remark .cmfil ; Everything else is a file 17747 17748 001565'01 302 07 0 00 000015 caie q3, .dvnul ; A JFN on NUL:?? 17749 001566'01 254 00 0 00 001600' ifskp. ; Yes, let's fix that up 17750 001567'01 200 01 0 00 000006 move t1, q2 ; Load parsed JFN 17751 001570'01 260 17 0 00 000000* call isnulj ; Convert it to a special JFN, releasing original 17752 001571'01 334 01 0 00 000000# ermsg% (,cmder1) ; Allow ^H 17753 001572'01 254 00 0 00 001576' 17754 001573'01 202 01 0 00 001215* 17755 001574'01 104 00 0 00 000313 17756 001575'01 254 00 0 00 001563* 17757 000172'02 000000000000# 17758 000500'04 113 105 122 115 111 17759 17760 001576'01 200 06 0 00 000001 move q2, t1 ; Store the JFN and original parse flags 17761 001577'01 254 00 0 00 001602' jrst .tran3 ; Done with this second special NUL: (JFN) case 17762 001600'01 endif. 17763 17764 001600'01 302 07 0 00 000000 caie q3, .dvdsk ; Was this a structure? 17765 001601'01 254 00 0 00 001623' jrst .trane ; No, any other device is NOT VALID K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 25-4 K20IOC MAC 20-Jan-23 21:49 TRANSMIT [file] parsing [165] 17766 17767 17768 001602'01 .tran3: remark ;[229] Otherwise, parse is OK so far 17769 001602'01 403 01 0 00 000002 setzb t1, t2 ; Cons up a couple of nice .chnul's 17770 001603'01 124 01 0 00 001340* dmovem t1, atmbuf ; Stomp the atom buffer 17771 17772 001604'01 260 17 0 00 000211' call .inpu1 ; Get the search string 17773 001605'01 302 05 0 00 000010 caie q1, .cmcfm ; Defaulted search? 17774 001606'01 254 00 0 00 001620' ifskp. ; Yes, maybe fix up for TRANSMIT defaults 17775 001607'01 333 00 0 00 000000# skiple indefw ; Had we set a default search string? 17776 001610'01 254 00 0 00 001620' anskp. ; We did, so we're done 17777 remark ; Otherwise, supply another appropriate default. 17778 001611'01 336 01 0 00 000000* skipn t1, handsh ; Handshaking? 17779 001612'01 201 01 0 00 000012 movei t1, .chlfd ; No, then use linefeed. 17780 001613'01 241 01 0 00 777771 rot t1, -^d7 ; Turn into an ASCIZ word 17781 001614'01 202 01 0 00 001262* movem t1, strbuf ; Stomp the string buffer 17782 001615'01 201 02 0 00 000001 movei t2, ^d1 ; Single character long 17783 001616'01 200 03 0 00 003706' move t3, [point 7, strbuf] ; Pointer to buffer 17784 001617'01 124 02 0 00 001260* dmovem t2, strc ; Stomp into search string parameters 17785 001620'01 endif. ; Carry on 17786 17787 001620'01 202 06 0 00 000065* movem q2, pars2 ; Store the JFN and flags 17788 001621'01 476 00 0 00 000423* setom pars6 ;[209] Override the ^C handling 17789 17790 001622'01 263 17 0 00 000000 ret ; Done with the parse 17791 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 26 K20IOC MAC 20-Jan-23 21:49 TRANSMIT [file] parsing [165] 17792 remark Here for common parse errors 17793 17794 001623'01 200 01 0 00 000000# .trane: emsg ; Begin whining 17795 001624'01 104 00 0 00 000313 17796 000173'02 000000000000# 17797 000512'04 124 150 145 040 000 17798 001625'01 201 01 0 00 000101 movei t1, .priou ; Output to terminal, always 17799 17800 remark ; N.B., JFNS% will choke on a device 17801 001626'01 302 05 0 00 000016 caie q1, .cmdev ; Device? 17802 001627'01 254 00 0 00 001640' ifskp. ; Yes, use DEVST% 17803 001630'01 200 02 0 00 000006 move t2, q2 ; Load whatever we parsed 17804 001631'01 104 00 0 00 000121 DEVST% ; Write the device name into the AC's 17805 001632'01 320 12 0 00 001634' %jserr (,cmder1) 17806 001633'01 254 00 0 00 001637' 17807 001634'01 265 01 0 00 001556* 17808 001635'01 000000000000# 17809 001636'01 254 00 0 00 001575* 17810 000513'04 125 156 141 142 154 17811 001637'01 254 00 0 00 001650' else. ; Otherwise, DEVST% will choke on the JFN 17812 001640'01 550 02 0 00 000006 hrrz t2, q2 ; Load just the JFN 17813 dmove t3, [ ; Just want the device name, no punctuation 17814 fld(.jsaof,js%dev) 17815 001641'01 120 03 0 00 004031' 0 ] ; No odd prefix, whatever that is 17816 001642'01 104 00 0 00 000030 JFNS% ; Convert to something readable 17817 001643'01 320 12 0 00 001645' %jserr (,cmder1) 17818 001644'01 254 00 0 00 001650' 17819 001645'01 265 01 0 00 001634* 17820 001646'01 000000000000# 17821 001647'01 254 00 0 00 001636* 17822 000523'04 125 156 141 142 154 17823 001650'01 endif. ; Either way, error should be more informative 17824 17825 001650'01 200 01 0 00 000000# txmsg <: device is not valid for TRANSMIT or CAPTURE> 17826 001651'01 104 00 0 00 000076 17827 001652'01 320 12 0 00 001653' 17828 000174'02 000000000000# 17829 000535'04 072 040 144 145 166 17830 001653'01 561 01 0 00 000406* hrroi t1, crlf ; Newline 17831 001654'01 104 00 0 00 000076 PSOUT% ; Tie off the blat 17832 001655'01 320 12 0 00 001656' erjmpr .+1 ; Catch and ignore that error, too 17833 17834 001656'01 302 05 0 00 000006 caie q1, .cmfil ; Had we parsed a file, actually? 17835 001657'01 254 00 0 00 001663' ifskp. ; Yes, then have a little clean up to do 17836 001660'01 550 01 0 00 000006 hrrz t1, q2 ; Load our poor JFN, sans flags 17837 001661'01 104 00 0 00 000023 RLJFN% ; Toss it; can't use it 17838 001662'01 320 12 0 00 001647* erjmpr cmder1 ; Ignore error and beat it 17839 001663'01 endif. 17840 17841 001663'01 254 00 0 00 001662* jrst cmder1 ; Allow ^H 17842 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 27 K20IOC MAC 20-Jan-23 21:49 TRANSMIT command execution. 17843 subttl TRANSMIT command execution. 17844 17845 ; To do: Instead of repeated SIN%'s, how about a moby-PMAP% and MOVST? 17846 17847 001664'01 $trans: entry $trans ; Called by k20par 17848 extern mycaps ;[223] Expose capability vector 17849 001664'01 265 16 0 00 004005' saveac ;[209] Needs much registers 17850 17851 001665'01 550 01 0 00 001620* hrrz t1, pars2 ;[209] First make sure we can open the file. 17852 001666'01 202 01 0 00 000000* movem t1, filjfn ;[209] Store in case we need to release 17853 001667'01 302 01 0 00 377777 caie t1, .nulio ;[209] Don't need to open .nulio 17854 001670'01 254 00 0 00 001674' ifskp. ;[229] But give it some fake data 17855 001671'01 403 01 0 00 000002 setzb t1, t2 ;[229] It will have a zero bytes and pages 17856 001672'01 124 01 0 00 000000# dmovem t1, fsized ;[229] Store in file size double word 17857 001673'01 254 00 0 00 001744' else. ;[209] Otherwise must open it 17858 001674'01 104 00 0 00 000036 SIZEF% ;[229] Find out how large the file is 17859 001675'01 320 12 0 00 001677' ifje. r ;[229] Failed?? 17860 001676'01 254 00 0 00 001711' 17861 001677'01 200 04 0 00 000001 move t4, t1 ;[229] Save error for debuggers 17862 001700'01 334 00 0 00 000000 %ermsg (,) ;[229] 17863 001701'01 254 00 0 00 001705' 17864 001702'01 265 01 0 00 001645* 17865 001703'01 000000000000# 17866 001704'01 254 00 0 00 001705' 17867 000547'04 125 156 141 142 154 17868 001705'01 403 02 0 00 000003 setzb t2, t3 ;[229] Cons up a set of zeros 17869 001706'01 124 02 0 00 000000# dmovem t2, fsized ;[229] Store in file size double word 17870 001707'01 200 01 0 00 001666* move t1, filjfn ;[229] Reload the JFN and hope for the best 17871 001710'01 254 00 0 00 001712' else. ;[229] Otherwise, worked!!!! 17872 001711'01 124 02 0 00 000000# dmovem t2, fsized ;[229] So store results in file size double word 17873 001712'01 endif. ;[229] End case JSYS handling 17874 dmove t2, [1,,.fbbyv ;[229] Let's have a look at the byte size 17875 001712'01 120 02 0 00 004033' t4 ] ;[229] Tuck it into t4 17876 001713'01 104 00 0 00 000063 GTFDB% ;[229] Try to pull from file descriptor block 17877 001714'01 320 12 0 00 001716' ifje. r ;[229] Failed?? 17878 001715'01 254 00 0 00 001722' 17879 001716'01 200 04 0 00 000001 move t4, t1 ;[229] Save the error for debuggers 17880 001717'01 201 03 0 00 000007 movei t3, ^d7 ;[229] Ignore it and pretend ASCII 17881 001720'01 550 01 0 00 001665* hrrz t1, pars2 ;[229] Reload JFN for OPENF% attempt 17882 001721'01 254 00 0 00 001723' else. ;[229] Otherwise, worked 17883 001722'01 135 03 0 00 004035' ldb t3,[ pointr(t4,fb%bsz) ] ;[229] Extract byte size from packed field 17884 001723'01 endif. ;[229] End case JSYS handling 17885 001723'01 200 02 0 00 004036' movx t2, fld(7,of%bsz)!of%rd ; Assume 7-bit (also handles 36 bit PA1050) 17886 001724'01 306 03 0 00 000010 cain t3, ^d8 ;[229] Is our assumption incorrect? 17887 001725'01 200 02 0 00 004037' movx t2, fld(8,of%bsz)!of%rd ;[223] Fine, it's eight bit 17888 001726'01 104 00 0 00 000021 OPENF% 17889 001727'01 320 12 0 00 001731' ifje. r ;[209] Failed?? 17890 001730'01 254 00 0 00 001744' 17891 001731'01 200 04 0 00 000001 move t4, t1 ;[209] Save error code for debugging 17892 001732'01 334 00 0 00 000000 %ermsg (,) ;[209] Squawk and continue 17893 001733'01 254 00 0 00 001737' 17894 001734'01 265 01 0 00 001702* 17895 001735'01 000000000000# 17896 001736'01 254 00 0 00 001737' 17897 000561'04 125 156 141 142 154 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 27-1 K20IOC MAC 20-Jan-23 21:49 TRANSMIT command execution. 17898 001737'01 402 00 0 00 001707* setzm filjfn ;[209] Stomp JFN global storage 17899 001740'01 550 01 0 00 001720* hrrz t1, pars2 ;[209] Reload the JFN 17900 001741'01 260 17 0 00 000000* call frclos ;[209] Force it closed 17901 001742'01 600 00 0 00 000000 nop ;[209] Ignore error and carry on 17902 001743'01 263 17 0 00 000000 ret ;[209] And return; we can't do anything else 17903 001744'01 endif. ;[209] End case OPENF% JSYS error handling 17904 001744'01 endif. ;[209] End case .nulio OPENF% decision 17905 17906 remark ;[209] .trans gets and decodes a prompt (search) string 17907 17908 001744'01 400 11 0 00 000000 $tran1: setz q5, ;[209] Assume not in a batch job that needs fixup 17909 001745'01 336 00 0 00 001617* skipn strc ;[209] Of couse, don't bother if no search string... 17910 001746'01 254 00 0 00 002011' jrst $tran2 ;[209] There won't be anything to fix up 17911 001747'01 332 00 0 00 001474* skipe pars8 ;[229] Nor if we were told to shut up 17912 001750'01 254 00 0 00 002011' jrst $tran2 ;[229] User typed a /SILENT 17913 001751'01 336 00 0 00 000000# skipn ;[209] Now then, are we a batch job? 17914 001752'01 254 00 0 00 002011' jrst $tran2 ;[209] No, so we don't care about BATCON confusion 17915 ;[209] Otherwise, REALLY long lines are bad ... 17916 001753'01 120 01 0 00 001745* dmove t1, strc ;[209] Load the search string count and pointer 17917 001754'01 415 16 0 00 002007' block. ;[209] Enter block context for better control flow 17918 001755'01 261 17 0 00 000016 17919 001756'01 306 01 0 00 000001 cain t1, ^d1 ;[209] A single character?? 17920 001757'01 254 00 0 00 001510* retskp ;[209] Whatever it is, it needs to get tied off 17921 ;[209] A tiny hack: ibp is faster than adjbp 17922 001760'01 302 01 0 00 000003 caie t1, ^d3 ;[209] Is it EXACTLY three characters in length? 17923 001761'01 254 00 0 00 001764' ifskp. ;[209] It is, so handle this more efficiently 17924 001762'01 133 00 0 00 000002 ibp t2 ;[209] Positions us to the first byte 17925 001763'01 275 01 0 00 000001 subi t1, ^d1 ;[209] So ildb in case two works right 17926 001764'01 endif. ;[209] Fall through to case two 17927 17928 001764'01 302 01 0 00 000002 caie t1, ^d2 ;[209] A two character sequence, then? 17929 001765'01 254 00 0 00 001775' ifskp. ;[209] Yes, let's see if that's OK 17930 001766'01 134 03 0 00 000002 ildb t3, t2 ;[209] Let's get the first character 17931 001767'01 302 03 0 00 000015 caie t3, .chcrt ;[209] Carriage return? 17932 001770'01 254 00 0 00 001757* retskp ;[209] Nope, then batch output needs a 17933 001771'01 134 03 0 00 000002 ildb t3, t2 ;[209] Let's get the second character 17934 001772'01 302 03 0 00 000012 caie t3, .chlfd ;[209] And was that a linefeed? 17935 001773'01 254 00 0 00 001770* retskp ;[209] Nope, then batch output needs a 17936 001774'01 263 17 0 00 000000 ret ;[209] ! Batch log will be tidy 17937 001775'01 endif. ;[209] End case, a search string of two characters 17938 ;[209] Note: ldb, ildb is faster than ildb, ildb 17939 001775'01 275 01 0 00 000001 subi t1, ^d1 ;[209] Going to look at the last two characters (!!) 17940 001776'01 133 01 0 00 000002 adjbp t1, t2 ;[209] Position right on the penultimate 17941 001777'01 135 03 0 00 000001 ldb t3, t1 ;[209] Let's get the penultimate character 17942 002000'01 302 03 0 00 000015 caie t3, .chcrt ;[209] Carriage return? 17943 002001'01 254 00 0 00 001773* retskp ;[209] Nope, then batch output needs a 17944 002002'01 134 03 0 00 000001 ildb t3, t1 ;[209] Let's get the final character 17945 002003'01 302 03 0 00 000012 caie t3, .chlfd ;[209] And was that a linefeed? 17946 002004'01 254 00 0 00 002001* retskp ;[209] Nope, then batch output needs a 17947 002005'01 263 17 0 00 000000 ret ;[209] Final two are ! Batch log will be tidy 17948 002006'01 263 17 0 00 000000 endbk. ;[209] End block context 17949 002007'01 254 00 0 00 002011' ifskp. ;[209] Skip return means needs a 17950 002010'01 474 11 0 00 000000 seto q5, ;[209] So flag that for down stream 17951 002011'01 endif. ;[209] End block skip stanza 17952 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 27-2 K20IOC MAC 20-Jan-23 21:49 TRANSMIT command execution. 17953 002011'01 260 17 0 00 000000* $tran2: call clrbuf ;[229] Clear out any crud before searching 17954 002012'01 254 00 0 00 002201' jrst $tranx ;[229] If failed, just stop doing this 17955 002013'01 337 02 0 00 000420* skipg t2, pars4 ;[229] Integer milliseconds 17956 002014'01 254 00 0 00 002017' ifskp. ;[229] Wants time outs, so set them 17957 002015'01 201 01 0 00 002260' movei t1, $trant ;[229] Where to go die on a time out 17958 002016'01 260 17 0 00 000261* call timeon ;[229] Set the timer for it 17959 002017'01 endif. ;[229] 17960 002017'01 260 17 0 00 000264* call ccon ; Turn on ^C trap 17961 002020'01 254 00 0 00 002201' jrst $tranx ; Where to go upon ^C. 17962 002021'01 332 00 0 00 000414* ifme. vtermf ;[186] Calls only make sense if not virtual 17963 002022'01 254 00 0 00 002027' 17964 002023'01 260 17 0 00 000000* call doarpa ;[186] If on a TVT, set up to allow binary 17965 002024'01 260 17 0 00 000272* call dobits ; Condition the line. 17966 002025'01 254 00 0 00 002201' jrst $tranx 17967 002026'01 260 17 0 00 000274* call ttyob ; Let controlling tty output binary. 17968 002027'01 endif. ;[186] Otherwise, MTOPR%'s might break! 17969 002027'01 201 01 0 00 002060' movei t1, $tran3 ; Where to go if ^M typed (send next) 17970 002030'01 202 01 0 00 000000* movem t1, cmloc ; ... 17971 002031'01 201 01 0 00 002116' movei t1, $tran4 ; Where to go if ^P typed (resend previous) 17972 002032'01 202 01 0 00 000000* movem t1, cploc ; ... 17973 002033'01 260 17 0 00 000000* call cmpon ; Enable interrupts on ^M, ^P. 17974 txmsg < 17975 002034'01 200 01 0 00 000000# [KERMIT-20: Transmitting > ; Tell user we're starting. 17976 002035'01 104 00 0 00 000076 17977 002036'01 320 12 0 00 002037' 17978 000175'02 000000000000# 17979 000567'04 015 012 133 113 105 17980 002037'01 201 01 0 00 000101 movei t1, .priou 17981 002040'01 200 02 0 00 001737* move t2, filjfn 17982 002041'01 403 03 0 00 000004 setzb t3, t4 ;[209] No screwy prefix... 17983 002042'01 104 00 0 00 000030 JFNS 17984 002043'01 320 12 0 00 002044' erjmpr .+1 17985 txmsg < 17986 If stuck, type: 17987 Carriage Return to send next line, 17988 ^P to resend current line, 17989 002044'01 200 01 0 00 000000# > ;[187] 17990 002045'01 104 00 0 00 000076 17991 002046'01 320 12 0 00 002047' 17992 000176'02 000000000000# 17993 000575'04 015 012 040 111 146 17994 17995 17996 17997 dmove t3, [ byte (7) .chspc, "^", "C", "^", "C" 17998 002047'01 120 03 0 00 004040' byte (7) .chspc, .chnul ] ;[187] Assume default 17999 002050'01 200 02 0 00 000000# move t2, mycaps+1 ;[187] Load enabled capabilities 18000 002051'01 607 02 0 00 400000 txnn t2, sc%ctc ;[187] Is Control-C turned on?? 18001 dmove t3, [ byte (7) .chspc, "^", "G", "^", "G" 18002 002052'01 120 03 0 00 004042' byte (7) .chspc, .chnul ] ;[187] Wasn't... 18003 002053'01 561 01 0 00 000003 hrroi t1, t3 ;[187] Point to proper text 18004 002054'01 104 00 0 00 000076 PSOUT% ;[187] Tell them what to type 18005 txmsg 18007 002056'01 104 00 0 00 000076 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 27-3 K20IOC MAC 20-Jan-23 21:49 TRANSMIT command execution. 18008 002057'01 320 12 0 00 002060' 18009 000177'02 000000000000# 18010 000617'04 164 157 040 143 141 18011 18012 ;... K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 28 K20IOC MAC 20-Jan-23 21:49 TRANSMIT command execution. 18013 18014 ; Get a line from the file. 18015 18016 002060'01 336 00 0 00 000000* $tran3: ifmn. cmseen ;[194] ^M typed? 18017 002061'01 254 00 0 00 002066' 18018 txmsg < Sending next...] 18019 002062'01 200 01 0 00 000000# > ; Yes, type msg 18020 002063'01 104 00 0 00 000076 18021 002064'01 320 12 0 00 002065' 18022 000200'02 000000000000# 18023 000625'04 040 123 145 156 144 18024 18025 002065'01 402 00 0 00 002060* setzm cmseen ; and unset flag. 18026 002066'01 endif. ;[194] 18027 18028 002066'01 200 01 0 00 002040* move t1, filjfn ; Input file pointer 18029 remark t2, *MAGIC* ;[229] N.B., Below converts 7 to 8 bit! 18030 002067'01 200 02 0 00 004044' move t2, [point 8, strbf2] ; Where to put the line 18031 dmove t3, [ strblc ;[209] Maximum characters to read, 18032 002070'01 120 03 0 00 004045' .chlfd ] ;[209] but preferably terminate on linefeed. 18033 002071'01 104 00 0 00 000052 SIN 18034 002072'01 320 12 0 00 002074' ifje. r. ;[194] Catch last error in t1 18035 002073'01 254 00 0 00 002105' 18036 002074'01 550 02 0 00 000001 hrrz t2,t1 ; Erase fork handle from left half. 18037 002075'01 302 02 0 00 600220 caie t2, iox4 ; Was error EOF? 18038 002076'01 334 00 0 00 000000 %ermsg (,$tranx) ; No, give message. 18039 002077'01 254 00 0 00 002103' 18040 002100'01 265 01 0 00 001734* 18041 002101'01 000000 000000 18042 002102'01 254 00 0 00 002201' 18043 002103'01 260 17 0 00 002302' call tranot ;[229] Notify us of transmit completion 18044 002104'01 254 00 0 00 002201' jrst $tranx ; But either way, we are done 18045 002105'01 endif. ;[194] 18046 18047 002105'01 323 03 0 00 002111' ifg. t3 ;[209] Did we hit the linefeed? 18048 002106'01 201 10 0 00 005000 movei q4, strblc ;[209] Yes, so need to do post calculations 18049 002107'01 274 10 0 00 000003 sub q4, t3 ;[209] Calculate amount done 18050 002110'01 254 00 0 00 002112' else. ;[209] Otherwise, don't need to do any math 18051 002111'01 201 10 0 00 005000 movei q4, strblc ;[209] Put in maximum length 18052 002112'01 endif. ;[209] 18053 18054 ; N.B., This code appears to assume a particular kind of Tops-20 18055 ; formatted text file in other words, the STANDARD kind that is 18056 ; used on *ALL* DEC operating systems and in many cases on DOS, 18057 ; OS/2 and Windows. That is, a series of variable length lines 18058 ; terminated by a carriage return and a line feed. 18059 ; 18060 ; However, if you have a Unix or Multics 18061 ; format file with bare linefeed, then this code does the wrong 18062 ; thing because it will strip them all out, giving one big long 18063 ; line. It may also do the wrong thing for consecutive linefeeds. 18064 ; This is very old behavior. 18065 ; 18066 ; If this is in fact a bug or misfeature, then the fix is 18067 ; straightforward in concept (yet not in implementation). We'd K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 28-1 K20IOC MAC 20-Jan-23 21:49 TRANSMIT command execution. 18068 ; need to PMAP% the file and then use a MOVST to trigger on a 18069 ; carriage return and check after it for a linefeed. If the 18070 ; linefeed existed, then we'd strip it, otherwise, this would be a 18071 ; case of overprinting, which still might work right. Bare 18072 ; linefeed's would be left alone. 18073 ; 18074 ; Leave alone for now until better understand the reason for 18075 ; swallowing trailing linefeeds. 18076 ; 18077 ; Changed to shorten the string length because we don't send NUL 18078 ; terminated strings, but rather counted ones. 18079 18080 repeat 0, < ;[229] Previous vestigial code 18081 ldb t1, t2 ;[209] Pick up the last character 18082 caie t1, .chlfd ;[209] Was it a LF? 18083 ibp t2 ;[209] No, so don't overwrite it. 18084 setz t1, ;[209] Deposit a null, overwriting 18085 call @parity ;[223] Put parity on this last dinky character 18086 dpb t1, t2 ; last char if it was a LF. 18087 > ;[229] 18088 18089 002112'01 135 01 0 00 000002 ldb t1, t2 ;[229] Pick up the final character 18090 002113'01 302 01 0 00 000012 caie t1, .chlfd ;[229] Was it a linefeed? 18091 002114'01 254 00 0 00 002116' ifskp. ;[229] It is, so don't send it 18092 002115'01 363 10 0 00 002060' sojle q4, $tran3 ;[229] Decrement the count and skip if nothing left 18093 002116'01 endif. ;[229] Still, positive, so something to do K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 29 K20IOC MAC 20-Jan-23 21:49 TRANSMIT command execution. 18094 18095 ; TRANSMIT, cont'd... Echo the string if necessary. 18096 18097 002116'01 336 00 0 00 000000* $tran4: ifmn. cpseen ;[194] ^P typed? 18098 002117'01 254 00 0 00 002124' 18099 txmsg < - Resending... 18100 002120'01 200 01 0 00 000000# > ; Yes, type msg 18101 002121'01 104 00 0 00 000076 18102 002122'01 320 12 0 00 002123' 18103 000201'02 000000000000# 18104 000631'04 040 055 040 122 145 18105 18106 002123'01 402 00 0 00 002116* setzm cpseen ; and unset flag. 18107 002124'01 endif. ;[194] 18108 18109 002124'01 $tran5: remark ;[223] Tack on desired parity, in place (if desired) 18110 002124'01 200 01 0 00 001467* move t1, parity ;[223] Pick up the parity 18111 002125'01 306 01 0 00 003341' cain t1, none ;[223] Doing any parity anyway? 18112 002126'01 254 00 0 00 002132' ifskp. ;[223] We are, so do some parity already ... 18113 002127'01 200 02 0 00 004044' move t2, [point 8, strbf2] ; Point to the string. 18114 002130'01 210 03 0 00 000010 movn t3, q4 ;[223] Load negative for SOUTR% 18115 002131'01 260 17 0 00 003544' call putpar ;[223] Stomp some parity into it 18116 002132'01 endif. ;[223] End case handling parity 18117 18118 002132'01 336 00 0 00 001407* skipn duplex ; Half duplex? 18119 002133'01 254 00 0 00 002141' jrst $tran6 ;[223] No. 18120 002134'01 200 01 0 00 004044' move t1, [point 8, strbf2] ; Point to the string. 18121 002135'01 104 00 0 00 000076 PSOUT ; Yes, display it at the tty. 18122 002136'01 201 01 0 00 000012 movei t1, .chlfd ; Also need to add linefeed. 18123 002137'01 260 17 1 00 002124* call @parity ; And any necessary parity 18124 002140'01 104 00 0 00 000074 PBOUT 18125 18126 002141'01 $tran6: remark ;[223] Finally send the string 18127 002141'01 337 01 0 00 001356* skipg t1, netjfn ;[186] ... out the communication line. 18128 002142'01 200 01 0 00 001357* move t1, ttyjfn ;[186] using local terminal 18129 002143'01 200 02 0 00 004044' move t2, [point 8, strbf2] 18130 002144'01 210 03 0 00 000010 movn t3, q4 ;[223] Load count 18131 18132 002145'01 332 00 0 00 002021* ifme. vtermf ;[186] Not a virtual terminal? 18133 002146'01 254 00 0 00 002156' 18134 002147'01 104 00 0 00 000053 SOUT ;[186] Isn't, so olde reliable is fine 18135 002150'01 320 12 0 00 002152' %jserr (,$tranx) 18136 002151'01 254 00 0 00 002155' 18137 002152'01 265 01 0 00 002100* 18138 002153'01 000000 000000 18139 002154'01 254 00 0 00 002201' 18140 002155'01 254 00 0 00 002165' else. ;[186] Otherwise, have to get out and push 18141 002156'01 350 00 0 00 001403* aos vsoct ;[209] Count a SOUTR% done 18142 002157'01 104 00 0 00 000532 SOUTR% ;[186] 18143 002160'01 320 12 0 00 002162' %jserr (,$tranx) ;[186] 18144 002161'01 254 00 0 00 002165' 18145 002162'01 265 01 0 00 002152* 18146 002163'01 000000 000000 18147 002164'01 254 00 0 00 002201' 18148 002165'01 endif. ;[186] K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 29-1 K20IOC MAC 20-Jan-23 21:49 TRANSMIT command execution. 18149 18150 002165'01 336 00 0 00 002145* ifmn. vtermf ;[209] Only update virtual terminal totals 18151 002166'01 254 00 0 00 002172' 18152 002167'01 272 10 0 00 001404* addm q4, vsotc ;[204] Update tally of SOUTR% bytes 18153 002170'01 313 10 0 00 001406* camle q4, vsomx ;[204] Length than or equal to the maximum seen? 18154 002171'01 202 10 0 00 002170* movem q4, vsomx ;[204] Nope, we have a new maximum! 18155 002172'01 endif. ;[209] 18156 18157 ;[209] Now look for the prompt. Note that everything is echo'ed because 18158 ; this is what Kermit-20 has always done. However, since CAPTURE doesn't 18159 ; echo anything (for performance purposes), all we should see here is 18160 ; the prompt. Or an error... 18161 18162 002172'01 336 00 0 00 001753* $tran7: skipn strc ;[229] But!! Are we doing any recognition, anyway? 18163 002173'01 254 00 0 00 002060' jrst $tran3 ;[229] No, so just go on blatting 18164 002174'01 260 17 0 00 000254' call $input ;[209] Let $INPUT drive the bus now 18165 002175'01 322 11 0 00 002200' ifn. q5 ;[209] Batch log needs to get tied off? 18166 002176'01 561 01 0 00 001653* hrroi t1, crlf ;[209] Yes, so load that 18167 002177'01 104 00 0 00 000076 PSOUT% ;[209] and type it 18168 002200'01 endif. ;[209] End batch log line tie off 18169 002200'01 254 00 0 00 002060' jrst $tran3 ;[209] Returns on the prompt 18170 18171 ; Done, call terminal restore routines in reverse order. 18172 18173 002201'01 260 17 0 00 000000* $tranx: call cmpoff ; ^M, ^P interrupts off. 18174 002202'01 260 17 0 00 000413* call ccoff2 ; ^C trap off. 18175 002203'01 336 01 0 00 001470* skipn t1, pars7 ;[229] Did we have an EOF character? 18176 002204'01 254 00 0 00 002240' ifskp. ;[229] We did, let's get it sent 18177 002205'01 241 01 0 00 777770 rot t1, -^d8 ;[229] Turn into an 8 bit ASCIZ string (heh) 18178 002206'01 200 05 0 00 000001 move q1, t1 ;[229] And get it out of SOUTR%'s way 18179 002207'01 201 01 0 00 000015 movei t1, .chcrt ;[229] Load a carriage return 18180 002210'01 260 17 1 00 002137* call @parity ;[229] Put parity on that (if doing parity) 18181 002211'01 241 01 0 00 777760 rot t1, -^d16 ;[229] Turn into 2nd byte of 8 bit ASCIZ string 18182 002212'01 434 05 0 00 000001 or q1, t1 ;[229] 'append' it (heh) 18183 002213'01 337 01 0 00 002141* skipg t1, netjfn ;[229] Will go out the network 18184 002214'01 200 01 0 00 002142* move t1, ttyjfn ;[229] or using the local terminal 18185 dmove t2, [ ;[229] Set up for SOUTR% 18186 point 8, q1 ;[229] Output string is in q1 18187 002215'01 120 02 0 00 004047' -2 ] ;[229] Just two dinky characters 18188 002216'01 400 04 0 00 000000 setz t4, ;[229] Should be ignored, but just in case 18189 002217'01 332 00 0 00 002165* ifme. vtermf ;[229] Going to a real terminal? 18190 002220'01 254 00 0 00 002232' 18191 002221'01 104 00 0 00 000053 SOUT% ;[229] Yes, so counted SOUT% will be fine 18192 002222'01 320 12 0 00 002224' %jserr (,) ;[229] Complain and carry on 18193 002223'01 254 00 0 00 002227' 18194 002224'01 265 01 0 00 002162* 18195 002225'01 000000 000000 18196 002226'01 254 00 0 00 002227' 18197 002227'01 260 17 0 00 000417* call ttyou ; Restore controlling tty. 18198 002230'01 260 17 0 00 000416* call unbits ; Put line back to previous state. 18199 002231'01 254 00 0 00 002240' else. ;[229] Otherwise, needs a 'push' 18200 002232'01 104 00 0 00 000532 SOUTR% ;[229] Counted string is faster 18201 002233'01 320 12 0 00 002235' %jserr (,) ;[229] Complain and carry on 18202 002234'01 254 00 0 00 002240' 18203 002235'01 265 01 0 00 002224* K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 29-2 K20IOC MAC 20-Jan-23 21:49 TRANSMIT command execution. 18204 002236'01 000000 000000 18205 002237'01 254 00 0 00 002240' 18206 002240'01 endif. ;[229] End case appropriate output selection 18207 002240'01 endif. ;[229] End case sending the EOF 18208 18209 002240'01 260 17 0 00 002011* call clrbuf ; Flush any junk they may have typed 18210 002241'01 600 00 0 00 000000 nop ;[186] Ignore any complaints 18211 002242'01 332 00 0 00 002217* ifme. vtermf ;[186] Calls only make sense if not virtual 18212 002243'01 254 00 0 00 002246' 18213 002244'01 260 17 0 00 002227* call ttyou ; Restore controlling tty. 18214 002245'01 260 17 0 00 002230* call unbits ; Put line back to previous state. 18215 002246'01 endif. ;[186] Otherwise, MTOPR%'s might break! 18216 18217 002246'01 337 01 0 00 002066* skipg t1, filjfn ;[193] Close the file. 18218 002247'01 254 00 0 00 002255' ifskp. ;[193] If there was any 18219 002250'01 306 01 0 00 377777 cain t1, .nulio ;[193] Unless special NUL: 18220 002251'01 254 00 0 00 002255' anskp. ;[193] Which needs no releasing 18221 002252'01 621 01 0 00 777777 tlz t1, -1 ;[193] Turn off any bogus flags 18222 002253'01 260 17 0 00 001741* call frclos ;[209] Force the JFN to close 18223 002254'01 600 00 0 00 000000 nop ;[209] Ignore any errors 18224 002255'01 endif. ;[193] End case closing a real JFN 18225 002255'01 402 00 0 00 002246* setzm filjfn ; Zero the JFN holder. 18226 002256'01 260 17 0 00 000425' call $inpcl ;[229] Clean up $input's buffer 18227 002257'01 263 17 0 00 000000 ret 18228 18229 002260'01 $trant: remark ;[229] Here on a time out 18230 002260'01 333 04 0 00 002172* skiple t4, strc ;[229] No search string, then? 18231 002261'01 254 00 0 00 002265' ifskp. ;[229] Nope, just generic complaint 18232 002262'01 200 01 0 00 000000# emsg ;[229] Suitably vague.. 18233 002263'01 104 00 0 00 000313 18234 000202'02 000000000000# 18235 000635'04 124 162 141 156 163 18236 002264'01 254 00 0 00 002277' else. ;[229] Otherwise, provide a more helpful message 18237 002265'01 200 01 0 00 000000# emsg ;[229] Begin whining 18238 002266'01 104 00 0 00 000313 18239 000203'02 000000000000# 18240 000641'04 124 162 141 156 163 18241 dmove t1, [ .priou ;[229] continue typing on terminal 18242 002267'01 120 01 0 00 004051' point 7,strbuf ] ;[229] Point to search string 18243 002270'01 210 03 0 00 000004 movn t3, t4 ;[229] Load exact count to do 18244 002271'01 104 00 0 00 000053 SOUT% ;[229] Counted SOUT% is faster 18245 002272'01 320 12 0 00 002274' %jsErr (,) ;[229] Can't win ... 18246 002273'01 254 00 0 00 002277' 18247 002274'01 265 01 0 00 002235* 18248 002275'01 000000 000000 18249 002276'01 254 00 0 00 002277' 18250 002277'01 endif. ;[229] End case no prompt 18251 18252 002277'01 561 01 0 00 002176* hrroi t1, crlf ;[229] Have to tie off the line 18253 002300'01 104 00 0 00 000076 PSOUT% ;[229] 18254 002301'01 254 00 0 00 002201' jrst $tranx ;[229] Go shut everything down 18255 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 30 K20IOC MAC 20-Jan-23 21:49 Notify of transmission completion 18256 subttl Notify of transmission completion 18257 18258 ;N.B., The byte count isn't what we actually sent; it's what the 18259 ; file should show up as. 18260 18261 tranot: txmsg < 18262 002302'01 200 01 0 00 000000# [KERMIT-20: Transmit of > ;[229] Begin to tell us about it 18263 002303'01 104 00 0 00 000076 18264 002304'01 320 12 0 00 002305' 18265 000204'02 000000000000# 18266 000650'04 015 012 133 113 105 18267 18268 002305'01 200 02 0 00 002255* move t2, filjfn ;[229] Let's get ready to print the file name 18269 002306'01 302 02 0 00 377777 caie t2, .nulio ;[229] Just dumping it? 18270 002307'01 254 00 0 00 002314' ifskp. ;[229] Yes, so bum the JFNS% 18271 002310'01 200 01 0 00 000000# txmsg ;[229] (which won't work, anyway) 18272 002311'01 104 00 0 00 000076 18273 002312'01 320 12 0 00 002313' 18274 000205'02 000000000000# 18275 000656'04 116 125 114 072 000 18276 002313'01 254 00 0 00 002324' else. ;[229] Otherwise, have a real file (I hope) 18277 002314'01 201 01 0 00 000101 movei t1, .priou ;[229] Continue to display on the terminal 18278 002315'01 403 03 0 00 000004 setzb t3, t4 ;[229] No special formatting or goofy prefix 18279 002316'01 104 00 0 00 000030 JFNS% ;[229] Let's see the file name 18280 002317'01 320 12 0 00 002321' %jsErr (,) ;[229] 18281 002320'01 254 00 0 00 002324' 18282 002321'01 265 01 0 00 002274* 18283 002322'01 000000000000# 18284 002323'01 254 00 0 00 002324' 18285 000657'04 103 157 165 154 144 18286 002324'01 endif. ;[229] End case displaying the file name 18287 18288 002324'01 200 01 0 00 000000# txmsg < complete> ;[229] Prepare to blat the file length 18289 002325'01 104 00 0 00 000076 18290 002326'01 320 12 0 00 002327' 18291 000206'02 000000000000# 18292 000667'04 040 143 157 155 160 18293 002327'01 337 02 0 00 000000# skipg t2, fsized ;[229] Load the size of the file in bytes 18294 002330'01 254 00 0 00 002350' ifskp. ;[229] Actually had some data 18295 002331'01 200 01 0 00 000000# txmsg <, > ;[229] Punctuate for some data 18296 002332'01 104 00 0 00 000076 18297 002333'01 320 12 0 00 002334' 18298 000207'02 000000000000# 18299 000671'04 054 040 000 000 000 18300 002334'01 201 01 0 00 000101 movei t1, .priou ;[229] Continue to display on the terminal 18301 002335'01 201 03 0 00 000012 movei t3, ^d10 ;[229] File sizes are always base 10 18302 002336'01 104 00 0 00 000224 NOUT% ;[229] Finally type our length 18303 002337'01 320 12 0 00 002341' %jsErr (,) ;[229] 18304 002340'01 254 00 0 00 002344' 18305 002341'01 265 01 0 00 002321* 18306 002342'01 000000000000# 18307 002343'01 254 00 0 00 002344' 18308 000672'04 103 157 165 154 144 18309 002344'01 200 01 0 00 000000# txmsg < characters> ;[229] However, we clipped a lot of linefeeds 18310 002345'01 104 00 0 00 000076 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 30-1 K20IOC MAC 20-Jan-23 21:49 Notify of transmission completion 18311 002346'01 320 12 0 00 002347' 18312 000210'02 000000000000# 18313 000702'04 040 143 150 141 162 18314 002347'01 254 00 0 00 002356' else. ;[229] Otherwise, nothing there 18315 002350'01 200 01 0 00 002305* move t1, filjfn ;[229] But!! Do we actually care? 18316 002351'01 306 01 0 00 377777 cain t1, .nulio ;[229] Just dumping stuff? 18317 002352'01 254 00 0 00 002356' anskp. ;[229] Yes, so NUL: really only has one size... 18318 002353'01 200 01 0 00 000000# txmsg <(empty file)> ;[229] Nothing there... 18319 002354'01 104 00 0 00 000076 18320 002355'01 320 12 0 00 002356' 18321 000211'02 000000000000# 18322 000705'04 050 145 155 160 164 18323 002356'01 endif. ;[229] End case 18324 18325 txmsg <] 18326 002356'01 200 01 0 00 000000# > ;[229] Finish reassuring user 18327 002357'01 104 00 0 00 000076 18328 002360'01 320 12 0 00 002361' 18329 000212'02 000000000000# 18330 000710'04 135 015 012 000 000 18331 002361'01 263 17 0 00 000000 ret ;[229] Finally done 18332 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 31 K20IOC MAC 20-Jan-23 21:49 CAPTURE Parsing logic 18333 subttl CAPTURE Parsing logic 18334 18335 ;[229] Begin code insertion 18336 18337 ;[229] %table puts stuff in the correct .psect 18338 18339 000213'02 000000 000000 %table (capswi) ; The capture switch table 18340 000214'02 000000# 000000 %key2 , %eofsw ; The EOF switch parses a restricted token set 18341 000045'03 105 117 106 000 000 18342 000215'02 000000# 000002 %key2 , %timsw ; In case we don't want to wait forever ... 18343 000046'03 164 151 155 145 157 18344 000213'02 000002 000002 %tbend ; End of table 18345 18346 002362'01 000000000000# captfs: flddb. .cmswi,,capswi,,,tranfd ; Maybe get a capture switch 18347 002363'01 000000000000# 18348 18349 ; Default command filespec fields for .CMFIL. These are only given 18350 ; so that we may get the flags returned by GTJFN% (which are currently 18351 ; unused) 18352 18353 chgsec(code,const) ;;GTJFN defaults are not in code, they're in const 18354 18355 000216'02 600020 777777 capbk: gj%flg!gj%fou!gj%new!fld(.gjnhg,.rhalf) ; .GJGEN 18356 000217'02 000100 000101 .priin,,.priou ; .GJSRC (ignored if COMND%) 18357 000220'02 000000 000000 0 ; .GJDEV (do not default the device) 18358 000221'02 000000 000000 0 ; .GJDIR (do not default the directory) 18359 000222'02 000000 000000 0 ; .GJNAM (do not default the name) 18360 000223'02 000000 000000 0 ; .GJEXT (do not default the extension) 18361 000224'02 000000 000000 0 ; .GJPRO (use system default protection) 18362 000225'02 000000 000000 0 ; .GJACT (use job's current account) 18363 000010 capbkl==<.-capbk> ; Length of this GTJFN argument block. 18364 retsec ;;Back to where-ever we started from 18365 18366 002364'01 .captu: entry .captu ; Linkage is from k20par 18367 002364'01 265 16 0 00 004005' saveac ; Protect some registers 18368 18369 002365'01 200 01 0 00 004025' movx t1, cz%ncl!.fhslf ; Release non-open JFN's on reparse 18370 002366'01 104 00 0 00 000034 CLZFF% 18371 002367'01 320 12 0 00 002370' erjmpr .+1 ; Catch and ignore errors 18372 18373 002370'01 200 01 0 00 004053' move t1, [capbk,,cjfnbk] ;Insert our file parsing 18374 002371'01 251 01 0 00 000000# blt t1, cjfnbk+capbkl ; defaults into the parse block 18375 18376 002372'01 201 11 0 00 002362' movei q5, captfs ; Load our initial parse file descriptor block 18377 002373'01 254 00 0 00 001443' callret .tran0 ; The rest of it parses exactly like TRANSMIT 18378 18379 ;[230] End code insertion 18380 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 32 K20IOC MAC 20-Jan-23 21:49 CAPTURE semantic action 18381 subttl CAPTURE semantic action 18382 18383 ;[230] Begin code insertion 18384 18385 003776 capmxl==<-2> ;;Maximum we can store, minus at end 18386 18387 remark ; Various linkages 18388 extern inilin ; Routine to condition line for capture 18389 extern rrslin ; Routine to decondition line 18390 extern ttipar ; Count of parity errors detected 18391 extern movchr ; Location of a movslj instruction 18392 18393 002374'01 $captu: entry $captu ; Linkage is from k20par 18394 002374'01 265 16 0 00 004054' saveac ; Protect a bunch of registers 18395 18396 002375'01 337 07 0 00 002213* skipg q3, netjfn ; Assuming getting a character from the network 18397 002376'01 200 07 0 00 002214* move q3, ttyjfn ; No network, so using local terminal 18398 002377'01 200 10 0 00 002203* move q4, pars7 ; Load EOF character (if any, which will have parity) 18399 002400'01 200 13 0 00 000010 move p3, q4 ; Make a 7 bit copy 18400 002401'01 405 13 0 00 000177 andi p3, ^o177 ; by stripping off any parity 18401 002402'01 201 01 0 00 000015 movei t1, .chcrt ; Load expected end of line 18402 002403'01 260 17 1 00 002210* call @parity ; Put parity on it (if doing parity) 18403 002404'01 200 12 0 00 000001 move p2, t1 ; and keep the result in p2 18404 ; Now set up to write the prompt easily 18405 002405'01 336 04 0 00 002260* skipn t4, strc ; Load the prompt length 18406 002406'01 254 00 0 00 002430' ifskp. ; If not zero, see about using it 18407 002407'01 316 07 0 00 002376* camn q3, ttyjfn ; Not going to the terminal? 18408 002410'01 254 00 0 00 002413' ifskp. ; No, so will be doing a SOUTR% 18409 002411'01 313 04 0 00 002171* camle t4, vsomx ; Length less than or equal to the maximum seen? 18410 002412'01 202 04 0 00 002411* movem t4, vsomx ; Nope, we have a new SOUTR% maximum! 18411 002413'01 endif. ; End case SOUTR% max update 18412 002413'01 200 01 0 00 002403* move t1, parity ; Load the parity 18413 002414'01 302 01 0 00 003341' caie t1, none ; But!! Not doing any parity? 18414 002415'01 254 00 0 00 002425' ifskp. ; No, so just 'expand' the byte width 18415 002416'01 200 01 0 00 000004 move t1, t4 ; The strings are the same length 18416 002417'01 403 03 0 00 000006 setzb t3, q2 ; Both are section zero local 18417 002420'01 200 02 0 00 003706' move t2, [point 7, strbuf] ; Source is 7 bit 18418 002421'01 200 05 0 00 004044' move q1, [point 8, strbf2] ; Destination is 8 bit 18419 002422'01 123 01 0 00 000000* extend t1, movchr ; Do the byte width expansion 18420 002423'01 600 00 0 00 000000 nop ; Ignore any odd non-skip 18421 002424'01 254 00 0 00 002430' else. ; Otherwise, have to do some real parity 18422 002425'01 210 03 0 00 000004 movn t3, t4 ; genpar wants a negative count (like SOUT%) 18423 002426'01 120 01 0 00 004072' dmove t1, [ exp , ] 18424 002427'01 260 17 0 00 003565' call genpar ; Rewrite the string as 8 bit (7 + 1 bit parity) 18425 002430'01 endif. ; End 7 to 8 bit conversion, possibly with parity 18426 002430'01 endif. ; End case network prompt length check 18427 18428 002430'01 550 01 0 00 001740* hrrz t1, pars2 ; Let's get the output file opened 18429 002431'01 202 01 0 00 002350* movem t1, filjfn ; Store JFN (sans flags) 18430 002432'01 306 01 0 00 377777 cain t1, .nulio ; Opening .nulio does work, but it's a waste of time 18431 002433'01 254 00 0 00 002453' ifskp. ; A real file, so let's get this thing open 18432 002434'01 200 02 0 00 004074' movx t2, fld(7,of%bsz)!of%wr ; 7-bit bytes, write-only (I.E., no append) 18433 002435'01 104 00 0 00 000021 OPENF% ; Try to create the file 18434 002436'01 320 12 0 00 002440' ifje. r ; Failed?? 18435 002437'01 254 00 0 00 002453' K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 32-1 K20IOC MAC 20-Jan-23 21:49 CAPTURE semantic action 18436 002440'01 200 04 0 00 000001 move t4, t1 ; Save error code for debugging 18437 002441'01 334 00 0 00 000000 %ermsg (,) ; Squawk and continue 18438 002442'01 254 00 0 00 002446' 18439 002443'01 265 01 0 00 002341* 18440 002444'01 000000000000# 18441 002445'01 254 00 0 00 002446' 18442 000711'04 125 156 141 142 154 18443 002446'01 402 00 0 00 002431* setzm filjfn ; Stomp JFN global storage 18444 002447'01 550 01 0 00 002430* hrrz t1, pars2 ; Reload the JFN 18445 002450'01 260 17 0 00 002253* call frclos ; Force it closed 18446 002451'01 600 00 0 00 000000 nop ; Ignore error and carry on 18447 002452'01 263 17 0 00 000000 ret ; And return; we can't do anything else 18448 002453'01 endif. ; End case OPENF% JSYS error handling 18449 002453'01 endif. ; End case skipping an OPENF% of .nulio 18450 18451 002453'01 260 17 0 00 002532' call caphrl ; Display the capture herald 18452 002454'01 260 17 0 00 002017* call ccon ; Turn on ^C trap 18453 002455'01 254 00 0 00 002526' jrst $capux ; Where to go upon ^C. 18454 002456'01 260 17 0 00 000000* call inilin ; Initialize the line for transfer 18455 18456 002457'01 do. ; Enter loop context 18457 002457'01 260 17 0 00 002673' call getcrt ; Get a carriage return terminated line of text 18458 002460'01 254 00 0 00 002526' jrst $capux ; On error, close the file and restore the line 18459 002461'01 260 17 0 00 003027' call eofovr ; Overwrite any EOF at the end of the string 18460 002462'01 200 01 0 00 002446* move t1, filjfn ; Load the file JFN 18461 002463'01 306 01 0 00 377777 cain t1, .nulio ; But!! Only going to toss it? 18462 002464'01 254 00 0 00 002476' ifskp. ; No, so do the write 18463 002465'01 323 14 0 00 002476' andg. p4 ; Unless we have nothing to write 18464 002466'01 200 02 0 00 003706' move t2,[point 7,strbuf] ;Source is the repacked string 18465 002467'01 210 03 0 00 000014 movn t3, p4 ; Load negative length because ... 18466 002470'01 104 00 0 00 000053 SOUT% ; Counted SOUT%'s are faster 18467 002471'01 320 12 0 00 002473' %jserr (,$capux) ; Complain and stop doing this 18468 002472'01 254 00 0 00 002476' 18469 002473'01 265 01 0 00 002443* 18470 002474'01 000000 000000 18471 002475'01 254 00 0 00 002526' 18472 002476'01 endif. ; End case writing the file (or tossing the data) 18473 002476'01 321 10 0 00 002526' jumpl q4, endlp. ; Break out of loop if allready hit EOF character 18474 002477'01 322 04 0 00 002457' jumpe t4, top. ; Don't print the prompt unless told to 18475 002500'01 336 05 0 00 002405* skipn q1, strc ; No search string, then? 18476 002501'01 254 00 0 00 002457' loop. ; No such luck, go get some more data 18477 002502'01 200 01 0 00 000007 move t1, q3 ; Load whatever transfer JFN we're using 18478 002503'01 200 02 0 00 004044' move t2,[point 8,strbf2] ;Point to search string 18479 002504'01 210 03 0 00 000005 movn t3, q1 ; Load exact count to do 18480 002505'01 312 01 0 00 002407* came t1, ttyjfn ; Going to the terminal? 18481 002506'01 254 00 0 00 002516' ifskp. ; Yes, that's easy enough 18482 002507'01 104 00 0 00 000053 SOUT% ; Boom, done 18483 002510'01 320 12 0 00 002512' %jserr (,$capux) ; or not... 18484 002511'01 254 00 0 00 002515' 18485 002512'01 265 01 0 00 002473* 18486 002513'01 000000 000000 18487 002514'01 254 00 0 00 002526' 18488 002515'01 254 00 0 00 002525' else. ; Otherwise, needs a poke to be on its way 18489 002516'01 104 00 0 00 000532 SOUTR% ; Write the network 18490 002517'01 320 12 0 00 002521' %jserr (,$capux) ; or not... K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 32-2 K20IOC MAC 20-Jan-23 21:49 CAPTURE semantic action 18491 002520'01 254 00 0 00 002524' 18492 002521'01 265 01 0 00 002512* 18493 002522'01 000000 000000 18494 002523'01 254 00 0 00 002526' 18495 002524'01 272 05 0 00 002167* addm q1, vsotc ; Update tally of SOUTR% bytes 18496 002525'01 endif. ; End case writing the terminal 18497 002525'01 254 00 0 00 002457' loop. ; Either way, go get some more goodies 18498 002526'01 enddo. ; Exit loop lexical context 18499 18500 002526'01 260 17 0 00 000000* $capux: call rrslin ; Turn ^C trap off, close file, clear buffer 18501 002527'01 561 01 0 00 002277* hrroi t1, crlf ;[229] Tie off line 18502 002530'01 104 00 0 00 000076 PSOUT% ;[229] So INPUT in Batch works 18503 002531'01 263 17 0 00 000000 ret ; Done 18504 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 33 K20IOC MAC 20-Jan-23 21:49 Display herald for capture command 18505 subttl Display herald for capture command 18506 18507 ; Call: 18508 ; 18509 ; strc/ Indicates we have a prompt string 18510 ; filjfn/ Wherever we're writing the captured data 18511 ; q4/ EOF character (if we have one) 18512 ; 18513 ; N.B., If we bum all the SOUT%'s with a movslj, it will have to get 18514 ; executed in section or the text will need to be in section zero 18515 18516 002532'01 201 01 0 00 000101 caphrl: movei t1, .priou ; Output is always the terminal 18517 dxtext (t2,< 18518 002533'01 120 02 0 00 000000# [KERMIT-20: Capturing to >) ;Tell user we're starting. 18519 000226'02 000000000000# 18520 000227'02 777777 777745 18521 000717'04 015 012 133 113 105 18522 002534'01 104 00 0 00 000053 SOUT% ; Counted SOUT% is faster 18523 002535'01 320 12 0 00 002537' %jsErr (,) ; Whine and continue 18524 002536'01 254 00 0 00 002542' 18525 002537'01 265 01 0 00 002521* 18526 002540'01 000000000000# 18527 002541'01 254 00 0 00 002542' 18528 000725'04 125 156 141 142 154 18529 002542'01 200 02 0 00 002462* move t2, filjfn ; Load the JFN 18530 002543'01 302 02 0 00 377777 caie t2, .nulio ; But!! Just tossing it? 18531 002544'01 254 00 0 00 002555' ifskp. ; Yes, can't JFNS% because it chokes on a device 18532 002545'01 120 02 0 00 000000# dxtext (t2,) ; Easy enough to 'translate' (heh) 18533 000230'02 000000000000# 18534 000231'02 777777 777774 18535 000735'04 116 125 114 072 000 18536 002546'01 104 00 0 00 000053 SOUT% ; Counted SOUT% is faster 18537 002547'01 320 12 0 00 002551' %jsErr (,) ; What? Eh? 18538 002550'01 254 00 0 00 002554' 18539 002551'01 265 01 0 00 002537* 18540 002552'01 000000000000# 18541 002553'01 254 00 0 00 002554' 18542 000736'04 125 156 141 142 154 18543 002554'01 254 00 0 00 002564' else. ; Otherwise, assume a bona fide JFN 18544 002555'01 403 03 0 00 000004 setzb t3, t4 ; Standard formatting, no goofball prefix... 18545 002556'01 104 00 0 00 000030 JFNS% ; Type it 18546 002557'01 320 12 0 00 002561' %jsErr (,) ; Whine & continue 18547 002560'01 254 00 0 00 002564' 18548 002561'01 265 01 0 00 002551* 18549 002562'01 000000000000# 18550 002563'01 254 00 0 00 002564' 18551 000745'04 125 156 141 142 154 18552 002564'01 endif. ; End case output device special casing 18553 18554 002564'01 322 10 0 00 002621' ifn. q4 ; Do we have an EOF character? 18555 002565'01 120 02 0 00 000000# dxtext (t2,<, EOF: >) ; We do, so load the herald 18556 000232'02 000000000000# 18557 000233'02 777777 777771 18558 000756'04 054 040 105 117 106 18559 002566'01 104 00 0 00 000053 SOUT% ; Counted SOUT is faster K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 33-1 K20IOC MAC 20-Jan-23 21:49 Display herald for capture command 18560 002567'01 320 12 0 00 002571' %jsErr (,) ; Whine and continue 18561 002570'01 254 00 0 00 002574' 18562 002571'01 265 01 0 00 002561* 18563 002572'01 000000000000# 18564 002573'01 254 00 0 00 002574' 18565 000760'04 125 156 141 142 154 18566 002574'01 200 02 0 00 000010 move t2, q4 ; Load the EOF character 18567 002575'01 405 02 0 00 000177 andi t2, ^o177 ; Stomp any parity 18568 002576'01 302 02 0 00 000033 caie t2, .chesc ; The escape character? 18569 002577'01 254 00 0 00 002602' ifskp. ; It is 18570 002600'01 201 02 0 00 000044 movei t2, "$" ; Replace it with our talisman 18571 002601'01 254 00 0 00 002613' else. ; Otherwise, it is a control character 18572 002602'01 201 03 0 02 000100 movei t3, <"A"-.chcna>(t2) ; Turn into ASCII and get out of the way 18573 002603'01 201 02 0 00 000136 movei t2, "^" ; Need the pointy up arrow 18574 002604'01 104 00 0 00 000051 BOUT% ; Type it 18575 002605'01 320 12 0 00 002607' %jsErr (,) ; Blat 18576 002606'01 254 00 0 00 002612' 18577 002607'01 265 01 0 00 002571* 18578 002610'01 000000000000# 18579 002611'01 254 00 0 00 002612' 18580 000766'04 125 156 141 142 154 18581 002612'01 200 02 0 00 000003 move t2, t3 ; Restore the character 18582 002613'01 endif. ; End case tweaking the EOF character for printing 18583 002613'01 104 00 0 00 000051 BOUT% ; Finally print whatever we made up 18584 002614'01 320 12 0 00 002616' %jsErr (,) ; Blat and continue 18585 002615'01 254 00 0 00 002621' 18586 002616'01 265 01 0 00 002607* 18587 002617'01 000000000000# 18588 002620'01 254 00 0 00 002621' 18589 000777'04 125 156 141 142 154 18590 002621'01 endif. ; End case printing EOF character 18591 18592 002621'01 336 00 0 00 002500* ifmn. strc ; Do we have a prompt string? 18593 002622'01 254 00 0 00 002642' 18594 002623'01 120 02 0 00 000000# dxtext (t2,<, prompt: >) ;we do, so type it 18595 000234'02 000000000000# 18596 000235'02 777777 777766 18597 001005'04 054 040 160 162 157 18598 002624'01 104 00 0 00 000053 SOUT% ; Counted SOUT% is faster 18599 002625'01 320 12 0 00 002627' %jsErr (,) ; Whine and continue 18600 002626'01 254 00 0 00 002632' 18601 002627'01 265 01 0 00 002616* 18602 002630'01 000000000000# 18603 002631'01 254 00 0 00 002632' 18604 001010'04 125 156 141 142 154 18605 002632'01 200 02 0 00 004044' move t2, [point 8, strbf2] ; Note, parity was put on the prompt 18606 002633'01 210 03 0 00 002621* movn t3, strc ; Load negative length because ... 18607 002634'01 104 00 0 00 000053 SOUT% ; a counted SOUT% is faster 18608 002635'01 320 12 0 00 002637' %jsErr (,); Whine and continue 18609 002636'01 254 00 0 00 002642' 18610 002637'01 265 01 0 00 002627* 18611 002640'01 000000000000# 18612 002641'01 254 00 0 00 002642' 18613 001020'04 125 156 141 142 154 18614 002642'01 endif. ; End case prompting K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 33-2 K20IOC MAC 20-Jan-23 21:49 Display herald for capture command 18615 18616 002642'01 120 02 0 00 000000# dxtext (t2,<, type: >) ; Note trailing space !! 18617 000236'02 000000000000# 18618 000237'02 777777 777770 18619 001030'04 054 040 164 171 160 18620 002643'01 104 00 0 00 000053 SOUT% ; Counted SOUT% is faster 18621 002644'01 320 12 0 00 002646' %jsErr (,); Whine and continue 18622 002645'01 254 00 0 00 002651' 18623 002646'01 265 01 0 00 002637* 18624 002647'01 000000000000# 18625 002650'01 254 00 0 00 002651' 18626 001032'04 125 156 141 142 154 18627 002651'01 120 02 0 00 000000# dxtext (t2,<^C^C>) ; Assume default 18628 000240'02 000000000000# 18629 000241'02 777777 777774 18630 001040'04 136 103 136 103 000 18631 002652'01 200 04 0 00 000000# move t4, mycaps+1 ; Load enabled capabilities 18632 002653'01 607 04 0 00 400000 txnn t4, sc%ctc ; Is Control-C on?? 18633 002654'01 120 02 0 00 000000# dxtext (t2,<^G^G>) ; Wasn't ... 18634 000242'02 000000000000# 18635 000243'02 777777 777774 18636 001041'04 136 107 136 107 000 18637 002655'01 104 00 0 00 000053 SOUT% ; Counted SOUT% is faster 18638 002656'01 320 12 0 00 002660' %jsErr (,) ; Whine and continue 18639 002657'01 254 00 0 00 002663' 18640 002660'01 265 01 0 00 002646* 18641 002661'01 000000000000# 18642 002662'01 254 00 0 00 002663' 18643 001042'04 125 156 141 142 154 18644 18645 dxtext (t2,< to finish] 18646 002663'01 120 02 0 00 000000# >) ; Note initial leading space !! 18647 000244'02 000000000000# 18648 000245'02 777777 777763 18649 001053'04 040 164 157 040 146 18650 18651 002664'01 104 00 0 00 000053 SOUT% ; Counted SOUT% is faster 18652 002665'01 320 12 0 00 002667' %jsErr (,) ; Whine and continue 18653 002666'01 254 00 0 00 002672' 18654 002667'01 265 01 0 00 002660* 18655 002670'01 000000000000# 18656 002671'01 254 00 0 00 002672' 18657 001056'04 125 156 141 142 154 18658 18659 002672'01 263 17 0 00 000000 ret ; Finally done 18660 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 34 K20IOC MAC 20-Jan-23 21:49 Get a carriage return terminated line of text 18661 subttl Get a carriage return terminated line of text 18662 18663 ; Call: 18664 ; 18665 ; q3/ JFN we're reading from, typically netjfn 18666 ; p2/ EOF character without parity 18667 ; q4/ EOF character, if doing EOF 18668 ; 18669 ; Return: 18670 ; 18671 ; +1/ Any kind of error 18672 ; +2/ Hit either carriage return or an EOF 18673 ; 18674 ; t4/ 0 if didn't hit a carriage return 18675 ; -1 if we did (a linefeed will be appended!!) 18676 ; q1/ Points to last character in seven bit stream 18677 ; q4/ -1 if hit the EOF character 18678 ; p2/ Preserved, always 18679 ; p4/ Total characters that have been buffered up 18680 18681 002673'01 265 16 0 00 004075' getcrt: saveac ; Used as scratch 18682 002674'01 403 14 0 00 000015 setzb p4, p5 ; Assume won't buffer anything or hit a CR 18683 002675'01 200 13 0 00 004021' move p3,[point 8,strbuf] ;Will be reading into the string buffer 18684 ; Loop reads until EOF, CR or buffer full 18685 002676'01 do. ; Enter loop context 18686 002676'01 301 14 0 00 003776 cail p4, capmxl ; Would the read overflow the buffer? 18687 002677'01 254 00 0 00 002775' exit. ; Then don't read another thing 18688 002700'01 200 01 0 00 000007 move t1, q3 ; Load the input JFN 18689 002701'01 104 00 0 00 000050 BIN% ; Wait for a byte 18690 002702'01 320 12 0 00 002704' %jsErr (,r) ; Whine and return 18691 002703'01 254 00 0 00 002707' 18692 002704'01 265 01 0 00 002667* 18693 002705'01 000000000000# 18694 002706'01 254 00 0 00 001535* 18695 001066'04 105 162 162 157 162 18696 002707'01 312 01 0 00 002505* came t1, ttyjfn ; Was this the local terminal? 18697 002710'01 350 00 0 00 000473* aos nbict ; No, so count a network BIN%, then 18698 002711'01 200 01 0 00 000002 move t1, t2 ; Check the parity on this poor character 18699 002712'01 260 17 1 00 002413* call @parity ; Calculate the parity (if any) 18700 002713'01 312 01 0 00 000002 came t1, t2 ; Is the parity the same?? 18701 002714'01 254 00 0 00 002731' ifskp. ; That's dandy, let's use it 18702 002715'01 136 02 0 00 000013 idpb t2, p3 ; Append the single byte we got 18703 002716'01 271 14 0 00 000001 addi p4, ^d1 ; and count it 18704 002717'01 322 10 0 00 002724' ifn. q4 ; Doing EOF?? 18705 002720'01 312 02 0 00 000010 came t2, q4 ; We are. Is this the EOF? 18706 002721'01 254 00 0 00 002724' anskp. ; Isn't, so just carry on 18707 002722'01 474 10 0 00 000000 seto q4, ; Flag hit EOF 18708 002723'01 254 00 0 00 002775' exit. ; Exit the loop 18709 002724'01 endif. ; End case possible EOF checking 18710 002724'01 312 02 0 00 000012 came t2, p2 ; Was the character a carriage return? 18711 002725'01 254 00 0 00 002730' ifskp. ; It was, so check and return this line 18712 002726'01 474 15 0 00 000000 seto p5, ; Flag hit carriage return 18713 002727'01 254 00 0 00 002775' exit. ; Get out of the loop 18714 002730'01 endif. ; End case checking for carriage return 18715 002730'01 254 00 0 00 002735' else. ; Not, so a parity error K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 34-1 K20IOC MAC 20-Jan-23 21:49 Get a carriage return terminated line of text 18716 002731'01 200 01 0 00 000000# emsg 18717 002732'01 104 00 0 00 000313 18718 000246'02 000000000000# 18719 001074'04 102 141 144 040 160 18720 002733'01 350 00 0 00 000000* aos ttipar ; Count a detected parity error 18721 002734'01 263 17 0 00 000000 ret ; And give an error return 18722 002735'01 endif. ; End case checking parity 18723 002735'01 260 17 0 00 000476* call clrest ; Find out how much, if anything, remains 18724 002736'01 263 17 0 00 000000 ret ; Failed somehow, just give up 18725 002737'01 322 01 0 00 002676' jumpe t1, top. ; If nothing to read, go wait for something 18726 remark ; Otherwise, get the rest of the goodies 18727 002740'01 200 02 0 00 000001 move t2, t1 ; Save a working copy 18728 002741'01 270 02 0 00 000014 add t2, p4 ; Calculate what would be the final total 18729 002742'01 307 02 0 00 003776 caig t2, capmxl ; Would this read overflow the buffer? 18730 002743'01 254 00 0 00 002746' ifskp. ; It would, so clip down to maximum 18731 002744'01 275 02 0 00 003776 subi t2, capmxl ; Calculate the overflow 18732 002745'01 274 01 0 00 000002 sub t1, t2 ; And reduce the read by that amount 18733 002746'01 endif. ; End case buffer overflow check 18734 002746'01 200 11 0 00 000001 move p1, t1 ; Save final maximum 18735 002747'01 200 01 0 00 000007 move t1, q3 ; Load whatever transfer JFN we're using 18736 002750'01 200 02 0 00 000013 move t2, p3 ; Load current position in buffer 18737 002751'01 120 03 0 00 000011 dmove t3, p1 ; Load maximum we'll read and terminator 18738 002752'01 104 00 0 00 000052 SIN% ; And grab whatever else is waiting for us 18739 002753'01 320 12 0 00 002755' %jsErr (,r) ; Whine and return 18740 002754'01 254 00 0 00 002760' 18741 002755'01 265 01 0 00 002704* 18742 002756'01 000000000000# 18743 002757'01 254 00 0 00 002706* 18744 001105'04 105 162 162 157 162 18745 002760'01 200 13 0 00 000002 move p3, t2 ; Update current position in buffer 18746 002761'01 274 11 0 00 000003 sub p1, t3 ; Subtract negative to get total characters transferred 18747 002762'01 316 07 0 00 002707* camn q3, ttyjfn ; Not using the local terminal? 18748 002763'01 254 00 0 00 002770' ifskp. ; No, so updates some more variables 18749 002764'01 350 00 0 00 000512* aos nsici ; Update Network SIN%'s Issued 18750 002765'01 313 11 0 00 000510* camle p1, nsimx ; Smaller than biggest? 18751 002766'01 202 11 0 00 002765* movem p1, nsimx ; Nope, we have a new winner 18752 002767'01 272 11 0 00 000523* addm p1, nsitc ; Update Network SIN% total characters read 18753 002770'01 endif. ; End case network tally updates 18754 002770'01 270 14 0 00 000011 add p4, p1 ; Compute total characters in strbuf 18755 002771'01 135 01 0 00 000002 ldb t1, t2 ; Pick up the last eight bit character 18756 002772'01 312 01 0 00 000012 came t1, p2 ; Was it a carriage return?? 18757 002773'01 254 00 0 00 002676' loop. ; Wasn't, so go get some more data 18758 002774'01 474 15 0 00 000000 seto p5, ; Otherwise, it was, so flag and fall out of the loop 18759 002775'01 enddo. ; End loop lexical context 18760 18761 remark ; Check parity and repack the string 18762 002775'01 200 02 0 00 004021' move t2,[point 8,strbuf] ;Point to network input buffer 18763 002776'01 210 03 0 00 000014 movn t3, p4 ; Pretend doing a SOUT% 18764 remark ; If no parity, chkpar will return +2 18765 002777'01 260 17 0 00 003610' call chkpar ; Check the parity 18766 003000'01 254 00 0 00 003011' ifskp. ; Everything is fine, so convert to 7 bit 18767 003001'01 200 01 0 00 000014 move t1, p4 ; Source length is the total characters gotten 18768 003002'01 200 02 0 00 004021' move t2,[point 8,strbuf] ;Which comes from the network data 18769 003003'01 403 03 0 00 000006 setzb t3, q2 ; Pointers are section zero local 18770 003004'01 200 04 0 00 000014 move t4, p4 ; Output string is same length K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 34-2 K20IOC MAC 20-Jan-23 21:49 Get a carriage return terminated line of text 18771 003005'01 200 05 0 00 003706' move q1,[point 7,strbuf] ;Destination is same with smaller byte size 18772 003006'01 123 01 0 00 002422* extend t1, movchr ; Repack the string in place (which is safe) 18773 003007'01 600 00 0 00 000000 nop ; Ignore any odd non-skip 18774 003010'01 254 00 0 00 003015' else. ; Otherwise, badness 18775 003011'01 200 01 0 00 000000# emsg 18776 003012'01 104 00 0 00 000313 18777 000247'02 000000000000# 18778 001114'04 102 141 144 040 160 18779 003013'01 350 00 0 00 002733* aos ttipar ; Count a detected parity error 18780 003014'01 263 17 0 00 000000 ret ; And fail the call 18781 003015'01 endif. ; End parity check 18782 18783 003015'01 326 15 0 00 003022' ife. p5 ; If no CR, fix up the last pointer 18784 003016'01 474 02 0 00 000000 seto t2, ; movchr points PAST the last character 18785 003017'01 133 02 0 00 000005 adjbp t2, q1 ; So back up the 7 bit pointer by one 18786 003020'01 200 05 0 00 000002 move q1, t2 ; And pass that back 18787 003021'01 254 00 0 00 003025' else. ; Otherwise, we hit the carriage return!! 18788 003022'01 201 01 0 00 000012 movei t1, .chlfd ; So will need a line feed 18789 003023'01 136 01 0 00 000005 idpb t1, q1 ; Append it 18790 003024'01 271 14 0 00 000001 addi p4, ^d1 ; and acCOUNT for it (Boo...) 18791 003025'01 endif. ; End case carriage return fix up 18792 18793 003025'01 200 04 0 00 000015 move t4, p5 ; Pass back the carriage return flag 18794 003026'01 254 00 0 00 002004* retskp ; Return success 18795 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 35 K20IOC MAC 20-Jan-23 21:49 Check for and Overwrite EOF at the end of the string 18796 subttl Check for and Overwrite EOF at the end of the string 18797 18798 ; Assumes that the EOF is always within three characters of the last 18799 ; character, including that character. This is based on how the EOF 18800 ; logic sends the character in TRANSMIT and how the CAPTURE logic will 18801 ; append a linefeed to any carriage return it finds. In other words, 18802 ; the sequence we check for is . However, if we bump 18803 ; into the EOF before we've checked everything, that's fine, too. 18804 ; 18805 ; Call: 18806 ; 18807 ; q1/ Points to the last character in the seven bit stream 18808 ; q4/ EOF character with parity (if we're doing any parity) 18809 ; p3/ EOF character without parity (whether or not we're doing parity) 18810 ; p4/ Length of string we're just about to write 18811 ; 18812 ; Return: 18813 ; 18814 ; +1, always 18815 ; 18816 ; q1/ Unchanged, string will have EOF character stripped if q4 was -1 18817 ; q4/ Set to -1, if found the EOF character 18818 ; p3/ Unchanged 18819 ; p4/ Length will be less, depending on where we found the EOF 18820 ; 18821 ; All other registers are preserved 18822 ; 18823 ; N.B., EVERYTHING after the EOF is tossed, including the EOF!! 18824 18825 003027'01 322 13 0 00 002757* eofovr: jumpe p3, r ; If not checking EOF, we have nothing to do 18826 003030'01 323 14 0 00 003027* jumple p4, r ; Don't bother if funny length, either 18827 ; First do the trivial edge cases 18828 003031'01 325 10 0 00 003034' ifl. q4 ; So, did somebody else already flag this? 18829 003032'01 275 14 0 00 000001 subi p4, ^d1 ; They did, so don't write the EOF to the file 18830 003033'01 263 17 0 00 000000 ret ; After shortening length, we're done 18831 003034'01 endif. ; End trivial case of somebody already told us 18832 ; Next trivial case? Is it at the end? 18833 003034'01 135 01 0 00 000005 ldb t1, q1 ; Get the last character 18834 003035'01 312 01 0 00 000013 came t1, p3 ; EOF already? 18835 003036'01 254 00 0 00 003042' ifskp. ; That was easy, just reduce the length 18836 003037'01 474 10 0 00 000000 seto q4, ; Flag we hit EOF 18837 003040'01 275 14 0 00 000001 subi p4, ^d1 ; We're not writing EOF to the file 18838 003041'01 263 17 0 00 000000 ret ; and return; we're done 18839 003042'01 endif. ; End case checking last character 18840 ; Final trivial case, a single character string 18841 003042'01 306 14 0 00 000001 cain p4, ^d1 ; Just this one dinky character? 18842 003043'01 263 17 0 00 000000 ret ; Fine, we didn't hit the EOF ... 18843 ; Otherwise, this is about to get harder 18844 003044'01 265 16 0 00 004107' saveac 18845 003045'01 201 07 0 00 000003 movei q3, ^d3 ; Will assume sequence is 18846 003046'01 313 07 0 00 000014 camle q3, p4 ; BUT!! Do we have enough characters? 18847 003047'01 200 07 0 00 000014 move q3, p4 ; No, so clip it down to remaining 18848 003050'01 363 07 0 00 003030* sojle q3, R ; Account for character we just checked (in t1) 18849 ; Also double checks our arithmatic, above 18850 003051'01 474 06 0 00 000000 seto q2, ; Back up the pointer K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 35-1 K20IOC MAC 20-Jan-23 21:49 Check for and Overwrite EOF at the end of the string 18851 003052'01 133 06 0 00 000005 adjbp q2, q1 ; Now pointing at penultimate character 18852 003053'01 135 02 0 00 000006 ldb t2, q2 ; and load that character 18853 003054'01 312 02 0 00 000013 came t2, p3 ; Hit the EOF? 18854 003055'01 254 00 0 00 003062' ifskp. ; We did 18855 003056'01 474 10 0 00 000000 seto q4, ; Flag we hit EOF 18856 003057'01 275 14 0 00 000002 subi p4, ^d2 ; We punted two characters from the string 18857 003060'01 263 17 0 00 000000 ret ; and return; we're done 18858 003061'01 254 00 0 00 003064' else. ; We didn't hit the EOF 18859 003062'01 306 07 0 00 000001 cain q3, ^d1 ; Was it a two character string, then? 18860 003063'01 263 17 0 00 000000 ret ; Then we're done, no EOF found 18861 003064'01 endif. ; End case checking penultimate character 18862 003064'01 363 07 0 00 003050* sojle q3, R ; Account for this second character we just checked 18863 ; Checking last character, so can reuse q3 18864 003065'01 474 07 0 00 000000 seto q3, ; Back up the pointer one more 18865 003066'01 133 07 0 00 000006 adjbp q3, q2 ; Now pointing at the antipenultimate character 18866 003067'01 135 03 0 00 000007 ldb t3, q3 ; and load that character 18867 003070'01 312 03 0 00 000013 came t3, p3 ; Hit the EOF finally?? 18868 003071'01 263 17 0 00 000000 ret ; Nope, so wasn't in this string 18869 003072'01 474 10 0 00 000000 seto q4, ; It's the EOF! So flag we found it 18870 003073'01 275 14 0 00 000003 subi p4, ^d3 ; Punting three characters from the string 18871 003074'01 263 17 0 00 000000 ret ; and return; we're done 18872 18873 ;[230] End code insertion 18874 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 36 K20IOC MAC 20-Jan-23 21:49 Translation table for MOVST to not uppercase 18875 subttl Translation table for MOVST to not uppercase 18876 18877 ;[209] Begin code and table insertion 18878 18879 ; Inspired by my rewrite of SETNOD, SETND2 (ND2SUB.MAC) 18880 18881 chgsec(code,const) ;;Put tables in the constants .psect 18882 18883 000002 %ascii=.chcnb ; ASCII values start at Control-B 18884 18885 remark Character table simply moves characters until a backslash is hit 18886 18887 000250'02 chrtab: intern chrtab ; Also used by k20par 18888 000250'02 100000 000001 xwd eoscod,.chcna ; NUL is end of string, ^A is allowed 18889 xlist ; Don't need to see all this junk 18890 list ; Restart the blather 18891 18892 000350' %eochr=. ; Remember end of table 18893 000326'02 reloc chrtab+<<"\">_-1> ; Gets us to the corrct halfword pair 18894 000326'02 500134 000135 xwd >,135 ;Stop on a backslash, emit a right brocket 18895 000350'02 reloc %eochr ; Get to end of table 18896 18897 100200 %ascii=eoscod!200!.chnul ; Anything we translate with bit 8 is bad 18898 xlist ; Don't need to see all this junk 18899 list ; Restart the blather 18900 18901 000550' %eotup=. ; Remember end of table 18902 000526'02 reloc chrtup+<<"\">_-1> ; Gets us to the corrct halfword pair 18903 000526'02 500134 000135 xwd >,135 ;Stop on a backslash, emit a right brocket 18904 000530'02 reloc chrtup+<<"`">_-1> ; Gets us to the corrct halfword pair 18905 000530'02 000140 000101 xwd "`","A" ; Convert lowercase a to UPPERcase A 18906 000102 %ascus="B" ; Starting at lowercase b 18907 xlist ; Don't need to see all this junk 18908 list ; Restart the blather 18909 000545'02 000132 000173 xwd "Z",173 ; Last letter and Left brace 18910 18911 000550'02 reloc %eotup ; Get to end of table 18912 18913 remark For eight bit data, everything stops us 18914 18915 100200 %ascus=eoscod!200!.chnul ; Anything we translate with bit 8 is bad 18916 xlist ; Don't need to see all this junk 18917 list ; Restart the blather 18918 retsec ; Re-open executable code 18919 18920 cleans(<%ascus,%eotup>) ; Don't polute the symbol table 18921 18922 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 38 K20IOC MAC 20-Jan-23 21:49 cescxp C Escape Expansion 18923 subttl cescxp C Escape Expansion 18924 18925 ; Given a source and destination pointer, copies the string from the 18926 ; source to the destination, triggering C escape expansion where 18927 ; appropriate. The source string MUST be NUL terminated 18928 ; 18929 ; If case is being ignored, then the string is UPPERcased as it is 18930 ; copied to facilitate later usage of string comparison instructions. 18931 ; 18932 ; Returns updated pointers and length. The destination buffer can 18933 ; never fill before the input buffer empties because any expansion 18934 ; involves converting two or more characters to a single character. 18935 ; 18936 ; Parity MUST be stripped before calling this routine. Although it 18937 ; will accept 8 bit pointers, it expects that the parity bit has been 18938 ; removed and will fail if finds a character with bit 8 set. 18939 ; 18940 ; Assumes section local pointers, do not use OWGP as the wrong 18941 ; thing will be returned. 18942 18943 003075'01 015 00 0 00 000000# chrmov: movst 0,chrtab ; Moves string without UPPERcasing 18944 003076'01 000000 000000 .chnul ; Fill character is end of string 18945 18946 003077'01 015 00 0 00 000000# chrmup: movst 0,chrtup ; Translate table to UPPERcase 18947 003100'01 000000 000000 .chnul ; Fill character is end of string 18948 18949 ; Call: 18950 ; 18951 ; t1/ Destination string pointer 18952 ; t2/ Source string pointer 18953 ; t3/ Maximum length of destination 18954 ; t4/ Translation table to use (whether matching case or not) 18955 ; 18956 ; Returns: 18957 ; 18958 ; +1/ Something bad happened or did nothing 18959 ; +2/ Good return 18960 ; 18961 ; t1/ Updated destination string pointer 18962 ; t2/ Updated source string pointer 18963 ; t3/ Length we translated 18964 18965 003101'01 cescxp: entry cescxp ; Also used by k20par 18966 003101'01 265 16 0 00 004125' saveac ; Save registers for piggy MOVST 18967 003102'01 550 11 0 00 000004 hrrz p1, t4 ; Save requested table 18968 003103'01 505 11 0 00 015000 hrli p1, (movst 0,) ; Load correct extended instruction opcode 18969 003104'01 400 12 0 00 000000 setz p2, ; .chnul is the fill character 18970 003105'01 200 05 0 00 000001 move q1, t1 ; Position destination for MOVST 18971 003106'01 200 01 0 00 000003 move t1, t3 ; Set source length 18972 003107'01 200 04 0 00 000003 move t4, t3 ; Same as destination (so no fill) 18973 003110'01 200 07 0 00 000003 move q3, t3 ; Save (original) length for later 18974 003111'01 403 03 0 00 000006 setzb t3, q2 ; Force local pointers 18975 003112'01 621 01 0 00 300000 txz t1, N!M ; Clear translation flags 18976 18977 003113'01 do. ; Enter loop context K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 38-1 K20IOC MAC 20-Jan-23 21:49 cescxp C Escape Expansion 18978 003113'01 661 01 0 00 400000 txo t1,S ; Set significance flag (start translating) 18979 003114'01 123 01 0 00 000011 extend t1, p1 ; Move the string, testing for end and 18980 003115'01 320 12 0 00 003117' %jserr (, r) ; Pass any machine error back up 18981 003116'01 254 00 0 00 003122' 18982 003117'01 265 01 0 00 002755* 18983 003120'01 000000000000# 18984 003121'01 254 00 0 00 003064* 18985 001126'04 115 117 126 123 124 18986 003122'01 623 01 0 00 200000 txze t1, N ; Bumped into a backslash? 18987 003123'01 254 00 0 00 003127' ifskp. ; We did not and haven't exhausted source 18988 003124'01 621 01 0 00 700000 txz t1, S!N!M ; Clear all the flags 18989 003125'01 200 10 0 00 000002 move q4, t2 ; Keep stopping source pointer 18990 003126'01 344 01 0 00 003135' aoja t1, endlp. ; Account that .chnul was not consumed 18991 003127'01 endif. ; and we are done with the string move 18992 003127'01 621 01 0 00 700000 txz t1, S!N!M ; Clear all the flags 18993 003130'01 322 01 0 00 003135' jumpe t1, endlp. ; Done if no more source 18994 003131'01 322 04 0 00 003135' jumpe t4, endlp. ; Done if no more destination 18995 003132'01 260 17 0 00 003157' call escchr ; Otherwise, process an escape character 18996 003133'01 263 17 0 00 000000 ret ; Failed, just stop right now 18997 003134'01 327 01 0 00 003113' jumpg t1, top. ; Keep moving characters until no more 18998 003135'01 enddo. ; End loop context 18999 19000 remark t2, ; Still has source 19001 003135'01 200 03 0 00 000007 move t3, q3 ; Load original length 19002 003136'01 274 03 0 00 000004 sub t3, t4 ; Calculate what we finally produced 19003 003137'01 200 01 0 00 000005 move t1, q1 ; Restore updated destination BEFORE terminating it 19004 003140'01 136 06 0 00 000005 idpb q2, q1 ; Tie off destination 19005 19006 003141'01 316 03 0 00 000007 camn t3, q3 ; Stopped before the end of the string? 19007 003142'01 254 00 0 00 003153' ifskp. ; Uh oh... Stopped early. What did that? 19008 003143'01 135 04 0 00 000010 ldb t4, q4 ; Load source character that stopped us 19009 003144'01 246 04 0 00 777777 lshc t4, ^d<-1> ; Divide by two, shifting odd bit into bit zero 19010 003145'01 242 05 0 00 777735 lsh q1, ^d<-35> ; Shift into bit zero 19011 xct [ hlrz q2,chrtab(t4) ; Even, pick up left half 19012 003146'01 256 00 0 05 004143' hrrz q2,chrtab(t4) ](q1) ; Even, pick up right half 19013 003147'01 626 06 0 00 100000 txzn q2, eoscod ; Had to be an end of string 19014 003150'01 254 00 0 00 003153' anskp. ; But wasn't, so we're done 19015 003151'01 622 06 0 00 000200 txze q2, 200 ; Any parity? 19016 003152'01 263 17 0 00 000000 ret ; Yes, so that's bad; return +1 19017 003153'01 endif. ; End eigth bit checking 19018 003153'01 323 03 0 00 003121* jumple t3, R ; Nothing to do if nothing read 19019 003154'01 254 00 0 00 003026* retskp ; Return +2 19020 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 39 K20IOC MAC 20-Jan-23 21:49 Escape table for escape character substitution 19021 subttl Escape table for escape character substitution 19022 19023 ; The translate table assumes that exactly a SINGLE character is to be 19024 ; translated, unless a number is being given. The logic coupled with 19025 ; it is as follows: 19026 ; 19027 ; 1) If the character count is zero, then a single character 19028 ; substitution was possible and we are done. 19029 ; 19030 ; 2) Any character that does not have a valid escape mapping will 19031 ; terminate with the N bit set (note TRMCOD opcode). 19032 ; 19033 ; 3) Any character that requires further processing will terminate 19034 ; processing (EOSCOD), but the count will not be zero. These 19035 ; characters are currenly upper and lower X and decimal digits. 19036 19037 chgsec(code,const) ;;Put table in the constants .psect 19038 19039 000000 %escha=0 ; Starts out at .CHNUL 19040 19041 000650'02 esctab: remark ; Appropriately trigger on escape values 19042 xlist ; Don't need to see all this junk 19043 list ; Restart the blather 19044 19045 000750' %eoesc=. ; Remember end of table 19046 19047 000700'02 reloc esctab+<<"0">_-1> ; Gets us to the correct halfword pair 19048 xlist ; Save the trees!!! 19049 list ; Restart the blather 19050 19051 define escsub(chr1,sub1,chr2,sub2) < 19052 reloc esctab+<<&177>_-1> ;;Gets us to the correct halfword pair 19053 xwd sub1,sub2 ;;Emit the appropriate pair 19054 >;;escsub 19055 19056 000677'02 000056 500057 escsub(".",<".">,"/",) ;;Tops-10 monitor prompt 19057 000710'02 000100 000007 escsub("@",<"@">,"A",.chbel) ;;I kept fat fingering \@ ... 19058 000711'02 000010 000003 escsub("B",.chbsp,"C",.chcnc) 19059 000712'02 000004 000033 escsub("D",.chcnd,"E",.chesc) 19060 000713'02 000014 500107 escsub("F",.chffd,"G",); 19061 19062 000717'02 000012 500117 escsub("N",.chlfd,"O",) 19063 000720'02 500120 000042 escsub("P",,"Q",.chdbq) 19064 000721'02 000015 500123 escsub("R",.chcrt,"S",) 19065 000722'02 000011 500125 escsub("T",.chtab,"U",) 19066 000723'02 000013 500127 escsub("V",.chvtb,"W",) 19067 000725'02 000032 500133 escsub("Z",.chcnz,"[",) ;;Left brocket 19068 19069 000730'02 500140 000007 escsub("`",,"a",.chbel) 19070 000731'02 000010 000003 escsub("b",.chbsp,"c",.chcnc) 19071 000732'02 000004 000033 escsub("d",.chcnd,"e",.chesc) 19072 000733'02 000014 500147 escsub("f",.chffd,"g",); 19073 19074 000737'02 000012 500157 escsub("n",.chlfd,"o",) 19075 000740'02 500160 000042 escsub("p",,"q",.chdbq) K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 39-1 K20IOC MAC 20-Jan-23 21:49 Escape table for escape character substitution 19076 000741'02 000015 500163 escsub("r",.chcrt,"s",) 19077 000742'02 000011 500165 escsub("t",.chtab,"u",) 19078 000743'02 000013 500167 escsub("v",.chvtb,"w",) 19079 000745'02 000032 500173 escsub("z",.chcnz,173,) ;;Left curly brace 19080 19081 000671'02 000042 500043 escsub(.chdbq,.chdbq,"#",) ;;Double quote 19082 000673'02 500046 000047 escsub("&",,"'","'") 19083 000707'02 500076 000077 escsub(76,,"?","?") ;;Left pointy bracket 19084 000726'02 000134 500135 escsub("\","\","]",) ;;Right broket 19085 19086 000750'02 reloc %eoesc ; Get to back to end of table 19087 retsec ;;Re-open executable code 19088 19089 cleans(<%escha,%eoesc>) ;;Don't polute the symbol table 19090 19091 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 40 K20IOC MAC 20-Jan-23 21:49 Handle escape character substitution and expansion 19092 subttl Handle escape character substitution and expansion 19093 19094 ; See esctab commentary above for this routine's logic summary. In 19095 ; this routine's case, the MOVST is not being used for the efficiency 19096 ; of moving a string but rather for the 'relative' ease of using a 19097 ; table driven approach. However, this would still probably be more 19098 ; efficient than a worst case skip chain. 19099 ; 19100 ; Call: 19101 ; 19102 ; t1/ Remaining bytes in source string 19103 ; t2/ Section local pointer to source 19104 ; t3/ 0 (and must be zero) 19105 ; t4/ Remaining bytes in destination string 19106 ; q1/ Section local pointer to destination 19107 ; q2/ 0 (and must be zero) 19108 ; 19109 ; Return: 19110 ; 19111 ; +1/ Failed somehow 19112 ; +2/ Escape character substituted or expanded 19113 ; 19114 ; t1 through q2 updates as appropriate. 19115 ; 19116 ; Be aware of the following: 19117 ; 19118 ; While the routine is fairly defensively coded, it makes an 19119 ; assumption that the destination string is always at least as long as 19120 ; the source. If this is the case, then the destination storage space 19121 ; can NEVER be overflowed because the minimal substitution will remove 19122 ; two characters from the source while depositing a single character 19123 ; in the destination. 19124 19125 003155'01 015 00 0 00 000000# escmov: movst 0,esctab ; Actual extend instruction being executed 19126 003156'01 000000 000000 .chnul ; Fill character is end of string (never used) 19127 19128 003157'01 escchr: entry escchr ; Used in k20par 19129 003157'01 265 16 0 00 004145' saveac ; EXTEND needs SO many registers... 19130 003160'01 621 01 0 00 700000 txz t1, N!M!S ; Stomp flags so math and EXTEND work 19131 003161'01 337 07 0 00 000001 skipg q3, t1 ; Save and check remaining source count 19132 003162'01 334 00 0 00 000000 %ermsg (,r) 19133 003163'01 254 00 0 00 003167' 19134 003164'01 265 01 0 00 003117* 19135 003165'01 000000000000# 19136 003166'01 254 00 0 00 003153* 19137 001131'04 105 163 143 141 160 19138 003167'01 200 10 0 00 000004 move q4, t4 ; Save current remaining destination count 19139 19140 003170'01 200 01 0 00 004155' move t1,[S!<^d1>] ; Only looking at a SINGLE character of source 19141 003171'01 201 04 0 00 000001 movei t4,^d1 ; Destination will be always be one character 19142 003172'01 123 01 0 00 003155' extend t1, escmov ; Try to expand the escape 19143 003173'01 320 12 0 00 003175' %jserr (, r) ; Pass any machine error back up 19144 003174'01 254 00 0 00 003200' 19145 003175'01 265 01 0 00 003164* 19146 003176'01 000000000000# K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 40-1 K20IOC MAC 20-Jan-23 21:49 Handle escape character substitution and expansion 19147 003177'01 254 00 0 00 003166* 19148 001142'04 105 163 143 141 160 19149 19150 003200'01 607 01 0 00 200000 ifxn. t1, N ; Invalid escape character?? 19151 003201'01 254 00 0 00 003211' 19152 003202'01 200 01 0 00 000000# emsg 19153 003203'01 104 00 0 00 000313 19154 000750'02 000000000000# 19155 001146'04 111 154 154 145 147 19156 003204'01 135 01 0 00 000002 ldb t1, t2 ; Pick up what didn't work 19157 003205'01 104 00 0 00 000074 PBOUT% ; Show us 19158 003206'01 561 01 0 00 002527* hrroi t1, crlf ; Load end of line 19159 003207'01 104 00 0 00 000076 PSOUT% ; Print it 19160 003210'01 263 17 0 00 000000 ret ; Return failure 19161 003211'01 endif. 19162 19163 003211'01 326 04 0 00 003227' ife. t4 ; Was this a simple substitution? 19164 003212'01 375 01 0 00 000007 sosge t1, q3 ; Yes, account for source byte consumed 19165 003213'01 334 00 0 00 000000 %ermsg (,r) 19166 003214'01 254 00 0 00 003220' 19167 003215'01 265 01 0 00 003175* 19168 003216'01 000000000000# 19169 003217'01 254 00 0 00 003177* 19170 001154'04 105 163 143 141 160 19171 003220'01 375 04 0 00 000010 sosge t4, q4 ; Account for destination byte consumed 19172 003221'01 334 00 0 00 000000 %ermsg (,r) 19173 003222'01 254 00 0 00 003226' 19174 003223'01 265 01 0 00 003215* 19175 003224'01 000000000000# 19176 003225'01 254 00 0 00 003217* 19177 001165'04 105 163 143 141 160 19178 003226'01 254 00 0 00 003154* retskp ; Return success 19179 003227'01 endif. 19180 19181 003227'01 200 01 0 00 000007 move t1, q3 ; Original remaining source bytes is fine 19182 003230'01 474 03 0 00 000000 seto t3, ; But must back up the source pointer 19183 003231'01 133 03 0 00 000002 adjbp t3, t2 ; because it did not translate the byte 19184 003232'01 200 02 0 00 000003 move t2, t3 ; Overwrite current 19185 003233'01 400 03 0 00 000000 setz t3, ; Keep source pointer section local 19186 003234'01 200 04 0 00 000010 move t4, q4 ; Restore original remaining destination bytes 19187 003235'01 260 17 0 00 003260' call cvtoct ; Convert ASCII octal digits to binary 19188 003236'01 263 17 0 00 000000 ret ; Pass the error up 19189 ; Range check result 19190 003237'01 303 03 0 00 000177 caile t3, .chdel ; Over 7 bits? 19191 003240'01 334 00 0 00 000000 %ermsg (,r) 19192 003241'01 254 00 0 00 003245' 19193 003242'01 265 01 0 00 003223* 19194 003243'01 000000000000# 19195 003244'01 254 00 0 00 003225* 19196 001177'04 123 160 145 143 151 19197 003245'01 136 03 0 00 000005 idpb t3, q1 ; Deposit in output buffer 19198 003246'01 400 03 0 00 000000 setz t3, ; Keep source string section local 19199 003247'01 375 00 0 00 000004 sosge t4 ; Account for destination byte consumed 19200 003250'01 334 00 0 00 000000 %ermsg (,r) 19201 003251'01 254 00 0 00 003255' K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 40-2 K20IOC MAC 20-Jan-23 21:49 Handle escape character substitution and expansion 19202 003252'01 265 01 0 00 003242* 19203 003253'01 000000000000# 19204 003254'01 254 00 0 00 003244* 19205 001210'04 105 163 143 141 160 19206 003255'01 254 00 0 00 003226* retskp ; Worked! 19207 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 41 K20IOC MAC 20-Jan-23 21:49 ASCII Octal to Binary Octal Conversion table 19208 subttl ASCII Octal to Binary Octal Conversion table 19209 19210 chgsec(code,const) ;;Put the table in the constants .psect 19211 19212 000000 %octal=0 ; ASCII values start at .chnul 19213 19214 000751'02 octtab: xlist ; Save the trees!!! 19215 list ; Safe to look now, phew!!!! 19216 19217 001051' %eooct==. ; Remember the end of octal table 19218 19219 001001'02 reloc octtab+<<"0">_-1> ; Gets us to the corrct halfword pair 19220 000000 %octal=0 ; Starting octal digit VALUE 19221 19222 repeat ^d4,< ; Only doing 4 pairs of digits 0 through 7 19223 xwd %octal,%octal+1 ; Emit the octal value for the ASCII digit 19224 %octal==%octal+2 ;;Step to next character pair 19225 > 19226 001001'02 000000 000001 19227 001002'02 000002 000003 19228 001003'02 000004 000005 19229 001004'02 000006 000007 19230 19231 remark 8,9 ;;Fail on decimal digits!!!! 19232 001005'02 500070 500071 xwd trmcod!<"8">,trmcod!<"9"> 19233 19234 001051'02 reloc %eooct ; Get back to the end of octtab table 19235 retsec ;;Restore code psect 19236 cleans(<%octal,%eooct>) ;;Don't polute the symbol table 19237 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 42 K20IOC MAC 20-Jan-23 21:49 Octal Conversion 19238 subttl Octal Conversion 19239 19240 ; The purpose of the function is to bum a NIN%. This done for two 19241 ; reasons: 19242 ; 19243 ; 1) It's faster (no JSYS overhead) 19244 ; 2) It keeps counters straight. 19245 ; 19246 ; Done only in the context of a previous movst (see escchr, 19247 ; above), so has an odd register file to contend with. 19248 ; 19249 ; Although a 36 bit word will hold twelve 3 bit octal digits, we limit 19250 ; it to eleven digits so we don't wind up having to deal with any 19251 ; goofy numbers that look negative. 19252 ; 19253 ; However, the limit here is 12. This allows us to determine the 19254 ; difference between a number that is too long and a character that 19255 ; terminated the translation. 19256 ; 19257 ; The conversion code is trivial, we don't even use a cvtdbo (which is 19258 ; the wrong base, anyway), but rather take a seven bit ASCII digit, 19259 ; subtract ASCII zero ("0") from it and then deposit it in a register. 19260 ; This is all done with a single MOVST. 19261 ; 19262 ; Upon termination, that binary octal number is left-normalized and 19263 ; need merely be right-normalized with a lshc. 19264 ; 19265 ; Call: 19266 ; 19267 ; t1/ Remaining bytes in source string 19268 ; t2/ Section local pointer to source 19269 ; t3/ 0 (and must be zero) 19270 ; t4/ Remaining bytes in destination string 19271 ; q1/ Section local pointer to destination 19272 ; q2/ 0 (and must be zero) 19273 ; 19274 ; Return: 19275 ; 19276 ; +1 Some kind of failure 19277 ; +2 19278 ; t1/ Updated with bytes consumed 19279 ; t2/ Updated pointer past digits consumed 19280 ; t3/ Binary form of octal number 19281 ; t4/ Preserved 19282 ; q1/ Preserved 19283 ; q2/ Preserved 19284 ; 19285 ; N.B., Caller *MUST* rezero t3!!! 19286 19287 003256'01 015 00 0 00 000000# octmov: movst 0,octtab ; Actual extend instruction being executed 19288 003257'01 000000 000000 .chnul ; Fill character is end of string (never used) 19289 19290 003260'01 265 16 0 00 004156' cvtoct: saveac ; Preserve what we'll stomp 19291 003261'01 621 01 0 00 300000 txz t1, N!M ; Clear the number flags 19292 003262'01 661 01 0 00 400000 txo t1, S ; Start translating immediately K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 42-1 K20IOC MAC 20-Jan-23 21:49 Octal Conversion 19293 dmove t4,[ ^d12 ; Maximum of eleven octal digits (see above) 19294 003263'01 120 04 0 00 004170' point 3, q3 ] ; N.B., 3 bit bytes!! 19295 003264'01 400 07 0 00 000000 setz q3, ; Give the destination a clean slate 19296 003265'01 123 01 0 00 003256' extend t1, octmov ; Convert Octal digits 19297 003266'01 320 12 0 00 003270' %jserr (,r) 19298 003267'01 254 00 0 00 003273' 19299 003270'01 265 01 0 00 003252* 19300 003271'01 000000000000# 19301 003272'01 254 00 0 00 003254* 19302 001221'04 106 141 151 154 145 19303 19304 003273'01 607 01 0 00 200000 ifxn. t1, N ; Invalid digit?? 19305 003274'01 254 00 0 00 003304' 19306 003275'01 200 01 0 00 000000# emsg 19307 003276'01 104 00 0 00 000313 19308 001051'02 000000000000# 19309 001230'04 111 154 154 145 147 19310 003277'01 135 01 0 00 000002 ldb t1, t2 ; Pick up what didn't work 19311 003300'01 104 00 0 00 000074 PBOUT% ; Show us 19312 003301'01 561 01 0 00 003206* hrroi t1, crlf ; Load end of line 19313 003302'01 104 00 0 00 000076 PSOUT% ; Print it 19314 003303'01 263 17 0 00 000000 ret ; Return failure 19315 003304'01 endif. 19316 19317 003304'01 327 04 0 00 003312' ifle. t4 ; Exhausted destination string? 19318 003305'01 334 00 0 00 000000 %ermsg (,r) 19319 003306'01 254 00 0 00 003312' 19320 003307'01 265 01 0 00 003270* 19321 003310'01 000000000000# 19322 003311'01 254 00 0 00 003272* 19323 001240'04 123 160 145 143 151 19324 003312'01 endif. 19325 19326 003312'01 250 04 0 00 000007 exch t4, q3 ; Position left-justified result in adjacent AC 19327 003313'01 201 06 0 00 000014 movei q2, ^d12 ; Load original (slightly bogus) limit 19328 003314'01 274 06 0 00 000007 sub q2, q3 ; Calculate log base 8 of final number (heh) 19329 003315'01 325 06 0 00 003323' ifl. q2 ; Complete gubbish? 19330 003316'01 334 00 0 00 000000 %ermsg (,r) 19331 003317'01 254 00 0 00 003323' 19332 003320'01 265 01 0 00 003307* 19333 003321'01 000000000000# 19334 003322'01 254 00 0 00 003311* 19335 001253'04 117 143 164 141 154 19336 003323'01 endif. 19337 003323'01 326 06 0 00 003331' ife. q2 ; Never did anything?? 19338 003324'01 334 00 0 00 000000 %ermsg (,r) 19339 003325'01 254 00 0 00 003331' 19340 003326'01 265 01 0 00 003320* 19341 003327'01 000000000000# 19342 003330'01 254 00 0 00 003322* 19343 001263'04 117 143 164 141 154 19344 003331'01 endif. ; Very puzzling 19345 19346 003331'01 221 06 0 00 000003 imuli q2, ^d3 ; Three bits per octal digit 19347 003332'01 246 03 0 06 000000 lshc t3, (q2) ; Shift the bits into the right place K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 42-2 K20IOC MAC 20-Jan-23 21:49 Octal Conversion 19348 19349 003333'01 621 01 0 00 700000 txz t1, S!N!M ; Clear the flags some more 19350 003334'01 271 01 0 00 000001 addi t1,^d1 ; Account for character we stopped on 19351 003335'01 474 06 0 00 000000 seto q2, ; But are now at, so back up the point 19352 003336'01 133 06 0 00 000002 adjbp q2, t2 ; so that an ildb works and the consequent 19353 003337'01 250 06 0 00 000002 exch q2, t2 ; Say this is the real pointer 19354 003340'01 254 00 0 00 003255* retskp ; And return with the correct register file 19355 19356 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 43 K20IOC MAC 20-Jan-23 21:49 Translation table for first character to search for 19357 subttl Translation table for first character to search for 19358 19359 ; Translate tables cannot be in extended text (non-zero section) 19360 ; because we need to use them to transfer a few characters for match 19361 ; purposes. 19362 ; 19363 ; N.B., a NUL character stops the search, but does NOT set the 'N' 19364 ; bit! ntrigr has to account for this because data that comes back 19365 ; from Tops-10 can have NUL's in it. Might be padding. 19366 19367 chgsec(code,const) ;;Put table in constants area 19368 19369 000002 %asc1c=.chcnb ; ASCII values start at Control-B 19370 19371 remark Base translate table passes all 7 bit data 19372 19373 001052'02 100000 000001 btrnst: xwd eoscod!.chnul,.chcna ;;NUL terminates 19374 xlist ; Don't need to see all this junk 19375 list ; Restart the blather 19376 19377 remark For eight bit data, everything stops us 19378 19379 100200 %asc1c=eoscod!200!.chnul ; Anything we translate with bit 8 is bad 19380 19381 xlist ; Don't need to see all this junk 19382 list ; Restart the blather 19383 000200 sertln==.-btrnst ; Calculate search table length 19384 ; After second pass, not needed at all 19385 cleans(<%asc1c>) ;;Don't polute the symbol table 19386 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 44 K20IOC MAC 20-Jan-23 21:49 Caseless Translation table for first character to search for 19387 subttl Caseless Translation table for first character to search for 19388 19389 ; N.B., a NUL character stops the search, but does NOT set the 'N' 19390 ; bit! ntrigr has to account for this because data that comes back 19391 ; from Tops-10 can have NUL's in it. 19392 19393 000002 %asc1u=.chcnb ; ASCII values start at Control-B 19394 19395 remark Base translate table passes all 7 bit data, uppercasing along the way 19396 19397 001252'02 100000 000001 btrnsu: xwd eoscod!.chnul,.chcna ;;NUL terminates 19398 xlist ; Don't need to see all this junk 19399 list ; Restart the blather 19400 19401 001352' %eotsu=. ; Remember end of table 19402 19403 001332'02 reloc btrnsu+<<"`">_-1> ; Gets us to the corrct halfword pair 19404 001332'02 000140 000101 xwd "`","A" ; Convert lowercase a to UPPERcase A 19405 19406 000102 %asc1u="B" ; Starting at lowercase b 19407 xlist ; Don't need to see all this junk 19408 list ; Restart the blather 19409 19410 001347'02 000132 000173 xwd "Z",173 ; Last letter and Left brace 19411 19412 001352'02 reloc %eotsu ; Get back to end of table 19413 19414 remark For eight bit data, everything stops us 19415 19416 100200 %asc1u==eoscod!200!.chnul ; Anything we translate with bit 8 is bad 19417 .xcref %asc1u ; Keep off cross reference 19418 19419 xlist ; Don't need to see all this junk 19420 list ; Restart the blather 19421 19422 cleans(<%asc1u,%eotsu>) ;;Punt working symbols 19423 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 45 K20IOC MAC 20-Jan-23 21:49 Macro to build a parity generating and checking tables 19424 subttl Macro to build a parity generating and checking tables 19425 19426 ; Inspired by PARBIT remote macro in TTYSRV (see CHITAB). buildp is 19427 ; a more generalized approach to handle both checking and generating 19428 ; any kind of a parity table, suitable for string instructions. 19429 ; 19430 ; To generate various parities: 19431 ; 19432 ; Mark buildp(200,200) ;;Sets both odd and even, always 19433 ; Space buildp(0,0) ;;N.B., can be optimized with movslj for 7 bit 19434 ; Even buildp(200,0) ;;Only emit even parity bit 19435 ; Odd buildp(0,200) ;;Only emit odd parity bit 19436 ; 19437 ; To double check the table, set the parity you want and run a timing test 19438 19439 define buildp(evn,odp) < ;;Builds a parity table 19440 xlist ;; Save us the blat, please ... 19441 odp!.chnul,,evn!.chcna ;; 0 ^@,, 1 ^A NULL,, 19442 evn!.chcnb,,odp!.chcnc ;; 2 ^B,, 3 ^C 19443 evn!.chcnd,,odp!.chcne ;; 4 ^D,, 5 ^E 19444 odp!.chcnf,,evn!.chbel ;; 6 ^F,, 7 ^G ,,Bell 19445 evn!.chbsp,,odp!.chtab ;; 10 ^H,, 11 ^I Backspace,,Tab 19446 odp!.chlfd,,evn!.chvtb ;; 12 ^J,, 13 ^K Line-Feed,,Vertical Tab 19447 odp!.chffd,,evn!.chcrt ;; 14 ^L,, 15 ^M Form Feed,,Carriage Return 19448 evn!.chcnn,,odp!.chcno ;; 16 ^N,, 17 ^O 19449 evn!.chcnp,,odp!.chcnq ;; 20 ^P,, 21 ^Q 19450 odp!.chcnr,,evn!.chcns ;; 22 ^R,, 23 ^S 19451 odp!.chcnt,,evn!.chcnu ;; 24 ^T,, 25 ^U 19452 evn!.chcnv,,odp!.chcnw ;; 26 ^V,, 27 ^W 19453 odp!.chcnx,,evn!.chcny ;; 30 ^X,, 31 ^Y 19454 evn!.chcnz,,odp!.chesc ;; 32 ^Z,, 33 ^[ ,,Escape Control 19455 evn!.chcbs,,odp!.chcrb ;; 34 ^\,, 35 ^] Control Backslash,,Right Bracket 19456 odp!.chccf,,evn!.chcun ;; 36 ^^,, 37 ^_ Control Cicumflex,,Underline 19457 evn!.chspc,,odp!"!" ;; 40 ,, 41 ! Space,, 19458 odp!.chdbq,,evn!"#" ;; 42 " ,, 43 # Double quote,, 19459 odp!"$",,evn!"%" ;; 44 $ ,, 45 % 19460 evn!"&",,odp!"'" ;; 46 & ,, 47 ' 19461 odp!"(",,evn!")" ;; 50 ( ,, 51 ) 19462 evn!"*",,odp!"+" ;; 52 * ,, 53 + 19463 evn!",",,odp!"-" ;; 54 , ,, 55 - Comma,,Dash (Minus Sign) 19464 odp!".",,evn!"/" ;; 56 . ,, 57 / Dot,,Forward Slash 19465 odp!"0",,evn!"1" ;; 60 0 ,, 61 1 19466 evn!"2",,odp!"3" ;; 62 2 ,, 63 3 19467 evn!"4",,odp!"5" ;; 64 4 ,, 65 5 19468 odp!"6",,evn!"7" ;; 66 6 ,, 67 7 19469 evn!"8",,odp!"9" ;; 70 8 ,, 71 9 19470 odp!":",,evn!";" ;; 72 : ,, 73 ; Colen,, Semicolen 19471 odp!.chlpt,,evn!"=" ;; 74 ,, 75 = Left pointy,, 19472 evn!.chrpt,,odp!"?" ;; 76 ,, 77 ? ,,Right pointy 19473 evn!"@",,odp!"A" ;; 100 @ ,,101 A 19474 odp!"B",,evn!"C" ;; 102 B ,,103 C 19475 odp!"D",,evn!"E" ;; 104 D ,,105 E 19476 evn!"F",,odp!"G" ;; 106 F ,,107 G 19477 odp!"H",,evn!"I" ;; 110 H ,,111 I 19478 evn!"J",,odp!"K" ;; 112 J ,,113 K K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 45-1 K20IOC MAC 20-Jan-23 21:49 Macro to build a parity generating and checking tables 19479 evn!"L",,odp!"M" ;; 114 L ,,115 M 19480 odp!"N",,evn!"O" ;; 116 N ,,117 O 19481 odp!"P",,evn!"Q" ;; 120 P ,,121 Q 19482 evn!"R",,odp!"S" ;; 122 R ,,123 S 19483 evn!"T",,odp!"U" ;; 124 T ,,125 U 19484 odp!"V",,evn!"W" ;; 126 V ,,127 W 19485 evn!"X",,odp!"Y" ;; 130 X ,,131 Y 19486 odp!"Z",,evn!"[" ;; 132 Z ,,133 [ ,,Open Broket 19487 odp!"\",,evn!"]" ;; 134 \ ,,135 ] Backslash,,Close Broket 19488 evn!"^",,odp!"_" ;; 136 ^ ,,137 _ Up arrow,,Underline 19489 odp!"`",,evn!"a" ;; 140 ` ,,141 a Backtic (accent grave) 19490 evn!"b",,odp!"c" ;; 142 b ,,143 c 19491 evn!"d",,odp!"e" ;; 144 d ,,145 e 19492 odp!"f",,evn!"g" ;; 146 f ,,147 g 19493 evn!"h",,odp!"i" ;; 150 h ,,151 i 19494 odp!"j",,evn!"k" ;; 152 j ,,153 k 19495 odp!"l",,evn!"m" ;; 154 l ,,155 m 19496 evn!"n",,odp!"o" ;; 156 n ,,157 o 19497 evn!"p",,odp!"q" ;; 160 p ,,161 q 19498 odp!"r",,evn!"s" ;; 162 r ,,163 s 19499 odp!"t",,evn!"u" ;; 164 t ,,165 u 19500 evn!"v",,odp!"w" ;; 166 v ,,167 w 19501 odp!"x",,evn!"y" ;; 170 x ,,171 y 19502 evn!"z",,odp!"{" ;; 172 z ,,173 { Open Curly Brace 19503 evn!"|",,odp!"}" ;; 174 | ,,175 } Vertical Bar,,Close Curley Brace 19504 odp!"~",,evn!.chdel ;; 176 ~ ,,177 $? HZ2000 Lead in (!),,Rubout 19505 list ;; Turn the blat back on 19506 >;;buildp 19507 19508 define badpar (b,%b,%c) < ;;Generates a table with bad parity 19509 ifb ,<%b=0> ;;If no bit specified, default to zero 19510 ifnb ,<%b=b> ;;Otherwise, use the bit 19511 %c=trmcod!%b!.chnul ;;Starts out with NUL character, which fails 19512 xlist ; Don't need to see all this junk 19513 repeat ^d<<128>_-1>,< ;;Fill table with one to one translations 19514 xwd %c,%c+1 ;;Properly fill half words, failing every single one 19515 %c=%c+2 ;;Step to next pair 19516 >;;repeat ^d64 ;;Do remaining 126 characters 19517 list ; Restart the blather 19518 cleans(<%b,%c>) ;;Punt working symbols 19519 > K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 46 K20IOC MAC 20-Jan-23 21:49 String based parity generating and checking tables 19520 subttl String based parity generating and checking tables 19521 19522 ;[223] Begin table insertions (still in const .psect) 19523 19524 remark Seven to Eight bit parity generating tables 19525 19526 ; N.B., as with single character routines, bit 8 is disregarded 19527 ; when generating parity 19528 19529 001452'02 spar7t: buildp(0,0) ; Space parity simply always clears bit 8 19530 buildp(0,0) ; Clear it for anything with bit 8 up 19531 001652'02 mpar7t: buildp(200,200) ; Mark parity simply always sets bit 8 19532 buildp(200,200) ; Set it for anthing with bit 8 up 19533 002052'02 epar7t: buildp(200,0) ; Build even parity generating table 19534 buildp(200,0) ; Ignore bit 8 and process as if it were zero 19535 002252'02 opar7t: buildp(0,200) ; Build odd parity generating table 19536 buildp(0,200) ; Ignore bit 8 and process as if it were zero 19537 19538 subttl Eight to Seven bit parity checking tables 19539 19540 002452'02 spar8t: buildp(0,0) ; For space, the 1st 128 do not have bit 8 set, so fine 19541 badpar(200) ; However, any with bit 8 up are BAD 19542 002652'02 mpar8t: badpar(0) ; For mark, the 1st 128 do not have bit 8 set, so BAD 19543 buildp(0,0) ; 2nd 128 have bit 8 up, so fine; strip off the parity 19544 003052'02 epar8t: buildp(trmcod,0) ; Anything with even parity should NOT be in lower 128 19545 buildp(0,trmcod) ; Otherwise, odd parity should not be in upper 128 19546 003252'02 opar8t: buildp(0,trmcod) ; Any odd parity set should not be in lower 128 19547 buildp(trmcod,0) ; Likewise, even parity should not be in upper 128 19548 19549 retsec ; Back into code .psect 19550 19551 ;[223] End table insertions 19552 19553 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 47 K20IOC MAC 20-Jan-23 21:49 Parity routines, used for a single byte and checking 19554 subttl Parity routines, used for a single byte and checking 19555 19556 ; All accept a character in t1, returning the same character with proper 19557 ; parity in t1. +1 always because nothing fails. Supposedly... 19558 19559 003341'01 none: remark ; Default, don't touch the eighth bit. 19560 entry none 19561 003341'01 263 17 0 00 000000 ret 19562 19563 003342'01 mark: remark ; Mark, bit 8 is always 1. 19564 entry mark 19565 003342'01 435 01 0 00 000200 ori t1, ^o200 ; Turn on the parity bit. 19566 003343'01 263 17 0 00 000000 ret 19567 19568 003344'01 space: remark ; Space, opposite of mark, bit 8 is always zero. 19569 entry space 19570 003344'01 405 01 0 00 000177 andi t1, ^o177 ; Turn off the parity bit. 19571 003345'01 263 17 0 00 000000 ret 19572 19573 003346'01 even: remark ; Even, the total number of one bits should be even. 19574 entry even 19575 003346'01 265 16 0 00 004172' saveac 19576 003347'01 405 01 0 00 000177 andi t1, ^o177 ; Start off with bit 8 = 0. 19577 003350'01 200 02 0 00 000001 move t2, t1 19578 003351'01 254 00 0 00 003355' jrst evnodd 19579 19580 003352'01 odd: remark ; Odd, the total number of one bits should be odd. 19581 entry odd 19582 003352'01 265 16 0 00 004172' saveac 19583 003353'01 405 01 0 00 000177 andi t1, ^o177 ; Turn off the parity bit. 19584 003354'01 201 02 0 01 000200 movei t2, ^o200(t1) ; Start off with bit 8 = 1. 19585 19586 003355'01 evnodd: remark ; The actual worker subroutine 19587 003355'01 242 02 0 00 777774 lsh t2, -4 ; Get high order 4 bits of character 19588 003356'01 431 02 0 01 000000 xori t2, (t1) ; Fold into 4 bits. 19589 003357'01 642 02 0 00 000014 trce t2, 14 ; Left two bits both 0 or 1? 19590 003360'01 606 02 0 00 000014 trnn t2, 14 ; or both 1? 19591 003361'01 431 01 0 00 000200 xori t1, 200 ; Yes, set parity 19592 003362'01 642 02 0 00 000003 trce t2, 3 ; Right two bits both 0? 19593 003363'01 606 02 0 00 000003 trnn t2, 3 ; or both 1? 19594 003364'01 431 01 0 00 000200 xori t1, 200 ; Yes, set parity. 19595 003365'01 263 17 0 00 000000 ret 19596 19597 ;[209] End code insertion 19598 19599 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 48 K20IOC MAC 20-Jan-23 21:49 SET PARITY parsing tables 19600 subttl SET PARITY parsing tables 19601 19602 ;[223] This code moved from k20par and updated 19603 19604 003452'02 000000 000000 %table(partab) ;[223] Values are all table offsets, below 19605 003453'02 000000# 000003 %key2 , .parev ;[223] 19606 000050'03 145 166 145 156 000 19607 003454'02 000000# 000002 %key2 , .parmk ;[223] 19608 000051'03 155 141 162 153 000 19609 003455'02 000000# 000000 %key2 , .parno ;[223] 19610 000052'03 156 157 156 145 000 19611 003456'02 000000# 003457' %keyf3 , %odd, ;[223] Abbreviate documented name 19612 000053'03 002000 000005 19613 000054'03 157 000 000 000 000 19614 003457'02 000000# 000004 %odd: %key2 , .parod ;[223] 19615 000055'03 157 144 144 000 000 19616 003460'02 000000# 000002 %keyf3 , .parmk, cm%inv ;[223] A common nickname for 'mark' 19617 000056'03 002000 000001 19618 000057'03 157 156 145 000 000 19619 003461'02 000000# 000001 %key2 , .parsp ;[223] 19620 000060'03 163 160 141 143 145 19621 003462'02 000000# 000001 %keyf3 , .parsp, cm%inv ;[223] A common nickname for 'space' 19622 000062'03 002000 000001 19623 000063'03 172 145 162 157 000 19624 003452'02 000010 000010 %tbend 19625 19626 ;[223] Begin Switch table insertion 19627 19628 comment " The plethora of invisible entries are a result of my being 19629 purely unable to come up with what I thought would be a good 19630 keyword, picking something to get on with it, becoming 19631 dissatisified or otherwise annoyed with that particular 19632 choice and then trying something else until things finally 19633 'looked right', both in a printed switch list and in the 19634 help text. Of course, then I would remember the old names 19635 and ... 19636 " 19637 19638 ; Define some mnemonic symbols to help us not to be confused... 19639 19640 define %Yes <;;> ;;There should only be four (4) documented entries 19641 000001 %No==cm%inv ;;Means not documented in k20hlp.mac 19642 19643 remark ; These are the parity switches 19644 19645 003463'02 000000 000000 %table(parswi) 19646 remark AC Value Documented? 19647 003464'02 000000# 000000# %keyf4 (, q3, 0, %No ) 19648 000064'03 002000 000001 19649 000065'03 141 154 154 055 143 19650 000070'03 000007 000000 19651 003465'02 000000# 000000# %key3 (, q4, -1) 19652 000071'03 143 150 145 143 153 19653 000075'03 000010 777777 19654 %Yes K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 48-1 K20IOC MAC 20-Jan-23 21:49 SET PARITY parsing tables 19655 003466'02 000000# 000000# %keyf4 (, q3, 0, %No ) 19656 000076'03 002000 000001 19657 000077'03 145 166 145 162 171 19658 000102'03 000007 000000 19659 003467'02 000000# 000000# %key3 (, q4, 0) 19660 000103'03 147 145 156 145 162 19661 000106'03 000010 000000 19662 %Yes 19663 003470'02 000000# 000000# %key3 (, q3, -1) 19664 000107'03 160 141 143 153 145 19665 000112'03 000007 777777 19666 %Yes 19667 003471'02 000000# 000000# %keyf4 (, q4, -1, %No ) 19668 000113'03 002000 000001 19669 000114'03 160 141 162 151 164 19670 000120'03 000010 777777 19671 003472'02 000000# 000000# %keyf4 (, q4, -1, %No ) 19672 000121'03 002000 000001 19673 000122'03 162 145 143 145 151 19674 000125'03 000010 777777 19675 003473'02 000000# 000000# %key3 (, q3, 0) 19676 000126'03 164 145 162 155 151 19677 000133'03 000007 000000 19678 %Yes 19679 003463'02 000010 000010 %tbend 19680 19681 cleans(<%Yes,%No>) ;;Clean up worker symbols 19682 19683 ;[223] End switch table insertion 19684 19685 chgsec(code,const) ;;[223] FDB's are not in code, they're in const 19686 19687 003474'02 schrpr: remark ;[223] Single character parity routines 19688 003474'02 000000000000# none ;[223] Don't do parity 19689 003475'02 000000000000# space ;[223] Bit 8 is always clear 19690 003476'02 000000000000# mark ;[223] Bit 8 is always set 19691 003477'02 000000000000# even ;[223] Even parity 19692 003500'02 000000000000# odd ;[223] Odd parity 19693 19694 003501'02 stpart: remark ;[223] String based parity tables 19695 003501'02 000 00 0 00 000000 Z ;[223] None means do nothing 19696 003502'02 001452' 002452' spar7t,,spar8t ;[223] Space parity generating and checking 19697 003503'02 001652' 002652' mpar7t,,mpar8t ;[223] Mark parity generating and checking 19698 003504'02 002052' 003052' epar7t,,epar8t ;[223] Even parity generating and checking 19699 003505'02 002252' 003252' opar7t,,opar8t ;[223] Odd parity generating and checking 19700 19701 003506'02 010004 003511' spafdb: flddb. .cmcfm,,,,,spafdd 19702 003507'02 000000 000000 19703 003510'02 44 07 0 00 003721' 19704 003511'02 000000 000000 spafdd: flddb. .cmkey,,partab,,,, ;;[223] If in a define 19705 003512'02 000000 003452' 19706 19707 003513'02 010004 003516' spwfdb: flddb. .cmcfm,,,,,spwfdd 19708 003514'02 000000 000000 19709 003515'02 44 07 0 00 003732' K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 48-2 K20IOC MAC 20-Jan-23 21:49 SET PARITY parsing tables 19710 003516'02 003002 000000 spwfdd: flddb. .cmswi,,parswi,,,, ;;[223] If in a define 19711 003517'02 000000 003463' 19712 003520'02 000000 000000 19713 003521'02 44 07 0 00 003737' 19714 19715 retsec ;;Back to where-ever we started from 19716 19717 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 49 K20IOC MAC 20-Jan-23 21:49 SET PARITY parsing 19718 subttl SET PARITY parsing 19719 19720 003366'01 .setpa: entry .setpa ;[223] Invoked from k20par 19721 003366'01 200 16 0 00 000000# guide 19722 003367'01 260 17 0 00 001444* 19723 003522'02 000000000000# 19724 001274'04 164 157 000 000 000 19725 003370'01 201 01 0 00 000000# movei t1, spafdb ;[223] Assume not defining a macro 19726 003371'01 332 00 0 00 000250* skipe definf ;[223] But!! Are we in a define? 19727 003372'01 201 01 0 00 000000# movei t1, spafdd ;[223] Indeed; don't parse a confirm 19728 003373'01 260 17 0 00 001501* call rfield ; Parse a keyword. 19729 003374'01 135 03 0 00 003671' ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ;[223] Get what was parsed 19730 19731 003375'01 302 03 0 00 000010 caie t3, .cmcfm ;[223] Parsed a confirm? 19732 003376'01 254 00 0 00 003403' ifskp. ;[223] We did, 19733 003377'01 403 02 0 00 000003 setzb t2, t3 ;[223] so load default values 19734 003400'01 202 02 0 00 000231* movem t2, pars3 ;[223] Offset zero is 'none' 19735 003401'01 124 02 0 00 002013* dmovem t2, pars4 ;[223] Parity on all I/O, sent--not checked 19736 003402'01 263 17 0 00 000000 ret ;[223] Nothing further to do; comand is confirmed 19737 003403'01 endif. ;[223] End requesting default values 19738 19739 003403'01 265 16 0 00 003707' saveac ;[223] Needs a few more registers 19740 003404'01 550 02 0 02 000000 hrrz t2, (t2) ; Get the value for the keyword. 19741 003405'01 120 05 0 00 000002 dmove q1, t2 ;[223] Save value and parse type 19742 003406'01 403 07 0 00 000010 setzb q3, q4 ;[223] Assume parity on all I/O, sent--not checked 19743 19744 003407'01 do. ;[223] Enter loop context 19745 003407'01 201 01 0 00 000000# movei t1, spwfdb ;[223] Assume we can confirm 19746 003410'01 332 00 0 00 003371* skipe definf ;[223] But!! Are we in a define? 19747 003411'01 201 01 0 00 000000# movei t1, spwfdd ;[223] We are; wait on the confirm 19748 003412'01 260 17 0 00 000000* call rflde ;[223] Try to parse something 19749 003413'01 254 00 0 00 003424' ifskp. ;[223] Worked!! 19750 003414'01 135 06 0 00 003671' ldb q2, [pointr (.cmfnp(t3),cm%fnc)] ;[223] Get function code. 19751 003415'01 306 06 0 00 000010 cain q2, .cmcfm ;[223] Finally finished typing switches? 19752 003416'01 254 00 0 00 003430' exit. ;[223] Yes, break out of the loop 19753 003417'01 550 01 0 02 000000 hrrz t1, (t2) ;[223] Get the value pair for the switch 19754 003420'01 554 02 0 01 000000 hlrz t2, (t1) ;[223] Pick up the address 19755 003421'01 570 03 0 01 000000 hrre t3, (t1) ;[223] Sign extend the value 19756 003422'01 202 03 0 02 000000 movem t3, (t2) ;[223] Side effect something 19757 003423'01 254 00 0 00 003427' else. ;[223] Otherwise, failed the parse 19758 003424'01 336 00 0 00 003410* skipn definf ;[223] In DEFINE? 19759 003425'01 254 00 0 00 000000* jrst cmderr ;[223] No, so a definite parse error; allow retry 19760 003426'01 263 17 0 00 000000 ret ;[223] Return into DEFINE and see if that chokes 19761 003427'01 endif. ;[223] End parse result handling 19762 003427'01 254 00 0 00 003407' loop. ;[223] Get another switch 19763 003430'01 enddo. ;[223] End loop lexical context 19764 19765 003430'01 202 05 0 00 003400* movem q1, pars3 ;[223] Store parity actions 19766 003431'01 124 07 0 00 003401* dmovem q3, pars4 ;[223] Store where to apply parity 19767 003432'01 263 17 0 00 000000 ret ;[223] Whether or not in a define, can return 19768 19769 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 50 K20IOC MAC 20-Jan-23 21:49 SET PARITY semantic action 19770 subttl SET PARITY semantic action 19771 19772 extern nrtflg ;[223] Tops-20/Tops-10 DECnet NRT? 19773 extern ptyflg ;[223] Talking to ourselves? 19774 extern lclpar ;[223] Whether local line will do parity 19775 extern opnpar ;[223] Whether open device will do parity 19776 extern parity ;[194] Parity routine we'll use 19777 extern ebq ;[194] Eight bit quoting character 19778 extern ebqr ;[194] We'll request eight bit quoting 19779 19780 chgsec(code,data) ;[223] Need writable storage 19781 000000'05 000 00 0 00 000000 genint:: Z ;[223] Constructed instruction to generate parity 19782 000001'05 000 00 0 00 000000 chkint:: Z ;[223] Constructed instruction to check parity 19783 000002'05 000 00 0 00 000000 parpko:: Z ;[223] Doing parity on packets, only 19784 000003'05 000 00 0 00 000000 parrck:: Z ;[223] Checking parity on recieve in addition to sending 19785 retsec ;[223] Get back into code psect 19786 19787 003433'01 $setpa: entry $setpa ;[223] Invoked from k20par 19788 extern ttfork ;[223] Parity change forces a fork-reset 19789 003433'01 265 16 0 00 003672' saveac ;[223] Needs a register 19790 19791 003434'01 120 01 0 00 003431* dmove t1, pars4 ;[223] Pick up parity domain parse results 19792 003435'01 124 01 0 00 000000# dmovem t1, parpko ;[223] Store in global variables 19793 19794 003436'01 200 05 0 00 003430* move q1, pars3 ;[223] What did they say? 19795 003437'01 200 06 0 05 000000# move q2, schrpr(q1) ;[223] Pick up single character parity routine 19796 003440'01 554 02 0 05 000000# hlrz t2, stpart(q1) ;[223] Load string based parity generation routine 19797 003441'01 322 02 0 00 003446' ifn. t2 ;[223] Do we have anything? 19798 003442'01 550 03 0 05 000000# hrrz t3, stpart(q1) ;[223] Yes, load string based parity checking routine 19799 003443'01 505 02 0 00 015000 hrli t2, (movst 0,0) ;[223] Drop in the 19800 003444'01 505 03 0 00 015000 hrli t3, (movst 0,0) ;[223] extended opcodes 19801 003445'01 254 00 0 00 003447' else. ;[223] Otherwise, this is 'none', which is special cased 19802 003446'01 400 03 0 00 000000 setz t3, ;[223] Nothing in t3 19803 003447'01 endif. ;[223] End case extended instruction construction 19804 003447'01 124 02 0 00 000000# dmovem t2, genint ;[223] Store both extended string instructions 19805 003450'01 202 06 0 00 002712* movem q2, parity ;[223] Store single character routines 19806 19807 003451'01 260 17 0 00 003534' call parchr ;[223] Recompute parity on important characters 19808 003452'01 336 01 0 00 000000* skipn t1, ttfork ;[223] Are we doing interactive communications? 19809 003453'01 254 00 0 00 003463' ifskp. ;[223] We are, must reset to use new parity 19810 003454'01 104 00 0 00 000153 KFORK% ;[223] Whack the communications fork 19811 003455'01 320 12 0 00 003457' %jsErr (,) ;[223] 19812 003456'01 254 00 0 00 003462' 19813 003457'01 265 01 0 00 003326* 19814 003460'01 000000000000# 19815 003461'01 254 00 0 00 003462' 19816 001275'04 125 156 141 142 154 19817 003462'01 402 00 0 00 003452* setzm ttfork ;[223] And force a recreate 19818 003463'01 endif. ;[223] End case resetting comunications fork 19819 19820 003463'01 302 06 0 00 003341' caie q2, none ;[194] Was the parity NONE? 19821 003464'01 254 00 0 00 003471' ifskp. ;[194] Yes, it was 19822 003465'01 201 01 0 00 000131 movei t1, "Y" ;[194] Just say we will do 8th-bit 19823 003466'01 202 01 0 00 000000* movem t1, ebq ;[95] prefixing if requested. 19824 003467'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 15:18 11-Jun-23 Page 50-1 K20IOC MAC 20-Jan-23 21:49 SET PARITY semantic action 19825 003470'01 254 00 0 00 003533' else. ;[194] Otherwise, not NONE 19826 003471'01 476 00 0 00 003467* setom ebqr ;[194] So request 8th-bit prefixing. 19827 003472'01 201 02 0 00 000046 movei t2, dqbin ;[89] Use the default prefix. 19828 003473'01 202 02 0 00 003466* movem t2, ebq ;[89] 19829 003474'01 336 00 0 00 002375* ifmn. netjfn ;[223] Network connection? 19830 003475'01 254 00 0 00 003523' 19831 003476'01 332 00 0 00 000000* ifme. opnpar ;[223] Yes, does it NOT do parity? 19832 003477'01 254 00 0 00 003522' 19833 003500'01 336 00 0 00 000000* ifmn. nrtflg ;[223] DECnet connection? 19834 003501'01 254 00 0 00 003506' 19835 003502'01 200 01 0 00 000000# txmsg <%Network connection> ;[223] Yes, say as such 19836 003503'01 104 00 0 00 000076 19837 003504'01 320 12 0 00 003505' 19838 003523'02 000000000000# 19839 001310'04 045 116 145 164 167 19840 003505'01 254 00 0 00 003517' else. ;[223] Otherwise, it's something else 19841 003506'01 336 00 0 00 000000* ifmn. ptyflg ;[223] PTY? 19842 003507'01 254 00 0 00 003514' 19843 003510'01 200 01 0 00 000000# txmsg <%Pseudo-terminal> ;[223] 19844 003511'01 104 00 0 00 000076 19845 003512'01 320 12 0 00 003513' 19846 003524'02 000000000000# 19847 001314'04 045 120 163 145 165 19848 003513'01 254 00 0 00 003517' else. ;[223] Otherwise, physical line 19849 003514'01 200 01 0 00 000000# txmsg <%Terminal line> ;[223] 19850 003515'01 104 00 0 00 000076 19851 003516'01 320 12 0 00 003517' 19852 003525'02 000000000000# 19853 001320'04 045 124 145 162 155 19854 003517'01 endif. ;[223] End PTY decision 19855 003517'01 endif. ;[223] End NRT decision 19856 txmsg < does not support parity 19857 003517'01 200 01 0 00 000000# > ;[223] Remind terminal-and-packets ill-advised 19858 003520'01 104 00 0 00 000076 19859 003521'01 320 12 0 00 003522' 19860 003526'02 000000000000# 19861 001323'04 040 144 157 145 163 19862 19863 003522'01 endif. ;[223] End case parity on network device 19864 003522'01 254 00 0 00 003530' else. ;[223] Otherwise, using control terminal 19865 003523'01 332 00 0 00 000000* ifme. lclpar ;[223] Will local line will do parity? 19866 003524'01 254 00 0 00 003530' 19867 txmsg <%Control terminal line does not support parity 19868 003525'01 200 01 0 00 000000# > ;[223] Remind terminal-and-packets ill-advised 19869 003526'01 104 00 0 00 000076 19870 003527'01 320 12 0 00 003530' 19871 003527'02 000000000000# 19872 001331'04 045 103 157 156 164 19873 19874 003530'01 endif. ;[223] 19875 003530'01 endif. ;[223] End case checking device parity toleration 19876 txmsg <%Will request 8th-bit prefixing. 19877 If the other KERMIT doesn't agree, binary files cannot be sent correctly. 19878 003530'01 200 01 0 00 000000# > 19879 003531'01 104 00 0 00 000076 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 50-2 K20IOC MAC 20-Jan-23 21:49 SET PARITY semantic action 19880 003532'01 320 12 0 00 003533' 19881 003530'02 000000000000# 19882 001343'04 045 127 151 154 154 19883 19884 19885 003533'01 endif. ;[194] End case doing SOME kind of parity 19886 19887 003533'01 263 17 0 00 000000 ret 19888 19889 ;[223] End code move 19890 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 51 K20IOC MAC 20-Jan-23 21:49 If parity changes, side effect certain characters 19891 subttl If parity changes, side effect certain characters 19892 19893 ;[223] Begin code insertion 19894 19895 ; Parity had been computed on all characters in a sending packet 19896 ; except where a character might be outside of the packet proper. One 19897 ; such character would be padding, which is simply emitted before the 19898 ; packet itself is sent. 19899 ; 19900 ; Now the entire message is built including the padding, start-of- 19901 ; header and end-of-line characters and then putpar is called to apply 19902 ; parity in a single extended instruction. 19903 ; 19904 ; There are certain situations where the characters are looked for 19905 ; individually, so this code applies parity to all of them whenever 19906 ; parity changes. If the characters themselves change, then the 19907 ; routines doing the changes apply current parity. 19908 ; 19909 ; Note that we don't tweak the received characters because the chkpar 19910 ; routine is called before we ever get to checking them. Since it 19911 ; strips parity, we don't need to worry about it; when receiving... 19912 19913 remark ; Document what we'll be tweaking 19914 extern ssthdr ; Sending start of header character 19915 remark rsthdr ; Receiving start of header character 19916 extern spadch ; Sending padding character 19917 remark rpadch ; Receiving padding character 19918 extern seolch ; Sending End of Line character 19919 remark reolch ; Receiving End of Line character 19920 extern handsh ; Handshake character 19921 19922 chgsec(code,const) ; Table of addresses is constant data 19923 003531'02 000000000000# pchars: exp ssthdr,spadch,seolch,handsh 19924 000004 pcharl==.-pchars ; Number of entries in the table 19925 retsec ; Return to code psect 19926 19927 003534'01 265 16 0 00 003663' parchr: saveac ; Used as a counter 19928 003535'01 201 05 0 00 000003 movx q1, ; Load maximum offset 19929 19930 003536'01 do. ; Enter loop context 19931 003536'01 200 01 1 05 000000# move t1, @pchars(q1) ; Load the character 19932 003537'01 405 01 0 00 000177 andi t1, ^o177 ; Stomp any previous parity 19933 003540'01 260 17 0 06 000000 call (q2) ; Apply the appropriate parity 19934 003541'01 202 01 1 05 000000# movem t1, @pchars(q1) ; Store the proper character 19935 003542'01 365 05 0 00 003536' sojge q1, top. ; Do the next character until done 19936 003543'01 enddo. ; End of loop lexical context 19937 19938 003543'01 263 17 0 00 000000 ret ; Done fixing up everything 19939 19940 cleans () ; Clean up working symbol 19941 19942 ;[223] End code insertion 19943 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 52 K20IOC MAC 20-Jan-23 21:49 Put parity on an eight bit stream 19944 subttl Put parity on an eight bit stream 19945 19946 ;[223] Begin code insertion 19947 19948 ; The algorythm is actually straightforward; the routine is passed a 19949 ; pointer to a buffer that is almost ready to send, meaning we are the 19950 ; last operation directly before the SOUT%/SOUTR%. The buffer is 19951 ; assumed to contain 7 bit ASCII characters in 8 bit bytes, thus 19952 ; giving the routine a place to put the parity. 19953 ; 19954 ; It checks whether parity is being done and, if so, loads the single 19955 ; instruction that will perform the operation. This is a MOVST which 19956 ; has been constructed with the appropriate translate table. 19957 ; 19958 ; Again, although the byte pointer being passed is eight bits, the 19959 ; string is treated as a series of seven bit bytes in 8 bit fields 19960 ; where the current setting of the eigth bit is discarded. The string 19961 ; is overwritten in place with the correct parity, at which point, it 19962 ; will be completely ready to be sent. 19963 ; 19964 ; Once the MOVST is started, the whole process is effectively a series 19965 ; of table lookups with no computations involved at all. 19966 ; 19967 ; The routine is faster than calling the single character conversion 19968 ; routines, even for the shortest possible Kermit packet of three 19969 ; characters. In other words, even with all the register pushing and 19970 ; popping, it still always wins. 19971 ; 19972 ; Depending on your view, the amount of memory taken up by the 19973 ; translation tables is not flagrant: a single kiloword and it is 19974 ; shared. 19975 ; 19976 ; Call: (Expected to be just before SOUT%/SOUTR%) 19977 ; 19978 ; t2/ Pointer to eight bit data to overwrite 19979 ; t3/ Negative length of data to do 19980 ; 19981 ; Return: 19982 ; 19983 ; +1, always; appropriate parity, if parity is being done (I.E., not 'none') 19984 19985 003544'01 putpar: entry putpar ; Used by packet routines in k20mit 19986 003544'01 325 03 0 00 003330* jumpge t3, R ; Zero or gubbish? Just leave it alone... 19987 003545'01 200 16 0 00 003450* move cx, parity ; Load current parity setting 19988 003546'01 306 16 0 00 003341' cain cx, none ; Not doing anything? 19989 003547'01 263 17 0 00 000000 ret ; No, so don't do anything 19990 19991 003550'01 265 16 0 00 004200' saveac ; Otherwise, set up eight registers ... 19992 003551'01 210 01 0 00 000003 movn t1, t3 ; Source length 19993 003552'01 200 04 0 00 000001 move t4, t1 ; destination is the same length 19994 003553'01 200 05 0 00 000002 move q1, t2 ; String will be updated in place (I.E., overwritten) 19995 003554'01 403 03 0 00 000006 setzb t3, q2 ; Section local pointers 19996 003555'01 336 07 0 00 000000# skipn q3, genint ; Load and double check extended string instruction 19997 003556'01 263 17 0 00 000000 ret ; Very odd! We checked above, but ignore it 19998 003557'01 400 10 0 00 000000 setz q4, ; Fill character is NUL (yet unused...) K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 52-1 K20IOC MAC 20-Jan-23 21:49 Put parity on an eight bit stream 19999 003560'01 621 01 0 00 300000 txz t1, N!M ; Shut off Negative and Mark 20000 003561'01 661 01 0 00 400000 txo t1, S ; Have to dink the foolish significance bit... 20001 003562'01 123 01 0 00 000007 extend t1, q3 ; Get down to some serious string translating 20002 003563'01 600 00 0 00 000000 nop ; Can't happen 20003 003564'01 263 17 0 00 000000 ret ; Done 20004 20005 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 53 K20IOC MAC 20-Jan-23 21:49 Generate parity on a seven bit stream 20006 subttl Generate parity on a seven bit stream 20007 20008 ; Like the above, except creates a new eight stream from a seven bit 20009 ; stream instead of overwriting the eight bit stream in place. 20010 ; 20011 ; t1/ Pointer to eight bit destination data 20012 ; t2/ Pointer to seven bit source data 20013 ; t3/ Negative length of data to do 20014 ; 20015 ; If parity is being done, then t2 will be updated to the original 20016 ; value of t1, otherwise it is unchanged. t1 is always trashed, 20017 ; everything else is preserved. 20018 ; 20019 ; N.B., The above is fine and everything ...but... 20020 ; THE BYTE WIDTHS ARE *NOT* CHECKED!!!! 20021 20022 003565'01 genpar: entry genpar ; Used by k20dsp and k20net 20023 003565'01 325 03 0 00 003544* jumpge t3, R ; Zero or gubbish? Just leave it alone... 20024 003566'01 200 16 0 00 003545* move cx, parity ; Load current parity setting 20025 003567'01 306 16 0 00 003341' cain cx, none ; Not doing any parity? 20026 003570'01 263 17 0 00 000000 ret ; No, so don't do anything 20027 20028 003571'01 265 16 0 00 004216' saveac ; Otherwise, go hog wild on registers 20029 003572'01 200 11 0 00 000001 move q5, t1 ; Save original destination 20030 003573'01 200 05 0 00 000001 move q1, t1 ; and put it where movst wants to use it 20031 003574'01 210 01 0 00 000003 movn t1, t3 ; Source length is positive 20032 003575'01 200 04 0 00 000001 move t4, t1 ; destination is the same length 20033 003576'01 403 03 0 00 000006 setzb t3, q2 ; Section local pointers 20034 003577'01 336 07 0 00 000000# skipn q3, genint ; Load and double check extended string instruction 20035 003600'01 263 17 0 00 000000 ret ; Very odd! We checked above, but ignore it 20036 003601'01 400 10 0 00 000000 setz q4, ; Fill character is NUL (yet unused...) 20037 003602'01 621 01 0 00 300000 txz t1, N!M ; Shut off Negative and Mark 20038 003603'01 661 01 0 00 400000 txo t1, S ; Have to dink the foolish significance bit... 20039 003604'01 123 01 0 00 000007 extend t1, q3 ; Get down to some serious string translating 20040 003605'01 600 00 0 00 000000 nop ; Can't happen 20041 003606'01 200 02 0 00 000011 move t2, q5 ; Return new source for SOUT%/SOUTR% 20042 003607'01 263 17 0 00 000000 ret ; Done 20043 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 54 K20IOC MAC 20-Jan-23 21:49 Check Parity 20044 subttl Check Parity 20045 20046 ; Call: 20047 ; 20048 ; t2/ Pointer to eight bit data 20049 ; t3/ Negative length of data to do 20050 ; 20051 ; Return: 20052 ; 20053 ; +1, Bad parity, if parity is not none 20054 ; +2, Good parity or none or zero length 20055 ; 20056 ; The routine is faster than calling single character conversion 20057 ; routines for the shortest possible Kermit packet of three 20058 ; characters. In other words, even with all the register pushing and 20059 ; popping, it still always wins. 20060 20061 003610'01 chkpar: entry chkpar ; Used by k10mit 20062 003610'01 325 03 0 00 003340* jumpge t3, RSKP ; Zero or gubbish? Just leave it alone... 20063 003611'01 200 16 0 00 003566* move cx, parity ; Load current parity setting 20064 003612'01 306 16 0 00 003341' cain cx, none ; Not doing anything? 20065 003613'01 254 00 0 00 003610* retskp ; No, so don't do anything 20066 20067 003614'01 265 16 0 00 004200' saveac ; Otherwise, set up eight registers ... 20068 003615'01 210 01 0 00 000003 movn t1, t3 ; Source length 20069 003616'01 200 04 0 00 000001 move t4, t1 ; destination is the same length 20070 003617'01 200 05 0 00 000002 move q1, t2 ; String will be updated in place (I.E., overwritten) 20071 003620'01 403 03 0 00 000006 setzb t3, q2 ; Section local pointers 20072 003621'01 336 07 0 00 000000# skipn q3, chkint ; Load and double check extended string instruction 20073 003622'01 254 00 0 00 003613* retskp ; Very odd! We checked above, but ignore it 20074 003623'01 400 10 0 00 000000 setz q4, ; Fill character is NUL (yet unused...) 20075 003624'01 621 01 0 00 300000 txz t1, N!M ; Shut off Negative and Mark 20076 003625'01 661 01 0 00 400000 txo t1, S ; Have to dink the foolish significance bit... 20077 003626'01 123 01 0 00 000007 extend t1, q3 ; Get down to some serious string translating 20078 003627'01 600 00 0 00 000000 nop ; Can't happen 20079 003630'01 607 01 0 00 200000 txnn t1, N ; Bump into any bad parity? 20080 003631'01 254 00 0 00 003622* retskp ; Nope, we're done 20081 003632'01 263 17 0 00 000000 ret ; Otherwise, bad parity 20082 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 55 K20IOC MAC 20-Jan-23 21:49 padbuf - Generate a buffer of padding characters with correct parity 20083 subttl padbuf - Generate a buffer of padding characters with correct parity 20084 20085 ; Call: 20086 ; 20087 ; t1/ Number of padding characters 20088 ; t2/ 7 bit padding character 20089 ; t3/ Parity to form 20090 ; t4/ Address of buffer to put the padding with proper padding in 20091 ; 20092 ; Returns +1, always 20093 20094 003633'01 padbuf: entry padbuf ; Called from k10mit 20095 003633'01 265 16 0 00 003707' saveac ; Wants some scratch 20096 20097 003634'01 120 05 0 00 000001 dmove q1, t1 ; Save length and character 20098 003635'01 120 07 0 00 000003 dmove q3, t3 ; Save parity and buffer address 20099 20100 003636'01 200 01 0 00 000002 move t1, t2 ; Load padding character 20101 003637'01 260 17 1 00 000007 call @q3 ; Calculate parity 20102 003640'01 200 06 0 00 000001 move q2, t1 ; Make a copy 20103 repeat ^d3, < ; Construct the next four characters 20104 lsh q2, ^d8 ; Shift over an eight bit character 20105 or q2, t1 ; Or in the padding character 20106 > 20107 003641'01 242 06 0 00 000010 20108 003642'01 434 06 0 00 000001 20109 003643'01 242 06 0 00 000010 20110 003644'01 434 06 0 00 000001 20111 003645'01 242 06 0 00 000010 20112 003646'01 434 06 0 00 000001 20113 20114 003647'01 242 06 0 00 000004 lsh q2, ^d4 ; Left justify to make 8 bit ASCIZ 20115 003650'01 202 06 0 10 000000 movem q2,(q4) ; Stomp first word of buffer 20116 20117 003651'01 200 01 0 00 000005 move t1, q1 ; Load original length 20118 003652'01 231 01 0 00 000004 idivi t1, ^d4 ; Four 8 bit characters per word 20119 003653'01 302 02 0 00 000000 caie t2, 0 ; No remainder? 20120 003654'01 271 01 0 00 000001 addi t1, ^d1 ; Round up a word 20121 003655'01 275 01 0 00 000001 subi t1, ^d1 ; Already did first word 20122 003656'01 323 01 0 00 003565* jumple t1, R ; Four characters or less? 20123 ; Otherwise, fill out the rest of the buffer 20124 003657'01 200 02 0 00 000010 move t2, q4 ; Starting address in buffer 20125 003660'01 201 03 0 02 000001 movei t3, 1(t2) ; Next address to fill out the rest of the necessary 20126 003661'01 123 01 0 00 003702' xblt. t1 ; words in the buffer (but not the whole buffer) 20127 003662'01 263 17 0 00 000000 ret ; Done 20128 20129 ;[223] End code insertion 20130 20131 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 56 K20IOC MAC 20-Jan-23 21:49 Close out Code section 20132 subttl Close out Code section 20133 20134 xlist ; Save the trees!!!!! 20135 list 20136 20137 .endps code ; End of code .psect 20138 K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page 57 K20IOC MAC 20-Jan-23 21:49 Local storage 20139 subttl Local storage 20140 20141 .psect data ;Write-able area 20142 20143 000004'05 000000 000000 intima:: defita ;[160] Timeout action for INPUT search. 20144 000005'05 000000 000000 incase:: defics ;[160] Case conversion flag for INPUT search. 20145 000006'05 000000 011610 indeft:: defito ; ** DO NOT ;[194] Default timeout for INPUT search (milliseconds) 20146 000007'05 203500 000000 indeff:: defitf ; REORDER ** ;[212] Same value as floating point seconds 20147 20148 000010'05 000000 000000 indefc:: 0 ;[209] Default search string length in characters 20149 000011'05 000000 000000 indefw:: 0 ;[209] Same length in words 20150 000012'05 indefs:: block strblw ;[209] Storage for default search string (if set) 20151 20152 001012'05 trgchr: block 1 ;[209] The 'trigger' character 20153 001013'05 trnbas: block 2 ;[209] Translation base table we used 20154 001015'05 sertab: block sertln ;[209] Search table 20155 20156 ;[209] Handles register spill from searching routines 20157 20158 001215'05 ornetc: block 1 ; ** DO NOT ;[209] Original network count 20159 001216'05 ornetp: block 1 ; REORDER ** ;[209] Original network pointer (end of buffer) 20160 20161 ;[209] Next two variables are for cross INPUT calls with left over data 20162 20163 001217'05 000000 000000 inpcbf:: 0 ;[209] Number of characters we flushed 20164 001220'05 000000 000000 inpcnt:: 0 ;** DO NOT REORDER** ;[209] Number of characters in buffer 20165 001221'05 44 07 0 00 001222' inpptr: point 7, inpbuf ;[209] Current position in buffer 20166 001222'05 inpbuf:: block strblw ;[209] Area to read data into 20167 20168 002222'05 fsized: block 2 ;[229] File size double word 20169 20170 .endps data ; Close out storage area 20171 20172 .psect text ;[209] Read-only storage 20173 000134'03 inpini: intern inpini ;[209] Used by buffer clearing routines 20174 000134'03 000000 000000 0 ;[209] Nothing in INPUT command buffer 20175 000135'03 44 07 0 00 000000# point 7, inpbuf ;[209] So pointing at beginning 20176 .endps text ;[209] Close out section zero text 20177 20178 20179 .xcmsy ;[194] Ditch MACSYM junk 20180 20181 end NO ERRORS DETECTED PROGRAM BREAK IS 000000 PSECT 1 BREAK IS 004235 FOR CODE PSECT 2 BREAK IS 003745 FOR CONST PSECT 3 BREAK IS 000136 FOR TEXT PSECT 4 BREAK IS 001372 FOR ETEXT PSECT 5 BREAK IS 002224 FOR DATA CPU TIME USED 00:01.822 129P CORE USED K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page S-1 K20IOC MAC 20-Jan-23 21:49 SYMBOL TABLE ATMBLN 000000 ext ESOUT% 104000 000313 int PBOUT 104000 000074 int .CHBSP 000010 sin ATMBUF 000000 ext ETEXT 000000 ext PBOUT% 104000 000074 int .CHCBS 000034 sin BIN 104000 000050 int F 000000 spd POPJFN 000000 ext .CHCCF 000036 sin BIN% 104000 000050 int FB%BSZ 007700 000000 sin PSOUT 104000 000076 int .CHCNA 000001 sin BOUT 104000 000051 int FILJFN 000000 ext PSOUT% 104000 000076 int .CHCNB 000002 sin BOUT% 104000 000051 int FRCLOS 000000 ext Q1 000005 spd .CHCNC 000003 sin BUFFER 000000 ext GJ%FLG 000020 000000 sin Q2 000006 spd .CHCND 000004 sin CALL 260740 000000 GJ%FOU 400000 000000 sin Q3 000007 spd .CHCNE 000005 sin CALLRE 254000 000000 spd GJ%GIV 000001 000000 sin Q4 000010 spd .CHCNF 000006 sin CARIER 000000 ext GJ%GND 000040 000000 sin Q5 000011 spd .CHCNN 000016 sin CCOFF2 000000 ext GJ%NEW 200000 000000 sin R 000000 ext .CHCNO 000017 sin CCON 000000 ext GJ%OLD 100000 000000 sin RET 263740 000000 .CHCNP 000020 sin CFMRTN 000000 ext GJ%UHV 004000 000000 sin RFIELD 000000 ext .CHCNQ 000021 sin CHKLIN 000000 ext GTFDB% 104000 000063 int RFLDE 000000 ext .CHCNR 000022 sin CHKSEC 000000 ext HANDSH 000000 ext RLJFN% 104000 000023 int .CHCNS 000023 sin CJFNBK 000000 ext IOX4 600220 int RSKP 000000 ext .CHCNT 000024 sin CLRBUF 000000 ext ISNULJ 000000 ext S 400000 000000 spd .CHCNU 000025 sin CLREST 000000 ext JFNS 104000 000030 int SBK 000000 ext .CHCNV 000026 sin CLZFF% 104000 000034 int JFNS% 104000 000030 int SC%CTC 400000 000000 sin .CHCNW 000027 sin CM%ABR 000004 sin JOBTAB 000000 ext SESFLG 000000 ext .CHCNX 000030 sin CM%DPP 000002 000000 sin JS%DEV 700000 000000 sin SESJFN 000000 ext .CHCNY 000031 sin CM%FNC 777000 000000 sin KFORK% 104000 000153 int SIN 104000 000052 int .CHCNZ 000032 sin CM%FW 002000 000000 sin LOCAL 000000 ext SIN% 104000 000052 int .CHCRB 000035 sin CM%HPP 000004 000000 sin M 100000 000000 spd SIZEF% 104000 000036 int .CHCRT 000015 sin CM%INV 000001 sin MOVSLJ 016000 000000 SOUT 104000 000053 int .CHCUN 000037 sin CM%SDH 000001 000000 sin MOVST 015000 000000 SOUT% 104000 000053 int .CHDBQ 000042 spd CMDER1 000000 ext N 200000 000000 spd SOUTR% 104000 000532 int .CHDEL 000177 sin CMDERR 000000 ext NBICT 000000 ext STRBF2 000000 ext .CHESC 000033 sin CMLOC 000000 ext NETJFN 000000 ext STRBLC 005000 spd .CHFFD 000014 sin CMPOFF 000000 ext NOIRTN 000000 ext STRBLW 001000 spd .CHLFD 000012 sin CMPON 000000 ext NOP 600000 000000 sin STRBUF 000000 ext .CHLPT 000074 spd CMSEEN 000000 ext NOUT% 104000 000224 int STRC 000000 ext .CHNUL 000000 sin CODE 000000 ext NSICI 000000 ext STRPTR 000000 ext .CHRPT 000076 spd CONST 000000 ext NSIMX 000000 ext T1 000001 spd .CHSPC 000040 sin CPLOC 000000 ext NSITC 000000 ext T2 000002 spd .CHTAB 000011 sin CPSEEN 000000 ext NUL4 000000 ext T3 000003 spd .CHVTB 000013 sin CRLF 000000 ext OF%BSZ 770000 000000 sin T4 000004 spd .CMCFM 000010 sin CX 000016 OF%RD 200000 sin TAKJFN 000000 ext .CMDAT 000001 sin CZ%NCL 040000 000000 sin OF%WR 100000 sin TEXT 000000 ext .CMDEV 000016 sin DATA 000000 ext OPENF% 104000 000021 int TIMDEL 000000 ext .CMFIL 000006 sin DEFICS 000000 spd P 000017 TIMEON 000000 ext .CMFLT 000015 sin DEFINF 000000 ext P1 000011 spd TRMCOD 500000 spd .CMFNP 000000 sin DEFITA 000000 spd P2 000012 spd TTYJFN 000000 ext .CMKEY 000000 sin DEFITF 203500 000000 spd P3 000013 spd TTYOB 000000 ext .CMQST 000021 sin DEFITO 011610 spd P4 000014 spd TTYOU 000000 ext .CMSWI 000003 sin DEVST% 104000 000121 int P5 000015 spd UNBITS 000000 ext .CMTOK 000023 sin DOARPA 000000 ext PARITY 000000 ext VSOCT 000000 ext .CMTXT 000017 sin DOBITS 000000 ext PARS1 000000 ext VSOMX 000000 ext .DVDSK 000000 sin DQBIN 000046 spd PARS2 000000 ext VSOTC 000000 ext .DVNUL 000015 sin DUPLEX 000000 ext PARS3 000000 ext VTERMF 000000 ext .FBBYV 000011 sin DV%TYP 000777 000000 sin PARS4 000000 ext XMOVEI 415000 000000 int .FHSLF 400000 sin DVCHR% 104000 000117 int PARS5 000000 ext %%JSER 000000 ext .FP 000015 spd EOSCOD 100000 spd PARS6 000000 ext ..MSK 777777 777777 spd .FPAC 000005 spd ERJMPR 320500 000000 int PARS7 000000 ext .A16 000016 spd .GJDEF 000000 sin ERRPTR 000000 ext PARS8 000000 ext .CHBEL 000007 sin .GJNHG 777777 sin K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page S-2 K20IOC MAC 20-Jan-23 21:49 SYMBOL TABLE .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 15:18 11-Jun-23 Page S-3 K20IOC MAC 20-Jan-23 21:49 SYMBOL TABLE FOR PSECT CODE ATMBLN 000000 ext ISNULJ 001570' ext STRPTR 001242' ext ..0113 000122' spd ATMBUF 004022' ext JOBTAB 000000 ext TAKJFN 000370' ext ..0114 000123' spd BSRCH1 001313' LCLPAR 003523' ext TIMDEL 000422' ext ..0127 000162' spd BSRCH2 001317' LOOPIO 000541' TIMEON 002016' ext ..0132 000154' spd BSRCHS 001237' LOOPOV 000545' TRANOT 002302' ..0137 000152' spd BUFBEG 001116' LOOPTM 000543' TTFORK 003462' ext ..0145 000157' spd CAPHRL 002532' M1STCH 000553' TTIPAR 003013' ext ..0146 000162' spd CAPMXL 003776 spd MARK 003342' ent TTYJFN 002762' ext ..0155 000167' spd CAPTFS 002362' MATCHS 000563' TTYOB 002026' ext ..0163 000206' spd CARIER 001361' ext MOVCHR 003006' ext TTYOU 002244' ext ..0164 000211' spd CCOFF2 002202' ext MOVSUP 000555' UNBITS 002245' ext ..0165 000176' spd CCON 002454' ext MRKTAB 001321' VSOCT 002156' ext ..0172 000205' spd CESCXP 003101' ent MYCAPS 000000 ext VSOMX 002412' ext ..0201 000202' spd CFMRTN 001342' ext NBICT 002710' ext VSOTC 002524' ext ..0202 000205' spd CHKLIN 001360' ext NETINS 000432' VTERMF 002242' ext ..0213 000232' spd CHKPAR 003610' ent NETJFN 003474' ext $CAPTU 002374' ent ..0221 000227' spd CHKSEC 001506' ext NETPRN 001061' $CAPUX 002526' ..0222 000231' spd CHRMOV 003075' NOIRTN 003367' ext $INP4A 000262' ..0223 000244' spd CHRMUP 003077' NONE 003341' ent $INPCL 000425' ..0230 000245' spd CJFNBK 004053' ext NRTFLG 003500' ext $INPU5 000277' ..0235 000253' spd CLRBUF 002240' ext NSICI 002764' ext $INPU6 000300' ..0243 000262' spd CLREST 002735' ext NSIMX 002766' ext $INPU7 000304' ..0245 000266' spd CMDER1 001663' ext NSITC 002767' ext $INPU9 000345' ..0253 000276' spd CMDERR 003425' ext NTRIGR 001027' $INPUT 000254' ent ..0260 000277' spd CMLOC 002030' ext NUL4 000376' ext $INPUX 000411' ..0265 000312' spd CMPOFF 002201' ext OCTMOV 003256' $INPUY 000410' ..0266 000321' spd CMPON 002033' ext ODD 003352' ent $OUTP4 001356' ..0272 000326' spd CMPRMN 000557' int OPNPAR 003476' ext $OUTPU 001344' ent ..0304 000334' spd CMSEEN 002065' ext PADBUF 003633' ent $SETPA 003433' ent ..0306 000342' spd CPLOC 002032' ext PARCHR 003534' $SINSE 000067' ..0314 000353' spd CPSEEN 002123' ext PARITY 003611' ext $SINSI 000061' ..0321 000355' spd CRLF 003301' ext PARS2 002447' ext $TRAN1 001744' ..0326 000365' spd CVTOCT 003260' PARS3 003436' ext $TRAN2 002011' ..0344 000406' spd DEFINF 003424' ext PARS4 003434' ext $TRAN3 002060' ..0352 000403' spd DOARPA 002023' ext PARS6 001621' ext $TRAN4 002116' ..0353 000406' spd DOBITS 002024' ext PARS7 002377' ext $TRAN5 002124' ..0354 000420' spd DUPLEX 002132' ext PARS8 001747' ext $TRAN6 002141' ..0362 000420' spd EBQ 003473' ext POPJFN 000410' ext $TRAN7 002172' ..0374 000423' spd EBQR 003471' ext PTYFLG 003506' ext $TRANS 001664' ent ..0403 000437' spd EOFOVR 003027' PUTPAR 003544' ent $TRANT 002260' ..0404 000537' spd ERRPTR 001573' ext R 003656' ext $TRANX 002201' ..0411 000451' spd ESCCHR 003157' ent RFIELD 003373' ext %%JSER 003457' ext ..0414 000462' spd ESCMOV 003155' RFLDE 003412' ext %EOFSW 000000 spd ..0422 000453' spd EVEN 003346' ent RRSLIN 002526' ext %SILSW 000001 spd ..0423 000461' spd EVNODD 003355' RSKP 003631' ext %TIMSW 000002 spd ..0430 000464' spd FILJFN 002542' ext SEOLCH 000000 ext ..0030 000021' spd ..0435 000532' spd FRCLOS 002450' ext SESFLG 001421' ext ..0031 000022' spd ..0447 000521' spd GENPAR 003565' ent SESJFN 001417' ext ..0040 000042' spd ..0450 000531' spd GETCRT 002673' SPACE 003344' ent ..0041 000046' spd ..0457 000572' spd HANDSH 001611' ext SPADCH 000000 ext ..0042 000046' spd ..0464 000600' spd INILIN 002456' ext SSTHDR 000000 ext ..0056 000056' spd ..0473 000612' spd INPBFA 001234' STR2BP 000562' ..0057 000061' spd ..0505 000665' spd INPBFC 001117' ent STRBF2 004044' ext ..0066 000074' spd ..0507 000650' spd INPBTC 001233' STRBUF 004052' ext ..0070 000102' spd ..0515 000650' spd INPCLR 001105' ent STRC 002633' ext ..0075 000103' spd ..0526 000655' spd K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page S-4 K20IOC MAC 20-Jan-23 21:49 SYMBOL TABLE FOR PSECT CODE ..0540 000676' spd ..1251 001775' spd ..2031 003022' spd .TRAN1 001445' ..0546 000711' spd ..1257 002011' spd ..2036 003025' spd .TRAN2 001525' ..0554 000716' spd ..1265 002017' spd ..2037 003034' spd .TRAN3 001602' ..0556 000731' spd ..1267 002027' spd ..2051 003042' spd .TRANE 001623' ..0563 000733' spd ..1303 002066' spd ..2057 003062' spd .TRANS 001434' ent ..0564 000766' spd ..1317 002074' spd ..2060 003064' spd ..0572 000747' spd ..1320 002105' spd ..2066 003113' spd ..0604 000754' spd ..1324 002111' spd ..2067 003135' spd ..0606 001001' spd ..1331 002112' spd ..2077 003127' spd ..0623 001007' spd ..1336 002116' spd ..2105 003153' spd ..0625 001014' spd ..1340 002124' spd ..2114 003211' spd ..0633 001041' spd ..1354 002132' spd ..2124 003227' spd ..0650 001047' spd ..1356 002156' spd ..2145 003304' spd ..0652 001076' spd ..1363 002165' spd ..2155 003312' spd ..0675 001156' spd ..1372 002172' spd ..2165 003323' spd ..0706 001170' spd ..1400 002200' spd ..2175 003331' spd ..0713 001221' spd ..1412 002240' spd ..2255 003403' spd ..0720 001222' spd ..1414 002232' spd ..2264 003407' spd ..0725 001206' spd ..1421 002240' spd ..2265 003430' spd ..0736 001220' spd ..1430 002246' spd ..2272 003424' spd ..0746 001260' spd ..1442 002255' spd ..2273 003427' spd ..0753 001264' spd ..1450 002265' spd ..2274 003446' spd ..0764 001342' spd ..1451 002277' spd ..2301 003447' spd ..0765 001343' spd ..1467 002314' spd ..2306 003463' spd ..0770 001370' spd ..1470 002324' spd ..2317 003471' spd ..1007 001433' spd ..1504 002350' spd ..2320 003533' spd ..1022 001517' spd ..1505 002356' spd ..2321 003523' spd ..1027 001472' spd ..1532 002430' spd ..2326 003530' spd ..1035 001476' spd ..1540 002413' spd ..2327 003522' spd ..1043 001515' spd ..1546 002425' spd ..2335 003506' spd ..1045 001506' spd ..1547 002430' spd ..2342 003517' spd ..1061 001512' spd ..1554 002453' spd ..2345 003514' spd ..1062 001515' spd ..1562 002440' spd ..2352 003517' spd ..1071 001522' spd ..1563 002453' spd ..2361 003530' spd ..1072 001525' spd ..1574 002457' spd ..2400 003536' spd ..1104 001565' spd ..1575 002526' spd ..2401 003543' spd ..1112 001545' spd ..1602 002476' spd ..IFT 200000 000001 spd ..1120 001564' spd ..1613 002516' spd ..JX1 200000 000000 spd ..1135 001600' spd ..1614 002525' spd ..MX1 000003 spd ..1146 001620' spd ..1635 002555' spd ..MX2 000001 spd ..1156 001640' spd ..1636 002564' spd ..TX1 200000 000000 spd ..1157 001650' spd ..1650 002621' spd ..TX2 000001 spd ..1174 001663' spd ..1670 002602' spd .CAPTU 002364' ent ..1202 001674' spd ..1671 002613' spd .INPU0 000134' ..1203 001744' spd ..1700 002642' spd .INPU1 000211' ..1210 001677' spd ..1751 002676' spd .INPU2 000220' ..1211 001711' spd ..1752 002775' spd .INPUT 000131' ent ..1212 001712' spd ..1762 002731' spd .OUTPU 001330' ent ..1221 001716' spd ..1763 002735' spd .SETIN 000000' ent ..1222 001722' spd ..1764 002724' spd .SETPA 003366' ent ..1223 001723' spd ..1776 002730' spd .SINCA 000007' ..1230 001731' spd ..2006 002746' spd .SINDT 000030' ..1231 001744' spd ..2017 002770' spd .SINSE 000062' ..1236 002007' spd ..2025 003011' spd .SINTA 000110' ..1243 001764' spd ..2026 003015' spd .TRAN0 001443' K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page S-5 K20IOC MAC 20-Jan-23 21:49 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 15:18 11-Jun-23 Page S-6 K20IOC MAC 20-Jan-23 21:49 SYMBOL TABLE FOR PSECT TEXT INPINI 000134' int K20IOC Kermit Input/Output statement Control MACRO %53B(1254)-4 15:18 11-Jun-23 Page S-7 K20IOC MAC 20-Jan-23 21:49 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 15:18 11-Jun-23 Page 1 K20DSP MAC 6-Jun-23 10:31 Preliminaries 20182 title k20dsp - Kermit-20 Display Routines 20183 20184 ; All display code was removed from k20mit and moved to this module as 20185 ; part of Edit 194 to address the issue of a very large single source 20186 ; file that unexpectedly began generating MCRNEC errors. 20187 ; 20188 ; During this time, some code was rewritten to decrease symbol table 20189 ; usage, to (hopefully) clean up control flow and provide for 20190 ; additional checking and better recovery. Speed ups were not avoided 20191 ; where possible, typically space being traded for time. However, 20192 ; this was not done at the expense of clarity, maintainability being 20193 ; of paramount concern. 20194 ; 20195 ; The code here should be differentiated from the extensive help text 20196 ; which is contained in k20hlp, which is constant, does not change 20197 ; during runtime and resides in its own .PSECT. The text here is 20198 ; dynamically generated. 20199 20200 subttl Preliminaries 20201 20202 search monsym,macsym,cmd,k20unv ;[194] 20203 cmdacs ^ ;Clean up p1-p4 definitions 20204 20205 sall ; Tidy listing 20206 .directive flblst ; We don't need to see all the ASCIZ bytes... 20207 20208 remark common parsing external data 20209 20210 extern pars1 ; Data from first parse. 20211 extern pars2 ; Data from second parse. 20212 extern pars3 ; Data from third parse. 20213 extern pars4 ; Data from fourth parse. 20214 extern pars5 ;[41] ... 20215 20216 remark for file handling 20217 20218 extern filjfn ; JFN of currently open file 20219 20220 remark other useful routines and data 20221 20222 extern qlog ; Quit logging 20223 extern %%jser ; Support for error macros 20224 extern %%smsg ; Support for smsg macro 20225 extern BOUTI% ;[216] BOUT% Internal 20226 extern errptr ; Pointer to error message 20227 extern getnti ; Get information about line 20228 extern ccon, ccoff ; Handle control-C, if we have it 20229 extern crlf ; Carriage return line feed 20230 extern crlflf ; As previous, but double line feed 20231 extern ttyjfn ; JFN on local terminal 20232 extern $priou ; Terminal primary output 20233 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 2 K20DSP MAC 6-Jun-23 10:31 Various NUL: ASCII strings and lengths 20234 subttl Various NUL: ASCII strings and lengths 20235 20236 .psect text ; Text goes in text psect 20237 000000'01 472531 435032 nulnam: byte (7) "N","U","L",":", .chcrt, .chlfd, .chlfd, .chnul 20238 000002'01 252352 546164 astnul: byte (7) "*","N","U","L",":", .chnul 20239 .endps text 20240 20241 .psect const ; Read-only constants go in constants psecn 20242 000000'02 44 07 0 00 000000# nulptr: point 7, nulnam ; Pointer to fixed "NUL:" string 20243 000001'02 777777 777770 -^d8 ; "NUL:" (4) + crlflf (4) 20244 000002'02 44 07 0 00 000000# nul5: point 7, astnul ; Pointer to fixed "*NUL:" ASCIZ 20245 000003'02 777777 777773 -^d5 ; Length of same 20246 .endps const ; End of constants 20247 20248 .psect code/ronly ; Don't allow stores 20249 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 3 K20DSP MAC 6-Jun-23 10:31 Clear Control-O, if set 20250 subttl Clear Control-O, if set 20251 20252 ; Preserves all registers, +1 always 20253 ; 20254 ; This is concerned about the local controlling terminal, not anything 20255 ; remote over a pseudo-terminal, network or (maybe) pipe. 20256 20257 000000'03 clrcno: entry clrcno 20258 000000'03 265 16 0 00 004240' saveac ; Just don't touch 20259 20260 000001'03 200 01 0 00 000000* move t1, $PRIOU ; Whatever is best to choose for primary output 20261 000002'03 104 00 0 00 000107 RFMOD% ; Find out about control-O 20262 000003'03 320 12 0 00 000005' ifje. r ; Failed?? 20263 000004'03 254 00 0 00 000010' 20264 000005'03 200 04 0 00 000001 move t4, t1 ; Save error, just in case 20265 000006'03 400 02 0 00 000000 setz t2, ; Assume ^O has not been typed 20266 000007'03 200 01 0 00 000001* move t1, $PRIOU ; Reload JFN or device, just in case 20267 000010'03 endif. 20268 20269 000010'03 627 02 0 00 400000 txzn t2, tt%osp ; Is Output suppress (^O) on? 20270 000011'03 263 17 0 00 000000 ret ; No, nothing to do 20271 000012'03 104 00 0 00 000110 SFMOD% ; Otherwise, turn it off 20272 000013'03 320 12 0 00 000015' ifje. r ; Failed?? But we just read it... 20273 000014'03 254 00 0 00 000017' 20274 000015'03 200 04 0 00 000001 move t4, t1 ; Save error, just in case 20275 000016'03 200 01 0 00 000007* move t1, $PRIOU ; Reload JFN or device, just in case 20276 000017'03 endif. 20277 20278 000017'03 263 17 0 00 000000 ret ; Done 20279 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 4 K20DSP MAC 6-Jun-23 10:31 typnam - Type a file name 20280 subttl typnam - Type a file name 20281 20282 ; t1/ Output JFN or designator 20283 ; t2/ JFN to render 20284 ; 20285 ; Updates t1, if string pointer 20286 ; 20287 ; +1/ If failed along the way (t1 unchanged) 20288 ; +2/ Succeeded 20289 20290 000020'03 typnam: entry typnam ;[220] 20291 000020'03 265 16 0 00 004252' saveac ; Save these anyway 20292 000021'03 200 05 0 00 000001 move q1, t1 ; Save output designator 20293 000022'03 400 04 0 00 000000 setz t4, ; No string prefix or stop character 20294 20295 000023'03 302 02 0 00 377777 caie t2, .nulio ;[193] NUL: talisman? 20296 000024'03 254 00 0 00 000035' ifskp. ;[193] Yes, that's easy 20297 000025'03 120 02 0 00 000000# dmove t2, nulptr ;[193] Point to equivalent string 20298 000026'03 104 00 0 00 000053 SOUT% ;[193] Counted SOUT% is faster 20299 000027'03 320 12 0 00 000031' ifje. r ;[194] Failed?? 20300 000030'03 254 00 0 00 000034' 20301 000031'03 200 04 0 00 000001 move t4, t1 ;[193] Save error for debuggers 20302 000032'03 200 01 0 00 000005 move t1, q1 ;[193] Restore output designator 20303 000033'03 263 17 0 00 000000 ret ;[194] Give error return 20304 000034'03 endif. ;]194] End SOUT% error handling 20305 000034'03 254 00 0 00 000053' else. ;[193] Otherwise, a real JFN 20306 000035'03 400 03 0 00 000000 setz t3, ; Default formatting 20307 000036'03 104 00 0 00 000030 JFNS% ; Type it someplace 20308 000037'03 320 12 0 00 000041' ifje. r ;[194] Failed?? 20309 000040'03 254 00 0 00 000044' 20310 000041'03 200 04 0 00 000001 move t4, t1 ;[194] Save error for debuggers 20311 000042'03 200 01 0 00 000005 move t1, q1 ;[194] Restore output designator 20312 000043'03 263 17 0 00 000000 ret ;[194] Give error return 20313 000044'03 endif. ;]194] End JFN% error handling 20314 dmove t2, [ point 7, crlflf ;[194] Double linefeed 20315 000044'03 120 02 0 00 004264' -^d4 ] ;[194] Four characters total in string 20316 000045'03 104 00 0 00 000053 SOUT% ;[193] Counted SOUT% is faster 20317 000046'03 320 12 0 00 000050' ifje. r ;[194] Failed?? 20318 000047'03 254 00 0 00 000053' 20319 000050'03 200 04 0 00 000001 move t4, t1 ;[193] Save error for debuggers 20320 000051'03 200 01 0 00 000005 move t1, q1 ;[193] Restore output designator 20321 000052'03 263 17 0 00 000000 ret ;[194] Give error return 20322 000053'03 endif. ;]194] End SOUT% error handling 20323 000053'03 endif. ;[193] End .nulio special casing 20324 20325 000053'03 254 00 0 00 000000* retskp ;[194] Won!! 20326 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 5 K20DSP MAC 6-Jun-23 10:31 Routine to type a file at the local terminal. 20327 subttl Routine to type a file at the local terminal. 20328 20329 ; Call: 20330 ; 20331 ; t1/ JFN of file to type 20332 ; t3/ Byte size 20333 ; 20334 ; Returns +1, If anything strange 20335 ; +2, Success 20336 ; 20337 ; Rewritten be a little more picky about the calling arguments and to 20338 ; use PMAP% instead of SIN%. Passing a HRROI in to a file opened in 8 20339 ; bit mode did the wrong thing, anyway. 20340 ; 20341 ; Will also generate parity for a seven bit file, if we're asked to 20342 ; to do that. That should normally never happen as the monitor should 20343 ; be handling this. The code here is largely for testing purposes. 20344 ; 20345 ; Note: The routine checks for a byte size between 1 and 36, however 20346 ; only a byte size of 7 or 8 are properly handled, everything 20347 ; but 8 being displayed as a seven bit (I.E., ASCII) file. This 20348 ; will properly type 36 bit listings generated by PA1050 and is 20349 ; no worse then the previous (incorrect) behavior. 20350 ; 20351 ; N.B., For an eight bit file, parity must be ignored--you're on your 20352 ; own... 20353 20354 000054'03 typfil: entry typfil ;[220] 20355 000054'03 265 16 0 00 004266' saveac 20356 20357 000055'03 514 05 0 00 000001 hrlz q1, t1 ; Save JFN, start at file page zero 20358 000056'03 621 01 0 00 777777 tlz t1, -1 ; Whack any flags left lying around 20359 000057'03 306 01 0 00 377777 cain t1, .nulio ; Asked to type NUL:? 20360 000060'03 254 00 0 00 000053* retskp ; That's easy; we're done already! 20361 20362 000061'03 323 03 0 00 000066' ifg. t3 ; Could the byte size be reasonable? 20363 000062'03 303 03 0 00 000044 caile t3, ^d36 ; Yes, but is it actually so? 20364 000063'03 254 00 0 00 000066' anskp. ; No, it's delusional 20365 000064'03 200 06 0 00 000003 move q2, t3 ; It's fine, so save the validated file byte size 20366 000065'03 254 00 0 00 000106' else. ; Otherwise, byte size is some kind of gubbish 20367 000066'03 200 01 0 00 000000# txmsg <% KERMIT-20 can not type a file with a byte size of: > 20368 000067'03 104 00 0 00 000076 20369 000070'03 320 12 0 00 000071' 20370 000004'02 000000000000# 20371 000000'04 045 040 113 105 122 20372 000071'03 201 01 0 00 000101 movei t1, .priou ; continue on this terminal 20373 000072'03 200 02 0 00 000003 move t2, t3 ; Load it where NOUT% wants it 20374 000073'03 201 03 0 00 000012 movei t3, ^d10 ; Base ten 20375 000074'03 104 00 0 00 000224 NOUT% ; Type the bogus byte size 20376 000075'03 320 12 0 00 000077' ifje. r ; Catch and ignore error 20377 000076'03 254 00 0 00 000103' 20378 000077'03 200 04 0 00 000001 move t4, t1 ; Store error for debugger 20379 000100'03 200 01 0 00 000000# txmsg <*ERROR*> ; About as good as we can do 20380 000101'03 104 00 0 00 000076 20381 000102'03 320 12 0 00 000103' k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 5-1 K20DSP MAC 6-Jun-23 10:31 Routine to type a file at the local terminal. 20382 000005'02 000000000000# 20383 000013'04 052 105 122 122 117 20384 000103'03 endif. ; End NOUT% error handling 20385 000103'03 561 01 0 00 000000* hrroi t1, crlf ; Tie off the line 20386 000104'03 104 00 0 00 000076 PSOUT% 20387 000105'03 263 17 0 00 000000 ret ; Return a failure 20388 000106'03 endif. ; End byte size checking 20389 20390 000106'03 104 00 0 00 000024 GTSTS% ; Otherwise, see if we can use the JFN at all 20391 000107'03 320 12 0 00 000111' ifje. r ; Failed?? 20392 000110'03 254 00 0 00 000131' 20393 000111'03 200 04 0 00 000001 move t4, t1 ; Store error for debugging 20394 000112'03 200 01 0 00 000000# emsg ;Begin complaining 20395 000113'03 104 00 0 00 000313 20396 000006'02 000000000000# 20397 000015'04 103 141 156 047 164 20398 000114'03 201 01 0 00 000101 movei t1, .priou ; continue on this terminal 20399 000115'03 554 02 0 00 000005 hlrz t2, q1 ; Load JFN, which was stored prepratory to PMAP%ing 20400 000116'03 201 03 0 00 000010 movei t3, ^d8 ; JFN's are base 8 20401 000117'03 104 00 0 00 000224 NOUT% ; Type it (or try to, anyway) 20402 000120'03 320 12 0 00 000122' ifje. r ; Catch and ignore error 20403 000121'03 254 00 0 00 000126' 20404 000122'03 200 04 0 00 000001 move t4, t1 ; Store error for debugger 20405 000123'03 200 01 0 00 000000# txmsg <*ERROR*> ; About as good as we can do 20406 000124'03 104 00 0 00 000076 20407 000125'03 320 12 0 00 000126' 20408 000007'02 000000000000# 20409 000022'04 052 105 122 122 117 20410 000126'03 endif. ; End NOUT% error handling 20411 000126'03 561 01 0 00 000103* hrroi t1, crlf ; And tie off the complaint 20412 000127'03 104 00 0 00 000076 PSOUT% 20413 000130'03 263 17 0 00 000000 ret ; And get out of here 20414 000131'03 endif. ; End case JSYS error handling 20415 20416 000131'03 603 02 0 00 000200 ifxe. t2, gs%nam ; So does anything in there smell like a JFN? 20417 000132'03 254 00 0 00 000154' 20418 000133'03 200 04 0 00 000001 move t4, t1 ; Store error for debugging 20419 000134'03 200 01 0 00 000000# emsg ;Begin complaining 20420 000135'03 104 00 0 00 000313 20421 000010'02 000000000000# 20422 000024'04 103 141 156 047 164 20423 000136'03 201 01 0 00 000101 movei t1, .priou ; continue on this terminal 20424 000137'03 554 02 0 00 000005 hlrz t2, q1 ; Load JFN, which was stored prepratory to PMAP%ing 20425 000140'03 201 03 0 00 000010 movei t3, ^d8 ; JFN's are base 8 20426 000141'03 104 00 0 00 000224 NOUT% ; Type it (or try to, anyway) 20427 000142'03 320 12 0 00 000144' ifje. r ; Catch and ignore error 20428 000143'03 254 00 0 00 000150' 20429 000144'03 200 04 0 00 000001 move t4, t1 ; Store error for debugger 20430 000145'03 200 01 0 00 000000# txmsg <*ERROR*> ; About as good as we can do 20431 000146'03 104 00 0 00 000076 20432 000147'03 320 12 0 00 000150' 20433 000011'02 000000000000# 20434 000031'04 052 105 122 122 117 20435 000150'03 endif. ; End NOUT% error handling 20436 000150'03 561 01 0 00 000126* hrroi t1, crlf ; And tie off the complaint k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 5-2 K20DSP MAC 6-Jun-23 10:31 Routine to type a file at the local terminal. 20437 000151'03 104 00 0 00 000076 PSOUT% 20438 000152'03 263 17 0 00 000000 ret ; And get out of here 20439 000153'03 254 00 0 00 000155' else. ; Otherwise, at least the JSYS worked 20440 000154'03 200 04 0 00 000002 move t4, t2 ; So save the status bits past the DVCHR% 20441 000155'03 endif. ; End case initial JFN check 20442 20443 000155'03 104 00 0 00 000117 DVCHR% ; Now let's have a look at the device 20444 000156'03 320 12 0 00 000160' ifje. r ; Failed?? 20445 000157'03 254 00 0 00 000162' 20446 000160'03 200 04 0 00 000001 move t4, t1 ; Get the error out of the way 20447 000161'03 477 02 0 00 000003 setob t2, t3 ; Assume no kind of device 20448 000162'03 endif. 20449 20450 000162'03 135 03 0 00 004304' load t3, dv%typ,t2 ; Pick up the device type 20451 000163'03 306 03 0 00 000015 cain t3, .dvnul ; Did this manage to slip through?? 20452 000164'03 254 00 0 00 000060* retskp ; Strangely, it did; silently ignore it 20453 20454 000165'03 306 03 0 00 000000 cain t3, .dvdsk ; Not a disk? 20455 000166'03 254 00 0 00 000207' ifskp. ; Won't be mapping it, then 20456 000167'03 200 01 0 00 000000# emsg 20457 000170'03 104 00 0 00 000313 20458 000012'02 000000000000# 20459 000033'04 103 141 156 047 164 20460 000171'03 201 01 0 00 000101 movei t1, .priou ; Carry on typing to the terminal 20461 000172'03 554 02 0 00 000005 hlrz t2, q1 ; Load the JFN (which we know is bound) 20462 000173'03 403 03 0 00 000004 setzb t3, t4 ; No special formatting or odd prefix 20463 000174'03 104 00 0 00 000030 JFNS% ; Tell us what we choked on 20464 000175'03 320 12 0 00 000177' ifje. r ; Catch and ignore error 20465 000176'03 254 00 0 00 000203' 20466 000177'03 200 04 0 00 000001 move t4, t1 ; Store error for debugger 20467 000200'03 200 01 0 00 000000# txmsg <*ERROR*> ; About as good as we can do 20468 000201'03 104 00 0 00 000076 20469 000202'03 320 12 0 00 000203' 20470 000013'02 000000000000# 20471 000041'04 052 105 122 122 117 20472 000203'03 endif. ; End NOUT% error handling 20473 000203'03 561 01 0 00 000150* hrroi t1, crlf ; And tie off the complaint 20474 000204'03 104 00 0 00 000076 PSOUT% 20475 000205'03 263 17 0 00 000000 ret ; And get out of here 20476 000206'03 254 00 0 00 000210' else. ; Ok to proceed 20477 000207'03 554 01 0 00 000005 hlrz t1, q1 ; Reload the JFN (which DVCHR% smashed) 20478 000210'03 endif. 20479 20480 000210'03 104 00 0 00 000036 SIZEF% ; Find the file size 20481 000211'03 320 16 0 00 000213' ifje. ; Failed?? 20482 000212'03 254 00 0 00 000216' 20483 000213'03 200 04 0 00 000001 move t4, t1 ; Get the error out of the way 20484 000214'03 403 02 0 00 000003 setzb t2, t3 ; Assume no kind of length 20485 000215'03 554 01 0 00 000005 hlrz t1, q1 ; Reload the JFN, just in case 20486 000216'03 endif. 20487 ; Investigate SIZEF% results 20488 000216'03 322 02 0 00 000164* jumpe t2, rskp ; If no bytes, nothing to do. 20489 000217'03 322 03 0 00 000216* jumpe t3, rskp ; No pages to map? Nothing to do... 20490 000220'03 120 07 0 00 000002 dmove q3, t2 ; Save quantities as loop counters 20491 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 5-3 K20DSP MAC 6-Jun-23 10:31 Routine to type a file at the local terminal. 20492 000221'03 321 04 0 00 000233' ifxe. t4, gs%opn ; Finally, is the file open? 20493 remark ; It isn't, but we can silently recover 20494 000222'03 200 02 0 00 004305' movx t2,fld(^d8,of%bsz)!of%rd ; Assume reading an 8 bit file 20495 000223'03 302 06 0 00 000010 caie q2, ^d8 ; But!! Not eight bit? 20496 000224'03 200 02 0 00 004306' movx t2,fld(^d7,of%bsz)!of%rd ; Everything else is 7 bit 20497 000225'03 104 00 0 00 000021 OPENF% ; Open it 20498 000226'03 320 12 0 00 000230' %jserr (,r) ; Punt 20499 000227'03 254 00 0 00 000233' 20500 000230'03 265 01 0 00 000000* 20501 000231'03 000000000000# 20502 000232'03 254 00 0 00 000000* 20503 000043'04 125 156 141 142 154 20504 000233'03 endif. ; End case trying to recover from an unopened file 20505 20506 000233'03 260 17 0 00 000427' call whakfp ; Whack anything left over 20507 000234'03 263 17 0 00 000000 ret ; Go no further if something failed 20508 000235'03 302 06 0 00 000007 caie q2, ^d7 ; 7 bit ASCII? 20509 000236'03 254 00 0 00 000242' ifskp. ; OK, routine type out 20510 000237'03 201 04 0 00 005000 movx t4,^d<512*<36/7>> ;Count of seven bit bytes in page 20511 000240'03 505 06 0 00 440700 hrli q2, () ;Using a seven bit pointer, then 20512 000241'03 254 00 0 00 000244' else. ; Otherwise, 8 bit ASCII 20513 000242'03 201 04 0 00 004000 movx t4,^d<512*<36/8>> ;So less bytes per page 20514 000243'03 505 06 0 00 441000 hrli q2, () ;and using an eight bit pointer 20515 000244'03 endif. 20516 000244'03 541 06 0 00 007000 hrri q2, maporg ; Either way, coming from same address 20517 20518 000245'03 do. ; Finally enter loop context 20519 000245'03 200 01 0 00 000005 move t1, q1 ; Case I, load JFN and file page 20520 000246'03 120 02 0 00 004307' dmove t2, [ exp <.fhslf,,mappag>, pm%rd ] 20521 000247'03 104 00 0 00 000056 PMAP% ; Map it in, read-only 20522 000250'03 320 12 0 00 000252' %jserr (,r) ; Punt 20523 000251'03 254 00 0 00 000255' 20524 000252'03 265 01 0 00 000230* 20525 000253'03 000000000000# 20526 000254'03 254 00 0 00 000232* 20527 000050'04 125 156 141 142 154 20528 000255'03 210 03 0 00 000004 movn t3, t4 ; Let's assume the maximum 20529 000256'03 313 04 0 00 000007 camle t4, q3 ; Unless we are within the end of file 20530 000257'03 210 03 0 00 000007 movn t3, q3 ; Otherwise, just do remainder 20531 000260'03 270 07 0 00 000003 add q3, t3 ; Subtract off remaining total 20532 000261'03 200 02 0 00 000006 move t2, q2 ; Load the source pointer 20533 000262'03 200 01 0 00 000000* move t1, parity ; But! Are we putting parity on this? 20534 000263'03 306 01 0 00 000000* cain t1, none ; Anything but none means we might be doing exactly that 20535 000264'03 254 00 0 00 000304' ifskp. ; OK, some some kind of parity being done, check further 20536 000265'03 554 01 0 00 000006 hlrz t1, q2 ; Pick up the default pointer fields 20537 000266'03 306 01 0 00 441000 cain t1, () ; Not doing eight bit? 20538 000267'03 254 00 0 00 000304' anskp. ; No, can't put parity on an eight bit file 20539 000270'03 332 00 0 00 000000* skipe parpko ; Just doing parity on packets? 20540 000271'03 254 00 0 00 000304' anskp. ; Yes, so don't muck up the type out 20541 000272'03 415 16 0 00 000304' block. ; Generate the parity then 20542 000273'03 261 17 0 00 000016 20543 000274'03 265 16 0 00 004311' saveac 20544 000275'03 211 01 0 00 010000 movni t1,^d<4*strblw*2> ; Load maximum count for combined buffers 20545 000276'03 313 01 0 00 000003 camle t1, t3 ; Overflow? (have to compare negative numbers backwards) 20546 000277'03 200 03 0 00 000001 move t3, t1 ; Clip down to maximum k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 5-4 K20DSP MAC 6-Jun-23 10:31 Routine to type a file at the local terminal. 20547 000300'03 201 01 0 00 000000* movei t1,strbuf ; Resolve address of string buffer 20548 000301'03 505 01 0 00 441000 hrli t1, <(point 8,0)> ;Finish building eight bit pointer 20549 000302'03 260 17 0 00 000000* call genpar ; Generate a new string with parity 20550 000303'03 263 17 0 00 000000 endbk. ; End block context 20551 000304'03 endif. ; End case parity handling 20552 000304'03 201 01 0 00 000101 movei t1, .priou ; Type it on whatever primary output is 20553 000305'03 104 00 0 00 000053 SOUT% ; Counted SOUT% is efficient 20554 000306'03 320 12 0 00 000310' %jserr (,r) ; Punt 20555 000307'03 254 00 0 00 000313' 20556 000310'03 265 01 0 00 000252* 20557 000311'03 000000000000# 20558 000312'03 254 00 0 00 000254* 20559 000055'04 125 156 141 142 154 20560 000313'03 323 07 0 00 000316' jumple q3, endlp. ; Exit if done with all the characters 20561 000314'03 271 05 0 00 000001 addi q1, ^d1 ; Bump to next file page 20562 000315'03 367 10 0 00 000245' sojg q4, top. ; Do it, if any pages left 20563 000316'03 enddo. ; Exit loop lexical context 20564 20565 000316'03 254 00 0 00 000427' jrst whakfp ; Whack any pages 20566 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 6 K20DSP MAC 6-Jun-23 10:31 Character echoing routine. 20567 subttl Character echoing routine. 20568 20569 ; Need to do this because having tty open in binary mode overrides ccoc 20570 ; settings. t2 contains character to echo. 20571 ; 20572 ;[151] 20573 20574 000317'03 echo: entry echo ;[196] 20575 000317'03 265 16 0 00 004240' saveac ;[186] Must save all ACs. 20576 20577 000320'03 620 02 0 00 000200 trz t2, 200 ; Strip any parity. 20578 000321'03 200 03 0 00 000002 move t3, t2 ; Make a copy of the character. 20579 20580 000322'03 301 03 0 00 000040 cail t3, 40 ;[18] Check most common case first, 20581 000323'03 303 03 0 00 000126 caile t3, 126 ;[18] namely, whether it's a printable 20582 000324'03 334 00 0 00 000000 skipa ;[18] character. 20583 000325'03 254 00 0 00 000402' jrst echo2 ;[18] If so, just go print it. 20584 20585 000326'03 307 03 0 00 000006 caig t3, 6 ; Check for control char, null thru ^F. 20586 000327'03 254 00 0 00 000354' jrst echo1 20587 000330'03 306 03 0 00 000013 cain t3, 13 ; ^K 20588 000331'03 254 00 0 00 000354' jrst echo1 20589 000332'03 301 03 0 00 000016 cail t3, 16 ; ^N-^Z 20590 000333'03 303 03 0 00 000032 caile t3, 32 20591 000334'03 334 00 0 00 000000 skipa 20592 000335'03 254 00 0 00 000354' jrst echo1 20593 000336'03 301 03 0 00 000034 cail t3, 34 ; ^\-^_ 20594 000337'03 303 03 0 00 000037 caile t3, 37 20595 000340'03 334 00 0 00 000000 skipa 20596 000341'03 254 00 0 00 000354' jrst echo1 20597 000342'03 302 03 0 00 000033 caie t3, 33 ;[194] ESC? 20598 000343'03 254 00 0 00 000346' ifskp. ;[194] Yes 20599 000344'03 201 02 0 00 000044 movei t2, "$" ; Echo as dollar sign 20600 000345'03 254 00 0 00 000402' jrst echo2 20601 000346'03 endif. ;[194] 20602 000346'03 302 03 0 00 000177 caie t3, 177 ;[194] DEL? 20603 000347'03 254 00 0 00 000352' ifskp. ;[194] Yes 20604 000350'03 474 03 0 00 000000 seto t3, ; So it echoes as ^? (100-1=77="?") 20605 000351'03 254 00 0 00 000354' jrst echo1 20606 000352'03 endif. ;[194] 20607 000352'03 200 02 0 00 000003 move t2, t3 ; Anything else, just type it. 20608 000353'03 254 00 0 00 000402' jrst echo2 20609 20610 000354'03 337 01 0 00 000000* echo1: skipg t1, ttyjfn ; Echo it on the tty. 20611 000355'03 201 01 0 00 000101 movei t1, .priou 20612 000356'03 201 02 0 00 000136 movei t2, "^" ; Print an uparrow 20613 000357'03 104 00 0 00 000051 BOUT 20614 000360'03 320 12 0 00 000362' %jserr (,) 20615 000361'03 254 00 0 00 000365' 20616 000362'03 265 01 0 00 000310* 20617 000363'03 000000 000000 20618 000364'03 254 00 0 00 000365' 20619 20620 000365'03 337 01 0 00 000000* skipg t1, sesjfn ;[195] Logging? 20621 000366'03 254 00 0 00 000401' ifskp. ;[195] Yes k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 6-1 K20DSP MAC 6-Jun-23 10:31 Character echoing routine. 20622 000367'03 336 00 0 00 000000* skipn sesflg ;[195] Active? 20623 000370'03 254 00 0 00 000401' anskp. ;[195] No 20624 000371'03 306 01 0 00 377777 cain t1, .nulio ;[193] Just dumping it? 20625 000372'03 254 00 0 00 000401' anskp. ;[195] Yeah, don't even bother then 20626 000373'03 104 00 0 00 000051 BOUT ; Yes, do that. 20627 000374'03 320 12 0 00 000376' %jserr (,qlog) ; Error, print msg, close log, rtn from there. 20628 000375'03 254 00 0 00 000401' 20629 000376'03 265 01 0 00 000362* 20630 000377'03 000000 000000 20631 000400'03 254 00 0 00 000000* 20632 000401'03 endif. ;[195] 20633 20634 000401'03 201 02 0 03 000100 movei t2, 100(t3) ; Convert to char to uncontrollified version. 20635 000402'03 337 01 0 00 000354* echo2: skipg t1, ttyjfn ; Back to TTY. 20636 000403'03 201 01 0 00 000101 movei t1, .priou 20637 000404'03 104 00 0 00 000051 BOUT ; Print the character itself. 20638 000405'03 320 12 0 00 000407' %jserr (,) 20639 000406'03 254 00 0 00 000412' 20640 000407'03 265 01 0 00 000376* 20641 000410'03 000000 000000 20642 000411'03 254 00 0 00 000412' 20643 20644 000412'03 337 01 0 00 000365* skipg t1, sesjfn ;[195] Logging? 20645 000413'03 254 00 0 00 000426' ifskp. ;[195] Yes 20646 000414'03 336 00 0 00 000367* skipn sesflg ;[195] Active? 20647 000415'03 254 00 0 00 000426' anskp. ;[195] No 20648 000416'03 306 01 0 00 377777 cain t1, .nulio ;[193] Just dumping it? 20649 000417'03 254 00 0 00 000426' anskp. ;[195] Yeah, don't even bother then 20650 000420'03 104 00 0 00 000051 BOUT ; Yes, do that. 20651 000421'03 320 12 0 00 000423' %jserr (,qlog) ; Error, print msg, close log, rtn from there. 20652 000422'03 254 00 0 00 000426' 20653 000423'03 265 01 0 00 000407* 20654 000424'03 000000 000000 20655 000425'03 254 00 0 00 000400* 20656 000426'03 endif. ;[195] 20657 20658 000426'03 263 17 0 00 000000 ret 20659 20660 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 7 K20DSP MAC 6-Jun-23 10:31 Whack a file page, if it exists 20661 subttl Whack a file page, if it exists 20662 20663 000427'03 whakfp: entry whakfp ;[220] 20664 remark RPACS% ; Could have used this, but didn't ... 20665 000427'03 200 01 0 00 007000 move t1, maporg ; Did anything get left lying around? 20666 000430'03 320 12 0 00 000432' ifje. r ; No, so that's fine 20667 000431'03 254 00 0 00 000435' 20668 000432'03 200 04 0 00 000001 move t4, t1 ; But save the error for the curious 20669 000433'03 254 00 0 00 000217* retskp ; Succeed (since nothing to do) 20670 000434'03 254 00 0 00 000445' else. ; Otherwise, ditch whatever is there 20671 000435'03 474 01 0 00 000000 seto t1, ; Case IV, whacking a process page 20672 000436'03 120 02 0 00 004325' dmove t2, [ exp <.fhslf,,mappag>, 0 ] ; From our address space 20673 000437'03 104 00 0 00 000056 PMAP% ; Kick the page into oblivion 20674 000440'03 320 12 0 00 000442' %jserr (,r) 20675 000441'03 254 00 0 00 000445' 20676 000442'03 265 01 0 00 000423* 20677 000443'03 000000000000# 20678 000444'03 254 00 0 00 000312* 20679 000062'04 125 156 141 142 154 20680 000445'03 endif. 20681 20682 000445'03 254 00 0 00 000433* retskp ; And done 20683 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 8 K20DSP MAC 6-Jun-23 10:31 STATISTICS external variables 20684 subttl STATISTICS external variables 20685 20686 extern nnak ; Number of NAK's seen 20687 extern ntimou ; Number of time outs 20688 extern pause ; Interpacket pause in milliseconds 20689 extern rpsiz ; Maximum receive packet size 20690 extern rtchr ; Total characters receieved 20691 extern rtot ; Received total characters 20692 extern sec ; Seconds (for figuring baud rate 20693 extern speed ; Line speed, if physical line 20694 extern spsiz ; Maximum send packet size 20695 extern statxt ; Status text 20696 extern stchr ; Total characters sent 20697 extern ewallt ;[207] Elapsed wall time block 20698 extern durtim ;[207] Prints a duration 20699 extern stot ; Sent total characters 20700 extern timerx ; Count of TIMER% JSYS errors 20701 extern ttibin ; BIN% counter 20702 extern ttildb ; ildb's over SIN%'ed data 20703 extern ttimax ; Maximum size a SIN% can do 20704 extern ttisin ; Largest SIN% we ever did 20705 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 9 K20DSP MAC 6-Jun-23 10:31 STATISTICS command 20706 subttl STATISTICS command 20707 20708 000446'03 $srvt: entry $srvt ;[194] 20709 000446'03 334 01 0 00 004327' skipa t1,[point 7, statxt] ;[216] Server statistics 20710 000447'03 $stat: entry $stat ;[194] 20711 000447'03 201 01 0 00 000101 movei t1,.priou ;[189] Otherwise local 20712 smsg < 20713 000450'03 120 02 0 00 000000# Maximum number of characters in packet: > ;[189] 20714 000451'03 260 17 0 00 000000* 20715 000014'02 000000000000# 20716 000015'02 777777 777724 20717 000072'04 015 012 040 115 141 20718 000452'03 200 02 0 00 000000* srvnum rpsiz ;[189] 20719 000453'03 201 03 0 00 000012 20720 000454'03 104 00 0 00 000224 20721 000455'03 320 14 0 00 000456' 20722 000456'03 120 02 0 00 000000# smsg < received: > ;[189] 20723 000457'03 260 17 0 00 000451* 20724 000016'02 000000000000# 20725 000017'02 777777 777765 20726 000103'04 040 162 145 143 145 20727 000460'03 200 02 0 00 000000* srvnum spsiz ;[189] 20728 000461'03 201 03 0 00 000012 20729 000462'03 104 00 0 00 000224 20730 000463'03 320 14 0 00 000464' 20731 smsg < sent 20732 000464'03 120 02 0 00 000000# > ;[189] 20733 000465'03 260 17 0 00 000457* 20734 000020'02 000000000000# 20735 000021'02 777777 777771 20736 000106'04 040 163 145 156 164 20737 20738 000466'03 415 16 0 00 000504' block. ;[207] Set up a stack frame for registers 20739 000467'03 261 17 0 00 000016 20740 000470'03 265 16 0 00 004330' saveac ;[207] Holds a pointer to elapsed DK10 ticks double word 20741 000471'03 201 05 0 00 000000* movei q1,ewallt ;[207] Resolve address of elapsted wall time block 20742 000472'03 120 02 0 05 000017 dmove t2, .datus(q1) ;[207] Load the actual value 20743 000473'03 434 02 0 00 000003 or t2, t3 ;[207] Checking for non-zero either word 20744 000474'03 322 02 0 00 000503' ifn. t2 ;[207] Did this take any time, actually? 20745 000475'03 120 02 0 00 000000# smsg < Communications duration: > ;[207] It did 20746 000476'03 260 17 0 00 000465* 20747 000022'02 000000000000# 20748 000023'02 777777 777746 20749 000110'04 040 103 157 155 155 20750 000477'03 200 02 0 00 000005 move t2, q1 ;[207] So load pointer to the value 20751 000500'03 260 17 0 00 000000* call durtim ;[207] Print the duration 20752 smsg <, analysis: 20753 000501'03 120 02 0 00 000000# > ;[207] Close off 20754 000502'03 260 17 0 00 000476* 20755 000024'02 000000000000# 20756 000025'02 777777 777763 20757 000116'04 054 040 141 156 141 20758 20759 000503'03 endif. ;[207] End case elapsed DK10 ticks 20760 000503'03 263 17 0 00 000000 endbk. ;[207] Restore stack frame k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 9-1 K20DSP MAC 6-Jun-23 10:31 STATISTICS command 20761 20762 smsg < 20763 000504'03 120 02 0 00 000000# Sent: > ;[189] 20764 000505'03 260 17 0 00 000502* 20765 000026'02 000000000000# 20766 000027'02 777777 777762 20767 000121'04 015 012 011 123 145 20768 000506'03 200 02 0 00 000000* srvnum stot ;[189] 20769 000507'03 201 03 0 00 000012 20770 000510'03 104 00 0 00 000224 20771 000511'03 320 14 0 00 000512' 20772 20773 000512'03 120 02 0 00 000000# smsg < Efficiency: > ;[189] 20774 000513'03 260 17 0 00 000505* 20775 000030'02 000000000000# 20776 000031'02 777777 777757 20777 000124'04 040 040 040 040 011 20778 000514'03 200 02 0 00 000000* move t2, stchr 20779 000515'03 200 03 0 00 000506* move t3, stot 20780 000516'03 260 17 0 00 004024' call peffif ;[189] Print Efficiency Factor 20781 smsg < 20782 000517'03 120 02 0 00 000000# Received: > ;[189] 20783 000520'03 260 17 0 00 000513* 20784 000032'02 000000000000# 20785 000033'02 777777 777762 20786 000130'04 015 012 011 122 145 20787 000521'03 200 02 0 00 000000* srvnum rtot ;[189] 20788 000522'03 201 03 0 00 000012 20789 000523'03 104 00 0 00 000224 20790 000524'03 320 14 0 00 000525' 20791 000525'03 120 02 0 00 000000# smsg < Efficiency: > ;[189] 20792 000526'03 260 17 0 00 000520* 20793 000034'02 000000000000# 20794 000035'02 777777 777757 20795 000133'04 040 040 040 040 011 20796 000527'03 200 02 0 00 000000* move t2, rtchr 20797 000530'03 200 03 0 00 000521* move t3, rtot 20798 000531'03 260 17 0 00 004024' call peffif ;[189] Print Efficiency Factor 20799 20800 smsg < 20801 000532'03 120 02 0 00 000000# Total: > ;[189] 20802 000533'03 260 17 0 00 000526* 20803 000036'02 000000000000# 20804 000037'02 777777 777762 20805 000137'04 015 012 011 124 157 20806 000534'03 200 02 0 00 000530* move t2, rtot 20807 000535'03 270 02 0 00 000515* add t2, stot 20808 000536'03 200 04 0 00 000002 move t4, t2 ; Save the total number of chars. 20809 000537'03 201 03 0 00 000012 movei t3, ^d10 ;[194] 20810 000540'03 104 00 0 00 000224 NOUT% ;[194] 20811 000541'03 320 14 0 00 000542' erjmps .+1 ;[194] 20812 20813 000542'03 120 02 0 00 000000# smsg < Efficiency: > ;[189] 20814 000543'03 260 17 0 00 000533* 20815 000040'02 000000000000# k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 9-2 K20DSP MAC 6-Jun-23 10:31 STATISTICS command 20816 000041'02 777777 777757 20817 000142'04 040 040 040 040 011 20818 000544'03 200 02 0 00 000004 move t2, t4 ;[189] Load total of all communications chars 20819 000545'03 200 03 0 00 000514* move t3, stchr ;[189] Load file characters sent 20820 000546'03 270 03 0 00 000527* add t3, rtchr ;[189] add total receieved 20821 000547'03 260 17 0 00 004024' call peffif ;[189] One or the other will not be zero 20822 20823 smsg < 20824 20825 000550'03 120 02 0 00 000000# Total characters per second: > ;[189] 20826 000551'03 260 17 0 00 000543* 20827 000042'02 000000000000# 20828 000043'02 777777 777736 20829 000146'04 015 012 015 012 040 20830 20831 000552'03 337 03 0 00 000004 skipg t3, t4 ;[207] Did we send anything. actually? 20832 000553'03 254 00 0 00 000557' ifskp. ;[207] Looks like it 20833 000554'03 260 17 0 00 004077' call gmkcps ;[207] Print characters per second 20834 000555'03 254 00 0 00 000557' anskp. ;[207] Unless some problem (like no time) 20835 000556'03 254 00 0 00 000561' else. ;[207] In either case, don't do any math 20836 000557'03 120 02 0 00 000000# smsg <[N/A]> ;[207] So say really can't do it 20837 000560'03 260 17 0 00 000551* 20838 000044'02 000000000000# 20839 000045'02 777777 777773 20840 000155'04 133 116 057 101 135 20841 000561'03 endif. ;[207] End handling characters per second 20842 20843 smsg < 20844 000561'03 120 02 0 00 000000# Effective data rate: > ;[189] 20845 000562'03 260 17 0 00 000560* 20846 000046'02 000000000000# 20847 000047'02 777777 777747 20848 000157'04 015 012 040 105 146 20849 000563'03 336 03 0 00 000545* skipn t3, stchr ;[189] Is the number of chars sent zero? 20850 000564'03 200 03 0 00 000546* move t3, rtchr ;[189] If so we were receiving. 20851 000565'03 322 03 0 00 000570' ifn. t3 ;[207] Was there any data? 20852 000566'03 260 17 0 00 004122' call gmkbps ;[189] Display a more readable baud rate 20853 000567'03 254 00 0 00 000572' else. ;[207] Otherwise, number makes no sense 20854 000570'03 120 02 0 00 000000# smsg <[N/A]> ;[207] So say it isn't applicable 20855 000571'03 260 17 0 00 000562* 20856 000050'02 000000000000# 20857 000051'02 777777 777773 20858 000165'04 133 116 057 101 135 20859 000572'03 endif. 20860 20861 000572'03 337 00 0 00 000000# skipg pvbaud ;[210] Do we have a virtual baud rate? 20862 000573'03 333 00 0 00 000000* skiple speed ;[207] or on a real terminal? 20863 000574'03 260 17 0 00 000703' call pspeef ;[207] Go print speed efficiency (maybe) 20864 ;[180]... 20865 smsg < 20866 000575'03 120 02 0 00 000000# ILDB: > ;[189] 20867 000576'03 260 17 0 00 000571* 20868 000052'02 000000000000# 20869 000053'02 777777 777767 20870 000167'04 015 012 040 111 114 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 9-3 K20DSP MAC 6-Jun-23 10:31 STATISTICS command 20871 000577'03 200 02 0 00 000000* srvnum ttildb ;[189] 20872 000600'03 201 03 0 00 000012 20873 000601'03 104 00 0 00 000224 20874 000602'03 320 14 0 00 000603' 20875 000603'03 120 02 0 00 000000# smsg < SIN: > ;[189] 20876 000604'03 260 17 0 00 000576* 20877 000054'02 000000000000# 20878 000055'02 777777 777770 20879 000171'04 040 040 123 111 116 20880 000605'03 200 02 0 00 000000* srvnum ttisin ;[189] 20881 000606'03 201 03 0 00 000012 20882 000607'03 104 00 0 00 000224 20883 000610'03 320 14 0 00 000611' 20884 000611'03 120 02 0 00 000000# smsg < SIN Max: > ;[189] 20885 000612'03 260 17 0 00 000604* 20886 000056'02 000000000000# 20887 000057'02 777777 777764 20888 000173'04 040 040 123 111 116 20889 000613'03 200 02 0 00 000000* srvnum ttimax ;[189] 20890 000614'03 201 03 0 00 000012 20891 000615'03 104 00 0 00 000224 20892 000616'03 320 14 0 00 000617' 20893 000617'03 120 02 0 00 000000# smsg < BIN: > ;[189] 20894 000620'03 260 17 0 00 000612* 20895 000060'02 000000000000# 20896 000061'02 777777 777770 20897 000176'04 040 040 102 111 116 20898 000621'03 200 02 0 00 000000* srvnum ttibin ;[189] 20899 000622'03 201 03 0 00 000012 20900 000623'03 104 00 0 00 000224 20901 000624'03 320 14 0 00 000625' 20902 ;...[180] 20903 20904 000625'03 336 00 0 00 000000* $stat4: skipn errptr ; Was there an error? 20905 000626'03 254 00 0 00 000640' jrst $statx ; If not, done. 20906 smsg < 20907 000627'03 120 02 0 00 000000# Canceled by error: > ;[189] 20908 000630'03 260 17 0 00 000620* 20909 000062'02 000000000000# 20910 000063'02 777777 777751 20911 000200'04 015 012 040 103 141 20912 000631'03 200 02 0 00 000625* move t2, errptr ;[189] 20913 000632'03 403 03 0 00 000004 setzb t3, t4 ;[189] 20914 000633'03 104 00 0 00 000053 SOUT% ;[189] ; If so output it. 20915 000634'03 320 14 0 00 000635' erjmps .+1 ;[189] 20916 000635'03 561 02 0 00 000203* hrroi t2, crlf ;[189] ;[50] 20917 000636'03 104 00 0 00 000053 SOUT% ;[189] 20918 000637'03 320 14 0 00 000640' erjmps .+1 ;[189] 20919 20920 ;[36] Interpacket pause. 20921 20922 $statx: smsg < 20923 000640'03 120 02 0 00 000000# Interpacket pause in effect: > 20924 000641'03 260 17 0 00 000630* 20925 000064'02 000000000000# k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 9-4 K20DSP MAC 6-Jun-23 10:31 STATISTICS command 20926 000065'02 777777 777740 20927 000205'04 015 012 040 111 156 20928 000642'03 200 02 0 00 000000* srvnum pause ;[196] 20929 000643'03 201 03 0 00 000012 20930 000644'03 104 00 0 00 000224 20931 000645'03 320 14 0 00 000646' 20932 smsg < ms 20933 20934 000646'03 120 02 0 00 000000# Timeouts: > ;[196] ;[54] How many timeouts and NAKs. 20935 000647'03 260 17 0 00 000641* 20936 000066'02 000000000000# 20937 000067'02 777777 777756 20938 000214'04 040 155 163 015 012 20939 20940 000650'03 200 02 0 00 000000* srvnum ntimou ;[189] 20941 000651'03 201 03 0 00 000012 20942 000652'03 104 00 0 00 000224 20943 000653'03 320 14 0 00 000654' 20944 smsg < 20945 000654'03 120 02 0 00 000000# NAKs: > ;[189] 20946 000655'03 260 17 0 00 000647* 20947 000070'02 000000000000# 20948 000071'02 777777 777764 20949 000220'04 015 012 040 116 101 20950 000656'03 200 02 0 00 000000* srvnum nnak ;[189] 20951 000657'03 201 03 0 00 000012 20952 000660'03 104 00 0 00 000224 20953 000661'03 320 14 0 00 000662' 20954 20955 ;[47][132] If debugging, tell most recent JSYS error. 20956 20957 000662'03 322 14 0 00 000700' jumpe debug, $statz ;[132] Debugging? 20958 $statj: smsg < 20959 000663'03 120 02 0 00 000000# Last JSYS error: > ;[189] ; Yes, tell about last error. 20960 000664'03 260 17 0 00 000655* 20961 000072'02 000000000000# 20962 000073'02 777777 777754 20963 000223'04 015 012 040 114 141 20964 000665'03 525 02 0 00 400000 hrloi t2, .fhslf 20965 000666'03 400 03 0 00 000000 setz t3, 20966 000667'03 104 00 0 00 000011 ERSTR 20967 000670'03 320 14 0 00 000672' erjmps .+2 ;[189] Ignore strange error 20968 000671'03 320 14 0 00 000672' erjmps .+1 ;[189] Ignore stranger error 20969 smsg < 20970 000672'03 120 02 0 00 000000# Timer errors: > ;[189] ;[132] Also, give hints if anything is 20971 000673'03 260 17 0 00 000664* 20972 000074'02 000000000000# 20973 000075'02 777777 777754 20974 000230'04 015 012 040 124 151 20975 000674'03 200 02 0 00 000000* srvnum timerx ;[189] ; going wrong with timers. 20976 000675'03 201 03 0 00 000012 20977 000676'03 104 00 0 00 000224 20978 000677'03 320 14 0 00 000700' 20979 20980 $statz: smsg < k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 9-5 K20DSP MAC 6-Jun-23 10:31 STATISTICS command 20981 20982 000700'03 120 02 0 00 000000# > ;[189] 20983 000701'03 260 17 0 00 000673* 20984 000076'02 000000000000# 20985 000077'02 777777 777774 20986 000235'04 015 012 015 012 000 20987 000702'03 263 17 0 00 000000 ret 20988 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 10 K20DSP MAC 6-Jun-23 10:31 Print Speed Efficiency (if we have some kind of baud rate) 20989 subttl Print Speed Efficiency (if we have some kind of baud rate) 20990 20991 ; Rewrite of previous code for nanosecond resolution 20992 20993 ; N.B., Code IGNORES split speed and uses only the recieve speed 20994 20995 extern dblscl ; Double integer scaling factor 20996 20997 chgsec(code,const) 20998 000100'02 207620 000000 percnt: 100. ; Factor to range up to a percent 20999 000101'02 000000 000000 0. ; Double floating multiplier!! 21000 retsec 21001 21002 000703'03 pspeef: remark t1 ; It is DEADLY to touch t1!! 21003 remark ; Assumes these may be smashed 21004 remark t5, q1 ; These are aliased 21005 000703'03 265 16 0 00 004330' saveac ; Play it safe 21006 000704'03 265 16 0 00 000000* trvar <,,,,,> 21007 000705'03 000000 000014 21008 ; Naming conventions for transient variables 21009 remark dichrs ; Double Integer characters 21010 remark dfchrs ; Double floating characters 21011 remark dietic ; Double Integer elapsed ticks 21012 remark dfetic ; Double floating elapsed ticks 21013 remark disped ; Double integer speed 21014 remark dfsped ; Double floating speed 21015 21016 000706'03 403 02 0 00 000003 setzb t2, t3 ; Let's assume we'll need to float 21017 000707'03 124 02 0 15 000011 dmovem t2, disped ; an integer 21018 000710'03 124 02 0 15 000013 dmovem t2, dfsped ; baud rate 21019 21020 000711'03 135 02 0 00 004336' ldb t2,[POINTR(,nttype)] ;[210] Maybe remote, so find out 21021 000712'03 135 03 0 00 004337' ldb t3,[POINTR(,ntline)] ;[210] about our local line 21022 000713'03 332 00 0 00 000000* ifme. ptyflg ; Not connected to a pseudo terminal? 21023 000714'03 254 00 0 00 000737' 21024 000715'03 332 00 0 00 000000* skipe nrtflg ; Network remote? 21025 000716'03 254 00 0 00 000737' anskp. ; So do that 21026 000717'03 302 02 0 00 000000 caie t2, nw%nnt ; Not a network transport? 21027 000720'03 254 00 0 00 000737' anskp. ; No, so either a front end or PTY 21028 000721'03 306 03 0 00 000002 cain t3, nw%pt ; But!! Are we on a pseudo-terminal?? 21029 000722'03 254 00 0 00 000737' anskp. ; No, so can only be the front-end case 21030 smsg < 21031 000723'03 120 02 0 00 000000# Efficiency: > ; Begin more blat 21032 000724'03 260 17 0 00 000701* 21033 000102'02 000000000000# 21034 000103'02 777777 777757 21035 000236'04 015 012 040 105 146 21036 000725'03 333 03 0 00 000573* skiple t3, speed ; Load and check speed 21037 000726'03 254 00 0 00 000732' ifskp. ; Is this absurd? 21038 000727'03 120 02 0 00 000000# smsg <[SPEED ERROR]> ;Report speed error 21039 000730'03 260 17 0 00 000724* 21040 000104'02 000000000000# 21041 000105'02 777777 777763 21042 000242'04 133 123 120 105 105 21043 000731'03 263 17 0 00 000000 ret ; Leave, can't do anything else k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 10-1 K20DSP MAC 6-Jun-23 10:31 Print Speed Efficiency (if we have some kind of baud rate) 21044 000732'03 endif. ; end speed load and check 21045 000732'03 400 02 0 00 000000 setz t2, ; Assume hardware baud is not an unsigned int 21046 000733'03 623 03 0 00 400000 tlze t3, (1b0) ; Cast unsigned to signed long 21047 000734'03 201 02 0 00 000001 movei t2, ^d1 ; Propagate to high order 21048 000735'03 124 02 0 15 000011 dmovem t2, disped ; And store as the speed 21049 000736'03 254 00 0 00 000761' else. ; Otherwise, might have done virtual timing 21050 000737'03 400 05 0 00 000000 setz q1, ;[210] Let's assume we don't know what to load 21051 000740'03 332 00 0 00 000713* skipe ptyflg ;[210] Connected to a PTY? 21052 000741'03 201 05 0 00 000000# movei q1, pvbaud ;[210] Address of its virtual baud rate 21053 000742'03 332 00 0 00 000715* skipe nrtflg ;[210] How about an NRT? 21054 000743'03 201 05 0 00 000000# movei q1, dnbaud ;[210] Address of DECnet virtual baud rate 21055 000744'03 326 05 0 00 000752' ife. q1 ;[210] Still don't know? 21056 000745'03 306 03 0 00 000002 cain t3, nw%pt ;[210] A pseudo-terminal? 21057 000746'03 201 05 0 00 000000# movei q1, pvbaud ;[210] Address of its virtual baud rate 21058 000747'03 306 03 0 00 000003 cain t3, nw%mc ;[210] An NRT? 21059 000750'03 201 05 0 00 000000# movei q1, dnbaud ;[210] Address of DECnet virtual baud rate 21060 000751'03 322 05 0 00 000444* jumpe q1, R ;[210] If still nothing, then done 21061 000752'03 endif. ;[210] Otherwise some valid address in q1 21062 000752'03 120 02 0 05 000000 dmove t2, (q1) ;[210] Load any timing test data 21063 000753'03 323 02 0 00 000751* jumple t2, R ;[210] No test or bad test 21064 000754'03 124 02 0 15 000013 dmovem t2, dfsped ; Store precomputed virtual rate 21065 000755'03 477 02 0 00 000003 setob t2, t3 ; Cons up an impossible double integer baud rate 21066 000756'03 124 02 0 15 000011 dmovem t2, disped ; And store as the speed 21067 smsg < 21068 000757'03 120 02 0 00 000000# Pseudo-efficiency: > ; Begin pseudo-blat 21069 000760'03 260 17 0 00 000730* 21070 000106'02 000000000000# 21071 000107'02 777777 777751 21072 000245'04 015 012 040 120 163 21073 000761'03 endif. ; End case local or remote instrumented PTY 21074 21075 000761'03 336 03 0 00 000563* skipn t3, stchr ; Nothing sent? 21076 000762'03 200 03 0 00 000564* move t3, rtchr ; No, so this was a recieve 21077 000763'03 326 03 0 00 000767' ife. t3 ; Or did nothing happen at all? 21078 000764'03 120 02 0 00 000000# smsg <[N/A]> ; So say it isn't applicable 21079 000765'03 260 17 0 00 000760* 21080 000110'02 000000000000# 21081 000111'02 777777 777773 21082 000252'04 133 116 057 101 135 21083 000766'03 263 17 0 00 000000 ret ; And get out of here 21084 000767'03 endif. 21085 21086 000767'03 400 02 0 00 000000 setz t2, ; Assume characters are not unsigned int 21087 000770'03 623 03 0 00 400000 tlze t3, (1b0) ; Cast unsigned to signed long 21088 000771'03 201 02 0 00 000001 movei t2, ^d1 ; Propagate to high order 21089 000772'03 124 02 0 15 000001 dmovem t2, dichrs ; And store signed long 21090 21091 000773'03 415 16 0 00 001001' block. ; Enter block context for better control flow 21092 000774'03 261 17 0 00 000016 21093 000775'03 120 02 0 00 000000# dmove t2,ewallt+.datus ;Load double elapsed DK10 ticks 21094 000776'03 327 02 0 00 000445* jumpg t2, RSKP ; Non-zero high order is good 21095 000777'03 327 03 0 00 000776* jumpg t3, RSKP ; Ditto low order 21096 001000'03 263 17 0 00 000000 endbk. ; End block context 21097 001001'03 254 00 0 00 001004' ifskp. ; Positive number? 21098 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 15:18 11-Jun-23 Page 10-2 K20DSP MAC 6-Jun-23 10:31 Print Speed Efficiency (if we have some kind of baud rate) 21099 001003'03 254 00 0 00 001007' else. ; Otherwise, zero or negative 21100 001004'03 120 02 0 00 000000# smsg <[TIME ERROR]> ; Report time error 21101 001005'03 260 17 0 00 000765* 21102 000112'02 000000000000# 21103 000113'02 777777 777764 21104 000254'04 133 124 111 115 105 21105 001006'03 263 17 0 00 000000 ret ; Leave, can't do anything else 21106 001007'03 endif. 21107 21108 001007'03 415 16 0 00 001034' block. ; Enter block context to double float everything 21109 001010'03 261 17 0 00 000016 21110 001011'03 265 16 0 00 004340' saveac ; Save precious T1 21111 001012'03 120 01 0 15 000011 dmove t1, disped ; Load integer baud 21112 001013'03 321 01 0 00 001017' ifge. t1 ; Already did this? 21113 001014'03 260 17 0 00 000000* call dfloat ; Convert to double floating point 21114 001015'03 263 17 0 00 000000 ret ; Or not 21115 001016'03 124 01 0 15 000013 dmovem t1, dfsped ; Store double floating speed 21116 001017'03 endif. ; Otherwise, already done 21117 21118 001017'03 120 01 0 15 000005 dmove t1, dietic ; Load double integer elapsed ticks 21119 001020'03 260 17 0 00 001014* call dfloat ; Convert to double floating point 21120 001021'03 263 17 0 00 000000 ret ; But couldn't... 21121 001022'03 124 01 0 15 000007 dmovem t1, dfetic ; Store double floating elapsed ticks 21122 001023'03 120 01 0 15 000001 dmove t1, dichrs ; Load double integer characters 21123 001024'03 116 01 0 00 000000* dmul t1, dblscl ; Scale up by nanosecond ratio 21124 001025'03 124 03 0 15 000001 dmovem t3, dichrs ; Store scaled double integer elapsed ticks 21125 21126 001026'03 120 01 0 00 000003 dmove t1, t3 ; Load same for double floating 21127 001027'03 260 17 0 00 001020* call dfloat ; Convert to double floating point 21128 001030'03 263 17 0 00 000000 ret ; Yet failed 21129 001031'03 124 01 0 15 000003 dmovem t1, dfchrs ; Store double floating characters 21130 001032'03 254 00 0 00 000777* retskp ; Indicate complete double floating success 21131 001033'03 263 17 0 00 000000 endbk. ; End block context, release frame 21132 001034'03 254 00 0 00 001040' ifskp. ; Worked 21133 001035'03 120 02 0 15 000003 dmove t2, dfchrs ; Load double floating characters 21134 001036'03 112 02 0 00 004120' dfmp t2, baud ; Convert to bits for baud rate 21135 001037'03 254 00 0 00 001043' else. ; Something went wrong... 21136 001040'03 120 02 0 00 000000# smsg <[DFLOAT ERROR]> ; Yes, whine about it 21137 001041'03 260 17 0 00 001005* 21138 000114'02 000000000000# 21139 000115'02 777777 777762 21140 000257'04 133 104 106 114 117 21141 001042'03 263 17 0 00 000000 ret ; Return, can't go any further 21142 001043'03 endif. 21143 21144 001043'03 113 02 0 15 000007 dfdv t2, dfetic ; Compute effective baud rate 21145 001044'03 112 02 0 00 000000# dfmp t2, percnt ; Scale to percentage 21146 001045'03 113 02 0 15 000013 dfdv t2, dfsped ; Divide by line rate to get efficiency 21147 001046'03 260 17 0 00 004064' call peffi0 ; Print it 21148 001047'03 120 02 0 00 000000# smsg < per cent> ;[189] 21149 001050'03 260 17 0 00 001041* 21150 000116'02 000000000000# 21151 000117'02 777777 777767 21152 000262'04 040 160 145 162 040 21153 001051'03 263 17 0 00 000000 ret k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 10-3 K20DSP MAC 6-Jun-23 10:31 Print Speed Efficiency (if we have some kind of baud rate) 21154 21155 endtv. ; End lexical context transient variables 21156 21157 ;[207] End code insertion 21158 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 11 K20DSP MAC 6-Jun-23 10:31 Print real or virtual baud rate 21159 subttl Print real or virtual baud rate 21160 21161 extern ntiblk ;[210] NTINF% of local line 21162 21163 001052'03 332 00 0 00 000740* prntbd: skipe ptyflg ;[210] Connected to a PTY? 21164 001053'03 254 00 0 00 001107' jrst prntbv ;[210] Yes, show the virtual baud rate 21165 001054'03 332 00 0 00 000742* skipe nrtflg ;[210] How about an NRT? 21166 001055'03 254 00 0 00 001107' jrst prntbv ;[210] Yes, show the virtual baud rate 21167 remark pipflg ;[210] Connected via a pipe? 21168 remark prntbv ;[210] Yes, show the virtual baud rate 21169 ;[210] Load network and line type of local terminal 21170 001056'03 135 01 0 00 004346' ldb t1,[POINTR(,nttype)] ;[210] 21171 001057'03 135 02 0 00 004347' ldb t2,[POINTR(,ntline)] ;[210] 21172 001060'03 302 01 0 00 000000 caie t1, nw%nnt ;[210] Not a 'network' terminal? 21173 001061'03 254 00 0 00 001101' jrst prntnv ;[210] No see if it has a network virtual baud rate 21174 001062'03 306 02 0 00 000002 cain t2, nw%pt ;[210] But!! Are we on a pseudo-terminal?? 21175 001063'03 254 00 0 00 001101' jrst prntnv ;[210] We are, see if we did a speed test 21176 remark ;[210] Only other non-network terminal is FE: 21177 21178 001064'03 337 02 0 00 000725* prntbs: skipg t2,speed ; If negative, we don't really know it. 21179 001065'03 254 00 0 00 001100' ifskp. ;[194] We know it 21180 txmsg < 21181 001066'03 200 01 0 00 000000# Speed: > ; Line speed. 21182 001067'03 104 00 0 00 000076 21183 001070'03 320 12 0 00 001071' 21184 000120'02 000000000000# 21185 000264'04 015 012 040 040 123 21186 001071'03 201 01 0 00 000101 movei t1, .priou 21187 001072'03 201 03 0 00 000012 movei t3, ^d10 21188 001073'03 104 00 0 00 000224 NOUT% 21189 001074'03 320 14 0 00 001075' erjmps .+1 21190 001075'03 200 01 0 00 000000# txmsg < Bd> ;[210] Recognized suffix for "baud" 21191 001076'03 104 00 0 00 000076 21192 001077'03 320 12 0 00 001100' 21193 000121'02 000000000000# 21194 000270'04 040 102 144 000 000 21195 001100'03 endif. ;[194] 21196 001100'03 263 17 0 00 000000 ret ;[210] Either way, done 21197 21198 001101'03 400 01 0 00 000000 prntnv: setz t1, ;[210] Let's assume we don't know what to load 21199 001102'03 306 02 0 00 000002 cain t2, nw%pt ;[210] A pseudo-terminal? 21200 001103'03 201 01 0 00 000000# movei t1, pvbaud ;[210] Address of its virtual baud rate 21201 001104'03 306 02 0 00 000003 cain t2, nw%mc ;[210] An NRT? 21202 001105'03 201 01 0 00 000000# movei t1, dnbaud ;[210] Address of DECnet virtual baud rate 21203 001106'03 254 00 0 00 001114' jrst prntcm ;[210] See if anything to print 21204 21205 001107'03 400 01 0 00 000000 prntbv: setz t1, ;[210] Let's assume we don't know what to load 21206 001110'03 332 00 0 00 001052* skipe ptyflg ;[210] Connected to a PTY? 21207 001111'03 201 01 0 00 000000# movei t1, pvbaud ;[210] Address of its virtual baud rate 21208 001112'03 332 00 0 00 001054* skipe nrtflg ;[210] How about an NRT? 21209 001113'03 201 01 0 00 000000# movei t1, dnbaud ;[210] Address of DECnet virtual baud rate 21210 remark pipflg ;[210] Connected via a pipe? 21211 remark t1, pibaud ;[210] Address of its virtual baud rate 21212 21213 001114'03 prntcm: remark ;[210] Common virtual speed k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 11-1 K20DSP MAC 6-Jun-23 10:31 Print real or virtual baud rate 21214 001114'03 322 01 0 00 000753* jumpe t1, r ;[210] Return if nobody is volunteering anything 21215 001115'03 265 16 0 00 004330' saveac ;[210] Preserve for proper return xct 21216 remark t5, q1 ;[210] Because t4:t5 pair used 21217 001116'03 120 04 0 01 000000 dmove t4, (t1) ;[210] Load virtual baud rate 21218 001117'03 323 04 0 00 001114* jumple t4, r ;[210] If nothing, then don't print anything 21219 txmsg < 21220 001120'03 200 01 0 00 000000# Pseudo Speed: > ;[210] Instrumented PTY speed 21221 001121'03 104 00 0 00 000076 21222 001122'03 320 12 0 00 001123' 21223 000122'02 000000000000# 21224 000271'04 015 012 040 040 120 21225 001123'03 201 01 0 00 000101 movei t1, .priou ;[210] Display it on terminal 21226 001124'03 254 00 0 00 004137' callret gmkbp1 ;[210] Print the baud rate 21227 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 12 K20DSP MAC 6-Jun-23 10:31 Print real or virtual baud rate 21228 remark Test command semantic action 21229 21230 ;[210] Begin Code Insertion 21231 21232 extern dptybd ; Discover PTY: virtual baud rate 21233 extern dnulbd ; Discover NUL: virtual baud rate 21234 extern dpipbd ; Discover PIP: virtual baud rate 21235 extern dsrvbd ; Discover DECnet (DCN:/SRV:) virtual baud rate 21236 extern timdev ; Device being timed 21237 21238 001125'03 $time: intern $time ; Called from k20par 21239 001125'03 265 16 0 00 004330' saveac ; Just in case anybody might needit 21240 001126'03 331 01 0 00 000000* skipl t1, pars2 ; Pick up the device to test 21241 001127'03 254 00 0 00 001151' ifskp. ; Special return?? 21242 001130'03 316 01 0 00 004350' camn t1, [-1] ; Error that somebody else blatted? 21243 001131'03 263 17 0 00 000000 ret ; We're done 21244 001132'03 554 02 0 00 000001 hlrz t2, t1 ; Reposition source device type 21245 001133'03 620 02 0 00 600000 trz t2, .dvdes ; Now have a device number 21246 001134'03 200 01 0 00 000000# txmsg 21247 001135'03 104 00 0 00 000076 21248 001136'03 320 12 0 00 001137' 21249 000123'02 000000000000# 21250 000276'04 103 157 160 151 145 21251 001137'03 200 01 0 00 000002 move t1, t2 ; Position for conversion to text 21252 001140'03 260 17 0 00 001262' call ascdev ; Do so 21253 001141'03 104 00 0 00 000076 PSOUT% ; Type the text 21254 001142'03 200 01 0 00 000000# txmsg < to > ; Where it's going 21255 001143'03 104 00 0 00 000076 21256 001144'03 320 12 0 00 001145' 21257 000124'02 000000000000# 21258 000304'04 040 164 157 040 000 21259 001145'03 200 02 0 00 000000* move t2, pars3 ; Load destination device 21260 001146'03 202 02 0 00 001126* movem t2, pars2 ; Put where downstream wants it 21261 001147'03 120 04 0 00 000000* dmove t4, pars4 ; Load the timing results 21262 001150'03 254 00 0 00 001323' callret $time1 ; And go type something 21263 001151'03 endif. 21264 21265 001151'03 202 01 0 00 000000* movem t1, timdev ; Remember device being timed 21266 001152'03 302 01 0 00 000013 caie t1, .dvpty ; Pseudo-terminal? 21267 001153'03 254 00 0 00 001172' ifskp. ; Yep, so let's run that test 21268 001154'03 476 00 0 00 000000# setom pvbaud ; Say no PTY virtual baud rate 21269 001155'03 476 00 0 00 000000# setom pvbaud+1 ; It's a double 21270 001156'03 260 17 0 00 000000* call dptybd ; Found in k20net 21271 001157'03 254 00 0 00 001165' ifskp. 21272 001160'03 327 04 0 00 001164' ifle. t4 ; Did it work? 21273 001161'03 200 01 0 00 000000# emsg 21274 001162'03 104 00 0 00 000313 21275 000125'02 000000000000# 21276 000305'04 120 163 145 165 144 21277 001163'03 263 17 0 00 000000 ret ; Can't do anything further 21278 001164'03 endif. ; Otherwise, have a valid number 21279 001164'03 254 00 0 00 001170' else. 21280 001165'03 200 01 0 00 000000# emsg 21281 001166'03 104 00 0 00 000313 21282 000126'02 000000000000# k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 12-1 K20DSP MAC 6-Jun-23 10:31 Print real or virtual baud rate 21283 000316'04 120 163 145 165 144 21284 001167'03 263 17 0 00 000000 ret ; Can't do anything further 21285 001170'03 endif. 21286 21287 001170'03 124 04 0 00 000000# dmovem t4, pvbaud ; Side-effect virtual baud rate 21288 001171'03 254 00 0 00 001323' callret $time1 ; And display it 21289 001172'03 endif. ; End case pseudo-terminal 21290 21291 001172'03 302 01 0 00 000015 caie t1, .dvnul ; NUL: device? 21292 001173'03 254 00 0 00 001212' ifskp. ; OK, so let's see how fast we can dump stuff 21293 001174'03 476 00 0 00 000000# setom nlbaud ; Assume fails 21294 001175'03 476 00 0 00 000000# setom nlbaud+1 ; It's a double word 21295 001176'03 260 17 0 00 000000* call dnulbd ; Go do some nanosecond timing 21296 001177'03 254 00 0 00 001205' ifskp. 21297 001200'03 327 04 0 00 001204' ifle. t4 ; Did it work? 21298 001201'03 200 01 0 00 000000# emsg 21299 001202'03 104 00 0 00 000313 21300 000127'02 000000000000# 21301 000327'04 104 141 164 141 040 21302 001203'03 263 17 0 00 000000 ret ; Can't do anything further 21303 001204'03 endif. ; Otherwise, have a valid number 21304 001204'03 254 00 0 00 001210' else. 21305 001205'03 200 01 0 00 000000# emsg 21306 001206'03 104 00 0 00 000313 21307 000130'02 000000000000# 21308 000337'04 104 141 164 141 040 21309 001207'03 263 17 0 00 000000 ret ; Can't do anything further 21310 001210'03 endif. 21311 21312 001210'03 124 04 0 00 000000# dmovem t4, nlbaud ; Store NUL's virtual baud rate 21313 001211'03 254 00 0 00 001323' callret $time1 ; Hit display epilogue 21314 001212'03 endif. 21315 21316 001212'03 302 01 0 00 000403 caie t1, .dvpip ; Pipe device? 21317 001213'03 254 00 0 00 001232' ifskp. ; Yep, so let's run that test 21318 001214'03 476 00 0 00 000000# setom pibaud ; Assume fails 21319 001215'03 476 00 0 00 000000# setom pibaud+1 ; It's a double word 21320 001216'03 260 17 0 00 000000* call dpipbd ; Found in k20net 21321 001217'03 254 00 0 00 001225' ifskp. 21322 001220'03 327 04 0 00 001224' ifle. t4 ; Did it work? 21323 001221'03 200 01 0 00 000000# emsg 21324 001222'03 104 00 0 00 000313 21325 000131'02 000000000000# 21326 000347'04 120 151 160 145 040 21327 001223'03 263 17 0 00 000000 ret ; Can't do anything further 21328 001224'03 endif. ; Otherwise, have a valid number 21329 001224'03 254 00 0 00 001230' else. 21330 001225'03 200 01 0 00 000000# emsg 21331 001226'03 104 00 0 00 000313 21332 000132'02 000000000000# 21333 000356'04 120 151 160 145 040 21334 001227'03 263 17 0 00 000000 ret ; Can't do anything further 21335 001230'03 endif. 21336 21337 001230'03 124 04 0 00 000000# dmovem t4, pibaud ; Store the calculated baud rate k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 12-2 K20DSP MAC 6-Jun-23 10:31 Print real or virtual baud rate 21338 001231'03 254 00 0 00 001323' callret $time1 ; Hit display epilogue 21339 001232'03 endif. ; End case pseudo-terminal 21340 21341 001232'03 306 01 0 00 000022 cain t1, .dvdcn ; DECnet active component? 21342 001233'03 201 01 0 00 000023 movei t1, .dvsrv ; Replace with DECnet passive component 21343 21344 001234'03 302 01 0 00 000023 caie t1, .dvsrv ; DECnet? 21345 001235'03 254 00 0 00 001254' ifskp. ; Yep, so let's run that test 21346 001236'03 476 00 0 00 000000# setom dnbaud ; Assume no DECnet baud rate detected 21347 001237'03 476 00 0 00 000000# setom dnbaud+1 ; It's a double 21348 001240'03 260 17 0 00 000000* call dsrvbd ; Found in k20net 21349 001241'03 254 00 0 00 001247' ifskp. 21350 001242'03 327 04 0 00 001246' ifle. t4 ; Did it work? 21351 001243'03 200 01 0 00 000000# emsg 21352 001244'03 104 00 0 00 000313 21353 000133'02 000000000000# 21354 000365'04 104 105 103 156 145 21355 001245'03 263 17 0 00 000000 ret ; Can't do anything further 21356 001246'03 endif. ; Otherwise, have a valid number 21357 001246'03 254 00 0 00 001252' else. 21358 001247'03 200 01 0 00 000000# emsg 21359 001250'03 104 00 0 00 000313 21360 000134'02 000000000000# 21361 000375'04 104 105 103 156 145 21362 001251'03 263 17 0 00 000000 ret ; Can't do anything further 21363 001252'03 endif. 21364 21365 001252'03 124 04 0 00 000000# dmovem t4, dnbaud ; Store the calculated baud rate 21366 001253'03 254 00 0 00 001323' callret $time1 ; Hit display epilogue 21367 001254'03 endif. ; End case pseudo-terminal 21368 21369 001254'03 260 17 0 00 001262' call ascdev ; Turn device number in t1 into a name 21370 001255'03 104 00 0 00 000313 ESOUT% ; Begin whining 21371 txmsg < does not have a timing routine 21372 001256'03 200 01 0 00 000000# > ; Complete whining 21373 001257'03 104 00 0 00 000076 21374 001260'03 320 12 0 00 001261' 21375 000135'02 000000000000# 21376 000404'04 040 144 157 145 163 21377 21378 001261'03 263 17 0 00 000000 ret ; Beat it 21379 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 13 K20DSP MAC 6-Jun-23 10:31 Handle unknown and known timing devices 21380 subttl Handle unknown and known timing devices 21381 21382 ; Call: 21383 ; 21384 ; t1/ Device number to translate 21385 ; 21386 ; Return: +1 always 21387 ; 21388 ; t1/ pointer to constructed device text 21389 ; (even if unknown device) 21390 21391 chgsec(code,data) ; Need some writable storage 21392 000000'05 devtxt: block 4 ; Space for ASCII device name 21393 retsec ; Close off writable storage 21394 21395 chgsec(code,text) ; Emit some program text 21396 000004'01 125 156 153 156 157 unktxt: asciz "Unknown:" ; if we have no clue 21397 000006'01 000000 000072 dvpunc: exp ":", .chnul ; Device punctuation 21398 retsec ; Close off program text 21399 21400 001262'03 ascdev: intern ascdev ; In case K20TIM wants to directly use it 21401 001262'03 265 16 0 00 004351' saveac ; Needs some registers 21402 001263'03 200 05 0 00 000001 move q1, t1 ; Save device number 21403 21404 001264'03 260 17 0 00 001310' call devunt ; If device has units, use that 21405 001265'03 326 01 0 00 001117* jumpn t1, r ; Was transformed 21406 ; OK, not a device with units 21407 001266'03 525 02 0 05 600000 hrloi t2, .dvdes(q1) ; Turn back into a real device 21408 001267'03 201 01 0 00 000000# movei t1, devtxt ; Writable to put ASCII device name 21409 001270'03 403 03 0 00 000004 setzb t3, t4 ; Ten .chnul's of device name (6 max) 21410 001271'03 124 03 0 01 000000 dmovem t3, 0(t1) ; Stomp area 21411 001272'03 124 03 0 01 000002 dmovem t3, 2(t1) ; Plus extra for good measure 21412 001273'03 661 01 0 00 777777 tlo t1, -1 ; Now have a Tops-20 JSYS pointer 21413 21414 001274'03 104 00 0 00 000121 DEVST% ; Turn into a string 21415 001275'03 320 12 0 00 001277' ifje. r ; Catch error 21416 001276'03 254 00 0 00 001302' 21417 001277'03 200 02 0 00 000001 move t2, t1 ; And keep for a debugger 21418 001300'03 561 01 0 00 000000# hrroi t1, unktxt ; Say we don't know... 21419 001301'03 254 00 0 00 001307' else. ; Otherwise, have some text 21420 001302'03 120 02 0 00 000000# dmove t2, dvpunc ; Load device punctuation 21421 001303'03 136 02 0 00 000001 idpb t2, t1 ; Drop in the colon 21422 001304'03 200 02 0 00 000001 move t2, t1 ; Copy the pointer 21423 001305'03 136 03 0 00 000002 idpb t3, t2 ; Close off string, allowing append 21424 001306'03 561 01 0 00 000000# hrroi t1, devtxt ; Return pointer to constructed text 21425 001307'03 endif. 21426 21427 001307'03 263 17 0 00 000000 ret ; Finally return, something... 21428 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 14 K20DSP MAC 6-Jun-23 10:31 devunt Turns a device with unit numbers into generic 21429 subttl devunt Turns a device with unit numbers into generic 21430 21431 ;Can't use chgsec here, doesn't nest 21432 21433 define gendev(d,t,%a) < 21434 xwd d,%a ;;Create an entry for this device 21435 .endps const ;;Out of constants 21436 .psect text ;;Program text 21437 %a: asciz "'t:" ;;Emit the text, no output to DDT 21438 .endps text ;;Close of text 21439 .psect const ;;Back in constants 21440 cleans(<%a>) 21441 >;;gendev 21442 21443 ; Build table of generic device text for unit based devices 21444 21445 ; The first three currently exist on PANDA and can be entered to .cmdev 21446 21447 chgsec(code,const) 21448 000136'02 000013 000000# gentab: gendev(.dvpty,PTY) ;;Pseudo-terminal (most common) 21449 000010'01 120 124 131 072 000 21450 000137'02 000012 000000# gendev(.dvtty,TTY) ;;Terminal (second most common) 21451 000011'01 124 124 131 072 000 21452 000140'02 000011 000000# gendev(.dvfe,FE) ;;Front end (may get noticed) 21453 000012'01 106 105 072 000 000 21454 remark ;;Otherwise, do in numeric order 21455 000141'02 000002 000000# gendev(.dvmta,MTA) ;;Physical magnetic tape 21456 000013'01 115 124 101 072 000 21457 000142'02 000003 000000# gendev(.dvdta,DTA) ;;1031 had these as does MOUNTR 21458 000014'01 104 124 101 072 000 21459 000143'02 000004 000000# gendev(.dvptr,PTR) ;;Paper tape reader 21460 000015'01 120 124 122 072 000 21461 000144'02 000005 000000# gendev(.dvptp,PTP) ;;Paper tape punch 21462 000016'01 120 124 120 072 000 21463 000145'02 000006 000000# gendev(.dvdsp,DIS) ;;Display 21464 000017'01 104 111 123 072 000 21465 000146'02 000007 000000# gendev(.dvlpt,LPT) ;;Line printer 21466 000020'01 114 120 124 072 000 21467 000147'02 000010 000000# gendev(.dvcdr,CDR) ;;Card reader 21468 000021'01 103 104 122 072 000 21469 000150'02 000017 000000# gendev(.dvplt,PLT) ;;Plotter 21470 000022'01 120 114 124 072 000 21471 000151'02 000021 000000# gendev(.dvcdp,CDP) ;;Card punch 21472 000023'01 103 104 120 072 000 21473 remark ; N.B., .dvats usurped by .dvnft 21474 ; gendev(.dvats,ATS) ;;Applications terminal SERVICE 21475 000152'02 000025 000000# gendev(.dvads,ADS) ;;Aydin display 21476 000024'01 101 104 123 072 000 21477 000153'02 000000000000# 0 ; Mark end of table 21478 retsec 21479 21480 ; Call: t1/ Device number, as per MONSYM 21481 ; Return: t1/ Maybe a pointer if a unit based device 21482 21483 001310'03 265 16 0 00 004363' devunt: saveac ; Just in case we get careless k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 14-1 K20DSP MAC 6-Jun-23 10:31 devunt Turns a device with unit numbers into generic 21484 001311'03 200 03 0 00 000001 move t3, t1 ; Move device number to someplace safer 21485 001312'03 400 01 0 00 000000 setz t1, ; Let's assume not a unit based device 21486 001313'03 201 04 0 00 000000# movei t4, gentab ; Load address of generics table 21487 21488 001314'03 do. ; Enter loop context 21489 001314'03 554 02 0 04 000000 hlrz t2, (t4) ; Load candidate device number 21490 001315'03 322 02 0 00 001265* jumpe t2, r ; If empty, none of the above 21491 001316'03 316 02 0 00 000003 camn t2, t3 ; Hit our device, yet? 21492 001317'03 254 00 0 00 001321' exit. ; Hot zing! Have a string to return 21493 001320'03 344 04 0 00 001314' aoja t4, top. ; Otherwise, next device 21494 001321'03 enddo. ; Exit loop context 21495 21496 001321'03 560 01 0 04 000000 hrro t1, (t4) ; Pick up address of text 21497 001322'03 263 17 0 00 000000 ret ; Return as a Tops-20 pointer 21498 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 15 K20DSP MAC 6-Jun-23 10:31 Common Display Epilogue 21499 subttl Common Display Epilogue 21500 21501 ; T4/T5 Baud rate to display 21502 21503 001323'03 200 01 0 00 001146* $time1: move t1, pars2 ; Load device number 21504 001324'03 260 17 0 00 001262' call ascdev ; Turn into a reasonable string 21505 001325'03 104 00 0 00 000076 PSOUT% ; Type it 21506 001326'03 120 01 0 00 004375' dmove t1, [exp .priou, .chspc] 21507 001327'03 104 00 0 00 000051 BOUT% ; And space over 21508 21509 001330'03 254 00 0 00 004137' callret gmkbp1 ; Print the baud rate 21510 001331'03 561 01 0 00 000635* hrroi t1, crlf ; Tie off the line 21511 001332'03 104 00 0 00 000076 PSOUT% 21512 001333'03 263 17 0 00 000000 ret ; And done 21513 21514 ;[210] End code insertion 21515 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 16 K20DSP MAC 6-Jun-23 10:31 SHOW VERSION 21516 subttl SHOW VERSION 21517 21518 extern $verno ;[194] Major version 21519 extern $mnver ;[194] Minor version 21520 extern $edno ;[194] Edit number 21521 extern $who ;[194] Who last edited 21522 21523 001334'03 $shtop: entry $shtop ;[194] ;[39] Top of SHOW command. 21524 001334'03 $shver: entry $shver ;[194] 21525 001334'03 200 01 0 00 000000# txmsg 21526 001335'03 104 00 0 00 000076 21527 001336'03 320 12 0 00 001337' 21528 000154'02 000000000000# 21529 000413'04 124 117 120 123 055 21530 21531 001337'03 201 01 0 00 000101 movei t1, .priou ;[194] 21532 dmove t2, [ $verno ;[197] major version 21533 001340'03 120 02 0 00 004377' ^d10 ] ;[197] Using decimal versions 21534 001341'03 104 00 0 00 000224 NOUT% ;[194] 21535 001342'03 320 14 0 00 001343' erjmps .+1 ;[194] 21536 21537 001343'03 336 02 0 00 004401' skipn t2, [$mnver] ;[197] 21538 001344'03 254 00 0 00 001353' ifskp. ;[197] minor version 21539 001345'03 201 01 0 00 000056 movei t1, "." ;[95] Use new decimal notation 21540 001346'03 104 00 0 00 000074 PBOUT ;[95] 21541 001347'03 320 14 0 00 001350' erjmps .+1 ;[194] 21542 001350'03 201 01 0 00 000101 movei t1, .priou ;[194] 21543 001351'03 104 00 0 00 000224 NOUT% ;[194] 21544 001352'03 320 14 0 00 001353' erjmps .+1 ;[194] 21545 001353'03 endif. ;[194] 21546 21547 001353'03 336 02 0 00 004402' skipn t2, [$edno] ;[197] edit 21548 001354'03 254 00 0 00 001366' ifskp. ;[197] 21549 001355'03 201 01 0 00 000050 movei t1, "(" 21550 001356'03 104 00 0 00 000074 PBOUT 21551 001357'03 320 14 0 00 001360' erjmps .+1 ;[194] 21552 001360'03 201 01 0 00 000101 movei t1, .priou ;[194] 21553 001361'03 104 00 0 00 000224 NOUT% ;[194] 21554 001362'03 320 14 0 00 001363' erjmps .+1 ;[194] 21555 001363'03 201 01 0 00 000051 movei t1, ")" 21556 001364'03 104 00 0 00 000074 PBOUT 21557 001365'03 320 14 0 00 001366' erjmps .+1 ;[194] 21558 001366'03 endif. ;[194] 21559 21560 001366'03 336 02 0 00 004403' skipn t2, [$who] ;[197] who 21561 001367'03 254 00 0 00 001376' ifskp. ;[197] 21562 001370'03 201 01 0 00 000055 movei t1, "-" 21563 001371'03 104 00 0 00 000074 PBOUT 21564 001372'03 320 14 0 00 001373' erjmps .+1 ;[194] 21565 001373'03 201 01 0 00 000101 movei t1, .priou ;[194] 21566 001374'03 104 00 0 00 000224 NOUT% ;[194] 21567 001375'03 320 14 0 00 001376' erjmps .+1 ;[194] 21568 001376'03 endif. ;[194] 21569 21570 001376'03 561 01 0 00 000000* hrroi t1, crlflf ;[194] k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 16-1 K20DSP MAC 6-Jun-23 10:31 SHOW VERSION 21571 001377'03 104 00 0 00 000076 PSOUT% ;[194] 21572 001400'03 256 00 0 00 000005 xct q1 ;[39] return or proceed... 21573 remark ;[194] May fall through .. 21574 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 17 K20DSP MAC 6-Jun-23 10:31 SHOW DAYTIME 21575 subttl SHOW DAYTIME 21576 21577 001401'03 $shday: entry $shday ;[194] 21578 001401'03 120 01 0 00 004404' dmove t1, [ exp .priou, -1 ] ;[194] Current date and time. 21579 001402'03 205 03 0 00 336001 movx t3, ot%day!ot%fdy!ot%fmn!ot%4yr!ot%dam!ot%spa!ot%scl 21580 001403'03 104 00 0 00 000220 ODTIM% 21581 001404'03 320 12 0 00 001405' erjmpr .+1 ;[194] Catch and ignore error 21582 001405'03 260 17 0 00 003315' call moon ; Phase of the moon. 21583 21584 001406'03 561 01 0 00 001376* hrroi t1, crlflf ;[194] 21585 001407'03 104 00 0 00 000076 PSOUT% ;[194] 21586 001410'03 256 00 0 00 000005 xct q1 ;[39] return or proceed... 21587 remark ;[194] May fall through .. 21588 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 18 K20DSP MAC 6-Jun-23 10:31 SHOW LINE external variable usage (all [194]) 21589 subttl SHOW LINE external variable usage (all [194]) 21590 21591 extern rosnpt ; Remote operating system name pointer 21592 extern brk ; Number of NUL's to send to simulate a break 21593 extern carier ; On a modem line, set if have carrier 21594 extern duplex ; Line duplex setting 21595 extern escape ; Escape character 21596 extern flow ; Type of flow control, if any 21597 extern handsh ; Handshake character 21598 extern local ; Set if in local mode 21599 extern mdmlin ; Set if dial-up line 21600 extern mytty ; Current logged in line (if not detached) 21601 extern nbict ; Network BIN% count 21602 extern netjfn ; Network JFN (even if we're remote...) 21603 extern nodnam ; Remote DECnet node name 21604 extern nodnum ; Remote DECnet node number (if monitor supports this) 21605 extern nrtflg ; Set if a valid Network Remote Terminal 21606 extern ptyflg ; Set if doing pseudo-terminal I/O 21607 extern ptynam ; ASCII device name 21608 extern sesflg ; Set if session logging is active 21609 extern sesjfn ; Contains session logging jfn 21610 extern ttynum ; Number of terminal being used 21611 extern tvtchk ; Set if doing TVT discovery 21612 extern tvtflg ; Set if must negotiate binary mode on TVT 21613 extern vbict ; Virtual Terminal BIN% Count 21614 extern vchrcn ; Total characters flushed virtual terminal 21615 extern inpcbf ; INPUT network Characters Buffer Flushed 21616 extern vtermf ; Set if virtual line (I.E., PTY or NRT) 21617 21618 remark ;[223] Parity storage 21619 extern parity ; Type of parity in use 21620 extern none ;[223] No parity being enforced 21621 extern space ; Space parity routine (0, always) 21622 extern mark ; Mark parity routine (1, always) 21623 extern even ; Even parity routine 21624 extern odd ; Odd parity routine 21625 extern parpko ;[223] Non-zero if doing parity on packets, only 21626 extern parrck ;[223] Checking parity on recieve in addition to sending 21627 extern ttipar ;[223] Total parity errors for session 21628 extern genpar ;[223] Use string instructions to generate a new string 21629 extern strc ;[223] Count of characters in temporary buffer 21630 extern strptr ;[223] Appropriate pointer to same 21631 extern strbuf ;[223] Global address of string buffer 21632 remark strbf2 ;[223] Flows into this, too 21633 21634 remark ; DECnet information (is in k20net) 21635 extern mynode ; Number of local executor (us) 21636 extern myname ; Local executor name 21637 extern ndvfxp ; If monitor has extended node verify (T79) 21638 21639 remark Some support routines 21640 21641 extern chklin ; Checks a line's status, physical, network, Etc. 21642 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 19 K20DSP MAC 6-Jun-23 10:31 SHOW LINE display 21643 subttle SHOW LINE display 21644 21645 001411'03 $shlin: entry $shlin ;[194] Also used in command loop 21646 001411'03 336 00 0 00 001112* ifmn. nrtflg ;[186] DECnet NRT? 21647 001412'03 254 00 0 00 001502' 21648 001413'03 200 01 0 00 000000# txmsg ;[186] 21649 001414'03 104 00 0 00 000076 21650 001415'03 320 12 0 00 001416' 21651 000155'02 000000000000# 21652 000420'04 122 145 155 157 164 21653 001416'03 561 01 0 00 000000* hrroi t1, nodnam ;[186] Point to the node 21654 001417'03 104 00 0 00 000076 PSOUT% ;[186] Type it 21655 001420'03 200 01 0 00 000000# txmsg <::> ;[186] Trailing punctuation 21656 001421'03 104 00 0 00 000076 21657 001422'03 320 12 0 00 001423' 21658 000156'02 000000000000# 21659 000427'04 072 072 000 000 000 21660 21661 remark ;[186] If we don't have T79, see if we can fake it 21662 001423'03 332 00 0 00 000000* ifme. ndvfxp ;[186] Does the monitor NOT have extended node verify? 21663 001424'03 254 00 0 00 001441' 21664 001425'03 120 01 0 00 000000* dmove t1, myname ;[186] Load only node name we really know about 21665 001426'03 415 16 0 00 001436' block. ;[186] Enter block context for easier decisioning 21666 001427'03 261 17 0 00 000016 21667 001430'03 312 01 0 00 001416* came t1, nodnam ;[186] DECnet node name is maximum of six ASCII bytes 21668 001431'03 263 17 0 00 000000 ret ;[186] First 5 characters didn't match 21669 001432'03 312 02 0 00 000000# came t2, nodnam+1 ;[186] How about the last character? 21670 001433'03 263 17 0 00 000000 ret ;[186] Didn't match ... 21671 001434'03 254 00 0 00 001032* retskp ;[186] Connection is to local node! 21672 001435'03 263 17 0 00 000000 endbk. ;[186] Tear down block frame 21673 001436'03 254 00 0 00 001441' ifskp. ;[186] +2 means we knew the node inately 21674 001437'03 200 03 0 00 000000* move t3, mynode ;[186] Load number of local executor (that's us!) 21675 001440'03 202 03 0 00 000000* movem t3, nodnum ;[186] Stomp into connection data 21676 001441'03 endif. ;[186] End case attempted node recognition 21677 001441'03 endif. ;[186] End case monitor does not have T79 21678 21679 remark ;[186] N.B., requires monitor edit T79 21680 001441'03 337 04 0 00 001440* skipg t4, nodnum ;[186] Do we know the node number? 21681 001442'03 254 00 0 00 001464' ifskp. ;[186] We do, let's type it 21682 001443'03 200 01 0 00 000000# txmsg ( [) ;[186] Appropriately open broket it 21683 001444'03 104 00 0 00 000076 21684 001445'03 320 12 0 00 001446' 21685 000157'02 000000000000# 21686 000430'04 040 133 000 000 000 21687 001446'03 201 01 0 00 000101 movei t1, .priou ;[186] Still going to terminal 21688 001447'03 201 03 0 00 000012 movei t3, ^d10 ;[186] Node numbers are in octal 21689 001450'03 135 02 0 00 004406' ldb t2,[pointr t4,n%area] ;[186] Load DECnet Area Number 21690 001451'03 322 02 0 00 001457' ifn. t2 ;[186] If none, may be phase II ... 21691 001452'03 104 00 0 00 000224 NOUT% ;[186] Otherwise, type it 21692 001453'03 320 14 0 00 001454' erjmps .+1 ;[186] Catch and suppress error 21693 001454'03 201 02 0 00 000056 movei t2, "." ;[186] Punctuation suffix for areas 21694 001455'03 104 00 0 00 000051 BOUT% ;[186] Punctuate the node number 21695 001456'03 320 14 0 00 001457' erjmps .+1 ;[186] Catch and suppress error 21696 001457'03 endif. ;[186] End case non-zero area 21697 001457'03 135 02 0 00 004407' ldb t2,[pointr t4,n%node] ;[186] Load DECnet Node Number k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 19-1 K20DSP MAC 6-Jun-23 10:31 SHOW LINE display 21698 001460'03 104 00 0 00 000224 NOUT% ;[186] Type it 21699 001461'03 320 14 0 00 001462' erjmps .+1 ;[186] Catch and suppress error 21700 001462'03 201 02 0 00 000135 movei t2, "]" ;[186] Close broket 21701 001463'03 104 00 0 00 000051 BOUT% ;[186] Trailing punctuation on DECnet node number 21702 001464'03 endif. ;[186] End case known node number 21703 21704 001464'03 200 04 0 00 000000* move t4, rosnpt ;[186] Load remote operating system name pointer 21705 001465'03 316 04 0 00 004350' camn t4, [-1] ;[186] Not our special bogon talisman? 21706 001466'03 254 00 0 00 001476' ifskp. ;[186] No, it's a valid text pointer 21707 001467'03 200 01 0 00 000000# txmsg < (> ;[186] Put it in parenthesis 21708 001470'03 104 00 0 00 000076 21709 001471'03 320 12 0 00 001472' 21710 000160'02 000000000000# 21711 000431'04 040 050 000 000 000 21712 001472'03 200 01 0 00 000004 move t1, t4 ;[186] Load pointer to the remote os name 21713 001473'03 104 00 0 00 000076 PSOUT% ;[186] Type it 21714 001474'03 201 01 0 00 000051 movei t1, ")" ;[186] Closing parenthesis 21715 001475'03 104 00 0 00 000074 PBOUT% ;[186] Tie off the operating system name 21716 001476'03 endif. ;[186] End case known remote operating system 21717 21718 txmsg < 21719 001476'03 200 01 0 00 000000# (Network Remote Terminal, KERMIT-20 is LOCAL)> ;[186] Not using any local TTY 21720 001477'03 104 00 0 00 000076 21721 001500'03 320 12 0 00 001501' 21722 000161'02 000000000000# 21723 000432'04 015 012 040 050 116 21724 001501'03 254 00 0 00 001575' jrst $show3 ;[186] Skip the modem control 21725 001502'03 endif. ;[186] End case DECnet NRT 21726 21727 001502'03 200 01 0 00 000000# txmsg 21728 001503'03 104 00 0 00 000076 21729 001504'03 320 12 0 00 001505' 21730 000162'02 000000000000# 21731 000444'04 124 124 131 040 146 21732 001505'03 201 01 0 00 000101 numout ttynum, 8 21733 001506'03 200 02 0 00 000000* 21734 001507'03 201 03 0 00 000010 21735 001510'03 104 00 0 00 000224 21736 001511'03 320 14 0 00 001512' 21737 001512'03 312 02 0 00 000000# came t2, ctynum ;[223] Is this the console? 21738 001513'03 254 00 0 00 001517' ifskp. ;[223] Yes, remark about that 21739 001514'03 200 01 0 00 000000# txmsg < [Console]> ;[223] A discrete indicator 21740 001515'03 104 00 0 00 000076 21741 001516'03 320 12 0 00 001517' 21742 000163'02 000000000000# 21743 000451'04 040 133 103 157 156 21744 001517'03 endif. ;[223] 21745 21746 001517'03 332 00 0 00 001110* ifme. ptyflg ;[186] Physical line? 21747 001520'03 254 00 0 00 001534' 21748 001521'03 200 04 0 00 000000* move t4, mytty ; See whether we're local or remote... 21749 001522'03 312 04 0 00 001506* came t4, ttynum ; If it's us 21750 001523'03 254 00 0 00 001530' ifskp. ; Then we are the remote 21751 txmsg < 21752 001524'03 200 01 0 00 000000# (job's controlling terminal, KERMIT-20 is REMOTE)> k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 19-2 K20DSP MAC 6-Jun-23 10:31 SHOW LINE display 21753 001525'03 104 00 0 00 000076 21754 001526'03 320 12 0 00 001527' 21755 000164'02 000000000000# 21756 000454'04 015 012 040 050 152 21757 001527'03 254 00 0 00 001533' else. ; Anything else means we're local 21758 txmsg < 21759 001530'03 200 01 0 00 000000# (assigned TTY line, KERMIT-20 is LOCAL)> 21760 001531'03 104 00 0 00 000076 21761 001532'03 320 12 0 00 001533' 21762 000165'02 000000000000# 21763 000467'04 015 012 040 050 141 21764 001533'03 endif. 21765 001533'03 254 00 0 00 001554' else. ;[186] Otherwise, it's a pseudo terminal 21766 001534'03 200 01 0 00 000000# txmsg (< [>) ;[186] Type opening broket 21767 001535'03 104 00 0 00 000076 21768 001536'03 320 12 0 00 001537' 21769 000166'02 000000000000# 21770 000500'04 040 133 000 000 000 21771 001537'03 561 01 0 00 000000* hrroi t1, ptynam ;[186] Load the name of the pseudo-terminal 21772 001540'03 104 00 0 00 000076 PSOUT% ;[186] Type the punctuated device 21773 001541'03 201 01 0 00 000135 movei t1, "]" ;[186] Load closing broket 21774 001542'03 104 00 0 00 000074 PBOUT% ;[186] and type that 21775 txmsg < 21776 001543'03 200 01 0 00 000000# (pseudo-terminal loopback to > ;[186] 21777 001544'03 104 00 0 00 000076 21778 001545'03 320 12 0 00 001546' 21779 000167'02 000000000000# 21780 000501'04 015 012 040 050 160 21781 001546'03 561 01 0 00 001425* hrroi t1, myname ;[186] Name of local node 21782 001547'03 104 00 0 00 000076 PSOUT% ;[186] Type that 21783 001550'03 200 01 0 00 000000# txmsg <::, KERMIT-20 is LOCAL)> ;[186] 21784 001551'03 104 00 0 00 000076 21785 001552'03 320 12 0 00 001553' 21786 000170'02 000000000000# 21787 000510'04 072 072 054 040 113 21788 001553'03 254 00 0 00 001575' jrst $show3 ;[186] PTY never has modem control 21789 001554'03 endif. ;[186] End case terminal check 21790 21791 001554'03 337 01 0 00 000000* skipg t1, netjfn ;[186] Tell about modem control & carrier. 21792 001555'03 200 01 0 00 000402* move t1, ttyjfn ;[186] Unless using local terminal 21793 001556'03 260 17 0 00 000000* call chklin 21794 001557'03 336 00 0 00 000000* ifmn. mdmlin ;[194] 21795 001560'03 254 00 0 00 001575' 21796 txmsg < 21797 Line has modem control 21798 001561'03 200 01 0 00 000000# Carrier: > 21799 001562'03 104 00 0 00 000076 21800 001563'03 320 12 0 00 001564' 21801 000171'02 000000000000# 21802 000515'04 015 012 040 040 114 21803 21804 001564'03 336 00 0 00 000000* ifmn. carier ; Is it? 21805 001565'03 254 00 0 00 001572' 21806 001566'03 200 01 0 00 000000# txmsg ; Say it's on. 21807 001567'03 104 00 0 00 000076 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 19-3 K20DSP MAC 6-Jun-23 10:31 SHOW LINE display 21808 001570'03 320 12 0 00 001571' 21809 000172'02 000000000000# 21810 000526'04 117 156 000 000 000 21811 001571'03 254 00 0 00 001575' else. ; Otherwise... 21812 001572'03 200 01 0 00 000000# txmsg ; No. 21813 001573'03 104 00 0 00 000076 21814 001574'03 320 12 0 00 001575' 21815 000173'02 000000000000# 21816 000527'04 117 146 146 000 000 21817 001575'03 endif. 21818 001575'03 endif. ;[194] 21819 21820 $show3: txmsg < 21821 001575'03 200 01 0 00 000000# Handshake: > ;[76] Handshake 21822 001576'03 104 00 0 00 000076 21823 001577'03 320 12 0 00 001600' 21824 000174'02 000000000000# 21825 000530'04 015 012 040 040 110 21826 001600'03 332 01 0 00 000000* skipe t1, handsh ;[194] Any? 21827 001601'03 254 00 0 00 001606' ifskp. ;[194] Blew up the front end, anyway 21828 001602'03 200 01 0 00 000000# txmsg 21829 001603'03 104 00 0 00 000076 21830 001604'03 320 12 0 00 001605' 21831 000175'02 000000000000# 21832 000534'04 116 157 156 145 000 21833 001605'03 254 00 0 00 001607' else. ;[194] Otherwise, type it 21834 001606'03 260 17 0 00 003646' call putc 21835 001607'03 endif. ;[194] 21836 21837 txmsg < 21838 001607'03 200 01 0 00 000000# Flow-Control: > ;[143] 21839 001610'03 104 00 0 00 000076 21840 001611'03 320 12 0 00 001612' 21841 000176'02 000000000000# 21842 000535'04 015 012 040 040 106 21843 001612'03 336 00 0 00 000000* ifmn. flow 21844 001613'03 254 00 0 00 001620' 21845 001614'03 200 01 0 00 000000# txmsg 21846 001615'03 104 00 0 00 000076 21847 001616'03 320 12 0 00 001617' 21848 000177'02 000000000000# 21849 000542'04 130 117 116 055 130 21850 001617'03 254 00 0 00 001623' else. 21851 001620'03 200 01 0 00 000000# txmsg 21852 001621'03 104 00 0 00 000076 21853 001622'03 320 12 0 00 001623' 21854 000200'02 000000000000# 21855 000544'04 116 157 156 145 000 21856 001623'03 endif. 21857 21858 001623'03 336 00 0 00 000000* ifmn. local ;[194] Don't confuse them with this 21859 001624'03 254 00 0 00 001632' 21860 txmsg < 21861 001625'03 200 01 0 00 000000# Escape Character: > ;[217] Present the escape character 21862 001626'03 104 00 0 00 000076 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 19-4 K20DSP MAC 6-Jun-23 10:31 SHOW LINE display 21863 001627'03 320 12 0 00 001630' 21864 000201'02 000000000000# 21865 000545'04 015 012 040 040 105 21866 001630'03 200 01 0 00 000000* move t1, escape 21867 001631'03 260 17 0 00 003646' call putc 21868 001632'03 endif. ;[194] 21869 21870 21871 $show4: txmsg < 21872 001632'03 200 01 0 00 000000# Parity: > 21873 001633'03 104 00 0 00 000076 21874 001634'03 320 12 0 00 001635' 21875 000202'02 000000000000# 21876 000552'04 015 012 040 040 120 21877 001635'03 200 02 0 00 000262* move t2, parity 21878 001636'03 415 01 0 00 000000# xmovei t1, enone ; None 21879 001637'03 306 02 0 00 000000* cain t2, space ; Space 21880 001640'03 415 01 0 00 000000# xmovei t1, espac 21881 001641'03 306 02 0 00 000000* cain t2, mark ; Mark 21882 001642'03 415 01 0 00 000000# xmovei t1, emark 21883 001643'03 306 02 0 00 000000* cain t2, odd ; Odd 21884 001644'03 415 01 0 00 000000# xmovei t1, eodd 21885 001645'03 306 02 0 00 000000* cain t2, even ; Even 21886 001646'03 415 01 0 00 000000# xmovei t1, eeven 21887 001647'03 661 01 0 00 610001 txo t1, .px7 ; Turn into a OWGP 21888 001650'03 104 00 0 00 000076 PSOUT% ; Finally type something 21889 21890 001651'03 306 02 0 00 000263* cain t2, none ;[223] Doing any parity at all? 21891 001652'03 254 00 0 00 001714' jrst $sho4a ;[223] No, skip domains 21892 001653'03 120 02 0 00 000270* dmove t2, parpko ;[223] Load parity domains 21893 001654'03 200 04 0 00 000002 move t4, t2 ;[223] See if doing either 21894 001655'03 434 04 0 00 000003 or t4, t3 ;[223] by seeing if either were set 21895 001656'03 322 04 0 00 001714' jumpe t4, $sho4a ;[223] If zero, no domain modification 21896 21897 001657'03 200 04 0 00 000002 move t4, t2 ;[223] See if doing both 21898 001660'03 404 04 0 00 000003 and t4, t3 ;[223] by seeing if both set 21899 001661'03 201 01 0 00 000040 movei t1, .chspc ;[223] Space over 21900 001662'03 104 00 0 00 000074 PBOUT% ;[223] 21901 001663'03 201 01 0 00 000133 movei t1, "[" ;[223] Open broket 21902 001664'03 104 00 0 00 000074 PBOUT% ;[223] 21903 001665'03 322 02 0 00 001671' ifn. t2 ;[223] Packets Only? 21904 001666'03 200 01 0 00 000000# txmsg () ;[223] 21905 001667'03 104 00 0 00 000076 21906 001670'03 320 12 0 00 001671' 21907 000203'02 000000000000# 21908 000556'04 120 141 143 153 145 21909 001671'03 endif. ;[223] 21910 001671'03 322 04 0 00 001674' ifn. t4 ;[223] Plural? 21911 001672'03 201 01 0 00 000054 movei t1, "," ;[223] Yes, wants a comma, then 21912 001673'03 104 00 0 00 000074 PBOUT% ;[223] 21913 001674'03 endif. ;[223] 21914 001674'03 322 03 0 00 001700' ifn. t3 ;[223] Not just generating parity? 21915 001675'03 200 01 0 00 000000# txmsg () ;[223] 21916 001676'03 104 00 0 00 000076 21917 001677'03 320 12 0 00 001700' k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 19-5 K20DSP MAC 6-Jun-23 10:31 SHOW LINE display 21918 000204'02 000000000000# 21919 000561'04 122 145 143 145 151 21920 001700'03 endif. ;[223] 21921 001700'03 201 01 0 00 000135 movei t1, "]" ;[223] Close broket 21922 001701'03 104 00 0 00 000074 PBOUT% ;[223] 21923 001702'03 336 04 0 00 000000* skipn t4, ttipar ;[223] Any parity errors?? 21924 001703'03 254 00 0 00 001714' ifskp. ;[223] Yes, type these 21925 txmsg < 21926 001704'03 200 01 0 00 000000# Parity Errors: > ;[223] 21927 001705'03 104 00 0 00 000076 21928 001706'03 320 12 0 00 001707' 21929 000205'02 000000000000# 21930 000565'04 015 012 040 040 120 21931 001707'03 201 01 0 00 000101 numout t4 ;[223] Type how many 21932 001710'03 200 02 0 00 000004 21933 001711'03 201 03 0 00 000012 21934 001712'03 104 00 0 00 000224 21935 001713'03 320 14 0 00 001714' 21936 001714'03 endif. ;[223] Done or nothing to do 21937 21938 $sho4a: txmsg < 21939 001714'03 200 01 0 00 000000# Duplex: > ;[18] 21940 001715'03 104 00 0 00 000076 21941 001716'03 320 12 0 00 001717' 21942 000206'02 000000000000# 21943 000572'04 015 012 040 040 104 21944 001717'03 200 02 0 00 000000* move t2, duplex 21945 001720'03 302 02 0 00 000000 caie t2, dxfull 21946 001721'03 254 00 0 00 001726' ifskp. 21947 001722'03 200 01 0 00 000000# txmsg 21948 001723'03 104 00 0 00 000076 21949 001724'03 320 12 0 00 001725' 21950 000207'02 000000000000# 21951 000576'04 106 165 154 154 000 21952 001725'03 254 00 0 00 001731' else. 21953 001726'03 200 01 0 00 000000# txmsg 21954 001727'03 104 00 0 00 000076 21955 001730'03 320 12 0 00 001731' 21956 000210'02 000000000000# 21957 000577'04 110 141 154 146 000 21958 001731'03 endif. 21959 21960 001731'03 337 02 0 00 001064* skipg t2,speed ; If negative, we don't really know it. 21961 001732'03 254 00 0 00 001742' ifskp. ;[194] We know it 21962 txmsg < 21963 001733'03 200 01 0 00 000000# Speed: > ; Line speed. 21964 001734'03 104 00 0 00 000076 21965 001735'03 320 12 0 00 001736' 21966 000211'02 000000000000# 21967 000600'04 015 012 040 040 123 21968 001736'03 201 01 0 00 000101 movei t1, .priou 21969 001737'03 201 03 0 00 000012 movei t3, ^d10 21970 001740'03 104 00 0 00 000224 NOUT% 21971 001741'03 320 14 0 00 001742' erjmps .+1 21972 001742'03 endif. ;[194] k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 19-6 K20DSP MAC 6-Jun-23 10:31 SHOW LINE display 21973 21974 txmsg < 21975 001742'03 200 01 0 00 000000# Break Simulation: > 21976 001743'03 104 00 0 00 000076 21977 001744'03 320 12 0 00 001745' 21978 000212'02 000000000000# 21979 000604'04 015 012 040 040 102 21980 001745'03 337 00 0 00 001731* ifmg. speed 21981 001746'03 254 00 0 00 001763' 21982 001747'03 200 01 0 00 000000# txmsg 21983 001750'03 104 00 0 00 000076 21984 001751'03 320 12 0 00 001752' 21985 000213'02 000000000000# 21986 000611'04 105 156 141 142 154 21987 001752'03 201 01 0 00 000101 numout brk 21988 001753'03 200 02 0 00 000000* 21989 001754'03 201 03 0 00 000012 21990 001755'03 104 00 0 00 000224 21991 001756'03 320 14 0 00 001757' 21992 001757'03 200 01 0 00 000000# txmsg < NULs at 50 baud> 21993 001760'03 104 00 0 00 000076 21994 001761'03 320 12 0 00 001762' 21995 000214'02 000000000000# 21996 000613'04 040 116 125 114 163 21997 001762'03 254 00 0 00 001766' else. 21998 001763'03 200 01 0 00 000000# txmsg 21999 001764'03 104 00 0 00 000076 22000 001765'03 320 12 0 00 001766' 22001 000215'02 000000000000# 22002 000617'04 104 151 163 141 142 22003 001766'03 endif. 22004 22005 001766'03 336 00 0 00 000000* skipn vtermf ;[186] Virtual terminal? 22006 001767'03 254 00 0 00 002022' jrst $sho4e ;[186] No, then this makes no sense 22007 22008 001770'03 332 00 0 00 001517* ifme. ptyflg ;[186] Unless loopback 22009 001771'03 254 00 0 00 001776' 22010 txmsg < 22011 001772'03 200 01 0 00 000000# NRT Connection: > ;[186] Status of connection 22012 001773'03 104 00 0 00 000076 22013 001774'03 320 12 0 00 001775' 22014 000216'02 000000000000# 22015 000621'04 015 012 040 040 116 22016 001775'03 254 00 0 00 002001' else. 22017 txmsg < 22018 001776'03 200 01 0 00 000000# PTY Connection: > ;[186] Status of connection 22019 001777'03 104 00 0 00 000076 22020 002000'03 320 12 0 00 002001' 22021 000217'02 000000000000# 22022 000626'04 015 012 040 040 120 22023 002001'03 endif. ;[186] 22024 22025 002001'03 337 01 0 00 001554* skipg t1,netjfn ;[186] Load line to check 22026 002002'03 200 01 0 00 001555* move t1, ttyjfn ;[186] Unless using local terminal 22027 002003'03 260 17 0 00 001556* call chklin ;[186] Check 'line' status k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 19-7 K20DSP MAC 6-Jun-23 10:31 SHOW LINE display 22028 002004'03 336 00 0 00 001564* ifmn. carier ;[186] However, is it? 22029 002005'03 254 00 0 00 002012' 22030 002006'03 200 01 0 00 000000# txmsg ;[186] Assume good news 22031 002007'03 104 00 0 00 000076 22032 002010'03 320 12 0 00 002011' 22033 000220'02 000000000000# 22034 000633'04 117 156 154 151 156 22035 002011'03 254 00 0 00 002015' else. 22036 002012'03 200 01 0 00 000000# txmsg ;[186] It isn't, sigh... 22037 002013'03 104 00 0 00 000076 22038 002014'03 320 12 0 00 002015' 22039 000221'02 000000000000# 22040 000635'04 104 162 157 160 160 22041 002015'03 endif. ;[186] Either way, tell us 22042 22043 002015'03 260 17 0 00 001052' call prntbd ;[210] Print some kind of baud rate maybe 22044 22045 002016'03 200 01 0 00 000000* move t1, vbict ;[186] Ever connected? 22046 002017'03 270 01 0 00 000000* add t1, nbict ;[186] any network output 22047 002020'03 322 01 0 00 002022' ifn. t1 ;[186] Yes to either one means display something 22048 002021'03 260 17 0 00 003424' call disper ;[186] Display information concerning performance 22049 002022'03 endif. 22050 22051 remark $sho4e ;[186] Falls through 22052 22053 002022'03 337 04 0 00 000412* $sho4e: skipg t4, sesjfn ;[195] Are we logging? 22054 002023'03 254 00 0 00 002070' ifskp. ;[195] Well, are we? 22055 002024'03 336 00 0 00 000414* ifmn. sesflg ;[195] BUT!! Are we actively logging right now? 22056 002025'03 254 00 0 00 002032' 22057 txmsg < 22058 002026'03 200 01 0 00 000000# Log: (Enabled) > ;[220] 22059 002027'03 104 00 0 00 000076 22060 002030'03 320 12 0 00 002031' 22061 000222'02 000000000000# 22062 000637'04 015 012 040 040 114 22063 002031'03 254 00 0 00 002035' else. ;[220] Otherwise, not ACTIVELY logging 22064 txmsg < 22065 002032'03 200 01 0 00 000000# Log: (Disabled) > ;[220] 22066 002033'03 104 00 0 00 000076 22067 002034'03 320 12 0 00 002035' 22068 000223'02 000000000000# 22069 000644'04 015 012 040 040 114 22070 002035'03 endif. ;[220] 22071 002035'03 200 02 0 00 000004 move t2, t4 ;[220] Reload the logging JFN 22072 002036'03 201 01 0 00 000101 movei t1, .priou ;[220] Typing on the terminal? 22073 002037'03 302 02 0 00 377777 caie t2, .nulio ;[193] Efficiently dumping it? 22074 002040'03 254 00 0 00 002051' ifskp. ;[193] Yes, that's a constant string 22075 002041'03 120 02 0 00 000000# dmove t2, nul5 ;[193] Point to said string 22076 002042'03 104 00 0 00 000053 SOUT% ;[193] Counted SOUT% is faster 22077 002043'03 320 12 0 00 002045' %jserr (,) ;[193] ?? 22078 002044'03 254 00 0 00 002050' 22079 002045'03 265 01 0 00 000442* 22080 002046'03 000000000000# 22081 002047'03 254 00 0 00 002050' 22082 000651'04 125 156 141 142 154 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 19-8 K20DSP MAC 6-Jun-23 10:31 SHOW LINE display 22083 002050'03 254 00 0 00 002070' else. ;[193] Otherwise, a 'real' JFN 22084 002051'03 201 02 0 00 000040 movx t2, .chspc ;[193] Space over 22085 002052'03 104 00 0 00 000051 BOUT% ;[193] So columns line up 22086 002053'03 320 12 0 00 002055' %jserr (,) ;[194] ??? 22087 002054'03 254 00 0 00 002060' 22088 002055'03 265 01 0 00 002045* 22089 002056'03 000000000000# 22090 002057'03 254 00 0 00 002060' 22091 000657'04 125 156 141 142 154 22092 002060'03 200 02 0 00 000004 move t2, t4 ;[193] Restore the logging JFN 22093 002061'03 403 03 0 00 000004 setzb t3, t4 ;[193] Use default formatting, no prefix 22094 002062'03 104 00 0 00 000030 JFNS ; Say what it is. 22095 002063'03 320 12 0 00 002065' %jserr (,) ;[194] 22096 002064'03 254 00 0 00 002070' 22097 002065'03 265 01 0 00 002055* 22098 002066'03 000000000000# 22099 002067'03 254 00 0 00 002070' 22100 000666'04 125 156 141 142 154 22101 002070'03 endif. ;[193] End .nulio special casing 22102 002070'03 endif. ;[194] End case session logging JFN open 22103 22104 002070'03 332 00 0 00 001411* $sho4f: ifme. nrtflg ;[223] Not if NRT; line number is meaningless 22105 002071'03 254 00 0 00 002077' 22106 002072'03 200 01 0 00 001522* move t1, ttynum ;[223] Load line number (FE or TTY# of PTY, if PTY) 22107 002073'03 260 17 0 00 000000* call getnti ;[223] Get network information on this line 22108 002074'03 254 00 0 00 002077' anskp. ;[223] Failed, so better skip the line characteristics 22109 remark t1, ;[223] Network Type from NTINF% 22110 remark t2, ;[223] Line Type from NTINF% 22111 002075'03 200 03 0 00 002072* move t3, ttynum ;[223] Load line number 22112 002076'03 260 17 0 00 003673' call linchr ;[186] Show some things 22113 002077'03 endif. ;[223] 22114 22115 002077'03 $sho4h: remark ;put next one here... 22116 22117 002077'03 561 01 0 00 001406* $sho4x: hrroi t1, crlflf ;[194] Double line feed 22118 002100'03 104 00 0 00 000076 PSOUT% ;[194] Tie off the blat 22119 002101'03 256 00 0 00 000005 xct q1 ;[39] return or proceed... 22120 remark ;[194] May fall through .. 22121 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 20 K20DSP MAC 6-Jun-23 10:31 SHOW FILE-INFO external variables 22122 subttl SHOW FILE-INFO external variables 22123 22124 extern abtfil ; Set if keeping a file, zero to discard 22125 extern autbyt ; Set if doing auto-bytesize detection 22126 extern ebtflg ; Set if forcing 8-bit mode 22127 extern tbtflg ;[223] ; Set if forcing 36-bit mode 22128 extern expung ; Set if deletes are expunging 22129 extern itsflg ; Flag for handling ITS-binary format files 22130 extern tlgjfn ; Transaction log JFN 22131 extern xfnflg ; Flag for filename conversion 22132 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 21 K20DSP MAC 6-Jun-23 10:31 SHOW FILE-INFO display logic 22133 subttl SHOW FILE-INFO display logic 22134 22135 002102'03 $shfil: entry $shfil 22136 22137 002102'03 200 01 0 00 000000# txmsg 22138 002103'03 104 00 0 00 000076 22139 002104'03 320 12 0 00 002105' 22140 000224'02 000000000000# 22141 000675'04 102 171 164 145 040 22142 002105'03 332 00 0 00 000000* ifme. autbyt ;[194] Not auto-byte 22143 002106'03 254 00 0 00 002127' 22144 002107'03 332 00 0 00 000000* ifme. tbtflg ;[232] Not 36 bit 22145 002110'03 254 00 0 00 002123' 22146 002111'03 332 00 0 00 000000* ifme. ebtflg 22147 002112'03 254 00 0 00 002117' 22148 002113'03 200 01 0 00 000000# txmsg 22149 002114'03 104 00 0 00 000076 22150 002115'03 320 12 0 00 002116' 22151 000225'02 000000000000# 22152 000702'04 123 145 166 145 156 22153 002116'03 254 00 0 00 002122' else. 22154 002117'03 200 01 0 00 000000# txmsg 22155 002120'03 104 00 0 00 000076 22156 002121'03 320 12 0 00 002122' 22157 000226'02 000000000000# 22158 000704'04 105 151 147 150 164 22159 002122'03 endif. 22160 002122'03 254 00 0 00 002126' else. ;[232] Really post-processed 7 bit mode 22161 002123'03 200 01 0 00 000000# txmsg 22162 002124'03 104 00 0 00 000076 22163 002125'03 320 12 0 00 002126' 22164 000227'02 000000000000# 22165 000706'04 124 150 151 162 164 22166 002126'03 endif. ;[232] 22167 002126'03 254 00 0 00 002132' else. 22168 002127'03 200 01 0 00 000000# txmsg 22169 002130'03 104 00 0 00 000076 22170 002131'03 320 12 0 00 002132' 22171 000230'02 000000000000# 22172 000713'04 101 165 164 157 000 22173 002132'03 endif. ;[194] 22174 txmsg < 22175 002132'03 200 01 0 00 000000# File name conversion: > ;[84] 22176 002133'03 104 00 0 00 000076 22177 002134'03 320 12 0 00 002135' 22178 000231'02 000000000000# 22179 000714'04 015 012 040 040 106 22180 002135'03 332 00 0 00 000000* ifme. xfnflg ;[84] 22181 002136'03 254 00 0 00 002143' 22182 002137'03 200 01 0 00 000000# txmsg ;[84] 22183 002140'03 104 00 0 00 000076 22184 002141'03 320 12 0 00 002142' 22185 000232'02 000000000000# 22186 000722'04 117 146 146 000 000 22187 002142'03 254 00 0 00 002146' else. ;[84] k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 21-1 K20DSP MAC 6-Jun-23 10:31 SHOW FILE-INFO display logic 22188 002143'03 200 01 0 00 000000# txmsg ;[84] 22189 002144'03 104 00 0 00 000076 22190 002145'03 320 12 0 00 002146' 22191 000233'02 000000000000# 22192 000723'04 117 156 000 000 000 22193 002146'03 endif. ;[84] 22194 txmsg < 22195 002146'03 200 01 0 00 000000# ITS-binary-format file recognition: > ;[75] 22196 002147'03 104 00 0 00 000076 22197 002150'03 320 12 0 00 002151' 22198 000234'02 000000000000# 22199 000724'04 015 012 040 040 111 22200 002151'03 336 00 0 00 000000* ifmn. itsflg ;[75] 22201 002152'03 254 00 0 00 002157' 22202 002153'03 200 01 0 00 000000# txmsg ;[75] 22203 002154'03 104 00 0 00 000076 22204 002155'03 320 12 0 00 002156' 22205 000235'02 000000000000# 22206 000735'04 145 156 141 142 154 22207 002156'03 254 00 0 00 002162' else. ;[75] 22208 002157'03 200 01 0 00 000000# txmsg ;[75] 22209 002160'03 104 00 0 00 000076 22210 002161'03 320 12 0 00 002162' 22211 000236'02 000000000000# 22212 000737'04 144 151 163 141 142 22213 002162'03 endif. ;[75] 22214 txmsg < 22215 002162'03 200 01 0 00 000000# Disposition for incomplete incoming files: > ;[42] 22216 002163'03 104 00 0 00 000076 22217 002164'03 320 12 0 00 002165' 22218 000237'02 000000000000# 22219 000741'04 015 012 040 040 104 22220 002165'03 332 00 0 00 000000* ifme. abtfil ;[42] 22221 002166'03 254 00 0 00 002173' 22222 002167'03 200 01 0 00 000000# txmsg ;[42] 22223 002170'03 104 00 0 00 000076 22224 002171'03 320 12 0 00 002172' 22225 000240'02 000000000000# 22226 000753'04 104 151 163 143 141 22227 002172'03 254 00 0 00 002176' else. ;[42] 22228 002173'03 200 01 0 00 000000# txmsg ;[42] 22229 002174'03 104 00 0 00 000076 22230 002175'03 320 12 0 00 002176' 22231 000241'02 000000000000# 22232 000755'04 113 145 145 160 040 22233 002176'03 endif. ;[42] 22234 txmsg < 22235 002176'03 200 01 0 00 000000# Deleted files are > ;[143] 22236 002177'03 104 00 0 00 000076 22237 002200'03 320 12 0 00 002201' 22238 000242'02 000000000000# 22239 000763'04 015 012 040 040 104 22240 002201'03 332 00 0 00 000000* ifme. expung ;[194] 22241 002202'03 254 00 0 00 002206' 22242 002203'03 200 01 0 00 000000# txmsg ;[194] k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 21-2 K20DSP MAC 6-Jun-23 10:31 SHOW FILE-INFO display logic 22243 002204'03 104 00 0 00 000076 22244 002205'03 320 12 0 00 002206' 22245 000243'02 000000000000# 22246 000770'04 116 117 124 040 000 22247 002206'03 endif. ;[194] 22248 txmsg ;[126] 22250 002207'03 104 00 0 00 000076 22251 002210'03 320 12 0 00 002211' 22252 000244'02 000000000000# 22253 000771'04 145 170 160 165 156 22254 22255 22256 002211'03 337 02 0 00 000000* skipg t2, tlgjfn ; Any transaction log? 22257 002212'03 254 00 0 00 002237' ifskp. ;[194] Yes 22258 002213'03 201 01 0 00 000101 movei t1, .priou ; Yes, a real file, 22259 002214'03 400 04 0 00 000000 setz t4, ;[193] Let's assume no prefix or stop character 22260 002215'03 302 02 0 00 377777 caie t2, .nulio ;[193] Efficiently dumping it? 22261 002216'03 254 00 0 00 002227' ifskp. ;[193] Yes, that's a constant string 22262 002217'03 120 02 0 00 000000# dmove t2, nul5 ;[193] Point to said string 22263 002220'03 104 00 0 00 000053 SOUT% ;[193] Counted SOUT% is faster 22264 002221'03 320 12 0 00 002223' %jserr (,) ;[193] ?? 22265 002222'03 254 00 0 00 002226' 22266 002223'03 265 01 0 00 002065* 22267 002224'03 000000000000# 22268 002225'03 254 00 0 00 002226' 22269 001003'04 125 156 141 142 154 22270 002226'03 254 00 0 00 002236' else. ;[193] Otherwise, a 'real' JFN 22271 002227'03 400 03 0 00 000000 setz t3, ;[194] Use default formatting 22272 002230'03 104 00 0 00 000030 JFNS ; Say what it is. 22273 002231'03 320 12 0 00 002233' %jserr (,) ;[194] 22274 002232'03 254 00 0 00 002236' 22275 002233'03 265 01 0 00 002223* 22276 002234'03 000000000000# 22277 002235'03 254 00 0 00 002236' 22278 001011'04 125 156 141 142 154 22279 002236'03 endif. ;[193] End .nulio special casing 22280 002236'03 254 00 0 00 002242' else. ;[194] Otherwise, don't have one 22281 002237'03 200 01 0 00 000000# txmsg <(none)> 22282 002240'03 104 00 0 00 000076 22283 002241'03 320 12 0 00 002242' 22284 000245'02 000000000000# 22285 001021'04 050 156 157 156 145 22286 002242'03 endif. ;[194] 22287 22288 002242'03 561 01 0 00 002077* hrroi t1, crlflf ;[194] 22289 002243'03 104 00 0 00 000076 PSOUT% ;[194] 22290 002244'03 256 00 0 00 000005 xct q1 ;[39] return or proceed... 22291 remark ;[194] May fall through .. 22292 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 22 K20DSP MAC 6-Jun-23 10:31 SHOW DEBUG 22293 subttl SHOW DEBUG 22294 22295 extern logbsz ;[41] Log file byte size. 22296 extern logjfn ; Log file JFN 22297 extern pdcodf ;[221] If Packet Debug is also doing decoding 22298 22299 002245'03 $shdeb: entry $shdeb 22300 002245'03 200 01 0 00 000000# txmsg 22301 002246'03 104 00 0 00 000076 22302 002247'03 320 12 0 00 002250' 22303 000246'02 000000000000# 22304 001023'04 104 145 142 165 147 22305 002250'03 200 01 0 14 000000# move t1, debtab(debug) 22306 002251'03 104 00 0 00 000076 PSOUT% 22307 22308 002252'03 302 14 0 00 000002 caie debug, 2 ;[221] Are we debugging packets (I.E., dumping them?)? 22309 002253'03 254 00 0 00 002261' ifskp. ;[221] Indeed we are 22310 002254'03 336 00 0 00 000000* skipn pdcodf ;[221] Yes, but are we decodeing them? 22311 002255'03 254 00 0 00 002261' anskp. ;[221] Nope, so remain silent 22312 002256'03 200 01 0 00 000000# txmsg < [Decoding]> ;[221] Some extra soothing blat 22313 002257'03 104 00 0 00 000076 22314 002260'03 320 12 0 00 002261' 22315 000247'02 000000000000# 22316 001026'04 040 133 104 145 143 22317 002261'03 endif. ;[221] End special case debugging packets 22318 22319 002261'03 322 14 0 00 002326' ifn. debug ;[194] Only if actually debugging something 22320 txmsg < 22321 002262'03 200 01 0 00 000000# Debugging log file: > ;[38] 22322 002263'03 104 00 0 00 000076 22323 002264'03 320 12 0 00 002265' 22324 000250'02 000000000000# 22325 001031'04 015 012 040 040 104 22326 002265'03 337 02 0 00 000000* skipg t2, logjfn ;[198] Load debugging log file JFN (if there is one) 22327 002266'03 254 00 0 00 002323' ifskp. ;[194] There is, let's type something 22328 002267'03 201 01 0 00 000101 movei t1, .priou ; Yes, a real file, 22329 002270'03 400 04 0 00 000000 setz t4, ;[193] Let's assume no prefix or stop character 22330 002271'03 302 02 0 00 377777 caie t2, .nulio ;[193] Efficiently dumping it? 22331 002272'03 254 00 0 00 002303' ifskp. ;[193] Yes, that's a constant string 22332 002273'03 120 02 0 00 000000# dmove t2, nul5 ;[193] Point to said string 22333 002274'03 104 00 0 00 000053 SOUT% ;[193] Counted SOUT% is faster 22334 002275'03 320 12 0 00 002277' %jserr (,) ;[193] ?? 22335 002276'03 254 00 0 00 002302' 22336 002277'03 265 01 0 00 002233* 22337 002300'03 000000000000# 22338 002301'03 254 00 0 00 002302' 22339 001036'04 125 156 141 142 154 22340 002302'03 254 00 0 00 002312' else. ;[193] Otherwise, a 'real' JFN 22341 002303'03 400 03 0 00 000000 setz t3, ;[194] Use default formatting 22342 002304'03 104 00 0 00 000030 JFNS ; Say what it is. 22343 002305'03 320 12 0 00 002307' %jserr (,) ;[194] 22344 002306'03 254 00 0 00 002312' 22345 002307'03 265 01 0 00 002277* 22346 002310'03 000000000000# 22347 002311'03 254 00 0 00 002312' k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 22-1 K20DSP MAC 6-Jun-23 10:31 SHOW DEBUG 22348 001044'04 125 156 141 142 154 22349 002312'03 endif. ;[198] End .nulio special casing 22350 002312'03 200 01 0 00 000000# txmsg <, bytesize > ;[41] 22351 002313'03 104 00 0 00 000076 22352 002314'03 320 12 0 00 002315' 22353 000251'02 000000000000# 22354 001053'04 054 040 142 171 164 22355 002315'03 201 01 0 00 000101 numout logbsz ;[41] 22356 002316'03 200 02 0 00 000000* 22357 002317'03 201 03 0 00 000012 22358 002320'03 104 00 0 00 000224 22359 002321'03 320 14 0 00 002322' 22360 002322'03 254 00 0 00 002326' else. ;[194] Otherwise, don't have a debugging log file 22361 002323'03 200 01 0 00 000000# txmsg < (none)> ;[38] None. 22362 002324'03 104 00 0 00 000076 22363 002325'03 320 12 0 00 002326' 22364 000252'02 000000000000# 22365 001056'04 040 050 156 157 156 22366 002326'03 endif. ;[194] End log file printing decision 22367 002326'03 endif. ;[194] End case debugging 22368 22369 002326'03 561 01 0 00 002242* hrroi t1, crlflf ;[194] 22370 002327'03 104 00 0 00 000076 PSOUT% ;[194] 22371 002330'03 256 00 0 00 000005 xct q1 ;[39] return or proceed... 22372 remark ;[194] May fall through .. 22373 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 23 K20DSP MAC 6-Jun-23 10:31 SHOW PACKET-INFO external variables (all [194]) 22374 subttl SHOW PACKET-INFO external variables (all [194]) 22375 22376 extern bctr ; Block check type requested (character). 22377 extern bctu ; Block check type in use (number). 22378 extern ebq ; 8th-bit-on prefix. 22379 extern ebqflg ; 8th-bit prefixing flag. 22380 extern ebqr ; 8th-bit prefix field for Send-Init. 22381 extern reolch ; EOL character Tops-20 needs. 22382 extern rpadch ; Padding character Tops-20 wants. 22383 extern rpadn ; Number of padding characters for Tops-20. 22384 extern rptflg ; Repeat count processing flag. 22385 extern rptq ; Repeat count prefix. 22386 extern rquote ; Quote character Tops-20 wants. 22387 extern rsthdr ; Start of header character to receive. 22388 extern seolch ; EOL character micro needs. 22389 extern spadch ; Padding character micro wants. 22390 extern spadn ; Number of padding characters for micro. 22391 extern squote ; Quote character micro wants. 22392 extern ssthdr ; Start of header character to send. 22393 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 24 K20DSP MAC 6-Jun-23 10:31 SHOW PACKET-INFO display code 22394 subttl SHOW PACKET-INFO display code 22395 22396 ;[100] New headings, less confusing. 22397 22398 002331'03 $shpkt: entry $shpkt 22399 txmsg 22403 002332'03 104 00 0 00 000076 22404 002333'03 320 12 0 00 002334' 22405 000253'02 000000000000# 22406 001060'04 120 141 143 153 145 22407 22408 22409 22410 002334'03 201 01 0 00 000101 numout rpsiz 22411 002335'03 200 02 0 00 000452* 22412 002336'03 201 03 0 00 000012 22413 002337'03 104 00 0 00 000224 22414 002340'03 320 14 0 00 002341' 22415 002341'03 200 01 0 00 000000# txmsg < > 22416 002342'03 104 00 0 00 000076 22417 002343'03 320 12 0 00 002344' 22418 000254'02 000000000000# 22419 001076'04 011 011 000 000 000 22420 002344'03 201 01 0 00 000101 numout spsiz 22421 002345'03 200 02 0 00 000460* 22422 002346'03 201 03 0 00 000012 22423 002347'03 104 00 0 00 000224 22424 002350'03 320 14 0 00 002351' 22425 22426 002351'03 200 01 0 00 000000* move t1, rpadn ;[194] Load receive padding count 22427 002352'03 270 01 0 00 000000* add t1, spadn ;[194] Add sending padding count 22428 002353'03 323 01 0 00 002406' ifg. t1 ;[194] Only print characters if actually padding 22429 txmsg < characters 22430 002354'03 200 01 0 00 000000# Padding: > 22431 002355'03 104 00 0 00 000076 22432 002356'03 320 12 0 00 002357' 22433 000255'02 000000000000# 22434 001077'04 040 143 150 141 162 22435 22436 002357'03 201 01 0 00 000101 numout rpadn 22437 002360'03 200 02 0 00 002351* 22438 002361'03 201 03 0 00 000012 22439 002362'03 104 00 0 00 000224 22440 002363'03 320 14 0 00 002364' 22441 002364'03 200 01 0 00 000000# txmsg < > 22442 002365'03 104 00 0 00 000076 22443 002366'03 320 12 0 00 002367' 22444 000256'02 000000000000# 22445 001105'04 011 011 000 000 000 22446 002367'03 201 01 0 00 000101 numout spadn 22447 002370'03 200 02 0 00 002352* 22448 002371'03 201 03 0 00 000012 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 24-1 K20DSP MAC 6-Jun-23 10:31 SHOW PACKET-INFO display code 22449 002372'03 104 00 0 00 000224 22450 002373'03 320 14 0 00 002374' 22451 txmsg < 22452 002374'03 200 01 0 00 000000# Pad Character: > 22453 002375'03 104 00 0 00 000076 22454 002376'03 320 12 0 00 002377' 22455 000257'02 000000000000# 22456 001106'04 015 012 040 040 120 22457 002377'03 200 01 0 00 000000* move t1, rpadch 22458 002400'03 260 17 0 00 003646' call putc 22459 002401'03 200 01 0 00 000000# txmsg < > 22460 002402'03 104 00 0 00 000076 22461 002403'03 320 12 0 00 002404' 22462 000260'02 000000000000# 22463 001113'04 011 011 000 000 000 22464 002404'03 200 01 0 00 000000* move t1, spadch 22465 002405'03 260 17 0 00 003646' call putc 22466 002406'03 endif. ;[194] 22467 22468 txmsg < 22469 002406'03 200 01 0 00 000000# End-Of-Line: > 22470 002407'03 104 00 0 00 000076 22471 002410'03 320 12 0 00 002411' 22472 000261'02 000000000000# 22473 001114'04 015 012 040 040 105 22474 002411'03 200 01 0 00 000000* move t1, reolch 22475 002412'03 260 17 0 00 003646' call putc 22476 002413'03 200 01 0 00 000000# txmsg < > 22477 002414'03 104 00 0 00 000076 22478 002415'03 320 12 0 00 002416' 22479 000262'02 000000000000# 22480 001121'04 011 011 000 000 000 22481 002416'03 200 01 0 00 000000* move t1, seolch 22482 002417'03 260 17 0 00 003646' call putc 22483 txmsg < 22484 002420'03 200 01 0 00 000000# Control Prefix: > 22485 002421'03 104 00 0 00 000076 22486 002422'03 320 12 0 00 002423' 22487 000263'02 000000000000# 22488 001122'04 015 012 040 040 103 22489 002423'03 200 01 0 00 000000* move t1, rquote 22490 002424'03 260 17 0 00 003646' call putc 22491 002425'03 200 01 0 00 000000# txmsg < > 22492 002426'03 104 00 0 00 000076 22493 002427'03 320 12 0 00 002430' 22494 000264'02 000000000000# 22495 001127'04 011 011 000 000 000 22496 002430'03 200 01 0 00 000000* move t1, squote 22497 002431'03 260 17 0 00 003646' call putc 22498 22499 txmsg < 22500 002432'03 200 01 0 00 000000# Start-Of-Packet: > 22501 002433'03 104 00 0 00 000076 22502 002434'03 320 12 0 00 002435' 22503 000265'02 000000000000# k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 24-2 K20DSP MAC 6-Jun-23 10:31 SHOW PACKET-INFO display code 22504 001130'04 015 012 040 040 123 22505 002435'03 200 01 0 00 000000* move t1, ssthdr ;[18] 22506 002436'03 260 17 0 00 003646' call putc 22507 002437'03 200 01 0 00 000000# txmsg < > 22508 002440'03 104 00 0 00 000076 22509 002441'03 320 12 0 00 002442' 22510 000266'02 000000000000# 22511 001135'04 011 011 000 000 000 22512 002442'03 200 01 0 00 000000* move t1, rsthdr ;[18] 22513 002443'03 260 17 0 00 003646' call putc 22514 22515 ;[100] New headings for this stuff. 22516 22517 txmsg < 22518 22519 Requested Used 22520 002444'03 200 01 0 00 000000# 8th-bit Prefix: > ;[88] Begin addition 22521 002445'03 104 00 0 00 000076 22522 002446'03 320 12 0 00 002447' 22523 000267'02 000000000000# 22524 001136'04 015 012 015 012 011 22525 22526 22527 002447'03 336 00 0 00 000000* ifmn. ebqr ;[194] Did our user request 8th bit prefix? 22528 002450'03 254 00 0 00 002457' 22529 002451'03 200 01 0 00 000000* move t1, ebq ; Yes. 22530 002452'03 260 17 0 00 003646' call putc ; Say what it is. 22531 002453'03 200 01 0 00 000000# txmsg < > 22532 002454'03 104 00 0 00 000076 22533 002455'03 320 12 0 00 002456' 22534 000270'02 000000000000# 22535 001151'04 011 011 000 000 000 22536 002456'03 254 00 0 00 002462' else. ;[194] Otherwise, don't have one 22537 002457'03 200 01 0 00 000000# txmsg <(none) > ; Just say we'll do it if asked. 22538 002460'03 104 00 0 00 000076 22539 002461'03 320 12 0 00 002462' 22540 000271'02 000000000000# 22541 001152'04 050 156 157 156 145 22542 002462'03 endif. ;[194] 22543 22544 002462'03 336 00 0 00 000000* ifmn. ebqflg ;[194] Was it used during last transfer? 22545 002463'03 254 00 0 00 002467' 22546 002464'03 200 01 0 00 002451* move t1, ebq ; Looks like it, say what prefix. 22547 002465'03 260 17 0 00 003646' call putc 22548 002466'03 254 00 0 00 002472' else. ;[194] Wasn't used 22549 002467'03 200 01 0 00 000000# txmsg <(none)> ; Just say we would have done it if asked. 22550 002470'03 104 00 0 00 000076 22551 002471'03 320 12 0 00 002472' 22552 000272'02 000000000000# 22553 001154'04 050 156 157 156 145 22554 002472'03 endif. ;[194] 22555 22556 txmsg < 22557 002472'03 200 01 0 00 000000# Repeat Prefix: > ;[92] Begin addition 22558 002473'03 104 00 0 00 000076 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 24-3 K20DSP MAC 6-Jun-23 10:31 SHOW PACKET-INFO display code 22559 002474'03 320 12 0 00 002475' 22560 000273'02 000000000000# 22561 001156'04 015 012 040 040 122 22562 002475'03 200 01 0 00 000000* move t1, rptq ; What we would use to flag repeat counts. 22563 002476'03 260 17 0 00 003646' call putc 22564 002477'03 200 01 0 00 000000# txmsg < > 22565 002500'03 104 00 0 00 000076 22566 002501'03 320 12 0 00 002502' 22567 000274'02 000000000000# 22568 001163'04 011 011 000 000 000 22569 22570 002502'03 336 00 0 00 000000* ifmn. rptflg ;[194] Was it actually used? 22571 002503'03 254 00 0 00 002507' 22572 002504'03 200 01 0 00 002475* move t1, rptq ;[194] Show it 22573 002505'03 260 17 0 00 003646' call putc 22574 002506'03 254 00 0 00 002512' else. ;[194] Otherwise didn't use it 22575 002507'03 200 01 0 00 000000# txmsg <(none)> ; Just say we would have done it if asked. 22576 002510'03 104 00 0 00 000076 22577 002511'03 320 12 0 00 002512' 22578 000275'02 000000000000# 22579 001164'04 050 156 157 156 145 22580 002512'03 endif. ;[194] 22581 22582 txmsg < 22583 002512'03 200 01 0 00 000000# Block Check: > ;[98] Block check type. 22584 002513'03 104 00 0 00 000076 22585 002514'03 320 12 0 00 002515' 22586 000276'02 000000000000# 22587 001166'04 015 012 040 040 102 22588 002515'03 200 01 0 00 000000* move t1, bctr 22589 002516'03 260 17 0 00 003646' call putc 22590 002517'03 200 01 0 00 000000# txmsg < > 22591 002520'03 104 00 0 00 000076 22592 002521'03 320 12 0 00 002522' 22593 000277'02 000000000000# 22594 001173'04 011 011 000 000 000 22595 002522'03 201 01 0 00 000101 numout bctu ;[98] 22596 002523'03 200 02 0 00 000000* 22597 002524'03 201 03 0 00 000012 22598 002525'03 104 00 0 00 000224 22599 002526'03 320 14 0 00 002527' 22600 22601 002527'03 561 01 0 00 002326* hrroi t1, crlflf ;[194] Tie off the line 22602 002530'03 104 00 0 00 000076 PSOUT% 22603 002531'03 256 00 0 00 000005 xct q1 ;[39] return or proceed... 22604 remark ;[194] May fall through .. 22605 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 25 K20DSP MAC 6-Jun-23 10:31 SHOW TIMING-INFO external variable usage 22606 subttl SHOW TIMING-INFO external variable usage 22607 22608 extern delay ; Milliseconds to wait before sending first packet 22609 extern delayf ; Same number as floating point seconds 22610 extern imxtry ; Maximum retries in send initiate. 22611 extern maxtry ; Maximum retries for an ordinary packet. 22612 extern rpause ; Pause before ACKing data packet. 22613 extern rpausf ; Same number as floating point 22614 extern rtimou ; Minimum timeout interval Tops-20 needs. 22615 extern spause ; Pause before sending data packet. 22616 extern spausf ; Same number as floating point 22617 extern srvtim ; Server command wait timeout interval. 22618 extern stimou ; Interval for current timer 22619 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 26 K20DSP MAC 6-Jun-23 10:31 SHOW TIMING-INFO numeric output flags 22620 subttl SHOW TIMING-INFO numeric output flags 22621 22622 ;[212] Begin code Insertion 22623 22624 remark Complex flag usage set up 22625 22626 ; Integer and floating output flags to line up columns. 22627 ; The hairy floating flags can be found in DOC:JSYS_REFERENCE.MEM, 22628 ; section 2.9.1.2, table xx, pages 2-87, 88. 22629 22630 ; Integer flags 22631 120006 000012 int%f== 22632 .xcref int%f ; Don't need on cross reference 22633 suppress int%f ; Don't want in symbol table listing 22634 120006 000012 show. (int%f) ; Show final word 22635 22636 ; Floating point flags 22637 000000 flt%f==0 ; Floating output flags; no output to DDT 22638 .xcref flt%f ; No need on the cross reference 22639 suppress flt%f ; No need in symbol table listing 22640 22641 define fltf (v,f) < ;;Define a macro to build floating flag word 22642 ifnb ,< ;;Non-blank field specified? 22643 flt%f==> ;; OR in the value in the field 22644 >;; ifnb 22645 ifb ,< ;;Blank field? 22646 flt%f==> ;;OR in the bit 22647 >;; ifb 22648 .xcref flt%f ;;Still don't need on cross reference 22649 >;; fltf 22650 22651 fltf(.flspc,fl%sgn) ;;First character is a space 22652 fltf(.fllsp,fl%jus) ;;Right justify, leading spaces 22653 fltf(fl%one) ;;Output at least one digit 22654 fltf(fl%pnt) ;;Output the decimal point, always 22655 fltf(.flexn,fl%exp) ;;Don't output an exponent 22656 fltf(fl%ovl) ;;Output on overflow 22657 fltf(^d6,fl%fst) ;;Properly justify integral portion 22658 fltf(^d4,fl%snd) ;;Digits in second field 22659 22660 224100 060400 show. (flt%f) ;;Finally show what we got 22661 22662 ;[212] End code insertion 22663 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 27 K20DSP MAC 6-Jun-23 10:31 SHOW TIMING-INFO code 22664 subttl SHOW TIMING-INFO code 22665 22666 remark Timeout in floating seconds and integral milliseconds 22667 22668 002532'03 $shtim: entry $shtim 22669 002532'03 474 04 0 00 000000 seto t4, ;[212] Let's suppose no time outs 22670 txmsg ;[212] 22674 002534'03 104 00 0 00 000076 22675 002535'03 320 12 0 00 002536' 22676 000300'02 000000000000# 22677 001174'04 124 151 155 151 156 22678 22679 22680 22681 002536'03 120 01 0 00 000000* dmove t1,rtimou ;[212] Load timeout int ms and floating seconds 22682 002537'03 322 01 0 00 002550' ifn. t1 ;[212] Prefer int (because of a parser fluke) 22683 002540'03 201 01 0 00 000101 movei t1, .priou ;[212] 22684 002541'03 120 03 0 00 004410' dmove t3, [exp flt%f,0] ;[212] Special columnar formatting, flag non-zero 22685 002542'03 104 00 0 00 000233 FLOUT% ;[212] 22686 002543'03 320 14 0 00 002544' erjmps .+1 ;[212] 22687 002544'03 200 01 0 00 000000# txmsg < > ;[212] Two spaces to send column 22688 002545'03 104 00 0 00 000076 22689 002546'03 320 12 0 00 002547' 22690 000301'02 000000000000# 22691 001210'04 040 040 000 000 000 22692 002547'03 254 00 0 00 002553' else. ;[186] Otherwise, special case it 22693 002550'03 200 01 0 00 000000# txmsg < (none) > ;[186] Make it STAND OUT 22694 002551'03 104 00 0 00 000076 22695 002552'03 320 12 0 00 002553' 22696 000302'02 000000000000# 22697 001211'04 040 040 040 040 040 22698 002553'03 endif. ;[186] End special casing recieved 22699 22700 22701 002553'03 120 01 0 00 000000* dmove t1,stimou ;[212] Load timeout int ms and floating seconds 22702 002554'03 322 01 0 00 002562' ifn. t1 ;[212] Prefer int (because of a parser fluke) 22703 002555'03 201 01 0 00 000101 movei t1, .priou ;[212] 22704 002556'03 120 03 0 00 004410' dmove t3, [exp flt%f,0] ;[212] special columnar formatting, flag non-zero 22705 002557'03 104 00 0 00 000233 FLOUT ;[212] 22706 002560'03 320 14 0 00 002561' erjmps .+1 ;[212] 22707 002561'03 254 00 0 00 002565' else. ;[194] Otherwise, who knows? 22708 002562'03 200 01 0 00 000000# txmsg < (none)> ;[212] Five spaces 22709 002563'03 104 00 0 00 000076 22710 002564'03 320 12 0 00 002565' 22711 000303'02 000000000000# 22712 001214'04 040 040 040 040 040 22713 002565'03 endif. ;[194] 22714 22715 remark ;[212] If never printed a time out, suppress ms's 22716 002565'03 326 04 0 00 002637' ife. t4 ;[212] Ever do anthing? 22717 002566'03 200 01 0 00 000000# txmsg < sec (> ;[212] Yes, so label the seconds field 22718 002567'03 104 00 0 00 000076 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 27-1 K20DSP MAC 6-Jun-23 10:31 SHOW TIMING-INFO code 22719 002570'03 320 12 0 00 002571' 22720 000304'02 000000000000# 22721 001217'04 040 163 145 143 040 22722 002571'03 201 01 0 00 000101 numout [maxtim/^d1000] ;[212] 22723 002572'03 200 02 0 00 004412' 22724 002573'03 201 03 0 00 000012 22725 002574'03 104 00 0 00 000224 22726 002575'03 320 14 0 00 002576' 22727 txmsg < max) 22728 002576'03 200 01 0 00 000000# > ;[212] 22729 002577'03 104 00 0 00 000076 22730 002600'03 320 12 0 00 002601' 22731 000305'02 000000000000# 22732 001221'04 040 155 141 170 051 22733 22734 002601'03 337 02 0 00 002536* skipg t2,rtimou ;[212] Non-zero receive timeout? 22735 002602'03 254 00 0 00 002613' ifskp. ;[212] Yes,display it 22736 002603'03 200 01 0 00 000000# txmsg < > ;[212] One tab, seven spaces to recieve field 22737 002604'03 104 00 0 00 000076 22738 002605'03 320 12 0 00 002606' 22739 000306'02 000000000000# 22740 001223'04 011 040 040 040 040 22741 002606'03 201 01 0 00 000101 movei t1, .priou ;[194] 22742 002607'03 200 03 0 00 004413' movx t3, int%f ;[212] Special integer formatting 22743 002610'03 104 00 0 00 000224 NOUT% ;rtimou ;[186] Not rrtimo ... 22744 002611'03 320 14 0 00 002612' erjmps .+1 ;[194] 22745 002612'03 254 00 0 00 002616' else. ;[212] Otherwise, blank the field 22746 002613'03 200 01 0 00 000000# txmsg < > ;[212] 2 tabs, 7 spaces to end of recieve 22747 002614'03 104 00 0 00 000076 22748 002615'03 320 12 0 00 002616' 22749 000307'02 000000000000# 22750 001225'04 011 011 040 040 040 22751 002616'03 endif. ;[212] Done printing 22752 22753 002616'03 337 02 0 00 002553* skipg t2,stimou ;[212] Non-zero receive timeout? 22754 002617'03 254 00 0 00 002630' ifskp. ;[212] Yes,display it 22755 002620'03 200 01 0 00 000000# txmsg < > ;[212] One tab, four spaces 22756 002621'03 104 00 0 00 000076 22757 002622'03 320 12 0 00 002623' 22758 000310'02 000000000000# 22759 001227'04 011 040 040 040 040 22760 002623'03 201 01 0 00 000101 movei t1, .priou ;[194] 22761 002624'03 200 03 0 00 004413' movx t3, int%f ;[212] Special integer formatting 22762 002625'03 104 00 0 00 000224 NOUT% ;[186] 22763 002626'03 320 14 0 00 002627' erjmps .+1 ;[194] 22764 002627'03 254 00 0 00 002633' else. ;[212] Otherwise, no send timeout 22765 002630'03 200 01 0 00 000000# txmsg < > ;[212] Two tabs, two spaces 22766 002631'03 104 00 0 00 000076 22767 002632'03 320 12 0 00 002633' 22768 000311'02 000000000000# 22769 001231'04 011 011 040 040 000 22770 002633'03 endif. ;[212] Either should be in correct column now 22771 txmsg < ms 22772 002633'03 200 01 0 00 000000# > ;[212] Must always label non-zero milliseconds 22773 002634'03 104 00 0 00 000076 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 27-2 K20DSP MAC 6-Jun-23 10:31 SHOW TIMING-INFO code 22774 002635'03 320 12 0 00 002636' 22775 000312'02 000000000000# 22776 001232'04 040 155 163 015 012 22777 002636'03 254 00 0 00 002642' else. ;[212] Otherwise, no time outs at all, ever 22778 txmsg < 22779 002637'03 200 01 0 00 000000# > ;[212] So just tie off the line 22780 002640'03 104 00 0 00 000076 22781 002641'03 320 12 0 00 002642' 22782 000313'02 000000000000# 22783 001234'04 015 012 000 000 000 22784 002642'03 endif. ;[212] End whether ever printed anything 22785 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 28 K20DSP MAC 6-Jun-23 10:31 Pause in floating seconds and integral milliseconds 22786 subttl Pause in floating seconds and integral milliseconds 22787 22788 002642'03 400 04 0 00 000000 setz t4, ;[212] Assume nothing printed 22789 txmsg < 22790 002643'03 200 01 0 00 000000# Pause: > ;[196] 22791 002644'03 104 00 0 00 000076 22792 002645'03 320 12 0 00 002646' 22793 000314'02 000000000000# 22794 001235'04 015 012 040 040 120 22795 002646'03 200 03 0 00 004410' movx t3, ;[212] Special columnar formatting, always 22796 22797 002647'03 337 02 0 00 000000* skipg t2, rpausf ;[212] Load and check floating component 22798 002650'03 254 00 0 00 002656' ifskp. ;[212] Non-zero, type it 22799 002651'03 201 01 0 00 000101 movei t1, .priou ;[212] This terminal 22800 002652'03 104 00 0 00 000233 FLOUT ;[36] 22801 002653'03 320 14 0 00 002654' erjmps .+1 ;[212] Catch and suppress errors 22802 002654'03 474 04 0 00 000000 seto t4, ;[212] Flag printed something 22803 002655'03 254 00 0 00 002661' else. ;[212] Otherwise, special case zero 22804 002656'03 200 01 0 00 000000# txmsg < (none)> ;[212] with plain text 22805 002657'03 104 00 0 00 000076 22806 002660'03 320 12 0 00 002661' 22807 000315'02 000000000000# 22808 001240'04 040 040 040 040 040 22809 002661'03 endif. 22810 22811 002661'03 337 02 0 00 000000* skipg t2, spausf ;[212] Load and check floating component 22812 002662'03 254 00 0 00 002673' ifskp. ;[212] Non-zero, type it 22813 002663'03 200 01 0 00 000000# txmsg < > ;[212] Two spaces 22814 002664'03 104 00 0 00 000076 22815 002665'03 320 12 0 00 002666' 22816 000316'02 000000000000# 22817 001243'04 040 040 000 000 000 22818 002666'03 201 01 0 00 000101 movei t1, .priou ;[36] 22819 002667'03 104 00 0 00 000233 FLOUT ;[36] 22820 002670'03 320 14 0 00 002671' erjmps .+1 ;[194] 22821 002671'03 474 04 0 00 000000 seto t4, ;[212] Flag printed something 22822 002672'03 254 00 0 00 002676' else. ;[212] Otherwise, special case zero 22823 002673'03 200 01 0 00 000000# txmsg < (none)> ;[212] with plain text 22824 002674'03 104 00 0 00 000076 22825 002675'03 320 12 0 00 002676' 22826 000317'02 000000000000# 22827 001244'04 040 040 040 040 040 22828 002676'03 endif. 22829 22830 002676'03 322 04 0 00 002733' ifn. t4 ;[212] Printed any numbers? 22831 txmsg < sec 22832 002677'03 200 01 0 00 000000# > ;[212] Yes; one tab, seven spaces to recieve field 22833 002700'03 104 00 0 00 000076 22834 002701'03 320 12 0 00 002702' 22835 000320'02 000000000000# 22836 001247'04 040 163 145 143 015 22837 22838 002702'03 200 03 0 00 004413' movx t3, ;[212] Special integer formatting 22839 22840 002703'03 337 02 0 00 000000* skipg t2, rpause ;[212] Integer millisecond recieve pause k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 28-1 K20DSP MAC 6-Jun-23 10:31 Pause in floating seconds and integral milliseconds 22841 002704'03 254 00 0 00 002714' ifskp. ;[212] A real number, print it 22842 002705'03 201 01 0 00 000101 movei t1, .priou ;[212] Going to primary output 22843 002706'03 104 00 0 00 000224 NOUT% ;[212] Output it (but nicely) 22844 002707'03 320 14 0 00 002710' erjmps .+1 ;[212] Catch and suppress error 22845 002710'03 200 01 0 00 000000# txmsg < > ;[212] One tab, four spaces 22846 002711'03 104 00 0 00 000076 22847 002712'03 320 12 0 00 002713' 22848 000321'02 000000000000# 22849 001252'04 011 040 040 040 040 22850 002713'03 254 00 0 00 002717' else. ;[212] Otherwise, suppress completely 22851 002714'03 200 01 0 00 000000# txmsg < > ;[212] Two tabs, four spaces 22852 002715'03 104 00 0 00 000076 22853 002716'03 320 12 0 00 002717' 22854 000322'02 000000000000# 22855 001254'04 011 011 040 040 040 22856 002717'03 endif. ;[212] End suppression decision 22857 22858 002717'03 337 02 0 00 000000* skipg t2, spause ;[212] Integer millisecond send pause 22859 002720'03 254 00 0 00 002725' ifskp. ;[212] A real number, print it 22860 002721'03 201 01 0 00 000101 movei t1, .priou ;[212] Going to primary output 22861 002722'03 104 00 0 00 000224 NOUT% ;[212] Output it (but nicely) 22862 002723'03 320 14 0 00 002724' erjmps .+1 ;[212] Catch and suppress error 22863 002724'03 254 00 0 00 002730' else. ;[212] Otherwise, suppress number entirely 22864 002725'03 200 01 0 00 000000# txmsg < > ;[212] One tab, four spaces 22865 002726'03 104 00 0 00 000076 22866 002727'03 320 12 0 00 002730' 22867 000323'02 000000000000# 22868 001256'04 011 040 040 000 000 22869 002730'03 endif. ;[212] End suppression decision 22870 22871 002730'03 200 01 0 00 000000# txmsg < ms> ;[196] 22872 002731'03 104 00 0 00 000076 22873 002732'03 320 12 0 00 002733' 22874 000324'02 000000000000# 22875 001257'04 040 155 163 000 000 22876 002733'03 endif. ;[212] 22877 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 29 K20DSP MAC 6-Jun-23 10:31 Delay in floating seconds and integral milliseconds 22878 subttl Delay in floating seconds and integral milliseconds 22879 22880 txmsg < 22881 22882 002733'03 200 01 0 00 000000# Delay before sending first packet: > ;[196] 22883 002734'03 104 00 0 00 000076 22884 002735'03 320 12 0 00 002736' 22885 000325'02 000000000000# 22886 001260'04 015 012 015 012 040 22887 22888 002736'03 336 00 0 00 001623* ifmn. local ;[194] Local? 22889 002737'03 254 00 0 00 002744' 22890 002740'03 200 01 0 00 000000# txmsg ;[194] Never waits for anybody 22891 002741'03 104 00 0 00 000076 22892 002742'03 320 12 0 00 002743' 22893 000326'02 000000000000# 22894 001271'04 116 157 156 145 000 22895 002743'03 254 00 0 00 002777' else. ;[194] Remote, actually 22896 002744'03 332 02 0 00 000000* skipe t2, delayf ;[194] Do we have any delay, then? 22897 002745'03 254 00 0 00 002752' ifskp. ;[194] No, so special case that 22898 002746'03 200 01 0 00 000000# txmsg ;[194] A little different from local 22899 002747'03 104 00 0 00 000076 22900 002750'03 320 12 0 00 002751' 22901 000327'02 000000000000# 22902 001272'04 132 145 162 157 040 22903 002751'03 254 00 0 00 002777' else. 22904 002752'03 201 01 0 00 000101 movei t1, .priou ;[194] 22905 002753'03 400 03 0 00 000000 setz t3, ;[194] Default flags 22906 002754'03 104 00 0 00 000233 FLOUT% ;[194] Type it 22907 002755'03 320 12 0 00 002756' erjmpr .+1 ;[194] 22908 002756'03 312 02 0 00 004414' came t2,[1.0] ;[212] Exactly one second? 22909 002757'03 254 00 0 00 002764' ifskp. ;[212] Yes, inflect for singular case 22910 002760'03 200 01 0 00 000000# txmsg < sec (> ;[212] Label and punctuate 22911 002761'03 104 00 0 00 000076 22912 002762'03 320 12 0 00 002763' 22913 000330'02 000000000000# 22914 001275'04 040 163 145 143 040 22915 002763'03 254 00 0 00 002767' else. ;[212] Otherwise, use plural inflection 22916 002764'03 200 01 0 00 000000# txmsg < secs (> ;[212] Label and punctuate 22917 002765'03 104 00 0 00 000076 22918 002766'03 320 12 0 00 002767' 22919 000331'02 000000000000# 22920 001277'04 040 163 145 143 163 22921 002767'03 endif. ;[212] End grammatical analysis 22922 002767'03 201 01 0 00 000101 movei t1, .priou ;[194] 22923 002770'03 200 02 0 00 000000* move t2, delay ;[194] Load milliseconds 22924 002771'03 201 03 0 00 000012 movei t3, ^d10 ;[194] 22925 002772'03 104 00 0 00 000224 NOUT% ;[194] 22926 002773'03 320 12 0 00 002774' erjmpr .+1 ;[194] 22927 002774'03 200 01 0 00 000000# txmsg < ms)> ;[194] 22928 002775'03 104 00 0 00 000076 22929 002776'03 320 12 0 00 002777' 22930 000332'02 000000000000# 22931 001301'04 040 155 163 051 000 22932 002777'03 endif. ;[194] k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 29-1 K20DSP MAC 6-Jun-23 10:31 Delay in floating seconds and integral milliseconds 22933 002777'03 endif. ;[194] End delay listing 22934 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 30 K20DSP MAC 6-Jun-23 10:31 Retries, Pause and other Misc 22935 subttl Retries, Pause and other Misc 22936 22937 txmsg < 22938 002777'03 200 01 0 00 000000# Packet retries before timeout: > 22939 003000'03 104 00 0 00 000076 22940 003001'03 320 12 0 00 003002' 22941 000333'02 000000000000# 22942 001302'04 015 012 040 040 120 22943 003002'03 201 01 0 00 000101 numout maxtry 22944 003003'03 200 02 0 00 000000* 22945 003004'03 201 03 0 00 000012 22946 003005'03 104 00 0 00 000224 22947 003006'03 320 14 0 00 003007' 22948 22949 txmsg < 22950 003007'03 200 01 0 00 000000# Number of retries for init packet: > 22951 003010'03 104 00 0 00 000076 22952 003011'03 320 12 0 00 003012' 22953 000334'02 000000000000# 22954 001313'04 015 012 040 040 116 22955 003012'03 201 01 0 00 000101 numout imxtry 22956 003013'03 200 02 0 00 000000* 22957 003014'03 201 03 0 00 000012 22958 003015'03 104 00 0 00 000224 22959 003016'03 320 14 0 00 003017' 22960 22961 remark in floating seconds and integral milliseconds 22962 22963 003017'03 336 00 0 00 000000* ifmn. srvtim ;[194] Any NAK'ing? 22964 003020'03 254 00 0 00 003054' 22965 txmsg < 22966 003021'03 200 01 0 00 000000# Server sends NAKs every > ;[212] Yes, begin the blat 22967 003022'03 104 00 0 00 000076 22968 003023'03 320 12 0 00 003024' 22969 000335'02 000000000000# 22970 001324'04 015 012 040 040 123 22971 003024'03 201 01 0 00 000101 movei t1, .priou ;[212] Output to terminal 22972 003025'03 200 02 0 00 000000# move t2, ;[212] Pick up floating component 22973 003026'03 200 04 0 00 000002 move t4, t2 ;[212] Save a copy 22974 003027'03 400 03 0 00 000000 setz t3, ;[212] Default (non-columnar) formatting 22975 003030'03 104 00 0 00 000233 FLOUT% ;[212] Type it 22976 003031'03 320 14 0 00 003032' erjmps .+1 ;[212] Catch and suppress error 22977 003032'03 312 04 0 00 004414' came t4,[1.0] ;[212] Exactly one second? 22978 003033'03 254 00 0 00 003040' ifskp. ;[212] Yes, inflect for singular case 22979 003034'03 200 01 0 00 000000# txmsg < sec (> ;[212] Label and punctuate 22980 003035'03 104 00 0 00 000076 22981 003036'03 320 12 0 00 003037' 22982 000336'02 000000000000# 22983 001332'04 040 163 145 143 040 22984 003037'03 254 00 0 00 003043' else. ;[212] Otherwise, use plural inflection 22985 003040'03 200 01 0 00 000000# txmsg < secs (> ;[212] Label and punctuate 22986 003041'03 104 00 0 00 000076 22987 003042'03 320 12 0 00 003043' 22988 000337'02 000000000000# 22989 001334'04 040 163 145 143 163 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 30-1 K20DSP MAC 6-Jun-23 10:31 Retries, Pause and other Misc 22990 003043'03 endif. ;[212] End grammatical analysis 22991 003043'03 201 01 0 00 000101 movei t1, .priou ;[212] NOUT% goes to terminal, too 22992 003044'03 200 02 0 00 003017* move t2, srvtim ;[212] Load milliseconds 22993 003045'03 201 03 0 00 000012 movx t3, fld(^d10,no%rdx) ;[212] Base ten, but free format 22994 003046'03 104 00 0 00 000224 NOUT% ;[212] Type equivalent milliseconds 22995 003047'03 320 14 0 00 003050' erjmps .+1 ;[212] Catch and suppress error 22996 003050'03 200 01 0 00 000000# txmsg < ms)> ;[212] Abbreviation needs no inflection 22997 003051'03 104 00 0 00 000076 22998 003052'03 320 12 0 00 003053' 22999 000340'02 000000000000# 23000 001336'04 040 155 163 051 000 23001 003053'03 254 00 0 00 003057' else. ;[212] 23002 txmsg < 23003 003054'03 200 01 0 00 000000# Server will not NAK the communications line> 23004 003055'03 104 00 0 00 000076 23005 003056'03 320 12 0 00 003057' 23006 000341'02 000000000000# 23007 001337'04 015 012 040 040 123 23008 003057'03 endif. ;[212] 23009 23010 remark Other misc 23011 23012 003057'03 332 00 0 00 000014 ifme. debug ;[194] No blips if debugging. 23013 003060'03 254 00 0 00 003076' 23014 003061'03 336 00 0 00 002736* skipn local ; Or if not local. 23015 003062'03 254 00 0 00 003076' anskp. ;[194] 23016 txmsg < 23017 23018 003063'03 200 01 0 00 000000# "." for every > ;[4] 23019 003064'03 104 00 0 00 000076 23020 003065'03 320 12 0 00 003066' 23021 000342'02 000000000000# 23022 001351'04 015 012 015 012 040 23023 003066'03 201 01 0 00 000101 numout [blip] ;[9] 23024 003067'03 200 02 0 00 004415' 23025 003070'03 201 03 0 00 000012 23026 003071'03 104 00 0 00 000224 23027 003072'03 320 14 0 00 003073' 23028 003073'03 200 01 0 00 000000# txmsg < packets, "%" for each NAK.> 23029 003074'03 104 00 0 00 000076 23030 003075'03 320 12 0 00 003076' 23031 000343'02 000000000000# 23032 001356'04 040 160 141 143 153 23033 003076'03 endif. ;[194] 23034 23035 003076'03 561 01 0 00 002527* hrroi t1, crlflf ;[194] 23036 003077'03 104 00 0 00 000076 PSOUT% ;[194] 23037 003100'03 256 00 0 00 000005 xct q1 23038 remark ;[194] May fall through .. 23039 23040 if2 < purge int%f,flt%f,fltf > ;[212] Don't need symbols or macro after pass 2 23041 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 31 K20DSP MAC 6-Jun-23 10:31 Show INPUT parameters 23042 subttl Show INPUT parameters 23043 23044 extern incase ; Case conversion flag for INPUT search. 23045 extern indeft ; Default timeout for INPUT search, floating seconds 23046 extern indeff ; Same value as milliseconds 23047 extern intima ; Timeout action for INPUT search. 23048 23049 extern indefc ;[209] Default search string length in characters 23050 extern indefw ;[209] Same thing in words (for xblt) 23051 extern indefs ;[209] Expanded search string 23052 23053 ;[160] 23054 23055 003101'03 $shinp: entry $shinp 23056 txmsg 23059 003102'03 104 00 0 00 000076 23060 003103'03 320 12 0 00 003104' 23061 000344'02 000000000000# 23062 001364'04 120 141 162 141 155 23063 23064 003104'03 332 00 0 00 000000* ifme. incase 23065 003105'03 254 00 0 00 003112' 23066 003106'03 200 01 0 00 000000# txmsg 23067 003107'03 104 00 0 00 000076 23068 003110'03 320 12 0 00 003111' 23069 000345'02 000000000000# 23070 001377'04 111 147 156 157 162 23071 003111'03 254 00 0 00 003115' else. ;[209] In case set means case sensitive 23072 003112'03 200 01 0 00 000000# txmsg 23073 003113'03 104 00 0 00 000076 23074 003114'03 320 12 0 00 003115' 23075 000346'02 000000000000# 23076 001403'04 117 142 163 145 162 23077 003115'03 endif. 23078 23079 txmsg < 23080 003115'03 200 01 0 00 000000# Default Timeout: > 23081 003116'03 104 00 0 00 000076 23082 003117'03 320 12 0 00 003120' 23083 000347'02 000000000000# 23084 001410'04 015 012 040 040 104 23085 003120'03 337 02 0 00 000000* skipg t2, indeff ;[194] Load default value, if exists 23086 003121'03 254 00 0 00 003142' ifskp. ;[194] Doing time outs 23087 003122'03 201 01 0 00 000101 movei t1, .priou ;[194] 23088 003123'03 400 03 0 00 000000 setz t3, ;[194] Default flags 23089 003124'03 104 00 0 00 000233 FLOUT% ;[194] Type it 23090 003125'03 320 12 0 00 003126' erjmpr .+1 ;[194] 23091 003126'03 200 01 0 00 000000# txmsg < sec, > ;[194] 23092 003127'03 104 00 0 00 000076 23093 003130'03 320 12 0 00 003131' 23094 000350'02 000000000000# 23095 001415'04 040 163 145 143 054 23096 003131'03 201 01 0 00 000101 movei t1, .priou ;[194] k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 31-1 K20DSP MAC 6-Jun-23 10:31 Show INPUT parameters 23097 003132'03 200 02 0 00 000000* move t2, indeft ;[194] Load milliseconds 23098 003133'03 201 03 0 00 000012 movei t3, ^d10 ;[194] 23099 003134'03 104 00 0 00 000224 NOUT% ;[194] 23100 003135'03 320 12 0 00 003136' erjmpr .+1 ;[194] 23101 003136'03 200 01 0 00 000000# txmsg < ms> ;[194] 23102 003137'03 104 00 0 00 000076 23103 003140'03 320 12 0 00 003141' 23104 000351'02 000000000000# 23105 001417'04 040 155 163 000 000 23106 003141'03 254 00 0 00 003145' else. ;[194] Otherwise, not timing out 23107 003142'03 200 01 0 00 000000# txmsg ;[194] 23108 003143'03 104 00 0 00 000076 23109 003144'03 320 12 0 00 003145' 23110 000352'02 000000000000# 23111 001420'04 111 156 146 151 156 23112 003145'03 endif. ;[194] 23113 23114 txmsg < 23115 003145'03 200 01 0 00 000000# Timeout Action: > ;[209] 23116 003146'03 104 00 0 00 000076 23117 003147'03 320 12 0 00 003150' 23118 000353'02 000000000000# 23119 001422'04 015 012 040 040 124 23120 003150'03 332 00 0 00 000000* ifme. intima ;[209] 23121 003151'03 254 00 0 00 003156' 23122 003152'03 200 01 0 00 000000# txmsg ;[209] 23123 003153'03 104 00 0 00 000076 23124 003154'03 320 12 0 00 003155' 23125 000354'02 000000000000# 23126 001427'04 120 162 157 143 145 23127 003155'03 254 00 0 00 003161' else. ;[209] 23128 003156'03 200 01 0 00 000000# txmsg ;[209] 23129 003157'03 104 00 0 00 000076 23130 003160'03 320 12 0 00 003161' 23131 000355'02 000000000000# 23132 001435'04 121 165 151 164 040 23133 003161'03 endif. ;[209] 23134 23135 txmsg < 23136 003161'03 200 01 0 00 000000# Default Search: > ;[209] 23137 003162'03 104 00 0 00 000076 23138 003163'03 320 12 0 00 003164' 23139 000356'02 000000000000# 23140 001442'04 015 012 040 040 104 23141 23142 003164'03 332 00 0 00 000000* ifme. indefw ;[209] Anything set? 23143 003165'03 254 00 0 00 003172' 23144 003166'03 200 01 0 00 000000# txmsg <*Carriage Return Line Feed*> ;[209] Nope, so point that out 23145 003167'03 104 00 0 00 000076 23146 003170'03 320 12 0 00 003171' 23147 000357'02 000000000000# 23148 001447'04 052 103 141 162 162 23149 003171'03 254 00 0 00 003214' else. ;[209] Otherwise, something there 23150 003172'03 201 01 0 00 000040 movei t1, .chspc ;[209] Load a space 23151 003173'03 104 00 0 00 000074 PBOUT% ;[209] Line up the text k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 31-2 K20DSP MAC 6-Jun-23 10:31 Show INPUT parameters 23152 003174'03 201 01 0 00 000042 movei t1, .chdbq ;[209] Load Double quote 23153 003175'03 104 00 0 00 000074 PBOUT% ;[209] Type it 23154 003176'03 201 01 0 00 000101 movei t1, .priou ;[209] Output to terminal 23155 003177'03 561 02 0 00 000000* hrroi t2, indefs ;[209] Point to default string 23156 003200'03 210 03 0 00 000000* movn t3, indefc ;[209] Load negative count of characters 23157 003201'03 400 04 0 00 000000 setz t4, ;[209] Stop on NUL, just in case 23158 003202'03 104 00 0 00 000053 SOUT% ;[209] Type it (counted SOUT% faster) 23159 003203'03 320 12 0 00 003205' ifje. r ;[209] Catch any JSYS error 23160 003204'03 254 00 0 00 003212' 23161 003205'03 200 04 0 00 000001 move t4, t1 ;[209] Save error for debuggers 23162 003206'03 200 01 0 00 000000# txmsg <*** ERROR ***> ;[209] Something obvious, I guess 23163 003207'03 104 00 0 00 000076 23164 003210'03 320 12 0 00 003211' 23165 000360'02 000000000000# 23166 001455'04 052 052 052 040 105 23167 003211'03 201 01 0 00 000101 movei t1, .priou ;[209] Reload primary output 23168 003212'03 endif. ;[209] 23169 003212'03 201 01 0 00 000042 movei t1, .chdbq ;[209] Load Double quote 23170 003213'03 104 00 0 00 000074 PBOUT% ;[209] Type it 23171 003214'03 endif. ;[209] End case displaying search string 23172 23173 003214'03 561 01 0 00 003076* hrroi t1, crlflf ;[209] Tie off the line 23174 003215'03 104 00 0 00 000076 PSOUT% ;[209] 23175 23176 003216'03 256 00 0 00 000005 xct q1 23177 remark ;[194] May fall through .. 23178 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 32 K20DSP MAC 6-Jun-23 10:31 SHOW MACRO DEFINITIONS 23179 subttl SHOW MACRO DEFINITIONS 23180 23181 ;[77] SHOW MACRO DEFINITIONS 23182 23183 extern mactab ;[194] Macro table 23184 23185 003217'03 $shmac: entry $shmac 23186 003217'03 554 04 0 00 000000* hlrz t4, mactab ; Anything in macro table? 23187 003220'03 327 04 0 00 003225' ifle. t4 ;[194] If don't have any 23188 txmsg <%No macros defined 23189 003221'03 200 01 0 00 000000# > ;[203] Then say that 23190 003222'03 104 00 0 00 000076 23191 003223'03 320 12 0 00 003224' 23192 000361'02 000000000000# 23193 001460'04 045 116 157 040 155 23194 23195 003224'03 254 00 0 00 003314' jrst $shmax ;[194] And we're all done 23196 003225'03 endif. ;[203] Otherwise, have some blat 23197 ;[203] So dump the macros 23198 003225'03 201 01 0 00 000101 movei t1,.priou ;[203] Still going to terminal 23199 003226'03 200 02 0 00 000004 move t2,t4 ;[203] Load how many used 23200 003227'03 201 03 0 00 000012 movei t3,^d10 ;[203] Humans grok base 10 23201 003230'03 104 00 0 00 000224 NOUT% ;[203] Convert to external and display 23202 003231'03 320 12 0 00 003232' erjmpr .+1 ;[203] Catch and ignore error 23203 003232'03 200 01 0 00 000000# txmsg < macro> ;[203] Begin description 23204 003233'03 104 00 0 00 000076 23205 003234'03 320 12 0 00 003235' 23206 000362'02 000000000000# 23207 001465'04 040 155 141 143 162 23208 003235'03 201 01 0 00 000163 movei t1,"s" ;[203] Load inflection 23209 003236'03 302 04 0 00 000001 caie t4,^d1 ;[203] Singular case? 23210 003237'03 104 00 0 00 000074 PBOUT% ;[203] No, must inflect it 23211 003240'03 200 01 0 00 000000# txmsg < used, > ;[203] Continue description 23212 003241'03 104 00 0 00 000076 23213 003242'03 320 12 0 00 003243' 23214 000363'02 000000000000# 23215 001467'04 040 165 163 145 144 23216 23217 003243'03 201 01 0 00 000101 movei t1,.priou ;[203] Still going to terminal 23218 003244'03 550 02 0 00 003217* hrrz t2, mactab ;[203] Load maximum number of macros 23219 003245'03 274 02 0 00 000004 sub t2,t4 ;[203] Subtract off used 23220 003246'03 104 00 0 00 000224 NOUT% ;[203] Convert to external and display 23221 003247'03 320 12 0 00 003250' erjmpr .+1 ;[203] Catch and ignore error 23222 003250'03 200 01 0 00 000000# txmsg < available. Remaining storage: > 23223 003251'03 104 00 0 00 000076 23224 003252'03 320 12 0 00 003253' 23225 000364'02 000000000000# 23226 001471'04 040 141 166 141 151 23227 003253'03 260 17 0 00 000000* call $mchrs## ;[203] Get remaining space 23228 003254'03 200 02 0 00 000001 move t2, t1 ;[203] Load remaining characters 23229 003255'03 200 04 0 00 000001 move t4, t1 ;[203] Save a copy 23230 003256'03 201 01 0 00 000101 movei t1, .priou ;[203] This terminal 23231 003257'03 201 03 0 00 000012 movei t3, ^d10 ;[203] Base ten 23232 003260'03 104 00 0 00 000224 NOUT% ;[203] Convert to external and display 23233 003261'03 320 12 0 00 003262' erjmpr .+1 ;[203] Catch and ignore error k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 32-1 K20DSP MAC 6-Jun-23 10:31 SHOW MACRO DEFINITIONS 23234 003262'03 200 01 0 00 000000# txmsg < character> ;[203] 23235 003263'03 104 00 0 00 000076 23236 003264'03 320 12 0 00 003265' 23237 000365'02 000000000000# 23238 001500'04 040 143 150 141 162 23239 003265'03 201 01 0 00 000163 movei t1,"s" ;[203] Load inflection 23240 003266'03 302 04 0 00 000001 caie t4,^d1 ;[203] Singular case? 23241 003267'03 104 00 0 00 000074 PBOUT% ;[203] No, must inflect it 23242 txmsg < 23243 23244 Definitions: 23245 23246 003270'03 200 01 0 00 000000# > ;[203] 23247 003271'03 104 00 0 00 000076 23248 003272'03 320 12 0 00 003273' 23249 000366'02 000000000000# 23250 001503'04 015 012 015 012 104 23251 23252 003273'03 554 04 0 00 003244* hlrz t4, mactab ;[203] Reload macro table length 23253 003274'03 201 03 0 00 000001 movei t3, 1 ;[194] Point at first entry of TBLUK% tabke 23254 ;[194] Fall through to loop context 23255 003275'03 do. ;[194] Enter loop lexical context 23256 003275'03 200 01 0 00 000000# txmsg < > ;[194] Space over twice 23257 003276'03 104 00 0 00 000076 23258 003277'03 320 12 0 00 003300' 23259 000367'02 000000000000# 23260 001510'04 040 040 000 000 000 23261 003300'03 564 01 0 03 003273* hlro t1, mactab(t3) ; Point to macro name. 23262 003301'03 104 00 0 00 000076 PSOUT ; Print it. 23263 003302'03 200 01 0 00 000000# txmsg < = > 23264 003303'03 104 00 0 00 000076 23265 003304'03 320 12 0 00 003305' 23266 000370'02 000000000000# 23267 001511'04 040 075 040 000 000 23268 003305'03 560 01 0 03 003300* hrro t1, mactab(t3) ; Same deal for macro body. 23269 003306'03 104 00 0 00 000076 PSOUT 23270 003307'03 260 17 0 00 003624' call ifcrlf ;[194] See if it wants a CRLF 23271 003310'03 350 00 0 00 000003 aos t3 ; Bump TBLUK% index. 23272 003311'03 367 04 0 00 003275' sojg t4, top. ; Do for all macros in table. 23273 003312'03 enddo. ;[194] 23274 23275 003312'03 561 01 0 00 001331* hrroi t1, crlf ;[194] 23276 003313'03 104 00 0 00 000076 PSOUT% 23277 23278 003314'03 263 17 0 00 000000 $shmax: ret ;[83] Last one, always want to return. 23279 remark q1 ; Last show command always returns 23280 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 33 K20DSP MAC 6-Jun-23 10:31 ITS Phase of Moon 23281 subttl ITS Phase of Moon 23282 23283 ;[6] (this whole routine, just for fun...) 23284 ; 23285 ; This code stolen from MOON.MAC (anybody know who wrote it?). 23286 ; Just changed OUTCHR's to PBOUT%'s via a macro. - Frank. 23287 ; 23288 ; The code is from MIT and may have been named in jest after famed MIT 23289 ; hacker David A. Moon. Also, see below. - Tom. 23290 ; 23291 ;[190] Change OUTCHR macro to not store in write-protected area 23292 ;[194] Slight rework to reduce symbol table 23293 23294 003315'03 265 16 0 00 004416' moon: saveac <5,6> 23295 003316'03 403 03 0 00 000004 setzb 3,4 23296 003317'03 474 02 0 00 000000 seto 2, 23297 003320'03 104 00 0 00 000222 ODCNV% 23298 003321'03 320 16 0 00 001315* erjmp r 23299 003322'03 621 04 0 00 000077 tlz 4,77 23300 003323'03 104 00 0 00 000223 IDCNV% 23301 003324'03 320 16 0 00 003321* erjmp r ; Return upon any error. 23302 003325'03 200 01 0 00 000000# txmsg <, Moon: > ; OK so far, say what we're doing. 23303 003326'03 104 00 0 00 000076 23304 003327'03 320 12 0 00 003330' 23305 000371'02 000000000000# 23306 001512'04 054 040 115 157 157 23307 23308 ; AC2= Universal time adjusted for time zone. 23309 23310 003330'03 200 01 0 00 000002 move 1,2 ; Right place. 23311 003331'03 274 01 0 00 000000# sub 1,newmn ; Sub off base new moon 23312 003332'03 230 01 0 00 000000# idiv 1,period ; Divide by the period 23313 003333'03 230 02 0 00 000000# idiv 2,perio4 ; Get fractions of a period 23314 003334'03 317 03 0 00 000000# camg 3,perio8 ; Check for phase + or - 23315 003335'03 254 00 0 00 003342' ifskp. ;[194] ; Not more than 3+ days 23316 003336'03 274 03 0 00 000000# sub 3,perio4 ; Make it next phase -n days 23317 003337'03 306 02 0 00 000003 cain 2,3 ; Is it LQ+3D+? 23318 003340'03 634 02 0 00 000002 tdza 2,2 ; It is 23319 003341'03 340 02 0 00 000000 aoj 2, ; Increment phase 23320 003342'03 endif. 23321 23322 003342'03 510 01 0 02 000000# hllz 1,table(2) ; Get SIXBIT phase 23323 003343'03 335 00 0 00 000003 skipge 3 ; 3 < 0 then minus phase output 23324 003344'03 665 01 0 00 000015 tloa 1,'-' ; - 23325 003345'03 665 01 0 00 000013 tloa 1,'+' ; + 23326 003346'03 217 00 0 00 000003 movms 3 ; Fix mag of 3 23327 003347'03 200 02 0 00 004426' move 2,[point 6,1] ; Byte pointer 23328 003350'03 201 05 0 00 000002 movei 5,2 ; Loop 3 times 23329 23330 003351'03 do. ;[194] Enter loop context 23331 003351'03 134 04 0 00 000002 ildb 4,2 ; Get a character 23332 003352'03 271 04 0 00 000040 addi 4," " ; Make ASCII 23333 003353'03 261 17 0 00 000001 OUTCHR 4 ; Type it 23334 003354'03 200 01 0 00 000004 23335 003355'03 104 00 0 00 000074 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 33-1 K20DSP MAC 6-Jun-23 10:31 ITS Phase of Moon 23336 003356'03 320 12 0 00 003357' 23337 003357'03 262 17 0 00 000001 23338 003360'03 365 05 0 00 003351' sojge 5,top. ;[194] ; Loop 23339 003361'03 enddo. 23340 23341 003361'03 205 04 0 00 777774 movsi 4,-4 ; Make aobjn pointer 23342 23343 003362'03 do. ;[194] Enter loop context 23344 003362'03 550 02 0 04 000000# hrrz 2,table(4) ; Get a multiplier 23345 003363'03 620 02 0 00 774000 trz 2,774000 ; Strip off ascii character 23346 003364'03 221 03 0 02 000000 imuli 3,(2) ; Get the value decoded 23347 003365'03 554 01 0 00 000003 hlrz 1,3 ; Get value 23348 003366'03 621 03 0 00 777777 tlz 3,-1 ; Zap old LH 23349 003367'03 200 05 0 00 000001 move 5,1 ; Use 5 & 6 here 23350 003370'03 231 05 0 00 000012 idivi 5,12 ; Radix 10 23351 003371'03 271 05 0 00 000060 addi 5,60 ; Make ASCII 23352 003372'03 307 05 0 00 000060 caig 5,60 ;[194] Check for leading zero 23353 003373'03 254 00 0 00 003401' ifskp. ;[194] Not a leading zero 23354 003374'03 261 17 0 00 000001 OUTCHR 5 ; Type it. 23355 003375'03 200 01 0 00 000005 23356 003376'03 104 00 0 00 000074 23357 003377'03 320 12 0 00 003400' 23358 003400'03 262 17 0 00 000001 23359 003401'03 endif. ;[194] 23360 003401'03 271 06 0 00 000060 addi 6,60 ; Make ASCII 23361 003402'03 261 17 0 00 000001 OUTCHR 6 23362 003403'03 200 01 0 00 000006 23363 003404'03 104 00 0 00 000074 23364 003405'03 320 12 0 00 003406' 23365 003406'03 262 17 0 00 000001 23366 003407'03 135 05 0 00 004427' ldb 5,[point 7,table(4),24] ; Get d/h/m/s 23367 003410'03 261 17 0 00 000001 OUTCHR 5 ; Type it. 23368 003411'03 200 01 0 00 000005 23369 003412'03 104 00 0 00 000074 23370 003413'03 320 12 0 00 003414' 23371 003414'03 262 17 0 00 000001 23372 003415'03 261 17 0 00 000001 OUTCHR ["."] ; Follow with a dot. 23373 003416'03 200 01 0 00 004430' 23374 003417'03 104 00 0 00 000074 23375 003420'03 320 12 0 00 003421' 23376 003421'03 262 17 0 00 000001 23377 003422'03 253 04 0 00 003362' aobjn 4, top. ;[194] ; Loop. 23378 003423'03 enddo. ;[194] 23379 23380 003423'03 263 17 0 00 000000 ret ; Done, return. 23381 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 34 K20DSP MAC 6-Jun-23 10:31 Pure data for MOON 23382 subttl Pure data for MOON 23383 23384 ; 12:47am Monday, 1 August 2022 23385 ; 23386 ; This routine uses a lunar period of 29 days, 12 hours, 53 minutes 23387 ; and 19 seconds. 23388 ; 23389 ; After 43 years, 6 months, 3 days, 23 hours, 29 minutes and 12 23390 ; seconds, it might be of interest to see how accurate this still is; 23391 ; meaning, has the period changed (I.E., increased) to the extent 23392 ; that we are accumulating a detectable difference. 23393 ; 23394 ; Wikipedia reports that a lunation, or synodic month, is the time 23395 ; period from one new moon to the next. In the J2000. 0 epoch, the 23396 ; average length of a lunation is 29.53059 days (or 29 days, 12 hours, 23397 ; 44 minutes, and 3 seconds). That is quite a difference. 23398 ; 23399 ; And it might be irrelevant. 23400 ; 23401 ; Since Earth's orbit around the Sun is elliptical and not circular, 23402 ; the speed of Earth's progression around the Sun varies during the 23403 ; year. Thus, the angular rate is faster nearer periapsis and slower 23404 ; near apoapsis. 23405 ; 23406 ; The same is also true for the Moon's orbit around the Earth. 23407 ; Because of these variations in angular rate, the actual time between 23408 ; lunations may vary from about 29.18 to about 29.93 days. The 23409 ; average duration in modern times is 29.53059 days with up to seven 23410 ; hours variation about the mean in any given year. 23411 23412 chgsec(code,const) ;;Constants go in CONST .PSECT 23413 23414 000372'02 125575 034343 newmn: 125575,,34343 ; 28-jan-79 0120 est 23415 000035 422752 per==35,,422752 ; 29d.12h.53m.19s 23416 000373'02 000035 422752 period: per 23417 000374'02 000007 304572 perio4: per/4 23418 000375'02 000003 542275 perio8: per/10 23419 23420 000376'02 565500 144 0001 table: byte(18)'NM '(7)"d"(11)^D1 ; New moon - days - 1 23421 000377'02 466100 150 0030 byte(18)'FQ '(7)"h"(11)^D24 ; First quarter - hours - 24 23422 000400'02 465500 155 0074 byte(18)'FM '(7)"m"(11)^D60 ; Full moon - minutes - 60 23423 000401'02 546100 163 0074 byte(18)'LQ '(7)"s"(11)^D60 ; Last quarter - seconds - 60 23424 23425 retsec ;;Return to previous .PSECT 23426 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 35 K20DSP MAC 6-Jun-23 10:31 Display line performance external variables 23427 subttl Display line performance external variables 23428 23429 extern nsici ; Network SIN%'s Issued 23430 extern nsimx ; Network SIN% maximum length 23431 extern nsitc ; Network SIN% total characters 23432 extern vboct ; Virtual Terminal BOUT% Count (simulated) 23433 extern vsict ; Virtual Terminal SIN% Count (number done) 23434 extern vsimx ; Virtual Terminal SIN% Maximum length 23435 extern vsitc ; Virtual Terminal total characters SIN%'ed 23436 extern vsoct ; Virtual Terminal SOUTR%'s Issued 23437 extern vsotc ; Virtual Terminal SOUTR% Total Characters 23438 extern vsomx ; Virtual Terminal SOUTR% Maximum length 23439 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 36 K20DSP MAC 6-Jun-23 10:31 Display information concerning line performance 23440 subttl Display information concerning line performance 23441 23442 ; Previous code from TELNET used BIN%/BOUT% loops in two forks to 23443 ; input data from the terminal and display results asynchronously. In 23444 ; terms of computational overhead, using a BIN% and a BOUT% for each 23445 ; character is the most expensive way to do it. 23446 ; 23447 ; It's also a certain way to become unpopular on a heavily loaded 23448 ; system or otherwise adversely impact other activities. On the other 23449 ; hand, data can not be left in the buffer in the case of a real front 23450 ; end, as this will crash RSX20F. 23451 ; 23452 ; The code was rewritten to wait for a character and then determine 23453 ; after the read whether more data existed in the buffer. If this was 23454 ; the case, then the remaining data was read. This also occurs on 23455 ; output. A Virtual BOUT% in this case is a SOUTR% of one character 23456 ; to get it pushed over the network. 23457 23458 003424'03 265 16 0 00 004240' disper: saveac ; Not called with anything, doesn't touch AC's 23459 23460 remark ; transmission fork keep these 23461 003425'03 336 00 0 00 002016* ifmn. vbict 23462 003426'03 254 00 0 00 003437' 23463 txmsg < 23464 003427'03 200 01 0 00 000000# Terminal BIN%'s: > 23465 003430'03 104 00 0 00 000076 23466 003431'03 320 12 0 00 003432' 23467 000402'02 000000000000# 23468 001514'04 015 012 040 040 124 23469 003432'03 201 01 0 00 000101 numout vbict ; Virtual Terminal BIN% Count 23470 003433'03 200 02 0 00 003425* 23471 003434'03 201 03 0 00 000012 23472 003435'03 104 00 0 00 000224 23473 003436'03 320 14 0 00 003437' 23474 003437'03 endif. 23475 003437'03 336 00 0 00 000000* ifmn. vchrcn 23476 003440'03 254 00 0 00 003451' 23477 txmsg < 23478 003441'03 200 01 0 00 000000# Virtual CFIBF%'s: > 23479 003442'03 104 00 0 00 000076 23480 003443'03 320 12 0 00 003444' 23481 000403'02 000000000000# 23482 001521'04 015 012 040 040 126 23483 003444'03 201 01 0 00 000101 numout vchrcn ; Virtual CHaRcters flushed CouNt 23484 003445'03 200 02 0 00 003437* 23485 003446'03 201 03 0 00 000012 23486 003447'03 104 00 0 00 000224 23487 003450'03 320 14 0 00 003451' 23488 003451'03 endif. 23489 003451'03 336 00 0 00 000000* ifmn. inpcbf 23490 003452'03 254 00 0 00 003463' 23491 txmsg < 23492 003453'03 200 01 0 00 000000# Buffer CFIBF%'s: > 23493 003454'03 104 00 0 00 000076 23494 003455'03 320 12 0 00 003456' k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 36-1 K20DSP MAC 6-Jun-23 10:31 Display information concerning line performance 23495 000404'02 000000000000# 23496 001526'04 015 012 040 040 040 23497 003456'03 201 01 0 00 000101 numout inpcbf ; INPUT network Buffer characters flushed 23498 003457'03 200 02 0 00 003451* 23499 003460'03 201 03 0 00 000012 23500 003461'03 104 00 0 00 000224 23501 003462'03 320 14 0 00 003463' 23502 003463'03 endif. 23503 003463'03 336 00 0 00 000000* ifmn. vboct 23504 003464'03 254 00 0 00 003475' 23505 txmsg < 23506 003465'03 200 01 0 00 000000# Virtual BOUT%'s: > 23507 003466'03 104 00 0 00 000076 23508 003467'03 320 12 0 00 003470' 23509 000405'02 000000000000# 23510 001533'04 015 012 040 040 126 23511 003470'03 201 01 0 00 000101 numout vboct ; Virtual Terminal BOUT% Count (simulated) 23512 003471'03 200 02 0 00 003463* 23513 003472'03 201 03 0 00 000012 23514 003473'03 104 00 0 00 000224 23515 003474'03 320 14 0 00 003475' 23516 003475'03 endif. 23517 003475'03 336 00 0 00 000000* ifmn. vsict 23518 003476'03 254 00 0 00 003527' 23519 txmsg < 23520 003477'03 200 01 0 00 000000# SIN%'s Issued: > 23521 003500'03 104 00 0 00 000076 23522 003501'03 320 12 0 00 003502' 23523 000406'02 000000000000# 23524 001540'04 015 012 040 040 123 23525 003502'03 201 01 0 00 000101 numout vsict ; Virtual Terminal SIN% Count 23526 003503'03 200 02 0 00 003475* 23527 003504'03 201 03 0 00 000012 23528 003505'03 104 00 0 00 000224 23529 003506'03 320 14 0 00 003507' 23530 txmsg < 23531 003507'03 200 01 0 00 000000# SIN% Bytes Total: > 23532 003510'03 104 00 0 00 000076 23533 003511'03 320 12 0 00 003512' 23534 000407'02 000000000000# 23535 001545'04 015 012 040 040 123 23536 003512'03 201 01 0 00 000101 numout vsitc ; Virtual Terminal total characters SIN%'ed 23537 003513'03 200 02 0 00 000000* 23538 003514'03 201 03 0 00 000012 23539 003515'03 104 00 0 00 000224 23540 003516'03 320 14 0 00 003517' 23541 txmsg < 23542 003517'03 200 01 0 00 000000# Max SIN% Length: > 23543 003520'03 104 00 0 00 000076 23544 003521'03 320 12 0 00 003522' 23545 000410'02 000000000000# 23546 001552'04 015 012 040 040 115 23547 003522'03 201 01 0 00 000101 numout vsimx ; Maximum length SIN% ever did 23548 003523'03 200 02 0 00 000000* 23549 003524'03 201 03 0 00 000012 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 36-2 K20DSP MAC 6-Jun-23 10:31 Display information concerning line performance 23550 003525'03 104 00 0 00 000224 23551 003526'03 320 14 0 00 003527' 23552 003527'03 endif. 23553 23554 003527'03 336 00 0 00 000000* ifmn. vsoct 23555 003530'03 254 00 0 00 003561' 23556 txmsg < 23557 003531'03 200 01 0 00 000000# SOUTR%'s Issued: > 23558 003532'03 104 00 0 00 000076 23559 003533'03 320 12 0 00 003534' 23560 000411'02 000000000000# 23561 001557'04 015 012 040 040 123 23562 003534'03 201 01 0 00 000101 numout vsoct ; Virtual Terminal SOUTR% Count 23563 003535'03 200 02 0 00 003527* 23564 003536'03 201 03 0 00 000012 23565 003537'03 104 00 0 00 000224 23566 003540'03 320 14 0 00 003541' 23567 txmsg < 23568 003541'03 200 01 0 00 000000# SOUTR% Bytes: > 23569 003542'03 104 00 0 00 000076 23570 003543'03 320 12 0 00 003544' 23571 000412'02 000000000000# 23572 001564'04 015 012 040 040 123 23573 003544'03 201 01 0 00 000101 numout vsotc ; Virtual Terminal SOUTR% Bytes Total 23574 003545'03 200 02 0 00 000000* 23575 003546'03 201 03 0 00 000012 23576 003547'03 104 00 0 00 000224 23577 003550'03 320 14 0 00 003551' 23578 txmsg < 23579 003551'03 200 01 0 00 000000# Max SOUTR% Len: > 23580 003552'03 104 00 0 00 000076 23581 003553'03 320 12 0 00 003554' 23582 000413'02 000000000000# 23583 001571'04 015 012 040 040 115 23584 003554'03 201 01 0 00 000101 numout vsomx ; Virtual Terminal SOUTR% Maximum length 23585 003555'03 200 02 0 00 000000* 23586 003556'03 201 03 0 00 000012 23587 003557'03 104 00 0 00 000224 23588 003560'03 320 14 0 00 003561' 23589 003561'03 endif. 23590 23591 remark ; Network input fork updates these 23592 003561'03 336 00 0 00 002017* ifmn. nbict ; Did any network input? 23593 003562'03 254 00 0 00 003623' 23594 txmsg < 23595 003563'03 200 01 0 00 000000# Network BIN%'s: > 23596 003564'03 104 00 0 00 000076 23597 003565'03 320 12 0 00 003566' 23598 000414'02 000000000000# 23599 001576'04 015 012 040 040 116 23600 003566'03 201 01 0 00 000101 numout nbict ; Network BIN% count 23601 003567'03 200 02 0 00 003561* 23602 003570'03 201 03 0 00 000012 23603 003571'03 104 00 0 00 000224 23604 003572'03 320 14 0 00 003573' k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 36-3 K20DSP MAC 6-Jun-23 10:31 Display information concerning line performance 23605 txmsg < 23606 003573'03 200 01 0 00 000000# Network SIN%'s: > 23607 003574'03 104 00 0 00 000076 23608 003575'03 320 12 0 00 003576' 23609 000415'02 000000000000# 23610 001603'04 015 012 040 040 116 23611 003576'03 201 01 0 00 000101 numout nsici ; Network SIN%'s Issued 23612 003577'03 200 02 0 00 000000* 23613 003600'03 201 03 0 00 000012 23614 003601'03 104 00 0 00 000224 23615 003602'03 320 14 0 00 003603' 23616 txmsg < 23617 003603'03 200 01 0 00 000000# Network SIN% Cnt: > 23618 003604'03 104 00 0 00 000076 23619 003605'03 320 12 0 00 003606' 23620 000416'02 000000000000# 23621 001610'04 015 012 040 040 116 23622 003606'03 201 01 0 00 000101 numout nsitc ; Network SIN% total characters 23623 003607'03 200 02 0 00 000000* 23624 003610'03 201 03 0 00 000012 23625 003611'03 104 00 0 00 000224 23626 003612'03 320 14 0 00 003613' 23627 txmsg < 23628 003613'03 200 01 0 00 000000# Network SIN% Max: > 23629 003614'03 104 00 0 00 000076 23630 003615'03 320 12 0 00 003616' 23631 000417'02 000000000000# 23632 001615'04 015 012 040 040 116 23633 003616'03 201 01 0 00 000101 numout nsimx ; Network SIN% maximum length 23634 003617'03 200 02 0 00 000000* 23635 003620'03 201 03 0 00 000012 23636 003621'03 104 00 0 00 000224 23637 003622'03 320 14 0 00 003623' 23638 003623'03 endif. 23639 23640 003623'03 263 17 0 00 000000 ret 23641 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 37 K20DSP MAC 6-Jun-23 10:31 ifcrlf -- maybe type a carriage return line feed 23642 subttl ifcrlf -- maybe type a carriage return line feed 23643 23644 ; Call: t1/ Updated point of PSOUT%'ed macro body 23645 ; 23646 ; [194] fixed a case of a macro not being terminated with a carriage 23647 ; return. This is unlikely, but could happen. That being the 23648 ; the case, when displaying the macros, we now have to check to 23649 ; see if we need to print a crlf. 23650 23651 003624'03 ifcrlf: entry ifcrlf ; Inform LINK of our location 23652 remark t1, t2 ; Smashes these 23653 003624'03 265 16 0 00 004431' saveac ; Holds counter and pointers!! 23654 ; Last three characters should be 23655 remark .chcrt, .chlfd, .chnul 23656 003625'03 211 02 0 00 000003 movni t2, ^d3 ; Check the end of the macro string 23657 003626'03 133 02 0 00 000001 adjbp t2, t1 ; May not have a CRLF ... 23658 003627'03 134 03 0 00 000002 ildb t3, t2 ; Pick up penultimate character 23659 003630'03 134 04 0 00 000002 ildb t4, t2 ; Pick up last character 23660 23661 003631'03 306 03 0 00 000015 cain t3, .chcrt ; Did they tie off the line? 23662 003632'03 254 00 0 00 003637' ifskp. ; Apparently not 23663 003633'03 306 04 0 00 000015 cain t4, .chcrt ; Unless they did it backwards 23664 003634'03 254 00 0 00 003637' anskp. ; Odd, but be happy... 23665 003635'03 201 01 0 00 000015 movei t1, .chcrt ; Otherwise, do the carriage return 23666 003636'03 104 00 0 00 000074 PBOUT% 23667 003637'03 endif. 23668 23669 003637'03 306 04 0 00 000012 cain t4, .chlfd ; Did they scroll the carriage? 23670 003640'03 254 00 0 00 003645' ifskp. ; Perhaps not 23671 003641'03 306 03 0 00 000012 cain t3, .chlfd ; Unless they did it backwards 23672 003642'03 254 00 0 00 003645' anskp. ; Odd, but be happy ... 23673 003643'03 201 01 0 00 000012 movei t1, .chlfd ; Otherwise, do the line feed 23674 003644'03 104 00 0 00 000074 PBOUT% 23675 003645'03 endif. 23676 23677 003645'03 263 17 0 00 000000 ret 23678 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 38 K20DSP MAC 6-Jun-23 10:31 PUTC -- Print a single character, using ^X notation, DEL, etc. 23679 subttl PUTC -- Print a single character, using ^X notation, DEL, etc. 23680 23681 ; Call with t1/ character to print. 23682 ; 23683 ;[223] Modifies no registers 23684 23685 003646'03 putc: entry putc ;[194] Inform LINK of our location 23686 003646'03 261 17 0 00 000001 push p, t1 ;[223] Save the character 23687 003647'03 405 01 0 00 000177 andi t1, ^o177 ;[223] Stomp the parity 23688 23689 003650'03 302 01 0 00 000177 caie t1, .chdel ;[194] A rubout? 23690 003651'03 254 00 0 00 003661' ifskp. ;[194] It is 23691 003652'03 261 17 0 00 000002 push p, t2 ;[194] Don't bump into anything 23692 003653'03 200 01 0 00 000000# txmsg ;[194] type this 23693 003654'03 104 00 0 00 000076 23694 003655'03 320 12 0 00 003656' 23695 000420'02 000000000000# 23696 001622'04 104 105 114 000 000 23697 003656'03 262 17 0 00 000002 pop p, t2 ;[194] Restore in case somebody cared 23698 003657'03 262 17 0 00 000001 pop p, t1 ;[223] Restore the original character 23699 003660'03 263 17 0 00 000000 ret 23700 003661'03 endif. ;[194] 23701 23702 003661'03 301 01 0 00 000040 cail t1, .chspc ;[194] Is it a control char? 23703 003662'03 254 00 0 00 003670' ifskp. ;[194] It is 23704 003663'03 261 17 0 00 000001 push p, t1 ; Save the char. 23705 003664'03 201 01 0 00 000136 movei t1, "^" ; Get the control quote. 23706 003665'03 104 00 0 00 000074 PBOUT% 23707 003666'03 262 17 0 00 000001 pop p, t1 23708 003667'03 435 01 0 00 000100 ori t1, ^o100 ; Turn on the non-control bit. 23709 003670'03 endif. ;[194] 23710 23711 003670'03 104 00 0 00 000074 PBOUT% 23712 003671'03 262 17 0 00 000001 pop p, t1 ;[223] Restore the original character 23713 003672'03 263 17 0 00 000000 ret 23714 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 39 K20DSP MAC 6-Jun-23 10:31 show a line's characteristics 23715 subttl show a line's characteristics 23716 23717 ; Says some interesting things about the line that is passed in t1 23718 ; 23719 ; Such information does not effect the protocol, per se. It is rather 23720 ; used for debugging and as part of a heuristic as to what kind of 23721 ; performance could be expected. As there are a rather large number 23722 ; of other factors that can impact performance, what is displayed can 23723 ; in no way be assumed to be determinative. 23724 ; 23725 ; All part of 186, plus some 223 flavoring 23726 23727 ;[223] Line type names 23728 23729 chgsec(code,const) ;[223] Table goes in const psect 23730 000421'02 000000000000# ltname: cascii() ;[223] NW%UND Undefined 23731 001623'04 125 156 144 145 146 23732 000422'02 000000000000# cascii() ;[223] NW%FW Front end (RSX-20F) 23733 001625'04 106 105 000 000 000 23734 000423'02 000000000000# cascii() ;[223] NW%PT Pseudo-terminal 23735 001626'04 120 124 131 000 000 23736 000424'02 000000000000# cascii() ;[223] NW%MC Network Remote Terminal (MCB) 23737 001627'04 116 122 124 000 000 23738 000425'02 000000000000# Cascii() ;[223] NW%TV Telnet Virtual Terminal 23739 001630'04 124 126 124 000 000 23740 000426'02 000000000000# cascii() ;[223] NW%CH CTERM 23741 001631'04 103 124 105 122 115 23742 000427'02 000000000000# cascii() ;[223] NW%LH Local Area Terminal 23743 001633'04 114 101 124 000 000 23744 000430'02 ltneot: remark ;[223] Mark end of table 23745 000007 nw%mx== ;[223] Maximum type 23746 retsec ;[223] Back into code 23747 cleans() ;[223] 23748 23749 ; Call: 23750 ; 23751 ; t1/ Network Type 23752 ; t2/ Line Type 23753 ; t3/ Line number 23754 23755 extern lclpar ;[223] Whether local line will do parity 23756 extern opnpar ;[223] Whether open device will do parity 23757 23758 003673'03 265 16 0 00 004441' linchr: saveac 23759 ;[223] Does not overwrite any register 23760 003674'03 200 05 0 00 000003 move q1, t3 ;[223] Save line number 23761 003675'03 301 02 0 00 000000 cail t2, 0 ;[223] Negative line type? 23762 003676'03 301 02 0 00 000007 cail t2, nw%mx ;[223] or over the maximum? 23763 003677'03 400 02 0 00 000000 setz t2, ;[223] Yes to either, reset to NW%UND 23764 003700'03 120 06 0 00 000001 dmove q2, t1 ;[223] Store network and line type 23765 23766 003701'03 326 07 0 00 003712' ife. q3 ;[223] Undefined line type? (NW%UND) 23767 txmsg < 23768 003702'03 200 01 0 00 000000# Unknown Line: > ; So do error blat 23769 003703'03 104 00 0 00 000076 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 39-1 K20DSP MAC 6-Jun-23 10:31 show a line's characteristics 23770 003704'03 320 12 0 00 003705' 23771 000430'02 000000000000# 23772 001634'04 015 012 040 125 156 23773 003705'03 201 01 0 00 000101 numout q1, ^d8 ; Type whatever we did get passed 23774 003706'03 200 02 0 00 000005 23775 003707'03 201 03 0 00 000010 23776 003710'03 104 00 0 00 000224 23777 003711'03 320 14 0 00 003712' 23778 003712'03 endif. ;[223] Try the rest of it 23779 23780 txmsg < 23781 003712'03 200 01 0 00 000000# Controlling Type: > 23782 003713'03 104 00 0 00 000076 23783 003714'03 320 12 0 00 003715' 23784 000431'02 000000000000# 23785 001641'04 015 012 040 040 103 23786 003715'03 200 01 0 07 000000# move t1, ltname(q3) ;[223] Pick up address of the correct string 23787 003716'03 104 00 0 00 000076 PSOUT% ;[223] And type it 23788 003717'03 320 12 0 00 003720' erjmpr .+1 23789 23790 003720'03 200 04 0 00 000000* move t4, lclpar ;[223] Assume we're doing the controlling terminal 23791 003721'03 312 05 0 00 001521* came q1, mytty ;[223] BUT!! Is this the controlling terminal? 23792 003722'03 200 04 0 00 000000* move t4, opnpar ;[223] Parity tolerated will be set by k20net 23793 003723'03 322 04 0 00 003727' ifn. t4 ;[223] So, does the thing do parity? 23794 003724'03 200 01 0 00 000000# txmsg < [Parity]> ;[223] Yes, somebody will generate it, if asked 23795 003725'03 104 00 0 00 000076 23796 003726'03 320 12 0 00 003727' 23797 000432'02 000000000000# 23798 001646'04 040 133 120 141 162 23799 003727'03 endif. ;[223] Otherwise, nothing to say 23800 23801 003727'03 260 17 0 00 001052' call prntbd ;[210] Print some kind of baud rate maybe 23802 23803 003730'03 302 07 0 00 000004 caie q3, nw%tv ;[223] A TCP Virtual Terminal (TVT)? 23804 003731'03 254 00 0 00 003762' ifskp. ;[223] Yes, then let's display those specifics 23805 txmsg < 23806 003732'03 200 01 0 00 000000# TVT Binary: > ;[129] ARPAnet TVT binary mode. 23807 003733'03 104 00 0 00 000076 23808 003734'03 320 12 0 00 003735' 23809 000433'02 000000000000# 23810 001650'04 015 012 040 040 124 23811 003735'03 332 00 0 00 000000* ifme. tvtflg 23812 003736'03 254 00 0 00 003743' 23813 003737'03 200 01 0 00 000000# txmsg 23814 003740'03 104 00 0 00 000076 23815 003741'03 320 12 0 00 003742' 23816 000434'02 000000000000# 23817 001655'04 117 146 146 000 000 23818 003742'03 254 00 0 00 003746' else. 23819 003743'03 200 01 0 00 000000# txmsg 23820 003744'03 104 00 0 00 000076 23821 003745'03 320 12 0 00 003746' 23822 000435'02 000000000000# 23823 001656'04 117 156 000 000 000 23824 003746'03 endif. k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 39-2 K20DSP MAC 6-Jun-23 10:31 show a line's characteristics 23825 txmsg < 23826 003746'03 200 01 0 00 000000# TVT Negotiate: > ;[182] ARPAnet TVT discovery 23827 003747'03 104 00 0 00 000076 23828 003750'03 320 12 0 00 003751' 23829 000436'02 000000000000# 23830 001657'04 015 012 040 040 124 23831 003751'03 332 00 0 00 000000* ifme. tvtchk 23832 003752'03 254 00 0 00 003757' 23833 003753'03 200 01 0 00 000000# txmsg 23834 003754'03 104 00 0 00 000076 23835 003755'03 320 12 0 00 003756' 23836 000437'02 000000000000# 23837 001664'04 117 166 145 162 162 23838 003756'03 254 00 0 00 003762' else. 23839 003757'03 200 01 0 00 000000# txmsg 23840 003760'03 104 00 0 00 000076 23841 003761'03 320 12 0 00 003762' 23842 000440'02 000000000000# 23843 001666'04 101 165 164 157 155 23844 003762'03 endif. 23845 003762'03 endif. ;[223] End case TCP Virtual Terminal? 23846 23847 003762'03 200 01 0 00 000005 move t1, q1 ; Load line number 23848 003763'03 660 01 0 00 400000 txo t1, .ttdes ; Turn into a terminal designator (if not already one) 23849 003764'03 104 00 0 00 000303 GTTYP% ; Odd that buffers are returned here... 23850 003765'03 320 12 0 00 003767' %jsErr (,r) 23851 003766'03 254 00 0 00 003772' 23852 003767'03 265 01 0 00 002307* 23853 003770'03 000000000000# 23854 003771'03 254 00 0 00 003324* 23855 001670'04 125 156 141 142 154 23856 003772'03 200 04 0 00 000003 move t4, t3 ; Get the buffer counts out of the way 23857 23858 txmsg < 23859 003773'03 200 01 0 00 000000# Input Buffers: > ; Present the input buffer count 23860 003774'03 104 00 0 00 000076 23861 003775'03 320 12 0 00 003776' 23862 000441'02 000000000000# 23863 001700'04 015 012 040 040 111 23864 003776'03 201 01 0 00 000101 movei t1, .priou ; On the terminal 23865 003777'03 554 02 0 00 000004 hlrz t2, t4 ; Load input buffer count 23866 004000'03 201 03 0 00 000012 movei t3, ^d10 ; Is in base ten 23867 004001'03 104 00 0 00 000224 NOUT% 23868 004002'03 320 12 0 00 004004' %jsErr (,) 23869 004003'03 254 00 0 00 004007' 23870 004004'03 265 01 0 00 003767* 23871 004005'03 000000000000# 23872 004006'03 254 00 0 00 004007' 23873 001705'04 125 156 141 142 154 23874 23875 txmsg < 23876 004007'03 200 01 0 00 000000# Output Buffers: > ; Present the output buffer count 23877 004010'03 104 00 0 00 000076 23878 004011'03 320 12 0 00 004012' 23879 000442'02 000000000000# k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 39-3 K20DSP MAC 6-Jun-23 10:31 show a line's characteristics 23880 001717'04 015 012 040 040 117 23881 004012'03 201 01 0 00 000101 movei t1, .priou ; On the terminal 23882 004013'03 550 02 0 00 000004 hrrz t2,t4 ; Load output buffer count 23883 004014'03 201 03 0 00 000012 movei t3, ^d10 ; Is in base ten 23884 004015'03 104 00 0 00 000224 NOUT% 23885 004016'03 320 12 0 00 004020' %jsErr (,) 23886 004017'03 254 00 0 00 004023' 23887 004020'03 265 01 0 00 004004* 23888 004021'03 000000000000# 23889 004022'03 254 00 0 00 004023' 23890 001724'04 125 156 141 142 154 23891 23892 004023'03 263 17 0 00 000000 ret 23893 23894 cleans() 23895 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 40 K20DSP MAC 6-Jun-23 10:31 Print Efficiency Factor 23896 subttl Print Efficiency Factor 23897 23898 ; Overhead calculations 23899 ; 23900 ; T1/ Output JFN or pointer, sacred 23901 ; T2/ Total characters in file(s) 23902 ; T3/ Total characters transferred, every single one 23903 ; 23904 ; In other words, t3 has what was necessary to communicate t2 23905 ; 23906 ; A factor over 1, how much compression is winning you 23907 ; under 1, how much the prefixing is costing you 23908 ; 23909 ; Describe various totals kept for $stat 23910 ; 23911 ; stot - total characters sent, including everything 23912 ; stchr - total characters all files 23913 ; rtot - total characters received, every single one of them 23914 ; rtchr - total characters all files 23915 ; 23916 ; Question, do we really need DOUBLE floating point? fltr will 'only' 23917 ; lose precision for a communications or combined file character total 23918 ; that is greater than 134,217,728 (2**27). 23919 ; 23920 ; This would be a file in excess of 52,429 pages, which is over 2/3's 23921 ; of an RP06. Even if some transfers happened over weekends, it is 23922 ; doubtful that this much data could have been sent--it was more 23923 ; common to just send a magnetic tape. Besides, disk space was 23924 ; EXPENSIVE. If you could afford the platters, you could certainly 23925 ; afford the cost of a tape, the tape mount, the mount time and the 23926 ; postage. 23927 ; 23928 ; Disk space is now effectively free, most structures being double 23929 ; RP07's, having a (then) gargantuan storage capability of over a 23930 ; gigabyte of ASCII text. However, since Kermit speeds are now in 23931 ; the megabyte range, a transfer of multiple large files could 23932 ; exceed 35 bit integer precision. This is certainly possibly if 23933 ; you are using your 20 to store .jpeg's or digital audio. 23934 23935 extern dfloat ; In k20sub (originally from eftpsa) 23936 23937 004024'03 265 16 0 00 004351' peffif: saveac ; Don't touch other temporaries 23938 ; First handle some simple cases 23939 004025'03 327 02 0 00 004031' ifle. t2 ; Is this a zero length file (or balony?) 23940 004026'03 120 02 0 00 000000# smsg <[100% Overhead]> ;Make it stand out 23941 004027'03 260 17 0 00 001050* 23942 000443'02 000000000000# 23943 000444'02 777777 777761 23944 001736'04 133 061 060 060 045 23945 004030'03 263 17 0 00 000000 ret ; That was easy ... 23946 004031'03 endif. 23947 ; Have a non-zero length file here? 23948 004031'03 326 03 0 00 004035' ife. t3 ; Zero length file (like NUL:)? 23949 004032'03 120 02 0 00 000000# smsg <[ZERO]> ; Make it stand out 23950 004033'03 260 17 0 00 004027* k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 40-1 K20DSP MAC 6-Jun-23 10:31 Print Efficiency Factor 23951 000445'02 000000000000# 23952 000446'02 777777 777772 23953 001742'04 133 132 105 122 117 23954 004034'03 263 17 0 00 000000 ret ; That was easy ... 23955 004035'03 endif. 23956 23957 004035'03 325 03 0 00 004041' ifl. t3 ; Impossible communications count? 23958 004036'03 120 02 0 00 000000# smsg <[ERROR]> ; Make it stand out 23959 004037'03 260 17 0 00 004033* 23960 000447'02 000000000000# 23961 000450'02 777777 777771 23962 001744'04 133 105 122 122 117 23963 004040'03 263 17 0 00 000000 ret ; That was easy ... 23964 004041'03 endif. 23965 ; Guess we have some real work to do 23966 004041'03 415 16 0 00 004063' block. ; Set up a stack frame for easier return 23967 004042'03 261 17 0 00 000016 23968 004043'03 265 16 0 00 004457' saveac ; Preserve some more registers 23969 remark t1,t2,t3,t4,t5 ; Can use these for this block 23970 004044'03 200 05 0 00 000002 move t5, t2 ; Save total characters in files 23971 004045'03 400 01 0 00 000000 setz t1, ; No integer high order 23972 004046'03 200 02 0 00 000003 move t2, t3 ; Load total characters communicated 23973 004047'03 260 17 0 00 001027* call dfloat ; Double float the double integer 23974 004050'03 263 17 0 00 000000 ret ; But couldn't 23975 004051'03 250 02 0 00 000005 exch t2, t5 ; Store floating low order and restore 23976 004052'03 200 04 0 00 000001 move t4, t1 ; Store floating high order 23977 004053'03 400 01 0 00 000000 setz t1, ; No integer high order 23978 004054'03 260 17 0 00 004047* call dfloat ; Double float the double integer 23979 004055'03 263 17 0 00 000000 ret ; But couldn't 23980 004056'03 200 03 0 00 000002 move t3, t2 ; Reposition low order 23981 004057'03 200 02 0 00 000001 move t2, t1 ; Reposition high order 23982 004060'03 113 02 0 00 000004 dfdv t2,t4 ; Divide extremely slowly 23983 004061'03 254 00 0 00 001434* retskp ; Win 23984 004062'03 263 17 0 00 000000 endbk. ; End block context, restore registers 23985 004063'03 263 17 0 00 000000 ret ; Passing any error up 23986 23987 004064'03 200 04 0 00 000000# peffi0: move t4,fmcntl ; Load format control 23988 004065'03 104 00 0 00 000235 DFOUT% ; Show us a nice number 23989 004066'03 320 14 0 00 004067' erjmps .+1 ; Don't touch precious t1!! 23990 23991 004067'03 316 04 0 00 000000# camn t4,fmcntl ; Overwritten with error? 23992 004070'03 263 17 0 00 000000 ret ; Nope, we're fine 23993 004071'03 334 00 0 00 000000 %ermsg (,r) 23994 004072'03 254 00 0 00 004076' 23995 004073'03 265 01 0 00 004020* 23996 004074'03 000000000000# 23997 004075'03 254 00 0 00 003771* 23998 001746'04 125 156 141 142 154 23999 004076'03 263 17 0 00 000000 ret ; Finally done 24000 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 41 K20DSP MAC 6-Jun-23 10:31 Define hairy DFOUT% control word 24001 subttl Define hairy DFOUT% control word 24002 24003 000000 fmcntw==0 ; Initialize format control word 24004 24005 define blcntl (value,field,format) < 24006 ifnb , 24007 ifb , 24008 > 24009 24010 blcntl(.fldig,fl%sgn) ;;Sign control is start with a digit 24011 blcntl(.fllsp,fl%jus) ;;Justification is leading spaces 24012 blcntl(fl%one) ;;Output at least one digit, even if zero 24013 blcntl(fl%pnt) ;;Always print a decimal point 24014 blcntl(.flexn,fl%exp) ;;No exponent (too confusing) 24015 blcntl(fl%ovl) ;;Output any overflow 24016 blcntl(-1,fl%rnd) ;;Don't do any rounding 24017 blcntl(^d4,fl%fst) ;;Allow 9,999 improvement 24018 blcntl(^d4,fl%snd) ;;Allow .0001 degradation 24019 24020 chgsec(code,const) ;;This is a constant 24021 000451'02 024137 040400 fmcntl: fmcntw ; Final control word 24022 retsec ;;Back to previous .PSECT 24023 24024 if2 < purge blcntl > ;;Not needed after pass 2 24025 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 42 K20DSP MAC 6-Jun-23 10:31 Calculate Giga, Mega, Kilo character rate 24026 subttl Calculate Giga, Mega, Kilo character rate 24027 24028 ; Uses double floating point to print a more readable, accurate byte rate. 24029 ; 24030 ; t3/ Total characters sent or received 24031 ; 24032 ; +1 - Some odd thing happened 24033 ; +2 - The math worked, at least 24034 24035 004077'03 gmkcps: extern dblcal ; Found with other math routines in k20tim 24036 004077'03 265 16 0 00 004471' saveac ; Need some more scratch 24037 24038 004100'03 415 16 0 00 004111' block. ;[207] Enter block context for better control flow 24039 004101'03 261 17 0 00 000016 24040 004102'03 265 16 0 00 004252' saveac ;[207] Used for DK10 double word 24041 004103'03 201 05 0 00 000471* movei q1, ewallt ;[207] Construct pointer to elapsed wall time 24042 004104'03 201 02 0 05 000017 movei t2, .datus(q1) ;[207] Load pointer to DK10 double word 24043 004105'03 120 03 0 02 000000 dmove t3, (t2) ;[207] Load DK10 tick wall time 24044 004106'03 327 03 0 00 004061* jumpg t3, RSKP ;[207] Non-zero high order is OK 24045 004107'03 327 04 0 00 004106* jumpg t4, RSKP ;[207] Ditto low order 24046 004110'03 263 17 0 00 000000 endbk. ;[207] End block context, restore registers 24047 004111'03 263 17 0 00 000000 ret ;[207] Zero ticks?? Uh, forget it 24048 004112'03 260 17 0 00 000000* call dblcal ; Calculate double floating character rate 24049 004113'03 263 17 0 00 000000 ret ; Failed 24050 004114'03 260 17 0 00 004145' call ranger ; Put result into kilo, mega or giga range 24051 004115'03 260 17 0 00 004064' call peffi0 ; Type it 24052 004116'03 260 17 0 00 004201' call chrsfx ; Puts in the right character suffix 24053 24054 004117'03 254 00 0 00 004107* retskp ; Worked!! 24055 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 43 K20DSP MAC 6-Jun-23 10:31 Calculate Giga, Mega, Kilo baud rate 24056 subttl Calculate Giga, Mega, Kilo baud rate 24057 24058 ; Uses double floating point to print a more readable, accurate byte rate. 24059 ; 24060 ; t3/ Total characters sent or received 24061 24062 ; t4/ High order floating point bit rate (unranged) 24063 ; t5/ Low order, ditto 24064 24065 004120'03 204500 000000 baud: exp 10. ; Assume ten bits per character 24066 004121'03 000000 000000 0 ; Which is not valid for 110 baud 24067 24068 004122'03 gmkbps: extern dblcal ; Found with math routines in k20sub 24069 004122'03 265 16 0 00 004471' saveac ; Need some more scratch 24070 24071 004123'03 415 16 0 00 004133' block. ;[207] Enter block context for better control flow 24072 004124'03 261 17 0 00 000016 24073 004125'03 265 16 0 00 004431' saveac ;[207] Used for DK10 double word 24074 004126'03 201 02 0 00 000000# movei t2,.datus+ewallt;[207] Construct pointer to elapsed DK10 tick wall time 24075 004127'03 120 03 0 02 000000 dmove t3, (t2) ;[207] Load DK10 tick wall time 24076 004130'03 327 03 0 00 004117* jumpg t3, RSKP ;[207] Non-zero high order is OK 24077 004131'03 327 04 0 00 004130* jumpg t4, RSKP ;[207] Ditto low order 24078 004132'03 263 17 0 00 000000 endbk. ;[207] End block context, restore registers 24079 004133'03 263 17 0 00 000000 ret ;[207] Zero ticks?? Uh, forget it 24080 24081 004134'03 260 17 0 00 004112* call dblcal ; Calculate double floating character rate 24082 004135'03 263 17 0 00 000000 ret ; Failed 24083 004136'03 112 04 0 00 004120' dfmp t4, baud ; Scale to baud rate 24084 24085 004137'03 gmkbp1: remark ; Common exit epilogue 24086 004137'03 260 17 0 00 004145' call ranger ; Put result into kilo, mega or giga range 24087 004140'03 260 17 0 00 004064' call peffi0 ; Type it 24088 004141'03 260 17 0 00 004211' call baudsf ; Puts in the right suffix 24089 24090 004142'03 263 17 0 00 000000 ret 24091 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 44 K20DSP MAC 6-Jun-23 10:31 Put result into kilo, mega, giga or tera range 24092 subttl Put result into kilo, mega, giga or tera range 24093 24094 ; Call: 24095 ; 24096 ; t1/ Output designator, unused, but preserved, anyway 24097 ; t4/ High order floating point bit rate (unranged) 24098 ; t5/ Low order, ditto 24099 ; 24100 ; Returns: +1, always 24101 ; 24102 ; t1/ Unmodified output designator 24103 ; t2/ High order, possibly ranged 24104 ; t3/ Low order, ditto 24105 ; t5/ Rate prefix (K, M, G, T), if any 24106 ; 24107 ; N.B., Since we are checking for less than 1,024 in the high 24108 ; order. It is unnecessary to compare the low order word, 24109 ; so we can bum a DCAM. 24110 ; 24111 ; A 'T' prefix means terabaud and is probably either wrong or 24112 ; otherwise delusional in some way. It should be doubted. 24113 24114 004143'03 213400 000000 kilo: 1024. ; Used for ranging (floating!!!) 24115 004144'03 000000 000000 0 ; Also used as double floating divisor 24116 24117 004145'03 265 16 0 00 004340' ranger: saveac ; Let's just leave that alone 24118 004146'03 311 04 0 00 004143' caml t4,kilo ; Into kilobaud already?? 24119 004147'03 254 00 0 00 004153' ifskp. ; Nope, not even, so not much to do, then 24120 004150'03 120 02 0 00 000004 dmove t2,t4 ; Load puny hundreds of baud rate (yech) 24121 004151'03 400 05 0 00 000000 setz t5, ; Not even a prefix character, sniff 24122 004152'03 263 17 0 00 000000 ret ; Well, that was easy 24123 004153'03 endif. ; Otherwise, at least in kilobaud 24124 24125 004153'03 113 04 0 00 004143' dfdv t4,kilo ; Reduce by ten orders of binary magnitude 24126 004154'03 311 04 0 00 004143' caml t4,kilo ; Into Megabaud? 24127 004155'03 254 00 0 00 004161' ifskp. ; No, but respectable anyway (or used to be) 24128 004156'03 120 02 0 00 000004 dmove t2,t4 ; Load kilobaud rate 24129 004157'03 201 05 0 00 000113 movei t5,"K" ; Load the Kilobaud prefix 24130 004160'03 263 17 0 00 000000 ret ; Return kilo or greater, but less than mega 24131 004161'03 endif. ; Otherwise, at least in megabaud 24132 24133 004161'03 113 04 0 00 004143' dfdv t4,kilo ; Reduce by ten orders of binary magnitude 24134 004162'03 311 04 0 00 004143' caml t4,kilo ; Into Gigabaud? 24135 004163'03 254 00 0 00 004167' ifskp. ; No, but at NI/CI speeds! 24136 004164'03 120 02 0 00 000004 dmove t2,t4 ; Load Megabaud rate 24137 004165'03 201 05 0 00 000115 movei t5,"M" ; Load the Megabaud prefix 24138 004166'03 263 17 0 00 000000 ret ; Return mega or greater, but less than giga 24139 004167'03 endif. ; Otherwise, at least in Gigabaud 24140 24141 004167'03 113 04 0 00 004143' dfdv t4,kilo ; Reduce by ten orders of binary magnitude 24142 004170'03 311 04 0 00 004143' caml t4,kilo ; Into Terabaud?? 24143 004171'03 254 00 0 00 004175' ifskp. ; No, but 1000BaseT is nothing to sneeze at! 24144 004172'03 120 02 0 00 000004 dmove t2,t4 ; Load Gigabaud rate 24145 004173'03 201 05 0 00 000107 movei t5,"G" ; Load the Gigabaud prefix 24146 004174'03 263 17 0 00 000000 ret ; Return giga or greater, but less that tera k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 44-1 K20DSP MAC 6-Jun-23 10:31 Put result into kilo, mega, giga or tera range 24147 004175'03 endif. ; Otherwise, some kind of incredible rate 24148 24149 remark Dude!! ; What kind of com gear are you using? 24150 004175'03 113 04 0 00 004143' dfdv t4,kilo ; Reduce by ten orders of binary magnitude 24151 004176'03 120 02 0 00 000004 dmove t2,t4 ; Load Terabaud rate 24152 004177'03 201 05 0 00 000124 movei t5,"T" ; Load Terabaud prefix 24153 004200'03 263 17 0 00 000000 ret ; Return from ...Fantasy Island... 24154 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 45 K20DSP MAC 6-Jun-23 10:31 Print correct character suffix 24155 subttle Print correct character suffix 24156 24157 ; Call: 24158 ; 24159 ; t1/ Output designator (updated, if string) 24160 ; t5/ character prefix character (if any) 24161 24162 004201'03 201 02 0 00 000040 chrsfx: movei t2,.chspc ; Load a space 24163 004202'03 260 17 0 00 000000* call BOUTI% ;[216] Properly emit 24164 24165 004203'03 336 02 0 00 000005 skipn t2,t5 ; Load prefix character 24166 004204'03 254 00 0 00 004206' ifskp. ; If there is one, then type it 24167 004205'03 260 17 0 00 004202* call BOUTI% ;[216] Properly emit it 24168 004206'03 endif. 24169 24170 004206'03 120 02 0 00 000000# smsg 24171 004207'03 260 17 0 00 004037* 24172 000452'02 000000000000# 24173 000453'02 777777 777775 24174 001757'04 103 057 163 000 000 24175 004210'03 263 17 0 00 000000 ret 24176 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 46 K20DSP MAC 6-Jun-23 10:31 Print correct baud suffix 24177 subttle Print correct baud suffix 24178 24179 ; Call: 24180 ; 24181 ; t1/ Output designator (updated, if string) 24182 ; t5/ character prefix character (if any) 24183 24184 004211'03 201 02 0 00 000040 baudsf: movei t2,.chspc ; Load a space 24185 004212'03 260 17 0 00 004205* call BOUTI% ;[216] Seperate number from text 24186 004213'03 336 02 0 00 000005 skipn t2,t5 ; Load prefix character 24187 004214'03 254 00 0 00 004216' ifskp. ; If there is one, then type it 24188 004215'03 260 17 0 00 004212* call BOUTI% ;[216] 24189 004216'03 endif. 24190 24191 004216'03 120 02 0 00 000000# smsg ; Accepted abbreviation for Baud 24192 004217'03 260 17 0 00 004207* 24193 000454'02 000000000000# 24194 000455'02 777777 777776 24195 001760'04 102 144 000 000 000 24196 004220'03 263 17 0 00 000000 ret 24197 24198 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 47 K20DSP MAC 6-Jun-23 10:31 Determine the console's line number 24199 subttl Determine the console's line number 24200 24201 ;[223] Begin code insertion 24202 24203 ; Want to know this because the CTY is not a good line to use as you 24204 ; can't control what a front end might type as well as Tops-20's own 24205 ; needs. Using it can cause messages to never get seen, being simply 24206 ; thrown away as a packet resend. 24207 ; 24208 ; It is for this reason that the PANDA access control job (ACJ) will 24209 ; not allow the CTY to be assigned (either explicitly with ASND% or 24210 ; implicitly with an OPENF%) by anything else than an enabled WHEEL or 24211 ; OPERATOR. 24212 24213 chgsec(code,data) ; Need to store the data... 24214 000004'05 ctyerr: block 1 ; Any STDEV% error 24215 000005'05 ctydev: block 1 ;** DO NOT ; Console in 'device' format 24216 000006'05 ctynum: block 1 ; REORDER ** ; Bare line number of console 24217 retsec ; Restore psect assumptions 24218 24219 chgsec(code,const) ; The device name of the console is eternal 24220 000456'02 103 124 131 000 000 ctynam: asciz /CTY/ ; Note, NO device punctuation! 24221 retsec ; Restore psect assumptions 24222 24223 004221'03 inicty: entry inicty ; Called at program start up 24224 004221'03 265 16 0 00 004240' saveac ; Let's not touch anything 24225 24226 004222'03 561 01 0 00 000000# hrroi t1, ctynam ; Tops-20 pointer to CTY device name 24227 004223'03 104 00 0 00 000120 STDEV% ; Turn the string into a device 24228 004224'03 320 12 0 00 004226' ifje. r ; This is REALLY supposed to be defined... 24229 004225'03 254 00 0 00 004232' 24230 004226'03 202 01 0 00 000000# movem t1, ctyerr ; Store error for the curious 24231 004227'03 477 02 0 00 000003 setob t2, t3 ; Cons up a pair bogus talismen 24232 004230'03 124 02 0 00 000000# dmovem t2, ctydev ; Flag that they are useless 24233 004231'03 263 17 0 00 000000 ret ; Go no further 24234 004232'03 endif. ; End STDEV% error handling 24235 24236 remark ; Otherwise, worked!! 24237 004232'03 202 02 0 00 000000# movem t2, ctydev ; Save in device format for ASND% check 24238 004233'03 620 02 0 00 400000 txz t2, .ttdes ; Shut off terminal designator if half word 24239 004234'03 552 02 0 00 000000# hrrzm t2, ctynum ; Save just the line number 24240 004235'03 201 04 0 00 601405 movx t4, lstrx1 ; Say it worked fine 24241 004236'03 202 04 0 00 000000# movem t4, ctyerr ; Store (lack of) error for the curious 24242 24243 004237'03 263 17 0 00 000000 ret ; Finally done 24244 24245 ;[223] End code insertion 24246 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 48 K20DSP MAC 6-Jun-23 10:31 Finishing items 24247 subttl Finishing items 24248 24249 xlist ; Save the trees!! 24250 list ; Resume listing 24251 24252 .endps code ; Close the code .psect 24253 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 49 K20DSP MAC 6-Jun-23 10:31 Extended Text for Display 24254 subttl Extended Text for Display 24255 24256 .psect etext ;[209] Need to put some things in extended text 24257 24258 remark Various types of parity 24259 24260 001761'04 116 157 156 145 000 enone: asciz/None/ 24261 001762'04 123 160 141 143 145 espac: asciz/Space/ 24262 001764'04 115 141 162 153 000 emark: asciz/Mark/ 24263 001765'04 117 144 144 000 000 eodd: asciz/Odd/ 24264 001766'04 105 166 145 156 000 eeven: asciz/Even/ 24265 24266 remark Various states of debugging 24267 24268 001767'04 117 146 146 000 000 deboff: asciz/Off/ 24269 001770'04 123 164 141 164 145 debsts: asciz/States/ 24270 001772'04 120 141 143 153 145 debpks: asciz/Packets/ 24271 24272 .endps etext ; Close out section 1 text 24273 24274 remark Pointers to extended text which MUST be in section zero 24275 24276 .psect const ; Constants 24277 24278 000457'02 000000000000# debtab: .px7!deboff 24279 000460'02 000000000000# .px7!debsts 24280 000461'02 000000000000# .px7!debpks 24281 24282 .endps const 24283 k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page 50 K20DSP MAC 6-Jun-23 10:31 Display Module local storage 24284 subttl Display Module local storage 24285 24286 .psect data ; Writable storage 24287 000007'05 000000 000000 pvbaud:: exp 0,0 ; PTY: virtual baud rate 24288 000011'05 000000 000000 pibaud:: exp 0,0 ; PIP: virtual baud rate 24289 000013'05 000000 000000 nlbaud:: exp 0,0 ; NUL: virtual baud rate 24290 000015'05 000000 000000 dnbaud:: exp 0,0 ; DECnet virtual baud rate 24291 24292 .endps data ; End of data psect 24293 24294 .xcmsy ;[194] Ditch MACSYM junk 24295 end NO ERRORS DETECTED PROGRAM BREAK IS 000000 PSECT 1 BREAK IS 000025 FOR TEXT PSECT 2 BREAK IS 000462 FOR CONST PSECT 3 BREAK IS 004501 FOR CODE PSECT 4 BREAK IS 001774 FOR ETEXT PSECT 5 BREAK IS 000017 FOR DATA CPU TIME USED 00:01.722 135P CORE USED k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page S-1 K20DSP MAC 6-Jun-23 10:31 SYMBOL TABLE BLIP 000005 NO%OOV 020000 000000 sin T3 000003 spd BOUT 104000 000051 int NO%RDX 777777 sin T4 000004 spd BOUT% 104000 000051 int NOUT% 104000 000224 int T5 000005 spd BOUTI% 000000 ext NTLINE 777777 spd TEXT 000000 ext CALL 260740 000000 NTTYPE 000777 000000 spd TT%OSP 400000 000000 sin CALLRE 254000 000000 spd NW%MC 000003 sin TTYJFN 000000 ext CCOFF 000000 ext NW%NNT 000000 sin XMOVEI 415000 000000 int CCON 000000 ext NW%PT 000002 sin $PRIOU 000000 ext CODE 000000 ext NW%TV 000004 sin %%JSER 000000 ext CONST 000000 ext ODCNV% 104000 000222 int %%SMSG 000000 ext CRLF 000000 ext ODTIM% 104000 000220 int ..MSK 777777 777777 spd CRLFLF 000000 ext OF%BSZ 770000 000000 sin .A16 000016 spd CX 000016 OF%RD 200000 sin .CHCRT 000015 sin DATA 000000 ext OPENF% 104000 000021 int .CHDBQ 000042 spd DEBUG 000014 spd OT%4YR 010000 000000 sin .CHDEL 000177 sin DEVST% 104000 000121 int OT%DAM 004000 000000 sin .CHLFD 000012 sin DFOUT% 104000 000235 int OT%DAY 200000 000000 sin .CHNUL 000000 sin DV%TYP 000777 000000 sin OT%FDY 100000 000000 sin .CHSPC 000040 sin DVCHR% 104000 000117 int OT%FMN 020000 000000 sin .DATUS 000017 spd DXFULL 000000 spd OT%SCL 000001 000000 sin .DVADS 000025 sin ERJMP 320700 000000 int OT%SPA 002000 000000 sin .DVCDP 000021 sin ERJMPR 320500 000000 int P 000017 .DVCDR 000010 sin ERJMPS 320600 000000 int P1 000011 spd .DVDCN 000022 sin ERRPTR 000000 ext P2 000012 spd .DVDES 600000 sin ERSTR 104000 000011 int P3 000013 spd .DVDSK 000000 sin ESOUT% 104000 000313 int P4 000014 spd .DVDSP 000006 sin ETEXT 000000 ext P5 000015 spd .DVDTA 000003 sin FILJFN 000000 ext PARS1 000000 ext .DVFE 000011 sin FL%EXP 003000 000000 sin PARS2 000000 ext .DVLPT 000007 sin FL%FST 770000 sin PARS3 000000 ext .DVMTA 000002 sin FL%JUS 140000 000000 sin PARS4 000000 ext .DVNUL 000015 sin FL%ONE 020000 000000 sin PARS5 000000 ext .DVPIP 000403 sin FL%OVL 000100 000000 sin PBOUT 104000 000074 int .DVPLT 000017 sin FL%PNT 004000 000000 sin PBOUT% 104000 000074 int .DVPTP 000005 sin FL%RND 000037 000000 sin PM%RD 100000 000000 sin .DVPTR 000004 sin FL%SGN 600000 000000 sin PMAP% 104000 000056 int .DVPTY 000013 sin FL%SND 007700 sin PSOUT 104000 000076 int .DVSRV 000023 sin FLOUT 104000 000233 int PSOUT% 104000 000076 int .DVTTY 000012 sin FLOUT% 104000 000233 int Q1 000005 spd .FHSLF 400000 sin GETNTI 000000 ext Q2 000006 spd .FLDIG 000000 sin GS%NAM 000200 000000 sin Q3 000007 spd .FLEXN 000000 sin GS%OPN 400000 000000 sin Q4 000010 spd .FLLSP 000000 sin GTSTS% 104000 000024 int Q5 000011 spd .FLSPC 000001 sin GTTYP% 104000 000303 int QLOG 000000 ext .FP 000015 spd IDCNV% 104000 000223 int R 000000 ext .FPAC 000005 spd JFNS 104000 000030 int RET 263740 000000 .NULIO 377777 sin JFNS% 104000 000030 int RFMOD% 104000 000107 int .NWTTF 000004 sin LSTRX1 601405 int RSKP 000000 ext .PRIOU 000101 sin MAPORG 007000 spd SFMOD% 104000 000110 int .PX7 610001 000000 spd MAPPAG 000007 spd SIZEF% 104000 000036 int .SAC 000016 MAXTIM 267460 SOUT% 104000 000053 int .SAV1 000000 ext N%AREA 176000 spd STDEV% 104000 000120 int .SAV2 000000 ext N%NODE 001777 spd STRBLW 001000 spd .SAV3 000000 ext NO%COL 000177 000000 sin T1 000001 spd .TTDES 400000 sin NO%LFL 100000 000000 sin T2 000002 spd .XTRST 000000 ext k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page S-2 K20DSP MAC 6-Jun-23 10:31 SYMBOL TABLE FOR PSECT TEXT ASTNUL 000002' DVPUNC 000006' NULNAM 000000' UNKTXT 000004' k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page S-3 K20DSP MAC 6-Jun-23 10:31 SYMBOL TABLE FOR PSECT CONST CTYNAM 000456' DEBTAB 000457' FMCNTL 000451' GENTAB 000136' LTNAME 000421' NEWMN 000372' NUL5 000002' NULPTR 000000' PER 000035 422752 spd PERCNT 000100' PERIO4 000374' PERIO8 000375' PERIOD 000373' TABLE 000376' k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page S-4 K20DSP MAC 6-Jun-23 10:31 SYMBOL TABLE FOR PSECT CODE ABTFIL 002165' ext INDEFW 003164' ext RANGER 004145' VSICT 003503' ext ASCDEV 001262' int INICTY 004221' ent REOLCH 002411' ext VSIMX 003523' ext AUTBYT 002105' ext INPCBF 003457' ext ROSNPT 001464' ext VSITC 003513' ext BAUD 004120' INTIMA 003150' ext RPADCH 002377' ext VSOCT 003535' ext BAUDSF 004211' ITSFLG 002151' ext RPADN 002360' ext VSOMX 003555' ext BCTR 002515' ext KILO 004143' RPAUSE 002703' ext VSOTC 003545' ext BCTU 002523' ext LCLPAR 003720' ext RPAUSF 002647' ext VTERMF 001766' ext BOUTI% 004215' ext LINCHR 003673' RPSIZ 002335' ext WHAKFP 000427' ent BRK 001753' ext LOCAL 003061' ext RPTFLG 002502' ext XFNFLG 002135' ext CARIER 002004' ext LOGBSZ 002316' ext RPTQ 002504' ext $DFCHR 000015 000003 spd CHKLIN 002003' ext LOGJFN 002265' ext RQUOTE 002423' ext $DFETI 000015 000007 spd CHRSFX 004201' MACTAB 003305' ext RSKP 004131' ext $DFSPE 000015 000013 spd CLRCNO 000000' ent MARK 001641' ext RSTHDR 002442' ext $DICHR 000015 000001 spd CRLF 003312' ext MAXTRY 003003' ext RTCHR 000762' ext $DIETI 000015 000005 spd CRLFLF 004264' ext MDMLIN 001557' ext RTIMOU 002601' ext $DISPE 000015 000011 spd DBLCAL 004134' ext MOON 003315' RTOT 000534' ext $EDNO 000000 ext DBLSCL 001024' ext MYNAME 001546' ext SEC 000000 ext $MCHRS 003253' ext DELAY 002770' ext MYNODE 001437' ext SEOLCH 002416' ext $MNVER 000000 ext DELAYF 002744' ext MYTTY 003721' ext SESFLG 002024' ext $PRIOU 000016' ext DEVUNT 001310' NBICT 003567' ext SESJFN 002022' ext $SHDAY 001401' ent DFLOAT 004054' ext NDVFXP 001423' ext SPACE 001637' ext $SHDEB 002245' ent DISPER 003424' NETJFN 002001' ext SPADCH 002404' ext $SHFIL 002102' ent DNULBD 001176' ext NNAK 000656' ext SPADN 002370' ext $SHINP 003101' ent DPIPBD 001216' ext NODNAM 001430' ext SPAUSE 002717' ext $SHLIN 001411' ent DPTYBD 001156' ext NODNUM 001441' ext SPAUSF 002661' ext $SHMAC 003217' ent DSRVBD 001240' ext NONE 001651' ext SPEED 001745' ext $SHMAX 003314' DUPLEX 001717' ext NRTFLG 002070' ext SPSIZ 002345' ext $SHO4A 001714' DURTIM 000500' ext NSICI 003577' ext SQUOTE 002430' ext $SHO4E 002022' EBQ 002464' ext NSIMX 003617' ext SRVTIM 003044' ext $SHO4F 002070' EBQFLG 002462' ext NSITC 003607' ext SSTHDR 002435' ext $SHO4H 002077' EBQR 002447' ext NTIBLK 000000 ext STATXT 004327' ext $SHO4X 002077' EBTFLG 002111' ext NTIMOU 000650' ext STCHR 000761' ext $SHOW3 001575' ECHO 000317' ent ODD 001643' ext STIMOU 002616' ext $SHOW4 001632' ECHO1 000354' OPNPAR 003722' ext STOT 000535' ext $SHPKT 002331' ent ECHO2 000402' PARITY 001635' ext STRBUF 000300' ext $SHTIM 002532' ent ERRPTR 000631' ext PARPKO 001653' ext STRC 000000 ext $SHTOP 001334' ent ESCAPE 001630' ext PARRCK 000000 ext STRPTR 000000 ext $SHVER 001334' ent EVEN 001645' ext PARS2 001323' ext TBTFLG 002107' ext $SRVT 000446' ent EWALLT 004103' ext PARS3 001145' ext TIMDEV 001151' ext $STAT 000447' ent EXPUNG 002201' ext PARS4 001147' ext TIMERX 000674' ext $STAT4 000625' FLOW 001612' ext PAUSE 000642' ext TLGJFN 002211' ext $STATJ 000663' FMCNTW 024137 040400 spd PDCODF 002254' ext TTIBIN 000621' ext $STATX 000640' GENPAR 000302' ext PEFFI0 004064' TTILDB 000577' ext $STATZ 000700' GETNTI 002073' ext PEFFIF 004024' TTIMAX 000613' ext $TIME 001125' int GMKBP1 004137' PRNTBD 001052' TTIPAR 001702' ext $TIME1 001323' GMKBPS 004122' PRNTBS 001064' TTISIN 000605' ext $VERNO 000000 ext GMKCPS 004077' PRNTBV 001107' TTYJFN 002002' ext $WHO 000000 ext HANDSH 001600' ext PRNTCM 001114' TTYNUM 002075' ext %%JSER 004073' ext IFCRLF 003624' ent PRNTNV 001101' TVTCHK 003751' ext %%SMSG 004217' ext IMXTRY 003013' ext PSPEEF 000703' TVTFLG 003735' ext ....Z 224100 060400 INCASE 003104' ext PTYFLG 001770' ext TYPFIL 000054' ent ...X 000002 spd INDEFC 003200' ext PTYNAM 001537' ext TYPNAM 000020' ent ..0005 000005' spd INDEFF 003120' ext PUTC 003646' ent VBICT 003433' ext ..0006 000010' spd INDEFS 003177' ext QLOG 000425' ext VBOCT 003471' ext ..0014 000015' spd INDEFT 003132' ext R 004075' ext VCHRCN 003445' ext ..0015 000017' spd k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page S-5 K20DSP MAC 6-Jun-23 10:31 SYMBOL TABLE FOR PSECT CODE ..0023 000035' spd ..0534 001007' spd ..1271 001726' spd ..2013 002633' spd ..0024 000053' spd ..0541 001034' spd ..1272 001731' spd ..2032 002656' spd ..0031 000031' spd ..0542 001017' spd ..1303 001742' spd ..2033 002661' spd ..0032 000034' spd ..0554 001040' spd ..1311 001763' spd ..2042 002673' spd ..0040 000041' spd ..0555 001043' spd ..1316 001766' spd ..2043 002676' spd ..0041 000044' spd ..0570 001100' spd ..1325 001776' spd ..2050 002733' spd ..0047 000050' spd ..0604 001151' spd ..1332 002001' spd ..2064 002714' spd ..0050 000053' spd ..0616 001172' spd ..1337 002012' spd ..2065 002717' spd ..0052 000066' spd ..0624 001165' spd ..1344 002015' spd ..2076 002725' spd ..0057 000106' spd ..0625 001170' spd ..1351 002022' spd ..2077 002730' spd ..0066 000077' spd ..0626 001164' spd ..1363 002070' spd ..2106 002744' spd ..0067 000103' spd ..0644 001212' spd ..1365 002032' spd ..2113 002777' spd ..0077 000111' spd ..0652 001205' spd ..1372 002035' spd ..2122 002752' spd ..0100 000131' spd ..0653 001210' spd ..1403 002051' spd ..2123 002777' spd ..0110 000122' spd ..0654 001204' spd ..1404 002070' spd ..2132 002764' spd ..0111 000126' spd ..0672 001232' spd ..1416 002077' spd ..2133 002767' spd ..0115 000154' spd ..0700 001225' spd ..1426 002127' spd ..2146 003054' spd ..0122 000155' spd ..0701 001230' spd ..1433 002132' spd ..2153 003057' spd ..0131 000144' spd ..0702 001224' spd ..1434 002123' spd ..2162 003040' spd ..0132 000150' spd ..0720 001254' spd ..1441 002126' spd ..2163 003043' spd ..0142 000160' spd ..0726 001247' spd ..1442 002117' spd ..2174 003076' spd ..0143 000162' spd ..0727 001252' spd ..1447 002122' spd ..2210 003112' spd ..0151 000207' spd ..0730 001246' spd ..1462 002143' spd ..2215 003115' spd ..0152 000210' spd ..0750 001277' spd ..1467 002146' spd ..2230 003142' spd ..0161 000177' spd ..0751 001302' spd ..1476 002157' spd ..2231 003145' spd ..0162 000203' spd ..0752 001307' spd ..1503 002162' spd ..2242 003156' spd ..0172 000213' spd ..0775 001314' spd ..1512 002173' spd ..2247 003161' spd ..0173 000216' spd ..0776 001321' spd ..1517 002176' spd ..2256 003172' spd ..0175 000233' spd ..1005 001353' spd ..1526 002206' spd ..2263 003214' spd ..0212 000242' spd ..1013 001366' spd ..1544 002237' spd ..2272 003205' spd ..0213 000244' spd ..1021 001376' spd ..1545 002242' spd ..2273 003212' spd ..0221 000245' spd ..1023 001502' spd ..1552 002227' spd ..2277 003225' spd ..0222 000316' spd ..1035 001441' spd ..1553 002236' spd ..2326 003275' spd ..0232 000304' spd ..1044 001436' spd ..1572 002261' spd ..2327 003312' spd ..0235 000304' spd ..1051 001441' spd ..1576 002326' spd ..2342 003342' spd ..0245 000346' spd ..1057 001464' spd ..1612 002323' spd ..2351 003351' spd ..0253 000352' spd ..1063 001457' spd ..1613 002326' spd ..2352 003361' spd ..0264 000401' spd ..1075 001476' spd ..1620 002303' spd ..2360 003362' spd ..0300 000426' spd ..1111 001517' spd ..1621 002312' spd ..2361 003423' spd ..0311 000432' spd ..1115 001534' spd ..1640 002406' spd ..2366 003401' spd ..0312 000435' spd ..1122 001554' spd ..1674 002457' spd ..2370 003437' spd ..0313 000445' spd ..1127 001530' spd ..1701 002462' spd ..2400 003451' spd ..0331 000504' spd ..1130 001533' spd ..1706 002467' spd ..2410 003463' spd ..0332 000503' spd ..1143 001575' spd ..1713 002472' spd ..2420 003475' spd ..0377 000557' spd ..1153 001572' spd ..1722 002507' spd ..2430 003527' spd ..0400 000561' spd ..1160 001575' spd ..1727 002512' spd ..2444 003561' spd ..0407 000570' spd ..1173 001606' spd ..1740 002550' spd ..2460 003623' spd ..0414 000572' spd ..1174 001607' spd ..1745 002553' spd ..2502 003637' spd ..0461 000737' spd ..1201 001620' spd ..1752 002562' spd ..2510 003645' spd ..0466 000761' spd ..1206 001623' spd ..1757 002565' spd ..2516 003661' spd ..0476 000732' spd ..1213 001632' spd ..1762 002637' spd ..2526 003670' spd ..0503 000752' spd ..1225 001671' spd ..1767 002642' spd ..2537 003712' spd ..0514 000767' spd ..1235 001674' spd ..2000 002613' spd ..2551 003727' spd ..0526 001001' spd ..1243 001700' spd ..2001 002616' spd ..2565 003762' spd ..0533 001004' spd ..1257 001714' spd ..2012 002630' spd ..2571 003743' spd k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page S-6 K20DSP MAC 6-Jun-23 10:31 SYMBOL TABLE FOR PSECT CODE ..2576 003746' spd ..2605 003757' spd ..2612 003762' spd ..2634 004031' spd ..2645 004035' spd ..2656 004041' spd ..2670 004063' spd ..2674 004111' spd ..2676 004133' spd ..2703 004153' spd ..2711 004161' spd ..2717 004167' spd ..2725 004175' spd ..2733 004206' spd ..2744 004216' spd ..2755 004226' spd ..2756 004232' 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 15:18 11-Jun-23 Page S-7 K20DSP MAC 6-Jun-23 10:31 SYMBOL TABLE FOR PSECT ETEXT DEBOFF 001767' DEBPKS 001772' DEBSTS 001770' EEVEN 001766' EMARK 001764' ENONE 001761' EODD 001765' ESPAC 001762' k20dsp - Kermit-20 Display Routines MACRO %53B(1254)-4 15:18 11-Jun-23 Page S-8 K20DSP MAC 6-Jun-23 10:31 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 15:18 11-Jun-23 Page 1 K20PDC MAC 9-Jun-23 22:41 24296 title k20pdc - Kermit (Visual) Packet Decoding 24297 24298 ; All display code was removed from k20mit and moved to the k20dsp 24299 ; module as part of Edit 194 to address the issue of a very large 24300 ; single source file that unexpectedly began generating MCRNEC errors. 24301 ; 24302 ; With the exception the 'main' k20mit module, any time a module gets 24303 ; near 50 pages, a code split happens. Thus far, this has happened 24304 ; with: 24305 ; 24306 ; k20ioc - Kermit INPUT/OUTPUT/TRANSMIT support 24307 ; k20mac - Kermit Macros (DEFINE command) 24308 ; k20srv - Kermit Server Commands 24309 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 15:18 11-Jun-23 Page 2 K20PDC MAC 9-Jun-23 22:41 Preliminaries 24310 subttl Preliminaries 24311 24312 search monsym,macsym,cmd,k20unv ;[194] 24313 cmdacs ^ ;Clean up p1-p4 definitions 24314 24315 sall ; Tidy listing 24316 .directive flblst ; We don't need to see all the ASCIZ bytes... 24317 24318 extern rquote ; Receive quote character 24319 extern squote ; Send quote character 24320 24321 extern $closd ; Close debugging log 24322 extern logjfn ; Debugging log JFN 24323 extern BOUTI% ; Byte output to JFN or append to string 24324 extern %%smsg ; smsg macro support 24325 remark ; N.B., %%smsg *ONLY* handles OWGP's!!!!! 24326 24327 repeat 0,< remark ;;;; ; Put these in later to bum a BOUT% 24328 extern s8ccv7 ; String eight controlified convert to seven 24329 extern trnbuf ; Where it leaves this 24330 > 24331 .psect code/ronly ; Pure code. Pure Heaven 24332 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 15:18 11-Jun-23 Page 3 K20PDC MAC 9-Jun-23 22:41 DIAMSG Print packet type and number if debugging "states" 24333 subttl DIAMSG Print packet type and number if debugging "states" 24334 24335 ;[114] DIAMSG 24336 ; 24337 ; Enter with: 24338 ; t1/ packet type 24339 ; t2/ packet number 24340 ; t4/ pointer to data 24341 ; logjfn/ debugging log file jfn 24342 ; Returns +1 always, with all ACs unchanged. 24343 24344 000000'01 diamsg: entry diamsg ;[221] Moved here from k20mit 24345 000000'01 306 14 0 00 000001 cain debug, 1 ; Only for protocol debugging. 24346 000001'01 336 00 0 00 000000* skipn logjfn ; Got a log JFN? 24347 000002'01 263 17 0 00 000000 ret ; Nope, forget it. 24348 24349 000003'01 265 16 0 00 000774' saveac ; Save these. 24350 000004'01 405 01 0 00 000177 andi t1, 177 ;[235] Strip off any parity 24351 000005'01 261 17 0 00 000001 push p, t1 ; Save packet type for sec. 24352 000006'01 200 01 0 00 000001* move t1, logjfn ; Get debugging log file JFN. 24353 000007'01 201 03 0 00 000010 movei t3, ^d8 ;[194] ; JFN's are in octal... 24354 000010'01 104 00 0 00 000224 NOUT% 24355 000011'01 320 12 0 00 000013' ifje. r ;[194] Catch and ignore error 24356 000012'01 254 00 0 00 000016' 24357 000013'01 262 17 0 00 000002 pop p, t2 ;[194] Keep the stack straight!!!!! 24358 000014'01 254 00 0 00 000031' jrst deberr ;[174] 24359 000015'01 254 00 0 00 000017' else. ;[194] Otherwise, worked 24360 000016'01 262 17 0 00 000002 pop p, t2 ; Pop packet type 24361 000017'01 endif. ;[194] 24362 000017'01 260 17 0 00 000000* call BOUTI% 24363 000020'01 302 02 0 00 000107 caie t2, "G" ; Generic command? 24364 000021'01 254 00 0 00 000026' ifskp. ;[194] Yes, first character of one 24365 000022'01 200 03 0 00 000004 move t3, t4 ; Log the first character of the data packet. 24366 000023'01 134 02 0 00 000003 ildb t2, t3 24367 000024'01 405 02 0 00 000177 andi t2, 177 ;[235] Strip off any parity 24368 000025'01 260 17 0 00 000017* call BOUTI% ;[174] 24369 000026'01 endif. ;[194] 24370 24371 000026'01 201 02 0 00 000040 diamsz: movei t2, " " ; A space for delimitation. 24372 000027'01 260 17 0 00 000025* call BOUTI% ;[174] 24373 000030'01 263 17 0 00 000000 ret 24374 24375 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 15:18 11-Jun-23 Page 4 K20PDC MAC 9-Jun-23 22:41 Handle I/O errors writing to debugging log file. 24376 subttl Handle I/O errors writing to debugging log file. 24377 24378 ;[174] 24379 24380 000031'01 deberr: entry deberr ;[221] Moved here from k20mit 24381 txmsg < 24382 000031'01 200 01 0 00 000000# %KERMIT-20: Error writing debug log file - > 24383 000032'01 104 00 0 00 000076 24384 000033'01 320 12 0 00 000034' 24385 000000'02 000000000000# 24386 000000'03 015 012 045 113 105 24387 000034'01 201 01 0 00 000101 movei t1, .priou 24388 000035'01 525 02 0 00 400000 hrloi t2, .fhslf 24389 000036'01 400 03 0 00 000000 setz t3, 24390 000037'01 104 00 0 00 000011 ERSTR% 24391 000040'01 320 14 0 00 000042' erjmps .+2 ; Ignore its strange return 24392 000041'01 320 14 0 00 000042' erjmps .+1 ; Ignore its stranger return 24393 txmsg < 24394 000042'01 200 01 0 00 000000# > 24395 000043'01 104 00 0 00 000076 24396 000044'01 320 12 0 00 000045' 24397 000001'02 000000000000# 24398 000012'03 015 012 000 000 000 24399 000045'01 400 01 0 00 000000 setz t1, ; Close the log file if possible 24400 000046'01 260 17 0 00 000000* call $closd ;[194] ; and turn off debug log. 24401 000047'01 263 17 0 00 000000 ret 24402 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 15:18 11-Jun-23 Page 5 K20PDC MAC 9-Jun-23 22:41 Packet Decode 24403 subttl Packet Decode 24404 24405 ; t1/ LH, "S" or "R" (Sending or Receiving 24406 ; RH, Debugging log JFN or terminal device id 24407 ; t2/ Point 8, packet to send or packet we got 24408 24409 000050'01 pdecod: entry pdecod ; Called by k10mit packet routines 24410 remark ; *MUST* be saved by caller!!!! 24411 000050'01 265 16 0 00 001006' saveac ; Needs some more registers 24412 24413 000051'01 337 13 0 00 000006* skipg p3, logjfn ; Do we have a logging JFN? (can be .priou) 24414 000052'01 263 17 0 00 000000 ret ; No, so don't log anything 24415 000053'01 554 11 0 00 000001 hlrz p1, t1 ; Load the packet context 24416 000054'01 621 01 0 00 777777 tlz t1, -1 ; And stomp it out of the register 24417 000055'01 120 05 0 00 000001 dmove q1, t1 ; Let's save these for a moment 24418 000056'01 120 07 0 00 000003 dmove q3, t3 ; all of the temporaries 24419 24420 000057'01 415 16 0 00 000067' block. ; Carefully review the context character 24421 000060'01 261 17 0 00 000016 24422 000061'01 306 11 0 00 000122 cain p1, "R" ; Receiving? 24423 000062'01 254 00 0 00 000000* retskp ; Yes, this is valid 24424 000063'01 306 11 0 00 000123 cain p1, "S" ; Sending? 24425 000064'01 254 00 0 00 000062* retskp ; Yes, that's valid, too 24426 000065'01 263 17 0 00 000000 ret ; Otherwise, some kind of bad 24427 000066'01 263 17 0 00 000000 endbk. ; End of block context 24428 000067'01 254 00 0 00 000076' ifskp. ; +2 means we thought it was fine 24429 000070'01 306 11 0 00 000122 cain p1, "R" ; Receiving? 24430 000071'01 254 00 0 00 000107' callret rpdecd ; Yes, go do something about that 24431 000072'01 306 11 0 00 000123 cain p1, "S" ; Receiving? 24432 000073'01 254 00 0 00 000152' callret spdecd ; Yes, go do something about that, too 24433 000074'01 254 00 0 00 000076' anskp. ; ??? Shouldn't happen--we just checked 24434 000075'01 254 00 0 00 000106' else. ; Otherwise, unknown context 24435 000076'01 200 01 0 00 000013 move t1, p3 ; Pick up the log JFN 24436 000077'01 120 02 0 00 000000# smsg <% "> ; Begin confusion blat 24437 000100'01 260 17 0 00 000000* 24438 000002'02 000000000000# 24439 000003'02 777777 777775 24440 000013'03 045 040 042 000 000 24441 000101'01 200 11 0 00 000011 move p1, p1 ; Pick up the unknown context character 24442 000102'01 260 17 0 00 000027* call BOUTI% ; Put it into the log file 24443 smsg <" is not a known transmission context 24444 000103'01 120 02 0 00 000000# > ; Finish the blat and close off the line 24445 000104'01 260 17 0 00 000100* 24446 000004'02 000000000000# 24447 000005'02 777777 777731 24448 000014'03 042 040 151 163 040 24449 24450 000105'01 263 17 0 00 000000 ret ; Get out of here and don't risk bogosity 24451 000106'01 endif. ; End case context character scrub 24452 24453 000106'01 263 17 0 00 000000 ret ; Superstition... 24454 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 15:18 11-Jun-23 Page 6 K20PDC MAC 9-Jun-23 22:41 Receive Context 24455 subttl Receive Context 24456 24457 ; Invoked at the end of the receive 24458 ; 24459 ; AC's: 24460 ; 24461 ; t1/ Packet type 24462 ; t2/ Packet number 24463 ; t3/ Length of data field 24464 ; t4/ 8-bit byte pointer to data field 24465 24466 extern rsthdr ; Start of Packet 24467 extern num ; Packet Number 24468 extern type ; Message Type 24469 extern datlen ; Data length 24470 extern pktlen ; Packet length 24471 extern islong ; Set if a long packet 24472 extern datptr ; Pointer to data area of packet 24473 extern pktbct ; Block check type for this packet on receive 24474 extern blkchk ; Final computed block check 24475 extern fintim ; Fine grained time of day (in K20TIM) 24476 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 15:18 11-Jun-23 Page 7 K20PDC MAC 9-Jun-23 22:41 Decode a received packet 24477 subttl Decode a received packet 24478 24479 000107'01 rpdecd: remark ; Saved by original external caller 24480 remark ; Saved by internal control linkage 24481 repeat 0,< 24482 setzb t1, t2 ; Cons up some .CHNUL's 24483 dmovem t1, sop8st ; Start of Packet character as an 8 bit ASCII string 24484 dmovem t1, trnbuf ; Same character as expanded 7 bit ASCIZ 24485 > 24486 000107'01 200 01 0 00 000013 move t1, p3 ; Load the log file JFN 24487 000110'01 120 02 0 00 000000# smsg () ; "R" for Receive 24488 000111'01 260 17 0 00 000104* 24489 000006'02 000000000000# 24490 000007'02 777777 777776 24491 000024'03 122 054 000 000 000 24492 000112'01 260 17 0 00 000000* call fintim ; Print Time of Day down to HP ticks 24493 000113'01 254 00 0 00 000031' jrst deberr ; Something went wrong, stop doing this 24494 000114'01 201 04 0 00 000122 movei t4, "R" ; Flag that we're receiving 24495 000115'01 260 17 0 00 000716' call pkthdr ; Display packet head 24496 000116'01 254 00 0 00 000031' jrst deberr ; Failed somehow 24497 24498 000117'01 200 02 0 00 000000* move t2, datptr ; Load what receieve sets up 24499 000120'01 202 02 0 00 000000* movem t2, sdatpt ; Pretend we're sending it for code re-use 24500 24501 000121'01 200 04 0 00 000000* move t4, type ; Reload the type 24502 000122'01 405 04 0 00 000177 andi t4, 177 ;[235] Strip off any parity 24503 000123'01 301 04 0 00 000101 cail t4, "A" ; Before "A"? 24504 000124'01 303 04 0 00 000132 caile t4, "Z" ; or after "Z"? 24505 000125'01 254 00 0 00 000213' jrst invsnd ; Can't do the jump table 24506 24507 000126'01 415 16 0 00 000136' block. ; Enter block context for better control flow 24508 000127'01 261 17 0 00 000016 24509 000130'01 306 04 0 00 000131 cain t4, "Y" ; An acknowledge? 24510 000131'01 263 17 0 00 000000 ret ; Don't overwrite what ACK is ack'ing 24511 000132'01 306 04 0 00 000116 cain t4, "N" ; A negative acknowledge? 24512 000133'01 263 17 0 00 000000 ret ; Don't overwrite what NAK is nak'ing 24513 000134'01 254 00 0 00 000064* retskp ; Otherwise, OK to update context 24514 000135'01 263 17 0 00 000000 endbk. ; End of block context 24515 000136'01 254 00 0 00 000140' ifskp. ; +2 means OK to overwrite 24516 000137'01 202 04 0 00 000000# movem t4, lstpkt ; Remember last packet type 24517 000140'01 endif. 24518 24519 000140'01 265 16 0 00 001024' saveac ; Needs some scratch 24520 000141'01 200 05 0 00 000120* move q1, sdatpt ; Load the pointer to the packet's data field 24521 000142'01 200 07 0 00 000000* move q3, datlen ; Number of initialization bytes 24522 24523 000143'01 200 03 0 00 000004 move t3, t4 ; Save a working copy 24524 000144'01 275 03 0 00 000101 subi t3, "A" ; Bring into offset range 24525 000145'01 260 17 1 03 000000# call @sndpkt(t3) ; Call the right routine 24526 000146'01 263 17 0 00 000000 ret ; Pass the error back up 24527 24528 smsg < 24529 000147'01 120 02 0 00 000000# > ; Tie off the log file line 24530 000150'01 260 17 0 00 000111* 24531 000010'02 000000000000# k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 15:18 11-Jun-23 Page 7-1 K20PDC MAC 9-Jun-23 22:41 Decode a received packet 24532 000011'02 777777 777776 24533 000025'03 015 012 000 000 000 24534 000151'01 263 17 0 00 000000 ret ; +1, always 24535 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 15:18 11-Jun-23 Page 8 K20PDC MAC 9-Jun-23 22:41 Decode a sent packet 24536 subttl Decode a sent packet 24537 24538 extern sseqn ; Sending Sequence Number 24539 extern sdatpt ; Sending Data Pointer (points inside the packet) 24540 extern spakpt ; Sending packet pointer 24541 24542 000152'01 spdecd: remark ; Saved by original external caller 24543 remark ; Saved by internal control linkage 24544 repeat 0,< 24545 setzb t1, t2 ; Cons up some .CHNUL's 24546 dmovem t1, sop8st ; Start of Packet character as an 8 bit ASCII string 24547 dmovem t1, trnbuf ; Same character as expanded 7 bit ASCIZ 24548 > 24549 000152'01 200 01 0 00 000013 move t1, p3 ; Load the log file JFN 24550 000153'01 120 02 0 00 000000# smsg () ; "S" for Send 24551 000154'01 260 17 0 00 000150* 24552 000012'02 000000000000# 24553 000013'02 777777 777776 24554 000026'03 123 054 000 000 000 24555 000155'01 260 17 0 00 000112* call fintim ; Print Time of Day down to HP ticks 24556 000156'01 254 00 0 00 000031' jrst deberr ; Something went wrong, stop doing this 24557 000157'01 201 04 0 00 000123 movei t4, "S" ; Flag that we're sending 24558 000160'01 260 17 0 00 000716' call pkthdr ; Dump basic packet headers 24559 000161'01 254 00 0 00 000031' jrst deberr ; Failed somehow 24560 24561 000162'01 200 04 0 00 000121* move t4, type ; Reload the type 24562 000163'01 405 04 0 00 000177 andi t4, 177 ;[235] Strip off any parity 24563 000164'01 301 04 0 00 000101 cail t4, "A" ; Before "A"? 24564 000165'01 303 04 0 00 000132 caile t4, "Z" ; or after "Z"? 24565 000166'01 254 00 0 00 000213' jrst invsnd ; Can't do the jump table 24566 24567 000167'01 415 16 0 00 000177' block. ; Enter block context for better control flow 24568 000170'01 261 17 0 00 000016 24569 000171'01 306 04 0 00 000131 cain t4, "Y" ; An acknowledge? 24570 000172'01 263 17 0 00 000000 ret ; Don't overwrite what ACK is ack'ing 24571 000173'01 306 04 0 00 000116 cain t4, "N" ; A negative acknowledge? 24572 000174'01 263 17 0 00 000000 ret ; Don't overwrite what NAK is nak'ing 24573 000175'01 254 00 0 00 000134* retskp ; Otherwise, OK to update context 24574 000176'01 263 17 0 00 000000 endbk. ; End of block context 24575 000177'01 254 00 0 00 000201' ifskp. ; +2 means OK to overwrite 24576 000200'01 202 04 0 00 000000# movem t4, lstpkt ; Remember last packet type 24577 000201'01 endif. 24578 24579 000201'01 265 16 0 00 001024' saveac ; Needs some scratch 24580 000202'01 200 05 0 00 000141* move q1, sdatpt ; Load the pointer to the packet's data field 24581 000203'01 200 07 0 00 000142* move q3, datlen ; Number of initialization bytes 24582 24583 000204'01 200 03 0 00 000004 move t3, t4 ; Save a working copy 24584 000205'01 275 03 0 00 000101 subi t3, "A" ; Bring into offset range 24585 000206'01 260 17 1 03 000000# call @sndpkt(t3) ; Call the right routine 24586 000207'01 263 17 0 00 000000 ret ; Pass the error back up 24587 smsg < 24588 000210'01 120 02 0 00 000000# > ; Otherwise, tie off the log file line 24589 000211'01 260 17 0 00 000154* 24590 000014'02 000000000000# k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 15:18 11-Jun-23 Page 8-1 K20PDC MAC 9-Jun-23 22:41 Decode a sent packet 24591 000015'02 777777 777776 24592 000027'03 015 012 000 000 000 24593 000212'01 263 17 0 00 000000 ret ; Returns +1, always 24594 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 15:18 11-Jun-23 Page 9 K20PDC MAC 9-Jun-23 22:41 Jump table for sent packet types 24595 subttl Jump table for sent packet types 24596 24597 .endps code ; Constant tables don't go in code 24598 .psect const ; they go into the constants psect 24599 24600 000016'02 000000000000# sndpkt: INVSND ; "A" - Attributes 24601 000017'02 000000000000# sndeot ; "B" - EOT 24602 000020'02 000000000000# INVSND ; "C" - Largely unimplemented host command 24603 000021'02 000000000000# sndata ; "D" - Data 24604 000022'02 000000000000# snderr ; "E" - Error packet 24605 000023'02 000000000000# sndfil ; "F" - File Header 24606 000024'02 000000000000# sndgen ; "G" - Sending a generic command 24607 000025'02 000000000000# INVSND ; "H" - Undefined 24608 000026'02 000000000000# sndinz ; "I" - Info Packet 24609 000027'02 000000000000# INVSND ; "J" - Undefined 24610 000030'02 000000000000# INVSND ; "K" - Undefined 24611 000031'02 000000000000# INVSND ; "L" - Undefined 24612 000032'02 000000000000# INVSND ; "M" - Undefined 24613 000033'02 000000000000# sndnak ; "N" - Negative Acknowledge (NAK) 24614 000034'02 000000000000# INVSND ; "O" - Undefined 24615 000035'02 000000000000# INVSND ; "P" - Undefined 24616 000036'02 000000000000# INVSND ; "Q" - Undefined 24617 000037'02 000000000000# sndrec ; "R" - Receive (GET) 24618 000040'02 000000000000# sndini ; "S" - Send 24619 000041'02 000000000000# INVSND ; "T" - Specially handled, somehow 24620 000042'02 000000000000# INVSND ; "U" - Undefined 24621 000043'02 000000000000# INVSND ; "V" - Undefined 24622 000044'02 000000000000# INVSND ; "W" - Undefined 24623 000045'02 000000000000# sndtxt ; "X" - Text Header 24624 000046'02 000000000000# sndack ; "Y" - Acknowledge (ACK) 24625 000047'02 000000000000# sndeof ; "Z" - EOF 24626 24627 .endps const ; Done with constants 24628 .psect code ; Back to generating code 24629 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 15:18 11-Jun-23 Page 10 K20PDC MAC 9-Jun-23 22:41 Invalid Send Packet 24630 subttl Invalid Send Packet 24631 24632 000213'01 200 01 0 00 000013 INVSND: move t1, p3 ; Load log file 24633 000214'01 120 02 0 00 000000# smsg (<, Invalid packet type: ">) ;" Fool font crock mode 24634 000215'01 260 17 0 00 000211* 24635 000050'02 000000000000# 24636 000051'02 777777 777750 24637 000030'03 054 040 111 156 166 24638 000216'01 200 02 0 00 000004 invsn1: move t2, t4 ; Load it 24639 000217'01 260 17 0 00 000102* call BOUTI% ; Put it in the log 24640 000220'01 201 02 0 00 000042 invsn2: movei t2, .chdbq ; Load closing double quote 24641 000221'01 260 17 0 00 000217* call BOUTI% ; Put it in the log 24642 000222'01 361 07 0 00 000175* sojl q3, RSKP ; Nothing here? That's fine 24643 000223'01 254 00 0 00 000233' callret sndata ; Dump any data that came along with it 24644 000224'01 254 00 0 00 000222* retskp ; Successfully whined ... 24645 24646 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 15:18 11-Jun-23 Page 11 K20PDC MAC 9-Jun-23 22:41 Various Commands, many mostly dinky 24647 subttl Various Commands, many mostly dinky 24648 24649 000225'01 sndeot: remark Sending a "B" - End of Transmission 24650 000225'01 120 02 0 00 000000# smsg (<, End of Transmission>) 24651 000226'01 260 17 0 00 000215* 24652 000052'02 000000000000# 24653 000053'02 777777 777753 24654 000035'03 054 040 105 156 144 24655 000227'01 361 07 0 00 000224* sojl q3, RSKP ; Nothing here? That's fine 24656 000230'01 120 02 0 00 000000# smsg <: > ; Shouldn't have anything in it, but... 24657 000231'01 260 17 0 00 000226* 24658 000054'02 000000000000# 24659 000055'02 777777 777776 24660 000042'03 072 040 000 000 000 24661 000232'01 254 00 0 00 000235' callret sndat1 ; Dump it 24662 24663 24664 000233'01 sndata: remark Sending a "D" - Data Packet 24665 000233'01 120 02 0 00 000000# smsg <, Data: > ; The packet data 24666 000234'01 260 17 0 00 000231* 24667 000056'02 000000000000# 24668 000057'02 777777 777770 24669 000043'03 054 040 104 141 164 24670 000235'01 200 02 0 00 000202* sndat1: move t2, sdatpt ; Load pointer to data area of packet 24671 000236'01 210 03 0 00 000203* movn t3, datlen ; Length of same 24672 000237'01 322 03 0 00 000243' sndat2: ifn. t3 ; Ditch the SOUT% if nothing there 24673 000240'01 104 00 0 00 000053 SOUT% ; Spew that 24674 000241'01 320 12 0 00 000031' erjmpr deberr ; Or didn't 24675 000242'01 254 00 0 00 000245' else. ; That's odd 24676 000243'01 120 02 0 00 000000# smsg (<(null)>) ; Blat about it 24677 000244'01 260 17 0 00 000234* 24678 000060'02 000000000000# 24679 000061'02 777777 777772 24680 000045'03 050 156 165 154 154 24681 000245'01 endif. ; End case non-zero data 24682 000245'01 254 00 0 00 000227* retskp 24683 24684 24685 000246'01 snderr: remark Sending an "E" - Error (Fatal) 24686 000246'01 120 02 0 00 000000# smsg (<, Error>) 24687 000247'01 260 17 0 00 000244* 24688 000062'02 000000000000# 24689 000063'02 777777 777771 24690 000047'03 054 040 105 162 162 24691 000250'01 361 07 0 00 000245* sojl q3, RSKP ; Nothing here? That's fine 24692 000251'01 254 00 0 00 000233' callret sndata ; Dump it 24693 24694 24695 000252'01 sndfil: remark Sending a "F" - (Fetch or Name this File) 24696 000252'01 120 02 0 00 000000# smsg <, File: > ; The packet name 24697 000253'01 260 17 0 00 000247* 24698 000064'02 000000000000# 24699 000065'02 777777 777770 24700 000051'03 054 040 106 151 154 24701 000254'01 254 00 0 00 000235' callret sndat1 ; Dump it k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 15:18 11-Jun-23 Page 11-1 K20PDC MAC 9-Jun-23 22:41 Various Commands, many mostly dinky 24702 24703 24704 000255'01 sndinz: remark Sending an "I" - Initialization (here are my parameters) 24705 smsg (<, Initialization 24706 000255'01 120 02 0 00 000000# >) 24707 000256'01 260 17 0 00 000253* 24708 000066'02 000000000000# 24709 000067'02 777777 777752 24710 000053'03 054 040 111 156 151 24711 24712 000257'01 254 00 0 00 000511' callret params ; Break out the parameters 24713 24714 000260'01 sndnak: remark Sending an "N" - Negative acknowledgement 24715 000260'01 120 02 0 00 000000# smsg (<, Negative Acknowledge>) 24716 000261'01 260 17 0 00 000256* 24717 000070'02 000000000000# 24718 000071'02 777777 777752 24719 000060'03 054 040 116 145 147 24720 000262'01 254 00 0 00 000250* retskp 24721 24722 000263'01 sndrec: remark Sending an "R" - Receive (this file) 24723 000263'01 120 02 0 00 000000# smsg <, Receive: > ; The packet name 24724 000264'01 260 17 0 00 000261* 24725 000072'02 000000000000# 24726 000073'02 777777 777765 24727 000065'03 054 040 122 145 143 24728 000265'01 254 00 0 00 000235' callret sndat1 ; Dump it 24729 24730 24731 000266'01 sndini: remark Sending an "S" - Send Initiation 24732 smsg (<, Send Initiation 24733 000266'01 120 02 0 00 000000# >) 24734 000267'01 260 17 0 00 000264* 24735 000074'02 000000000000# 24736 000075'02 777777 777751 24737 000070'03 054 040 123 145 156 24738 24739 000270'01 254 00 0 00 000511' callret params ; Break out the parameters 24740 24741 000271'01 sndtxt: remark Sending an "X" - Display this data on terminal 24742 000271'01 120 02 0 00 000000# smsg <, Text: > ; ; The packet name 24743 000272'01 260 17 0 00 000267* 24744 000076'02 000000000000# 24745 000077'02 777777 777770 24746 000075'03 054 040 124 145 170 24747 000273'01 254 00 0 00 000235' callret sndat1 ; Dump it 24748 24749 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 15:18 11-Jun-23 Page 12 K20PDC MAC 9-Jun-23 22:41 Sending Acknowledgement table 24750 subttl Sending Acknowledgement table 24751 24752 .endps code ; Constant tables don't go in code 24753 .psect const ; they go into the constants psect 24754 24755 000100'02 000000000000# acktab: defack ; "A" - Attributes 24756 000101'02 000000000000# defack ; "B" - EOT 24757 000102'02 000000000000# defack ; "C" - Largely unimplemented host command 24758 000103'02 000000000000# defack ; "D" - Data 24759 000104'02 000000000000# errack ; "E" - Error packet 24760 000105'02 000000000000# defack ; "F" - File Header 24761 000106'02 000000000000# defack ; "G" - Sending a generic command 24762 000107'02 000000000000# defack ; "H" - Undefined 24763 000110'02 000000000000# inzack ; "I" - Info Packet 24764 000111'02 000000000000# UNDACK ; "J" - Undefined 24765 000112'02 000000000000# UNDACK ; "K" - Undefined 24766 000113'02 000000000000# UNDACK ; "L" - Undefined 24767 000114'02 000000000000# UNDACK ; "M" - Undefined 24768 000115'02 000000000000# errack ; "N" - Negative Acknowledge (NAK) 24769 000116'02 000000000000# UNDACK ; "O" - Undefined 24770 000117'02 000000000000# UNDACK ; "P" - Undefined 24771 000120'02 000000000000# UNDACK ; "Q" - Undefined 24772 000121'02 000000000000# defack ; "R" - Receive (GET) 24773 000122'02 000000000000# iniack ; "S" - Send 24774 000123'02 000000000000# defack ; "T" - Specially handled, somehow 24775 000124'02 000000000000# UNDACK ; "U" - Undefined 24776 000125'02 000000000000# UNDACK ; "V" - Undefined 24777 000126'02 000000000000# UNDACK ; "W" - Undefined 24778 000127'02 000000000000# defack ; "X" - Text Header 24779 000130'02 000000000000# errack ; "Y" - Acknowledge (ACK) 24780 000131'02 000000000000# defack ; "Z" - EOF 24781 24782 .endps const ; Done with constants 24783 .psect code ; Back to generating code 24784 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 15:18 11-Jun-23 Page 13 K20PDC MAC 9-Jun-23 22:41 Acknowledgement dispatch 24785 subttl Acknowledgement dispatch 24786 24787 000274'01 265 16 0 00 001024' sndack: saveac ; Needs some scratch 24788 000275'01 200 05 0 00 000235* move q1, sdatpt ; Load the pointer to the packet's data field 24789 000276'01 200 07 0 00 000236* move q3, datlen ; Number of initialization bytes 24790 24791 000277'01 200 04 0 00 000000# move t4, lstpkt ; Load what we should be acknowledging 24792 000300'01 405 04 0 00 000177 andi t4, 177 ;[235] Strip off any parity 24793 000301'01 200 03 0 00 000004 move t3, t4 ; Save a working copy 24794 000302'01 275 03 0 00 000101 subi t3, "A" ; Bring into offset range 24795 000303'01 254 00 1 03 000000# callret @acktab(t3) ; Continue the right routine 24796 24797 24798 000304'01 UNDACK: remark ; Packet type the Kermit-20 does not do 24799 000304'01 120 02 0 00 000000# smsg (<, Undefined Acknowlege for packet type: ">) ;" Fool font crock mode 24800 000305'01 260 17 0 00 000272* 24801 000132'02 000000000000# 24802 000133'02 777777 777727 24803 000077'03 054 040 125 156 144 24804 000306'01 254 00 0 00 000216' callret invsn1 ; Finish logging it 24805 24806 000307'01 errack: remark ; Shouldn't acknowledge "Y", "N" or "E" 24807 000307'01 120 02 0 00 000000# smsg (<, ERROR: should not be acknowledging a packet type: ">) ;" Fool 24808 000310'01 260 17 0 00 000305* 24809 000134'02 000000000000# 24810 000135'02 777777 777713 24811 000110'03 054 040 105 122 122 24812 000311'01 254 00 0 00 000216' callret invsn1 ; Finish logging it 24813 24814 000312'01 iniack: remark ; Response to "S" 24815 smsg (<, Send Initiation Acknowledgement 24816 000312'01 120 02 0 00 000000# >) 24817 000313'01 260 17 0 00 000310* 24818 000136'02 000000000000# 24819 000137'02 777777 777731 24820 000123'03 054 040 123 145 156 24821 24822 000314'01 254 00 0 00 000511' callret params ; Break out the parameters 24823 24824 000315'01 inzack: remark ; Response to "I" 24825 smsg (<, Initialization Acknowledgement 24826 000315'01 120 02 0 00 000000# >) 24827 000316'01 260 17 0 00 000313* 24828 000140'02 000000000000# 24829 000141'02 777777 777732 24830 000133'03 054 040 111 156 151 24831 24832 000317'01 254 00 0 00 000511' callret params ; Break out the parameters 24833 24834 000320'01 defack: remark ; All others is to print any contents 24835 000320'01 326 07 0 00 000336' ife. q3 ; If none, then nothing further to do 24836 000321'01 120 02 0 00 000000# smsg (<, Acknowledged packet type ">) ;" Fool font crock mode 24837 000322'01 260 17 0 00 000316* 24838 000142'02 000000000000# 24839 000143'02 777777 777744 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 15:18 11-Jun-23 Page 13-1 K20PDC MAC 9-Jun-23 22:41 Acknowledgement dispatch 24840 000143'03 054 040 101 143 153 24841 000323'01 200 02 0 00 000004 move t2, t4 ; Load what we're acknowledging 24842 000324'01 405 02 0 00 000177 andi t2, 177 ;[235] Strip off any parity 24843 000325'01 260 17 0 00 000221* call BOUTI% ; Append to log 24844 000326'01 302 02 0 00 000107 caie t2, "G" ; Was this a generic command? 24845 000327'01 254 00 0 00 000333' ifskp. ; It was, so provide a little more clarity 24846 000330'01 200 02 0 00 000000# move t2, lstgen ; Load the kind of last generic 24847 000331'01 405 02 0 00 000177 andi t2, 177 ;[235] Strip off any parity 24848 000332'01 260 17 0 00 000325* call BOUTI% ; Append to log 24849 000333'01 endif. 24850 000333'01 201 02 0 00 000042 movei t2, .chdbq ; Closing double quote 24851 000334'01 260 17 0 00 000332* call BOUTI% ; Append that, too 24852 000335'01 254 00 0 00 000262* retskp ; Worked, wonderfully... 24853 000336'01 endif. 24854 24855 000336'01 120 02 0 00 000000# smsg (<, Ack(>) ; Short acknowledgement 24856 000337'01 260 17 0 00 000322* 24857 000144'02 000000000000# 24858 000145'02 777777 777772 24859 000151'03 054 040 101 143 153 24860 000340'01 200 02 0 00 000004 move t2, t4 ; Load what we're acknowledging 24861 000341'01 405 02 0 00 000177 andi t2, 177 ;[235] Strip off any parity 24862 000342'01 260 17 0 00 000334* call BOUTI% ; Append to log 24863 000343'01 302 02 0 00 000107 caie t2, "G" ; Was this a generic command? 24864 000344'01 254 00 0 00 000350' ifskp. ; It was, so provide a little more clarity 24865 000345'01 200 02 0 00 000000# move t2, lstgen ; By getting the last generic command 24866 000346'01 405 02 0 00 000177 andi t2, 177 ;[235] Strip off any parity 24867 000347'01 260 17 0 00 000342* call BOUTI% ; Append to log 24868 000350'01 endif. 24869 000350'01 120 02 0 00 000000# smsg (<), >) ; Close and space over 24870 000351'01 260 17 0 00 000337* 24871 000146'02 000000000000# 24872 000147'02 777777 777775 24873 000153'03 051 054 040 000 000 24874 24875 000352'01 200 02 0 00 000005 move t2, q1 ; Load the pointer to the data area 24876 000353'01 210 03 0 00 000007 movn t3, q3 ; Negative length of data area 24877 000354'01 104 00 0 00 000053 SOUT% ; Get the response into the log 24878 000355'01 320 12 0 00 000031' erjmpr deberr ; Or didn't... 24879 000356'01 254 00 0 00 000335* retskp ; Worked!! 24880 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 15:18 11-Jun-23 Page 14 K20PDC MAC 9-Jun-23 22:41 Sending a "Z" - End of File 24881 subttl Sending a "Z" - End of File 24882 24883 000357'01 120 02 0 00 000000# sndeof: smsg (<, End of File>) 24884 000360'01 260 17 0 00 000351* 24885 000150'02 000000000000# 24886 000151'02 777777 777763 24887 000154'03 054 040 105 156 144 24888 000361'01 200 05 0 00 000275* move q1, sdatpt ; Load the pointer the packet's data field 24889 000362'01 200 07 0 00 000276* move q3, datlen ; Number of initialization bytes 24890 ; See if being told to discard file 24891 000363'01 361 07 0 00 000356* sojl q3, RSKP ; But only if there is a character 24892 000364'01 134 06 0 00 000005 ildb q2, q1 ; Load the action character 24893 000365'01 405 06 0 00 000177 andi q2, 177 ;[235] Strip off any parity 24894 000366'01 302 06 0 00 000104 caie q2, "D" ; Got told to discard? 24895 000367'01 254 00 0 00 000373' ifskp. ; We did 24896 000370'01 120 02 0 00 000000# smsg (<, Discarding>) ; Blat about it 24897 000371'01 260 17 0 00 000360* 24898 000152'02 000000000000# 24899 000153'02 777777 777764 24900 000157'03 054 040 104 151 163 24901 000372'01 254 00 0 00 000376' else. ; Otherwise, something odd 24902 000373'01 120 02 0 00 000000# smsg (<, >) ; So blat about that 24903 000374'01 260 17 0 00 000371* 24904 000154'02 000000000000# 24905 000155'02 777777 777776 24906 000162'03 054 040 000 000 000 24907 000375'01 254 00 0 00 000235' callret sndat1 ; and put into the log 24908 000376'01 endif. ; End of Discard decision 24909 24910 000376'01 254 00 0 00 000363* retskp ; Successfully decode the packet 24911 24912 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 15:18 11-Jun-23 Page 15 K20PDC MAC 9-Jun-23 22:41 Generic Send Packet Types 24913 subttl Generic Send Packet Types 24914 24915 .endps code ; Constant tables don't go in code 24916 .psect const ; they go into the constants psect 24917 24918 000156'02 000000000000# sgenpt: genpwd ; A - PWD 24919 000157'02 000000000000# INVGEN ; B - Undefined 24920 000160'02 000000000000# gencwd ; C - CWD 24921 000161'02 000000000000# gendir ; D - Directory 24922 000162'02 000000000000# gendel ; E - Erase (delete) 24923 000163'02 000000000000# genfin ; F - Finish 24924 000164'02 000000000000# INVGEN ; G - Undefined 24925 000165'02 000000000000# genhlp ; H - Help 24926 000166'02 000000000000# INVGEN ; I - Login (not yet implemented) 24927 000167'02 000000000000# INVGEN ; J - Journal control (nyi) 24928 000170'02 000000000000# INVGEN ; K - Copy (nyi) 24929 000171'02 000000000000# genbye ; L - Logout, Bye 24930 000172'02 000000000000# INVGEN ; M - Undefined 24931 000173'02 000000000000# INVGEN ; N - Undefined 24932 000174'02 000000000000# INVGEN ; O - Undefined 24933 000175'02 000000000000# INVGEN ; P - Program invocation (nyi) 24934 000176'02 000000000000# gensta ; Q - Server status query 24935 000177'02 000000000000# INVGEN ; R - Rename (nyi) 24936 000200'02 000000000000# INVGEN ; S - Undefined 24937 000201'02 000000000000# INVGEN ; T - Type 24938 000202'02 000000000000# gendsk ; U - Disk Usage 24939 000203'02 000000000000# INVGEN ; V - Variable Set/Query 24940 000204'02 000000000000# INVGEN ; W - Who (Finger) 24941 000205'02 000000000000# INVGEN ; X - Undefined 24942 000206'02 000000000000# INVGEN ; Y - Undefined 24943 000207'02 000000000000# INVGEN ; Z - Undefined 24944 24945 .endps const ; Done with constants 24946 .psect code ; Back to generating code 24947 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 15:18 11-Jun-23 Page 16 K20PDC MAC 9-Jun-23 22:41 Send Generic Command 24948 subttl Send Generic Command 24949 24950 000377'01 sndgen: remark t1, p3 ; Already loaded with JFN 24951 000377'01 120 02 0 00 000000# smsg <, Generic, > ; A generic packet type 24952 000400'01 260 17 0 00 000374* 24953 000210'02 000000000000# 24954 000211'02 777777 777765 24955 000163'03 054 040 107 145 156 24956 24957 000401'01 371 00 0 00 000007 sosl q3 ; Malformed? 24958 000402'01 254 00 0 00 000406' ifskp. ; It is 24959 000403'01 120 02 0 00 000000# smsg (<(% No action character)>) 24960 000404'01 260 17 0 00 000400* 24961 000212'02 000000000000# 24962 000213'02 777777 777751 24963 000166'03 050 045 040 116 157 24964 000405'01 254 00 0 00 000376* retskp ; Handled malformed character OK 24965 000406'01 endif. 24966 24967 000406'01 134 04 0 00 000005 ildb t4, q1 ; Pick up the generic command character 24968 000407'01 405 04 0 00 000177 andi t4, 177 ;[235] Strip off any parity 24969 000410'01 301 04 0 00 000101 cail t4, "A" ; Before "A"? 24970 000411'01 303 04 0 00 000132 caile t4, "Z" ; or after "Z"? 24971 000412'01 254 00 0 00 000417' jrst invgen ; Can't do the jump table 24972 000413'01 202 04 0 00 000000# movem t4, lstgen ; Set last generic 24973 24974 000414'01 200 03 0 00 000004 move t3, t4 ; Save a copy in case of error 24975 000415'01 275 03 0 00 000101 subi t3, "A" ; Bring into offset range 24976 000416'01 254 00 1 03 000000# callret @sgenpt(t3) ; Invoke the correct decoding routine 24977 24978 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 15:18 11-Jun-23 Page 17 K20PDC MAC 9-Jun-23 22:41 Invalid Generic message type 24979 subttl Invalid Generic message type 24980 24981 000417'01 120 02 0 00 000000# INVGEN: smsg () ;" Fool font crock mode 24982 000420'01 260 17 0 00 000404* 24983 000214'02 000000000000# 24984 000215'02 777777 777751 24985 000173'03 111 156 166 141 154 24986 000421'01 254 00 0 00 000216' callret invsn1 ; Finish logging it 24987 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 15:18 11-Jun-23 Page 18 K20PDC MAC 9-Jun-23 22:41 Trivial Generic Requests 24988 subttl Trivial Generic Requests 24989 24990 000422'01 genpwd: remark "A" 24991 000422'01 120 02 0 00 000000# smsg () 24992 000423'01 260 17 0 00 000420* 24993 000216'02 000000000000# 24994 000217'02 777777 777751 24995 000200'03 120 162 151 156 164 24996 000424'01 254 00 0 00 000405* retskp 24997 24998 000425'01 gencwd: remark "C" 24999 000425'01 120 02 0 00 000000# smsg () 25000 000426'01 260 17 0 00 000423* 25001 000220'02 000000000000# 25002 000221'02 777777 777750 25003 000205'03 103 150 141 156 147 25004 000427'01 260 17 0 00 000457' call genarg ; Print the working directory, if any 25005 000430'01 600 00 0 00 000000 nop ; Ignore error 25006 000431'01 254 00 0 00 000424* retskp 25007 25008 000432'01 gendir: remark "D" 25009 000432'01 120 02 0 00 000000# smsg () 25010 000433'01 260 17 0 00 000426* 25011 000222'02 000000000000# 25012 000223'02 777777 777767 25013 000212'03 104 151 162 145 143 25014 000434'01 254 00 0 00 000457' callret genarg 25015 25016 000435'01 gendel: remark "E" 25017 000435'01 120 02 0 00 000000# smsg () 25018 000436'01 260 17 0 00 000433* 25019 000224'02 000000000000# 25020 000225'02 777777 777773 25021 000214'03 105 162 141 163 145 25022 000437'01 254 00 0 00 000457' callret genarg 25023 25024 000440'01 genfin: remark "F" 25025 000440'01 120 02 0 00 000000# smsg () 25026 000441'01 260 17 0 00 000436* 25027 000226'02 000000000000# 25028 000227'02 777777 777772 25029 000216'03 106 151 156 151 163 25030 000442'01 254 00 0 00 000431* retskp 25031 25032 000443'01 genhlp: remark "H" 25033 000443'01 120 02 0 00 000000# smsg () 25034 000444'01 260 17 0 00 000441* 25035 000230'02 000000000000# 25036 000231'02 777777 777774 25037 000220'03 110 145 154 160 000 25038 000445'01 254 00 0 00 000442* retskp 25039 25040 000446'01 genbye: remark "L" 25041 000446'01 120 02 0 00 000000# smsg () 25042 000447'01 260 17 0 00 000444* k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 15:18 11-Jun-23 Page 18-1 K20PDC MAC 9-Jun-23 22:41 Trivial Generic Requests 25043 000232'02 000000000000# 25044 000233'02 777777 777772 25045 000221'03 114 157 147 157 165 25046 000450'01 254 00 0 00 000445* retskp 25047 25048 000451'01 gensta: remark "Q" 25049 000451'01 120 02 0 00 000000# smsg () 25050 000452'01 260 17 0 00 000447* 25051 000234'02 000000000000# 25052 000235'02 777777 777755 25053 000223'03 123 145 162 166 145 25054 000453'01 254 00 0 00 000450* retskp 25055 25056 000454'01 gendsk: remark "U" 25057 000454'01 120 02 0 00 000000# smsg () 25058 000455'01 260 17 0 00 000452* 25059 000236'02 000000000000# 25060 000237'02 777777 777766 25061 000227'03 104 151 163 153 040 25062 000456'01 254 00 0 00 000453* retskp 25063 25064 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 15:18 11-Jun-23 Page 19 K20PDC MAC 9-Jun-23 22:41 Generic Argument Decode 25065 subttl Generic Argument Decode 25066 25067 000457'01 361 07 0 00 000456* genarg: sojl q3, RSKP ; If nothing left, we're done 25068 000460'01 134 04 0 00 000005 ildb t4, q1 ; Pick up the length of the argument 25069 000461'01 405 04 0 00 000177 andi t4, 177 ;[235] Strip off any parity 25070 25071 000462'01 200 12 0 00 000000* move p2, rquote ; Let's assume we are receiving 25072 000463'01 302 11 0 00 000122 caie p1, "R" ; However, are we? 25073 000464'01 200 12 0 00 000000* move p2, squote ; Nope, we are sending 25074 25075 000465'01 do. ; Enter loop context for each argument 25076 000465'01 312 12 0 00 000004 came p2, t4 ; Is the length the same as the quote 25077 000466'01 254 00 0 00 000472' ifskp. ; They are, so then the length has to be quoted 25078 000467'01 361 07 0 00 000457* sojl q3, RSKP ; If nothing left, we're done 25079 000470'01 134 04 0 00 000005 ildb t4, q1 ; Pick up the length of this argument 25080 000471'01 405 04 0 00 000177 andi t4, 177 ;[235] Strip off any parity 25081 000472'01 endif. ; End case quoted length 25082 000472'01 275 04 0 00 000040 subi t4, .chspc ; Bring into numeric range 25083 000473'01 323 04 0 00 000467* jumple t4, RSKP ; No argument, depart 25084 000474'01 120 02 0 00 000000# smsg (<, >) ; Punctuate the argument 25085 000475'01 260 17 0 00 000455* 25086 000240'02 000000000000# 25087 000241'02 777777 777776 25088 000232'03 054 040 000 000 000 25089 000476'01 200 02 0 00 000005 move t2, q1 ; Load the properly advanced pointer 25090 000477'01 210 03 0 00 000004 movn t3, t4 ; Load the negative length 25091 000500'01 104 00 0 00 000053 SOUT% ; Put into the log 25092 000501'01 320 14 0 00 000000* erjmps r ; Shouldn't happen, JFN was fine 25093 000502'01 200 05 0 00 000002 move q1, t2 ; Update packet pointer 25094 000503'01 274 07 0 00 000004 sub q3, t4 ; Count off the characters we did 25095 000504'01 361 07 0 00 000473* sojl q3, RSKP ; See if we have another field and exit if not 25096 000505'01 134 04 0 00 000005 ildb t4, q1 ; Pick up the length of the argument 25097 000506'01 405 04 0 00 000177 andi t4, 177 ;[235] Strip off any parity 25098 000507'01 254 00 0 00 000465' loop. ; And go take care of that 25099 000510'01 enddo. ; End loop lexical context 25100 25101 000510'01 254 00 0 00 000504* retskp ; Superstition 25102 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 15:18 11-Jun-23 Page 20 K20PDC MAC 9-Jun-23 22:41 Break out parameters for S and I packets 25103 subttl Break out parameters for S and I packets 25104 25105 ; Call: 25106 ; 25107 ; q1/ Pointer to packet's data field 25108 ; *q2/ Used internally for packet characters 25109 ; q3/ Number of bytes in packet's data field 25110 ; 25111 ; Return: 25112 ; 25113 ; +1 Some kind of failure 25114 ; +2 Successfully decoded 25115 25116 000511'01 120 02 0 00 000000# params: smsg () 25117 000512'01 260 17 0 00 000475* 25118 000242'02 000000000000# 25119 000243'02 777777 777770 25120 000233'03 120 141 162 141 155 25121 000513'01 200 02 0 00 000362* move t2, datlen 25122 000514'01 201 03 0 00 000012 movei t3, ^d10 25123 000515'01 104 00 0 00 000224 NOUT% 25124 000516'01 320 12 0 00 000501* erjmpr r 25125 25126 000517'01 361 07 0 00 000510* sojl q3, RSKP ; Only if there 25127 000520'01 134 06 0 00 000005 ildb q2, q1 ; Load the maximum length 25128 000521'01 405 06 0 00 000177 andi q2, 177 ;[235] Strip off any parity 25129 000522'01 120 02 0 00 000000# smsg (<, MaxL: >) 25130 000523'01 260 17 0 00 000512* 25131 000244'02 000000000000# 25132 000245'02 777777 777770 25133 000235'03 054 040 115 141 170 25134 000524'01 200 02 0 00 000006 move t2, q2 25135 000525'01 275 02 0 00 000040 subi t2, .chspc 25136 000526'01 201 03 0 00 000012 movei t3, ^d10 25137 000527'01 104 00 0 00 000224 NOUT% ; 1 Packet size 25138 000530'01 320 12 0 00 000516* erjmpr r 25139 25140 000531'01 361 07 0 00 000517* sojl q3, RSKP ; Only if there 25141 000532'01 134 06 0 00 000005 ildb q2, q1 ; Load the time out 25142 000533'01 405 06 0 00 000177 andi q2, 177 ;[235] Strip off any parity 25143 000534'01 120 02 0 00 000000# smsg (<, TimO: >) 25144 000535'01 260 17 0 00 000523* 25145 000246'02 000000000000# 25146 000247'02 777777 777770 25147 000237'03 054 040 124 151 155 25148 000536'01 200 02 0 00 000006 move t2, q2 25149 000537'01 275 02 0 00 000040 subi t2, .chspc 25150 000540'01 201 03 0 00 000012 movei t3, ^d10 25151 000541'01 104 00 0 00 000224 NOUT% ; 2 Time out 25152 000542'01 320 12 0 00 000530* erjmpr r 25153 25154 000543'01 361 07 0 00 000531* sojl q3, RSKP ; Only if there 25155 000544'01 134 06 0 00 000005 ildb q2, q1 ; Load the number of padding characters 25156 000545'01 405 06 0 00 000177 andi q2, 177 ;[235] Strip off any parity 25157 000546'01 120 02 0 00 000000# smsg (<, Npad: >) k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 15:18 11-Jun-23 Page 20-1 K20PDC MAC 9-Jun-23 22:41 Break out parameters for S and I packets 25158 000547'01 260 17 0 00 000535* 25159 000250'02 000000000000# 25160 000251'02 777777 777770 25161 000241'03 054 040 116 160 141 25162 000550'01 200 02 0 00 000006 move t2, q2 25163 000551'01 275 02 0 00 000040 subi t2, .chspc 25164 000552'01 201 03 0 00 000012 movei t3, ^d10 25165 000553'01 104 00 0 00 000224 NOUT% ; 3 Padding (character count) 25166 000554'01 320 12 0 00 000542* erjmpr r 25167 25168 000555'01 361 07 0 00 000543* sojl q3, RSKP ; Only if there 25169 000556'01 134 06 0 00 000005 ildb q2, q1 ; Load the padding character 25170 000557'01 405 06 0 00 000177 andi q2, 177 ;[235] Strip off any parity 25171 000560'01 120 02 0 00 000000# smsg (<, PadC: >) ; 4 25172 000561'01 260 17 0 00 000547* 25173 000252'02 000000000000# 25174 000253'02 777777 777770 25175 000243'03 054 040 120 141 144 25176 000562'01 200 02 0 00 000006 move t2, q2 25177 000563'01 271 02 0 00 000100 addi t2, ^o100 ; It's in excess 64 (decimal) 25178 000564'01 405 02 0 00 000177 andi t2, ^o177 ; Clip if it went to eight bits 25179 000565'01 260 17 0 00 000756' call outc ; Output as a control character 25180 25181 000566'01 361 07 0 00 000555* sojl q3, RSKP ; Only if there 25182 000567'01 134 06 0 00 000005 ildb q2, q1 ; Load the packet terminator 25183 000570'01 405 06 0 00 000177 andi q2, 177 ;[235] Strip off any parity 25184 000571'01 120 02 0 00 000000# smsg (<, EOL: >) ; 5 25185 000572'01 260 17 0 00 000561* 25186 000254'02 000000000000# 25187 000255'02 777777 777771 25188 000245'03 054 040 105 117 114 25189 000573'01 200 02 0 00 000006 move t2, q2 25190 000574'01 275 02 0 00 000040 subi t2, .chspc ; Bring into control range 25191 000575'01 260 17 0 00 000756' call outc ; Output as a control character 25192 25193 000576'01 361 07 0 00 000566* sojl q3, RSKP ; Only if there 25194 000577'01 134 06 0 00 000005 ildb q2, q1 ; Load the control prefix 25195 000600'01 405 06 0 00 000177 andi q2, 177 ;[235] Strip off any parity 25196 000601'01 120 02 0 00 000000# smsg (<, Qctl: >) ; 6 25197 000602'01 260 17 0 00 000572* 25198 000256'02 000000000000# 25199 000257'02 777777 777770 25200 000247'03 054 040 121 143 164 25201 000603'01 200 02 0 00 000006 move t2, q2 25202 000604'01 260 17 0 00 000756' call outc ; Output as a control character 25203 25204 000605'01 361 07 0 00 000576* sojl q3, RSKP ; Only if there 25205 000606'01 134 06 0 00 000005 ildb q2, q1 ; Load the eight bit quote 25206 000607'01 405 06 0 00 000177 andi q2, 177 ;[235] Strip off any parity 25207 000610'01 120 02 0 00 000000# smsg (<, Qbin: >) ; 7 25208 000611'01 260 17 0 00 000602* 25209 000260'02 000000000000# 25210 000261'02 777777 777770 25211 000251'03 054 040 121 142 151 25212 000612'01 200 02 0 00 000006 move t2, q2 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 15:18 11-Jun-23 Page 20-2 K20PDC MAC 9-Jun-23 22:41 Break out parameters for S and I packets 25213 000613'01 302 02 0 00 000131 caie t2, "Y" ; Am I agreeing? 25214 000614'01 254 00 0 00 000620' ifskp. ; I'm agreeable 25215 000615'01 120 02 0 00 000000# smsg 25216 000616'01 260 17 0 00 000611* 25217 000262'02 000000000000# 25218 000263'02 777777 777775 25219 000253'03 131 145 163 000 000 25220 000617'01 254 00 0 00 000626' else. ; Otherwise, could be other things 25221 000620'01 302 02 0 00 000116 caie t2, "N" ; Am I refusing 8 bit 25222 000621'01 254 00 0 00 000625' ifskp. ; I'm disagreeble 25223 000622'01 120 02 0 00 000000# smsg 25224 000623'01 260 17 0 00 000616* 25225 000264'02 000000000000# 25226 000265'02 777777 777776 25227 000254'03 116 157 000 000 000 25228 000624'01 254 00 0 00 000626' else. ; Neither one is the 8 bit quote character 25229 000625'01 260 17 0 00 000756' call outc ; Output as a possible control character 25230 000626'01 endif. ; End case No or actual character 25231 000626'01 endif. ; End case Yes or something else 25232 25233 000626'01 361 07 0 00 000605* sojl q3, RSKP ; Only if there 25234 000627'01 134 06 0 00 000005 ildb q2, q1 ; Load the block check type 25235 000630'01 405 06 0 00 000177 andi q2, 177 ;[235] Strip off any parity 25236 000631'01 120 02 0 00 000000# smsg (<, ChkT: >) ; 8 25237 000632'01 260 17 0 00 000623* 25238 000266'02 000000000000# 25239 000267'02 777777 777770 25240 000255'03 054 040 103 150 153 25241 000633'01 200 04 0 00 000006 move t4, q2 25242 000634'01 120 02 0 00 000000# dxtext (t2, ) 25243 000270'02 000000000000# 25244 000271'02 777777 777761 25245 000257'03 040 074 117 165 164 25246 000635'01 306 04 0 00 000061 cain t4, "1" 25247 000636'01 120 02 0 00 000000# dxtext (t2,<6-bit>) 25248 000272'02 000000000000# 25249 000273'02 777777 777773 25250 000263'03 066 055 142 151 164 25251 000637'01 306 04 0 00 000062 cain t4, "2" 25252 000640'01 120 02 0 00 000000# dxtext (t2,<12-bit>) 25253 000274'02 000000000000# 25254 000275'02 777777 777772 25255 000265'03 061 062 055 142 151 25256 000641'01 306 04 0 00 000063 cain t4, "3" 25257 000642'01 120 02 0 00 000000# dxtext (t2,<16-bit CRC>) 25258 000276'02 000000000000# 25259 000277'02 777777 777766 25260 000267'03 061 066 055 142 151 25261 000643'01 260 17 0 00 000632* call %%smsg ; Handle as if I did an smsg 25262 25263 000644'01 361 07 0 00 000626* sojl q3, RSKP ; Only if there 25264 000645'01 134 06 0 00 000005 ildb q2, q1 ; Load the repeat count prefix 25265 000646'01 405 06 0 00 000177 andi q2, 177 ;[235] Strip off any parity 25266 000647'01 120 02 0 00 000000# smsg (<, Rept: >) ; 9 25267 000650'01 260 17 0 00 000643* k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 15:18 11-Jun-23 Page 20-3 K20PDC MAC 9-Jun-23 22:41 Break out parameters for S and I packets 25268 000300'02 000000000000# 25269 000301'02 777777 777770 25270 000272'03 054 040 122 145 160 25271 000651'01 200 02 0 00 000006 move t2, q2 25272 000652'01 260 17 0 00 000347* call BOUTI% 25273 25274 remark Extended capabilities 25275 25276 000653'01 361 07 0 00 000644* sojl q3, RSKP ; If nothing left, we're done 25277 000654'01 134 06 0 00 000005 ildb q2, q1 ; Otherwise, pick up first capability mask 25278 000655'01 405 06 0 00 000177 andi q2, 177 ;[235] Strip off any parity 25279 000656'01 275 06 0 00 000040 subi q2, .chspc ; Bring into numeric range 25280 000657'01 606 06 0 00 000002 trnn q2, 2 ; Is the Long Packets capability bit on? 25281 000660'01 254 00 0 00 000653* retskp ; No, we can't do anything else 25282 000661'01 120 02 0 00 000000# smsg (<, Long: >) ; 10 25283 000662'01 260 17 0 00 000650* 25284 000302'02 000000000000# 25285 000303'02 777777 777770 25286 000274'03 054 040 114 157 156 25287 25288 000663'01 415 16 0 00 000705' block. ; Enter block context for better control flow 25289 000664'01 261 17 0 00 000016 25290 000665'01 361 07 0 00 000554* sojl q3, r ; Stop if Sliding Windows isn't there 25291 000666'01 134 06 0 00 000005 ildb q2, q1 ; Yet ignore it because we don't do it 25292 000667'01 405 06 0 00 000177 andi q2, 177 ;[235] Strip off any parity 25293 000670'01 361 07 0 00 000665* sojl q3, r ; Stop if high order is not there 25294 000671'01 134 02 0 00 000005 ildb t2, q1 ; Load the high order 25295 000672'01 405 02 0 00 000177 andi t2, 177 ;[235] Strip off any parity 25296 000673'01 275 02 0 00 000040 subi t2, .chspc ; Bring into numeric range 25297 000674'01 221 02 0 00 000137 imuli t2, ^d95 ; High digit is base 94 25298 000675'01 361 07 0 00 000670* sojl q3, r ; Fail if low order is not there 25299 000676'01 134 03 0 00 000005 ildb t3, q1 ; It's there, load it 25300 000677'01 405 03 0 00 000177 andi t3, 177 ;[235] Strip off any parity 25301 000700'01 275 03 0 00 000040 subi t3, .chspc ; Bring into numeric range 25302 000701'01 270 02 0 00 000003 add t2, t3 ; Combine with high order 25303 000702'01 201 03 0 00 000012 movei t3, ^d10 ; Base 10 25304 000703'01 254 00 0 00 000660* retskp ; Flag we're actually doing long windows 25305 000704'01 263 17 0 00 000000 endbk. ; End block context 25306 000705'01 254 00 0 00 000712' ifskp. ; Have a number to type 25307 000706'01 104 00 0 00 000224 NOUT% ; Type it 25308 000707'01 320 12 0 00 000675* erjmpr r ; Or not 25309 000710'01 254 00 0 00 000703* retskp ; Succeed 25310 000711'01 254 00 0 00 000715' else. ; Otherwise, this is a request 25311 000712'01 120 02 0 00 000000# smsg () ; Say we'll accept it 25312 000713'01 260 17 0 00 000662* 25313 000304'02 000000000000# 25314 000305'02 777777 777767 25315 000276'03 101 166 141 151 154 25316 000714'01 254 00 0 00 000710* retskp ; This is OK, too 25317 000715'01 endif. 25318 25319 000715'01 254 00 0 00 000714* retskp ; This is superstition 25320 25321 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 15:18 11-Jun-23 Page 21 K20PDC MAC 9-Jun-23 22:41 Packet Header 25322 subttl Packet Header 25323 25324 ; t4/ "R" or "S", depending on what we're doing 25325 25326 000716'01 200 01 0 00 000013 pkthdr: move t1, p3 ; Load the logging JFN 25327 000717'01 120 02 0 00 000000# smsg <, type: > ; The packet type 25328 000720'01 260 17 0 00 000713* 25329 000306'02 000000000000# 25330 000307'02 777777 777770 25331 000300'03 054 040 164 171 160 25332 000721'01 200 02 0 00 000162* move t2, type ; Message Type 25333 000722'01 405 02 0 00 000177 andi t2, 177 ;[235] Strip off any parity 25334 000723'01 260 17 0 00 000652* call BOUTI% ; Will further expand downstream 25335 000724'01 200 04 0 00 000002 move t4, t2 ; Save a copy of the type 25336 25337 000725'01 120 02 0 00 000000# smsg <, seq: > ; The sequence number 25338 000726'01 260 17 0 00 000720* 25339 000310'02 000000000000# 25340 000311'02 777777 777771 25341 000302'03 054 040 163 145 161 25342 000727'01 200 02 0 00 000000* move t2, sseqn ; Load the Sending Packet Number 25343 000730'01 302 04 0 00 000123 caie t4, "S" ; But are we? 25344 000731'01 200 02 0 00 000000* move t2, num ; No, so load the received Packet Number 25345 000732'01 201 03 0 00 000012 movei t3, ^d10 ; It's in base 10 25346 000733'01 104 00 0 00 000224 NOUT% ; Type that 25347 000734'01 320 12 0 00 000031' erjmpr deberr ; Or not... 25348 25349 000735'01 120 02 0 00 000000# smsg <, len: > ; Total packet length 25350 000736'01 260 17 0 00 000726* 25351 000312'02 000000000000# 25352 000313'02 777777 777771 25353 000304'03 054 040 154 145 156 25354 000737'01 200 02 0 00 000000* move t2, pktlen ; Includes the checksum 25355 000740'01 201 03 0 00 000012 movei t3, ^d10 ; It's in base 10 25356 000741'01 104 00 0 00 000224 NOUT% ; Type that 25357 000742'01 320 12 0 00 000031' erjmpr deberr ; Or not... 25358 25359 000743'01 336 00 0 00 000000* ifmn. islong ; Was this a long packet? 25360 000744'01 254 00 0 00 000747' 25361 000745'01 201 02 0 00 000114 movei t2, "L" ; Load flag for long packet 25362 000746'01 260 17 0 00 000723* call BOUTI% ; Append it as a c-like suffix 25363 000747'01 endif. ; End case long packet 25364 25365 000747'01 120 02 0 00 000000# smsg <, Blk: > ; Computed block check 25366 000750'01 260 17 0 00 000736* 25367 000314'02 000000000000# 25368 000315'02 777777 777771 25369 000306'03 054 040 102 154 153 25370 000751'01 200 02 0 00 000000* move t2, blkchk ; Load it 25371 000752'01 201 03 0 00 000012 movei t3, ^d10 ; We'll just use base 10 25372 000753'01 104 00 0 00 000224 NOUT% ; Type it 25373 000754'01 320 12 0 00 000031' erjmpr deberr ; Or not 25374 25375 000755'01 254 00 0 00 000715* retskp ; Worked 25376 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 15:18 11-Jun-23 Page 22 K20PDC MAC 9-Jun-23 22:41 outc -- Output a single character, using ^X notation, DEL, etc. 25377 subttl outc -- Output a single character, using ^X notation, DEL, etc. 25378 25379 ; Call: 25380 ; 25381 ; t1/ JFN 25382 ; t2/ Character to frobinicate 25383 25384 extern BOUTI% ; In case this is going into a string 25385 25386 000756'01 405 02 0 00 000177 outc: andi t2, 177 ;[235] Strip off any parity 25387 000757'01 302 02 0 00 000177 caie t2, .chdel ; A rubout? 25388 000760'01 254 00 0 00 000764' ifskp. ; It is 25389 000761'01 120 02 0 00 000000# smsg ; Show it this way (^? being confusing?) 25390 000762'01 260 17 0 00 000750* 25391 000316'02 000000000000# 25392 000317'02 777777 777775 25393 000310'03 104 105 114 000 000 25394 000763'01 263 17 0 00 000000 ret ; Succeed 25395 000764'01 endif. 25396 25397 000764'01 301 02 0 00 000040 cail t2, .chspc ; Is it a control character? 25398 000765'01 254 00 0 00 000773' ifskp. ; It is 25399 000766'01 261 17 0 00 000002 push p, t2 ; Save the character 25400 000767'01 201 02 0 00 000136 movei t2, "^" ; Load the control quote 25401 000770'01 260 17 0 00 000746* call BOUTI% ; Output that 25402 000771'01 262 17 0 00 000002 pop p, t2 ; Restore original character 25403 000772'01 435 02 0 00 000100 ori t2, ^o100 ; Bring into printable range 25404 000773'01 endif. 25405 25406 000773'01 254 00 0 00 000770* callret BOUTI% ; Output possibly controlified character 25407 25408 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 15:18 11-Jun-23 Page 23 K20PDC MAC 9-Jun-23 22:41 Vestigial Code found to be largely uninformative 25409 subttl Vestigial Code found to be largely uninformative 25410 25411 repeat 0,< ; Mark character doesn't change 25412 move t1, p3 ; Load the logging JFN 25413 smsg < 25414 sop: > ; Indicate what should start the packet 25415 move t1, rsthdr ; Load Receive Start of Packet character 25416 rot t1, -^d8 ; Position as an eight bit ASCII string 25417 movem t1, sop8st ; And store it 25418 25419 dmove t1, [ ^d1 ; We are only doing one dinky character 25420 point 8, sop8st ] ; And the source is what we just built 25421 call s8ccv7 ; String eight controlified convert to seven 25422 ret ; Shouldn't fail, but better give up 25423 >;;repeat 0 25424 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 15:18 11-Jun-23 Page 24 K20PDC MAC 9-Jun-23 22:41 Code .psect close out 25425 subttl Code .psect close out 25426 25427 xlist ; Save the trees!! 25428 list ; Resume listing 25429 25430 .endps code ; Close the code .psect 25431 k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 15:18 11-Jun-23 Page 25 K20PDC MAC 9-Jun-23 22:41 Module local working storage 25432 subttl Module local working storage 25433 25434 .psect data ; Open data storage 25435 000000'04 lstpkt: block 1 ; Last packet type 25436 000001'04 lstgen: block 1 ; Last generic type 25437 repeat 0,< 25438 sop8st: block 2 ; Start of Packet character as an 8 bit ASCII string 25439 > 25440 .endps data ; Close out the data .psect 25441 25442 .xcmsy ; Ditch any superfluous MACSYM junk 25443 end ; End of module NO ERRORS DETECTED PROGRAM BREAK IS 000000 PSECT 1 BREAK IS 001036 FOR CODE PSECT 2 BREAK IS 000320 FOR CONST PSECT 3 BREAK IS 000311 FOR ETEXT PSECT 4 BREAK IS 000002 FOR DATA CPU TIME USED 00:00.384 93P CORE USED k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 15:18 11-Jun-23 Page S-1 K20PDC MAC 9-Jun-23 22:41 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 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 15:18 11-Jun-23 Page S-2 K20PDC MAC 9-Jun-23 22:41 SYMBOL TABLE FOR PSECT CODE BLKCHK 000751' ext SPAKPT 000000 ext BOUTI% 000773' ext SPDECD 000152' DATLEN 000513' ext SQUOTE 000464' ext DATPTR 000117' ext SSEQN 000727' ext DEBERR 000031' ent TYPE 000721' ext DEFACK 000320' UNDACK 000304' DIAMSG 000000' ent $CLOSD 000046' ext DIAMSZ 000026' %%SMSG 000762' ext ERRACK 000307' ..0005 000013' spd FINTIM 000155' ext ..0006 000016' spd GENARG 000457' ..0007 000017' spd GENBYE 000446' ..0014 000026' spd GENCWD 000425' ..0023 000067' spd GENDEL 000435' ..0030 000076' spd GENDIR 000432' ..0031 000106' spd GENDSK 000454' ..0044 000136' spd GENFIN 000440' ..0051 000140' spd GENHLP 000443' ..0062 000177' spd GENPWD 000422' ..0067 000201' spd GENSTA 000451' ..0110 000243' spd INIACK 000312' ..0115 000245' spd INVGEN 000417' ..0162 000336' spd INVSN1 000216' ..0177 000333' spd INVSN2 000220' ..0210 000350' spd INVSND 000213' ..0224 000373' spd INZACK 000315' ..0225 000376' spd ISLONG 000743' ext ..0243 000406' spd LOGJFN 000051' ext ..0313 000465' spd NUM 000731' ext ..0314 000510' spd OUTC 000756' ..0321 000472' spd PARAMS 000511' ..0362 000620' spd PDECOD 000050' ent ..0363 000626' spd PKTBCT 000000 ext ..0373 000625' spd PKTHDR 000716' ..0374 000626' spd PKTLEN 000737' ext ..0426 000705' spd R 000707' ext ..0433 000712' spd RPDECD 000107' ..0434 000715' spd RQUOTE 000462' ext ..0451 000747' spd RSKP 000755' ext ..0466 000764' spd RSTHDR 000000 ext ..0477 000773' spd SDATPT 000361' ext SNDACK 000274' SNDAT1 000235' SNDAT2 000237' SNDATA 000233' SNDEOF 000357' SNDEOT 000225' SNDERR 000246' SNDFIL 000252' SNDGEN 000377' SNDINI 000266' SNDINZ 000255' SNDNAK 000260' SNDREC 000263' SNDTXT 000271' k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 15:18 11-Jun-23 Page S-3 K20PDC MAC 9-Jun-23 22:41 SYMBOL TABLE FOR PSECT CONST ACKTAB 000100' SGENPT 000156' SNDPKT 000016' k20pdc - Kermit (Visual) Packet Decoding MACRO %53B(1254)-4 15:18 11-Jun-23 Page S-4 K20PDC MAC 9-Jun-23 22:41 SYMBOL TABLE FOR PSECT DATA LSTGEN 000001' LSTPKT 000000' k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 1 K20NET MAC 4-Apr-23 00:43 Preliminaries 25444 title k20net - Kermit-20 Network Support 25445 remark Moved to seperate module as part of 194 to address MCRNEC 25446 remark Originally part of [186] 25447 25448 subttl Preliminaries 25449 25450 search monsym,macsym,cmd,k20unv ;[194] 25451 cmdacs ^ ;Clean up p1-p4 definitions 25452 25453 sall ; Tidy listing 25454 .directive flblst ; We don't need to see all the ASCIZ bytes... 25455 25456 extern ttyjfn ; JFN for controlling terminal 25457 extern ttyini ; Condition local terminal for connection 25458 extern savlnw ; Save terminal length and width 25459 extern rstlnw ; Restore terminal length and width 25460 extern netjfn ; Holds any kind of communications JFN 25461 extern netflg ; Flags returned from GTJFN% (unused) 25462 extern nodnam ; Parsed node name 25463 extern nodnum ; Converted node number, if we have it 25464 extern asgflg ; Flags that we have assigned a device 25465 extern asgdev ; Device we assigned (always a PTY) 25466 extern srvflg ; If running as a server 25467 extern myjob ; My current logged in job 25468 extern mytty ; My current attached terminal 25469 extern ttynum ; Line number of current connection 25470 extern mycaps ; This process' capability vector 25471 extern crlf ; Handy way to save two bytes 25472 extern %%jser ; JSYS error handler 25473 extern errptr ; Pointer to copies of error messages 25474 extern symout ; Given an address, types an associated symbol 25475 25476 remark Common parsing external data 25477 25478 extern pars3 ; Data from third parsed item 25479 extern pars4 ; Data from fourth parsed item 25480 extern pars5 ; Data from fifth parsed item (rarely used) 25481 extern pars6 ;[218] Data from six parsed item (even more rare) 25482 extern atmbuf ; The atom buffer 25483 25484 remark External linkages for INPUT/OUTPUT 25485 25486 extern inpclr ;[209] Clear the buffer 25487 extern handsh ;[190] Handshake character 25488 25489 remark External Parity routines and working storage (all 233) 25490 25491 extern parity ; Type of parity in use 25492 extern none ; No parity being enforced 25493 extern space ; Space parity routine (0, always) 25494 extern mark ; Mark parity routine (1, always) 25495 extern even ; Even parity routine 25496 extern odd ; Odd parity routine 25497 extern parpko ; Non-zero if doing parity on packets, only 25498 extern parrck ; Checking parity on recieve in addition to sending k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 1-1 K20NET MAC 4-Apr-23 00:43 Preliminaries 25499 extern ttipar ; Total parity errors for session 25500 extern movchr ; Translates between 7 and 8 bit 25501 extern genpar ; Use string instructions generate a new string 25502 extern chkpar ; Use string instructions to check parity 25503 extern strc ; Count of characters in temporary buffer 25504 extern strptr ; Appropriate pointer to same 25505 extern strbuf ; Global address of string buffer 25506 remark strbf2 ; Flows into this, too 25507 25508 .psect code/ronly ; Pure code, pure heaven 25509 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 2 K20NET MAC 4-Apr-23 00:43 Acquire information about local node 25510 subttl Acquire information about local node 25511 25512 ; Double checks if the system even has DECnet, just in case. It is 25513 ; possible to configure a system without DECnet; in fact, *all* Toad's 25514 ; are thus because they can't change the MAC address of their network 25515 ; adaptor. 25516 ; 25517 ; A remarkable oversight, if it was one, but DEC's decision to just 25518 ; snag part of the global MAC address space always seemed questionable 25519 ; to some. 25520 ; 25521 ; So we have to do this in order to not break on either a Toad, which 25522 ; can never have DECnet (see above) or a monitor built without it. 25523 ; 25524 ; Code lifted from my rewrite of SETNOD (SETND2) and properly Kermit 25525 ; cased... 25526 25527 000000'01 lclnod: entry lclnod 25528 000000'01 265 16 0 00 005122' saveac ; Wants a few extra registers 25529 remark q1, t5 ; Note, t5 aliases q1 25530 25531 000001'01 402 00 0 00 000000# setzm ndvfxp ; Assume doesn't have extended verify 25532 000002'01 201 07 0 00 000000# movei q3, cnfigd ; Resolve area to 18 bit address 25533 000003'01 201 01 0 00 000010 movx t1, .cfiln ; Length (maximum) 25534 25535 000004'01 403 02 0 00 000003 setzb t2, t3 ; Create two handy zeros 25536 000005'01 124 01 0 07 000000 dmovem t1, .cflen(q3) ; Set length, clear processor type 25537 000006'01 124 02 0 07 000002 dmovem t2, .cfise(q3) ; Clear serial number and microcode 25538 000007'01 124 02 0 07 000004 dmovem t2, .cfiho(q3) ; Clear hardware and microcode options 25539 000010'01 124 02 0 07 000006 dmovem t2, .cfiso(q3) ; Clear software options and version 25540 25541 000011'01 124 02 0 00 000000# dmovem t2, mynode ; Zero local executor and NDVFXP 25542 000012'01 124 02 0 00 000000# dmovem t2, myname ; Scrub the node name area 25543 25544 000013'01 201 01 0 00 000000 movx t1, .cfinf ; Want basic configuration 25545 000014'01 200 02 0 00 000007 move t2, q3 ; Where to put the goodies 25546 000015'01 104 00 0 00 000627 CNFIG% ; See what this monitor has 25547 000016'01 320 12 0 00 000000* erjmpr r ; Nothing, forget about the whole thing 25548 25549 000017'01 554 03 0 07 000000 load t3, cf%wdp,.cflen(q3) ;Load words returned 25550 000020'01 275 03 0 00 000001 subi t3, ^d1 ; Convert count to offset 25551 000021'01 305 03 0 00 000007 caige t3, .cfivr ; Need Tops-20 version 25552 000022'01 263 17 0 00 000000 ret ; Unable to determine Tops-20 version 25553 25554 000023'01 135 03 0 00 005134' load t3, vi%maj,.cfivr(q3) ;Load Tops-20 major release 25555 000024'01 305 03 0 00 000007 caige t3, 7 ; Needs Phase IV 25556 000025'01 254 00 0 00 000034' ifskp. ; So far, so good 25557 000026'01 302 03 0 00 000007 caie T3, 7 ; Exactly version seven? 25558 000027'01 254 00 0 00 000033' ifskp. ; Have to check minor version 25559 000030'01 135 03 0 00 005135' load t3, vi%min,.cfivr(q3) ;Load Tops-20 minor release 25560 000031'01 305 03 0 00 000001 caige t3, 1 ; Needs .NDINT 25561 000032'01 263 17 0 00 000000 ret ; Requires Tops-20 minor version one 25562 000033'01 endif. ; Otherwise, OK or after 7 (!) 25563 000033'01 254 00 0 00 000035' else. ; Otherwise, won't work 25564 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 15:18 11-Jun-23 Page 2-1 K20NET MAC 4-Apr-23 00:43 Acquire information about local node 25565 000035'01 endif. 25566 25567 000035'01 200 04 0 07 000006 move t4, .cfiso(q3) ; Load software options 25568 000036'01 607 04 0 00 200000 txnn t4, cf%dcn ; So, do we have DECnet? 25569 000037'01 263 17 0 00 000000 ret ; Nope, System is not configured for DECnet 25570 25571 000040'01 120 01 0 00 005136' dmove t1, [exp .ndgnm,t3] ;Get local node number 25572 000041'01 104 00 0 00 000567 NODE% ; In t3 25573 000042'01 320 12 0 00 000016* erjmpr r ; Give up, shouldn't ever fail.. 25574 000043'01 306 03 0 00 000000 cain t3, 0 ; Is DECnet running? 25575 000044'01 263 17 0 00 000000 ret ; System DECnet node number not configured 25576 000045'01 202 03 0 00 000000# movem t3, mynode ; Store away my local node number 25577 25578 000046'01 120 01 0 00 005140' dmove t1, [exp .ndgln,t3] ;Get local node name 25579 000047'01 561 03 0 00 000000# hrroi t3, myname ; Point to storage 25580 000050'01 104 00 0 00 000567 NODE% ; In t3 25581 000051'01 320 12 0 00 000053' ifje. r ; Failed?? 25582 000052'01 254 00 0 00 000055' 25583 000053'01 403 02 0 00 000003 setzb t2, t3 ; Cons up a couple of NUL's 25584 000054'01 124 02 0 00 000000# dmovem t2 ,myname ; Make sure no name 25585 000055'01 endif. 25586 25587 000055'01 332 00 0 00 000000# ifme. myname ; Get anything? 25588 000056'01 254 00 0 00 000061' 25589 000057'01 402 00 0 00 000000# setzm mynode ; Whack the executor node number 25590 000060'01 263 17 0 00 000000 ret ; System DECnet node name not configured 25591 000061'01 endif. 25592 ; At this point, we know we have DECnet 25593 remark ; See if monitor has extended verify (T79) 25594 000061'01 120 01 0 00 005142' dmove t1, [exp .ndvfx,t3] ;Node name verify, extended 25595 000062'01 561 03 0 00 000000# hrroi t3, myname ; Point to local node name 25596 000063'01 104 00 0 00 000567 NODE% ; See if .NDVFX exists 25597 000064'01 320 12 0 00 000066' ifje. r ; Oh dear, doesn't look promising 25598 000065'01 254 00 0 00 000071' 25599 000066'01 302 01 0 00 601713 caxe t1, argx02 ; Monitor doesn't have winning .NDVFX? 25600 000067'01 263 17 0 00 000000 ret ; That's fine, so don't use it 25601 000070'01 403 04 0 00 000005 setzb t4, t5 ; Zap flags and so forth 25602 000071'01 endif. ; End node processing 25603 25604 000071'01 607 04 0 00 020000 txnn t4, nd%num ; Better have gotten a number (as it is us) 25605 000072'01 263 17 0 00 000000 ret ; .NDVFX response did not get local node number 25606 000073'01 312 05 0 00 000000# came t5, mynode ; Yes, but is it in fact the local executor? 25607 000074'01 263 17 0 00 000000 ret ; Inconsistent local node number results 25608 000075'01 350 00 0 00 000000# aos ndvfxp ; Mark that it fully works 25609 000076'01 263 17 0 00 000000 ret ; We're done 25610 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 3 K20NET MAC 4-Apr-23 00:43 Get the 'name' of the local system 25611 subttl Get the 'name' of the local system 25612 25613 ; Because one can be going from one DECSYSTEM-20 to another, the 25614 ; message, "Returning to DEC20" might be confusing, particularly if 25615 ; one is so lucky as to have multiple parallel transfers happening to 25616 ; foreign systems. While uncommon, there is nothing preventing this 25617 ; scenario. 25618 ; 25619 ; Therefore, we pull the system name. We prefer GETAB% over NODE% 25620 ; because this should always work, whereas NODE% will give you 25621 ; something like "TOPS20" on a non-DECnet site that hasn't configured 25622 ; the name in SETSPD. 25623 ; 25624 ; If, for some reason, we can't do the GETAB% (as in some fascist ACJ 25625 ; prevents it on a truly locked down system), we will use NODE%. 25626 ; NODE% is supposed to work whether or not DECnet is in monitor (see 25627 ; STG). 25628 ; 25629 ; N.B., Since using GETAB%, we have to do a little parsing of SYSVER 25630 ; 25631 ; The problem is that SYSVER has too much blather in it and sometimes 25632 ; also includes propaganda and system version information. Since the 25633 ; first part is simply SYSTEM:MONNAM.TXT (which is supposed to be 25634 ; there), we parse the return up to the comma and use that. 25635 ; 25636 ; Code adapted from UPTIME; expects to be called AFTER lclnod in case 25637 ; SYSGT% and/or GETAB% either can't work (because no SC%GTB) or fail. 25638 ; 25639 ; Counts the string in case somebody needs it, later 25640 25641 000077'01 getnam: entry getnam 25642 000077'01 265 16 0 00 005122' saveac ; Needs some extra registers 25643 000100'01 403 01 0 00 000002 setzb t1,t2 ; Cons up a nice long zero 25644 000101'01 124 01 0 00 000000# dmovem t1,syscnt ; Stomp count and a few characters 25645 25646 000102'01 205 03 0 00 200000 movx t3,sc%gtb ; GETAB% capability? 25647 000103'01 616 03 0 00 000000# tdnn t3,mycaps+1 ; We have it, right? 25648 000104'01 254 00 0 00 000145' jrst getnod ; Most unusual! 25649 25650 000105'01 200 01 0 00 005144' movx t1,'SYSVER' ; Want system version information 25651 000106'01 104 00 0 00 000016 SYSGT% ; Pull out first word and table metadata 25652 000107'01 320 12 0 00 000145' erjmpr getnod ; Gronked?? Try something else 25653 000110'01 202 02 0 00 000000# movem t2,sysver ; Save table length and index (just in case) 25654 000111'01 550 06 0 00 000002 hrrz q2,t2 ; Cache the index in a fast place 25655 000112'01 515 05 0 00 000001 hrlzi q1,^d1 ; Put the table increment in the right place 25656 ; Now decide how long to loop 25657 000113'01 564 02 0 00 000002 hlro t2,t2 ; Turn into a fullword negative number 25658 000114'01 213 07 0 00 000002 movns q3,t2 ; Positivize it (note arcane use of self) 25659 000115'01 303 02 0 00 000011 caxle t2,syslen ; Will the table fit? 25660 000116'01 201 07 0 00 000011 movx q3,syslen ; Sadly, no. Clip it down 25661 000117'01 120 03 0 00 005145' dmove t3,[exp sysnam,0] ; Address of where to store text, nothing seen 25662 ; Fall through with first word 25663 000120'01 do. ; Enter loop context 25664 000120'01 202 01 0 03 000000 movem t1,(t3) ; Stomp the whole word into memory 25665 000121'01 334 02 0 00 000001 skipa t2,t1 ; Set up for correct shift k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 3-1 K20NET MAC 4-Apr-23 00:43 Get the 'name' of the local system 25666 000122'01 do. ; Inner loop to check characters 25667 000122'01 322 02 0 00 000130' jumpe t2,endlp. ; Processed everything? 25668 000123'01 400 01 0 00 000000 setz t1, ; clear a 'linked' register for a shift pair 25669 000124'01 246 01 0 00 000007 lshc t1,^d7 ; Peel off a character (faster than an ILDB) 25670 000125'01 306 01 0 00 000054 cain t1,"," ; A comma? 25671 000126'01 254 00 0 00 000137' jrst postab ; Yes, we've finally gone past the name 25672 000127'01 344 04 0 00 000122' aoja t4,top. ; Otherwise, count the character and inner loop 25673 000130'01 enddo. ; End inner loop to check characters 25674 000130'01 363 07 0 00 000137' sojle q3,endlp. ; Account for a full word done, maybe terminate 25675 000131'01 270 06 0 00 000005 add q2,q1 ; Bump to next GETAB% index 25676 000132'01 200 01 0 00 000006 move t1,q2 ; Load next requested word 25677 000133'01 104 00 0 00 000010 GETAB% ; Ask for it 25678 000134'01 320 12 0 00 000137' erjmpr postab ; Failed, just use what we have 25679 000135'01 322 01 0 00 000137' jumpe t1,postab ; If end, head off for post table processing 25680 000136'01 344 03 0 00 000120' aoja t3,top. ; Otherwise, handle this word 25681 000137'01 enddo. ; End of GETAB% loop context 25682 25683 000137'01 202 04 0 00 000000# postab: movem t4,syscnt ; We know the length of the system name!! 25684 000140'01 271 04 0 00 000001 addi t4,^d1 ; Get past last character (faster than ILDB) 25685 000141'01 133 04 0 00 005147' adjbp t4,[point 7,sysnam] ; Point to where we stored everything 25686 000142'01 400 01 0 00 000000 setz t1, ; Cons up a .CHNUL 25687 000143'01 137 01 0 00 000004 dpb t1,t4 ; Tie off the string (faster than ILDB) 25688 000144'01 263 17 0 00 000000 ret ; And down 25689 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 4 K20NET MAC 4-Apr-23 00:43 Get the 'name' of the local system 25690 remark Handle case of no SC%GTB or SYSGT%/GETAB% failure 25691 25692 ; NODE% should always work and one assumes that DECnet is set up on 25693 ; all modern systems. However, many systems had no DECnet and only 25694 ; ran ARPA code. That is less common as Galaxy assumes DECnet and 25695 ; parts of CFS seem to. 25696 ; 25697 ; As there were also systems with no ARPA code, we use a very old- 25698 ; fashioned method for getting the name and are highly defensively 25699 ; coded. 25700 ; 25701 ; Code lifted from my rewrite of SETNOD (SETND2) and properly Kermit 25702 ; cased... 25703 25704 000145'01 120 02 0 00 000000# getnod: dmove t2,myname ; Load what DECnet thinks 25705 000146'01 322 02 0 00 000170' jumpe t2,niente ; Didn't think much! Just default it 25706 000147'01 312 02 0 00 005150' came t2,[ascii "TOPS2"] ; First five of standard default? 25707 000150'01 254 00 0 00 000153' ifskp. ; Yep, let's look at the 2nd word 25708 000151'01 316 03 0 00 005151' camn t3,[ascii "0"] ; Really standard default?? 25709 000152'01 254 00 0 00 000170' jrst niente ; Default it to something nicer 25710 000153'01 endif. ; Otherwise, fall through 25711 25712 dmove t4,[point 7,sysnam ;Point to text to spew 25713 000153'01 120 04 0 00 005152' 0 ] ; Zero counter 25714 000154'01 do. ; Enter outer loop context 25715 000154'01 do. ; Enter inner loop context 25716 000154'01 400 01 0 00 000000 setz t1, ; whack the character accumulator 25717 000155'01 246 01 0 00 000007 lshc t1,^d7 ; Peel off a character (faster than an ILDB) 25718 000156'01 322 01 0 00 000161' jumpe t1,endlp. ; End of string? Do next word 25719 000157'01 136 01 0 00 000004 idpb t1,t4 ; Deposit into target string 25720 000160'01 344 05 0 00 000154' aoja q1,top. ; Next character 25721 000161'01 enddo. ; End of inner loop context 25722 000161'01 336 02 0 00 000003 skipn t2,t3 ; Position second word 25723 000162'01 254 00 0 00 000165' exit. ; Unless we're done 25724 000163'01 400 03 0 00 000000 setz t3, ; Set a talsiman 25725 000164'01 254 00 0 00 000154' jrst top. ; Peel a few more characters off 25726 000165'01 enddo. ; End of outer loop context 25727 25728 000165'01 202 05 0 00 000000# movem q1,syscnt ; Update string length count 25729 000166'01 136 03 0 00 000004 idpb t3,t4 ; Tie off the string 25730 000167'01 263 17 0 00 000000 ret ; Done 25731 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 5 K20NET MAC 4-Apr-23 00:43 Get the 'name' of the local system 25732 remark Here if we are just not having any luck with the local system name 25733 25734 chgsec(code,text) 25735 000000'02 104 105 103 055 062 defnam: asciz "DEC-20" ; Clear up where we are 25736 000002'02 000 00 0 00 000000 Z ; Historically what we called ourselves 25737 retsec 25738 25739 000170'01 120 01 0 00 000000# niente: dmove t1,defnam ; Load default name 25740 000171'01 124 01 0 00 000000# dmovem t1,sysnam ; Store default name 25741 000172'01 402 00 0 00 000000# setzm sysnam+2 ; Tie of the string 25742 000173'01 201 03 0 00 000006 movei t3,^d6 ; Length of unterminated string 25743 000174'01 202 03 0 00 000000# movem t3,syscnt ; Store the count 25744 25745 000175'01 263 17 0 00 000000 ret ; And done 25746 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 6 K20NET MAC 4-Apr-23 00:43 Set default prompt if doing network 25747 subttl Set default prompt if doing network 25748 25749 ; Sets a default prompt to use when we are NRT'ing in case it 25750 ; it is asked for by SET PROMPT (see .setpr: in k20par) 25751 25752 000176'01 setdef: entry setdef ; Called once at startup 25753 dmove t1,[point 7,myprom ; Default prompt, if needed 25754 000176'01 120 01 0 00 005154' point 7,sysnam] ; Source is local system name 25755 000177'01 200 04 0 00 000000# move t4,syscnt ; Length 25756 25757 000200'01 201 03 0 00 000042 movei t3, .chdbq ; Load a double quote 25758 000201'01 136 03 0 00 000001 idpb t3,t1 ; Deposit it in prompt 25759 25760 000202'01 do. ; Enter loop context. 25761 000202'01 134 03 0 00 000002 ildb t3,t2 ; Load source from local system name 25762 000203'01 136 03 0 00 000001 idpb t3,t1 ; Deposit it in prompt 25763 000204'01 367 04 0 00 000202' sojg t4,top. ; All of it 25764 000205'01 enddo. ; Exit loop context. 25765 25766 dmove t3,[ .chrpt ; Load right pointy bracket 25767 000205'01 120 03 0 00 005156' .chdbq ] ; And a double quote 25768 000206'01 136 03 0 00 000001 idpb t3,t1 ; Make prompt obvious 25769 000207'01 136 04 0 00 000001 idpb t4,t1 ; Close out default for .cmqst 25770 25771 000210'01 400 03 0 00 000000 setz t3, ; Cons up a .chnul 25772 000211'01 136 03 0 00 000001 idpb t3,t1 ; Close out the string 25773 000212'01 263 17 0 00 000000 ret 25774 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 7 K20NET MAC 4-Apr-23 00:43 Perform network connect and initial NRT negotiation 25775 subttl Perform network connect and initial NRT negotiation 25776 25777 ; Call: 25778 ; 25779 ; nodnam has result of .CMNOD 25780 ; 25781 ; Return: 25782 ; 25783 ; +1/ Couldn't open connection 25784 ; +2/ Connection open and negotiated with a remote NRT 25785 ; t1/ Network JFN we got 25786 25787 000213'01 decnct: entry decnct ; Called by k20mit, also 25788 000213'01 402 00 0 00 000000# setzm binflg ; Assume we don't have binary 25789 000214'01 402 00 0 00 000000# setzm nrtflg ; And that we don't have an NRT, either 25790 000215'01 260 17 0 00 000236' call chknrt ; First see if node itself exists 25791 000216'01 254 00 0 00 003053' callret clscln ; Failed, scrub storage 25792 000217'01 202 01 0 00 000000* movem t1,ttynum ; Store node number as line number 25793 000220'01 260 17 0 00 000262' call openrt ; Perform initial open activities 25794 000221'01 254 00 0 00 002673' callret clsjfn ; Unless build and open fail 25795 000222'01 260 17 0 00 000330' call waitcn ; Now wait for NSP negotiation 25796 000223'01 263 17 0 00 000000 ret ; Return +1, waitcn cleans up correctly 25797 000224'01 260 17 0 00 000603' call fixnam ; Rewrite remote node name 25798 000225'01 260 17 0 00 000627' call chktop ; Ensure it suppors Tops-10/20 NRT's 25799 000226'01 263 17 0 00 000000 ret ; It does't ... chktop cleans up correctly 25800 000227'01 201 03 0 00 000022 movei t3, .dvdcn ; Opened a DECnet NRT! 25801 000230'01 202 03 0 00 000000# movem t3, opndev ; Store opened device type 25802 000231'01 476 00 0 00 000000* setom vtermf ; Set the virtual terminal flag 25803 000232'01 476 00 0 00 000000* setom local ; We're the local Kermit 25804 remark gndpar ;[223] Can't get parity from a network JFN 25805 000233'01 402 00 0 00 000000# setzm opnpar ;[223] Either way, NRT's do not support parity 25806 000234'01 550 01 0 00 000000* hrrz t1, netjfn ;[223] Return JFN, no flags 25807 000235'01 254 00 0 00 000000* retskp ; Connected and ready to go! 25808 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 8 K20NET MAC 4-Apr-23 00:43 Checks that the candidate node exists 25809 subttl Checks that the candidate node exists 25810 25811 ; Verifies parsed node and attempts to extract some useful 25812 ; information. This should not be necessary, because unless CM%PO 25813 ; (parse-only) is set, when doing a .CMNOD, Tops-20 itself verifies 25814 ; that whats in the atom buffer exists in the monitor's data base. 25815 ; 25816 ; However we have to do the call to get the node number, which we 25817 ; pretend is a terminal number. 25818 ; 25819 ; Call: 25820 ; 25821 ; nodnam has ... something (see above) 25822 ; 25823 ; Return: 25824 ; 25825 ; +1/ Wasn't a valid DECnet node 25826 ; +2/ Valid DECnet node, t1 has node number if monitor supports this 25827 25828 000236'01 265 16 0 00 005160' chknrt: saveac ; Alias t5 25829 000237'01 120 01 0 00 005142' dmove t1,[exp .ndvfx,t3] ;Node name verify, extended 25830 000240'01 336 00 0 00 000000# skipn ndvfxp ; Has extended verify? 25831 000241'01 201 01 0 00 000015 movx t1, .ndvfy ; Pity, but still usable 25832 000242'01 561 03 0 00 000000* hrroi t3, nodnam ; Point to whatever .CMNOD got 25833 000243'01 104 00 0 00 000567 NODE% ; Get some information 25834 000244'01 320 12 0 00 000246' ifje. r ; Catch the error 25835 000245'01 254 00 0 00 000250' 25836 000246'01 200 02 0 00 000001 move t2, t1 ; Save for debugging 25837 000247'01 403 04 0 00 000005 setzb t4, t5 ; Zap flags and so forth 25838 000250'01 endif. ; 25839 000250'01 477 01 0 00 000000* setob t1, nodnum ; Let's assume nothing works 25840 000251'01 607 04 0 00 200000 txnn t4, nd%lgl ; Double check COMND% .CMNOD, just in case 25841 000252'01 263 17 0 00 000000 ret ; Then how did it get parsed?? 25842 000253'01 607 04 0 00 400000 txnn t4, nd%exm ; Legal, but do we know it? 25843 000254'01 263 17 0 00 000000 ret ; No, we do not 25844 25845 000255'01 607 04 0 00 020000 txnn t4, nd%num ; Did we get a number? 25846 000256'01 254 00 0 00 000235* retskp ; Oh well, maybe old monitor 25847 25848 000257'01 202 05 0 00 000250* movem t5, nodnum ; Save a node number, if we have it 25849 000260'01 200 01 0 00 000005 move t1, t5 ; Return a number to caller 25850 000261'01 254 00 0 00 000256* retskp ; And we are out of here! 25851 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 9 K20NET MAC 4-Apr-23 00:43 Open DECnet connect to NRT object 25852 subttl Open DECnet connect to NRT object 25853 25854 ; Here to actually open the connect. Check to see if the remote 25855 ; system is Tops-10 or Tops-20, in which case we can directly use 25856 ; it as if it were a terminal. This is not possible with a CTERM 25857 ; or TVT because there would be meta-data to process. 25858 ; 25859 ; Note, current behavior is that the OPENF% will succeed whether 25860 ; or not GJ%FLG is set, but strangely, NO traffic will be possible 25861 ; if is not used! If GJ%FLG is issued, then the following flags 25862 ; are returned: 25863 ; 25864 ; Bit Name Comment 25865 ; === ====== ================================================ 25866 ; 6 GJ%UHV The file used has the highest generation number 25867 ; because a generation number of 0 was given in the 25868 ; call. This is clearly false because no generation 25869 ; number nor extension (type) is supplied. 25870 ; 25871 ; 12 GJ%GND Files marked for deletion were not considered when 25872 ; assigning JFNs. 25873 ; 25874 ; 17 GJ%GIV Invisible files were not considerd when assigning 25875 ; JFNs. 25876 ; 25877 ; Why this makes it work is anybody's guess... 25878 ; 25879 ; Call: 25880 ; 25881 ; nodnam has validated foreign node name 25882 ; 25883 ; Return: 25884 ; 25885 ; +1/ Failed to create a JFN to the remote NRT 25886 ; +2/ JFN exists for remote object and is open 25887 25888 chgsec(code,const) ; Constants 25889 000000'03 000000000000# nrtadr: nrtobj ; Where to build network file spec to MCBNRT 25890 000001'03 623075 635000 nrtdev: byte (7) "d","c","n",":",.chnul ;Device name for client connections 25891 000002'03 000003 154455 nrtnum: byte (1) 0 (7) .chnul,.chnul,"3","2",.chdas 25892 retsec 25893 25894 000262'01 402 00 0 00 000000* openrt: setzm asgflg ; Certainly will not be assigning DCN:! 25895 000263'01 402 00 0 00 000000* setzm asgdev ; So don't put it there 25896 000264'01 120 01 0 00 000000# dmove t1,nrtadr ; Load address of object and device name 25897 000265'01 202 02 0 01 000000 movem t2, (t1) ; Start with "DCN:" 25898 000266'01 505 01 0 00 100700 hrli t1,(point 7,0,27) ; Point to ":" 25899 25900 000267'01 201 03 0 00 000242* movei t3,nodnam ; Resolve address of parsed node name 25901 000270'01 505 03 0 00 440700 hrli t3,() ; Turn into a local ASCII pointer 25902 ; And append the node name 25903 000271'01 do. ; Enter loop lexical context 25904 000271'01 134 02 0 00 000003 ildb t2,t3 ; Load node name byte 25905 000272'01 322 02 0 00 000275' jumpe t2,endlp. ; Exit if at end of string 25906 000273'01 136 02 0 00 000001 idpb t2,t1 ; Append to file specification k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 9-1 K20NET MAC 4-Apr-23 00:43 Open DECnet connect to NRT object 25907 000274'01 254 00 0 00 000271' loop. ; Go get some more 25908 000275'01 enddo. ; end loop lexical context 25909 ; Append MCBNRT's object type 25910 000275'01 200 02 0 00 000000# move t2, nrtnum ; Complete NRT number portion 25911 000276'01 136 02 0 00 000001 idpb t2,t1 ; Drop in the dash 25912 000277'01 242 02 0 00 777771 lsh t2,-^d7 ; Shift the "2" into place 25913 000300'01 136 02 0 00 000001 idpb t2,t1 ; Drop in the "2" 25914 000301'01 242 02 0 00 777771 lsh t2,-^d7 ; Shift the "3" into place 25915 000302'01 136 02 0 00 000001 idpb t2,t1 ; Drop in the "3" 25916 000303'01 400 02 0 00 000000 setz t2, ; Cons up a NUL 25917 000304'01 136 02 0 00 000001 idpb t2,t1 ; Tie off the line 25918 25919 000305'01 205 01 0 00 000021 movx t1,gj%sht!gj%flg ; Do a short form GTJFN with flags 25920 000306'01 561 02 0 00 000000# hrroi t2,nrtobj ; Using the spec just built 25921 000307'01 104 00 0 00 000020 GTJFN% ; Get DCN connection 25922 000310'01 320 12 0 00 000312' %jserr (,clscln) ; Scrub storage 25923 000311'01 254 00 0 00 000315' 25924 000312'01 265 01 0 00 000000* 25925 000313'01 000000000000# 25926 000314'01 254 00 0 00 003053' 25927 000000'04 125 156 141 142 154 25928 25929 000315'01 552 01 0 00 000234* hrrzm t1,netjfn ; Save JFN for the connection 25930 000316'01 512 01 0 00 000000* hllzm t1,netflg ; Save returned flags 25931 000317'01 621 01 0 00 777777 tlz t1,-1 ; But shut them off for downstream 25932 ; 8 bit bytes, small buffers and read/write 25933 000320'01 200 02 0 00 005166' move t2,[fld(^d8,of%bsz)!fld(.gssmb,of%mod)!of%rd!of%wr] 25934 000321'01 104 00 0 00 000021 OPENF% ; Open the network connection 25935 000322'01 320 12 0 00 000324' %jserr (,clsjfn) ; Toss the JFN 25936 000323'01 254 00 0 00 000327' 25937 000324'01 265 01 0 00 000312* 25938 000325'01 000000000000# 25939 000326'01 254 00 0 00 002673' 25940 000005'04 125 156 141 142 154 25941 000327'01 254 00 0 00 000261* retskp ; Return success 25942 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 10 K20NET MAC 4-Apr-23 00:43 Wait for DECnet connection completion 25943 subttl Wait for DECnet connection completion 25944 25945 ; Once we are done building the connection string and have successfully 25946 ; done the OPENF%, we must wait a bit for DECnet to complete network 25947 ; level negotiations. 25948 25949 ; This was is done by sitting in a loop, waiting a quarter second, 25950 ; checking the connection status and, if connected, returning. 25951 ; Otherwise we'd go around and do it again for the specified number of 25952 ; times. 25953 ; 25954 ; The new code sets a connection interrupt (mo%cdn) which results in a 25955 ; lot snappier response. Moral of the Story: Don't Poll. 25956 25957 ;[218] Rewritten for connection interrupts 25958 25959 extern dnchb ; DECnet channel bit, defined in k20sub 25960 extern dncfld,dndfld ; DECnet channal assignment/deassignment field 25961 extern timeon,timdel ; Force a specific time, force a timer delete 25962 extern ccon,ccoff2 ; Set up Control-C handler 25963 extern cyon, cyoff ; Set up Control-Y handler 25964 extern cyseen ; Set if Control-Y typed 25965 extern delay ; Default connect time out 25966 25967 000330'01 200 01 0 00 000315* waitcn: move t1, netjfn ; Load the network JFN 25968 dmove t2, [ .moacn ; Code to enable interrupts 25969 000331'01 120 02 0 00 005167' dncfld ] ; Channel to enable on 25970 000332'01 104 00 0 00 000077 MTOPR% ; Enable the interrupt 25971 000333'01 320 12 0 00 000335' %jserr (,clsnet) 25972 000334'01 254 00 0 00 000340' 25973 000335'01 265 01 0 00 000324* 25974 000336'01 000000000000# 25975 000337'01 254 00 0 00 002676' 25976 000013'04 104 105 103 156 145 25977 dmove t1, [ .fhslf ; This process 25978 000340'01 120 01 0 00 005171' dnchb ] ; DECnet connection channel 25979 000341'01 104 00 0 00 000131 AIC% ; Turn the channel on 25980 000342'01 320 12 0 00 000344' %jserr (,clsnet) ;?? 25981 000343'01 254 00 0 00 000347' 25982 000344'01 265 01 0 00 000335* 25983 000345'01 000000000000# 25984 000346'01 254 00 0 00 002676' 25985 000024'04 104 105 103 156 145 25986 000347'01 260 17 0 00 000000* call ccon ; Turn on Control-C interrupt 25987 000350'01 254 00 0 00 000512' jrst waitcc ; Go to the wait Control-C handler 25988 000351'01 260 17 0 00 000000* call cyon ; Fielding ^Y inquires 25989 000352'01 334 00 0 00 000000 %ermsg (,) 25990 000353'01 254 00 0 00 000357' 25991 000354'01 265 01 0 00 000344* 25992 000355'01 000000000000# 25993 000356'01 254 00 0 00 000357' 25994 000034'04 103 157 165 154 144 25995 000357'01 201 01 0 00 000522' movei t1, waitmo ; Address to go to on time out 25996 000360'01 337 02 0 00 000000* skipg t2, pars6 ; Use /timeout, if specified 25997 000361'01 200 02 0 00 000000* move t2, delay ; Otherwise use default k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 10-1 K20NET MAC 4-Apr-23 00:43 Wait for DECnet connection completion 25998 000362'01 323 02 0 00 000364' ifg. t2 ; Have any reasonable delay? 25999 000363'01 260 17 0 00 000000* call timeon ; Yes, set connection expiration time 26000 000364'01 endif. ; Otherwise, we are truly patient... 26001 26002 000364'01 do. ; Enter loop context 26003 000364'01 104 00 0 00 000306 WAIT% ; Wait forever and ever (and ever) 26004 000365' $waitj==:. ; Location of JSYS as reported 26005 000365'01 336 00 0 00 000000* skipn cyseen ; Should only happen for ^Y 26006 000366'01 254 00 0 00 000503' jrst waitun ; But didn't! Unknown!! 26007 000367'01 260 17 0 00 000407' call waitpr ; Print something nice 26008 000370'01 254 00 0 00 000373' ifskp. ; Link is still healthy 26009 000371'01 402 00 0 00 000365* setzm cyseen ; Stomp ^Y seen 26010 000372'01 254 00 0 00 000402' else. ; Otherwise, we are ill 26011 000373'01 415 16 0 00 000400' block. ; Will need a frame 26012 000374'01 261 17 0 00 000016 26013 000375'01 265 16 0 00 005173' saveac ; Save temporaries 26014 000376'01 260 17 0 00 000441' call shutdn ; Turn off the interrupts 26015 000377'01 263 17 0 00 000000 endbk. ; Exit block, restoring temporaries 26016 000400'01 260 17 0 00 000544' call decerr ; Complain and close 26017 000401'01 254 00 0 00 002676' callret clsnet ; Toss JFN and return 26018 000402'01 endif. 26019 000402'01 603 03 0 00 400000 txne t3, mo%con ; Connected?? Must have missed the interrupt 26020 000403'01 254 00 0 00 000405' exit. ; Break out and return success 26021 000404'01 254 00 0 00 000364' loop. ; And go catatonic again 26022 000405'01 enddo. ; End loop lexical context 26023 26024 000405'01 waitdn: remark ; Forced here by connection interrupt 26025 000405'01 260 17 0 00 000441' call shutdn ; Get rid of all our interrupts 26026 000406'01 254 00 0 00 000327* retskp ; Return success 26027 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 11 K20NET MAC 4-Apr-23 00:43 Print Connection Information 26028 subttl Print Connection Information 26029 26030 ; Returns +1 if connection went bad, t2 having the DECnet abort code 26031 ; +2 if the connection is still good and we continue to wait 26032 26033 000407'01 200 01 0 00 000330* waitpr: move t1,netjfn ; Load the JFN 26034 000410'01 201 02 0 00 000025 movx t2,.morls ; Function to read link status 26035 000411'01 104 00 0 00 000077 MTOPR% ; Do the status read 26036 000412'01 320 12 0 00 000042* erjmpr r ; Handle error, getting it in t1 26037 000413'01 603 03 0 00 400000 txne t3, mo%con ; Connected?? 26038 000414'01 254 00 0 00 000406* retskp ; Must have missed the interrupt 26039 000415'01 603 03 0 00 010000 txne t3, mo%abt ; Link aborted?? 26040 000416'01 263 17 0 00 000000 ret ; Fail and return blat 26041 000417'01 603 03 0 00 004000 txne t3, mo%syn ; A normal close? 26042 000420'01 263 17 0 00 000000 ret ; Already? That's pecular... 26043 000421'01 607 03 0 00 100000 ifxn. t3, mo%wfc ; Still healthy and waiting? 26044 000422'01 254 00 0 00 000427' 26045 txmsg <% Waiting for connection 26046 000423'01 200 01 0 00 000000# > 26047 000424'01 104 00 0 00 000076 26048 000425'01 320 12 0 00 000426' 26049 000003'03 000000000000# 26050 000044'04 045 040 127 141 151 26051 26052 000426'01 254 00 0 00 000414* retskp 26053 000427'01 endif. 26054 000427'01 607 03 0 00 040000 ifxn. t3, mo%wcc ; Just about done, actually? 26055 000430'01 254 00 0 00 000435' 26056 txmsg <% Waiting for connection confirmation 26057 000431'01 200 01 0 00 000000# > 26058 000432'01 104 00 0 00 000076 26059 000433'01 320 12 0 00 000434' 26060 000004'03 000000000000# 26061 000052'04 045 040 127 141 151 26062 26063 000434'01 254 00 0 00 000426* retskp 26064 000435'01 endif. 26065 26066 txmsg <% Unknown status 26067 000435'01 200 01 0 00 000000# > 26068 000436'01 104 00 0 00 000076 26069 000437'01 320 12 0 00 000440' 26070 000005'03 000000000000# 26071 000062'04 045 040 125 156 153 26072 26073 000440'01 254 00 0 00 000434* retskp ; Still OK to wait 26074 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 12 K20NET MAC 4-Apr-23 00:43 Connection interrupt time out and shutdown 26075 subttl Connection interrupt time out and shutdown 26076 26077 000441'01 201 01 0 00 400000 shutdn: movx t1, .fhslf ; This process 26078 000442'01 104 00 0 00 000130 DIR% ; Shut off the entire interrupt system 26079 000443'01 320 12 0 00 000445' %jserr (,) 26080 000444'01 254 00 0 00 000450' 26081 000445'01 265 01 0 00 000354* 26082 000446'01 000000000000# 26083 000447'01 254 00 0 00 000450' 26084 000066'04 111 156 164 145 162 26085 000450'01 260 17 0 00 000000* call ccoff2 ; Force off Control-C handler 26086 000451'01 260 17 0 00 000000* call timdel ; Delete the timer 26087 000452'01 260 17 0 00 000000* call cyoff ; Release ^Y 26088 dmove t1, [ .fhslf ; This process 26089 000453'01 120 01 0 00 005205' dnchb ] ; DECnet connection channel 26090 000454'01 104 00 0 00 000133 DIC% ; Shut the channel off 26091 000455'01 320 12 0 00 000457' %jserr (,) ; Carry on 26092 000456'01 254 00 0 00 000462' 26093 000457'01 265 01 0 00 000445* 26094 000460'01 000000000000# 26095 000461'01 254 00 0 00 000462' 26096 000075'04 104 105 103 156 145 26097 000462'01 200 01 0 00 000407* move t1, netjfn ; Load the network JFN 26098 dmove t2, [ .moacn ; Code to enable interrupts 26099 000463'01 120 02 0 00 005207' dndfld ] ; Take the interrupt off this channel 26100 000464'01 104 00 0 00 000077 MTOPR% ; Enable the interrupt 26101 000465'01 320 12 0 00 000467' %jserr (,) ; Carry on 26102 000466'01 254 00 0 00 000472' 26103 000467'01 265 01 0 00 000457* 26104 000470'01 000000000000# 26105 000471'01 254 00 0 00 000472' 26106 000105'04 104 105 103 156 145 26107 000472'01 104 00 0 00 000141 CIS% ; Clear out any other interrupt crud 26108 000473'01 201 01 0 00 400000 movx t1, .fhslf ; This process 26109 000474'01 104 00 0 00 000126 EIR% ; Turn the interrupt back on 26110 000475'01 320 12 0 00 000477' %jserr (,) ; Uh oh... 26111 000476'01 254 00 0 00 000502' 26112 000477'01 265 01 0 00 000467* 26113 000500'01 000000000000# 26114 000501'01 254 00 0 00 000502' 26115 000116'04 111 156 164 145 162 26116 000502'01 263 17 0 00 000000 ret 26117 26118 000503'01 waitun: remark ; Here if we don't know why we broke out 26119 000503'01 260 17 0 00 000441' call shutdn ; Get rid of all our interrupts 26120 emsg ; Inform 26122 000505'01 104 00 0 00 000313 26123 000006'03 000000000000# 26124 000125'04 125 156 153 156 157 26125 26126 000506'01 505 02 0 00 000007 hrli t2, .DCX7 ; Code is unspecified error 26127 000507'01 200 03 0 00 000000# sxtext (t3,) 26128 000007'03 000000000000# 26129 000133'04 125 156 153 156 157 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 12-1 K20NET MAC 4-Apr-23 00:43 Connection interrupt time out and shutdown 26130 000510'01 201 04 0 00 000020 movei t4,^d16 ; Length of reject message 26131 000511'01 254 00 0 00 000530' jrst waitm1 ; Join common code 26132 26133 000512'01 waitcc: remark ; ^C event 26134 000512'01 260 17 0 00 000441' call shutdn ; Get rid of all our interrupts 26135 txmsg <% aborting connection attempt 26136 000513'01 200 01 0 00 000000# > ; Inform 26137 000514'01 104 00 0 00 000076 26138 000515'01 320 12 0 00 000516' 26139 000010'03 000000000000# 26140 000137'04 045 040 141 142 157 26141 26142 000516'01 505 02 0 00 000011 hrli t2, .DCX9 ; Code is forced explicit disconnect 26143 000517'01 200 03 0 00 000000# sxtext (t3,) 26144 000011'03 000000000000# 26145 000146'04 101 142 141 156 144 26146 000520'01 201 04 0 00 000017 movei t4,^d15 ; Length of reject message 26147 000521'01 254 00 0 00 000530' jrst waitm1 ; Join common code 26148 26149 000522'01 waitmo: remark ; Time-out event 26150 000522'01 260 17 0 00 000441' call shutdn ; Get rid of all our interrupts 26151 emsg ; Whine 26153 000524'01 104 00 0 00 000313 26154 000012'03 000000000000# 26155 000152'04 122 145 155 157 164 26156 26157 000525'01 505 02 0 00 000046 hrli t2, .DCX38 ; Code is no response 26158 000526'01 200 03 0 00 000000# sxtext (t3,) 26159 000013'03 000000000000# 26160 000160'04 101 164 164 145 155 26161 000527'01 201 04 0 00 000020 movei t4,^d16 ; Length of reject message 26162 26163 000530'01 200 01 0 00 000462* waitm1: move t1,netjfn ; Load DCN: JFN 26164 000531'01 541 02 0 00 000040 hrri t2, .moclz ; Function to close 26165 000532'01 104 00 0 00 000077 MTOPR% ; Notify NSP that we are giving up 26166 000533'01 320 12 0 00 000544' erjmpr decerr ; We can't say "No"? 26167 000534'01 254 00 0 00 002757' callret clscom ; Toss whatever is left 26168 26169 ;[218] End rewrite for connection interrupts 26170 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 13 K20NET MAC 4-Apr-23 00:43 Asynchronous DECnet connection event 26171 subttl Asynchronous DECnet connection event 26172 26173 ;[218] Begin code insertion 26174 26175 ; Purpose is to break us out of any jsys we might be in (probably the 26176 ; WAIT%) and redirect the path of execution to the successful return. 26177 26178 000535'01 dntrap: entry dntrap ; chntab is in k20sub 26179 000535'01 261 17 0 00 000001 push p, t1 ; Save an accumulator 26180 000536'01 201 01 0 00 000405' movei t1, waitdn ; Load the connection success address 26181 000537'01 500 01 0 00 000000* hll t1, pc3 ; Load interrupted PC's flags 26182 000540'01 661 01 0 00 010000 txo t1, pc%usr ; Force user mode to break out of any JSYS 26183 000541'01 202 01 0 00 000537* movem t1, pc3 ; Restore as if we came from there 26184 000542'01 262 17 0 00 000001 pop p, t1 ; Restore the accumulator 26185 000543'01 104 00 0 00 000136 DEBRK% ; Done with interrupt 26186 26187 ;[218] End code insertion 26188 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 14 K20NET MAC 4-Apr-23 00:43 Handle a DECnet connection error of some type 26189 subttl Handle a DECnet connection error of some type 26190 26191 ; Takes two kinds of errors and honks accordingly 26192 ; 26193 ; Note assumption: if t1 still has netjfn in it, then it couldn't 26194 ; possibly have gotten stomped with an erjmpr 26195 ; 26196 ; Call: 26197 ; 26198 ; t1/ JFN or error code 26199 ; 26200 ; Return: 26201 ; 26202 ; +1, always, having typed some kind of blat 26203 26204 000544'01 decerr: entry decerr ; Also hit by other modules 26205 000544'01 550 02 0 00 000001 hrrz t2,t1 ; Save a possible error 26206 000545'01 200 01 0 00 000000# emsg ;[187] 26207 000546'01 104 00 0 00 000313 26208 000014'03 000000000000# 26209 000164'04 103 157 156 156 145 26210 000547'01 316 02 0 00 000530* camn t2,netjfn ; JSYS error? 26211 000550'01 254 00 0 00 000562' ifskp. ; Yes, that's easy enough to complain about 26212 000551'01 201 01 0 00 000101 movei t1,.priou ; Continue on primary output 26213 000552'01 505 02 0 00 400000 hrli t2,.fhslf ; Wants this for explicit error 26214 000553'01 400 03 0 00 000000 setz t3, ; Don't limit length of text 26215 000554'01 104 00 0 00 000011 ERSTR% ; Type the JSYS failure reason text 26216 000555'01 320 12 0 00 000557' erjmpr .+2 ; Ignore strange error 26217 000556'01 320 12 0 00 000557' erjmpr .+1 ; Ignore stranger error 26218 000557'01 561 01 0 00 000000* hrroi t1, crlf ; Tie off the line 26219 000560'01 104 00 0 00 000076 PSOUT% 26220 000561'01 263 17 0 00 000000 ret ; And return 26221 000562'01 endif. ; End JSYS error handling 26222 26223 000562'01 400 01 0 00 000000 setz t1, ; Let's assume we never found anything 26224 000563'01 621 03 0 00 777777 tlz t3,-1 ; Scrub to just the bare error 26225 000564'01 201 04 0 00 000000# movei t4,nsptab ; Load address of error table 26226 000565'01 505 04 0 00 777744 hrli t4,-nspcnt ; Load negative number of items in table 26227 26228 000566'01 do. ; Enter loop context 26229 000566'01 554 02 0 04 000000 hlrz t2,(t4) ; Load Disconnect Code Table 26230 000567'01 312 02 0 00 000003 came t2,t3 ; Did we find the code? 26231 000570'01 254 00 0 00 000574' ifskp. ; Yes, set up the pointer 26232 000571'01 550 01 0 04 000000 hrrz t1, (t4) ; Pick up in-section case 26233 000572'01 661 01 0 00 610001 txo t1, .px7 ; Turn into a OWGP to ASCII text in ETEXT 26234 000573'01 254 00 0 00 000575' exit. ; Break out of the loop 26235 000574'01 endif. 26236 000574'01 253 04 0 00 000566' aobjn t4,top. ; Nope, try the next error code 26237 000575'01 enddo. ; End loop context 26238 26239 000575'01 326 01 0 00 000577' ife. t1 ; Did we find anything? 26240 000576'01 200 01 0 00 000000# sxtext (t1,) 26241 000015'03 000000000000# 26242 000171'04 125 156 153 156 157 26243 000577'01 endif. ; Other, can provide extra information k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 14-1 K20NET MAC 4-Apr-23 00:43 Handle a DECnet connection error of some type 26244 000577'01 104 00 0 00 000313 ESOUT% ; Give us the bad news 26245 000600'01 561 01 0 00 000557* hrroi t1, crlf ; Tie off the line and return 26246 000601'01 104 00 0 00 000076 PSOUT% 26247 000602'01 254 00 0 00 002750' callret clsnrt ; Close the NRT object (or what's left) 26248 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 15 K20NET MAC 4-Apr-23 00:43 DECnet Disconnect Code Table (from MONSYM) 26249 subttl DECnet Disconnect Code Table (from MONSYM) 26250 26251 .endps code ; Pointers to extended text don't go in code 26252 26253 ; Note that the codes are stipulated by the NSP specification and 26254 ; may have meanings that are not directly implied by the comments 26255 26256 define nsperr(e,t,%et) < 26257 xwd e,%et ;;DECnet error code and in-section address 26258 chgsec(const,etext) ;;Text goes in extended section 26259 %et: asciz\'t\ ;;Drop text into extended section 26260 retsec ;;Gets back into const .psect 26261 cleans(<%et>) ;;Don't clutter listings with generated symbol 26262 >;;nsperr 26263 26264 .psect const ; Pointer table to extended text goes in const .psect 26265 26266 000016'03 000000 000000# nsptab: nsperr(.DCX0,) 26267 000201'04 122 145 152 145 143 26268 000017'03 000001 000000# nsperr(.DCX1,) 26269 000210'04 122 145 163 157 165 26270 000020'03 000002 000000# nsperr(.DCX2,) 26271 000216'04 104 145 163 164 151 26272 000021'03 000003 000000# nsperr(.DCX3,) 26273 000225'04 122 145 155 157 164 26274 000022'03 000004 000000# nsperr(.DCX4,) 26275 000233'04 104 145 163 164 151 26276 000023'03 000005 000000# nsperr(.DCX5,) 26277 000242'04 111 156 166 141 154 26278 000024'03 000006 000000# nsperr(.DCX6,) 26279 000250'04 117 142 152 145 143 26280 000025'03 000007 000000# nsperr(.DCX7,) 26281 000253'04 125 156 163 160 145 26282 000026'03 000010 000000# nsperr(.DCX8,) 26283 000257'04 101 142 157 162 164 26284 000027'03 000011 000000# nsperr(.DCX9,) 26285 000263'04 101 142 157 162 164 26286 000030'03 000012 000000# nsperr(.DCX10,) 26287 000267'04 111 156 166 141 154 26288 000031'03 000013 000000# nsperr(.DCX11,) 26289 000273'04 114 157 143 141 154 26290 000032'03 000025 000000# nsperr(.DCX21,) 26291 000277'04 103 157 156 156 145 26292 000033'03 000026 000000# nsperr(.DCX22,) 26293 000311'04 103 157 156 156 145 26294 000034'03 000027 000000# nsperr(.DCX23,) 26295 000323'04 103 157 156 156 145 26296 000035'03 000030 000000# nsperr(.DCX24,) 26297 000340'04 106 154 157 167 040 26298 000036'03 000040 000000# nsperr(.DCX32,) 26299 000345'04 124 157 157 040 155 26300 000037'03 000041 000000# nsperr(.DCX33,) 26301 000353'04 124 157 157 040 155 26302 000040'03 000042 000000# nsperr(.DCX34,) 26303 000364'04 101 143 143 145 163 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 15-1 K20NET MAC 4-Apr-23 00:43 DECnet Disconnect Code Table (from MONSYM) 26304 000041'03 000043 000000# nsperr(.DCX35,) 26305 000371'04 114 157 147 151 143 26306 000042'03 000044 000000# nsperr(.DCX36,) 26307 000400'04 111 156 166 141 154 26308 000043'03 000045 000000# nsperr(.DCX37,) 26309 000404'04 123 145 147 155 145 26310 000044'03 000046 000000# nsperr(.DCX38,) 26311 000411'04 116 157 040 162 145 26312 000045'03 000047 000000# nsperr(.DCX39,) 26313 000421'04 116 157 144 145 040 26314 000046'03 000050 000000# nsperr(.DCX40,) 26315 000425'04 114 151 156 153 040 26316 000047'03 000051 000000# nsperr(.DCX41,) 26317 000433'04 104 145 163 164 151 26318 000050'03 000052 000000# nsperr(.DCX42,) 26319 000442'04 103 157 156 146 151 26320 000051'03 000053 000000# nsperr(.DCX43,) 26321 000452'04 111 155 141 147 145 26322 000000000000# nspcnt==.-nsptab ; Number of items in table 26323 cleans() ; No need for symbol in listings, Etc. 26324 .psect code ; Back in code 26325 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 16 K20NET MAC 4-Apr-23 00:43 Canonicalize remote node name 26326 subttl Canonicalize remote node name 26327 26328 ; Rewrite the node name in case it was aliased. At least get it into 26329 ; UPPER case, which is what everybody wants. Also keeps gross CaMel 26330 ; case input from offending the sensitive 26331 26332 000603'01 337 02 0 00 000547* fixnam: skipg t2, netjfn ; Load JFN 26333 000604'01 263 17 0 00 000000 ret ; Unless there isn't one 26334 26335 000605'01 336 00 0 00 000000# ifmn. ndvfxp ; Have .ndvfx? 26336 000606'01 254 00 0 00 000611' 26337 000607'01 200 03 0 00 000257* move t3, nodnum ; Load previous node number 26338 000610'01 202 03 0 00 000000# movem t3, oldnum ; Store as old number 26339 000611'01 endif. ; Otherwise, will have to compare characters... 26340 26341 000611'01 120 03 0 00 000267* dmove t3, nodnam ; Load connected node name 26342 000612'01 124 03 0 00 000000# dmovem t3, oldnam ; Save (will hold six characters plus .chnul) 26343 000613'01 403 03 0 00 000004 setzb t3, t4 ; Cons up 10 .chnul's 26344 000614'01 124 03 0 00 000611* dmovem t3, nodnam ; Scrub storage enough 26345 26346 000615'01 561 01 0 00 000614* hrroi t1, nodnam ; Rewriting the node nam 26347 dmove t3, [ fld(.jsaof,js%nam) ; Just the file name 26348 000616'01 120 03 0 00 005211' 0 ] ; No strange prefix 26349 000617'01 104 00 0 00 000030 JFNS% ; Rewrite the node name 26350 000620'01 320 12 0 00 000412* erjmpr r ; ?? 26351 26352 000621'01 211 02 0 00 000003 movni t2,^d3 ; Getting before the dash 26353 000622'01 133 02 0 00 000001 adjbp t2,t1 ; back the pointer up 26354 000623'01 136 04 0 00 000002 idpb t4,t2 ; Stomp the dash, tying off the string 26355 000624'01 136 04 0 00 000002 idpb t4,t2 ; Also stomp the "2" and the ... 26356 000625'01 136 04 0 00 000002 idpb t4,t2 ; ... "3" to allow word compares 26357 000626'01 263 17 0 00 000000 ret ; Return everything all pretty 26358 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 17 K20NET MAC 4-Apr-23 00:43 Check if a connecting to a machine that supports Tops-20 NRT 26359 subttl Check if a connecting to a machine that supports Tops-20 NRT 26360 26361 ; Only these support a meta-data free NRT that we can use 26362 26363 ; N.B., These aren't just Tops-10 or Tops-20 machines! Ultrix-32 implements 26364 ; Tops-20 NRT. 26365 26366 000200 cnflen==200 ; Maximum characters allowed 26367 26368 000627'01 265 16 0 00 005213' chktop: saveac ; Fiddling with raw DECnet byte order 26369 000630'01 403 01 0 00 000002 setzb t1,t2 ; Cons up some zeros 26370 000631'01 124 01 0 00 000000# dmovem t1, nrtros ; Initialize unknown OS types 26371 000632'01 124 01 0 00 000000# dmovem t1, nrtflg ; and also NRT and network binary flags 26372 000633'01 402 00 0 00 000000# setzm nrtprt ; and also the NRT protocol 26373 26374 000634'01 337 01 0 00 000603* skipg t1, netjfn ; Load network JFN 26375 000635'01 263 17 0 00 000000 ret ; Unless there isn't one 26376 26377 000636'01 120 02 0 00 005223' dmove t2,[exp .morls,0] ; Read link status 26378 000637'01 104 00 0 00 000077 MTOPR% ; Request from the monitor 26379 000640'01 320 12 0 00 000544' erjmpr decerr ; Handle error 26380 26381 000641'01 607 03 0 00 020000 ifxn. t3,mo%eom ; Has an entire message? 26382 000642'01 254 00 0 00 000653' 26383 000643'01 400 02 0 00 000000 setz 2, ; Assume it's a lie 26384 000644'01 104 00 0 00 000102 SIBE% ; See what the deal is 26385 000645'01 334 00 0 00 000000 skipa ; Have some goodies to read, actually 26386 000646'01 254 00 0 00 000653' anskp. ; Or doesn't 26387 000647'01 303 02 0 00 000200 caile t2,cnflen ; Exceeds buffer length? 26388 000650'01 254 00 0 00 000653' anskp. ; clip it down 26389 000651'01 210 03 0 00 000002 movn t3,t2 ; Load exact length to read 26390 000652'01 254 00 0 00 000654' else. ; Otherwise use default length 26391 000653'01 211 03 0 00 000200 movni t3,cnflen ; Default maximum characters allowed 26392 000654'01 endif. 26393 26394 000654'01 200 02 0 00 005225' move t2,[point ^d8,cnfmsg] ;Note 8 bit pointer to config message 26395 000655'01 104 00 0 00 000531 SINR% ; Read Configuration message 26396 000656'01 320 12 0 00 000544' erjmpr decerr ; Gronked?? 26397 26398 remark ; Begin configuration message parsing 26399 000657'01 135 01 0 00 005226' ldb t1,[point ^D8,cnfmsg,7] 26400 000660'01 306 01 0 00 000001 cain t1,^d1 ; Is this a configuration message, actually? 26401 000661'01 254 00 0 00 000675' ifskp. ; No, so let's type it 26402 000662'01 200 01 0 00 000000# emsg 26403 000663'01 104 00 0 00 000313 26404 000052'03 000000000000# 26405 000460'04 077 040 111 154 154 26406 000664'01 201 01 0 00 000101 movei t1,.priou ; Output to primary 26407 000665'01 200 02 0 00 005227' move t2,[point ^d8,cnfmsg] ; Pointer to data from remote host 26408 000666'01 201 04 0 03 000200 movei t4,cnflen(t3) ; Get count received-1 26409 000667'01 210 03 0 00 000004 movn t3,t4 ; Now have output count 26410 000670'01 104 00 0 00 000053 SOUT% ; Type data on users terminal 26411 000671'01 320 12 0 00 000672' erjmpr .+1 ; Too bad for user, but ignore it 26412 000672'01 561 01 0 00 000600* hrroi t1, crlf ; Tie off 26413 000673'01 104 00 0 00 000076 PSOUT% ; the line k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 17-1 K20NET MAC 4-Apr-23 00:43 Check if a connecting to a machine that supports Tops-20 NRT 26414 000674'01 254 00 0 00 002750' callret clsnrt ; Close the connection 26415 000675'01 endif. ; End case connection message 26416 repeat 0,< ;;We don't look at the next two 26417 ldb t3,[point ^d8,cnfmsg,15] ; DEC ECO 26418 ldb t3,[point ^d8,cnfmsg,23] ; Customer ECO 26419 > 26420 000675'01 135 03 0 00 005230' ldb t3,[point ^d8,cnfmsg,34] ; Operating System type, high order byte 26421 000676'01 242 03 0 00 000010 lsh t3, ^d8 ; shift over and load the low order byte 26422 000677'01 135 04 0 00 005231' ldb t4,[point ^d8,cnfmsg+1,7] 26423 000700'01 200 05 0 00 000004 move q1, t4 ; Save constructed OS type 26424 26425 000701'01 200 01 0 00 000000# txmsg <[Remote system > ; Begin connection banner 26426 000702'01 104 00 0 00 000076 26427 000703'01 320 12 0 00 000704' 26428 000053'03 000000000000# 26429 000467'04 133 122 145 155 157 26430 000704'01 561 01 0 00 000615* hrroi t1,nodnam ; Remote system 26431 000705'01 104 00 0 00 000076 PSOUT% ; Type it 26432 000706'01 200 01 0 00 000000# txmsg <:: is running > 26433 000707'01 104 00 0 00 000076 26434 000710'01 320 12 0 00 000711' 26435 000054'03 000000000000# 26436 000473'04 072 072 040 151 163 26437 26438 000711'01 415 16 0 00 000723' block. ; Enter block context for easier control flow 26439 000712'01 261 17 0 00 000016 26440 000713'01 305 04 0 00 000000 caige t4, 0 ; Negative OS number?? 26441 000714'01 263 17 0 00 000000 ret ; That will never work 26442 000715'01 303 04 0 00 000022 caile t4, hsttyn ; Out of range? 26443 000716'01 263 17 0 00 000000 ret ; Don't know that, either 26444 000717'01 336 00 0 04 000763' skipn hsttyp(t4) ; But!! Is this entry 'known'? 26445 000720'01 263 17 0 00 000000 ret ; Nope (note table has 'reserved' gaps) 26446 000721'01 254 00 0 00 000440* retskp ; Otherwise, it's fine 26447 000722'01 263 17 0 00 000000 endbk. ; Return out of block context, one way or another 26448 000723'01 254 00 0 00 000730' ifskp. ; Skip means we know the remote OS code 26449 000724'01 200 01 0 04 000763' move t1, hsttyp(t4) ; Load OWGP to OS type string 26450 000725'01 202 01 0 00 000000# movem t1, rosnpt ; Save it for k20dsp 26451 000726'01 104 00 0 00 000076 PSOUT% ; Print it 26452 000727'01 254 00 0 00 000742' else. ; Non-skip means we didn't know it 26453 000730'01 200 01 0 00 000000# sxtext (t1,) ; Give it something to type 26454 000055'03 000000000000# 26455 000476'04 125 156 153 156 157 26456 000731'01 202 01 0 00 000000# movem t1, rosnpt ; if it wants something to type 26457 000732'01 200 01 0 00 000000# txmsg < an unknown operating system type: > ; Begin the blat 26458 000733'01 104 00 0 00 000076 26459 000734'01 320 12 0 00 000735' 26460 000056'03 000000000000# 26461 000500'04 040 141 156 040 165 26462 000735'01 201 01 0 00 000101 movei t1, .priou ; Still going to the terminal 26463 000736'01 200 02 0 00 000004 move t2, t4 ; Load the code we got 26464 000737'01 201 03 0 00 000012 movei t3, ^d10 ; These are in base 10 26465 000740'01 104 00 0 00 000224 NOUT% ; Blat the code 26466 000741'01 320 12 0 00 000742' erjmpr .+1 ; Catch and ignore the error 26467 000742'01 endif. ; End OS tyoe check 26468 txmsg <] k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 17-2 K20NET MAC 4-Apr-23 00:43 Check if a connecting to a machine that supports Tops-20 NRT 26469 000742'01 200 01 0 00 000000# > 26470 000743'01 104 00 0 00 000076 26471 000744'01 320 12 0 00 000745' 26472 000057'03 000000000000# 26473 000510'04 135 015 012 000 000 26474 000745'01 135 06 0 00 005232' ldb q2,[point ^d16,cnfmsg+1,23] ; Supported protocol types bit field 26475 000746'01 602 06 0 00 000010 ifxe. q2, TOPNRT ; Anything we understand? 26476 000747'01 254 00 0 00 000756' 26477 000750'01 561 01 0 00 000704* hrroi t1, nodnam ; Begin complaining 26478 000751'01 104 00 0 00 000313 ESOUT% ; about the node 26479 txmsg <:: does not support Tops-10/Tops-20 Network Remote Terminal protocol 26480 000752'01 200 01 0 00 000000# > 26481 000753'01 104 00 0 00 000076 26482 000754'01 320 12 0 00 000755' 26483 000060'03 000000000000# 26484 000511'04 072 072 040 144 157 26485 26486 000755'01 254 00 0 00 002750' callret clsnrt ; Close the connection 26487 000756'01 endif. 26488 26489 000756'01 202 05 0 00 000000# movem q1, nrtros ; If NRT, remote operating system type 26490 000757'01 202 06 0 00 000000# movem q2, nrtprt ; Save NRT protocols offered by remote 26491 26492 000760'01 476 00 0 00 000000# setom nrtflg ; Flag this is a valid NRT 26493 000761'01 476 00 0 00 000000# setom binflg ; Flag we will do binary 26494 000762'01 254 00 0 00 000721* retskp ; Won!! 26495 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 18 K20NET MAC 4-Apr-23 00:43 List of known DECnet host operating system types 26496 subttl List of known DECnet host operating system types 26497 26498 ; The base list comes from the venerable SETHOS (hence the similar 26499 ; variable names), but it has been updated with additional systems 26500 ; from the fine folks on HECnet. 26501 ; 26502 ; Be aware that these is not the same list as the DAP list!! 26503 ; (naturally...) They're not even the same between CTerm and NRT! 26504 26505 000763'01 hsttyp: intern hsttyp ; Used by k20dsp, twoo 26506 000763'01 000000000000# eascii ;^d0 26507 000530'04 122 123 124 123 000 26508 000764'01 000000000000# eascii ;^d1 26509 000531'04 122 124 055 061 061 26510 000765'01 000000000000# eascii ;^d2 26511 000533'04 122 123 124 123 057 26512 000766'01 000000000000# eascii ;^d3 26513 000535'04 122 123 130 055 061 26514 000767'01 000000000000# eascii ;^d4 26515 000537'04 122 123 130 055 061 26516 000770'01 000000000000# eascii ;^d5 26517 000541'04 122 123 130 055 061 26518 000771'01 000000000000# eascii ;^d6 26519 000543'04 111 101 123 000 000 26520 000772'01 000000000000# eascii ;^d7 26521 000544'04 126 115 123 000 000 26522 000773'01 000000000000# eascii ;^d8 (TOPS20) 26523 000545'04 124 117 120 123 055 26524 000774'01 000000000000# eascii ;^d9 (TOPS10) 26525 000547'04 124 117 120 123 055 26526 000775'01 000000000000# eascii ;^d10 26527 000551'04 122 124 123 055 070 26528 000776'01 000000000000# eascii ;^d11 (!!) 26529 000553'04 117 123 055 070 000 26530 000777'01 000000000000# eascii ;^d12 26531 000554'04 122 123 130 055 061 26532 001000'01 000000000000# eascii ;^d13 (the DN20!!) 26533 000556'04 115 103 102 000 000 26534 001001'01 000000000000# 0 ;^d14 Reserved 26535 001002'01 000000 000000 0 ;^d15 Reserved 26536 001003'01 000000 000000 0 ;^d16 Reserved 26537 001004'01 000000 000000 0 ;^d17 Reserved 26538 001005'01 000000000000# eascii ;^d18 26539 000557'04 125 114 124 122 111 26540 000000000000# hsttyn=.-hsttyp-1 ; Number of defined operating system types 26541 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 19 K20NET MAC 4-Apr-23 00:43 DECnet interrupt message processing (unused by Kermit) 26542 subttl DECnet interrupt message processing (unused by Kermit) 26543 26544 ; Gets an prints a DECnet interrupt message (which should never happen) 26545 ; and prints it on the user's terminal. No interrupt is enabled for 26546 ; this and the condition is checked for most irregularly. 26547 26548 001006'01 intmsg: entry intmsg 26549 001006'01 265 16 0 00 005173' saveac ; Be transparent 26550 dmove t2, [ .morim ; Read interrupt message 26551 001007'01 120 02 0 00 005233' point 7,intbuf] ; Use this area 26552 001010'01 104 00 0 00 000077 MTOPR% ; Grab the message 26553 001011'01 320 12 0 00 001013' %jserr (,r) 26554 001012'01 254 00 0 00 001016' 26555 001013'01 265 01 0 00 000477* 26556 001014'01 000000000000# 26557 001015'01 254 00 0 00 000620* 26558 000561'04 125 156 141 142 154 26559 001016'01 200 01 0 00 000000# txmsg <[KERMIT-20: DECnet Interrupt Message: > 26560 001017'01 104 00 0 00 000076 26561 001020'01 320 12 0 00 001021' 26562 000061'03 000000000000# 26563 000570'04 133 113 105 122 115 26564 dmove t1, [ .priou ; Typing on terminal 26565 001021'01 120 01 0 00 005235' point 7,intbuf] ; Point where we read this foolishness 26566 001022'01 210 03 0 00 000004 movn t3,t4 ; Doing a counted print 26567 001023'01 104 00 0 00 000053 SOUT% ; Display what we got 26568 001024'01 320 12 0 00 001026' %jserr (,r) 26569 001025'01 254 00 0 00 001031' 26570 001026'01 265 01 0 00 001013* 26571 001027'01 000000000000# 26572 001030'01 254 00 0 00 001015* 26573 000600'04 125 156 141 142 154 26574 txmsg <] 26575 001031'01 200 01 0 00 000000# > ; Close alert and tie off line 26576 001032'01 104 00 0 00 000076 26577 001033'01 320 12 0 00 001034' 26578 000062'03 000000000000# 26579 000607'04 135 015 012 000 000 26580 001034'01 263 17 0 00 000000 ret ; Return with a clean register file 26581 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 20 K20NET MAC 4-Apr-23 00:43 Initialize PTY parameters (adapted from BATCON) 26582 subttl Initialize PTY parameters (adapted from BATCON) 26583 26584 001035'01 inipty: entry inipty 26585 001035'01 200 01 0 00 005237' movx t1, 'TTYJOB' ; Terminal line to job number and 'hungry' 26586 001036'01 104 00 0 00 000016 SYSGT% ; Get the values 26587 001037'01 320 12 0 00 001041' ifje. r ; Fetch error for debugger 26588 001040'01 254 00 0 00 001043' 26589 001041'01 403 02 0 00 000000# setzb t2, ttygtb ; Set an impossible value 26590 001042'01 254 00 0 00 001044' else. ; Otherwise, JSYS worked 26591 001043'01 202 02 0 00 000000# movem t2, ttygtb ; So store something useful 26592 001044'01 endif. ; End case JSYS error handling 26593 26594 001044'01 200 01 0 00 005240' movx t1, 'PTYPAR' ; pseudo terminal configuration info 26595 001045'01 104 00 0 00 000016 SYSGT% ; Get the values 26596 001046'01 320 12 0 00 001050' ifje. r ; Fetch error for debugger 26597 001047'01 254 00 0 00 001052' 26598 001050'01 200 03 0 00 000001 move t3,t1 ; Save error 26599 001051'01 477 01 0 00 000002 setob t1,t2 ; Load a impossible values 26600 001052'01 endif. ; End case JSYS error handling 26601 26602 001052'01 572 01 0 00 000000# hrrem t1,pty1st ; Save TTY number of first PTY 26603 001053'01 576 01 0 00 000000# hlrem t1,ptycnt ; Save count of pseudo-terminals 26604 001054'01 202 02 0 00 000000# movem t2,ptygtb ; GETAB% index (which we'll never use) 26605 26606 001055'01 263 17 0 00 000000 ret ; Done 26607 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 21 K20NET MAC 4-Apr-23 00:43 PTY acquisition 26608 subttl PTY acquisition 26609 26610 ; Assign a PTY to use. This is necessary because, between the time we 26611 ; find a free PTY and the time we actually OPENF% it, somebody else may 26612 ; have already grabbed it. 26613 ; 26614 ; Another way to 'lock' the PTY for exclusive use is simply to open it. 26615 ; The approach of doing an ASND% is superior to this because the PTY 26616 ; can be opened as convenient and, if closed, can still be reused. 26617 ; Otherwise we'd have to go through this whole rigmarole again. 26618 ; 26619 ; Adapted from BATCON, which does an assign by ASND% as apposed to Phase 26620 ; II NRTSRV which assigns by OPENF%. 26621 ; 26622 ; Returns: 26623 ; 26624 ; t1/ Loopback terminal line 26625 ; t2/ Assigned PTY designator 26626 ; 26627 ; N.B., Always have to start with the first PTY and go through all of 26628 ; them because one of them may have become free. 26629 ; 26630 ; Be aware that, if you have more than one Kermit fork in a job doing 26631 ; pseudo-terminal based transfers, then this code will do the wrong 26632 ; thing because a single PTY is assumed to be used per job. There is 26633 ; no expectation of any problem as pseudo-terminals are only used for 26634 ; debugging, testing and prototyping. 26635 26636 001056'01 asipty: entry asipty ; Called by k20mit, also 26637 001056'01 265 16 0 00 005241' saveac ; Leave the registers alone 26638 26639 001057'01 402 00 0 00 000000# setzm ptyflg ; Not doing pseudo-terminals 26640 001060'01 402 00 0 00 000000# setzm binflg ; Not doing binary 26641 001061'01 336 00 0 00 000262* ifmn. asgflg ; Did we have an assigned device? 26642 001062'01 254 00 0 00 001105' 26643 001063'01 336 01 0 00 000263* skipn t1,asgdev ; That is, if we still know it 26644 001064'01 254 00 0 00 001105' anskp. ; Shouldn't happen, but... 26645 001065'01 104 00 0 00 000117 DVCHR% ; Pull the device characteristics 26646 001066'01 320 12 0 00 001070' ifje. r ; Trap error, record it 26647 001067'01 254 00 0 00 001072' 26648 001070'01 200 04 0 00 000001 move t4,t1 ; Get the error out of the way 26649 001071'01 403 01 0 00 000002 setzb t1,t2 ; Claim impossible values 26650 001072'01 endif. ; End JSYS error trap 26651 001072'01 312 01 0 00 001063* came t1,asgdev ; Double check; it's the same, right? 26652 001073'01 254 00 0 00 001105' anskp. ; Different somehow, so don't try to reuse it 26653 001074'01 135 04 0 00 005255' ldb t4,[pointr t2,dv%typ] ;Load the device type 26654 001075'01 302 04 0 00 000013 caie t4,.dvpty ; Is it a pseudo-terminal? 26655 001076'01 254 00 0 00 001105' anskp. ; No, so it is useless for loop back 26656 001077'01 574 04 0 00 000003 hlre t4,t3 ; Pick up the assigned job 26657 001100'01 312 04 0 00 000000* came t4,myjob ; Is it me? 26658 001101'01 254 00 0 00 001105' anskp. ; No, get our own, then 26659 remark t1,t2 ; Device designator and charteristics words loaded 26660 001102'01 476 00 0 00 000000# setom ptyflg ; Flag we have a pseudo-terminal 26661 001103'01 476 00 0 00 000000# setom binflg ; And that it will do binary 26662 001104'01 254 00 0 00 000762* retskp ; Return success, device string already built k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 21-1 K20NET MAC 4-Apr-23 00:43 PTY acquisition 26663 001105'01 endif. ; End case attempting device reu-se 26664 26665 001105'01 402 00 0 00 001061* setzm asgflg ; Nothing assigned 26666 001106'01 402 00 0 00 001072* setzm asgdev ; So no assigned device 26667 001107'01 337 05 0 00 000000# skipg q1,ptycnt ; Load and check count of ptys 26668 001110'01 263 17 0 00 000000 ret ; Give up right now 26669 001111'01 335 06 0 00 000000# skipge q2,pty1st ; Load line number associated with 1st PTY 26670 001112'01 263 17 0 00 000000 ret ; Don't work with junk from SYSGT% 26671 001113'01 400 07 0 00 000000 setz q3, ; Initial pseudo-terminal is PTY0: 26672 26673 001114'01 do. ; Enter loop context 26674 001114'01 205 01 0 00 600013 movsi t1,.dvdes+.dvpty ;Load pseudo-terminal device designator 26675 001115'01 540 01 0 00 000007 hrr t1,q3 ; Load the current PTY number 26676 001116'01 104 00 0 00 000117 DVCHR% ; Get device characteristics for this PTY 26677 001117'01 320 12 0 00 001121' ifje. r ; Pick up error for debugger 26678 001120'01 254 00 0 00 001122' 26679 001121'01 400 02 0 00 000000 setz t2, ; Default to not available 26680 001122'01 endif. ; End case device 26681 001122'01 607 02 0 00 010000 ifxn. t2,dv%av ; Free? (available) 26682 001123'01 254 00 0 00 001133' 26683 001124'01 120 03 0 00 000001 dmove t3,t1 ; Save designator words 26684 001125'01 104 00 0 00 000070 ASND% ; Quick! Assign it!! 26685 001126'01 320 16 0 00 001133' annje. ; Failed, do next PTY 26686 001127'01 124 03 0 00 000000# dmovem t3, ndvchr ; Save network device characteristics 26687 001130'01 476 00 0 00 001105* setom asgflg ; Assigned it. Set this flag to remember. 26688 001131'01 202 03 0 00 001106* movem t3, asgdev ; save assigned device 26689 001132'01 254 00 0 00 001136' exit. ; Got it! We're done 26690 001133'01 endif. ; End availibility/assignment attempt 26691 001133'01 114 06 0 00 005256' dadd q2,[exp 1,1] ; Bump both PTY and TTY numbers (clever) 26692 001134'01 367 05 0 00 001114' sojg q1,top. ; Try next pty 26693 001135'01 263 17 0 00 000000 ret ; Otherwise, couldn't get anything, fail 26694 001136'01 enddo. ; Exit loop context 26695 26696 001136'01 200 07 0 00 000001 move q3,t1 ; Save assigned PTY device 26697 001137'01 200 02 0 00 000001 move t2,t1 ; Use it here, too 26698 001140'01 561 01 0 00 000000# hrroi t1,ptynam ; Point to area to write PTY specification 26699 001141'01 104 00 0 00 000121 DEVST% ; Turn device into string 26700 001142'01 320 12 0 00 001030* erjmpr r ; Fail, we just assigned the device! 26701 26702 001143'01 201 02 0 00 000072 movei t2,":" ; Load terminating device punctuation 26703 001144'01 136 02 0 00 000001 idpb t2,t1 ; Complete device syntax 26704 001145'01 400 02 0 00 000000 setz t2, ; Load .chnul 26705 001146'01 136 02 0 00 000001 idpb t2,t1 ; Tie off the string 26706 26707 001147'01 205 02 0 00 600012 movsi t2,.dvdes+.dvtty ; Load terminal device designator 26708 001150'01 540 02 0 00 000006 hrr t2,q2 ; Build complete terminal designator 26709 001151'01 202 02 0 00 000000# movem t2,ptytty ; Store in case we need to manipulate it 26710 26711 001152'01 561 01 0 00 000000# hrroi t1,ttynam ; Point to area to write TTY specification 26712 001153'01 104 00 0 00 000121 DEVST% ; Turn device into string 26713 001154'01 320 12 0 00 001142* erjmpr r ; Fail, we just assigned the device! 26714 26715 001155'01 201 02 0 00 000072 movei t2,":" ; Load terminating device punctuation 26716 001156'01 136 02 0 00 000001 idpb t2,t1 ; Complete device syntax 26717 001157'01 400 02 0 00 000000 setz t2, ; Load .chnul k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 21-2 K20NET MAC 4-Apr-23 00:43 PTY acquisition 26718 001160'01 136 02 0 00 000001 idpb t2,t1 ; Tie off the string 26719 26720 001161'01 476 00 0 00 000000# setom ptyflg ; Flag we have a pseudo-terminal 26721 001162'01 476 00 0 00 000000# setom binflg ; And that it will do binary 26722 001163'01 120 01 0 00 000006 dmove t1,q2 ; Load terminal number and PTY designator 26723 001164'01 254 00 0 00 001104* retskp ; Done 26724 26725 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 22 K20NET MAC 4-Apr-23 00:43 Externals for Alternate Network Code 26726 subttl Externals for Alternate Network Code 26727 26728 extern doesc ; Label of main loop for escape character handling 26729 extern duplex ; Whether we're echoing or not 26730 extern echo ; Routine for local echoing 26731 extern escape ; Escape character for connecting (default ^\) 26732 extern vtermf ; Not running on real copper 26733 extern netlgx ; Label to continue error log handling 26734 extern ttfork ; Fork number of the connect receive fork. 26735 extern ttinch ; Label of main keyboard input loop 26736 extern tter1 ; Label for terminal error handling 26737 extern carier ; Carrier flag (also means connected) 26738 extern $connx ; Close connection for a physical line 26739 extern frkchn ; Fork channel interrupt number 26740 extern mdmlin ; -1 = modem-controlled line, 0 = not. 26741 extern sesjfn ; Session log file JFN. 26742 extern sesflg ; Whether the session log is active 26743 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 23 K20NET MAC 4-Apr-23 00:43 Execute the SET LINE command 26744 subttl Execute the SET LINE command 26745 26746 ; SET LINE is almost exactly like CONNECT, except that confirming a 26747 ; CONNECT with no arguments reconnects to an existing connection 26748 ; whereas confirming a SET LINE with no arguments CLOSES the 26749 ; connection. A subtle difference... 26750 ; 26751 ; $CONNE now has all the hair connection logic, no matter the 26752 ; connection type, PTY, line, NRT, Etc. This routine is simply taking 26753 ; care of a historical special case. 26754 ; 26755 ;Call: 26756 ; 26757 ;pars3/ Parse type: .cmkey, .cmnod, .cmnum, Etc. 26758 ;pars4/ Device information: type, unit, line number, Etc. 26759 26760 001165'01 $setln: entry $setln 26761 001165'01 265 16 0 00 005122' saveac ;[218] Parse item 26762 001166'01 120 05 0 00 000000* dmove q1, pars3 ;[218] Load parse type and unit 26763 001167'01 302 05 0 00 000010 caie q1, .cmcfm ;[218] Wanted to close? 26764 001170'01 254 00 0 00 001203' ifskp. ;[218] We did, so let's do that 26765 001171'01 333 07 0 00 000634* skiple q3, netjfn ;[218] Umm, do we have a connection? 26766 001172'01 254 00 0 00 001176' ifskp. ;[218] We do not, so nothing to do 26767 001173'01 200 01 0 00 000000# emsg ;[218] 26768 001174'01 104 00 0 00 000313 26769 000063'03 000000000000# 26770 000610'04 116 157 040 157 160 26771 001175'01 263 17 0 00 000000 ret ;[218] Nothing further to do 26772 001176'01 endif. ;[218] Otherwise, something is up 26773 001176'01 260 17 0 00 002673' call clsjfn ;[218] Stomp the network connection 26774 txmsg <[Connection closed] 26775 001177'01 200 01 0 00 000000# > ;[218] Say it's all over 26776 001200'01 104 00 0 00 000076 26777 001201'01 320 12 0 00 001202' 26778 000064'03 000000000000# 26779 000616'04 133 103 157 156 156 26780 26781 001202'01 263 17 0 00 000000 ret ;[218] End we're done 26782 001203'01 endif. ;[218] End case confirming to close 26783 26784 001203'01 254 00 0 00 001204' callret $conne ;[218] The rest is just like CONNECT 26785 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 24 K20NET MAC 4-Apr-23 00:43 CONNECT command 26786 subttl CONNECT command 26787 26788 ;[151] CONNECT code totally rewritten as Edit 151. Formerly, CONNECT was 26789 ; accomplished by running a program TTLINK in a lower fork. Now, the 26790 ; code is integrated into this program. This was done for two reasons: 26791 ; 26792 ; 1. V6 of TOPS-20 doesn't allow multiple JFNs on the same TTY device. 26793 ; [V7 has yet to be vetted] 26794 ; 2. TTLINK was interrupt-driven and therefore did not work under batch. 26795 ; 26796 ; This method, similar to that used in Mark Crispin's TELNET program, uses 26797 ; separate input and output forks. It works under batch because the "pty" 26798 ; is always "hungry". 26799 ; 26800 ;[187] This isn't quite true. TELNET can't run well under Batch precisely 26801 ; BECAUSE of the asynchronous forks. Actually, it really doesn't work 26802 ; at all. 26803 ; 26804 ; The Batch paradigm is fundamentally line half-duplex. This means 26805 ; that a line of input is pushed into a PTY and a response is checked 26806 ; for. The PTY may, in fact, NOT be hungry because the program is 26807 ; busy performing the requested command. 26808 ; 26809 ; When running asynchronously, the PTY will ALWAYS look hungry since 26810 ; the fork that is waiting for the input may not even be on the same 26811 ; system. This means that BATCON will continuously stuff input until 26812 ; something goes wrong. If a command fails, then a number of commands 26813 ; will have been typed ahead with unpredictable (or even catastrophic) 26814 ; results. 26815 ; 26816 ; A local modification to BATCON implements a Batch WAIT command, 26817 ; which causes BATCON to ignore PTY hungry for the indicated number of 26818 ; seconds to give whatever is on the other side of the PTY time to 26819 ; type something. It is, at best, a hack. 26820 ; 26821 ; It's best to not use the fork at all and go with a CONNECT/STAY and 26822 ; from there user use the INPUT and OUTPUT commands. 26823 26824 001204'01 $conne: entry $conne ;[186] Invoked from k20mit 26825 extern ttsfrk ;[186] Joins k20mit here 26826 26827 001204'01 335 01 0 00 001166* skipge t1, pars3 ;[186] Load the parse type 26828 001205'01 201 01 0 00 000010 movx t1, .cmcfm ;[186] If junk, use confirm 26829 26830 001206'01 302 01 0 00 000010 caie t1, .cmcfm ;[186] Confirmed (reconnect)? 26831 001207'01 254 00 0 00 001252' ifskp. ;[186] Yes, let's see if that makes sense 26832 001210'01 333 02 0 00 000000# skiple t2, opndev ;[186] Load currently connected device 26833 001211'01 254 00 0 00 001215' ifskp. ;[186] Junk?? 26834 emsg ;[186] Shouldn't happen. Ever 26836 001213'01 104 00 0 00 000313 26837 000065'03 000000000000# 26838 000623'04 116 157 164 150 151 26839 26840 001214'01 263 17 0 00 000000 ret ;[186] Do not continue k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 24-1 K20NET MAC 4-Apr-23 00:43 CONNECT command 26841 001215'01 endif. ;[186] End case absurd open device 26842 26843 001215'01 332 00 0 00 000232* ifme. local ;[186] Remote? 26844 001216'01 254 00 0 00 001223' 26845 001217'01 201 01 0 00 000001 movei t1, .cmnum ;[186] Can't connect to ourself 26846 001220'01 200 02 0 00 000000* move t2, mytty ;[186] So pretend we tried 26847 001221'01 124 01 0 00 001204* dmovem t1, pars3 ;[186] Stomp the parse 26848 001222'01 254 00 0 00 001252' jrst $conn1 ;[186] and carry on, eventualy to fail 26849 001223'01 endif. ;[186] End case remote reconnect 26850 26851 001223'01 302 02 0 00 000013 caie t2, .dvpty ;[186] Reconnect a PTY? 26852 001224'01 254 00 0 00 001230' ifskp. ;[186] Yes, fake that out 26853 001225'01 201 01 0 00 000000 movei t1, .cmkey ;[186] Pretend we parsed a keyword 26854 001226'01 124 01 0 00 001221* dmovem t1, pars3 ;[186] Stomp that in 26855 001227'01 254 00 0 00 001252' jrst $conn1 ;[186] Continue (re)connect 26856 001230'01 endif. ;[186] End case PTY reconnection 26857 26858 001230'01 302 02 0 00 000012 caie t2, .dvtty ;[186] Reconnect a physical terminal? 26859 001231'01 254 00 0 00 001236' ifskp. ;[186] Yes, fake that out 26860 001232'01 201 01 0 00 000001 movei t1, .cmnum ;[186] Pretend we parsed a number 26861 001233'01 200 02 0 00 000217* move t2, ttynum ;[186] Which is the currently open terminal 26862 001234'01 124 01 0 00 001226* dmovem t1, pars3 ;[186] Stomp that in and continue 26863 001235'01 254 00 0 00 001252' jrst $conn1 ;[186] Continue (re)connect 26864 001236'01 endif. ;[186] End case terminal reconnection 26865 26866 001236'01 302 02 0 00 000022 caie t2, .dvdcn ;[186] Reconnect an NRT? 26867 001237'01 254 00 0 00 001245' ifskp. ;[186] Yes, fake that out 26868 001240'01 201 01 0 00 000026 movei t1, .cmnod ;[186] Pretend we parsed a node 26869 001241'01 124 01 0 00 001234* dmovem t1, pars3 ;[186] Stomp that in 26870 001242'01 120 03 0 00 000750* dmove t3, nodnam ;[186] Load current node name 26871 001243'01 124 03 0 00 000000* dmovem t3, atmbuf ;[186] Pretend we parsed it 26872 001244'01 254 00 0 00 001252' jrst $conn1 ;[186] Continue (re)connect 26873 001245'01 endif. ;[186] End case NRT reconnection 26874 26875 001245'01 334 01 0 00 000000# ermsg% (, r) 26876 001246'01 254 00 0 00 001252' 26877 001247'01 202 01 0 00 000000* 26878 001250'01 104 00 0 00 000313 26879 001251'01 254 00 0 00 001154* 26880 000066'03 000000000000# 26881 000632'04 113 105 122 115 111 26882 26883 001252'01 endif. ;[186] End case ,cmcfm 26884 26885 001252'01 302 01 0 00 000001 $conn1: caie t1, .cmnum ;[186] Parsed a number? 26886 001253'01 254 00 0 00 001271' ifskp. ;[186] Yes, wants a physical line 26887 001254'01 331 02 0 00 000000* skipl t2, pars4 ;[186] Sanity check the number 26888 001255'01 254 00 0 00 001261' ifskp. ;[186] Don't let's be silly... 26889 emsg ;[186] An appropriate Vulcan response 26891 001257'01 104 00 0 00 000313 26892 000067'03 000000000000# 26893 000642'04 116 145 147 141 164 26894 26895 001260'01 263 17 0 00 000000 ret ;[186] And get out of here k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 24-2 K20NET MAC 4-Apr-23 00:43 CONNECT command 26896 001261'01 endif. ;[186] End case negative number 26897 26898 001261'01 312 02 0 00 001220* came t2, mytty ;[186] Is the requested line the same as ours? 26899 001262'01 254 00 0 00 001266' ifskp. ;[186] It is silly to connect to ourselves 26900 emsg ;[187] Advise user of their confusion 26903 001264'01 104 00 0 00 000313 26904 000070'03 000000000000# 26905 000653'04 131 157 165 040 143 26906 26907 26908 001265'01 263 17 0 00 000000 ret ;[186] And get out of here 26909 001266'01 endif. ;[186] End case self-connect 26910 remark ;[186] Fine, let's try to use it 26911 001266'01 505 01 0 00 000012 hrli t1, .dvtty ;[186] Requesting a terminal 26912 001267'01 540 01 0 00 000002 hrr t1, t2 ;[186] This line 26913 001270'01 254 00 0 00 001427' jrst $conn2 ;[186] Go blat about the connection 26914 001271'01 endif. ;[186] End case physical line 26915 26916 001271'01 302 01 0 00 000000 caie t1, .cmkey ;[186] Parsed a keyword? 26917 001272'01 254 00 0 00 001344' ifskp. ;[186] Yes, let's see about that 26918 001273'01 550 01 0 00 001254* hrrz t1, pars4 ;[186] Load the requested device 26919 001274'01 302 01 0 00 000015 caie t1, .dvnul ;[186] Wants to close out? 26920 001275'01 254 00 0 00 001310' ifskp. ;[186] Yes, so break the connection 26921 001276'01 332 00 0 00 001215* ifme. local ;[186] Already remote? 26922 001277'01 254 00 0 00 001303' 26923 emsg 26925 001301'01 104 00 0 00 000313 26926 000071'03 000000000000# 26927 000677'04 116 157 040 156 145 26928 26929 001302'01 263 17 0 00 000000 ret ;[186] Nothing to do, bye 26930 001303'01 endif. ;[186] End case not local 26931 001303'01 260 17 0 00 002676' call clsnet ;[186] Close whatever might be open 26932 txmsg <[Connection closed] 26933 001304'01 200 01 0 00 000000# > ;[186] Should say connection with what... 26934 001305'01 104 00 0 00 000076 26935 001306'01 320 12 0 00 001307' 26936 000072'03 000000000000# 26937 000706'04 133 103 157 156 156 26938 26939 001307'01 263 17 0 00 000000 ret ;[186] Proceed no further 26940 001310'01 endif. ;[186] End case closure 26941 26942 001310'01 302 01 0 00 000013 caie t1, .dvpty ;[186] Wants local loopback, differet job? 26943 001311'01 254 00 0 00 001314' ifskp. ;[186] Fine, let's try to use it 26944 001312'01 525 01 0 00 000013 hrloi t1, .dvpty ;[186] We don't specify the pseudo terminal 26945 001313'01 254 00 0 00 001427' jrst $conn2 ;[186] Go blat about the connection 26946 001314'01 endif. ;[186] 26947 26948 001314'01 302 01 0 00 000403 caie t1, .dvpip ;[186] Local connection, same job? 26949 001315'01 254 00 0 00 001321' ifskp. ;[186] Ok, handle that 26950 emsg () 26952 001317'01 104 00 0 00 000313 26953 000073'03 000000000000# 26954 000713'04 123 141 155 145 040 26955 26956 001320'01 263 17 0 00 000000 ret ;[186] Nothing to do, bye 26957 001321'01 endif. ;[186] End case doing a pipe 26958 26959 001321'01 302 01 0 00 777774 caie t1, .fhinf ;[205] Wants to get rid of the terminal fork? 26960 001322'01 254 00 0 00 001337' ifskp. ;[205] Does, so no 'network' activity 26961 001323'01 333 01 0 00 000000* skiple t1, ttfork ;[205] Load the fork handle 26962 001324'01 254 00 0 00 001330' ifskp. ;[205] Unless there isn't one 26963 emsg ;[205] Blat about it 26965 001326'01 104 00 0 00 000313 26966 000074'03 000000000000# 26967 000727'04 116 157 040 162 145 26968 26969 001327'01 254 00 0 00 001335' else. ;[205] Otherwise, get rid of it 26970 001330'01 104 00 0 00 000153 KFORK% ;[205] BYE!! 26971 001331'01 320 12 0 00 001332' erjmpr .+1 ;[205] Ignore error and carry on 26972 txmsg <[Killed remote terminal fork] 26973 001332'01 200 01 0 00 000000# > ;[205] 26974 001333'01 104 00 0 00 000076 26975 001334'01 320 12 0 00 001335' 26976 000075'03 000000000000# 26977 000736'04 133 113 151 154 154 26978 26979 001335'01 endif. ;[205] End fork determination actions 26980 001335'01 402 00 0 00 001323* setzm ttfork ;[205] Remember its demise 26981 001336'01 263 17 0 00 000000 ret ;[205] And we're done 26982 001337'01 endif. ;[205] End case terminal fork management 26983 26984 001337'01 334 01 0 00 000000# ermsg% (,r) ;[186] 26985 001340'01 254 00 0 00 001344' 26986 001341'01 202 01 0 00 001247* 26987 001342'01 104 00 0 00 000313 26988 001343'01 254 00 0 00 001251* 26989 000076'03 000000000000# 26990 000745'04 113 105 122 115 111 26991 26992 001344'01 endif. ;[186] End case .cmkey 26993 26994 001344'01 302 01 0 00 000026 caie t1, .cmnod ;[186] Parsed a node? 26995 001345'01 254 00 0 00 001422' ifskp. ;[186] Yes, wants to have excitement and adventure! 26996 001346'01 415 16 0 00 001372' block. ;[186] Allocate an anonymous stkvar 26997 001347'01 261 17 0 00 000016 26998 001350'01 265 16 0 00 000000* anstkv(t4,<.ndnum+1>);[186] Allocate a block for NODE% 26999 001351'01 000000 000003 27000 001352'01 415 04 0 17 777774 27001 001353'01 561 01 0 00 001243* hrroi t1, atmbuf ;[186] Point to whatever user typed 27002 001354'01 202 01 0 04 000000 movem t1, .ndnod(t4) ;[186] Store in block 27003 001355'01 403 01 0 00 000002 setzb t1, t2 ;[186] Cons up some zeros 27004 001356'01 124 01 0 04 000001 dmovem t1, .ndflg(t4) ;[186] Stomp flags and number 27005 001357'01 201 01 0 00 000023 movei t1, .ndvfx ;[186] Node name verify, extended k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 24-4 K20NET MAC 4-Apr-23 00:43 CONNECT command 27006 001360'01 336 00 0 00 000000# skipn ndvfxp ;[186] Has extended verify? 27007 001361'01 201 01 0 00 000015 movx t1, .ndvfy ;[186] Unfortunate, but still doable 27008 001362'01 200 02 0 00 000004 move t2, t4 ;[186] Load base of block 27009 001363'01 104 00 0 00 000567 NODE% ;[186] Should work because .cmnod validates 27010 001364'01 320 12 0 00 001366' ifje. r ;[186] Failed?? 27011 001365'01 254 00 0 00 001370' 27012 001366'01 403 02 0 00 000003 setzb t2, t3 ;[186] Whack any supposed flags 27013 001367'01 254 00 0 00 001371' else. ;[186] Otherwise, worked 27014 001370'01 120 02 0 04 000001 dmove t2, .ndflg(t4) ;[186] Load flags and maybe number 27015 001371'01 endif. ;[186] End JSYS error processing 27016 001371'01 263 17 0 00 000000 endbk. ;[186] End block, restore stack 27017 001372'01 603 02 0 00 200000 ifxe. t2, nd%lgl ;[186] Illegal in some way? 27018 001373'01 254 00 0 00 001403' 27019 001374'01 200 01 0 00 000000# emsg ;[186] Blat about it 27020 001375'01 104 00 0 00 000313 27021 000077'03 000000000000# 27022 000756'04 111 154 154 145 147 27023 001376'01 561 01 0 00 001353* hrroi t1, atmbuf ;[186] Point to what was typed 27024 001377'01 104 00 0 00 000076 PSOUT% ;[186] Type it 27025 001400'01 561 01 0 00 000672* hrroi t1, crlf ;[186] Tie off the line 27026 001401'01 104 00 0 00 000076 PSOUT% ;[186] Type it 27027 001402'01 263 17 0 00 000000 ret ;[186] Proceed no further 27028 001403'01 endif. 27029 001403'01 321 02 0 00 001413' ifxe. t2, nd%exm ;[186] Syntax correct, but do we know about it? 27030 001404'01 200 01 0 00 000000# emsg ;[186] Blat about it 27031 001405'01 104 00 0 00 000313 27032 000100'03 000000000000# 27033 000764'04 125 156 153 156 157 27034 001406'01 561 01 0 00 001376* hrroi t1, atmbuf ;[186] Point to what was typed 27035 001407'01 104 00 0 00 000076 PSOUT% ;[186] Type it 27036 001410'01 561 01 0 00 001400* hrroi t1, crlf ;[186] Tie off the line 27037 001411'01 104 00 0 00 000076 PSOUT% ;[186] Type it 27038 001412'01 263 17 0 00 000000 ret ;[186] Proceed no further 27039 001413'01 endif. 27040 001413'01 603 02 0 00 020000 txne t2, nd%num ;[186] Did T79 give us a number? 27041 001414'01 202 03 0 00 000607* movem t3, nodnum ;[186] Yes, store it 27042 001415'01 120 01 0 00 001406* dmove t1, atmbuf ;[186] Grab the atom buffer 27043 001416'01 124 01 0 00 001242* dmovem t1, nodnam ;[186] Pass to openrt 27044 001417'01 505 01 0 00 000022 hrli t1, .dvdcn ;[186] Outgoing DECnet connection 27045 001420'01 540 01 0 00 000003 hrr t1, t3 ;[186] Use node number, if we have it 27046 001421'01 254 00 0 00 001427' jrst $conn2 ;[186] And open the connection 27047 001422'01 endif. ;[186] End case node:: typed 27048 27049 001422'01 334 01 0 00 000000# ermsg% (,r) ;[186] 27050 001423'01 254 00 0 00 001427' 27051 001424'01 202 01 0 00 001341* 27052 001425'01 104 00 0 00 000313 27053 001426'01 254 00 0 00 001343* 27054 000101'03 000000000000# 27055 000772'04 113 105 122 115 111 27056 27057 27058 ; Set up controlling TTY for talk mode, issue connect message. 27059 27060 001427'01 260 17 0 00 003226' $conn2: call openet ;[186] Go open (or reopen) the connection k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 24-5 K20NET MAC 4-Apr-23 00:43 CONNECT command 27061 001430'01 263 17 0 00 000000 ret ;[186] Couldn't; proceed no further 27062 001431'01 202 01 0 00 001171* movem t1, netjfn ;[186] Store as network JFN 27063 001432'01 336 00 0 00 000000* skipn pars5 ;[205] Don't init terminal if staying 27064 001433'01 260 17 0 00 000000* call ttyini ;[186] Init controlling TTY. 27065 27066 001434'01 200 01 0 00 000000# txmsg <[KERMIT-20: > 27067 001435'01 104 00 0 00 000076 27068 001436'01 320 12 0 00 001437' 27069 000102'03 000000000000# 27070 001005'04 133 113 105 122 115 27071 001437'01 336 00 0 00 000000# ifmn. nrtflg ;[186] Active NRT connection? 27072 001440'01 254 00 0 00 001452' 27073 001441'01 200 01 0 00 000000# txmsg 27074 001442'01 104 00 0 00 000076 27075 001443'01 320 12 0 00 001444' 27076 000103'03 000000000000# 27077 001010'04 103 157 156 156 145 27078 001444'01 561 01 0 00 001416* hrroi t1,nodnam ;[186] and don't claim it is a terminal 27079 001445'01 104 00 0 00 000076 PSOUT% ;[186] instead, type the node name 27080 001446'01 200 01 0 00 000000# txmsg <::> ;[211] DECnet node punctuation 27081 001447'01 104 00 0 00 000076 27082 001450'01 320 12 0 00 001451' 27083 000104'03 000000000000# 27084 001016'04 072 072 000 000 000 27085 001451'01 254 00 0 00 001507' else. ;[186] Otherwise, use the physical line 27086 001452'01 336 00 0 00 000000# ifmn. ptyflg ;[186] Unless using a pseudo-terminal 27087 001453'01 254 00 0 00 001472' 27088 001454'01 200 01 0 00 000000# txmsg ;[186] 27089 001455'01 104 00 0 00 000076 27090 001456'01 320 12 0 00 001457' 27091 000105'03 000000000000# 27092 001017'04 114 157 157 160 142 27093 001457'01 561 01 0 00 000000# hrroi t1,sysnam ;[186] Load local node name 27094 001460'01 104 00 0 00 000076 PSOUT% ;[186] Remind us of where we are 27095 001461'01 200 01 0 00 000000# txmsg <:: via > ;[186] some more details 27096 001462'01 104 00 0 00 000076 27097 001463'01 320 12 0 00 001464' 27098 000106'03 000000000000# 27099 001024'04 072 072 040 166 151 27100 001464'01 561 01 0 00 000000# hrroi t1,ptynam ;[186] Give pseudo-terminal number 27101 001465'01 104 00 0 00 000076 PSOUT% ;[186] Type that 27102 001466'01 200 01 0 00 000000# txmsg < as > ;[186] load final clause 27103 001467'01 104 00 0 00 000076 27104 001470'01 320 12 0 00 001471' 27105 000107'03 000000000000# 27106 001026'04 040 141 163 040 000 27107 001471'01 254 00 0 00 001475' else. ;[186] Otherwise, physical line 27108 001472'01 200 01 0 00 000000# txmsg ;[186] 27109 001473'01 104 00 0 00 000076 27110 001474'01 320 12 0 00 001475' 27111 000110'03 000000000000# 27112 001027'04 103 157 156 156 145 27113 001475'01 endif. ;[186] End case pseudo-terminal 27114 001475'01 200 01 0 00 000000# txmsg ;[186] Type message. 27115 001476'01 104 00 0 00 000076 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 24-6 K20NET MAC 4-Apr-23 00:43 CONNECT command 27116 001477'01 320 12 0 00 001500' 27117 000111'03 000000000000# 27118 001036'04 124 124 131 000 000 27119 001500'01 201 01 0 00 000101 numout ttynum,^d8 ;[186] 27120 001501'01 200 02 0 00 001233* 27121 001502'01 201 03 0 00 000010 27122 001503'01 104 00 0 00 000224 27123 001504'01 320 14 0 00 001505' 27124 001505'01 201 01 0 00 000072 movei t1,":" ;[186] Extra colon to punctuate 27125 001506'01 104 00 0 00 000074 PBOUT% ;[186] DECnet node name 27126 001507'01 endif. ;[186] 27127 001507'01 332 00 0 00 001432* ifme. pars5 ;[205] Staying at remote? 27128 001510'01 254 00 0 00 001532' 27129 001511'01 200 01 0 00 000000# txmsg <, type > ;[205] No, normal blat 27130 001512'01 104 00 0 00 000076 27131 001513'01 320 12 0 00 001514' 27132 000112'03 000000000000# 27133 001037'04 054 040 164 171 160 27134 001514'01 201 01 0 00 000074 movei t1, 74 ; Left pointy bracket... 27135 001515'01 104 00 0 00 000074 PBOUT 27136 001516'01 200 01 0 00 000000# txmsg 27137 001517'01 104 00 0 00 000076 27138 001520'01 320 12 0 00 001521' 27139 000113'03 000000000000# 27140 001041'04 103 124 122 114 055 27141 001521'01 200 01 0 00 000000* move t1, escape ; (tell escape character) 27142 001522'01 271 01 0 00 000100 addi t1, "A"-1 27143 001523'01 104 00 0 00 000074 PBOUT 27144 001524'01 201 01 0 00 000076 movei t1, 76 ; ...Right pointy bracket 27145 001525'01 104 00 0 00 000074 PBOUT 27146 001526'01 200 01 0 00 000000# txmsg < to return.] > ; Tell about session log, if any. 27147 001527'01 104 00 0 00 000076 27148 001530'01 320 12 0 00 001531' 27149 000114'03 000000000000# 27150 001043'04 040 164 157 040 162 27151 001531'01 254 00 0 00 001534' else. ;[205] No, staying, so different blat 27152 001532'01 201 01 0 00 000135 movei t1, "]" ;[205] Not much blat 27153 001533'01 104 00 0 00 000074 PBOUT% ;[205] But say what there is of it... 27154 001534'01 endif. ;[205] 27155 27156 001534'01 337 02 0 00 000000* skipg t2, sesjfn ;[195] Logging? 27157 001535'01 254 00 0 00 001574' ifskp. ;[186] No, just tie off the line 27158 txmsg < 27159 001536'01 200 01 0 00 000000# [KERMIT-20: Logging session to > ; Yes, tell them now. 27160 001537'01 104 00 0 00 000076 27161 001540'01 320 12 0 00 001541' 27162 000115'03 000000000000# 27163 001046'04 015 012 133 113 105 27164 001541'01 201 01 0 00 000101 movei t1, .priou ; Type the filename. 27165 001542'01 302 02 0 00 377777 caie t2, .nulio ;[195] Just dumping it? 27166 001543'01 254 00 0 00 001554' ifskp. ;[195] Yep that's easy 27167 001544'01 120 02 0 00 000000* dmove t2, nul4## ;[195] In k20dsp 27168 001545'01 104 00 0 00 000053 SOUT% ;[195] 27169 001546'01 320 12 0 00 001550' %jserr (,) ;[195] 27170 001547'01 254 00 0 00 001553' k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 24-7 K20NET MAC 4-Apr-23 00:43 CONNECT command 27171 001550'01 265 01 0 00 001026* 27172 001551'01 000000 000000 27173 001552'01 254 00 0 00 001553' 27174 001553'01 254 00 0 00 001563' else. ;[195] Otherwise, a real file 27175 001554'01 403 03 0 00 000004 setzb t3, t4 ;[195] 27176 001555'01 104 00 0 00 000030 JFNS% 27177 001556'01 320 12 0 00 001560' %jserr (,) 27178 001557'01 254 00 0 00 001563' 27179 001560'01 265 01 0 00 001550* 27180 001561'01 000000 000000 27181 001562'01 254 00 0 00 001563' 27182 001563'01 endif. ;[195] 27183 27184 001563'01 332 00 0 00 000000* ifme. sesflg ;[195] Active? 27185 001564'01 254 00 0 00 001570' 27186 001565'01 200 01 0 00 000000# txmsg < (Disabled)> ;[195] Nyet 27187 001566'01 104 00 0 00 000076 27188 001567'01 320 12 0 00 001570' 27189 000116'03 000000000000# 27190 001055'04 040 050 104 151 163 27191 001570'01 endif. ;[195] 27192 txmsg <] 27193 001570'01 200 01 0 00 000000# > ;[195] 27194 001571'01 104 00 0 00 000076 27195 001572'01 320 12 0 00 001573' 27196 000117'03 000000000000# 27197 001060'04 135 015 012 000 000 27198 001573'01 254 00 0 00 001576' else. ;[195] Otherwise just 27199 001574'01 561 01 0 00 001410* hrroi t1,crlf ;[195] tie off the line 27200 001575'01 104 00 0 00 000076 PSOUT% 27201 001576'01 endif. ;[195] 27202 27203 001576'01 332 00 0 00 001507* skipe pars5 ;[205] Going there for real? 27204 001577'01 263 17 0 00 000000 ret ;[205] Nope, we're done 27205 001600'01 254 00 0 00 000000* callret ttsfrk ;[186] Go jump to the fork 27206 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 25 K20NET MAC 4-Apr-23 00:43 BOUTR% - BOUT% a Record 27207 subttl BOUTR% - BOUT% a Record 27208 27209 ; Necessary when doing DECnet to get a character pushed 27210 ; 27211 ; t1/ Network JFN 27212 ; t2/ Character to send 27213 ; 27214 ; Inefficient, you say? Clearly you haven't seen the code in the 27215 ; monitor that does a 'push'... 27216 ; 27217 ; Note use of anonymous stkvar to enable full re-entrancy while 27218 ; limiting symbol table usage. 27219 ; 27220 ; To do: Is a ROT and movem faster? Probably 27221 27222 001601'01 BOUTR%: entry BOUTR% ; Used in mainline 27223 001601'01 332 00 0 00 000231* ifme. vtermf ; Not a Virtual Terminal? 27224 001602'01 254 00 0 00 001612' 27225 001603'01 104 00 0 00 000051 BOUT% ; Just send the character out 27226 001604'01 320 12 0 00 001606' %jserr (,r) 27227 001605'01 254 00 0 00 001611' 27228 001606'01 265 01 0 00 001560* 27229 001607'01 000000000000# 27230 001610'01 254 00 0 00 001426* 27231 001061'04 102 117 125 124 122 27232 001611'01 254 00 0 00 001164* retskp ; Otherwise, worked!! 27233 001612'01 endif. ; End case regular line 27234 ; Otherwise, need to push it out the door 27235 remark t1,t2 ; t1 has JFN, t2 has character 27236 001612'01 265 16 0 00 005260' saveac ; Save a few things 27237 001613'01 265 16 0 00 001350* anstkv (t4,^d1) ; Allocate a one word anonymous stack variable 27238 001614'01 000000 000001 27239 001615'01 415 04 0 17 777776 27240 ; Now have something for SOUTR% to use 27241 001616'01 402 00 0 04 000000 setzm (t4) ; Clear memory (unnecessary for counted SOUTR%) 27242 001617'01 505 04 0 00 441000 hrli t4,(point 8,) ; Convert to an eight bit pointer 27243 001620'01 200 03 0 00 000004 move t3, t4 ; Make a copy of it 27244 001621'01 136 02 0 00 000003 idpb t2, t3 ; Pop the character at BEGINNING of word 27245 001622'01 200 02 0 00 000004 move t2, t4 ; Load pristine pointer for I/O 27246 001623'01 477 03 0 00 000004 setob t3, t4 ; Doing one character, no stop character 27247 001624'01 104 00 0 00 000532 SOUTR% ; Output, setting PSH 27248 001625'01 320 12 0 00 001627' ifje. r ; Catch error 27249 001626'01 254 00 0 00 001637' 27250 001627'01 200 04 0 00 000001 move t4, t1 ; Put this someplace for debuggers 27251 001630'01 334 00 0 00 000000 %ermsg (,) ; Whine 27252 001631'01 254 00 0 00 001635' 27253 001632'01 265 01 0 00 001606* 27254 001633'01 000000000000# 27255 001634'01 254 00 0 00 001635' 27256 001065'04 102 117 125 124 122 27257 001635'01 260 17 0 00 003073' call netvtx ; Whine some more 27258 001636'01 263 17 0 00 000000 ret ; Return failure 27259 001637'01 endif. ; End case JSYS error 27260 001637'01 254 00 0 00 001611* retskp ; Return success 27261 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 26 K20NET MAC 4-Apr-23 00:43 Alternate network input code (assumes upper fork context) 27262 subttl Alternate network input code (assumes upper fork context) 27263 27264 ; Special cased for NRT's in order to 'push' data on DECnet. Tested 27265 ; on PTY's, also. 27266 ; 27267 ; Characters are sent out with a 'push' by doing a record out, which 27268 ; gets them over to the remote NRT host immediately. Checks to see 27269 ; if we can bum BIN%'s with a SIN%. PTY code uses this, too. 27270 ; 27271 ; SIBE% is fine because we are looking at the local TTY 27272 ; 27273 ; N.B., We ALWAYS read 7-bit ASCII from our control terminal and may or 27274 ; may not put parity on it in for output 27275 27276 001640'01 vtmpsh: entry vtmpsh ; Jumped to by ttinch: 27277 remark q1, ; Have to validate that q1 is not in flight here 27278 27279 001640'01 do. ; Enter loop context. 27280 001640'01 200 01 0 00 000000* move t1, ttyjfn ; Wait for data on TTY 27281 001641'01 104 00 0 00 000050 BIN% ; Wakes up on anything 27282 001642'01 320 12 0 00 001644' %jserr (,tter1) ; What could happen? 27283 001643'01 254 00 0 00 001647' 27284 001644'01 265 01 0 00 001632* 27285 001645'01 000000000000# 27286 001646'01 254 00 0 00 000000* 27287 001072'04 103 141 156 047 164 27288 001647'01 350 00 0 00 000000# aos vbict ; Count a BIN% on a virtual terminal 27289 001650'01 201 04 0 00 000177 movei t4,177 ; 7 bit mask 27290 001651'01 407 02 0 00 000004 andb t2,t4 ; Stomp any foolish parity everywhere 27291 001652'01 316 02 0 00 001521* camn t2, escape ; Is it the escape character? 27292 001653'01 254 00 0 00 000000* jrst doesc ; Yes, go process single-char command. 27293 001654'01 104 00 0 00 000102 SIBE% ; Any more data to read maybe? 27294 001655'01 254 00 0 00 001703' ifskp. ; Nope, then just had this poor character 27295 001656'01 322 02 0 00 001664' ifn. t2 ; If zero, then no error and nothing to do 27296 001657'01 334 00 0 00 000000 %ermsg (,) ; But continue 27297 001660'01 254 00 0 00 001664' 27298 001661'01 265 01 0 00 001644* 27299 001662'01 000000000000# 27300 001663'01 254 00 0 00 001664' 27301 001077'04 125 156 141 142 154 27302 001664'01 endif. ; End case t2 having JSYS error code 27303 remark ; Yet contribute nothing to total 27304 001664'01 200 02 0 00 000004 move t2,t4 ; Load the character for duplex 27305 001665'01 332 00 0 00 000000* skipe duplex ; Have to echo locally? 27306 001666'01 260 17 0 00 000000* call echo ; Yes, do. 27307 001667'01 200 01 0 00 000004 move t1, t4 ;[223] Load in case parity 27308 001670'01 260 17 1 00 000000* call @parity ;[223] Do parity if asked 27309 001671'01 200 02 0 00 000001 move t2, t1 ;[223] Put whatever parity did in the right place 27310 001672'01 200 01 0 00 001431* move t1, netjfn ; Load JFN of our DCN: connection 27311 001673'01 260 17 0 00 001601' call BOUTR% ; Write and push to network 27312 001674'01 334 00 0 00 000000 %ermsg (,tter1) ; If error, go check. 27313 001675'01 254 00 0 00 001701' 27314 001676'01 265 01 0 00 001661* 27315 001677'01 000000000000# 27316 001700'01 254 00 0 00 001646* k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 26-1 K20NET MAC 4-Apr-23 00:43 Alternate network input code (assumes upper fork context) 27317 001110'04 103 141 156 047 164 27318 001701'01 350 00 0 00 000000# aos vboct ; Count it as a BOUT% 27319 001702'01 254 00 0 00 001727' else. ; Otherwise, maybe save us a few BIN%'s 27320 001703'01 301 02 0 00 002000 cail t2,linlen ; Rolling buffer plus BIN%? 27321 001704'01 201 02 0 00 001777 movei t2, ;Clip it down to fit the character we got 27322 001705'01 200 03 0 00 000002 move t3,t2 ; Load amount to read (positive!!) 27323 001706'01 200 05 0 00 000002 move t5,t2 ; Save a handy copy 27324 001707'01 272 05 0 00 000000# addm t5,vsitc ; Number of characters slurping up 27325 001710'01 313 05 0 00 000000# camle t5,vsimx ; Larger than largest we ever saw? 27326 001711'01 202 05 0 00 000000# movem t5,vsimx ; Yes, remember that 27327 001712'01 350 00 0 00 000000# aos vsict ; Count a SIN% 27328 001713'01 200 02 0 00 005270' move t2,[point 7,nrtbuf] ;Seven bit traffic 27329 001714'01 136 04 0 00 000002 idpb t4,t2 ; Deposit the BIN%'ed character 27330 001715'01 200 04 0 00 001652* move t4,escape ; Stop reading on escape character 27331 001716'01 104 00 0 00 000052 SIN% ; Slurp in a bunch of characters from user 27332 001717'01 320 12 0 00 001721' %jserr (,tter1) ; Handle any errors. 27333 001720'01 254 00 0 00 001724' 27334 001721'01 265 01 0 00 001676* 27335 001722'01 000000000000# 27336 001723'01 254 00 0 00 001700* 27337 001114'04 103 141 156 047 164 27338 001724'01 260 17 0 00 001731' call vtmout ; Output it 27339 001725'01 254 00 0 00 001723* jrst tter1 ; Failed somehow 27340 001726'01 326 05 0 00 001653* jumpn t5,doesc ; Use talisman to handle escape 27341 001727'01 endif. ; Done handling results from SIBE% 27342 001727'01 254 00 0 00 001640' loop. ; Go back and do it some more 27343 001730'01 enddo. ; Exit loop context 27344 ; Should never get here, but... 27345 001730'01 254 00 0 00 000000* jrst ttinch ; Go back and do it again from the top 27346 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 27 K20NET MAC 4-Apr-23 00:43 Network fork data writer 27347 subttl Network fork data writer 27348 27349 ; Write whatever data we have to the network, type it, log it, Etc. 27350 ; 27351 ; On entry: 27352 ; 27353 ; t1/ ttyjfn 27354 ; t2/ Updated byte pointer (buffer will have at least the BIN%'ed character) 27355 ; t3/ Remaining characters in buffer 27356 ; t4/ Escape character that may have stopped us 27357 ; t5/ Original buffer length 27358 ; 27359 ; AC usage: 27360 ; 27361 ; t5/ 0, Complete buffer written 27362 ; -1, Wasn't (hit an escape) 27363 ; 27364 ; q2/ Copy of orginal t3 (remaining characters) 27365 ; q3/ Number of characters we're actually writing 27366 ; q4/ Parity (if doing parity) 27367 27368 001731'01 265 16 0 00 005271' vtmout: saveac ; Save misc. things 27369 001732'01 200 10 0 00 001670* move q4, parity ;[223] Load parity 27370 001733'01 336 00 0 00 000000* skipn parpko ;[223] Not if packets-only 27371 001734'01 306 10 0 00 000000* cain q4, none ;[223] But!! Doing anything at all, really? 27372 001735'01 400 10 0 00 000000 setz q4, ;[223] No, so make it easier to do nothing 27373 27374 001736'01 350 07 0 00 000005 aos q3,t5 ; Store original count + BIN% 27375 001737'01 400 05 0 00 000000 setz t5, ; Let's assume didn't hit the escape 27376 001740'01 332 06 0 00 000003 skipe q2,t3 ; Save and check remaining count 27377 001741'01 474 05 0 00 000000 seto t5, ; Hit an escape... 27378 001742'01 277 03 0 00 000007 subb t3,q3 ; Calculate complete buffer size 27379 001743'01 322 07 0 00 001610* jumpe q3,r ; Don't do a push of an empty buffer 27380 27381 001744'01 210 01 0 00 000007 movn t1,q3 ; Pick up POSITIVE count of characters 27382 001745'01 272 01 0 00 000000# addm t1,vsotc ; Add in total 27383 001746'01 313 01 0 00 000000# camle t1,vsomx ; Greater than max? 27384 001747'01 202 01 0 00 000000# movem t1,vsomx ; Update maximum 27385 001750'01 350 00 0 00 000000# aos vsoct ; Count a SOUTR% 27386 27387 001751'01 200 02 0 00 005303' move t2,[point 7,nrtbuf] ;Seven bit traffic 27388 001752'01 322 10 0 00 001755' ifn. q4 ;[223] Parity? 27389 001753'01 200 01 0 00 005304' move t1,[point 8,parbuf] ;[223] Eight bit traffic 27390 001754'01 260 17 0 00 000000* call genpar ;[223] Generate a new string with parity 27391 001755'01 endif. ;[223] End case generating parity 27392 27393 001755'01 200 01 0 00 001672* move t1, netjfn ; Load JFN of our DCN: connection 27394 001756'01 104 00 0 00 000532 SOUTR% ; Write and 'push' 27395 001757'01 320 12 0 00 001761' %jserr (,r) ; If error, return +1 27396 001760'01 254 00 0 00 001764' 27397 001761'01 265 01 0 00 001721* 27398 001762'01 000000000000# 27399 001763'01 254 00 0 00 001743* 27400 001121'04 103 141 156 047 164 27401 001764'01 336 00 0 00 001665* skipn duplex ; Half duplex? k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 27-1 K20NET MAC 4-Apr-23 00:43 Network fork data writer 27402 001765'01 263 17 0 00 000000 ret ; No, nothing to echo 27403 ; Ugh... Let's get to it 27404 001766'01 265 16 0 00 005305' saveac ; Wants another register 27405 001767'01 200 06 0 00 005313' move q2,[point 7,nrtbuf] ;Load a pointer to the buffer 27406 001770'01 210 10 0 00 000007 movn q4,q3 ; Do a positive counter (unnecessary) 27407 27408 001771'01 do. ; Enter loop lexical context 27409 001771'01 134 02 0 00 000006 ildb t2,q2 ; Pick up a character from the buffer 27410 001772'01 260 17 0 00 001666* call echo ; Type it 27411 001773'01 367 10 0 00 001771' sojg q4,top. ; Do all of them 27412 001774'01 enddo. ; Exit loop lexical context 27413 27414 001774'01 263 17 0 00 000000 ret ; Done, finally 27415 27416 ; To do, this is an awful lot of instructions just to echo. 27417 ; Could temporarily restore the COC's and PSOUT%. Also could 27418 ; do a MOVST from from an eight byte buffer and overwrite it 27419 ; with a seven bit buffer with the control characters? 27420 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 28 K20NET MAC 4-Apr-23 00:43 Code for receive fork. 27421 subttl Code for receive fork. 27422 27423 ; Rewritten for efficiency to use less JSYI and avoid stack clash 27424 ; 27425 ; Runs forever, asynchronously, till killed. 27426 ; 27427 ; The algorithm is to wait for a character and then slurp up anything 27428 ; that might be in the monitor's input buffer for the line (or NRT). 27429 ; This can substantially cut down on BIN%/BOUT% overhead while still 27430 ; maintaining performance because the fork is effectively always waiting 27431 ; for remote output. 27432 ; 27433 ; Partially adapted from a much modified SETNOD. 27434 ; 27435 ; Be aware of a subtle Tops-20 bug! Once created, the terminal fork 27436 ; should NEVER be killed, but rather frozen. Previous Kermit behavior 27437 ; was to always kill the fork on a close, keeping the network JFN open, 27438 ; recreating the fork on every connect. While this was inefficient 27439 ; (fork creation being expensive), it was fine for a pseudo-terminal. 27440 ; 27441 ; However, killing the fork while it was waiting for NRT data caused 27442 ; Tops-20 DECnet to lose track of the buffers, the result being that 27443 ; whatever was last in the buffer was read again when the fork was 27444 ; recreated. 27445 ; 27446 ; Trying to force the monitor buffers to be correct with SINR% only 27447 ; partially worked. Output was not repeated, but a timing anomaly was 27448 ; then exposed that the result of a SIBE% was less than what was 27449 ; available, the consequence being that the SINR% would fail with 27450 ; a IOX10 error (Record is longer than user requested), the extra 27451 ; data then being dumped (into oblivion). 27452 ; 27453 ; Freezing and resuming the terminal fork prevents this situation and 27454 ; is more efficient, anyway. Therefore, make certain that the FFORK% 27455 ; at $CONX2+5 is NEVER changed back to a KFORK%! 27456 ; 27457 ; However, this does not fix the problem of output getting repeated 27458 ; into the main fork once the subfork is frozen. In particular, 27459 ; suppose the user does something very reasonable and connects to a 27460 ; remote system to sign on. Escaping back will now work fine, but if 27461 ; before this happens, the user runs a Kermit and puts it into server 27462 ; mode, the main fork will now see all the junk that the recreated 27463 ; inferior used to see plus a large pile of NUL's thrown in to boot!! 27464 ; 27465 ; Therefore, whenever we escape back, a clrbuf is done for an NRT. 27466 27467 002000 linlen==^d1024 ; Maximum characters we'll swallow at once 27468 27469 001775'01 netin: entry netin ; Jumped to by main character read loop 27470 remark q1,q2,q3,q4,p1,p2,p3 ;No need to save these in seperate fork 27471 001775'01 200 17 0 00 005314' move p,[iowd pdlsiz,frkpdl] ; Can't share stacks... 27472 001776'01 201 01 0 00 003174' movei t1, netinh ; Load Address of a halt routine 27473 001777'01 261 17 0 00 000001 push p, t1 ; Just in case we want to return over the top 27474 27475 002000'01 201 05 0 00 000000# movei q1, frkbuf ;[223] Always using the same buffer k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 28-1 K20NET MAC 4-Apr-23 00:43 Code for receive fork. 27476 002001'01 200 01 0 00 001732* move t1, parity ;[223] Load parity setting 27477 002002'01 306 01 0 00 001734* cain t1, none ;[223] Are we doing anything? 27478 002003'01 254 00 0 00 002013' ifskp. ;[223] Some kind of parity being done, so check further 27479 002004'01 332 00 0 00 001733* skipe parpko ;[223] Only doing parity on packets? 27480 002005'01 254 00 0 00 002013' anskp. ;[223] Yes, so better leave this alone 27481 002006'01 336 00 0 00 000000* skipn parrck ;[223] Checking parity on receive and not just sending? 27482 002007'01 254 00 0 00 002013' anskp. ;[223] No, so don't pay any attention 27483 002010'01 200 13 0 00 000001 move p3, t1 ;[223] Set the flag with the parity value 27484 002011'01 505 05 0 00 441000 hrli q1,<(point 8,0)> ;[223] Do it all 7 bit ASCII with a parity bit 27485 002012'01 254 00 0 00 002015' else. ;[223] Otherwise, not doing anything special 27486 002013'01 400 13 0 00 000000 setz p3, ;[223] So clear the flag 27487 002014'01 505 05 0 00 440700 hrli q1,<(point 7,0)> ;[223] And do it all straight 7 bit ASCII 27488 002015'01 endif. ;[223] End case parity determination 27489 27490 002015'01 do. ; Enter loop context 27491 002015'01 474 06 0 00 000000 seto q2, ; Assume we get at least one chracter 27492 002016'01 550 01 0 00 001755* hrrz t1, netjfn ; Always prefer a network JFN 27493 002017'01 326 01 0 00 002021' ife. t1 ; Unless there isn't one 27494 002020'01 550 01 0 00 001640* hrrz t1, ttyjfn ; Use terminal if nothing else 27495 002021'01 endif. ; End case no network JFN 27496 002021'01 104 00 0 00 000050 BIN% ; Wait for input 27497 002022'01 320 12 0 00 002024' %jserr (,neterr) ; Handle any errors. 27498 002023'01 254 00 0 00 002027' 27499 002024'01 265 01 0 00 001761* 27500 002025'01 000000000000# 27501 002026'01 254 00 0 00 002200' 27502 001125'04 103 141 156 047 164 27503 002027'01 350 00 0 00 000000# aos nbict ; Network BIN% count 27504 002030'01 200 07 0 00 000002 move q3, t2 ; Tuck that character safely away for now 27505 002031'01 200 04 0 00 000001 move t4, t1 ; Get the PTY JFN out of the way 27506 002032'01 260 17 0 00 002454' call clrest ; Find out what awaits us 27507 002033'01 254 00 0 00 002036' ifskp. ; Worked!! 27508 002034'01 200 11 0 00 000001 move p1, t1 ; Save the count (which might be zero) 27509 002035'01 254 00 0 00 002043' else. ; Failed?? 27510 002036'01 334 00 0 00 000000 %ermsg (,neterr) 27511 002037'01 254 00 0 00 002043' 27512 002040'01 265 01 0 00 002024* 27513 002041'01 000000000000# 27514 002042'01 254 00 0 00 002200' 27515 001132'04 125 156 141 142 154 27516 002043'01 endif. 27517 002043'01 326 11 0 00 002055' ife. p1 ; Nothing but one dinky character? 27518 002044'01 322 13 0 00 002051' ifn. p3 ;[223] Are we doing parity? 27519 002045'01 200 01 0 00 000007 move t1, q3 ;[223] Yes, so load the character 27520 002046'01 260 17 0 13 000000 call (p3) ;[223] Do some kind of parity 27521 002047'01 312 01 0 00 000007 came t1, q3 ;[223] Does it check? 27522 002050'01 260 17 0 00 002171' call parier ;[223] No, go complain 27523 002051'01 endif. ;[223] End case parity checking 27524 002051'01 200 02 0 00 000005 move t2, q1 ; Load the pointer 27525 002052'01 136 07 0 00 000002 idpb q3, t2 ; Drop the character in 27526 002053'01 260 17 0 00 002110' call ntecho ; Finally echo it 27527 002054'01 254 00 0 00 002107' else. ; Otherwise, save us many BIN%'s!! 27528 002055'01 do. ; Enter read/write loop 27529 002055'01 200 02 0 00 000011 move t2, p1 ; Load the total from clrest 27530 002056'01 301 02 0 00 002000 cail t2, linlen ; Rolling buffer plus BIN%? k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 28-2 K20NET MAC 4-Apr-23 00:43 Code for receive fork. 27531 002057'01 201 02 0 00 001777 movei t2, ;Clip it down to fit the character we got 27532 002060'01 313 02 0 00 000000# camle t2, nsimx ; Smaller than biggest? 27533 002061'01 202 02 0 00 000000# movem t2, nsimx ; Nope, update total 27534 002062'01 272 02 0 00 000000# addm t2, nsitc ; Network SIN% total characters 27535 002063'01 210 03 0 00 000002 movn t3, t2 ; Calculate amount to read 27536 002064'01 274 11 0 00 000002 sub p1, t2 ; Subtract from total known 27537 002065'01 274 06 0 00 000002 sub q2, t2 ; Account for previous byte in write total 27538 002066'01 200 02 0 00 000005 move t2, q1 ; Load the pointer 27539 002067'01 136 07 0 00 000002 idpb q3, t2 ; Drop the character in 27540 002070'01 325 03 0 00 002101' Ifl. t3 ; BUT!! Are we actualy going to do anything? 27541 002071'01 350 00 0 00 000000# aos nsici ; Network SIN%'s Issued 27542 002072'01 200 01 0 00 000004 move t1, t4 ; Load the network JFN 27543 002073'01 104 00 0 00 000052 SIN% ; Get that data! 27544 002074'01 320 12 0 00 002076' %jserr (,neterr) ;Handle any errors 27545 002075'01 254 00 0 00 002101' 27546 002076'01 265 01 0 00 002040* 27547 002077'01 000000000000# 27548 002100'01 254 00 0 00 002200' 27549 001142'04 103 141 156 047 164 27550 002101'01 endif. ; End sanity check 27551 002101'01 322 13 0 00 002105' ifn. p3 ;[223] Doing any kind of parity? 27552 002102'01 120 02 0 00 000005 dmove t2, q1 ;[223] Load what will be passed to ntecho 27553 002103'01 260 17 0 00 000000* call chkpar ;[223] Check the parity 27554 002104'01 260 17 0 00 002171' call parier ;[223] Bad, go complain 27555 002105'01 endif. ;[223] End case parity checking 27556 002105'01 260 17 0 00 002110' call ntecho ; Go echo the output 27557 002106'01 327 11 0 00 002055' jumpg p1, top. ; Still more data pending, read it 27558 002107'01 enddo. ; End inner input/output loop 27559 002107'01 endif. ; End decision to read more than one character 27560 002107'01 254 00 0 00 002015' loop. ; Otherwise, go to the top and wait for more 27561 002110'01 enddo. ; End outer loop 27562 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 29 K20NET MAC 4-Apr-23 00:43 echo what we read from the network 27563 subttl echo what we read from the network 27564 27565 ; Called from various places in netin lower fork code to display data 27566 ; 27567 ; Expects: 27568 ; 27569 ; ttyjfn/ Valid JFN or terminal designator 27570 ; q1/ Pointer to beginning of data read 27571 ; q2/ Negative count of data (I.E., counted SOUT% ready 27572 ; p3/ Parity scrubber flag 27573 ; 27574 ; +1, always 27575 ; 27576 ; Trashes t1, t2 and t3. 27577 ; 27578 ; If doing parity, we have a buffer with eight bit bytes in it which 27579 ; must have the parity bit stripped off. If this is not done, then 27580 ; Tops-20 is going to write in 'image' mode, which can produce funny 27581 ; output on terminal emulators. 27582 ; 27583 ; The routine simply picks up an eight bit byte and replaces it with a 27584 ; seven bit byte, overwriting the storage in place. Since the 7 bit 27585 ; ASCII stream will always trail the 8 bit stream, we will never run 27586 ; out of space nor clobber anything. 27587 27588 002110'01 322 13 0 00 002144' ntecho: jumpe p3,ntech2 ;[223] Any parity to strip off? 27589 002111'01 322 06 0 00 001763* jumpe q2, r ;[223] If nothing to do, we're done! 27590 002112'01 554 01 0 00 000005 hlrz t1, q1 ;[223] A quick sanity check of the pointer width 27591 002113'01 306 01 0 00 440700 cain t1, <(point 7,0)> ;[223] Is this a waste of time, anyway? 27592 002114'01 254 00 0 00 002144' jrst ntech2 ;[223] It is, so skip all of this 27593 27594 002115'01 315 06 0 00 005315' caxge q2,-^d4 ;[223] Characters at which movslj wins (we think) 27595 002116'01 254 00 0 00 002130' jrst ntech1 ;[223] Go win big with extended instruction! 27596 27597 002117'01 265 16 0 00 005316' ntech0: saveac ;[223] Doesn't need quite so many registers... 27598 002120'01 200 02 0 00 000005 move t2, q1 ;[223] Load 8 bit source 27599 002121'01 505 05 0 00 440700 hrli q1, <(point 7,0)> ;[223] Stomp in the right pointer width 27600 002122'01 200 03 0 00 000005 move t3, q1 ;[223] Load 7 bit destination 27601 002123'01 210 04 0 00 000006 movn t4, q2 ;[223] We get less confused by positive numbers ... 27602 27603 002124'01 do. ;[223] Enter loop context 27604 002124'01 134 01 0 00 000002 ildb t1, t2 ;[223] Pick up an 8 bit byte 27605 002125'01 136 01 0 00 000003 idpb t1, t3 ;[223] And deposit as 7 bit, stripping parity 27606 002126'01 367 04 0 00 002124' sojg t4, top. ;[223] Do the rest of them 27607 002127'01 enddo. ;[223] End loop lexical context 27608 002127'01 254 00 0 00 002144' jrst ntech2 ;[223] And go type something 27609 27610 002130'01 265 16 0 00 005326' ntech1: saveac ;[223] Convert from 8 to 7 bit ASCII 27611 002131'01 120 07 0 00 000005 dmove q3, q1 ;[223] Save original arguments 27612 002132'01 210 01 0 00 000006 movn t1, q2 ;[223] movslj wants positive counts 27613 002133'01 200 04 0 00 000001 move t4, t1 ;[223] Smaller width can never overflow 27614 002134'01 200 02 0 00 000005 move t2, q1 ;[223] Section local eight bit pointer 27615 002135'01 550 05 0 00 000002 hrrz q1, t2 ;[223] Same starting address 27616 002136'01 505 05 0 00 440700 hrli q1, <(point 7,0)> ;[223] Stomp in the right pointer 27617 002137'01 500 07 0 00 000005 hll q3, q1 ;[223] And remember that new width k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 29-1 K20NET MAC 4-Apr-23 00:43 echo what we read from the network 27618 002140'01 403 03 0 00 000006 setzb t3, q2 ;[223] Section local pointers 27619 002141'01 123 01 0 00 000000* extend t1, movchr ;[223] Repack the string in place (which is safe) 27620 002142'01 600 00 0 00 000000 nop ;[223] Ignore any odd non-skip 27621 002143'01 120 05 0 00 000007 dmove q1, q3 ;[223] Restore updated calling arguments 27622 27623 002144'01 200 01 0 00 002020* ntech2: move t1, ttyjfn ;[223] ; Load local terminal 27624 002145'01 120 02 0 00 000005 dmove t2,q1 ; Load pointer and length 27625 002146'01 104 00 0 00 000053 SOUT% ; Display incoming characters on screen. 27626 002147'01 320 12 0 00 002151' %jserr (,) 27627 002150'01 254 00 0 00 002154' 27628 002151'01 265 01 0 00 002076* 27629 002152'01 000000000000# 27630 002153'01 254 00 0 00 002154' 27631 001147'04 103 141 156 047 164 27632 002154'01 337 01 0 00 001534* skipg t1, sesjfn ; Logging? 27633 002155'01 254 00 0 00 002167' ifskp. ;[195] Possibly doing it 27634 002156'01 336 00 0 00 001563* skipn sesflg ;[195] Unless not active 27635 002157'01 254 00 0 00 002167' anskp. ;[195] In which case, skip it 27636 002160'01 120 02 0 00 000005 dmove t2,q1 ; Load buffer pointer and length 27637 002161'01 104 00 0 00 000053 SOUT% ; Write it to the log 27638 002162'01 320 12 0 00 002164' %jserr (,netlgx) ;[195] 27639 002163'01 254 00 0 00 002167' 27640 002164'01 265 01 0 00 002151* 27641 002165'01 000000000000# 27642 002166'01 254 00 0 00 000000* 27643 001156'04 103 141 156 047 164 27644 002167'01 endif. ;[195] End case logging 27645 002167'01 263 17 0 00 000000 ret ; Done 27646 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 30 K20NET MAC 4-Apr-23 00:43 Parity Error Handler 27647 subttl Parity Error Handler 27648 27649 002170'01 007 000 00000000 honk: byte (7) .chbel, .chnul ;[223] Just honk the terminal 27650 27651 002171'01 261 17 0 00 000001 parier: push p, t1 ;[223] Save the accumulator 27652 002172'01 561 01 0 00 002170' hrroi t1, honk ;[223] Point to the alert 27653 002173'01 104 00 0 00 000313 ESOUT% ;[223] Beep the terminal 27654 002174'01 320 12 0 00 002175' erjmpr .+1 ;[223] Catch and ignore error 27655 002175'01 350 00 0 00 000000* aos ttipar ;[223] Count a parity error 27656 002176'01 262 17 0 00 000001 pop p, t1 ;[223] Restore the accumulator 27657 002177'01 263 17 0 00 000000 ret ;[223] Done 27658 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 31 K20NET MAC 4-Apr-23 00:43 Error handler for network TTY. 27659 subttl Error handler for network TTY. 27660 27661 002200'01 336 00 0 00 001601* neterr: ifmn. vtermf ;[186] Virtual terminal? 27662 002201'01 254 00 0 00 002206' 27663 002202'01 200 01 0 00 002016* move t1, netjfn ;[186] Load network JFN 27664 002203'01 260 17 0 00 003622' call chklin ;[186] Get network status 27665 002204'01 336 00 0 00 000000* skipn carier ;[186] dropped carrier? 27666 002205'01 260 17 0 00 003073' call netvtx ;[186] Yep, we're down 27667 002206'01 endif. ;[186] End special case for non-physical line 27668 27669 002206'01 336 00 0 00 000000* skipn mdmlin ; Modem controlled line? 27670 002207'01 254 00 0 00 001775' jrst netin ; No, go back. 27671 002210'01 260 17 0 00 003622' call chklin ; Go check for carrier. 27672 002211'01 336 00 0 00 002204* skipn carier ; Still have it? 27673 002212'01 254 00 0 00 000000* jrst $connx ;[186] No, close the connection. 27674 002213'01 254 00 0 00 001775' jrst netin ; Yes, keep plugging away till they disconnect. 27675 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 32 K20NET MAC 4-Apr-23 00:43 Handles signal of failure of network input fork 27676 subttl Handles signal of failure of network input fork 27677 27678 002214'01 frtrap: entry frtrap 27679 extern pc3 ; Level we interrupt on 27680 27681 002214'01 261 17 0 00 000001 push p, t1 ; Save any AC we touch 27682 002215'01 261 17 0 00 000002 push p, t2 27683 002216'01 261 17 0 00 000003 push p, t3 27684 27685 002217'01 336 01 0 00 001335* skipn t1,ttfork ; Load the handle of network input fork 27686 002220'01 254 00 0 00 002224' ifskp. ; If there is one.... 27687 002221'01 104 00 0 00 000153 KFORK% ; Ditch it 27688 002222'01 320 12 0 00 002223' erjmpr .+1 ; Ignore the error 27689 002223'01 402 00 0 00 002217* setzm ttfork ; Forget about the handle; it's gone 27690 002224'01 endif. ; End case fork handler 27691 27692 002224'01 260 17 0 00 002676' call clsnet ; Whack any kind of network connection 27693 27694 002225'01 205 01 0 00 010000 movx t1,pc%usr ; Get into user mode. 27695 002226'01 436 01 0 00 000541* iorm t1,pc3 ; Resume at previous PC 27696 27697 002227'01 262 17 0 00 000003 pop p, t3 ; Restore AC's and beat it 27698 002230'01 262 17 0 00 000002 pop p, t2 27699 002231'01 262 17 0 00 000001 pop p, t1 27700 002232'01 104 00 0 00 000136 DEBRK% 27701 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 33 K20NET MAC 4-Apr-23 00:43 Sends a DECnet interrupt message when BREAK is requested 27702 subttl Sends a DECnet interrupt message when BREAK is requested 27703 27704 002233'01 110 145 171 041 040 nrtmsg: bldmsg () 27705 27706 002236'01 nrtbrk: entry nrtbrk ; Experimental; not really used 27707 002236'01 263 17 0 00 000000 ret ; This hangs a Tops-10 connection, don't do it 27708 27709 002237'01 265 16 0 00 005173' saveac ; Save just because we don't know 27710 002240'01 200 01 0 00 002202* move t1,netjfn ; Load network JFN 27711 002241'01 201 02 0 00 000036 movei t2,.mosim ; Function to send DECnet interrupt message 27712 dmove t3,[point 7,nrtmsg ;Point to interrupt message 27713 002242'01 120 03 0 00 005342' nrtlen ] ; Length of same 27714 002243'01 104 00 0 00 000077 MTOPR% ; Bombs away! 27715 002244'01 320 12 0 00 002246' %jserr(,r) 27716 002245'01 254 00 0 00 002251' 27717 002246'01 265 01 0 00 002164* 27718 002247'01 000000000000# 27719 002250'01 254 00 0 00 002111* 27720 001163'04 125 156 141 142 154 27721 002251'01 263 17 0 00 000000 ret 27722 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 34 K20NET MAC 4-Apr-23 00:43 clrbuf Clear Line Input Buffer 27723 subttl clrbuf Clear Line Input Buffer 27724 27725 ;[211] All rewritten and enhanced for non-physical terminals 27726 27727 ; Call: 27728 ; 27729 ; Nothing: appropriate thing is done based on connection context. 27730 ; 27731 ; Returns: 27732 ; 27733 ; +1/ Some problem 27734 ; +2/ Success 27735 ; t1/ Total characters chewed 27736 ; 27737 ; N.B., While SIBE% and SOBE% will work on any JFN, CFIBF% and 27738 ; CFOBF%'s will *ONLY* work with terminal lines. For PTY's 27739 ; and NRT's, we have to read the input (and toss it). 27740 27741 000310 flushc==^d200 ; Maximum characters to swallow 27742 27743 002252'01 clrbuf: entry clrbuf ; Inform link of our location 27744 002252'01 260 17 0 00 000000* call inpclr ;[209] Chuck any waiting input 27745 27746 002253'01 332 00 0 00 000000# skipe ptyflg ; Pseudo-terminal? 27747 002254'01 254 00 0 00 002356' callret ptyfls ; Yes, that has to be flushed from both sides 27748 002255'01 332 00 0 00 000000# skipe nrtflg ; DECnet NRT? 27749 002256'01 254 00 0 00 002306' callret dcnfls ; Yes, CFIBF% won't work 27750 ; Otherwise, a physical line on an FE!!!! 27751 002257'01 550 01 0 00 002240* hrrz t1, netjfn ; Although a real line, prefer network JFN 27752 002260'01 326 01 0 00 002262' ife. t1 ; Unless there isn't one 27753 002261'01 550 01 0 00 002144* hrrz t1, ttyjfn ; Use terminal if nothing else 27754 002262'01 endif. ; End case no network JFN 27755 002262'01 403 02 0 00 000003 setzb t2, t3 ; No current read, no accumulated read 27756 27757 002263'01 do. ; Enter loop context 27758 002263'01 104 00 0 00 000102 SIBE% ; Skip if input buffer empty 27759 002264'01 254 00 0 00 002274' ifskp. ; Empty? 27760 002265'01 322 02 0 00 002304' jumpe t2, endlp. ; If zero, then no error; exit loop 27761 002266'01 334 00 0 00 000000 %ermsg (,r) ;[211] 27762 002267'01 254 00 0 00 002273' 27763 002270'01 265 01 0 00 002246* 27764 002271'01 000000000000# 27765 002272'01 254 00 0 00 002250* 27766 001172'04 125 156 141 142 154 27767 002273'01 254 00 0 00 002304' else. ; Otherwise, have some junk in there 27768 002274'01 270 03 0 00 000002 add t3, t2 ; Add to total cleared 27769 002275'01 104 00 0 00 000100 CFIBF% ; Chuck the input 27770 002276'01 320 12 0 00 002300' %jserr (,r) ; Boo... 27771 002277'01 254 00 0 00 002303' 27772 002300'01 265 01 0 00 002270* 27773 002301'01 000000000000# 27774 002302'01 254 00 0 00 002272* 27775 001201'04 125 156 141 142 154 27776 002303'01 254 00 0 00 002263' loop. ; See if anything else shows up 27777 002304'01 endif. ; End of SIBE% action logic k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 34-1 K20NET MAC 4-Apr-23 00:43 clrbuf Clear Line Input Buffer 27778 002304'01 enddo. ; End flush loop 27779 27780 002304'01 200 01 0 00 000003 move t1, t3 ; Load grand total flushed 27781 002305'01 254 00 0 00 001637* retskp ; Return success!!! 27782 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 35 K20NET MAC 4-Apr-23 00:43 DECnet flush 27783 subttl DECnet flush 27784 27785 ; Somewhat similar logic to physical terminal, except that 27786 ; CFIBF% won't work, so we have to read (and toss) the data. 27787 ; 27788 ; N.B., Can't use SINR% because it will discard an unknown number 27789 ; of characters. Sigh... 27790 27791 002306'01 265 16 0 00 005344' dcnfls: saveac 27792 002307'01 550 01 0 00 002257* hrrz t1, netjfn ; Pick up the network JFN 27793 002310'01 326 01 0 00 002316' ife. t1 ; Have to have this for an NRT! 27794 002311'01 334 01 0 00 000000# ermsg% (,r) 27795 002312'01 254 00 0 00 002316' 27796 002313'01 202 01 0 00 001424* 27797 002314'01 104 00 0 00 000313 27798 002315'01 254 00 0 00 002302* 27799 000120'03 000000000000# 27800 001207'04 113 105 122 115 111 27801 27802 002316'01 endif. ; End of that particular sanity check 27803 002316'01 200 05 0 00 000001 move q1, t1 ; Save whatever JFN we're using (q1 unused) 27804 002317'01 400 07 0 00 000000 setz q3, ; No initial grand tally 27805 27806 002320'01 do. ; Enter loop context 27807 002320'01 104 00 0 00 000102 SIBE% ; Skip if input buffer empty 27808 002321'01 254 00 0 00 002331' ifskp. ; Empty? 27809 002322'01 322 02 0 00 002353' jumpe t2, endlp. ; If zero, then no error; exit loop 27810 002323'01 334 00 0 00 000000 %ermsg (,r) 27811 002324'01 254 00 0 00 002330' 27812 002325'01 265 01 0 00 002300* 27813 002326'01 000000000000# 27814 002327'01 254 00 0 00 002315* 27815 001223'04 125 156 141 142 154 27816 002330'01 254 00 0 00 002352' else. ; Otherwise, have some junk in there 27817 002331'01 200 06 0 00 000002 move q2, t2 ; Load for inner loop 27818 002332'01 do. ; Enter inner loop context 27819 002332'01 336 04 0 00 000006 skipn t4, q2 ; Load remaining characters 27820 002333'01 254 00 0 00 002352' exit. ; If no more, then we're done 27821 002334'01 303 04 0 00 000310 caile t4, flushc ; More than maximum we can swallow at once? 27822 002335'01 201 04 0 00 000310 movx t4, flushc ; Yep, well just take a mouthful 27823 remark t1, q1 ; JFN is still in there 27824 002336'01 200 02 0 00 005360' move t2, [point 8,flushb] ; Load pointer to the 'flush' buffer 27825 002337'01 210 03 0 00 000004 movn t3, t4 ; Reading exactly that much 27826 002340'01 104 00 0 00 000052 SIN% ; Swallow whatever junk is in there 27827 002341'01 320 12 0 00 002343' %jserr (,r) 27828 002342'01 254 00 0 00 002346' 27829 002343'01 265 01 0 00 002325* 27830 002344'01 000000000000# 27831 002345'01 254 00 0 00 002327* 27832 001234'04 125 156 141 142 154 27833 002346'01 270 04 0 00 000003 add t4, t3 ; Keep track of what we didn't read 27834 002347'01 274 06 0 00 000004 sub q2, t4 ; Subtract from remaining 27835 002350'01 270 07 0 00 000004 add q3, t4 ; And add to total done 27836 002351'01 327 06 0 00 002332' jumpg q2, top. ; Loop if anything left to do 27837 002352'01 enddo. ; End context inner loop k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 35-1 K20NET MAC 4-Apr-23 00:43 DECnet flush 27838 002352'01 endif. ; End SIBE% results handling 27839 002352'01 254 00 0 00 002320' loop. ; See if anything else there 27840 002353'01 enddo. ; End loop lexical context 27841 27842 002353'01 272 07 0 00 000000# addm q3, vchrcn ; Update grand total characters ever flushed 27843 002354'01 200 01 0 00 000007 move t1, q3 ; Return total characters whacked this time 27844 002355'01 254 00 0 00 002305* retskp ; Return success 27845 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 36 K20NET MAC 4-Apr-23 00:43 DECnet flush 27846 remark Special actions to flush a PTY 27847 27848 ; Note that while a CFIBF% will not work on the PTY JFN, a CFOBF% 27849 ; *WILL* work on the terminal side for which we have the device 27850 ; designator. Since we assigned the PTY which maps to the TTY, we 27851 ; retain certain rights to the terminal, one of which is that a CFOBF% 27852 ; will work and we don't have to read anything. 27853 ; 27854 ; None the less, we check to see if anything made it over to the PTY 27855 ; buffer so we can toss that. 27856 ; 27857 ; Does not return until *both* the SOBE% and SIBE% produce zero. 27858 27859 002356'01 ptyfls: remark ; Has to work both sides of the device 27860 002356'01 265 16 0 00 005361' saveac 27861 27862 002357'01 514 05 0 00 002307* hrlz q1, netjfn ; Pick up the network JFN 27863 002360'01 326 05 0 00 002366' ife. q1 ; Have to have this for a PTY!! 27864 002361'01 334 01 0 00 000000# ermsg% (,r) 27865 002362'01 254 00 0 00 002366' 27866 002363'01 202 01 0 00 002313* 27867 002364'01 104 00 0 00 000313 27868 002365'01 254 00 0 00 002345* 27869 000121'03 000000000000# 27870 001244'04 113 105 122 115 111 27871 27872 002366'01 endif. ; End of that particular sanity check 27873 002366'01 540 05 0 00 000000# hrr q1, ptytty ; Load this PTY's associated terminal line 27874 002367'01 660 05 0 00 400000 txo q1, .ttdes ; Force alternate form of terminal designator 27875 002370'01 403 06 0 00 000007 setzb q2, q3 ; Zero working read and grand total 27876 27877 002371'01 do. ; Enter loop context 27878 002371'01 550 01 0 00 000005 hrrz t1, q1 ; Load terminal designator 27879 002372'01 104 00 0 00 000103 SOBE% ; Skip if output buffer empty 27880 002373'01 254 00 0 00 002404' ifskp. ; Empty? 27881 002374'01 322 02 0 00 002402' ifn. t2 ; If zero, then no error and nothing to do 27882 002375'01 334 00 0 00 000000 %ermsg (,r) 27883 002376'01 254 00 0 00 002402' 27884 002377'01 265 01 0 00 002343* 27885 002400'01 000000000000# 27886 002401'01 254 00 0 00 002365* 27887 001260'04 125 156 141 142 154 27888 002402'01 endif. ; End case t2 having JSYS error code 27889 002402'01 400 10 0 00 000000 setz q4, ; Whack this round's output 27890 002403'01 254 00 0 00 002414' else. ; Otherwise, have some junk in there 27891 002404'01 270 07 0 00 000002 add q3, t2 ; Accumulate in grand tally 27892 002405'01 200 10 0 00 000002 move q4, t2 ; Flag non-zero buffer, this round 27893 002406'01 104 00 0 00 000101 CFOBF% ; Clear out any blocked up crud 27894 002407'01 320 12 0 00 002411' %jserr (,r) 27895 002410'01 254 00 0 00 002414' 27896 002411'01 265 01 0 00 002377* 27897 002412'01 000000000000# 27898 002413'01 254 00 0 00 002401* 27899 001271'04 103 157 165 154 144 27900 002414'01 endif. ; End SOBE% results handling k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 36-1 K20NET MAC 4-Apr-23 00:43 DECnet flush 27901 002414'01 554 01 0 00 000005 hlrz t1, q1 ; Load the PTY side 27902 002415'01 104 00 0 00 000102 SIBE% ; Skip if input buffer empty 27903 002416'01 254 00 0 00 002426' ifskp. ; Empty? 27904 002417'01 322 02 0 00 002425' ifn. t2 ; If zero, then no error; carry on 27905 002420'01 334 00 0 00 000000 %ermsg (,r) 27906 002421'01 254 00 0 00 002425' 27907 002422'01 265 01 0 00 002411* 27908 002423'01 000000000000# 27909 002424'01 254 00 0 00 002413* 27910 001301'04 125 156 141 142 154 27911 002425'01 endif. ; End case empty input buffer 27912 002425'01 254 00 0 00 002450' else. ; Otherwise, have some junk in there 27913 002426'01 270 10 0 00 000002 add q4, t2 ; Add to this round's tally 27914 002427'01 200 06 0 00 000002 move q2, t2 ; Load for inner loop 27915 002430'01 do. ; Enter inner loop context 27916 002430'01 337 04 0 00 000006 skipg t4, q2 ; Load remaining characters 27917 002431'01 254 00 0 00 002450' exit. ; If no more, then we're done 27918 002432'01 303 04 0 00 000310 caile t4, flushc ; More than maximum we can swallow at once? 27919 002433'01 201 04 0 00 000310 movx t4, flushc ; Yep, well just take a mouthful 27920 remark t1, q1 ; JFN is still in there 27921 002434'01 200 02 0 00 005377' move t2, [point 8,flushb] ; Load pointer to 'flush' buffer 27922 002435'01 210 03 0 00 000004 movn t3, t4 ; Reading exactly that much 27923 002436'01 104 00 0 00 000052 SIN% ; Swallow whatever junk is in there 27924 002437'01 320 12 0 00 002441' %jsErr (,r) ;[211] 27925 002440'01 254 00 0 00 002444' 27926 002441'01 265 01 0 00 002422* 27927 002442'01 000000000000# 27928 002443'01 254 00 0 00 002424* 27929 001310'04 125 156 141 142 154 27930 002444'01 270 04 0 00 000003 add t4, t3 ; Keep track of what we didn't read 27931 002445'01 270 07 0 00 000004 add q3, t4 ; And add to total done 27932 002446'01 274 06 0 00 000004 sub q2, t4 ; Subtract from remaining 27933 002447'01 327 06 0 00 002430' jumpg q2, top. ; Loop if anything left 27934 002450'01 enddo. ; End context inner loop 27935 002450'01 endif. ; End SIBE% results handling 27936 002450'01 327 10 0 00 002371' jumpg q4, top. ; If got anything, take another look 27937 002451'01 enddo. ; End of loop lexical context 27938 27939 002451'01 272 07 0 00 000000# addm q3, vchrcn ; Update grand total characters ever flushed 27940 002452'01 200 01 0 00 000007 move t1, q3 ; Return total characters whacked this time 27941 002453'01 254 00 0 00 002355* retskp ; Return success 27942 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 37 K20NET MAC 4-Apr-23 00:43 clrest Give an estimate of characters in input buffer 27943 subttl clrest Give an estimate of characters in input buffer 27944 27945 ; Call: 27946 ; 27947 ; Nothing: appropriate thing is done based on connection context. 27948 ; 27949 ; Returns: 27950 ; 27951 ; +1/ Some problem 27952 ; +2/ Success 27953 ; t1/ Total characters in various buffers 27954 ; 27955 ; N.B., A pseudo terminal can have characters on 'both sides', that 27956 ; is, the character's in the PTY's input buffer *AND* the 27957 ; characters in the associated TTY's output buffer that have not be 27958 ; transferred into the PTY's input buffer, yet. 27959 ; 27960 ; Thus, the use of SOBE% for pseudo-terminals in addition to the 27961 ; expected SIBE%. 27962 27963 002454'01 clrest: entry clrest ; World callable 27964 002454'01 265 16 0 00 005400' saveac ; Needs a few accumulators 27965 002455'01 550 04 0 00 002357* hrrz t4, netjfn ; Always prefer a network JFN 27966 002456'01 326 04 0 00 002460' ife. t4 ; Unless there isn't one 27967 002457'01 550 04 0 00 002261* hrrz t4, ttyjfn ; Use terminal if nothing else 27968 002460'01 endif. ; End case no network JFN 27969 002460'01 403 02 0 00 000003 setzb t2, t3 ; Clear all totals 27970 27971 002461'01 336 00 0 00 000000# ifmn. ptyflg ; If pseudo-terminal, look at both sides 27972 002462'01 254 00 0 00 002500' 27973 002463'01 550 01 0 00 000000# hrrz t1, ptytty ; Load this PTY's associated terminal line 27974 002464'01 660 01 0 00 400000 txo t1, .ttdes ; Force alternate form of terminal designator 27975 002465'01 104 00 0 00 000103 SOBE% ; Skip if output buffer empty 27976 002466'01 254 00 0 00 002476' ifskp. ; Empty? 27977 002467'01 322 02 0 00 002475' ifn. t2 ; If zero, then no error and nothing to do 27978 002470'01 334 00 0 00 000000 %ermsg (,r) 27979 002471'01 254 00 0 00 002475' 27980 002472'01 265 01 0 00 002441* 27981 002473'01 000000000000# 27982 002474'01 254 00 0 00 002443* 27983 001320'04 125 156 141 142 154 27984 002475'01 endif. ; End case t2 having JSYS error code 27985 002475'01 254 00 0 00 002500' else. ; Otherwise, have some junk in there 27986 002476'01 200 03 0 00 000002 move t3, t2 ; Keep track of TTY's output side 27987 002477'01 400 02 0 00 000000 setz t2, ; Keep nice and tidy for SIBE% 27988 002500'01 endif. ; End SOBE% results handling 27989 002500'01 endif. ; End PTY special case 27990 27991 002500'01 200 01 0 00 000004 move t1, t4 ; Load whatever JFN we decided to use 27992 002501'01 104 00 0 00 000102 SIBE% ; Skip if input buffer empty 27993 002502'01 254 00 0 00 002512' ifskp. ; Empty? 27994 002503'01 322 02 0 00 002511' ifn. t2 ; If zero, then no error and nothing to do 27995 002504'01 334 00 0 00 000000 %ermsg (,r) 27996 002505'01 254 00 0 00 002511' 27997 002506'01 265 01 0 00 002472* k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 37-1 K20NET MAC 4-Apr-23 00:43 clrest Give an estimate of characters in input buffer 27998 002507'01 000000000000# 27999 002510'01 254 00 0 00 002474* 28000 001331'04 125 156 141 142 154 28001 002511'01 endif. ; End case t2 having JSYS error code 28002 002511'01 254 00 0 00 002513' else. ; Otherwise, have some junk in there 28003 002512'01 270 03 0 00 000002 add t3, t2 ; Add to any running tally 28004 002513'01 endif. ; End SIBE% results handling 28005 28006 002513'01 200 01 0 00 000003 move t1, t3 ; Return grand total seen 28007 002514'01 254 00 0 00 002453* retskp ; Return success 28008 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 38 K20NET MAC 4-Apr-23 00:43 clread Return buffer of what we cleared 28009 subttl clread Return buffer of what we cleared 28010 28011 ; Call: 28012 ; 28013 ; Nothing: appropriate thing is done based on connection context. 28014 ; 28015 ; Returns: 28016 ; 28017 ; +1/ Some problem 28018 ; +2/ Success 28019 ; t1/ Total characters read 28020 ; t2/ (Eight bit) pointer to buffer 28021 ; 28022 ; N.B., be aware of the following: 28023 ; 28024 ; 1) clread should be repeatedly called until it returns zero as 28025 ; there may be more data than we can read. 28026 ; 28027 ; 2) Can't use SINR% because it will discard an unknown number of 28028 ; characters. Sigh... 28029 28030 002515'01 clread: entry clread ; Called from K20PAR 28031 002515'01 265 16 0 00 005412' saveac 28032 remark call ;[209] Display something 28033 002516'01 260 17 0 00 002252* call inpclr ;[209] Chuck any waiting input 28034 28035 002517'01 514 05 0 00 002455* hrlz q1, netjfn ; Prefer the network JFN 28036 002520'01 326 05 0 00 002522' ife. q1 ; But!! Do we have one? 28037 002521'01 514 05 0 00 002457* hrlz q1, ttyjfn ; Use terminal if nothing else 28038 002522'01 endif. ; End case no network JFN 28039 28040 002522'01 336 00 0 00 000000# ifmn. ptyflg ; Pseudo-terminal? 28041 002523'01 254 00 0 00 002526' 28042 002524'01 540 05 0 00 000000# hrr q1, ptytty ; Load this PTY's associated terminal line 28043 002525'01 660 05 0 00 400000 txo q1, .ttdes ; Force alternate form of terminal designator 28044 002526'01 endif. ; End case pseudo-terminal 28045 28046 dmove q4, [ flushc ; Load total remaining in buffer 28047 002526'01 120 10 0 00 005430' point 8, flushb ] ; Load pointer to 'flush' buffer 28048 28049 002527'01 do. ; Enter loop context 28050 002527'01 322 10 0 00 002606' jumpe q4, endlp. ; If buffer full, then return 28051 002530'01 550 01 0 00 000005 hrrz t1, q1 ; Load terminal designator 28052 002531'01 322 01 0 00 002546' ifn. t1 ; But did we ever have one? 28053 002532'01 104 00 0 00 000103 SOBE% ; Skip if output buffer empty 28054 002533'01 254 00 0 00 002544' ifskp. ; Empty? 28055 002534'01 322 02 0 00 002542' ifn. t2 ; If zero, then no error and nothing to do 28056 002535'01 334 00 0 00 000000 %ermsg (,r) 28057 002536'01 254 00 0 00 002542' 28058 002537'01 265 01 0 00 002506* 28059 002540'01 000000000000# 28060 002541'01 254 00 0 00 002510* 28061 001340'04 125 156 141 142 154 28062 002542'01 endif. ; End case t2 having JSYS error code 28063 002542'01 400 04 0 00 000000 setz t4, ; Whack this round's PTY portion k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 38-1 K20NET MAC 4-Apr-23 00:43 clread Return buffer of what we cleared 28064 002543'01 254 00 0 00 002545' else. ; Otherwise, have some junk in there 28065 002544'01 200 04 0 00 000002 move t4, t2 ; Flag non-zero buffer, this round 28066 002545'01 endif. ; End SOBE% results handling 28067 002545'01 254 00 0 00 002547' else. ; Otherwise no PTY 28068 002546'01 400 04 0 00 000000 setz t4, ; So no PTY contribution 28069 002547'01 endif. ; End special case for pseudo-termina 28070 002547'01 554 01 0 00 000005 hlrz t1, q1 ; Now load whatever JFN we have 28071 002550'01 104 00 0 00 000102 SIBE% ; Skip if input buffer empty 28072 002551'01 254 00 0 00 002561' ifskp. ; Empty? 28073 002552'01 322 02 0 00 002560' ifn. t2 ; If zero, then no error; carry on 28074 002553'01 334 00 0 00 000000 %ermsg (,r) 28075 002554'01 254 00 0 00 002560' 28076 002555'01 265 01 0 00 002537* 28077 002556'01 000000000000# 28078 002557'01 254 00 0 00 002541* 28079 001351'04 125 156 141 142 154 28080 002560'01 endif. ; End case empty input buffer 28081 002560'01 254 00 0 00 002562' else. ; Otherwise, have some junk in there 28082 002561'01 270 04 0 00 000002 add t4, t2 ; Add to this round's tally 28083 002562'01 endif. ; End SOBE% results handling 28084 002562'01 322 04 0 00 002606' jumpe t4, endlp. ; If nothing there, we're done 28085 002563'01 313 04 0 00 000010 camle t4, q4 ; More than what we have left? 28086 002564'01 200 04 0 00 000010 move t4, q4 ; Yep, don't overflow the buffer 28087 002565'01 200 06 0 00 000004 move q2, t4 ; Position for inner loop 28088 002566'01 400 07 0 00 000000 setz q3, ; Zero inner loop tally 28089 002567'01 do. ; Enter inner loop context 28090 remark t1, q1 ; JFN is still in there from SIBE% 28091 002567'01 200 02 0 00 000011 move t2, q5 ; Load updated pointer 28092 002570'01 210 03 0 00 000004 movn t3, t4 ; Reading exactly that much 28093 002571'01 104 00 0 00 000052 SIN% ; Swallow whatever junk is in there 28094 002572'01 320 12 0 00 002574' %jsErr (,r) 28095 002573'01 254 00 0 00 002577' 28096 002574'01 265 01 0 00 002555* 28097 002575'01 000000000000# 28098 002576'01 254 00 0 00 002557* 28099 001360'04 125 156 141 142 154 28100 002577'01 270 04 0 00 000003 add t4, t3 ; Keep track of what we did NOT read 28101 002600'01 270 07 0 00 000004 add q3, t4 ; And add to loop total done 28102 002601'01 274 06 0 00 000004 sub q2, t4 ; Subtract from remaining 28103 002602'01 327 06 0 00 002567' jumpg q2, top. ; Loop if anything left 28104 002603'01 enddo. ; End context inner loop 28105 002603'01 274 10 0 00 000007 sub q4, q3 ; Subtract from total buffer size 28106 002604'01 200 11 0 00 000002 move q5, t2 ; Store updated pointer for next round 28107 002605'01 327 10 0 00 002527' jumpg q4, top. ; If got anything, take another look 28108 002606'01 enddo. ; End of loop lexical context 28109 28110 002606'01 201 01 0 00 000310 movx t1, flushc ; Load largest possible buffer 28111 002607'01 274 01 0 00 000010 sub t1, q4 ; Subtract total remaining 28112 002610'01 272 01 0 00 000000# addm t1, vchrcn ; Update grand total characters ever flushed 28113 002611'01 200 02 0 00 005432' move t2, [point 8,flushb] ; Return pointer to 'flush' buffer 28114 002612'01 254 00 0 00 002514* retskp ; Finally return success 28115 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 39 K20NET MAC 4-Apr-23 00:43 Routine to unstop an XOFF'd line, added as edit 91. 28116 subttl Routine to unstop an XOFF'd line, added as edit 91. 28117 28118 002613'01 ttxon: entry ttxon ;[211] Partly rewritten for PTY's and NRT's 28119 002613'01 265 16 0 00 005433' saveac ;[211] Needs an extra register 28120 28121 002614'01 260 17 0 00 002252' call clrbuf ;[211] Call our new friend to toss data 28122 002615'01 263 17 0 00 000000 ret ;[211] But couldn't; give up 28123 28124 002616'01 332 01 0 00 002517* skipe t1, netjfn ;[186] Load the network JFN 28125 002617'01 254 00 0 00 002634' ifskp. ;[186] Unless we don't have one... 28126 002620'01 332 00 0 00 001276* skipe local ;[186] Are we remote? 28127 002621'01 334 01 0 00 000000# ermsg% (,r) ;[186] Punt 28128 002622'01 254 00 0 00 002626' 28129 002623'01 202 01 0 00 002363* 28130 002624'01 104 00 0 00 000313 28131 002625'01 254 00 0 00 002576* 28132 000122'03 000000000000# 28133 001366'04 113 105 122 115 111 28134 28135 002626'01 336 01 0 00 002521* skipn t1, ttyjfn ;[186] Yes, so just use the terminal JFN 28136 002627'01 334 01 0 00 000000# ermsg% (,r) ;[186] 28137 002630'01 254 00 0 00 002634' 28138 002631'01 202 01 0 00 002623* 28139 002632'01 104 00 0 00 000313 28140 002633'01 254 00 0 00 002625* 28141 000123'03 000000000000# 28142 001402'04 113 105 122 115 111 28143 28144 002634'01 endif. ;[186] Hopefully have SOMETHING ... 28145 002634'01 514 05 0 00 000001 hrlz q1, t1 ;[211] Save the JFN (sans flags) for later 28146 28147 002635'01 336 00 0 00 000000# ifmn. ptyflg ;[211] A pseudo-terminal? 28148 002636'01 254 00 0 00 002641' 28149 002637'01 550 01 0 00 000000# hrrz t1, ptytty ;[211] Yes, don't do this to the PTY half 28150 002640'01 660 01 0 00 400000 txo t1, .ttdes ;[211] Do it to the TTY half 28151 002641'01 endif. ;[211] End PTY-FE/NRT decision 28152 002641'01 540 05 0 00 000001 hrr q1, t1 ;[211] Save some terminal descriptor 28153 28154 ;[157] If we're doing flow control, send a ^Q (XON) to unstick the other side. 28155 28156 002642'01 336 00 0 00 000000* skipn flow ; Doing flow control? 28157 002643'01 263 17 0 00 000000 ret ; No, done. 28158 28159 002644'01 332 00 0 00 000000# skipe nrtflg ;[211] An NRT? 28160 002645'01 254 00 0 00 002666' callret ttxon3 ;[211] Skip this terminal stuff 28161 ;[211] Will never work with a DCN: JFN 28162 002646'01 550 01 0 00 000005 ttxon2: hrrz t1, q1 ;[211] Get some terminal descriptor 28163 002647'01 104 00 0 00 000107 RFMOD ; Yes, get terminal mode. 28164 002650'01 320 16 0 00 002633* erjmp r 28165 002651'01 200 03 0 00 000002 move t3, t2 ; Save it. 28166 002652'01 622 02 0 00 000300 txze t2, tt%dam ; Data mode? 28167 002653'01 254 00 0 00 002656' ifskp. ;[211] No, so no need to change 28168 002654'01 260 17 0 00 002666' call ttxon3 ; No, binary, just send it. 28169 002655'01 254 00 0 00 002665' else. ;[211] Otherwise, tweak the mode 28170 002656'01 104 00 0 00 000110 SFMOD ; Put in binary mode. k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 39-1 K20NET MAC 4-Apr-23 00:43 Routine to unstop an XOFF'd line, added as edit 91. 28171 002657'01 320 12 0 00 002650* erjmpr r ;[211] 28172 002660'01 260 17 0 00 002666' call ttxon3 ; Send the XON. 28173 002661'01 550 01 0 00 000005 hrrz t1, q1 ;[211] Reload the terminal descriptor 28174 002662'01 200 02 0 00 000003 move t2, t3 ; Load original settings 28175 002663'01 104 00 0 00 000110 SFMOD ; Put back in data mode. 28176 002664'01 320 12 0 00 002657* erjmpr r ;[211] 28177 002665'01 endif. ;[211] End terminal mode tweaking 28178 002665'01 263 17 0 00 000000 ret 28179 28180 002666'01 554 01 0 00 000005 ttxon3: hlrz t1, q1 ;[211] Use the real JFN 28181 002667'01 201 02 0 00 000021 movei t2, xon ; Send an XON. 28182 002670'01 104 00 0 00 000051 BOUT 28183 002671'01 320 16 0 00 002664* erjmp r 28184 002672'01 263 17 0 00 000000 ret 28185 28186 ;[211] End clrbuf rewrite for non-physical terminals 28187 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 40 K20NET MAC 4-Apr-23 00:43 clsnet -- Close any kind of 'network' connection 28188 subttl clsnet -- Close any kind of 'network' connection 28189 28190 remark ; Has to be before first reference!! 28191 syn clscom,clsfe ; Close the terminal 28192 syn clscom,clspty ; Close the pseudo-terminal 28193 28194 ; Ignores local setting, uses netjfn, regardless. Checks the JFN, 28195 ; regardless of it possibly being absurd. 28196 28197 002673'01 clsjfn: entry clsjfn ; Invoked by Kermit exit 28198 002673'01 265 16 0 00 005447' saveac ;Don't touch anything 28199 002674'01 200 01 0 00 002616* move t1, netjfn ; Use whatever is there, no matter what 28200 002675'01 254 00 0 00 002703' jrst chkcls ; Just get started with the JFN 28201 28202 ; Expects nothing; checks local to see if we would even have the JFN 28203 ; and sanity checks the JFN 28204 28205 002676'01 clsnet: entry clsnet ; Callable by anybody 28206 extern local ; Set if we are not using .priou for transfers 28207 28208 002676'01 336 00 0 00 002620* skipn local ; Are we not using our own terminal for packets? 28209 002677'01 263 17 0 00 000000 ret ; We are, so there is nothing to clean up 28210 002700'01 265 16 0 00 005447' saveac ;Don't touch anything 28211 002701'01 337 01 0 00 002674* skipg t1, netjfn ; If we are local, then we will have a JFN 28212 002702'01 254 00 0 00 003007' jrst clsasg ; Unless we are in some odd state 28213 remark chkcls ; falls through 28214 28215 002703'01 chkcls: remark ; Here to check if we can close it 28216 002703'01 104 00 0 00 000024 GTSTS% ; Now let's find out about the JFN 28217 002704'01 320 12 0 00 002706' ifje. r ; Catch and ignore the error 28218 002705'01 254 00 0 00 002712' 28219 002706'01 200 04 0 00 000001 move t4, t1 ; Save any error code for later 28220 002707'01 400 05 0 00 000000 setz q1, ; Whack the bits, assume nothing 28221 002710'01 550 01 0 00 002701* hrrz t1, netjfn ; Reload the JFN 28222 002711'01 254 00 0 00 002713' else. ; Otherwise, worked 28223 002712'01 200 05 0 00 000002 move q1, t2 ; Save the status bits 28224 002713'01 endif. 28225 002713'01 607 05 0 00 000200 jxe q1, gs%nam, clscln ; Nothing there? Just scrub the storage 28226 002714'01 254 00 0 00 003053' 28227 28228 002715'01 104 00 0 00 000117 DVCHR% ; JFN might work 28229 002716'01 320 12 0 00 002720' ifje. r ; But didn't 28230 002717'01 254 00 0 00 002724' 28231 002720'01 200 04 0 00 000001 move t4, t1 ; Save any error code for later 28232 002721'01 477 06 0 00 000010 setob q2, q4 ; Phoney device designator and assignment 28233 002722'01 400 07 0 00 000000 setz q3, ; No characteristics 28234 002723'01 254 00 0 00 002726' else. ; Otherwise, worked. Promising... 28235 002724'01 120 06 0 00 000001 dmove q2, t1 ; Save device designator and characteristics 28236 002725'01 200 10 0 00 000003 move q4, t3 ; And assignment word 28237 002726'01 endif. 28238 002726'01 325 05 0 00 003002' jxe q1, gs%opn, clsrlj ; If it isn't open, don't close it 28239 ; Load the device type 28240 002727'01 135 04 0 00 005465' ldb t4,[pointr q3,dv%typ] 28241 002730'01 306 04 0 00 000012 cain t4, .dvtty ; Physical (front end) terminal? 28242 002731'01 254 00 0 00 002757' jrst clsfe ; Clean that up and deassign k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 40-1 K20NET MAC 4-Apr-23 00:43 clsnet -- Close any kind of 'network' connection 28243 002732'01 306 04 0 00 000013 cain t4, .dvpty ; Pseudo terminal? 28244 002733'01 254 00 0 00 002757' jrst clspty ; Clean that up and deassign 28245 002734'01 306 04 0 00 000022 cain t4, .dvdcn ; Outgoing NRT? 28246 002735'01 254 00 0 00 002750' jrst clsnrt ; Clean that up (no deassign) 28247 28248 002736'01 334 01 0 00 000000# ermsg% (, clscom) 28249 002737'01 254 00 0 00 002743' 28250 002740'01 202 01 0 00 002631* 28251 002741'01 104 00 0 00 000313 28252 002742'01 254 00 0 00 002757' 28253 000124'03 000000000000# 28254 001416'04 113 105 122 115 111 28255 28256 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 41 K20NET MAC 4-Apr-23 00:43 Various JFN closure routines 28257 subttl Various JFN closure routines 28258 28259 remark ; See required location of SYN's, above 28260 remark clsfe ; Close the terminal 28261 remark clspty ; Close the pseudo-terminal 28262 28263 002743'01 44 07 0 00 002745' nrtend: point 7, .+2 ; Point to message 28264 002744'01 000000 000014 ^d12 ; Its length 28265 002745'01 113 145 162 155 151 ASCIZ "Kermit Close" ; Informative message... 28266 28267 002750'01 550 01 0 00 002710* clsnrt: hrrz t1, netjfn ; Load the network JFN 28268 002751'01 200 02 0 00 005466' move t2, [.dcx40,,.moclz] ;Object initiated close 28269 002752'01 120 03 0 00 002743' dmove t3, nrtend ; Message for remote NRT server to ignore 28270 002753'01 104 00 0 00 000077 MTOPR% ; Try to deliver the bad news 28271 002754'01 320 12 0 00 002756' ifje. r ; Catch and ignore error 28272 002755'01 254 00 0 00 002757' 28273 002756'01 200 04 0 00 000001 move t4, t1 ; Leave around for debugger 28274 002757'01 endif. 28275 remark clscom ; And proceed ...(falls through) 28276 28277 002757'01 550 01 0 00 002750* clscom: hrrz t1, netjfn ; Common close for any kind of JFN 28278 002760'01 104 00 0 00 000022 CLOSF% ; Make our first attempt 28279 002761'01 320 12 0 00 002763' ifje. r ; Catch and ignore the error 28280 002762'01 254 00 0 00 002767' 28281 002763'01 200 04 0 00 000001 move t4, t1 ; Save error for later 28282 002764'01 302 01 0 00 600160 caie t1, clsx1 ; File not open? 28283 002765'01 254 00 0 00 002770' jrst clsabt ; No, try to abort it 28284 002766'01 254 00 0 00 003002' jrst clsrlj ; Otherwise, just try to let go of it 28285 002767'01 endif. 28286 002767'01 254 00 0 00 003007' jrst clsasg ; Go clean up assignments and storage 28287 28288 002770'01 550 01 0 00 002757* clsabt: hrrz t1, netjfn ; Load the JFN, no flags 28289 002771'01 661 01 0 00 004000 txo t1, cz%abt ; Set the abort flag 28290 002772'01 104 00 0 00 000022 CLOSF% ; Toss it with reckless abandon 28291 002773'01 320 12 0 00 002775' ifje. r ; Catch and ignore the error 28292 002774'01 254 00 0 00 003001' 28293 002775'01 200 04 0 00 000001 move t4, t1 ; Save error for later 28294 002776'01 302 01 0 00 600152 caie t1, desx3 ; JFN not assigned anymore> 28295 002777'01 254 00 0 00 002770' jrst clsabt ; No, just try to let go of it 28296 003000'01 254 00 0 00 003007' jrst clsasg ; Otherwise, release assignments 28297 003001'01 endif. 28298 003001'01 254 00 0 00 003007' jrst clsasg ; Go clean up assignments 28299 28300 003002'01 550 01 0 00 002770* clsrlj: hrrz t1, netjfn ; Just try to let go 28301 003003'01 104 00 0 00 000023 RLJFN% ; and hope for the bext 28302 003004'01 320 12 0 00 003006' ifje. r ; Catch and ignore the error 28303 003005'01 254 00 0 00 003007' 28304 003006'01 200 04 0 00 000001 move t4, t1 ; Save error for later 28305 003007'01 endif. 28306 remark clsasg ; Clean up assignments 28307 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 42 K20NET MAC 4-Apr-23 00:43 Release any assigned terminals, pseudo or otherwise 28308 subttl Release any assigned terminals, pseudo or otherwise 28309 28310 003007'01 336 00 0 00 001130* clsasg: ifmn. asgflg ; Do we think anything assigned? 28311 003010'01 254 00 0 00 003016' 28312 003011'01 200 01 0 00 001131* move t1, asgdev ; Grab assigned device 28313 003012'01 104 00 0 00 000071 RELD% ; Punt it 28314 003013'01 320 12 0 00 003015' ifje. r ; Sigh 28315 003014'01 254 00 0 00 003016' 28316 003015'01 200 04 0 00 000001 move t4, t1 ; What if different from q2? 28317 003016'01 endif. 28318 003016'01 endif. 28319 ; Do a consistency check 28320 003016'01 574 03 0 00 000010 hlre t3, q4 ; Load job assignment 28321 003017'01 312 03 0 00 005467' came t3, [-1] ; Not assigned? 28322 003020'01 316 03 0 00 005470' camn t3, [-2] ; Allocator has it? 28323 003021'01 254 00 0 00 003053' Jrst clscln ; Then nothing else to do 28324 003022'01 312 03 0 00 001100* came t3, myjob ; Do we have this device? 28325 003023'01 254 00 0 00 003053' jrst clscln ; No, then surely cannot release it 28326 003024'01 200 01 0 00 000006 move t1, q2 ; Load JFN's device designator 28327 003025'01 316 01 0 00 003011* camn t1, asgdev ; Did we already release it, actually? 28328 003026'01 254 00 0 00 003053' jrst clscln ; Yes, so no inconsistency 28329 ; No, something extra left lying around... 28330 003027'01 554 02 0 00 000001 hlrz t2, t1 ; Pick up the device type 28331 003030'01 550 03 0 00 000001 hrrz t3, t1 ; Pick up the unit number 28332 003031'01 326 02 0 00 003041' ife. t2 ; But!! Any device type? 28333 003032'01 626 03 0 00 400000 trzn t3, .ttdes ; Universal terminal? 28334 003033'01 254 00 0 00 003053' jrst clscln ; No, some odd thing. Leave it alone 28335 003034'01 316 03 0 00 001261* camn t3, mytty ; It's a terminal. Ourself? 28336 003035'01 254 00 0 00 003053' jrst clscln ; Yes, LOGIN% or CRJOB% gave it to us 28337 003036'01 550 01 0 00 000003 hrrz t1, t3 ; Load bare terminal number 28338 003037'01 505 01 0 00 600012 hrli t1, .dvdes!.dvtty ;Give a general device designator 28339 003040'01 254 00 0 00 003047' else. ; Otherwise, fullword 28340 003041'01 200 04 0 00 000002 move t4, t2 ; Make a copy of the device designator 28341 003042'01 620 04 0 00 600000 trz t4, .dvdes ; Shut off the device designator 28342 003043'01 302 04 0 00 000012 caie t4, .dvtty ; A terminal? 28343 003044'01 254 00 0 00 003047' anskp. ; Not a terminal, so can't be our terminal 28344 003045'01 316 03 0 00 003034* camn t3, mytty ; It's a terminal. Ourself? 28345 003046'01 254 00 0 00 003053' jrst clscln ; Yes, LOGIN% or CRJOB% gave it to us 28346 003047'01 endif. ; To RELD% 28347 28348 003047'01 104 00 0 00 000071 RELD% ; Try to punt it, anyway 28349 003050'01 320 12 0 00 003052' ifje. r ; Sigh 28350 003051'01 254 00 0 00 003053' 28351 003052'01 200 04 0 00 000001 move t4, t1 ; Save error number for debuggers 28352 003053'01 endif. 28353 remark clscln ; Fall through to storage clean up 28354 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 43 K20NET MAC 4-Apr-23 00:43 Finally obliterate JFN related storage 28355 subttl Finally obliterate JFN related storage 28356 28357 ; Leaves ASCII device or node names alone for possible later reporting 28358 28359 003053'01 402 00 0 00 003007* clscln: setzm asgflg ; Nothing assigned 28360 003054'01 402 00 0 00 003025* setzm asgdev ; No relec of it, either 28361 003055'01 402 00 0 00 003002* setzm netjfn ; Not no JFN, not no how 28362 28363 003056'01 403 01 0 00 000002 setzb t1, t2 ; In case we have adjacent words 28364 003057'01 124 01 0 00 000000# dmovem t1, ndvchr ; Whack the characteristics double word 28365 003060'01 402 00 0 00 002200* setzm vtermf ; No kind of virtual terminal 28366 003061'01 402 00 0 00 000000# setzm nrtflg ; Not a DECnet NRT connection 28367 003062'01 402 00 0 00 000000# setzm ptytty ; No terminal assigned via PTY, either 28368 003063'01 402 00 0 00 000000# setzm ptyflg ; No a pseudo-terminal connection 28369 003064'01 402 00 0 00 000000# setzm ttyflg ; Not using a physical terminal 28370 003065'01 402 00 0 00 000000# setzm ttydev ; So don't have a device designator 28371 28372 003066'01 200 03 0 00 003045* move t3, mytty ; Use our local terminal 28373 003067'01 202 03 0 00 001501* movem t3, ttynum ; Use that 28374 003070'01 402 00 0 00 002676* setzm local ; We are no longer local 28375 003071'01 476 00 0 00 000000# setom opndev ; No opened device 28376 003072'01 263 17 0 00 000000 ret ; One way or another, finally done 28377 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 44 K20NET MAC 4-Apr-23 00:43 Lost virtual terminal connection, shut everything down 28378 subttl Lost virtual terminal connection, shut everything down 28379 28380 003073'01 netvtx: entry netvtx ;[196] 28381 extern frkchb ;[218] Convert channel number to bit 28382 txmsg < 28383 003073'01 200 01 0 00 000000# [KERMIT-20: Lost > 28384 003074'01 104 00 0 00 000076 28385 003075'01 320 12 0 00 003076' 28386 000125'03 000000000000# 28387 001426'04 015 012 007 133 113 28388 28389 003076'01 336 00 0 00 000000# ifmn. ptyflg 28390 003077'01 254 00 0 00 003115' 28391 003100'01 200 01 0 00 000000# txmsg 28392 003101'01 104 00 0 00 000076 28393 003102'01 320 12 0 00 003103' 28394 000126'03 000000000000# 28395 001433'04 160 163 145 165 144 28396 003103'01 561 01 0 00 000000# hrroi t1, ptynam ; Point to pseudo-terminal device name 28397 003104'01 104 00 0 00 000076 PSOUT% ; Type that 28398 003105'01 200 01 0 00 000000# txmsg < (> 28399 003106'01 104 00 0 00 000076 28400 003107'01 320 12 0 00 003110' 28401 000127'03 000000000000# 28402 001442'04 040 050 000 000 000 28403 003110'01 561 01 0 00 000000# hrroi t1, ttynam ; Point to associated terminal device name 28404 003111'01 104 00 0 00 000076 PSOUT% ; Type that 28405 003112'01 200 01 0 00 000000# txmsg <) > 28406 003113'01 104 00 0 00 000076 28407 003114'01 320 12 0 00 003115' 28408 000130'03 000000000000# 28409 001443'04 051 040 000 000 000 28410 003115'01 endif. 28411 28412 003115'01 336 00 0 00 000000# ifmn. nrtflg 28413 003116'01 254 00 0 00 003127' 28414 003117'01 200 01 0 00 000000# txmsg 28415 003120'01 104 00 0 00 000076 28416 003121'01 320 12 0 00 003122' 28417 000131'03 000000000000# 28418 001444'04 104 105 103 156 145 28419 003122'01 561 01 0 00 001444* hrroi t1,nodnam ; Point to the remote node 28420 003123'01 104 00 0 00 000076 PSOUT% ; Type it 28421 003124'01 200 01 0 00 000000# txmsg <:: > ; Trailing punctuation 28422 003125'01 104 00 0 00 000076 28423 003126'01 320 12 0 00 003127' 28424 000132'03 000000000000# 28425 001452'04 072 072 040 000 000 28426 003127'01 endif. 28427 28428 003127'01 200 01 0 00 000000# txmsg ; Find out where this blew up 28429 003130'01 104 00 0 00 000076 28430 003131'01 320 12 0 00 003132' 28431 000133'03 000000000000# 28432 001453'04 141 164 072 040 000 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 44-1 K20NET MAC 4-Apr-23 00:43 Lost virtual terminal connection, shut everything down 28433 003132'01 200 01 0 17 000000 move t1, (p) ; See who called us 28434 003133'01 621 01 0 00 777700 txz t1, klflgs ; Flags aren't part of the address 28435 003134'01 260 17 0 00 000000* call symout ; Symbollically! 28436 003135'01 200 01 0 00 000000# txmsg <. Returning to > 28437 003136'01 104 00 0 00 000076 28438 003137'01 320 12 0 00 003140' 28439 000134'03 000000000000# 28440 001454'04 056 040 122 145 164 28441 003140'01 561 01 0 00 000000# hrroi t1,sysnam ; Load local node name 28442 003141'01 104 00 0 00 000076 PSOUT% ; Type it, not "DEC-20" 28443 28444 dmove t1, [ .fhsup ;[218] Signaling superior Kermit 28445 003142'01 120 01 0 00 005471' frkchb ] ;[218] Inter-fork signal 28446 003143'01 104 00 0 00 000132 IIC% ; Give it a poke 28447 003144'01 320 12 0 00 003146' ifje. r ; Failed?? 28448 003145'01 254 00 0 00 003167' 28449 003146'01 302 01 0 00 600251 caie t1, FRKHX2 ; Wait! Tried to poke the wrong guy? 28450 003147'01 334 00 0 00 000000 %ermsg (,neter2) 28451 003150'01 254 00 0 00 003154' 28452 003151'01 265 01 0 00 002574* 28453 003152'01 000000000000# 28454 003153'01 254 00 0 00 003172' 28455 001460'04 125 156 141 142 154 28456 003154'01 201 01 0 00 400000 movei t1, .fhslf ;[186] We must be the inferior 28457 003155'01 104 00 0 00 000132 IIC% ;[186] So poke ourselves 28458 003156'01 320 12 0 00 003160' %jserr (,) ;[186] 28459 003157'01 254 00 0 00 003163' 28460 003160'01 265 01 0 00 003151* 28461 003161'01 000000000000# 28462 003162'01 254 00 0 00 003163' 28463 001472'04 125 156 141 142 154 28464 txmsg <:: (Sup)] 28465 28466 003163'01 200 01 0 00 000000# > 28467 003164'01 104 00 0 00 000076 28468 003165'01 320 12 0 00 003166' 28469 000135'03 000000000000# 28470 001501'04 072 072 040 050 123 28471 28472 003166'01 254 00 0 00 002212* jrst $connx ;[186] In self-case, close some other things 28473 003167'01 endif. ;[186] End signaling analysis and recovery 28474 txmsg <:: (Inf)] 28475 28476 003167'01 200 01 0 00 000000# > 28477 003170'01 104 00 0 00 000076 28478 003171'01 320 12 0 00 003172' 28479 000136'03 000000000000# 28480 001504'04 072 072 040 050 111 28481 28482 28483 003172'01 104 00 0 00 000170 neter2: HALTF ; Halt this fork. 28484 003173'01 254 00 0 00 003172' jrst neter2 ; Should never get here... 28485 28486 003174'01 261 17 0 00 000001 netinh: push p, t1 ; Save t1, just in case useful 28487 003175'01 261 17 0 00 000002 push p, t2 ; Ditto others k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 44-2 K20NET MAC 4-Apr-23 00:43 Lost virtual terminal connection, shut everything down 28488 003176'01 261 17 0 00 000003 push p, t3 28489 28490 003177'01 561 01 0 00 003215' hrroi t1, netinm ; Load error message 28491 003200'01 104 00 0 00 000313 ESOUT% ; Give ourselves an error 28492 003201'01 201 01 0 00 000101 movei t1,.priou ; Continue on primary output 28493 003202'01 525 02 0 00 400000 hrloi t2,.fhslf ; Wants this for explicit error 28494 003203'01 400 03 0 00 000000 setz t3, ; Don't limit length of text 28495 003204'01 104 00 0 00 000011 ERSTR% ; Type the JSYS failure reason text 28496 003205'01 320 12 0 00 003207' erjmpr .+2 ; Ignore strange error 28497 003206'01 320 12 0 00 003207' erjmpr .+1 ; Ignore stranger error 28498 003207'01 561 01 0 00 001574* hrroi t1, crlf ; Tie off the line 28499 003210'01 104 00 0 00 000076 PSOUT% 28500 28501 003211'01 262 17 0 00 000003 pop p, t3 ; Restore them 28502 003212'01 262 17 0 00 000002 pop p, t2 ; all of 28503 003213'01 262 17 0 00 000001 pop p, t1 ; them 28504 003214'01 254 00 0 00 003172' jrst neter2 ; Go drop dead and stay dead 28505 28506 003215'01 116 145 164 167 157 netinm: asciz /Network input subfork unexpectedly halted, / 28507 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 45 K20NET MAC 4-Apr-23 00:43 Open Net -- Opens network connection to somewhere 28508 subttl Open Net -- Opens network connection to somewhere 28509 28510 ; Call: 28511 ; 28512 ; t1/ LH: device type number - .dvpty, .dvdcn, .dvtty 28513 ; RH: unit number, if applicable (-1, otherwise) 28514 ; 28515 ; Return: 28516 ; 28517 ; +1/ t1, Gubbish 28518 ; t2, Ditto 28519 ; 28520 ; +2/ t1, JFN ready to use 28521 ; t2, Associated device designator (which may have been assigned) 28522 ; 28523 ; N.B., Assumes we are not treating a disk as a terminal 28524 28525 003226'01 openet: entry openet ; World callable 28526 extern flow ; Used for ^S/^Q processing 28527 003226'01 265 16 0 00 005412' saveac ;Save some things 28528 003227'01 200 05 0 00 000001 move q1, t1 ; Let's get that out of the way 28529 28530 003230'01 337 01 0 00 003055* skipg t1, netjfn ; Is anything maybe open? 28531 003231'01 254 00 0 00 003250' ifskp. ; Yes, let's get some information 28532 003232'01 104 00 0 00 000024 GTSTS% ; Get file status of JFN 28533 003233'01 320 16 0 00 003250' annje. ; Give up; JFN has to be ill 28534 003234'01 607 02 0 00 000200 ifxn. t2, gs%nam ; Don't go any further if nothing there 28535 003235'01 254 00 0 00 003247' 28536 003236'01 325 02 0 00 003247' andxn. t2, gs%opn ; And it has to be open 28537 003237'01 200 04 0 00 000002 move t4, t2 ; Save the status word 28538 003240'01 104 00 0 00 000117 DVCHR% ; Get the device characteristics 28539 003241'01 320 12 0 00 003243' ifje. r ; Catch and record error 28540 003242'01 254 00 0 00 003245' 28541 003243'01 661 04 0 00 000400 txo t4, gs%err ; Pretend the file is in error 28542 003244'01 254 00 0 00 003247' else. ; Otherwise, worked 28543 003245'01 200 06 0 00 000001 move q2, t1 ; Save device designator 28544 003246'01 120 07 0 00 000002 dmove q3, t2 ; Save characteristics and assignment 28545 003247'01 endif. ; End DVCHR error handling 28546 003247'01 endif. ; End case file status checking 28547 003247'01 254 00 0 00 003252' else. ; Otherwise, whack everything 28548 003250'01 403 04 0 00 000006 setzb t4, q2 ; No status or device designator 28549 003251'01 403 07 0 00 000010 setzb q3, q4 ; No device characteristics or assignment 28550 003252'01 endif. 28551 28552 remark ; See if we need to ditch the JFN 28553 003252'01 607 04 0 00 000200 ifxn. t4, gs%nam ; Is there a JFN already? 28554 003253'01 254 00 0 00 003257' 28555 003254'01 607 04 0 00 000400 andxn. t4, gs%err ; Any kind of error, phoney or otherwise? 28556 003255'01 254 00 0 00 003257' 28557 003256'01 260 17 0 00 002673' call clsjfn ; Yes, stomp it 28558 003257'01 endif. ; End case JFN status check 28559 28560 003257'01 554 01 0 00 000005 hlrz t1, q1 ; Finally have a look at the device type number 28561 003260'01 135 02 0 00 005473' ldb t2,[pointr q2,dv%typ];Load JFN's device type number 28562 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 45-1 K20NET MAC 4-Apr-23 00:43 Open Net -- Opens network connection to somewhere 28563 003261'01 302 01 0 00 000013 caie t1, .dvpty ; Wants a pseudo-terminal? 28564 003262'01 254 00 0 00 003272' ifskp. ; Yes, let's see if we are reconnecting 28565 003263'01 312 01 0 00 000002 came t1, t2 ; Already has one? 28566 003264'01 254 00 0 00 003267' ifskp. ; Fine, give him the same one 28567 003265'01 550 01 0 00 003230* hrrz t1, netjfn ; Reload the JFN 28568 003266'01 254 00 0 00 002612* retskp ; Return success 28569 003267'01 endif. ; Otherwise, wants to go somewhere else 28570 003267'01 603 04 0 00 400000 txne t4, gs%opn ; Anything already open? 28571 003270'01 260 17 0 00 002673' call clsjfn ; Yes, stomp it 28572 003271'01 254 00 0 00 003350' callret opnpty ; Yes, go assign and open one 28573 003272'01 endif. ; End case pseudo-terminal connection 28574 28575 003272'01 302 01 0 00 000012 caie t1, .dvtty ; Wants a physical terminal? 28576 003273'01 254 00 0 00 003312' ifskp. ; Yes, let's see if we are reconnecting 28577 003274'01 312 01 0 00 000002 came t1, t2 ; Already has one? 28578 003275'01 254 00 0 00 003307' ifskp. ; Yes, maybe reusing the current one 28579 003276'01 550 01 0 00 000005 hrrz t1, q1 ; Pick up requested unit number 28580 003277'01 135 02 0 00 005474' ldb t2,[pointr q2,dv%unt] ;Load JFN's device type number 28581 003300'01 312 01 0 00 000002 came t1, t2 ; Are they the same? 28582 003301'01 254 00 0 00 003307' anskp. ; No, release the old one and get out of here 28583 003302'01 574 01 0 00 000010 hlre t1, q4 ; Pick up assigned job 28584 003303'01 312 01 0 00 003022* came t1, myjob ; Is it me? 28585 003304'01 254 00 0 00 003307' anskp. ; Strange, don't risk reusing it 28586 003305'01 550 01 0 00 003265* hrrz t1, netjfn ; Reload the JFN 28587 003306'01 254 00 0 00 003266* retskp ; Return success 28588 003307'01 endif. 28589 003307'01 603 04 0 00 400000 txne t4, gs%opn ; Anything already open? 28590 003310'01 260 17 0 00 002673' call clsjfn ; Yes, stomp it 28591 003311'01 254 00 0 00 003454' callret opntty ; Go assign terminal and open it 28592 003312'01 endif. ; End case physical terminal 28593 28594 003312'01 302 01 0 00 000022 caie t1, .dvdcn ; Wants a DECnet NRT?? 28595 003313'01 254 00 0 00 003343' ifskp. ; Yes, maybe going to the same place 28596 003314'01 312 01 0 00 000002 came t1, t2 ; Already there someplace? 28597 003315'01 254 00 0 00 003340' ifskp. ; Fine, give him the same one 28598 003316'01 336 00 0 00 000000# ifmn. ndvfxp ; Has extended verify? 28599 003317'01 254 00 0 00 003327' 28600 003320'01 260 17 0 00 000236' call chknrt ; OK, so check the node name 28601 003321'01 254 00 0 00 003326' ifskp. ; Worked, let's compare the numbers 28602 003322'01 312 01 0 00 000000# came t1, oldnum ; Going to same node? 28603 003323'01 254 00 0 00 003326' anskp. ; No, so close up shop and go elsewhere 28604 003324'01 550 01 0 00 003305* hrrz t1, netjfn ; The same; reload the JFN 28605 003325'01 254 00 0 00 003306* retskp ; Return success 28606 003326'01 endif. ; Done 28607 remark ; Otherwise falls out and gets new connection 28608 003326'01 254 00 0 00 003340' else. ; Otherwise, have to compare characters 28609 dmove t1, [ -1,,oldnam ; Old node name 28610 003327'01 120 01 0 00 005475' -1,,nodnam ] ; Current node name 28611 003330'01 104 00 0 00 000540 STCMP% ; Compare them 28612 003331'01 320 12 0 00 003333' ifje. r ; Failed?? 28613 003332'01 254 00 0 00 003335' 28614 003333'01 200 03 0 00 000001 move t3, t1 ; Save error code 28615 003334'01 474 01 0 00 000000 seto t1, ; For sure not equal 28616 003335'01 endif. 28617 003335'01 326 01 0 00 003340' ife. t1 ; Equal? k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 45-2 K20NET MAC 4-Apr-23 00:43 Open Net -- Opens network connection to somewhere 28618 003336'01 550 01 0 00 003324* hrrz t1, netjfn ; The same; reload the JFN 28619 003337'01 254 00 0 00 003325* retskp ; Return success 28620 003340'01 endif. 28621 003340'01 endif. ; End same destination checks 28622 003340'01 endif. 28623 003340'01 603 04 0 00 400000 txne t4, gs%opn ; Anything already open? 28624 003341'01 260 17 0 00 002673' call clsjfn ; Yes, stomp it 28625 003342'01 254 00 0 00 000213' callret decnct ; Go connect somewhere 28626 003343'01 endif. ; End case DECnet MCB terminal 28627 28628 003343'01 334 01 0 00 000000# ermsg% (,r) 28629 003344'01 254 00 0 00 003350' 28630 003345'01 202 01 0 00 002740* 28631 003346'01 104 00 0 00 000313 28632 003347'01 254 00 0 00 002671* 28633 000137'03 000000000000# 28634 001507'04 113 105 122 115 111 28635 28636 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 46 K20NET MAC 4-Apr-23 00:43 Open a psuedo terminal connection 28637 subttl Open a psuedo terminal connection 28638 28639 003350'01 opnpty: remark ;These are already saved 28640 003350'01 260 17 0 00 001056' call asipty ; First, assign a PTY 28641 003351'01 263 17 0 00 000000 ret ; Unless we couldn't ... 28642 003352'01 476 00 0 00 003070* setom local ; We're the local Kermit 28643 28644 003353'01 120 05 0 00 000001 dmove q1, t1 ; Load terminal line and PTY designator 28645 003354'01 202 01 0 00 003067* movem t1,ttynum ; Store associated line number 28646 003355'01 202 02 0 00 000000# movem t2,ptydev ; Store assigned PTY designator 28647 003356'01 201 03 0 00 000010 movei t3, TOPS20 ; On a pseudo-terminal (I.E., a loopback) 28648 003357'01 200 04 0 03 000763' move t4, hsttyp(t3) ; Load OWGP to OS type string 28649 003360'01 124 03 0 00 000000# dmovem t3, nrtros ; The 'remote' OS is always Tops-20... 28650 28651 remark asgflg ; asipty sets the assigned flag 28652 remark asgdev ; Ditto the assigned device 28653 remark ptyflg ; Ditto pty and bin flags 28654 003361'01 402 00 0 00 002642* setzm flow ; Don't do control flow (although works) 28655 28656 003362'01 402 00 0 00 003336* setzm netjfn ; No network JFN, yet 28657 dmove t1, [ gj%sht!gj%flg ; Want flags 28658 003363'01 120 01 0 00 005477' -1,,ptynam ] ; asipty built this for us 28659 003364'01 104 00 0 00 000020 GTJFN% ; Try to open it 28660 003365'01 320 12 0 00 003367' ifje. r ; Catch the error 28661 003366'01 254 00 0 00 003401' 28662 003367'01 200 04 0 00 000001 move t4, t1 ; Record for debugger 28663 003370'01 334 00 0 00 000000 %ermsg (,) ; Bizarre, we just got the device 28664 003371'01 254 00 0 00 003375' 28665 003372'01 265 01 0 00 003160* 28666 003373'01 000000000000# 28667 003374'01 254 00 0 00 003375' 28668 001522'04 103 141 156 047 164 28669 003375'01 200 01 0 00 000006 move t1, q2 ; Load assigned designator 28670 003376'01 260 17 0 00 003447' call deadev ; Go deasign the device 28671 003377'01 263 17 0 00 000000 ret ; Return failure 28672 003400'01 254 00 0 00 003404' else. ; Otherwise worked 28673 003401'01 552 01 0 00 003362* hrrzm t1, netjfn ; Save as network JFN 28674 003402'01 512 01 0 00 000316* hllzm t1, netflg ; Ditto the flags (just in case) 28675 003403'01 200 11 0 00 000001 move q5, t1 ; Save a copy for recovery 28676 003404'01 endif. ; End case JSYS failure 28677 28678 003404'01 621 01 0 00 777777 tlz t1,-1 ; Whack flags them so OPENF% doesn't choke 28679 003405'01 200 02 0 00 005501' movx t2, fld(8,of%bsz)!of%wr!of%rd ; 8-bit bytes, read & write access. 28680 003406'01 104 00 0 00 000021 OPENF% ; Open the device. 28681 003407'01 320 12 0 00 003411' ifje. r ; Catch the error 28682 003410'01 254 00 0 00 003421' 28683 003411'01 200 04 0 00 000001 move t4, t1 ; Record for debugger 28684 003412'01 334 00 0 00 000000 %ermsg (,) ; Bizarre, we just got the device 28685 003413'01 254 00 0 00 003417' 28686 003414'01 265 01 0 00 003372* 28687 003415'01 000000000000# 28688 003416'01 254 00 0 00 003417' 28689 001527'04 103 157 165 154 144 28690 003417'01 550 01 0 00 000011 hrrz t1, q5 ; Load the JFN, sans flags 28691 003420'01 254 00 0 00 002673' callret clsjfn ; Call JFN and device clean up and scrub k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 46-1 K20NET MAC 4-Apr-23 00:43 Open a psuedo terminal connection 28692 003421'01 endif. ; End case JSYS results handling 28693 ;[223] Find out about the associated terminal 28694 003421'01 200 01 0 00 000005 move t1, q1 ;[223] Load the terminal line 28695 003422'01 660 01 0 00 400000 txo t1, .ttdes ;[223] Turn it into a terminal designator 28696 003423'01 260 17 0 00 004625' call gndpar ;[223] Go find out about the parity 28697 003424'01 400 02 0 00 000000 setz t2, ;[223] Failed somehow, so no parity 28698 003425'01 606 02 0 00 000001 ifxn. t2, gd%par ;[223] Will it tolerate parity?? 28699 003426'01 254 00 0 00 003431' 28700 003427'01 476 00 0 00 000000# setom opnpar ;[223] It will 28701 003430'01 254 00 0 00 003432' else. ;[223] ...Otherwise... 28702 003431'01 402 00 0 00 000000# setzm opnpar ;[223] It won't 28703 003432'01 endif. ;[223] 28704 28705 003432'01 550 01 0 00 000011 hrrz t1, q5 ;[223] Load the PTY JFN, sans flags 28706 003433'01 201 02 0 00 000003 movei t2, .chcnc ;[186] PTY *must* have a ^C to get going 28707 003434'01 260 17 0 00 001601' call BOUTR% ;[186] Push it out, either way 28708 003435'01 334 00 0 00 000000 %ermsg (,r) ;[186] 28709 003436'01 254 00 0 00 003442' 28710 003437'01 265 01 0 00 003414* 28711 003440'01 000000000000# 28712 003441'01 254 00 0 00 003347* 28713 001534'04 106 151 162 163 164 28714 28715 003442'01 200 02 0 00 000006 move t2, q2 ; Load PTY device designator 28716 003443'01 201 03 0 00 000013 movei t3, .dvpty ; Opened a pseudo-terminal 28717 003444'01 202 03 0 00 000000# movem t3, opndev ; Store opened device type 28718 003445'01 476 00 0 00 003060* setom vtermf ; Set the virtual terminal flag 28719 003446'01 254 00 0 00 003337* retskp ; Won!! 28720 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 47 K20NET MAC 4-Apr-23 00:43 Used to deassign anything during opening failure 28721 subttl Used to deassign anything during opening failure 28722 28723 003447'01 104 00 0 00 000117 deadev: DVCHR% ; Pull the device characteristics 28724 003450'01 320 12 0 00 003053' erjmpr clscln ; Ignore error and scrub storage 28725 003451'01 120 06 0 00 000001 dmove q2, t1 ; Position designator and characteristics 28726 003452'01 200 10 0 00 000003 move q4, t3 ; Where clsarg wants them 28727 003453'01 254 00 0 00 003007' callret clsasg ; Go hand off to release device and scrub 28728 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 48 K20NET MAC 4-Apr-23 00:43 Open a physical line 28729 subttl Open a physical line 28730 28731 ; Assumes q1 has an (octal) line number 28732 28733 003454'01 265 16 0 00 005502' opntty: saveac ;[223] For a copy of the JFN 28734 003455'01 550 01 0 00 000005 hrrz t1, q1 ; Load the unit number (the terminal line) 28735 003456'01 312 01 0 00 003066* came t1, mytty ; Is it us? 28736 003457'01 254 00 0 00 003467' ifskp. ; Yes, LOGIN% or CRJOB% assigned it 28737 003460'01 402 00 0 00 003053* setzm asgflg ; Not assigned 28738 003461'01 402 00 0 00 003054* setzm asgdev ; So get rid of artifacts 28739 003462'01 402 00 0 00 000000# setzm ttydev ; all of them 28740 003463'01 550 02 0 00 000005 hrrz t2, q1 ; Begin build for DEVST% 28741 003464'01 505 02 0 00 600012 hrli t2, .dvdes!.dvtty ;Turn into a device designator 28742 003465'01 200 06 0 00 000002 move q2, t2 ; Save that, just in case 28743 003466'01 254 00 0 00 003513' jrst gttyjf ; Now go get a TTY JFN 28744 003467'01 endif. 28745 28746 003467'01 505 01 0 00 600012 hrli t1, .dvdes!.dvtty ; Turn into a device designator 28747 003470'01 200 06 0 00 000001 move q2, t1 ; Save that for later 28748 003471'01 621 01 0 00 777777 tlz t1, -1 ; Shut them back off for NTINF% 28749 003472'01 311 01 0 00 000000# caml t1, pty1st ; Into virtual range? 28750 003473'01 334 01 0 00 000000# ermsg% (, clscln) 28751 003474'01 254 00 0 00 003500' 28752 003475'01 202 01 0 00 003345* 28753 003476'01 104 00 0 00 000313 28754 003477'01 254 00 0 00 003053' 28755 000140'03 000000000000# 28756 001542'04 113 105 122 115 111 28757 28758 003500'01 200 01 0 00 000006 move t1, q2 ; Load final requested device 28759 003501'01 104 00 0 00 000070 ASND% ; Assign it, so no possible login 28760 003502'01 320 12 0 00 003504' %jserr (,clscln) 28761 003503'01 254 00 0 00 003507' 28762 003504'01 265 01 0 00 003437* 28763 003505'01 000000000000# 28764 003506'01 254 00 0 00 003053' 28765 001552'04 103 157 165 154 144 28766 003507'01 350 00 0 00 003460* aos asgflg ; Flag we have a terminal assigned 28767 003510'01 202 01 0 00 003461* movem t1, asgdev ; Store global 28768 003511'01 202 01 0 00 000000# movem t1, ttydev ; Store as terminal device designator 28769 003512'01 200 02 0 00 000001 move t2, t1 ; Position for DEVST% 28770 28771 003513'01 350 00 0 00 000000# gttyjf: aos ttyflg ; At this point, commiting to the open 28772 003514'01 561 01 0 00 000000# hrroi t1,ttynam ; Point to area to write TTY specification 28773 003515'01 552 02 0 00 003354* hrrzm t2, ttynum ; Store as foreign terminal 28774 003516'01 104 00 0 00 000121 DEVST% ; Turn device into string 28775 003517'01 320 12 0 00 003521' %jserr (,deadev) 28776 003520'01 254 00 0 00 003524' 28777 003521'01 265 01 0 00 003504* 28778 003522'01 000000000000# 28779 003523'01 254 00 0 00 003447' 28780 001561'04 103 157 165 154 144 28781 003524'01 201 02 0 00 000072 movei t2,":" ; Load terminating device punctuation 28782 003525'01 136 02 0 00 000001 idpb t2,t1 ; Complete device syntax 28783 003526'01 400 02 0 00 000000 setz t2, ; Load .chnul k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 48-1 K20NET MAC 4-Apr-23 00:43 Open a physical line 28784 003527'01 136 02 0 00 000001 idpb t2,t1 ; Tie off the string 28785 28786 003530'01 402 00 0 00 003401* setzm netjfn ; No network JFN, yet 28787 dmove t1, [ gj%sht!gj%flg ; Want flags 28788 003531'01 120 01 0 00 005510' -1,,ttynam ] ; asipty built this for us 28789 003532'01 104 00 0 00 000020 GTJFN% ; Try to open it 28790 003533'01 320 12 0 00 003535' ifje. r ; Catch the error 28791 003534'01 254 00 0 00 003547' 28792 003535'01 200 04 0 00 000001 move t4, t1 ; Record for debugger 28793 003536'01 334 00 0 00 000000 %ermsg (,) ; Bizarre, we just got the device 28794 003537'01 254 00 0 00 003543' 28795 003540'01 265 01 0 00 003521* 28796 003541'01 000000000000# 28797 003542'01 254 00 0 00 003543' 28798 001570'04 103 141 156 047 164 28799 003543'01 200 01 0 00 000006 move t1, q2 ; Load assigned designator 28800 003544'01 260 17 0 00 003447' call deadev ; Go deasign the device 28801 003545'01 263 17 0 00 000000 ret ; Return failure 28802 003546'01 254 00 0 00 003552' else. ; Otherwise, worked 28803 003547'01 552 01 0 00 003530* hrrzm t1, netjfn ; Save as network JFN 28804 003550'01 512 01 0 00 003402* hllzm t1, netflg ; Ditto the flags (just in case) 28805 003551'01 200 11 0 00 000001 move q5, t1 ;[223] Save a copy for recovery 28806 003552'01 endif. ; End case JSYS failure 28807 28808 remark 8-bit bytes, image mode, read & write access. 28809 003552'01 200 02 0 00 005512' movx t2, fld(8,of%bsz)!fld(.gsimg,of%mod)!of%wr!of%rd 28810 003553'01 621 01 0 00 777777 tlz t1,-1 ; Whack flags them so OPENF% doesn't choke 28811 003554'01 104 00 0 00 000021 OPENF% ; Open the device. 28812 003555'01 320 12 0 00 003557' ifje. r ; Catch the error 28813 003556'01 254 00 0 00 003567' 28814 003557'01 200 04 0 00 000001 move t4, t1 ; Record for debugger 28815 003560'01 334 00 0 00 000000 %ermsg (,) ; Bizarre, we just got the device 28816 003561'01 254 00 0 00 003565' 28817 003562'01 265 01 0 00 003540* 28818 003563'01 000000000000# 28819 003564'01 254 00 0 00 003565' 28820 001575'04 103 157 165 154 144 28821 003565'01 200 01 0 00 000003 move t1, t3 ; Load the JFN 28822 003566'01 254 00 0 00 002673' callret clsjfn ; Call JFN and device clean up and scrub 28823 003567'01 endif. ; End case JSYS failure 28824 28825 003567'01 200 01 0 00 000011 move t1, q5 ;[223] Load terminal JFN and flags 28826 003570'01 260 17 0 00 004625' call gndpar ;[223] Go find out about the parity 28827 003571'01 400 02 0 00 000000 setz t2, ;[223] Failed somehow, so no parity 28828 003572'01 606 02 0 00 000001 ifxn. t2, gd%par ;[223] Will it tolerate parity?? 28829 003573'01 254 00 0 00 003576' 28830 003574'01 476 00 0 00 000000# setom opnpar ;[223] It will 28831 003575'01 254 00 0 00 003577' else. ;[223] ...Otherwise... 28832 003576'01 402 00 0 00 000000# setzm opnpar ;[223] It won't 28833 003577'01 endif. ;[223] End case parity discovery 28834 28835 003577'01 550 01 0 00 000011 hrrz t1, q5 ;[223] Load just the JFN 28836 003600'01 550 04 0 00 000005 hrrz t4, q1 ; Load the unit number again 28837 003601'01 312 04 0 00 003456* came t4, mytty ; Is it us? 28838 003602'01 254 00 0 00 003605' ifskp. ; Yes, then don't do a few things k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 48-2 K20NET MAC 4-Apr-23 00:43 Open a physical line 28839 003603'01 402 00 0 00 003352* setzm local ; Mark us as remote 28840 003604'01 254 00 0 00 003615' else. ; Otherwise, we are going places 28841 003605'01 476 00 0 00 003603* setom local ; We're the local Kermit 28842 003606'01 201 02 0 00 000015 movei t2, .chcrt ; Send a CR down the line to get things going. 28843 003607'01 260 17 0 00 001601' call BOUTR% ; Get it going 28844 003610'01 334 00 0 00 000000 %ermsg (,r) ;[186] 28845 003611'01 254 00 0 00 003615' 28846 003612'01 265 01 0 00 003562* 28847 003613'01 000000000000# 28848 003614'01 254 00 0 00 003441* 28849 001602'04 106 151 162 163 164 28850 003615'01 endif. 28851 28852 remark t1, netjfn ;[223] Still has JFN 28853 003615'01 200 02 0 00 000006 move t2, q2 ; Load TTY device designator 28854 003616'01 201 03 0 00 000012 movei t3, .dvtty ; Opened a terminal 28855 003617'01 202 03 0 00 000000# movem t3, opndev ; Store opened device type 28856 003620'01 402 00 0 00 003445* setzm vtermf ; Clear the virtual terminal flag 28857 003621'01 254 00 0 00 003446* retskp ; Won!! 28858 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 49 K20NET MAC 4-Apr-23 00:43 Check the line whose JFN is in t1. 28859 subttl Check the line whose JFN is in t1. 28860 28861 ; Set flags MDMLIN if line is remote, CARIER if line has carrier up. 28862 ; SPEED is set to a nonnegative number if known, -1 otherwise. 28863 ; 28864 ; Returns +1 always, with t1 unchanged, t2-t4 modified. 28865 28866 003622'01 chklin: entry chklin ;[186] Identify location for LINK 28867 extern mdmlin,speed,carier ;[186] And of everyone's necessaries 28868 28869 003622'01 265 16 0 00 005513' saveac ; Save the JFN!!! 28870 28871 003623'01 402 00 0 00 002206* setzm mdmlin ;[186] Assume line not modem-controlled. 28872 003624'01 402 00 0 00 002211* setzm carier ;[186] And no carrier 28873 003625'01 476 00 0 00 000000* setom speed ;[186] Assume speed is unknown 28874 28875 003626'01 553 04 0 00 000001 hrrzs t4, t1 ;[186] Save the JFN, sans flags 28876 003627'01 306 01 0 00 377777 cain t1, .nulio ;[186] Wants to talk with nobody? 28877 003630'01 263 17 0 00 000000 ret ;[186] That's never online 28878 003631'01 260 17 0 00 004000' call chkljf ;[186] Check basic JFN health 28879 003632'01 263 17 0 00 000000 ret ;[186] It's sick, somehow 28880 28881 003633'01 200 01 0 00 000004 move t1, t4 ;[186] restore jfn's rightful place 28882 003634'01 104 00 0 00 000117 dvchr% ;[186] get the device characteristics 28883 003635'01 320 12 0 00 003637' ifje. r ;[186] failed?? 28884 003636'01 254 00 0 00 003645' 28885 003637'01 200 04 0 00 000001 move t4, t1 ;[186] retrieve and return error code 28886 003640'01 334 00 0 00 000000 %ermsg(,r) 28887 003641'01 254 00 0 00 003645' 28888 003642'01 265 01 0 00 003612* 28889 003643'01 000000000000# 28890 003644'01 254 00 0 00 003614* 28891 001610'04 165 156 141 142 154 28892 003645'01 endif. ;[186] get out of here, nothing further to do 28893 28894 003645'01 250 01 0 00 000004 exch t1, t4 ;[186] Get the JFN back, save device 28895 003646'01 135 03 0 00 005255' ldb t3,[pointr t2,dv%typ] ;[186] Pick up a device type 28896 28897 003647'01 306 03 0 00 000022 cain t3, .dvdcn ;[186] Is this an NRT? 28898 003650'01 254 00 0 00 003755' jrst chkdcn ;[186] Then can't "Read Speed" 28899 003651'01 306 03 0 00 000013 cain t3, .dvpty ;[186] pseudo-terminal? 28900 003652'01 254 00 0 00 003767' jrst chkpty ;[186] Can't check terminal through the PTY 28901 003653'01 306 03 0 00 000012 cain t3, .dvtty ;[186] A terminal?? 28902 003654'01 254 00 0 00 003662' jrst chktty ;[186] Yes, go handle a physical line 28903 remark t3, .dvpip ;[186] A pipe? (a place holder) 28904 remark chkpip ;[186] Yes, go handle that 28905 ;[186] Otherwise, failure 28906 003655'01 334 01 0 00 000000# ermsg% (,r) 28907 003656'01 254 00 0 00 003662' 28908 003657'01 202 01 0 00 003475* 28909 003660'01 104 00 0 00 000313 28910 003661'01 254 00 0 00 003644* 28911 000141'03 000000000000# 28912 001621'04 113 105 122 115 111 28913 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 49-1 K20NET MAC 4-Apr-23 00:43 Check the line whose JFN is in t1. 28914 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 50 K20NET MAC 4-Apr-23 00:43 Case of physical line (on a DH or DL) or controlling line 28915 subttl Case of physical line (on a DH or DL) or controlling line 28916 28917 003662'01 chktty: extern setspd, monv ;[186] Physical line additional necessaries 28918 003662'01 250 04 0 00 000001 exch t4, t1 ;[208] Save the JFN, restore device 28919 remark t1, JFN ;[186] Still has terminal JFN 28920 003663'01 260 17 0 00 004025' call ntidev ;[208] Find out about it 28921 003664'01 254 00 0 00 003670' ifskp. ;[208] Worked 28922 003665'01 265 16 0 00 005213' saveac ;[208] Save for getnti results 28923 003666'01 120 05 0 00 000001 dmove q1, t1 ;[208] So save the results 28924 003667'01 254 00 0 00 003675' else. ;[208] Otherwise gronked. Sad... 28925 003670'01 334 00 0 00 000000 %ermsg (,r) 28926 003671'01 254 00 0 00 003675' 28927 003672'01 265 01 0 00 003642* 28928 003673'01 000000000000# 28929 003674'01 254 00 0 00 003661* 28930 001637'04 125 156 141 142 154 28931 003675'01 endif. ;[208] 28932 28933 003675'01 415 16 0 00 003705' block. ;[208] Enter block context for better control flow 28934 003676'01 261 17 0 00 000016 28935 003677'01 302 05 0 00 000000 caie q1, nw%nnt ;[208] Not a network terminal? 28936 003700'01 263 17 0 00 000000 ret ;[208] It is a network tty, so this makes no sense 28937 003701'01 302 06 0 00 000001 caie q2, nw%fe ;[208] DL or DH? (front end terminal) 28938 003702'01 263 17 0 00 000000 ret ;[208] No, so these won't make sense 28939 003703'01 254 00 0 00 003621* retskp ;[208] Exit block, +2; physical line 28940 003704'01 263 17 0 00 000000 endbk. ;[208] End block. lexical context 28941 003705'01 254 00 0 00 003710' ifskp. ;[208] Real hardware!! 28942 003706'01 200 01 0 00 000004 move t1, t4 ;[208] Restore the original JFN 28943 003707'01 254 00 0 00 003711' else. ;[208] Otherwise, a 'soft' terminal 28944 remark carier ;[208] Go with chkljf's GTSTS% result 28945 003710'01 263 17 0 00 000000 ret ;[208] and done 28946 003711'01 endif. 28947 28948 003711'01 201 02 0 00 000027 movei t2, .morsp ; "Read Speed" 28949 003712'01 104 00 0 00 000077 MTOPR ; Flag bits are returned in LH(T2) 28950 003713'01 320 12 0 00 003715' ifje. r ;[186] Unless it FAILS 28951 003714'01 254 00 0 00 003723' 28952 003715'01 200 04 0 00 000001 move t4, t1 ;[186] Save the error, could be useful 28953 003716'01 334 00 0 00 000000 %ermsg(,r) 28954 003717'01 254 00 0 00 003723' 28955 003720'01 265 01 0 00 003672* 28956 003721'01 000000000000# 28957 003722'01 254 00 0 00 003674* 28958 001650'04 125 156 141 142 154 28959 003723'01 endif. ;[186] Don't try to process junk--leave 28960 28961 003723'01 573 00 0 00 000003 hrres t3 ; No split speed. 28962 003724'01 321 02 0 00 003731' ifxe. t2, mo%rmt ;[194] Is carrier valid? 28963 003725'01 202 03 0 00 003625* movem t3, speed ; No, it's local, so speed is valid. 28964 003726'01 476 00 0 00 003624* setom carier ; Say local always has carrier 28965 003727'01 263 17 0 00 000000 ret ; Don't have to worry about carrier. 28966 003730'01 254 00 0 00 003732' else. ;[194] Otherwise line is a real dial up 28967 003731'01 476 00 0 00 003623* setom mdmlin ; Yes, flag for SHOW LINE, etc. 28968 003732'01 endif. ;[194] 28969 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 50-1 K20NET MAC 4-Apr-23 00:43 Case of physical line (on a DH or DL) or controlling line 28970 003732'01 332 00 0 00 000000* ifme. setspd ;[161] Was speed NOT explicitly SET for this line? 28971 003733'01 254 00 0 00 003743' 28972 003734'01 336 00 0 00 000000* ifmn. monv ;[194] TOPS-20 V6 or later? 28973 003735'01 254 00 0 00 003740' 28974 003736'01 202 03 0 00 003725* movem t3, speed ; Yes, so we can believe the speed. 28975 003737'01 254 00 0 00 003743' else. ;[194] Otherwise, some kind of geeser (or KS) 28976 003740'01 312 03 0 00 003736* came t3, speed ; Pre-V6. Does this agree with what was set? 28977 003741'01 474 03 0 00 000000 seto t3, ; No, so we don't really know the speed. 28978 003742'01 202 03 0 00 003740* movem t3, speed ; Save the speed or else -1 for don't know. 28979 003743'01 endif. ;[194] 28980 003743'01 endif. ;[194] 28981 28982 003743'01 403 02 0 00 003726* setzb t2, carier ; See if we have carrier. 28983 003744'01 104 00 0 00 000107 RFMOD ; Get mode word. 28984 003745'01 320 12 0 00 003747' %jserr(,r) ;[186] 28985 003746'01 254 00 0 00 003752' 28986 003747'01 265 01 0 00 003720* 28987 003750'01 000000000000# 28988 003751'01 254 00 0 00 003722* 28989 001656'04 125 156 141 142 154 28990 003752'01 602 02 0 00 000001 txne t2, tt%car ; Carrier? 28991 003753'01 476 00 0 00 003743* setom carier ; Yes. 28992 003754'01 263 17 0 00 000000 ret 28993 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 51 K20NET MAC 4-Apr-23 00:43 DECnet Network Remote Terminal Checking 28994 subttl DECnet Network Remote Terminal Checking 28995 28996 003755'01 chkdcn: remark t1, ; Has NRT JFN 28997 003755'01 201 02 0 00 000025 movx t2,.morls ; Function to read link status 28998 003756'01 104 00 0 00 000077 MTOPR% ; Do the status read 28999 003757'01 320 12 0 00 000544' erjmpr decerr ; Handle error, getting it in t1 29000 003760'01 603 03 0 00 002000 txne t3,mo%int ; Any interrupt message goofyness? 29001 003761'01 260 17 0 00 001006' call intmsg ; Yes, handle this oddity 29002 003762'01 325 03 0 00 003765' ifxn. t3,mo%con ; Connected? 29003 003763'01 476 00 0 00 003753* setom carier ; Yes, everything is still fine 29004 003764'01 254 00 0 00 003766' else. ; Otherwise, the party is OVER 29005 003765'01 402 00 0 00 003763* setzm carier ; So drop 'carrier' 29006 003766'01 endif. ; End case connection check 29007 003766'01 263 17 0 00 000000 ret ; Finally get out of here 29008 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 52 K20NET MAC 4-Apr-23 00:43 Pseudo-terminal status, a bit different 29009 subttl Pseudo-terminal status, a bit different 29010 29011 003767'01 chkpty: remark ; Case of PTY: device 29012 29013 repeat 0,< ; Apparently, this isn't true 29014 ifxe. q1, gs%eof ; On a PTY:, EOF is an error condition 29015 setzm carier ; So 'drop' carrier 29016 ret ; and get out of here 29017 else. ; Otherwise, might still be good 29018 setom carier ; So assume OK, for the moment 29019 endif. ; End case GTSTS% analysis for PTY 29020 > 29021 003767'01 336 01 0 00 000000# skipn t1, ttygtb ; Load GETAB% table length and number 29022 003770'01 263 17 0 00 000000 ret ; Unless there is none... 29023 003771'01 504 01 0 00 000000# hrl t1, ptytty ; Load PTY's associated terminal line 29024 003772'01 621 01 0 00 400000 tlz t1, .ttdes ; Just in case (shouldn't be on) 29025 003773'01 104 00 0 00 000010 GETAB% ; Get associated job and 'hunger' 29026 003774'01 320 12 0 00 003751* erjmpr r ; Get and ignore error, returning 29027 003775'01 325 01 0 00 003774* jumpge t1, r ; Still connected? Just return 29028 29029 003776'01 402 00 0 00 003765* setzm carier ; No job there anymore, so 'drop' carrier 29030 003777'01 263 17 0 00 000000 ret ; And get out of here 29031 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 53 K20NET MAC 4-Apr-23 00:43 Check Line JFN 29032 subttl Check Line JFN 29033 29034 ; Call t1/ JFN 29035 ; 29036 ; +1 / JFN is unhealthy in some way 29037 ; +2 / JFN works and is not in error, q1 has GTSTS result 29038 ; 29039 ; Sets 'carier' accordingly 29040 29041 004000'01 265 16 0 00 005523' chkljf: saveac ; Basic JFN health 29042 29043 004001'01 104 00 0 00 000024 GTSTS% ; Get the status of whatever it is 29044 004002'01 320 12 0 00 004004' ifje. r ; Failed?? 29045 004003'01 254 00 0 00 004014' 29046 004004'01 200 04 0 00 000001 move t4, t1 ; Save code for debuggers 29047 004005'01 403 02 0 00 000005 setzb t2, q1 ; Assume we have no carrier. 29048 004006'01 334 00 0 00 000000 %ermsg(,r) 29049 004007'01 254 00 0 00 004013' 29050 004010'01 265 01 0 00 003747* 29051 004011'01 000000000000# 29052 004012'01 254 00 0 00 003775* 29053 001664'04 125 156 141 142 154 29054 004013'01 254 00 0 00 004015' else. ; Otherwise, worked 29055 004014'01 200 05 0 00 000002 move q1, t2 ; So save the JFN's status 29056 004015'01 endif. 29057 29058 004015'01 641 02 0 00 400200 txc t2, gs%nam!gs%opn ; Complement the required bits 29059 004016'01 643 02 0 00 400200 txce t2, gs%nam!gs%opn ; Is it any good at and is it open? 29060 004017'01 263 17 0 00 000000 ret ; No, then there is certainly no carrier 29061 004020'01 603 02 0 00 000400 txne t2,gs%err ; Any kind of error? 29062 004021'01 263 17 0 00 000000 ret ; Yes, we're done 29063 004022'01 476 00 0 00 003776* setom carier ; Groovy, let's say we have 'carrier' 29064 004023'01 254 00 0 00 003703* retskp ; Finally get out of here 29065 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 54 K20NET MAC 4-Apr-23 00:43 Get Network Terminal Information 29066 subttl Get Network Terminal Information 29067 29068 ; NTINF%, which was introduced in 6.0 series Tops-20 and is now known 29069 ; to work in 7.0 series PANDA monitor and XKL. I believe there are 29070 ; also standard patches to the DEC monitor to make it work. 29071 ; 29072 ; Wants a terminal designator in t1 29073 ; 29074 ; Question: does this break for a PIP: JFN? Should it? 29075 ; 29076 ; +1 t1/ Last error code 29077 ; +2 t1/ Line Network Type (zero if not network) 29078 ; t2/ Line Terminal type or protocol 29079 29080 004024'01 getnti: entry getnti ;[194] Inform LINK of our location 29081 004024'01 660 01 0 00 400000 txo t1, .ttdes ;[186] Convert line to a device designator 29082 004025'01 ntidev: remark ;[208] Alternate entry if called with a device id 29083 004025'01 202 01 0 00 000000# movem t1 ,ntiblk+.NWLIN ;[182] Store requested terminal 29084 004026'01 120 01 0 00 005531' dmove t1,[exp ntblen,.NWRRH] ;[182] Requesting remote host information 29085 004027'01 124 01 0 00 000000# dmovem t1,ntiblk+.NWABC ;[182] Store length and request type 29086 004030'01 561 01 0 00 000000# hrroi t1, ntihst ;[186] Point to host area 29087 004031'01 202 01 0 00 000000# movem t1, ntiblk+.NWNNP ;[182] return remote host information 29088 29089 004032'01 403 01 0 00 000002 setzb t1, t2 ;[182] Everything else is zero 29090 004033'01 202 01 0 00 000000* movem t1, tvtflg ;[182] Assume not on a TVT 29091 004034'01 124 01 0 00 000000# dmovem t1, ntihst ;[186] Stomp 20 character DECnet node 29092 004035'01 124 01 0 00 000000# dmovem t1, ntihst+2 ;[186] name (which is impossible) 29093 004036'01 124 01 0 00 000000# dmovem t1,ntiblk+.NWTTF ;[186] Stomp terminal type and flags 29094 004037'01 402 00 0 00 000000# setzm ntiblk+.nwnu1 ;[186] and the node number 29095 29096 004040'01 201 01 0 00 000000# movei t1, ntiblk ;[182] Load the address of the argument block 29097 004041'01 104 00 0 00 000632 NTINF% ;[182] finally try to see out what's going on 29098 004042'01 320 12 0 00 004044' %jserr (,r) ;[186] Phooey, return +1 29099 004043'01 254 00 0 00 004047' 29100 004044'01 265 01 0 00 004010* 29101 004045'01 000000000000# 29102 004046'01 254 00 0 00 004012* 29103 001674'04 116 124 111 116 106 29104 ;[182] Load network type and line type 29105 004047'01 135 01 0 00 005533' ldb t1,[POINTR(,nttype)] 29106 004050'01 135 02 0 00 005534' ldb t2,[POINTR(,ntline)] 29107 004051'01 254 00 0 00 004023* retskp ;[186] Won! 29108 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 55 K20NET MAC 4-Apr-23 00:43 chktvt - check to see if we are using a TVT line 29109 subttl chktvt - check to see if we are using a TVT line 29110 29111 ; We use NTINF% (see above) when the user sets TVT-Binary mode to 29112 ; automatic which is an additional keyword (used to be just on or 29113 ; off). Automatic is the default, but we still allow overide. 29114 ; 29115 ; If the NTINF% fails, then we try recover by using STAT% to 29116 ; indentify whether the line is in the range of TVT's. This should 29117 ; work on any ARPAnet monitor with TCP support; MRC noted that the 29118 ; monitor "requires STAT% to be there" 29119 ; 29120 ; PANDA monitor verified to have 400000,,RSKP in NVTDOD (see [129]) 29121 ; 29122 ; Call: nothing passed 29123 ; 29124 ; Checks to see whether we are in automatic mode and if so, we 29125 ; execute the determination code in some form. Otherwise, we 29126 ; are in override mode and we skip any checks. 29127 ; 29128 ; Return: +1, always (although may complain about Jsyi errors) 29129 ; 29130 ; tvtflg may be side-effected by our (possible lack of) discovery 29131 29132 004052'01 chktvt: entry chktvt ;[194] Inform LINK of our location 29133 extern tvtchk, tvtflg ;[194] And of our necessaries 29134 004052'01 336 00 0 00 000000* skipn tvtchk ;[182] Are we supposed to figure out if TVT? 29135 004053'01 263 17 0 00 000000 ret ;[182] No, so skip all this cruft 29136 29137 004054'01 402 00 0 00 004033* setzm tvtflg ;[194] Stompt TVT flag because not known, yet 29138 004055'01 260 17 0 00 004024' call getnti ;[186] Get network terminal information 29139 004056'01 254 00 0 00 004064' jrst bbntvt ;[186] Try it the old fashioned way 29140 004057'01 306 01 0 00 000001 cain t1, NW%TCP ;[182] Is the network type NOT TCP? 29141 004060'01 302 02 0 00 000004 caie t2, NW%TV ;[182] or is this NOT a TVT? 29142 004061'01 263 17 0 00 000000 ret ;[182] Leave line set as not a TVT 29143 004062'01 350 00 0 00 004054* aos tvtflg ;[182] Okay, set TVT-BInary to ON 29144 004063'01 263 17 0 00 000000 ret ;[182] 29145 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 56 K20NET MAC 4-Apr-23 00:43 Check for TVT line using BBN interface 29146 subttl Check for TVT line using BBN interface 29147 29148 ; The following code is not used because a BBN TCP jsys is called. 29149 ; It is fall-back because NTINF% is preferred. However, it should 29150 ; always work, no matter the monitor version. 29151 ; 29152 ; [129] Largely adapted from MODEM.MAC 29153 29154 004064'01 bbntvt: extern ttynum ;[194] Inform LINK of our necessary 29155 004064'01 205 01 0 00 000040 movx t1, tcp%nt ;[129] Want aobjn ptr for tvts 29156 004065'01 104 00 0 00 000745 STAT% ;[129] Get it 29157 004066'01 320 12 0 00 004070' %jserr (,r) ;[182] Just give up 29158 004067'01 254 00 0 00 004073' 29159 004070'01 265 01 0 00 004044* 29160 004071'01 000000000000# 29161 004072'01 254 00 0 00 004046* 29162 001677'04 123 124 101 124 040 29163 004073'01 550 03 0 00 003515* hrrz t3, ttynum ;[129] TTY line we're useing 29164 004074'01 550 01 0 00 000002 hrrz t1, t2 ;[129] Get first TVT 29165 004075'01 315 03 0 00 000001 camge t3, t1 ;[129] Are we less than the firsT? 29166 004076'01 263 17 0 00 000000 ret ;[182] Yes 29167 004077'01 577 00 0 00 000002 hlres t2 ;[129] Calculate last TVT 29168 004100'01 274 01 0 00 000002 sub t1, t2 ;[129] ... 29169 004101'01 275 01 0 00 000001 subi t1, 1 ;[129] ... 29170 004102'01 317 03 0 00 000001 camg t3, t1 ;[129] Are we .le. last TVT? 29171 004103'01 350 00 0 00 004062* aos tvtflg ;[182] Yes, flag for later 29172 004104'01 263 17 0 00 000000 ret ;[182] 29173 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 57 K20NET MAC 4-Apr-23 00:43 Line routines 29174 subttl Line routines 29175 29176 ;[190] all moved from K20MIT to reduce its size 29177 29178 ; INILIN -- Initialize the communication line for file transfer. 29179 ; 29180 004105'01 inilin: entry inilin ;[220] Used in k20srv, too 29181 004105'01 332 00 0 00 000000# skipe inited ;[177] Already init'd? Don't do it again. 29182 004106'01 263 17 0 00 000000 ret ;[177] 29183 29184 ; Set all the terminal mode bits for transparent i/o. 29185 29186 004107'01 332 00 0 00 003620* inil2: ifme. vtermf ;[186] Physical line? 29187 004110'01 254 00 0 00 004114' 29188 004111'01 260 17 0 00 004120' call dobits ; Go do the bits. 29189 004112'01 263 17 0 00 000000 ret ; Pass along any failures. 29190 004113'01 260 17 0 00 004354' call doarpa ; Set up any Arpanet stuff. 29191 004114'01 endif. 29192 29193 004114'01 260 17 0 00 002252' call clrbuf ;[194] Clear any NAK's 29194 004115'01 600 00 0 00 000000 nop ;[186] Ignore any errors 29195 004116'01 476 00 0 00 000000# setom inited ;[177] Flag we've done this. 29196 004117'01 263 17 0 00 000000 ret k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 58 K20NET MAC 4-Apr-23 00:43 Line routines 29197 29198 ; Set communication line bits for transparent i/o. 29199 ; Returns +1 on failure, +2 on success. 29200 29201 004120'01 dobits: entry dobits ;Used by k20ioc 29202 004120'01 265 16 0 00 005160' saveac ;[186] Used for device designator 29203 004121'01 332 05 0 00 003547* skipe q1, netjfn ;[186] Load the network JFN 29204 004122'01 254 00 0 00 004137' ifskp. ;[186] Unless we don't have one... 29205 004123'01 332 00 0 00 003605* skipe local ;[186] Are we remote? 29206 004124'01 334 01 0 00 000000# ermsg% (,r) ;[186] Just punt 29207 004125'01 254 00 0 00 004131' 29208 004126'01 202 01 0 00 003657* 29209 004127'01 104 00 0 00 000313 29210 004130'01 254 00 0 00 004072* 29211 000142'03 000000000000# 29212 001702'04 113 105 122 115 111 29213 29214 004131'01 336 05 0 00 002626* skipn q1, ttyjfn ;[186] Yes, so just use the terminal JFN 29215 004132'01 334 01 0 00 000000# ermsg% (,r) ;[186] 29216 004133'01 254 00 0 00 004137' 29217 004134'01 202 01 0 00 004126* 29218 004135'01 104 00 0 00 000313 29219 004136'01 254 00 0 00 004130* 29220 000143'03 000000000000# 29221 001716'04 113 105 122 115 111 29222 29223 004137'01 endif. ;[186] Hopefully have SOMETHING ... 29224 29225 004137'01 200 01 0 00 000005 move t1, q1 ;[186] ; JFN for connection to other system. 29226 004140'01 201 02 0 00 000035 movx t2, .mornt ; Read system message status. 29227 004141'01 104 00 0 00 000077 MTOPR 29228 004142'01 320 12 0 00 004144' %jserr (,dobit2) 29229 004143'01 254 00 0 00 004147' 29230 004144'01 265 01 0 00 004070* 29231 004145'01 000000 000000 29232 004146'01 254 00 0 00 004160' 29233 004147'01 202 03 0 00 000000# movem t3, sysmsg ; Save here for later restoral. 29234 004150'01 201 02 0 00 000034 movx t2, .mosnt ; Now refuse system messages. 29235 004151'01 201 03 0 00 000001 movx t3, .mosmn 29236 004152'01 104 00 0 00 000077 MTOPR 29237 004153'01 320 12 0 00 004155' %jserr (,dobit2) 29238 004154'01 254 00 0 00 004160' 29239 004155'01 265 01 0 00 004144* 29240 004156'01 000000 000000 29241 004157'01 254 00 0 00 004160' 29242 29243 004160'01 205 01 0 00 624000 dobit2: movx t1, ;[147] Clear/Refuse links, 29244 004161'01 540 01 0 00 004073* hrr t1, ttynum ;[147] on the line used for file transfer. 29245 004162'01 660 01 0 00 400000 txo t1, .ttdes ;[147] (TLINK wants a device designator.) 29246 004163'01 474 02 0 00 000000 seto t2, 29247 004164'01 104 00 0 00 000216 TLINK 29248 004165'01 320 16 0 00 004166' erjmp dobit3 ;[147] Ignore any failure. 29249 29250 004166'01 200 01 0 00 000005 dobit3: move t1, q1 ;[186] ; JFN for the file transfer line. 29251 004167'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 15:18 11-Jun-23 Page 58-1 K20NET MAC 4-Apr-23 00:43 Line routines 29252 004170'01 104 00 0 00 000077 MTOPR% 29253 004171'01 320 12 0 00 004173' %jserr (,r) 29254 004172'01 254 00 0 00 004176' 29255 004173'01 265 01 0 00 004155* 29256 004174'01 000000 000000 29257 004175'01 254 00 0 00 004136* 29258 004176'01 202 03 0 00 000000# movem t3, oldpau ; Save the old pause mode. 29259 004177'01 201 02 0 00 000043 movei t2, .moxof ; Now set to... 29260 004200'01 201 03 0 00 000000 movei t3, .mooff ; no pause on end. 29261 004201'01 104 00 0 00 000077 MTOPR% 29262 004202'01 320 12 0 00 004204' %jserr (,r) 29263 004203'01 254 00 0 00 004207' 29264 004204'01 265 01 0 00 004173* 29265 004205'01 000000 000000 29266 004206'01 254 00 0 00 004175* 29267 004207'01 201 02 0 00 000000# movei t2, olddim ;[185] Point to line block 29268 004210'01 260 17 0 00 000000* call savlnw ;[185] Save this JFN's length and width 29269 004211'01 104 00 0 00 000107 RFMOD% ; Get current mode for this line. 29270 004212'01 320 12 0 00 004214' %jserr (,r) 29271 004213'01 254 00 0 00 004217' 29272 004214'01 265 01 0 00 004204* 29273 004215'01 000000 000000 29274 004216'01 254 00 0 00 004206* 29275 004217'01 476 00 0 00 004022* setom carier 29276 004220'01 402 00 0 00 003731* setzm mdmlin ;[130] Assume line not modem-controlled. 29277 004221'01 602 02 0 00 000001 txne t2, tt%car ;[130] Is it? 29278 004222'01 476 00 0 00 004220* setom mdmlin ;[130] Yes, flag. 29279 004223'01 202 02 0 00 000000# movem t2, oldmod ; Save the present mode. 29280 29281 ;[97] Turn off undesired bits (program echoing, links, translation). 29282 ;[97] Turn on desired bits (full duplex; TTY has form feed, tab, lowercase). 29283 ;[97] Note that any other settings are left intact, in particular TT%ECM, which 29284 ;[97] can cause a TAC to do its own echoing if turned off. 29285 29286 004224'01 dobit4: ; No echo, no links, no advice, no data mode, full duplex. 29287 004224'01 620 02 0 00 005734 txz t2, ;[129] Add TT$DUM 29288 ; No wakeup stuff, infinite width & length. 29289 004225'01 630 02 0 00 005535' txz t2, ;[127] 29290 ; No formfeed/tab/case interpretation, use XON/XOFF. 29291 004226'01 670 02 0 00 005536' txo t2, ;[129] REMOVE TT%DUM!!! 29292 29293 004227'01 336 00 0 00 000000* skipn handsh ;[155] Doing handshake? 29294 004230'01 336 00 0 00 003361* skipn flow ;[155] Doing flow control? 29295 004231'01 620 02 0 00 000002 txz t2, tt%pgm ; Handshake, or no flow - don't do XON/XOFF. 29296 004232'01 104 00 0 00 000110 SFMOD% ; Set the bits. 29297 004233'01 320 12 0 00 004235' %jserr (,) 29298 004234'01 254 00 0 00 004240' 29299 004235'01 265 01 0 00 004214* 29300 004236'01 000000 000000 29301 004237'01 254 00 0 00 004240' 29302 004240'01 104 00 0 00 000217 STPAR% 29303 004241'01 320 12 0 00 004243' %jserr (,) 29304 004242'01 254 00 0 00 004246' 29305 004243'01 265 01 0 00 004235* 29306 004244'01 000000 000000 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 58-2 K20NET MAC 4-Apr-23 00:43 Line routines 29307 004245'01 254 00 0 00 004246' 29308 004246'01 254 00 0 00 004051* retskp k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 59 K20NET MAC 4-Apr-23 00:43 Line routines 29309 29310 ;[181] PANDA Network Binary Mode routines 29311 29312 panda < ;[181] Only if doing Panda 29313 29314 ;[181] Returns true if we have network binary mode MTOPR% 29315 ;[181] Preserves ACs, always returns +1, havnbm: is side-effected 29316 29317 004247'01 chknbm: entry chknbm ;[190] 29318 004247'01 265 16 0 00 005537' saveac ;[181] Save the registers that MTOPR% trashes 29319 004250'01 120 01 0 00 005551' dmove t1,[ exp .CTTRM,.MORLT ] ;[181] Read local status 29320 004251'01 104 00 0 00 000077 MTOPR% ;[181] Can the monitor process this request? 29321 004252'01 320 12 0 00 004254' ifje. r ;[194] No, assume this isn't in the monitor 29322 004253'01 254 00 0 00 004257' 29323 004254'01 402 00 0 00 000000# setzm havnbm ;[181] so don't try to use it 29324 004255'01 402 00 0 00 000000# setzm setlts ;[181] and never try to restore status 29325 004256'01 254 00 0 00 004260' else. ;[194] 29326 004257'01 476 00 0 00 000000# setom havnbm ;[181] Otherwise, we have winning 29327 004260'01 endif. ;[194] 29328 004260'01 263 17 0 00 000000 ret ;[181] Panda Network Binary Mode! 29329 29330 ;[181] Sets network binary mode 29331 ;[181] Assumes it can stomp acumulators t1 through t3 29332 ;[181] Returns to doarpa's caller on success 29333 ;[181] on failure, assumes we don't have network binary mode, 29334 ;[181] clears the flag and tries it the old way 29335 29336 004261'01 332 00 0 00 000000# setnbm: skipe setlts ;[181] Did we already sucessfully set this? 29337 004262'01 263 17 0 00 000000 ret ;[181] Yes, why bother doing it twice? 29338 29339 004263'01 332 01 0 00 004121* skipe t1, netjfn ;[186] Load the network JFN 29340 004264'01 254 00 0 00 004301' ifskp. ;[186] Unless we don't have one... 29341 004265'01 332 00 0 00 004123* skipe local ;[186] Are we remote? 29342 004266'01 334 01 0 00 000000# ermsg% (,r) ;[186] Just punt 29343 004267'01 254 00 0 00 004273' 29344 004270'01 202 01 0 00 004134* 29345 004271'01 104 00 0 00 000313 29346 004272'01 254 00 0 00 004216* 29347 000144'03 000000000000# 29348 001733'04 113 105 122 115 111 29349 29350 004273'01 336 01 0 00 004131* skipn t1, ttyjfn ;[186] Yes, so just use the terminal JFN 29351 004274'01 334 01 0 00 000000# ermsg% (,r) ;[186] 29352 004275'01 254 00 0 00 004301' 29353 004276'01 202 01 0 00 004270* 29354 004277'01 104 00 0 00 000313 29355 004300'01 254 00 0 00 004272* 29356 000145'03 000000000000# 29357 001747'04 113 105 122 115 111 29358 29359 004301'01 endif. ;[186] Hopefully have SOMETHING ... 29360 29361 004301'01 201 02 0 00 400001 movx t2,.MORLT ;[181] Read local status 29362 004302'01 104 00 0 00 000077 MTOPR% 29363 004303'01 320 16 0 00 004321' erjmp nbmerr k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 59-1 K20NET MAC 4-Apr-23 00:43 Line routines 29364 004304'01 202 03 0 00 000000# movem t3,OLDLTS ;[181] save old terminal status 29365 004305'01 660 03 0 00 000006 txo t3,MO%NBI!MO%NBO ;[181] network binary mode (input AND output) 29366 004306'01 201 02 0 00 400002 movx t2,.MOSLT ;[181] want to set it 29367 004307'01 104 00 0 00 000077 MTOPR% 29368 004310'01 320 16 0 00 004321' erjmp nbmerr 29369 004311'01 201 02 0 00 400001 movx t2,.MORLT ;[181] now see what actually happened 29370 004312'01 104 00 0 00 000077 MTOPR% 29371 004313'01 320 16 0 00 004321' erjmp nbmerr 29372 004314'01 640 03 0 00 000006 xorx t3,MO%NBI!MO%NBO ;[181] flip binary mode status 29373 004315'01 602 03 0 00 000006 txne t3,MO%NBI!MO%NBO ;[181] they should have been BOTH set ... 29374 004316'01 254 00 0 00 004321' jrst nbmerr 29375 004317'01 350 00 0 00 000000# aos setlts ;[181] flag that we set terminal line status 29376 004320'01 263 17 0 00 000000 ret 29377 29378 004321'01 402 00 0 00 000000# nbmerr: setzm havnbm ;[181] We don't have network binary mode 29379 004322'01 254 00 0 00 004354' callret doarpa ;[181] Maybe the olde fashioned way works? 29380 29381 29382 ;[181] un-Sets network binary mode 29383 ;[181] Assumes it can stomp acumulators t1 through t3 29384 ;[181] Returns to unarpa's caller on success 29385 ;[181] on failure, assumes we don't have network binary mode, 29386 ;[181] clears the flag and tries it the old way 29387 29388 004323'01 400 01 0 00 000000 unsnbm: setz t1, ;[181] whatever the current state is, 29389 004324'01 250 01 0 00 000000# exch t1,setlts ;[181] say that it is no longer set 29390 004325'01 322 01 0 00 004300* jumpe t1,r ;[181] However: did we ever set nbm?? 29391 29392 004326'01 332 01 0 00 004263* skipe t1, netjfn ;[186] Load the network JFN 29393 004327'01 254 00 0 00 004344' ifskp. ;[186] Unless we don't have one... 29394 004330'01 332 00 0 00 004265* skipe local ;[186] Are we remote? 29395 004331'01 334 01 0 00 000000# ermsg% (,r) ;[186] Just punt 29396 004332'01 254 00 0 00 004336' 29397 004333'01 202 01 0 00 004276* 29398 004334'01 104 00 0 00 000313 29399 004335'01 254 00 0 00 004325* 29400 000146'03 000000000000# 29401 001764'04 113 105 122 115 111 29402 29403 004336'01 336 01 0 00 004273* skipn t1, ttyjfn ;[186] Yes, so just use the terminal JFN 29404 004337'01 334 01 0 00 000000# ermsg% (,r) ;[186] 29405 004340'01 254 00 0 00 004344' 29406 004341'01 202 01 0 00 004333* 29407 004342'01 104 00 0 00 000313 29408 004343'01 254 00 0 00 004335* 29409 000147'03 000000000000# 29410 002000'04 113 105 122 115 111 29411 29412 004344'01 endif. ;[186] Hopefully have SOMETHING ... 29413 29414 004344'01 201 02 0 00 400002 movx t2,.MOSLT ;[181] Read local status 29415 004345'01 200 03 0 00 000000# move t3,OLDLTS ;[181] get former status 29416 004346'01 104 00 0 00 000077 MTOPR% ;[181] try to restore it 29417 004347'01 320 12 0 00 004351' ifje. r ;[194] Failed, don't use this any longer 29418 004350'01 254 00 0 00 004353' k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 59-2 K20NET MAC 4-Apr-23 00:43 Line routines 29419 004351'01 402 00 0 00 000000# setzm havnbm ;[181] How could this have failed? 29420 004352'01 254 00 0 00 004551' callret unarpa ;[196] Get out of here and turn some more 29421 004353'01 endif. ;[196] things off 29422 004353'01 263 17 0 00 000000 ret 29423 29424 > ;[181] End Panda conditional 29425 ;[129] Do any required ARPAnet stuff. 29426 ; 29427 ; Important Note: The ability to send binary mode telnet negotiations 29428 ; depends on the monitor NOT doubling IACs on TVT lines. Some versions of 29429 ; TOPS-20 (particularly BBN's TCP monitor) will do this. 29430 ; 29431 ;[181] Use SOUTR% instead of SOUT% to ensure that 29432 ;[181] we flush the data to the TAC 29433 ; 29434 ; Returns +1 always, but prints warning on failure. 29435 ; 29436 004354'01 doarpa: entry doarpa ;[190] 29437 004354'01 336 00 0 00 004103* skipn tvtflg ; Are we on tvt? 29438 004355'01 263 17 0 00 000000 ret 29439 29440 004356'01 332 00 0 00 000000# panda < skipe havnbm ;[181] Does the monitor support network 29441 004357'01 254 00 0 00 004261' callret setnbm > ;[181] binary mode? 29442 29443 004360'01 265 16 0 00 005160' saveac ;[186] Used for device designator 29444 004361'01 332 05 0 00 004326* skipe q1, netjfn ;[186] Load the network JFN 29445 004362'01 254 00 0 00 004377' ifskp. ;[186] Unless we don't have one... 29446 004363'01 332 00 0 00 004330* skipe local ;[186] Are we remote? 29447 004364'01 334 01 0 00 000000# ermsg% (,r) ;[186] Just punt 29448 004365'01 254 00 0 00 004371' 29449 004366'01 202 01 0 00 004341* 29450 004367'01 104 00 0 00 000313 29451 004370'01 254 00 0 00 004343* 29452 000150'03 000000000000# 29453 002015'04 113 105 122 115 111 29454 29455 004371'01 336 05 0 00 004336* skipn q1, ttyjfn ;[186] Yes, so just use the terminal JFN 29456 004372'01 334 01 0 00 000000# ermsg% (,r) ;[186] 29457 004373'01 254 00 0 00 004377' 29458 004374'01 202 01 0 00 004366* 29459 004375'01 104 00 0 00 000313 29460 004376'01 254 00 0 00 004370* 29461 000151'03 000000000000# 29462 002031'04 113 105 122 115 111 29463 29464 004377'01 endif. ;[186] Hopefully have SOMETHING ... 29465 29466 004377'01 200 01 0 00 000005 move t1, q1 ;[186] ; Yes, talk binary. 29467 004400'01 120 02 0 00 005554' dmove t2,[exp ,-3] 29468 004401'01 104 00 0 00 000532 SOUTR% ;[181] This code adapted from MODEM.MAC 29469 004402'01 320 12 0 00 004404' %jserr(,doarpx) 29470 004403'01 254 00 0 00 004407' 29471 004404'01 265 01 0 00 004243* 29472 004405'01 000000 000000 29473 004406'01 254 00 0 00 004424' k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 59-3 K20NET MAC 4-Apr-23 00:43 Line routines 29474 004407'01 201 01 0 00 007640 movei t1,^d4000 ; Sleep four seconds. 29475 004410'01 104 00 0 00 000167 DISMS% 29476 004411'01 200 01 0 00 000005 move t1, q1 ;[186] Tell TVT "do binary". 29477 004412'01 120 02 0 00 005557' dmove t2,[exp ,-3] 29478 004413'01 104 00 0 00 000532 SOUTR% 29479 004414'01 320 12 0 00 004416' %jserr(,doarpx) 29480 004415'01 254 00 0 00 004421' 29481 004416'01 265 01 0 00 004404* 29482 004417'01 000000 000000 29483 004420'01 254 00 0 00 004424' 29484 004421'01 201 01 0 00 007640 movei t1,^d4000 29485 004422'01 104 00 0 00 000167 DISMS 29486 004423'01 263 17 0 00 000000 ret 29487 29488 doarpx: txmsg < 29489 %KERMIT-20: Warning -- Can't negotiate binary mode with TAC 29490 004424'01 200 01 0 00 000000# > 29491 004425'01 104 00 0 00 000076 29492 004426'01 320 12 0 00 004427' 29493 000152'03 000000000000# 29494 002046'04 015 012 045 113 105 29495 29496 004427'01 263 17 0 00 000000 ret k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 60 K20NET MAC 4-Apr-23 00:43 Line routines 29497 29498 ; RESLIN -- Reset/Restore the communications line. 29499 ; 29500 ; Restore old terminal modes, links, length & width, etc. 29501 ; Turn off control-C trap. 29502 ; 29503 ; CALL RESLIN does nothing if server. 29504 ; CALL RRSLIN restores the line even if server. 29505 29506 extern filjfn ;[190] 29507 29508 004430'01 reslin: entry reslin ;[190] 29509 004430'01 332 00 0 00 000000* skipe srvflg ; Server? 29510 004431'01 263 17 0 00 000000 ret ; Yes, forget it. 29511 29512 004432'01 rrslin: entry rrslin ;[220] Used by k20srv 29513 004432'01 260 17 0 00 000450* call ccoff2 ; REALLY reset the line. 29514 004433'01 rrsl2: entry rrsl2 ;[220] Used by k20srv 29515 004433'01 337 01 0 00 000000* skipg t1, filjfn ; Were we doing something with a file? 29516 004434'01 254 00 0 00 004442' ifskp. ;[194] Maybe so 29517 004435'01 621 01 0 00 777777 tlz t1, -1 ;[193] Just carefully toss any flags 29518 004436'01 306 01 0 00 377777 cain t1, .nulio ;[193] Not needed for NUL: 29519 004437'01 254 00 0 00 004442' anskp. ;[193] So bum the CLOSF 29520 004440'01 104 00 0 00 000022 CLOSF 29521 004441'01 320 12 0 00 004442' erjmpr .+1 ;[193] Catch and ignore error 29522 004442'01 endif. ;[194] 29523 004442'01 402 00 0 00 004433* setzm filjfn ;[194] Either way, no file 29524 29525 004443'01 332 00 0 00 004107* ifme. vtermf ;[186] Physical line? 29526 004444'01 254 00 0 00 004450' 29527 004445'01 260 17 0 00 004551' call unarpa ; Undo Arpanet TAC binary mode. 29528 004446'01 260 17 0 00 004454' call unbits ; Restore terminal bits. 29529 004447'01 260 17 0 00 002613' call ttxon ; Clear up any XOFF condition. 29530 004450'01 endif. ;[186] 29531 29532 004450'01 260 17 0 00 002252' call clrbuf ;[194] Clear terminal buffers 29533 004451'01 600 00 0 00 000000 nop ;[186] Ignore any failure 29534 004452'01 402 00 0 00 000000# setzm inited ;[177] Flag we're back to normal. 29535 004453'01 263 17 0 00 000000 ret k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 61 K20NET MAC 4-Apr-23 00:43 Line routines 29536 29537 ; Undo the effect of DOBITS -- restore all the communication line's 29538 ; old bits & modes. 29539 ; 29540 004454'01 unbits: entry unbits ;Used by K20IOC 29541 004454'01 265 16 0 00 005160' saveac ;[186] Used for device designator 29542 004455'01 332 05 0 00 004361* skipe q1, netjfn ;[186] Load the network JFN 29543 004456'01 254 00 0 00 004473' ifskp. ;[186] Unless we don't have one... 29544 004457'01 332 00 0 00 004363* skipe local ;[186] Are we remote? 29545 004460'01 334 01 0 00 000000# ermsg% (,r) ;[186] Just punt 29546 004461'01 254 00 0 00 004465' 29547 004462'01 202 01 0 00 004374* 29548 004463'01 104 00 0 00 000313 29549 004464'01 254 00 0 00 004376* 29550 000153'03 000000000000# 29551 002063'04 113 105 122 115 111 29552 29553 004465'01 336 05 0 00 004371* skipn q1, ttyjfn ;[186] Yes, so just use the terminal JFN 29554 004466'01 334 01 0 00 000000# ermsg% (,r) ;[186] 29555 004467'01 254 00 0 00 004473' 29556 004470'01 202 01 0 00 004462* 29557 004471'01 104 00 0 00 000313 29558 004472'01 254 00 0 00 004464* 29559 000154'03 000000000000# 29560 002077'04 113 105 122 115 111 29561 29562 004473'01 endif. ;[186] Hopefully have SOMETHING ... 29563 29564 004473'01 200 01 0 00 000005 move t1, q1 ;[186] ; Get the line. 29565 004474'01 201 02 0 00 000043 movei t2, .moxof ; Set the terminal pause on end mode... 29566 004475'01 200 03 0 00 000000# move t3, oldpau ; to what it was before. 29567 004476'01 104 00 0 00 000077 MTOPR% 29568 004477'01 320 12 0 00 004501' %jserr (,) 29569 004500'01 254 00 0 00 004504' 29570 004501'01 265 01 0 00 004416* 29571 004502'01 000000 000000 29572 004503'01 254 00 0 00 004504' 29573 004504'01 200 01 0 00 000005 move t1, q1 ;[186] ; Communication line JFN. 29574 004505'01 200 02 0 00 000000# move t2, oldmod ; Get the previous mode. 29575 004506'01 104 00 0 00 000110 SFMOD% 29576 004507'01 320 12 0 00 004511' %jserr (,) 29577 004510'01 254 00 0 00 004514' 29578 004511'01 265 01 0 00 004501* 29579 004512'01 000000 000000 29580 004513'01 254 00 0 00 004514' 29581 004514'01 104 00 0 00 000217 STPAR% 29582 004515'01 320 12 0 00 004517' %jserr (,) 29583 004516'01 254 00 0 00 004522' 29584 004517'01 265 01 0 00 004511* 29585 004520'01 000000 000000 29586 004521'01 254 00 0 00 004522' 29587 004522'01 201 02 0 00 000000# movei t2, olddim ;[185] Point to this JFN's dimensions 29588 004523'01 260 17 0 00 000000* call rstlnw ;[185] Restore length and width 29589 004524'01 201 02 0 00 000034 movx t2, .mosnt ; Restore system msg refuse/accept. 29590 004525'01 200 03 0 00 000000# move t3, sysmsg k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 61-1 K20NET MAC 4-Apr-23 00:43 Line routines 29591 004526'01 104 00 0 00 000077 MTOPR 29592 004527'01 320 12 0 00 004531' %jserr (,) 29593 004530'01 254 00 0 00 004534' 29594 004531'01 265 01 0 00 004517* 29595 004532'01 000000 000000 29596 004533'01 254 00 0 00 004534' 29597 29598 ; Restore links and advice if necessary. 29599 29600 004534'01 400 01 0 00 000000 setz t1, ; Restore links & advice. 29601 004535'01 200 02 0 00 000000# move t2, oldmod ; From old tty mode word. 29602 004536'01 602 02 0 00 001000 txne t2, tt%alk ; Was receiving links before? 29603 004537'01 661 01 0 00 030000 txo t1, ; Yes, so receive links. 29604 004540'01 602 02 0 00 000400 txne t2, tt%aad ; Was receiving advice before? 29605 004541'01 661 01 0 00 006000 txo t1, ; Yes, so receive links. 29606 004542'01 322 01 0 00 004472* jumpe t1, r ; Skip to next part if no bits to set. 29607 004543'01 540 01 0 00 004161* hrr t1, ttynum ; Must set bits, form tty designator 29608 004544'01 660 01 0 00 400000 txo t1, .ttdes ; ... 29609 004545'01 400 02 0 00 000000 setz t2, ; Don't leave garbage in here... 29610 004546'01 104 00 0 00 000216 TLINK ; Restore the settings. 29611 004547'01 320 16 0 00 004550' erjmp .+1 ; Ignore any errors. 29612 004550'01 263 17 0 00 000000 ret k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 62 K20NET MAC 4-Apr-23 00:43 Line routines 29613 29614 ; Turn off Arpanet TAC binary mode. 29615 29616 004551'01 336 00 0 00 004354* unarpa: skipn tvtflg ; Are we on a tvt? 29617 004552'01 263 17 0 00 000000 ret ; No, skip this. 29618 29619 004553'01 332 00 0 00 000000# panda < skipe havnbm ;[181] Does the monitor support network 29620 004554'01 254 00 0 00 004323' callret unsnbm > ;[181] binary mode? 29621 29622 004555'01 265 16 0 00 005160' saveac ;[186] Used for device designator 29623 004556'01 332 05 0 00 004455* skipe q1, netjfn ;[186] Load the network JFN 29624 004557'01 254 00 0 00 004574' ifskp. ;[186] Unless we don't have one... 29625 004560'01 332 00 0 00 004457* skipe local ;[186] Are we remote? 29626 004561'01 334 01 0 00 000000# ermsg% (,r) ;[186] Just punt 29627 004562'01 254 00 0 00 004566' 29628 004563'01 202 01 0 00 004470* 29629 004564'01 104 00 0 00 000313 29630 004565'01 254 00 0 00 004542* 29631 000155'03 000000000000# 29632 002114'04 113 105 122 115 111 29633 29634 004566'01 336 05 0 00 004465* skipn q1, ttyjfn ;[186] Yes, so just use the terminal JFN 29635 004567'01 334 01 0 00 000000# ermsg% (,r) ;[186] 29636 004570'01 254 00 0 00 004574' 29637 004571'01 202 01 0 00 004563* 29638 004572'01 104 00 0 00 000313 29639 004573'01 254 00 0 00 004565* 29640 000156'03 000000000000# 29641 002130'04 113 105 122 115 111 29642 29643 004574'01 endif. ;[186] Hopefully have SOMETHING ... 29644 29645 004574'01 200 01 0 00 000005 move t1, q1 ;[186] ;[181] Get the line. 29646 004575'01 120 02 0 00 005562' dmove t2, [exp ,-3] 29647 004576'01 104 00 0 00 000053 SOUT% ; Yes, turn off binary mode. 29648 004577'01 320 12 0 00 004601' %jserr(,unarpx) 29649 004600'01 254 00 0 00 004604' 29650 004601'01 265 01 0 00 004531* 29651 004602'01 000000 000000 29652 004603'01 254 00 0 00 004621' 29653 004604'01 201 01 0 00 007640 movei t1, ^d4000 ; Wait 4 secs. 29654 004605'01 104 00 0 00 000167 DISMS% 29655 004606'01 200 01 0 00 000005 move t1, q1 ;[186] ; Send the command. 29656 004607'01 120 02 0 00 005565' dmove t2, [exp ,-3] 29657 004610'01 104 00 0 00 000053 SOUT% 29658 004611'01 320 12 0 00 004613' %jserr(,unarpx) 29659 004612'01 254 00 0 00 004616' 29660 004613'01 265 01 0 00 004601* 29661 004614'01 000000 000000 29662 004615'01 254 00 0 00 004621' 29663 004616'01 201 01 0 00 007640 movei t1, ^d4000 ; Wait another 4 secs. 29664 004617'01 104 00 0 00 000167 DISMS% 29665 004620'01 263 17 0 00 000000 ret ; Done. 29666 29667 unarpx: txmsg < k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 62-1 K20NET MAC 4-Apr-23 00:43 Line routines 29668 %KERMIT-20: Warning -- Can't clear binary mode with TAC 29669 004621'01 200 01 0 00 000000# > ;[129] Error message for any of the above. 29670 004622'01 104 00 0 00 000076 29671 004623'01 320 12 0 00 004624' 29672 000157'03 000000000000# 29673 002145'04 015 012 045 113 105 29674 29675 29676 004624'01 263 17 0 00 000000 ret ;[129] And return 29677 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 63 K20NET MAC 4-Apr-23 00:43 Get Network Device Status 29678 subttl Get Network Device Status 29679 29680 ;[223] Begin Code Insertion 29681 ; 29682 ; N.B., Be aware that the result of GDSTS% has to be CAREFULLY checked 29683 ; because it may not throw an error, even when followed by an 29684 ; ERJMP! In certain error scenarios, the process's last error may 29685 ; not be changed, so messing around with a before-SETER% / after- 29686 ; GETER% won't catch the problem, either. We carefully check for 29687 ; such a situation and, if detected, set the process's last error 29688 ; appropriately. Sigh... 29689 ; 29690 ; On klh10, the only line currently known to tolerate parity is the CTY. 29691 ; On a PANDA monitor, PTY's will do parity 29692 ; 29693 ; Call: 29694 ; 29695 ; t1/ JFN on device (assumed opened in 8 bit mode) 29696 ; 29697 ; *OR* 29698 ; 29699 ; t1/ .ttdes+line number 29700 ; 29701 ; Returns: 29702 ; 29703 ; +1/ Some kind of bad 29704 ; +2/ Worked 29705 ; t1/ JFN, always 29706 ; t2/ Device-dependent status bits [If device supported GDSTS%] 29707 ; t3/ Device-dependent information [If device supported GDSTS%] 29708 ; t4/ Possible GDSTS% error 29709 29710 004625'01 gndpar: entry gndpar ; Also called from k20sub 29711 004625'01 265 16 0 00 005567' saveac ; Needs some extra registers 29712 29713 004626'01 200 05 0 00 000001 move q1, t1 ; Save JFN and any flags (which we don't use) 29714 004627'01 400 11 0 00 000000 setz q5, ; Second JFN on line 29715 29716 004630'01 606 05 0 00 400000 ifxn. q1, .ttdes ; Terminal device? 29717 004631'01 254 00 0 00 004635' 29718 004632'01 260 17 0 00 005044' call gndfil ; Yep, go get the JFN 29719 004633'01 200 11 0 00 000001 move q5, t1 ; Store it for later 29720 004634'01 254 00 0 00 004666' jrst devpar ; Go find out if it 'tolerates' parity 29721 004635'01 endif. ; End case terminal device 29722 29723 004635'01 621 01 0 00 777777 tlz t1, -1 ; Stomp the flags 29724 004636'01 104 00 0 00 000024 GTSTS% ; Get file status of JFN 29725 004637'01 320 12 0 00 004573* erjmpr r ; Failed, no way to know the parity 29726 004640'01 603 02 0 00 000200 txne t2, gs%nam ; Sanity check: does this JFN exist? 29727 004641'01 607 02 0 00 400000 txnn t2, gs%opn ; And is it open? 29728 004642'01 263 17 0 00 000000 ret ; No to one is a calling error 29729 ; Pick up and save the mode 29730 004643'01 135 04 0 00 005603' ldb t4,[pointr t2,gs%mod] 29731 004644'01 200 03 0 00 000002 move t3, t2 ; Save the entire status word, too 29732 004645'01 104 00 0 00 000045 RFBSZ% ; Get the opened byte size k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 63-1 K20NET MAC 4-Apr-23 00:43 Get Network Device Status 29733 004646'01 320 12 0 00 004637* erjmpr r ; Failed, better not go any further 29734 004647'01 415 16 0 00 004661' block. ; Build a stack frame for better control flow 29735 004650'01 261 17 0 00 000016 29736 004651'01 302 02 0 00 000007 caie t2, ^d7 ; Open in seven bit mode? 29737 004652'01 263 17 0 00 000000 ret ; Nope, have to have a new file 29738 004653'01 302 04 0 00 000000 caie t4, .gsnrm ; Opened in normal mode? 29739 004654'01 263 17 0 00 000000 ret ; No, so won't do parity 29740 004655'01 603 03 0 00 000400 txne t3, gs%err ; Nothing wrong, right? 29741 004656'01 263 17 0 00 000000 ret ; Better get our own copy 29742 004657'01 254 00 0 00 004246* retskp ; Otherwise, OK to check this JFN 29743 004660'01 263 17 0 00 000000 endbk. ; Either way, come out of the block 29744 004661'01 254 00 0 00 004664' ifskp. ; Skip means OK to check this JFN 29745 004662'01 200 11 0 00 000005 move q5, q1 ; So reuse it 29746 004663'01 254 00 0 00 004666' else. ; Otherwise, we need a copy 29747 004664'01 260 17 0 00 005044' call gndfil ; Go get a copy 29748 004665'01 200 11 0 00 000001 move q5, t1 ; Store it for later 29749 004666'01 endif. ; End of reuse determination logic 29750 29751 remark devpar ; Now check the parity (falls through) 29752 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 64 K20NET MAC 4-Apr-23 00:43 Get Network Device Status 29753 remark Now that we have a JFN, see if it will do parity 29754 29755 004666'01 200 11 0 00 000001 devpar: move q5, t1 ; Save terminal (copy) JFN and flags 29756 004667'01 621 01 0 00 777777 panda < tlz t1, -1 ; Stomp JFN flags so MTOPR%'s don't choke 29757 004670'01 201 02 0 00 400001 movx t2, .morlt ; PANDA can extract parity status 29758 004671'01 104 00 0 00 000077 MTOPR% ; So try to get it 29759 004672'01 320 12 0 00 004674' ifje. r ; Sigh... 29760 004673'01 254 00 0 00 004676' 29761 004674'01 474 10 0 00 000000 seto q4, ; Set a talisman and do nothing else 29762 004675'01 254 00 0 00 004711' else. ; Otherise, got something! 29763 004676'01 200 10 0 00 000003 move q4, t3 ; Save current settings, first 29764 004677'01 661 10 0 00 400000 txo q4, 1b0 ; Be optimistic and assume parity exists and is on 29765 004700'01 602 03 0 00 000010 txne t3, mo%par ; Any parity? 29766 004701'01 254 00 0 00 004711' anskp. ; Nothing further to do or undo 29767 004702'01 200 10 0 00 000003 move q4, t3 ; Try turning it on, saving current settings, first 29768 004703'01 660 03 0 00 000010 txo t3, mo%par ; Turn on (even) parity 29769 004704'01 620 03 0 00 000006 txz t3, mo%nbi!mo%nbo ; Shut network binary so that doesn't get in the way 29770 004705'01 201 02 0 00 400002 movx t2, .moslt ; Function to set PANDA mode bits 29771 004706'01 104 00 0 00 000077 MTOPR% ; Give it a whirl 29772 004707'01 254 00 0 00 004711' ifskp. ; Might not be in this monitor 29773 004710'01 474 10 0 00 000000 seto q4, ; So better leave it alone 29774 004711'01 endif. ; End .moslt analysis 29775 004711'01 endif. ; End .morlt recovery and interpretation 29776 >;panda 29777 dmove t1, [ .fhslf ; Can't believe result of GDSTS% all the time... 29778 004711'01 120 01 0 00 005604' lstrx1 ] ; So let's assume it worked 29779 004712'01 104 00 0 00 000336 SETER% ; and set no errors whatsoever 29780 004713'01 320 12 0 00 004715' %jserr(,) ; VERY strange... 29781 004714'01 254 00 0 00 004720' 29782 004715'01 265 01 0 00 004613* 29783 004716'01 000000000000# 29784 004717'01 254 00 0 00 004720' 29785 002161'04 125 156 141 142 154 29786 29787 004720'01 550 01 0 00 000011 hrrz t1, q5 ; Load the JFN we got 29788 004721'01 403 02 0 00 000003 setzb t2, t3 ; Let's assume the JSYS doesn't work 29789 004722'01 104 00 0 00 000145 GDSTS% ; Finally try a device status on it 29790 004723'01 320 12 0 00 004725' ifje. r ; Catch the error (hopefully) 29791 004724'01 254 00 0 00 004734' 29792 004725'01 200 04 0 00 000001 move t4, t1 ; Put error code someplace for debugger 29793 004726'01 334 00 0 00 000000 %ermsg(,) ;[223] Complain, but carry on 29794 004727'01 254 00 0 00 004733' 29795 004730'01 265 01 0 00 004715* 29796 004731'01 000000000000# 29797 004732'01 254 00 0 00 004733' 29798 002170'04 103 157 165 154 144 29799 004733'01 254 00 0 00 004750' else. ; Otherwise, worked. Maybe... 29800 004734'01 405 02 0 00 000001 andx t2, gd%par ; Toss everything but accepts parity 29801 004735'01 200 04 0 00 000002 move t4, t2 ; Get possible status out of the way 29802 004736'01 400 02 0 00 000000 setz t2, ; Let's assume GETER% fails (impossible) 29803 004737'01 201 01 0 00 400000 movei t1, .fhslf ; This process 29804 004740'01 104 00 0 00 000012 GETER% ; Get the last error 29805 004741'01 320 12 0 00 004743' %jserr(,) ; VERY strange... 29806 004742'01 254 00 0 00 004746' 29807 004743'01 265 01 0 00 004730* k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 64-1 K20NET MAC 4-Apr-23 00:43 Get Network Device Status 29808 004744'01 000000000000# 29809 004745'01 254 00 0 00 004746' 29810 002176'04 125 156 141 142 154 29811 004746'01 621 02 0 00 777777 tlz t2, -1 ; Shut off idiotic fork handle... 29812 004747'01 250 02 0 00 000004 exch t2, t4 ; Put the last error in a common place 29813 004750'01 endif. ; End case JSYS handling 29814 29815 004750'01 302 04 0 00 601405 caie t4, lstrx1 ; Any error? 29816 004751'01 254 00 0 00 004764' ifskp. ; No. Supposedly; let's double check 29817 004752'01 302 02 0 00 601340 caie t2, desx9 ; No entry in device dispatch table for GDSTS%? 29818 004753'01 254 00 0 00 004764' anskp. ; No, assume it's fine... 29819 004754'01 200 04 0 00 000002 move t4, t2 ; Yep, device doesn't support it 29820 004755'01 201 01 0 00 400000 movei t1, .fhslf ; This process 29821 004756'01 104 00 0 00 000336 SETER% ; Force it to be our last error 29822 004757'01 320 12 0 00 004761' %jserr(,) ; VERY strange... 29823 004760'01 254 00 0 00 004764' 29824 004761'01 265 01 0 00 004743* 29825 004762'01 000000000000# 29826 004763'01 254 00 0 00 004764' 29827 002205'04 125 156 141 142 154 29828 004764'01 endif. ; End case silent failure 29829 29830 004764'01 306 04 0 00 601405 cain t4, lstrx1 ; So... No error, right? 29831 004765'01 254 00 0 00 004767' ifskp. ; Something happened... 29832 ;;;; remark We handle this properly; uncomment for debugging or prototyping 29833 ;;;; %ermsg(,) 29834 004766'01 403 02 0 00 000003 setzb t2, t3 ; Cons up no status whatsoever 29835 004767'01 endif. 29836 29837 004767'01 335 03 0 00 000010 panda < skipge t3, q4 ; Did we have to restore anything? 29838 004770'01 254 00 0 00 005000' ifskp. ; Ok, so a bit of cleaning up to do, then 29839 004771'01 200 04 0 00 000002 move t4, t2 ; Save the precious gd%par bit! 29840 004772'01 550 01 0 00 000011 hrrz t1, q5 ; Pick up the terminal JFN, no flags 29841 004773'01 201 02 0 00 400002 movx t2, .moslt ; Function to set PANDA mode bits 29842 004774'01 104 00 0 00 000077 MTOPR% ; Try to set it back to the way it was 29843 004775'01 320 12 0 00 004776' erjmpr .+1 ; Failed?? We just changed it! 29844 004776'01 200 02 0 00 000004 move t2, t4 ; Restore the precious (scrubbed) gd%par bit 29845 004777'01 254 00 0 00 005004' else. ; Otherwise, looked negative 29846 005000'01 316 03 0 00 005467' camn t3, [-1] ; Is it our talisman? 29847 005001'01 254 00 0 00 005004' ifskp. ; No, so carry forward the parity setting 29848 005002'01 405 03 0 00 000010 andx t3, mo%par ; Just keep the parity on bit 29849 005003'01 434 02 0 00 000003 or t2, t3 ; And carry that on with a possible gd%par 29850 005004'01 endif. ; End case parity setting 29851 005004'01 endif. ; End .morlt recovery and interpretation 29852 >;;panda 29853 29854 remark t2, gd%par ; So will the thing do parity? 29855 005004'01 316 05 0 00 000011 camn q1, q5 ; Reused the JFN? 29856 005005'01 254 00 0 00 004657* retskp ; We did, so nothing further to do 29857 29858 005006'01 200 07 0 00 000002 move q3, t2 ; Save the precious device-dependent status bits 29859 dmove t1, [ devclt ; On time-out, hit device close timeout 29860 005007'01 120 01 0 00 005606' ^d2500 ] ; Give it two and half seconds to make up its mind 29861 005010'01 260 17 0 00 000363* call timeon ; Start the timer going 29862 005011'01 550 01 0 00 000011 hrrz t1, q5 ; Load the JFN, no flags k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 64-2 K20NET MAC 4-Apr-23 00:43 Get Network Device Status 29863 005012'01 104 00 0 00 000022 CLOSF% ; Close it 29864 005013'01 320 12 0 00 005015' %jserr(,) ; But carry on anyway 29865 005014'01 254 00 0 00 005020' 29866 005015'01 265 01 0 00 004761* 29867 005016'01 000000000000# 29868 005017'01 254 00 0 00 005020' 29869 002214'04 125 156 141 142 154 29870 005020'01 260 17 0 00 000451* call timdel ; Toss the timer, we won 29871 29872 005021'01 200 02 0 00 000007 move t2, q3 ; Restore the device-dependent status bits 29873 005022'01 254 00 0 00 005005* retskp ; Return success, anyway 29874 29875 29876 remark ; Here on device parity close timeout 29877 29878 devclt: dmove t1, [ devabt ; On time-out, hit device abort timeout 29879 005023'01 120 01 0 00 005610' ^d2500 ] ; Give it two and half seconds to make up its mind 29880 005024'01 260 17 0 00 005010* call timeon ; Start the timer going 29881 005025'01 550 01 0 00 000011 hrrz t1, q5 ; Load the JFN, no flags and set up to 29882 005026'01 621 01 0 00 004000 txz t1, cz%abt ; abort it, we mean business this time 29883 005027'01 104 00 0 00 000022 CLOSF% ; Bombs away! 29884 005030'01 320 12 0 00 005034' erjmpr devabt ; That didn't work, just try to let go of it 29885 005031'01 260 17 0 00 005020* call timdel ; Toss the timer, it's chucked 29886 005032'01 200 02 0 00 000007 move t2, q3 ; Restore the device-dependent status bits 29887 005033'01 254 00 0 00 005022* retskp ; Return some kind of success 29888 29889 devabt: dmove t1, [ devabf ; On time-out, hit device abort timeout 29890 005034'01 120 01 0 00 005612' ^d2500 ] ; Give it two and half seconds to make up its mind 29891 005035'01 260 17 0 00 005024* call timeon ; Start the timer going 29892 005036'01 550 01 0 00 000011 hrrz t1, q5 ; Load the JFN, no flags and set up to 29893 005037'01 104 00 0 00 000023 RLJFN% ; Just try to let go of it 29894 005040'01 320 12 0 00 005042' erjmpr devabf 29895 005041'01 260 17 0 00 005031* call timdel ; Toss the timer, it's chucked 29896 29897 005042'01 devabf: remark ; If hit here, just ignore what's going on, oh well.. 29898 005042'01 200 02 0 00 000007 move t2, q3 ; Restore the device-dependent status bits 29899 005043'01 254 00 0 00 005033* retskp ; Return some kind of success 29900 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 65 K20NET MAC 4-Apr-23 00:43 Get a seven bit handle on a (terminal) device 29901 subttl Get a seven bit handle on a (terminal) device 29902 29903 remark Constants definitions 29904 29905 000000 js%all==0 ; Has our JFNS% formatting bits 29906 .xcref js%all ; Not needed in the cross reference 29907 29908 define jsb(b) < ;;Macro to accumulate bits 29909 js%all==js%all! ;;OR in to completed word 29910 .xcref js%all ;;Keep off the cross reference!!!! 29911 >;;jsb 29912 29913 define jsf(m,v) < ; Macro to accumulate values 29914 ifb , ;;If no value, then always output 29915 ifnb , ;;If value, then use that 29916 .xcref js%all ;;Either way, keep off the cross reference 29917 >;;jsf 29918 29919 remark ; Finally cons up the formatting 29920 jsf(js%dev) ;;Device 29921 jsf(js%dir) ;;Directory 29922 jsf(js%nam) ;;Name 29923 jsf(js%typ) ;;Type 29924 jsf(js%gen) ;;Generation 29925 jsb(js%paf) ;;Punctuate all fields 29926 29927 chgsec(code,const) ; Not code, constants 29928 000160'03 111110 000001 allfld: js%all ; Output everything in the file name 29929 000161'03 000000 000000 0 ; No goofy prefix 29930 retsec ; Return from CONST psec 29931 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 66 K20NET MAC 4-Apr-23 00:43 Code to do the job 29932 subttl Code to do the job 29933 29934 ; N.B., This surely will NEVER work for a pipe or a file 29935 ; 29936 ; Call: 29937 ; 29938 ; t1/ JFN on device (assumed open) 29939 ; 29940 ; *OR* 29941 ; 29942 ; t1/ .ttdes+line number 29943 ; 29944 ; Return: 29945 ; 29946 ; +1/ Some problem 29947 ; t1/ Last JSYS' error 29948 ; t3/ Possible OPENF% error code 29949 ; t4/ Possible RLJFN% error code 29950 ; 29951 ; +2/ Worked! 29952 ; t1/ New JFN and flags 29953 29954 005044'01 265 16 0 00 005614' gndfil: saveac 29955 005045'01 265 16 0 00 001613* anstkv. (q2,mxfilw) ; Stack space for text of JFN 29956 005046'01 000000 000034 29957 005047'01 415 06 0 17 777743 29958 29959 005050'01 201 01 0 00 000033 movx t1, ; Length of storage to zero 29960 005051'01 200 02 0 00 000006 move t2, q2 ; First location to zero 29961 005052'01 201 03 0 02 000001 movei t3, 1(t2) ; Second location to zero 29962 005053'01 402 00 0 02 000000 setzm (t2) ; Whack the first location 29963 005054'01 320 12 0 00 004646* erjmpr r ; Must have bumped into a guard page or off section 29964 005055'01 123 01 0 00 005626' xblt. t1 ; And away we go! 29965 005056'01 320 12 0 00 005054* erjmpr r ; Must have bumped into a guard page or off section 29966 29967 005057'01 560 01 0 00 000006 hrro t1, q2 ; Tops-20 ASCIZ pointer to text area 29968 005060'01 550 02 0 00 000005 hrrz t2, q1 ; Load the JFN, sans flags 29969 005061'01 322 02 0 00 005056* jumpe t2, r ; Gubbish? 29970 005062'01 606 02 0 00 400000 txnn t2, .ttdes ; A terminal designator? 29971 005063'01 254 00 0 00 005072' ifskp. ; Yes, JFNS% will choke on it 29972 005064'01 104 00 0 00 000121 DEVST% ; So turn designator into a string 29973 005065'01 320 12 0 00 005061* erjmpr r ; But couldn't 29974 005066'01 120 02 0 00 005627' dmove t2, [exp ":",0] ; Load appropriate suffix 29975 005067'01 136 02 0 00 000001 idpb t2, t1 ; Punctuate the device 29976 005070'01 136 03 0 00 000001 idpb t3, t1 ; Tie off the string (does not allow append) 29977 005071'01 254 00 0 00 005075' else. ; Otherwise, a JFN which JFNS% can handle 29978 005072'01 120 03 0 00 000000# dmove t3, allfld ; Load formatting bits, no goofy prefix 29979 005073'01 104 00 0 00 000030 JFNS% ; Turn the JFN into text 29980 005074'01 320 12 0 00 005065* erjmpr r ; But couldn't 29981 005075'01 endif. 29982 29983 005075'01 205 01 0 00 100020 movx t1, gj%old!gj%flg ; Return flags 29984 005076'01 560 02 0 00 000006 hrro t2, q2 ; Load Tops-20 ASCIZ pointer to constructed text 29985 005077'01 104 00 0 00 000020 GTJFN% ; Get a duplicate JFN 29986 005100'01 320 12 0 00 005074* erjmpr r ; Failed?? k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 66-1 K20NET MAC 4-Apr-23 00:43 Code to do the job 29987 005101'01 200 07 0 00 000001 move q3, t1 ; Save file JFN and flags 29988 29989 005102'01 621 01 0 00 777777 tlz t1, -1 ; Shut off flags so OPENF% doesn't choke 29990 005103'01 200 02 0 00 005631' movx t2, fld(7,of%bsz)!fld(.gsnrm,of%mod)!of%wr!of%rd ; Force 7 bit mode!! 29991 005104'01 403 03 0 00 000004 setzb t3, t4 ; Scrub an error returns 29992 005105'01 104 00 0 00 000021 OPENF% ; Open the file (I hope) 29993 005106'01 320 12 0 00 005110' ifje. r ; Failed... 29994 005107'01 254 00 0 00 005112' 29995 005110'01 200 03 0 00 000001 move t3, t1 ; Save the error code 29996 005111'01 254 00 0 00 005114' else. ; Otherwise, worked!! 29997 005112'01 500 01 0 00 000007 hll t1, q3 ; Return the flags, too 29998 005113'01 254 00 0 00 005043* retskp ; Return success 29999 005114'01 endif. ; End initial JSYS handling 30000 30001 005114'01 550 01 0 00 000007 hrrz t1, q3 ; Reload the new JFN 30002 005115'01 104 00 0 00 000023 RLJFN% ; Toss its miserable remains 30003 005116'01 320 12 0 00 005120' ifje. r ; Failed?? 30004 005117'01 254 00 0 00 005121' 30005 005120'01 200 04 0 00 000001 move t4, t1 ; Return error code as talisman 30006 005121'01 endif. 30007 30008 005121'01 263 17 0 00 000000 ret ; Fail the call 30009 30010 ;[223] End Code Insertion 30011 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 67 K20NET MAC 4-Apr-23 00:43 Final code particulars 30012 subttl Final code particulars 30013 30014 xlist ; Save the trees!! 30015 list ; Safe to look 30016 .endps code ; Close out the code area 30017 k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 68 K20NET MAC 4-Apr-23 00:43 Misc. data storage 30018 subttl Misc. data storage 30019 30020 .psect data ; Writeable area!! 30021 30022 000000'05 cnfigd: block .cfiln ; Space for CNFIG% .CFINF data 30023 000010'05 block 1 ; And slop 30024 000011'05 mynode:: block 1 ; Number of local executor (us) 30025 000012'05 myname:: block 2 ; Local executor name 30026 000014'05 ndvfxp:: block 1 ; Whether monitor has extended node verify 30027 30028 000015'05 syscnt:: block 1 ; Count of characters in system name 30029 000016'05 sysnam:: block syslen ; Name of local system we're running on 30030 000027'05 myprom:: block 3 ; Prompt built off system name 30031 000032'05 sysver: block 1 ; GETAB% table for system name 30032 30033 000033'05 cnfmsg: block <+1> ; Space for configuration message 30034 000065'05 block 1 ; And slop ... 30035 30036 remark ;[190] ; Various line bits of interest 30037 30038 000066'05 000000 000000 inited: 0 ;[190] ;[177] inilin/reslin flag. 30039 000067'05 000000 000000 oldmod: 0 ;[190] ; Previous mode of the line. 30040 000070'05 000000 000000 olddim: 0 ;[190] ;[185] Old line dimensions 30041 000071'05 000000 000000 oldpau: 0 ;[190] ; Previous terminal pause on end mode. 30042 000072'05 000000 000000 sysmsg: 0 ;[190] ;[82] Accept/refuse system message status. 30043 30044 panda < remark ;[181] Storage for PANDA monitor TVT support 30045 000073'05 000000 000000 havnbm: 0 ;[181] Non-zero if we have network binary mode 30046 000074'05 000000 000000 setlts: 0 ;[181] set if we set terminal status 30047 000075'05 000000 000000 oldlts: 0 ;[181] Old terminal status 30048 > ;[181] 30049 30050 remark Do not reorder next two! 30051 000076'05 nrtros:: block 1 ; If NRT, remote operating system type 30052 000077'05 rosnpt:: block 1 ; Remote operating system name pointer 30053 000100'05 nrtflg:: block 1 ; Set if a valid Network Remote Terminal 30054 000101'05 binflg:: block 1 ; Set if terminal will do binary (they all do) 30055 000102'05 nrtprt: block 1 ; NRT protocol supported 30056 30057 000103'05 000000 000000 job: 0 ;[218] ;[7] Number of job that has TTY I want. 30058 000104'05 000000 000000 oasflg: 0 ;[218] ;[7] -1 if we assigned the previous TTY. 30059 000105'05 000000 000000 osgdev: 0 ;[218] ;[186] Old device I had assigned 30060 000106'05 000000 000000 oldjfn: 0 ;[218] ; JFN on previous line. 30061 30062 000107'05 000000 000000 oldnum: 0 ; Previous DECnet node number 30063 000110'05 000000 000000 oldnam: exp 0, 0, 0, 0 ; Previous DECnet node name 30064 000114'05 nrtobj: block <+1> ; Area to build object name for GTJFN% 30065 000150'05 block 2 ; And slop 30066 000152'05 intbuf: block ^d<<16/5>+1> ; Space for interupt message 30067 000156'05 block 3 ; And generous slop... (it is DECnet, after all) 30068 30069 000161'05 frkpdl: block pdlsiz ;[186] Fork's PDL 30070 ;[223] If a buffer is large enough for 8 bit, it will be large enough for 7 bit 30071 000471'05 frkbuf: block +1 ;[223] Buffer for fork to read into (if 8 bit) 30072 001072'05 nrtbuf: block +1 ;[223] Buffer for sending loop (if 8 bit) k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 68-1 K20NET MAC 4-Apr-23 00:43 Misc. data storage 30073 001473'05 parbuf: block +1 ;[223] Buffer if building parity from terminal input 30074 30075 remark pseudo-terminal information 30076 30077 002074'05 ttygtb: block 1 ; Terminal line to job mapping GETAB% 30078 002075'05 pty1st: block 1 ; Terminal line number of first pseudo-terminal 30079 002076'05 ptycnt: block 1 ; Count of pseudo-terminals 30080 002077'05 ptygtb: block 1 ; PTYPAR GETAB% index (which we'll never use) 30081 30082 002100'05 ndvchr:: block 2 ; Device characterstics double word 30083 30084 002102'05 ptyflg:: block 1 ; Set if doing pseudo-terminal I/O 30085 002103'05 ptynam:: block 3 ; ASCII name of pseudo-terminal 30086 002106'05 ptydev:: block 1 ; Assigned PTY device designator 30087 002107'05 ptytty:: block 1 ; Line number associated with pseudo-terminal 30088 30089 002110'05 ttyflg: block 1 ; Flag for physical terminal 30090 002111'05 ttydev:: block 1 ; Assigned TTY device designator 30091 002112'05 ttynam:: block 3 ; ASCII name of associated terminal 30092 30093 002115'05 777777 777777 opndev: -1 ;[186] Device type we are open on 30094 002116'05 opnsts:: block 2 ;[223] GDSTS% on the open JFN 30095 002120'05 000000 000000 opnpar:: 0 ;[223] Whether device supports parity 30096 30097 002121'05 000000 000000 vbict:: 0 ;[186] Virtual Terminal BIN% Count 30098 002122'05 000000 000000 vboct:: 0 ;[186] Virtual Terminal BOUT% Count (simulated) 30099 002123'05 000000 000000 vsict:: 0 ;[186] Virtual Terminal SIN% Count (number done) 30100 002124'05 000000 000000 vsitc:: 0 ;[186] Virtual Terminal total characters SIN%'ed 30101 002125'05 000000 000000 vsimx:: 0 ;[186] Virtual Terminal SIN% Maximum length 30102 002126'05 000000 000000 vsoct:: 0 ;[186] Virtual Terminal SOUTR%'s Issued 30103 002127'05 000000 000000 vsotc:: 0 ;[186] Virtual Terminal SOUTR% Total Characters 30104 002130'05 000000 000000 vsomx:: 0 ;[186] Virtual Terminal SOUTR% Maximum length 30105 002131'05 000000 000000 nbict:: 0 ;[186] Network BIN% count 30106 002132'05 000000 000000 nsici:: 0 ;[186] Network SIN%'s Issued 30107 002133'05 000000 000000 nsitc:: 0 ;[186] Network SIN% total characters 30108 002134'05 000000 000000 nsimx:: 0 ;[186] Network SIN% maximum length 30109 30110 002135'05 000000 000000 vchrcn:: 0 ;[211] Characters flushed from virtual line 30111 002136'05 flushb: block +1 ;[211] Flush buffer in words, eight bit bytes 30112 30113 002221'05 ntiblk::block ntblen ;[210] ;[182] NTINF% block for TVT 30114 002231'05 ntihst: block ^d20 ;[186] Remote DECnet host 30115 .endps data ; Close out the data area 30116 30117 .xcmsy ;[194] Ditch MACSYM junk 30118 30119 end NO ERRORS DETECTED PROGRAM BREAK IS 000000 PSECT 1 BREAK IS 005632 FOR CODE PSECT 2 BREAK IS 000003 FOR TEXT PSECT 3 BREAK IS 000162 FOR CONST PSECT 4 BREAK IS 002224 FOR ETEXT k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page 68-2 K20NET MAC 4-Apr-23 00:43 Misc. data storage PSECT 5 BREAK IS 002255 FOR DATA CPU TIME USED 00:01.888 139P CORE USED k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page S-1 K20NET MAC 4-Apr-23 00:43 SYMBOL TABLE AIC% 104000 000131 int GJ%FLG 000020 000000 sin NTINF% 104000 000632 int SOBE% 104000 000103 int ARGX02 601713 int GJ%OLD 100000 000000 sin NTLINE 777777 spd SOUT% 104000 000053 int ASGDEV 000000 ext GJ%SHT 000001 000000 sin NTTYPE 000777 000000 spd SOUTR% 104000 000532 int ASGFLG 000000 ext GS%ERR 000400 000000 sin NW%FE 000001 sin SPACE 000000 ext ASND% 104000 000070 int GS%MOD 000017 sin NW%NNT 000000 sin SRVFLG 000000 ext ATMBUF 000000 ext GS%NAM 000200 000000 sin NW%TCP 000001 sin STAT% 104000 000745 int BIN% 104000 000050 int GS%OPN 400000 000000 sin NW%TV 000004 sin STCMP% 104000 000540 int BOUT 104000 000051 int GTJFN% 104000 000020 int OBJLEN 000207 spd STPAR% 104000 000217 int BOUT% 104000 000051 int GTSTS% 104000 000024 int ODD 000000 ext STRBUF 000000 ext CALL 260740 000000 HALTF 104000 000170 int OF%BSZ 770000 000000 sin STRC 000000 ext CALLRE 254000 000000 spd HANDSH 000000 ext OF%MOD 007400 000000 sin STRPTR 000000 ext CF%DCN 200000 000000 sin IAC 000377 spd OF%RD 200000 sin SYMOUT 000000 ext CF%WDP 777777 000000 spd IIC% 104000 000132 int OF%WR 100000 sin SYSGT% 104000 000016 int CFIBF% 104000 000100 int INPCLR 000000 ext OPENF% 104000 000021 int SYSLEN 000011 spd CFOBF% 104000 000101 int JFNS% 104000 000030 int P 000017 T1 000001 spd CHKPAR 000000 ext JS%DEV 700000 000000 sin P1 000011 spd T2 000002 spd CIS% 104000 000141 int JS%DIR 070000 000000 sin P2 000012 spd T3 000003 spd CLOSF 104000 000022 int JS%GEN 000070 000000 sin P3 000013 spd T4 000004 spd CLOSF% 104000 000022 int JS%NAM 007000 000000 sin P4 000014 spd T5 000005 spd CLSX1 600160 int JS%PAF 000001 sin P5 000015 spd TCP%NT 000040 000000 spd CNFIG% 104000 000627 int JS%TYP 000700 000000 sin PANDAS 000001 sin TEXT 000000 ext CODE 000000 ext KFORK% 104000 000153 int PARITY 000000 ext TL%AAD 002000 000000 sin CONST 000000 ext KLFLGS 777700 000000 spd PARPKO 000000 ext TL%ABS 010000 000000 sin CRLF 000000 ext LSTRX1 601405 int PARRCK 000000 ext TL%COR 200000 000000 sin CX 000016 MARK 000000 ext PARS3 000000 ext TL%CRO 400000 000000 sin CZ%ABT 004000 000000 sin MO%ABT 010000 000000 sin PARS4 000000 ext TL%SAB 020000 000000 sin DEBRK% 104000 000136 int MO%CON 400000 000000 sin PARS5 000000 ext TL%STA 004000 000000 sin DESX3 600152 int MO%EOM 020000 000000 sin PARS6 000000 ext TLINK 104000 000216 int DESX9 601340 int MO%INT 002000 000000 sin PBOUT 104000 000074 int TOPNRT 000010 spd DEVST% 104000 000121 int MO%NBI 000004 sin PBOUT% 104000 000074 int TOPS20 000010 spd DIC% 104000 000133 int MO%NBO 000002 sin PC%USR 010000 000000 sin TRNBIN 000000 spd DIR% 104000 000130 int MO%PAR 000010 sin PDLSIZ 000310 spd TT%AAD 000400 sin DISMS 104000 000167 int MO%RMT 400000 000000 sin PSOUT% 104000 000076 int TT%ALK 001000 sin DISMS% 104000 000167 int MO%SYN 004000 000000 sin Q1 000005 spd TT%CAR 000001 sin DO 000375 spd MO%WCC 040000 000000 sin Q2 000006 spd TT%DAM 000300 sin DONT 000376 spd MO%WFC 100000 000000 sin Q3 000007 spd TT%DUM 000014 sin DV%AV 010000 000000 sin MOVCHR 000000 ext Q4 000010 spd TT%ECO 004000 sin DV%TYP 000777 000000 sin MTOPR 104000 000077 int Q5 000011 spd TT%LCA 040000 000000 sin DV%UNT 077777 sin MTOPR% 104000 000077 int R 000000 ext TT%LEN 037600 000000 sin DVCHR% 104000 000117 int MXFILW 000034 spd RELD% 104000 000071 int TT%LIC 000020 sin EIR% 104000 000126 int MYCAPS 000000 ext RET 263740 000000 TT%MFF 200000 000000 sin ERJMP 320700 000000 int MYJOB 000000 ext RFBSZ% 104000 000045 int TT%PGM 000002 sin ERJMPR 320500 000000 int MYTTY 000000 ext RFMOD 104000 000107 int TT%TAB 100000 000000 sin ERJMPS 320600 000000 int ND%EXM 400000 000000 sin RFMOD% 104000 000107 int TT%UOC 000040 sin ERRPTR 000000 ext ND%LGL 200000 000000 sin RLJFN% 104000 000023 int TT%WID 000177 000000 sin ERSTR% 104000 000011 int ND%NUM 020000 000000 sin RSKP 000000 ext TT%WKA 010000 sin ESOUT% 104000 000313 int NETFLG 000000 ext RSTLNW 000000 ext TT%WKF 100000 sin ETEXT 000000 ext NETJFN 000000 ext SAVLNW 000000 ext TT%WKN 040000 sin EVEN 000000 ext NODE% 104000 000567 int SC%GTB 200000 000000 sin TT%WKP 020000 sin FRKHX2 600251 int NODNAM 000000 ext SETER% 104000 000336 int TTIPAR 000000 ext GD%PAR 000001 sin NODNUM 000000 ext SFMOD 104000 000110 int TTYINI 000000 ext GDSTS% 104000 000145 int NONE 000000 ext SFMOD% 104000 000110 int TTYJFN 000000 ext GENPAR 000000 ext NOP 600000 000000 sin SIBE% 104000 000102 int TTYNUM 000000 ext GETAB% 104000 000010 int NOUT% 104000 000224 int SIN% 104000 000052 int VI%MAJ 077700 000000 sin GETER% 104000 000012 int NTBLEN 000010 spd SINR% 104000 000531 int VI%MIN 000077 000000 sin k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page S-2 K20NET MAC 4-Apr-23 00:43 SYMBOL TABLE WAIT% 104000 000306 int .DVDCN 000022 sin 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 .MOSNT 000034 sin .DCX1 000001 sin .MOXOF 000043 sin .DCX10 000012 sin .NDFLG 000001 sin .DCX11 000013 sin .NDGLN 000001 sin .DCX2 000002 sin .NDGNM 000003 sin .DCX21 000025 sin .NDNOD 000000 sin .DCX22 000026 sin .NDNUM 000002 sin .DCX23 000027 sin .NDVFX 000023 sin .DCX24 000030 sin .NDVFY 000015 sin .DCX3 000003 sin .NULIO 377777 sin .DCX32 000040 sin .NWABC 000000 sin .DCX33 000041 sin .NWLIN 000002 sin .DCX34 000042 sin .NWNNP 000003 sin .DCX35 000043 sin .NWNU1 000006 sin .DCX36 000044 sin .NWRRH 000000 sin .DCX37 000045 sin .NWTTF 000004 sin .DCX38 000046 sin .PRIOU 000101 sin .DCX39 000047 sin .PX7 610001 000000 spd .DCX4 000004 sin .SAC 000016 .DCX40 000050 sin .SAV1 000000 ext .DCX41 000051 sin .SAV2 000000 ext .DCX42 000052 sin .SAV3 000000 ext .DCX43 000053 sin .TTDES 400000 sin .DCX5 000005 sin .XSTKS 000000 ext .DCX6 000006 sin .DCX7 000007 sin .DCX8 000010 sin .DCX9 000011 sin k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page S-3 K20NET MAC 4-Apr-23 00:43 SYMBOL TABLE FOR PSECT CODE ASGDEV 003510' ext DOBIT4 004224' NRTEND 002743' UNARPA 004551' ASGFLG 003507' ext DOBITS 004120' ent NRTLEN 000016 spd UNARPX 004621' ASIPTY 001056' ent DOESC 001726' ext NRTMSG 002233' UNBITS 004454' ent ATMBUF 001415' ext DUPLEX 001764' ext NTECH0 002117' UNSNBM 004323' BBNTVT 004064' ECHO 001772' ext NTECH1 002130' VTERMF 004443' ext BOUTR% 001601' ent ERRPTR 004571' ext NTECH2 002144' VTMOUT 001731' CARIER 004217' ext ESCAPE 001715' ext NTECHO 002110' VTMPSH 001640' ent CCOFF2 004432' ext FILJFN 004442' ext NTIDEV 004025' WAITCC 000512' CCON 000347' ext FIXNAM 000603' NUL4 001544' ext WAITCN 000330' CHKCLS 002703' FLOW 004230' ext OPENET 003226' ent WAITDN 000405' CHKDCN 003755' FLUSHC 000310 spd OPENRT 000262' WAITM1 000530' CHKLIN 003622' ent FRKCHB 000000 ext OPNPTY 003350' WAITMO 000522' CHKLJF 004000' FRKCHN 000000 ext OPNTTY 003454' WAITPR 000407' CHKNBM 004247' ent FRTRAP 002214' ent PARIER 002171' WAITUN 000503' CHKNRT 000236' GENPAR 001754' ext PARITY 002001' ext $CF%WD 000000 spd CHKPAR 002103' ext GETNAM 000077' ent PARPKO 002004' ext $CONN1 001252' CHKPTY 003767' GETNOD 000145' PARRCK 002006' ext $CONN2 001427' CHKTOP 000627' GETNTI 004024' ent PARS3 001241' ext $CONNE 001204' ent CHKTTY 003662' GNDFIL 005044' PARS4 001273' ext $CONNX 003166' ext CHKTVT 004052' ent GNDPAR 004625' ent PARS5 001576' ext $SETLN 001165' ent CLRBUF 002252' ent GTTYJF 003513' PARS6 000360' ext $WAITJ 000365' sin CLREAD 002515' ent HANDSH 004227' ext PC3 002226' ext %%JSER 005015' ext CLREST 002454' ent HONK 002170' POSTAB 000137' ..0005 000034' spd CLSABT 002770' HSTTYN 000000000000# pol PTYFLS 002356' ..0006 000035' spd CLSASG 003007' HSTTYP 000763' int R 005100' ext ..0013 000033' spd CLSCLN 003053' INIL2 004107' RESLIN 004430' ent ..0021 000053' spd CLSCOM 002757' INILIN 004105' ent RRSL2 004433' ent ..0022 000055' spd CLSFE 002757' INIPTY 001035' ent RRSLIN 004432' ent ..0024 000061' spd CLSJFN 002673' ent INPCLR 002516' ext RSKP 005113' ext ..0036 000066' spd CLSNET 002676' ent INTMSG 001006' ent RSTLNW 004523' ext ..0037 000071' spd CLSNRT 002750' JS%ALL 111110 000001 spd SAVLNW 004210' ext ..0046 000120' spd CLSPTY 002757' LCLNOD 000000' ent SESFLG 002156' ext ..0047 000137' spd CLSRLJ 003002' LINLEN 002000 spd SESJFN 002154' ext ..0055 000122' spd CNFLEN 000200 spd LOCAL 004560' ext SETDEF 000176' ent ..0056 000130' spd CRLF 003207' ext MDMLIN 004222' ext SETNBM 004261' ..0063 000153' spd CYOFF 000452' ext MONV 003734' ext SETSPD 003732' ext ..0072 000154' spd CYON 000351' ext MOVCHR 002141' ext SHUTDN 000441' ..0073 000165' spd CYSEEN 000371' ext MYCAPS 000000 ext SPEED 003742' ext ..0101 000154' spd DCNFLS 002306' MYJOB 003303' ext SRVFLG 004430' ext ..0102 000161' spd DEADEV 003447' MYTTY 003601' ext SYMOUT 003134' ext ..0110 000202' spd DECERR 000544' ent NBMERR 004321' TIMDEL 005041' ext ..0111 000205' spd DECNCT 000213' ent NETER2 003172' TIMEON 005035' ext ..0116 000246' spd DELAY 000361' ext NETERR 002200' TTER1 001725' ext ..0117 000250' spd DEVABF 005042' NETFLG 003550' ext TTFORK 002223' ext ..0126 000271' spd DEVABT 005034' NETIN 001775' ent TTINCH 001730' ext ..0127 000275' spd DEVCLT 005023' NETINH 003174' TTIPAR 002175' ext ..0146 000364' spd DEVPAR 004666' NETINM 003215' TTSFRK 001600' ext ..0161 000364' spd DNCFLD 000000 ext NETJFN 004556' ext TTXON 002613' ent ..0162 000405' spd DNCHB 000000 ext NETLGX 002166' ext TTXON2 002646' ..0167 000373' spd DNDFLD 000000 ext NETVTX 003073' ent TTXON3 002666' ..0170 000402' spd DNTRAP 000535' ent NIENTE 000170' TTYINI 001433' ext ..0172 000400' spd DOARPA 004354' ent NODNAM 005476' ext TTYJFN 004566' ext ..0173 000427' spd DOARPX 004424' NODNUM 001414' ext TTYNUM 004543' ext ..0203 000435' spd DOBIT2 004160' NONE 002002' ext TVTCHK 004052' ext ..0253 000562' spd DOBIT3 004166' NRTBRK 002236' ent TVTFLG 004551' ext ..0262 000566' spd k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page S-4 K20NET MAC 4-Apr-23 00:43 SYMBOL TABLE FOR PSECT CODE ..0263 000575' spd ..1035 001534' spd ..1504 002450' spd ..2115 003250' spd ..0270 000574' spd ..1050 001574' spd ..1505 002425' spd ..2116 003252' spd ..0272 000577' spd ..1051 001576' spd ..1522 002430' spd ..2117 003247' spd ..0336 000611' spd ..1060 001554' spd ..1523 002450' spd ..2131 003243' spd ..0344 000653' spd ..1061 001563' spd ..1527 002460' spd ..2132 003245' spd ..0351 000654' spd ..1070 001570' spd ..1535 002500' spd ..2133 003247' spd ..0356 000675' spd ..1102 001612' spd ..1547 002476' spd ..2134 003257' spd ..0367 000723' spd ..1117 001627' spd ..1550 002500' spd ..2146 003272' spd ..0374 000730' spd ..1120 001637' spd ..1551 002475' spd ..2154 003267' spd ..0375 000742' spd ..1131 001640' spd ..1565 002512' spd ..2162 003312' spd ..0404 000756' spd ..1132 001730' spd ..1566 002513' spd ..2170 003307' spd ..0451 001041' spd ..1142 001703' spd ..1567 002511' spd ..2176 003343' spd ..0452 001043' spd ..1143 001727' spd ..1577 002522' spd ..2204 003340' spd ..0453 001044' spd ..1144 001664' spd ..1605 002526' spd ..2206 003327' spd ..0460 001050' spd ..1161 001755' spd ..1620 002527' spd ..2213 003340' spd ..0461 001052' spd ..1177 001771' spd ..1621 002606' spd ..2220 003326' spd ..0463 001105' spd ..1200 001774' spd ..1622 002546' spd ..2226 003333' spd ..0475 001070' spd ..1205 002013' spd ..1627 002547' spd ..2227 003335' spd ..0476 001072' spd ..1206 002015' spd ..1634 002544' spd ..2231 003340' spd ..0505 001114' spd ..1214 002015' spd ..1635 002545' spd ..2246 003367' spd ..0506 001136' spd ..1215 002110' spd ..1636 002542' spd ..2247 003401' spd ..0513 001121' spd ..1216 002021' spd ..1652 002561' spd ..2250 003404' spd ..0514 001122' spd ..1233 002036' spd ..1653 002562' spd ..2257 003411' spd ..0516 001133' spd ..1234 002043' spd ..1654 002560' spd ..2260 003421' spd ..0530 001203' spd ..1237 002055' spd ..1671 002567' spd ..2264 003431' spd ..0536 001176' spd ..1244 002107' spd ..1672 002603' spd ..2271 003432' spd ..0550 001252' spd ..1245 002051' spd ..1702 002634' spd ..2300 003467' spd ..0556 001215' spd ..1260 002055' spd ..1712 002641' spd ..2317 003535' spd ..0562 001223' spd ..1261 002107' spd ..1724 002656' spd ..2320 003547' spd ..0574 001230' spd ..1262 002101' spd ..1725 002665' spd ..2321 003552' spd ..0602 001236' spd ..1273 002105' spd ..1732 002706' spd ..2330 003557' spd ..0610 001245' spd ..1306 002124' spd ..1733 002712' spd ..2331 003567' spd ..0621 001271' spd ..1307 002127' spd ..1734 002713' spd ..2335 003576' spd ..0627 001261' spd ..1317 002167' spd ..1741 002720' spd ..2342 003577' spd ..0637 001266' spd ..1324 002206' spd ..1742 002724' spd ..2347 003605' spd ..0647 001344' spd ..1336 002224' spd ..1743 002726' spd ..2350 003615' spd ..0655 001310' spd ..1344 002262' spd ..1753 002756' spd ..2357 003637' spd ..0657 001303' spd ..1357 002263' spd ..1754 002757' spd ..2360 003645' spd ..0675 001314' spd ..1360 002304' spd ..1762 002763' spd ..2373 003670' spd ..0703 001321' spd ..1365 002274' spd ..1763 002767' spd ..2374 003675' spd ..0713 001337' spd ..1366 002304' spd ..1771 002775' spd ..2400 003705' spd ..0721 001330' spd ..1374 002316' spd ..1772 003001' spd ..2405 003710' spd ..0722 001335' spd ..1412 002320' spd ..2000 003006' spd ..2406 003711' spd ..0736 001422' spd ..1413 002353' spd ..2001 003007' spd ..2413 003715' spd ..0741 001372' spd ..1420 002331' spd ..2003 003016' spd ..2414 003723' spd ..0746 001366' spd ..1421 002352' spd ..2015 003015' spd ..2420 003731' spd ..0747 001370' spd ..1431 002332' spd ..2016 003016' spd ..2425 003732' spd ..0750 001371' spd ..1432 002352' spd ..2020 003041' spd ..2426 003743' spd ..0751 001403' spd ..1436 002366' spd ..2025 003047' spd ..2434 003740' spd ..0761 001413' spd ..1454 002371' spd ..2032 003052' spd ..2441 003743' spd ..0776 001452' spd ..1455 002451' spd ..2033 003053' spd ..2445 003765' spd ..1003 001507' spd ..1462 002404' spd ..2037 003115' spd ..2452 003766' spd ..1010 001472' spd ..1463 002414' spd ..2053 003127' spd ..2457 004004' spd ..1015 001475' spd ..1464 002402' spd ..2075 003146' spd ..2460 004014' spd ..1030 001532' spd ..1503 002426' spd ..2076 003167' spd ..2461 004015' spd k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page S-5 K20NET MAC 4-Apr-23 00:43 SYMBOL TABLE FOR PSECT CODE ..2472 004114' spd ..2504 004137' spd ..2545 004254' spd ..2546 004257' spd ..2547 004260' spd ..2554 004301' spd ..2570 004344' spd ..2604 004351' spd ..2605 004353' spd ..2613 004377' spd ..2637 004442' spd ..2641 004450' spd ..2653 004473' spd ..2703 004574' spd ..2723 004635' spd ..2732 004661' spd ..2737 004664' spd ..2740 004666' spd ..2745 004674' spd ..2746 004676' spd ..2747 004711' spd ..2754 004711' spd ..2765 004725' spd ..2766 004734' spd ..2767 004750' spd ..3001 004764' spd ..3012 004767' spd ..3020 005000' spd ..3021 005004' spd ..3026 005004' spd ..3037 005072' spd ..3040 005075' spd ..3045 005110' spd ..3046 005112' spd ..3047 005114' spd ..3054 005120' spd ..3055 005121' spd ..CSC 000004 spd ..CSN 000003 spd ..IFT 400001 spd ..JX1 400000 spd ..MX1 070000 300000 spd ..MX2 000000 spd ..PST 000003 spd ..TX1 400000 spd ..TX2 000001 spd .XSTKS 005045' ext k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page S-6 K20NET MAC 4-Apr-23 00:43 SYMBOL TABLE FOR PSECT TEXT DEFNAM 000000' k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page S-7 K20NET MAC 4-Apr-23 00:43 SYMBOL TABLE FOR PSECT CONST ALLFLD 000160' DATA 000000 ext NRTADR 000000' NRTDEV 000001' NRTNUM 000002' NSPTAB 000016' .SAV1 000000 ext .SAV2 000000 ext .SAV3 000000 ext k20net - Kermit-20 Network Support MACRO %53B(1254)-4 15:18 11-Jun-23 Page S-8 K20NET MAC 4-Apr-23 00:43 SYMBOL TABLE FOR PSECT DATA BINFLG 000101' int TTYNAM 002112' int CNFIGD 000000' VBICT 002121' int CNFMSG 000033' VBOCT 002122' int FLUSHB 002136' VCHRCN 002135' int FRKBUF 000471' VSICT 002123' int FRKPDL 000161' VSIMX 002125' int HAVNBM 000073' VSITC 002124' int INITED 000066' VSOCT 002126' int INTBUF 000152' VSOMX 002130' int JOB 000103' VSOTC 002127' int MYNAME 000012' int MYNODE 000011' int MYPROM 000027' int NBICT 002131' int NDVCHR 002100' int NDVFXP 000014' int NRTBUF 001072' NRTFLG 000100' int NRTOBJ 000114' NRTPRT 000102' NRTROS 000076' int NSICI 002132' int NSIMX 002134' int NSITC 002133' int NTIBLK 002221' int NTIHST 002231' OASFLG 000104' OLDDIM 000070' OLDJFN 000106' OLDLTS 000075' OLDMOD 000067' OLDNAM 000110' OLDNUM 000107' OLDPAU 000071' OPNDEV 002115' OPNPAR 002120' int OPNSTS 002116' int OSGDEV 000105' PARBUF 001473' PTY1ST 002075' PTYCNT 002076' PTYDEV 002106' int PTYFLG 002102' int PTYGTB 002077' PTYNAM 002103' int PTYTTY 002107' int ROSNPT 000077' int SETLTS 000074' SYSCNT 000015' int SYSMSG 000072' SYSNAM 000016' int SYSVER 000032' TTYDEV 002111' int TTYFLG 002110' TTYGTB 002074' K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 1 K20TIM MAC 3-Apr-23 23:45 All edit 216 except for some 207 code moved 30120 title K20TIM - Kermit (Virtual) Device Timing 30121 subttl All edit 216 except for some 207 code moved 30122 30123 Comment " ; Make gnuEmacs font-rot mode happy 30124 30125 The module provides basic loopback tests on various devices, currently 30126 all virtual. These are called speed tests because the results are 30127 used to validate the calculations for the efficiency rating of the 30128 line in the statistics output. 30129 30130 Other routines concerned with timing and load average may be found 30131 here. 30132 30133 Loopback tests could be provided for a physical line, but this would 30134 require taking the line out of service and fitting it with a loopback 30135 connector. For now, it is assumed that the baud rate is both 30136 correctly reported and used. 30137 30138 Please read the following VERY carefully: 30139 30140 1) The reported speed can vary WILDLY depending on other system 30141 activity and is easily peturbed for no readily apparent 30142 reason. 30143 30144 2) The speed itself is only reporting how fast the monitor is 30145 shuttling data around and has no basis in any physical 30146 transport, media or reality. 30147 30148 3) Changing the various mode, byte sizes and record lengths of 30149 the connection can produce speed changes, but these are of 30150 little pratical use other than determining what might be the 30151 most effective connection configuration. 30152 30153 4) Be particularly wary of the byte size for essentially 30154 meaningless results. It's largely here for DECnet testing 30155 and to see what the pseudo-terminal device driver might be 30156 stripping. 30157 30158 5) While it is possible to time intervals to 100 kHz (I.E., DK10) 30159 resolution, it is fundamentally impossible to accurately 30160 correlate such intervals with the time of day. This is 30161 because Tops-20 keeps the time of day as an 18 bit fixed point 30162 fraction, which works out to a 'Time of Day' tick being 30163 approximately 329.58858646932 milliseconds. 30164 30165 However, there is no way to tell when Tops-20 will advance 30166 this because the last system set time (TADIDT) as calculated 30167 STAD% is not available nor is the millisecond uptime counter 30168 that is used to calculate it. The problem is made worse 30169 because there is thus no public correlation between HPTIM%, 30170 either. 30171 30172 The problem really can't be resolved without a change to 30173 Tops-20 to make TADIDT available and to store the elapsed 30174 millisecond clock that was used to do the calculation. K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 1-1 K20TIM MAC 3-Apr-23 23:45 All edit 216 except for some 207 code moved 30175 30176 This is not a problem for commands that display elapsed time, 30177 such as CLEAR. It is a problem for logging where using HPTIM% 30178 can occasionally produce the effect of time going backwards. 30179 " 30180 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 2 K20TIM MAC 3-Apr-23 23:45 Preliminaries 30181 subttl Preliminaries 30182 30183 search monsym,macsym,cmd,k20unv 30184 search dcam ; Double compare macros 30185 cmdacs ^ ; Clean up p1-p4 definitions 30186 30187 sall ; Tidy listing 30188 .directive flblst ; We don't need to see all the ASCIZ bytes... 30189 30190 remark common parsing external data and usage 30191 30192 extern pars1 ; Contains address of .TIME 30193 extern pars2 ; Parsed device id 30194 extern pars3 ; OPENF% mode 30195 extern pars4 ; OPENF% byte size 30196 extern pars5 ; Buffer size (RECORD-LENGTH) 30197 30198 remark ; Various support routines 30199 extern ascdev ; Turns a device number into ASCII text 30200 extern %%jser ; JSYS error handler 30201 extern %%smsg ; smsg macro support 30202 extern BOUTI% ;[216] BOUT% Internal 30203 extern symout ; Get symbolic name and offset of an address 30204 remark $TIME ; Is found in k20dsp and invokes the timing routines 30205 30206 remark ; Various external variables 30207 extern crlf ; Carriage return line feed sequence 30208 30209 remark ; Some constants 30210 30211 000511 456000 msiday==^d86400000 ; Milliseconds in a day 30212 100276 770000 dkday==msiday*^d100 ; 100 DK10 ticks per millisecond 30213 000001 000000 todtic==^d262144 ; TOD ticks in a day 30214 30215 .psect code/ronly ; Don't allow stores!! 30216 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 3 K20TIM MAC 3-Apr-23 23:45 TIME command parse table 30217 subttl TIME command parse table 30218 30219 remark ; Common Names of devices we can test 30220 30221 000000'02 000000 000000 %table(timtab) ; Begin a keyword table 30222 000001'02 000000# 777777 %key2 , -1 ; Copy anotherdevice's baud 30223 000000'03 143 157 160 171 000 30224 000002'02 000000# 600015 %key2 , .dvdes!.dvnul ; Idiomatic for NUL: 30225 000001'03 144 141 164 141 055 30226 000003'02 000000# 600022 %keyf3 , .dvdes!.dvdcn, cm%inv ; Allows escape recognition 30227 000003'03 002000 000001 30228 000004'03 104 103 116 000 000 30229 000004'02 000000# 600022 %key2 , .dvdes!.dvdcn ; Means either SRV: or DCN: 30230 000005'03 104 105 103 156 145 30231 000005'02 000000# 777777 %keyf3 , -1, cm%inv ; When Tom gets sleepy 30232 000007'03 002000 000001 30233 000010'03 144 165 160 154 151 30234 000006'02 000000# 000010' %keyf3 , %NUL, cm%inv!cm%abr ; Prefer NUL over NRT 30235 000012'03 002000 000005 30236 000013'03 156 000 000 000 000 30237 000007'02 000000# 600022 %keyf3 , .dvdes!.dvdcn, cm%inv ; Sleepy Tom types this 30238 000014'03 002000 000001 30239 000015'03 116 122 124 000 000 30240 000010'02 000000# 600015 %nul: %keyf3 , .dvdes!.dvnul, cm%inv ; Allows escape recognition 30241 000016'03 002000 000001 30242 000017'03 116 125 114 000 000 30243 000011'02 000000# 000013' %keyf3 , %pipe, cm%inv!cm%abr ; Prefer pipe over PIP: 30244 000020'03 002000 000005 30245 000021'03 160 151 000 000 000 30246 000012'02 000000# 600403 %keyf3 , .dvdes!.dvpip, cm%inv ; Allows escape recognition 30247 000022'03 002000 000001 30248 000023'03 120 111 120 000 000 30249 000013'02 000000# 600403 %pipe: %key2 , .dvdes!.dvpip ; Idiomatic for PIP: 30250 000024'03 160 151 160 145 000 30251 000014'02 000000# 600013 %key2 , .dvdes!.dvpty ; Idiotmatic for PTY: 30252 000025'03 160 163 145 165 144 30253 000015'02 000000# 600013 %keyf3 , .dvdes!.dvpty, cm%inv ; Don't specify device number 30254 000031'03 002000 000001 30255 000032'03 120 124 131 000 000 30256 000016'02 000000# 000020' %keyf3 , %reus, cm%inv!cm%abr ; Prefer re-use over reuse 30257 000033'03 002000 000005 30258 000034'03 162 000 000 000 000 30259 000017'02 000000# 000020' %keyf3 , %reus, cm%inv!cm%abr ; Prefer re-use over reuse 30260 000035'03 002000 000005 30261 000036'03 162 145 000 000 000 30262 000020'02 000000# 777777 %reus: %keyf3 , -1, cm%inv ; Previous dumb name for copy 30263 000037'03 002000 000001 30264 000040'03 162 145 055 165 163 30265 000021'02 000000# 777777 %keyf3 , -1, cm%inv ; Ditto 30266 000042'03 002000 000001 30267 000043'03 162 145 165 163 145 30268 000022'02 000000# 600023 %keyf3 , .dvdes!.dvsrv, cm%inv ; Allows escape recognition 30269 000045'03 002000 000001 30270 000046'03 123 122 126 000 000 30271 000000'02 000022 000022 %tbend K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 3-1 K20TIM MAC 3-Apr-23 23:45 TIME command parse table 30272 cleans(<%nul,%pipe,%reus>) ; Pitch working symbols 30273 30274 chgsec(code,const) ;;Chained FDB's go into CONST area 30275 000023'02 000004 000026' timfdb: flddb. .cmkey,,timtab,,,timfd1 30276 000024'02 000000 000000' 30277 000025'02 44 07 0 00 000351' 30278 000026'02 016004 000000 timfd1: flddb. .cmdev,,, 30279 000027'02 000000 000000 30280 000030'02 44 07 0 00 000355' 30281 retsec ;;Restore psect assumptions 30282 cleans() ;;Toss working symbol 30283 30284 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 4 K20TIM MAC 3-Apr-23 23:45 TIME (device) command parsing 30285 subttl TIME (device) command parsing 30286 30287 000000'01 .time: intern .time ; Invoked by top level parser 30288 000000'01 265 16 0 00 003413' saveac ; Just in case 30289 000001'01 200 16 0 00 000000# guide (virtual speed of) 30290 000002'01 260 17 0 00 000000* 30291 000031'02 000000000000# 30292 000000'04 166 151 162 164 165 30293 30294 000003'01 477 01 0 00 000002 setob t1, t2 ; Cons up some talisman 30295 000004'01 124 01 0 00 000000* dmovem t1, pars2 ; No device nor OPENF% mode parsed 30296 000005'01 124 01 0 00 000000* dmovem t1, pars4 ; No OPENF% byte size 30297 000006'01 202 01 0 00 000000# movem t1, timdev ; Device being timed 30298 30299 000007'01 201 01 0 00 000000# movei t1, timfdb ; Parse a device as a keyword or something real 30300 000010'01 260 17 0 00 000000* call rfield ; Try to get something 30301 000011'01 135 04 0 00 003421' ldb t4, [pointr (.cmfnp(t3),cm%fnc)] ; Get parse function taken 30302 30303 000012'01 302 04 0 00 000000 caie t4, .cmkey ; Did a nice name? 30304 000013'01 254 00 0 00 000020' ifskp. ; Yep, that's not very difficult 30305 000014'01 524 02 0 02 000000 hrlo t2, (t2) ; Turn semantic action into a device designator 30306 000015'01 316 02 0 00 003422' camn t2, [-1] ; Wants to use a device's results elsewhere? 30307 000016'01 254 00 0 00 000125' callret .copy ; Yes, do that 30308 000017'01 201 04 0 00 000016 movei t4, .cmdev ; Otherwise, say we parsed a device 30309 000020'01 endif. ; And take the device case 30310 30311 000020'01 302 04 0 00 000016 caie t4, .cmdev ; Explicitly specified the device? 30312 000021'01 254 00 0 00 000040' ifskp. ; Yes, that's not much harder 30313 000022'01 554 01 0 00 000002 hlrz t1, t2 ; Pick up bare device designator 30314 000023'01 620 01 0 00 600000 txz t1, .dvdes ; Shut off the universal device code 30315 000024'01 202 01 0 00 000004* movem t1, pars2 ; Finally save just the device type number 30316 30317 000025'01 306 01 0 00 000013 cain t1, .dvpty ; Pseudo-terminal? 30318 000026'01 254 00 0 00 000052' callret parpty ; Yes, maybe parse its switch modifiers 30319 000027'01 306 01 0 00 000403 cain t1, .dvpip ; Pipe device? 30320 000030'01 254 00 0 00 000054' callret parpip ; Yes, maybe parse its switch modifiers 30321 000031'01 306 01 0 00 000015 cain t1, .dvnul ; NULL (or NIL) device? 30322 000032'01 254 00 0 00 000056' callret parnul ; Yes, maybe parse its bytesize modifier 30323 000033'01 302 01 0 00 000023 caie t1, .dvsrv ; DECnet passive component? 30324 000034'01 306 01 0 00 000022 cain t1, .dvdcn ; or DECnet active component 30325 000035'01 254 00 0 00 000060' callret pardcn ; Yes, maybe parse its switch modifiers 30326 ; None of the above, so nothing special 30327 000036'01 260 17 0 00 000000* confrm ; Tie off the line 30328 000037'01 263 17 0 00 000000 ret ; And done 30329 000040'01 endif. ; End case .cmdev parse item 30330 30331 000040'01 broken: remark ; Otherwise, we are deeply confused 30332 000040'01 200 01 0 00 000000# emsg() ; Begin the blat 30333 000041'01 104 00 0 00 000313 30334 000032'02 000000000000# 30335 000004'04 111 156 166 141 154 30336 000042'01 201 01 0 00 000101 movei t1, .priou ; Continue blatting on the terminal 30337 000043'01 200 02 0 00 000004 move t2, t4 ; Loaded the parsed function 30338 000044'01 201 03 0 00 000010 movei t3, fld(^d8,no%rdx) ;Function codes are octal 30339 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 15:19 11-Jun-23 Page 4-1 K20TIM MAC 3-Apr-23 23:45 TIME (device) command parsing 30340 000046'01 320 12 0 00 000047' erjmpr .+1 ; Ignore error, we're trying hard enough 30341 30342 000047'01 561 01 0 00 000000* hrroi t1, crlf ; Tie off the blat 30343 000050'01 104 00 0 00 000076 PSOUT% 30344 000051'01 263 17 0 00 000000 ret ; And go no further 30345 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 5 K20TIM MAC 3-Apr-23 23:45 Device secondary parse tables and function descriptor blocks 30346 subttl Device secondary parse tables and function descriptor blocks 30347 30348 remark Various switches for each device 30349 30350 000033'02 000000 000000 %table(nulswi) ; General device switch table 30351 000034'02 000000# 000000# %key2 ,parbyt ;Parse byte size 30352 000047'03 142 171 164 145 163 30353 000033'02 000001 000001 %tbend 30354 30355 000035'02 000000 000000 %table(devswi) ; General device switch table 30356 000036'02 000000# 000000# %key2 ,parbyt ;Parse byte size 30357 000051'03 142 171 164 145 163 30358 000037'02 000000# 000000# %key2 ,parmod ; Parse mode 30359 000053'03 155 157 144 145 072 30360 000035'02 000002 000002 %tbend 30361 30362 000040'02 000000 000000 %table(pipswi) ; Begin a special switch table for pipes 30363 000041'02 000000# 000000# %key2 ,parbyt ;Parse byte size 30364 000055'03 142 171 164 145 163 30365 000042'02 000000# 000000# %key2 ,parmod ; Parse mode 30366 000057'03 155 157 144 145 072 30367 000043'02 000000# 000000# %key2 ,parecl 30368 000061'03 162 145 143 157 162 30369 000040'02 000003 000003 %tbend 30370 30371 remark Switches applicable to potentiall all devices 30372 30373 000044'02 000000 000000 %table(modkey) ; N.B., Not all devices support all modes!! 30374 000045'02 000000# 000017 %keyf3 ,.GSDMP, cm%inv ;N.B., No device here supports dump mode 30375 000064'03 002000 000001 30376 000065'03 144 165 155 160 000 30377 000046'02 000000# 000047' %keyf3 , %imag, cm%abr!cm%inv 30378 000066'03 002000 000005 30379 000067'03 151 000 000 000 000 30380 000047'02 000000# 000010 %imag: %key2 , .GSIMG 30381 000070'03 151 155 141 147 145 30382 000050'02 000000# 000001 %keyf3 ,.GSSMB, cm%inv 30383 000072'03 002000 000001 30384 000073'03 151 156 164 145 162 30385 000051'02 000000# 000000 %key2 ,.GSNRM 30386 000076'03 156 157 162 155 141 30387 000052'02 000000# 000001 %key2 , .GSSMB 30388 000100'03 163 155 141 154 154 30389 000044'02 000006 000006 %tbend 30390 cleans(<%imag>) ;;Clean working symbol out of MACRO tables 30391 30392 chgsec(code,const) ;;Chained FDB's are in CONST, not code 30393 000053'02 010004 000056' parfdb: flddb. .cmcfm,,,,,parfd1 30394 000054'02 000000 000000 30395 000055'02 44 07 0 00 000365' 30396 000056'02 003000 000000 parfd1: flddb. .cmswi,,devswi, ;; or OPENF% mode modifiers 30397 000057'02 000000 000035' 30398 30399 000060'02 010004 000063' pipfdb: flddb. .cmcfm,,,,,pipfd1 30400 000061'02 000000 000000 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 5-1 K20TIM MAC 3-Apr-23 23:45 Device secondary parse tables and function descriptor blocks 30401 000062'02 44 07 0 00 000376' 30402 000063'02 003000 000000 pipfd1: flddb. .cmswi,,pipswi ;; or OPENF% mode and GTJFN% modifiers 30403 000064'02 000000 000040' 30404 30405 000065'02 010004 000070' nilfdb: flddb. .cmcfm,,,,,nilfd1 30406 000066'02 000000 000000 30407 000067'02 44 07 0 00 000405' 30408 000070'02 003000 000000 nilfd1: flddb. .cmswi,,nulswi, ;; NIL was the original TENEX name for NUL: 30409 000071'02 000000 000033' 30410 30411 000072'02 010004 000075' dcnfdb: flddb. .cmcfm,,,,,dcnfd1 30412 000073'02 000000 000000 30413 000074'02 44 07 0 00 000415' 30414 000075'02 003000 000000 dcnfd1: flddb. .cmswi,,devswi, ;; or OPENF% mode and GTJFN% modifiers 30415 000076'02 000000 000035' 30416 30417 30418 retsec ;;Back to code .psect 30419 cleans() 30420 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 6 K20TIM MAC 3-Apr-23 23:45 Device secondary (switch) parsing 30421 subttl Device secondary (switch) parsing 30422 30423 000052'01 201 05 0 00 000000# parpty: movei q1, parfdb ; Handle case of pseudo terminal 30424 000053'01 254 00 0 00 000062' callret parswi ; Now parse for PTY:'s switches 30425 30426 000054'01 201 05 0 00 000000# parpip: movei q1, pipfdb ; Handle pipe device 30427 000055'01 254 00 0 00 000062' callret parswi ; Now parse for PIP:'s switches 30428 30429 000056'01 201 05 0 00 000000# parnul: movei q1, nilfdb ; Handle NUL: (or NIL) device 30430 000057'01 254 00 0 00 000062' callret parswi ; Now parse for NUL:'s switches 30431 30432 000060'01 201 05 0 00 000000# pardcn: movei q1, dcnfdb ; Handle DECnet (SRV:/DCN:) device 30433 000061'01 254 00 0 00 000062' callret parswi ; Now parse for DCN:'s switch 30434 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 7 K20TIM MAC 3-Apr-23 23:45 Common secondary switch parsing 30435 subttl Common secondary switch parsing 30436 30437 000062'01 parswi: do. ; Enter loop logical context 30438 000062'01 200 01 0 00 000005 move t1, q1 ; Load the requested parse FDB 30439 000063'01 260 17 0 00 000010* call rfield ; Go parse something 30440 000064'01 135 04 0 00 003421' ldb t4, [pointr (.cmfnp(t3),cm%fnc)] ; Get parse function taken 30441 000065'01 306 04 0 00 000010 cain t4, .cmcfm ; Confirmed? 30442 000066'01 263 17 0 00 000000 ret ; They did, we're done 30443 000067'01 550 01 0 02 000000 hrrz t1, (t2) ; Otherwise, we have a switch to do 30444 000070'01 260 17 0 01 000000 call (t1) ; So Pick up switch parsed and call it 30445 000071'01 600 00 0 00 000000 nop ; Ignore any skip/non-skip (none currently skip) 30446 000072'01 254 00 0 00 000062' loop. ; Go get some more switches until confirmed 30447 000073'01 enddo. ; End loop lexical context 30448 30449 remark Here to handle BYTESIZE, MODE and RECORD-LENGTH switches 30450 30451 000073'01 parbyt: remark Parse file byte size 30452 000073'01 201 01 0 00 003427' movei t1, [flddb. .cmnum,,^d10,] 30453 000074'01 260 17 0 00 000063* call rfield ; Get a number 30454 000075'01 327 02 0 00 000101' ifle. t2 ; Gubbish? 30455 000076'01 200 01 0 00 000000# emsg 30456 000077'01 104 00 0 00 000313 30457 000077'02 000000000000# 30458 000013'04 111 154 154 157 147 30459 000100'01 254 00 0 00 000000* jrst cmder1 ; Complain and allow command retry. 30460 000101'01 endif. 30461 000101'01 307 02 0 00 000044 caig t2,^d36 ; Being overly bullish? 30462 000102'01 254 00 0 00 000106' ifskp. ; Then it isn't a DIGITAL computer... 30463 000103'01 200 01 0 00 000000# emsg 30464 000104'01 104 00 0 00 000313 30465 000100'02 000000000000# 30466 000025'04 124 150 145 040 120 30467 000105'01 254 00 0 00 000100* jrst cmder1 ; Complain and allow command retry. 30468 000106'01 endif. 30469 000106'01 202 02 0 00 000005* movem t2, pars4 ; Store byte size for OPENF% 30470 000107'01 263 17 0 00 000000 ret ; Get more switches 30471 30472 000110'01 parmod: remark Parse file mode 30473 000110'01 201 01 0 00 003436' movei t1, [flddb. .cmkey,,modkey,] 30474 000111'01 260 17 0 00 000074* call rfield ; Get a keyword 30475 000112'01 550 01 0 02 000000 hrrz t1, (t2) ; Turn semantic action into a mode value 30476 000113'01 202 01 0 00 000000* movem t1, pars3 ; Store OPENF% mode 30477 000114'01 263 17 0 00 000000 ret ; Get more switches 30478 30479 000115'01 parecl: remark Parse RECORD-LENGTH attrbute 30480 000115'01 201 01 0 00 003445' movei t1, [flddb. .cmnum,,^d10,] 30481 000116'01 260 17 0 00 000111* call rfield ; Get a number 30482 000117'01 327 02 0 00 000123' ifle. t2 ; Gubbish? 30483 000120'01 200 01 0 00 000000# emsg 30484 000121'01 104 00 0 00 000313 30485 000101'02 000000000000# 30486 000042'04 111 154 154 157 147 30487 000122'01 254 00 0 00 000105* jrst cmder1 ; Complain and allow command retry. 30488 000123'01 endif. 30489 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 15:19 11-Jun-23 Page 7-1 K20TIM MAC 3-Apr-23 23:45 Common secondary switch parsing 30490 000124'01 263 17 0 00 000000 ret ; Get more switches 30491 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 8 K20TIM MAC 3-Apr-23 23:45 Copy one device's speed test over another's 30492 subttl Copy one device's speed test over another's 30493 30494 ; Useful because inter-fork pseudo-terminal speed is FAR slower than 30495 ; inter-job speed, resulting in efficiency percentages in the 30496 ; quadruple digit range. 30497 30498 remark ; Common Names of device tests we can copy 30499 30500 000102'02 000000 000000 %table(coptab) ; Begin a keyword table 30501 000103'02 000000# 600015 %key2 , .dvdes!.dvnul ; Idiomatic for NUL: 30502 000102'03 144 141 164 141 055 30503 000104'02 000000# 600022 %keyf3 , .dvdes!.dvdcn, cm%inv ; Allows escape recognition 30504 000104'03 002000 000001 30505 000105'03 104 103 116 000 000 30506 000105'02 000000# 600022 %key2 , .dvdes!.dvdcn ; Means either SRV: or DCN: 30507 000106'03 104 105 103 156 145 30508 000106'02 000000# 000110' %keyf3 , %nul1, cm%inv!cm%abr ; Prefer NUL over NRT 30509 000110'03 002000 000005 30510 000111'03 156 000 000 000 000 30511 000107'02 000000# 600022 %keyf3 , .dvdes!.dvdcn, cm%inv ; Sleepy Tom types this 30512 000112'03 002000 000001 30513 000113'03 116 122 124 000 000 30514 000110'02 000000# 600015 %nul1: %keyf3 , .dvdes!.dvnul, cm%inv ; Allows escape recognition 30515 000114'03 002000 000001 30516 000115'03 116 125 114 000 000 30517 000111'02 000000# 000113' %keyf3 , %pip1, cm%inv!cm%abr ; Prefer pipe over PIP: 30518 000116'03 002000 000005 30519 000117'03 160 151 000 000 000 30520 000112'02 000000# 600403 %keyf3 , .dvdes!.dvpip, cm%inv ; Allows escape recognition 30521 000120'03 002000 000001 30522 000121'03 120 111 120 000 000 30523 000113'02 000000# 600403 %pip1: %key2 , .dvdes!.dvpip ; Idiomatic for PIP: 30524 000122'03 160 151 160 145 000 30525 000114'02 000000# 600013 %key2 , .dvdes!.dvpty ; Idiotmatic for PTY: 30526 000123'03 160 163 145 165 144 30527 000115'02 000000# 600013 %keyf3 , .dvdes!.dvpty, cm%inv ; Allows escape recognition 30528 000127'03 002000 000001 30529 000130'03 120 124 131 000 000 30530 000116'02 000000# 600023 %keyf3 , .dvdes!.dvsrv, cm%inv ; Allows escape recognition 30531 000131'03 002000 000001 30532 000132'03 123 122 126 000 000 30533 000102'02 000014 000014 %tbend 30534 30535 cleans(<%nul1,%pip1>) ; Toss working symbols 30536 30537 chgsec(code,const) ;;Chained FDB's go into const 30538 000117'02 000004 000122' cpffdb: flddb. .cmkey,,coptab,,,cpffd1 30539 000120'02 000000 000102' 30540 000121'02 44 07 0 00 000424' 30541 000122'02 016004 000000 cpffd1: flddb. .cmdev,,, 30542 000123'02 000000 000000 30543 000124'02 44 07 0 00 000355' 30544 30545 000125'02 000004 000130' cptfdb: flddb. .cmkey,,coptab,,,cptfd1 30546 000126'02 000000 000102' K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 8-1 K20TIM MAC 3-Apr-23 23:45 Copy one device's speed test over another's 30547 000127'02 44 07 0 00 000432' 30548 000130'02 016004 000000 cptfd1: flddb. .cmdev,,, 30549 000131'02 000000 000000 30550 000132'02 44 07 0 00 000355' 30551 retsec ;;Return to code .psect 30552 30553 cleans() ;;Punt the working symbols 30554 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 9 K20TIM MAC 3-Apr-23 23:45 TIME COPY command parsing 30555 subttl TIME COPY command parsing 30556 30557 000125'01 265 16 0 00 003450' .copy: saveac ; Wants another AC 30558 000126'01 200 16 0 00 000000# guide (a previous timing test result for) 30559 000127'01 260 17 0 00 000002* 30560 000133'02 000000000000# 30561 000055'04 141 040 160 162 145 30562 remark t5, q1 ; Note aliased, assumed saved 30563 30564 000130'01 201 01 0 00 000000# movei t1, cpffdb ; Copy-From FDB 30565 000131'01 260 17 0 00 000116* call rfield ; Try to get something 30566 000132'01 135 04 0 00 003421' ldb t4, [pointr (.cmfnp(t3),cm%fnc)] ; Get parse function taken 30567 30568 000133'01 302 04 0 00 000000 caie t4, .cmkey ; Did an idiomatic name? 30569 000134'01 254 00 0 00 000137' ifskp. ; Yep, that's not very difficult 30570 000135'01 524 02 0 02 000000 hrlo t2, (t2) ; Turn semantic action into a device designator 30571 000136'01 201 04 0 00 000016 movei t4, .cmdev ; Say we parsed a device 30572 000137'01 endif. ; And take the device case 30573 30574 000137'01 302 04 0 00 000016 caie t4, .cmdev ; If not a device at this point, 30575 000140'01 254 00 0 00 000040' jrst broken ; ...we are deeply broken... 30576 30577 000141'01 554 01 0 00 000002 hlrz t1, t2 ; Pick up bare device designator 30578 000142'01 620 01 0 00 600000 txz t1, .dvdes ; Shut off the universal device code 30579 000143'01 200 05 0 00 000001 move q1, t1 ; Save just the 'source' device type number 30580 30581 000144'01 200 16 0 00 000000# guide (to another device) 30582 000145'01 260 17 0 00 000127* 30583 000134'02 000000000000# 30584 000064'04 164 157 040 141 156 30585 30586 000146'01 201 01 0 00 000000# movei t1, cptfdb ; Copy-To FDB 30587 000147'01 260 17 0 00 000131* call rfield ; Try to get something 30588 000150'01 135 04 0 00 003421' ldb t4, [pointr (.cmfnp(t3),cm%fnc)] ; Get parse function taken 30589 30590 000151'01 302 04 0 00 000000 caie t4, .cmkey ; Did an idomatic name? 30591 000152'01 254 00 0 00 000155' ifskp. ; Indeed; transmorgrify 30592 000153'01 524 02 0 02 000000 hrlo t2, (t2) ; Turn semantic action into a device designator 30593 000154'01 201 04 0 00 000016 movei t4, .cmdev ; Say we parsed a device 30594 000155'01 endif. ; And take the device case 30595 30596 000155'01 302 04 0 00 000016 caie t4, .cmdev ; If not a device at this point, we are 30597 000156'01 254 00 0 00 000040' jrst broken ; deeply broken... 30598 30599 000157'01 554 06 0 00 000002 hlrz q2, t2 ; Pick up bare device designator 30600 000160'01 620 06 0 00 600000 txz q2, .dvdes ; Shut off the universal device code 30601 000161'01 312 05 0 00 000006 came q1, q2 ; Are we trying to reuse ourself? 30602 000162'01 254 00 0 00 000174' ifskp. ; Yes, don't let's be silly 30603 000163'01 200 01 0 00 000000# emsg 30604 000164'01 104 00 0 00 000313 30605 000135'02 000000000000# 30606 000070'04 122 145 144 165 156 30607 000165'01 200 01 0 00 000005 move t1, q1 ; Load device number 30608 000166'01 260 17 0 00 000000* call ascdev ; Turn into a string 30609 000167'01 104 00 0 00 000076 PSOUT% ; Type it K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 9-1 K20TIM MAC 3-Apr-23 23:45 TIME COPY command parsing 30610 txmsg <'s timing test result onto itself 30611 000170'01 200 01 0 00 000000# > 30612 000171'01 104 00 0 00 000076 30613 000172'01 320 12 0 00 000173' 30614 000136'02 000000000000# 30615 000074'04 047 163 040 164 151 30616 30617 000173'01 254 00 0 00 000122* jrst cmder1 ; Complain and allow command retry. 30618 000174'01 endif. 30619 000174'01 260 17 0 00 000036* confrm ; Tie off the line 30620 remark ; Fall through to execute the code 30621 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 10 K20TIM MAC 3-Apr-23 23:45 Re-use semantic action, not called since only one keyword 30622 subttl Re-use semantic action, not called since only one keyword 30623 30624 extern pvbaud ; PTY: virtual baud rate 30625 extern pibaud ; PIP: virtual baud rate 30626 extern nlbaud ; NUL: virtual baud rate 30627 extern dnbaud ; DCN:/SRV: pair virtual baud rate 30628 30629 000175'01 $copy: remark ; Check source tests 30630 000175'01 477 03 0 00 000004 setob t3, t4 ; Assume we don't know either 30631 000176'01 306 05 0 00 000013 cain q1, .dvpty ; Pseudo-terminal? 30632 000177'01 201 03 0 00 000000* movei t3, pvbaud ; Address of test results 30633 000200'01 306 05 0 00 000403 cain q1, .dvpip ; Pipe device? 30634 000201'01 201 03 0 00 000000* movei t3, pibaud ; Address of test results 30635 000202'01 306 05 0 00 000015 cain q1, .dvnul ; NULL (or NIL) device? 30636 000203'01 201 03 0 00 000000* movei t3, nlbaud ; Address of test results 30637 000204'01 302 05 0 00 000023 caie q1, .dvsrv ; DECnet passive component? 30638 000205'01 306 05 0 00 000022 cain q1, .dvdcn ; or DECnet active component 30639 000206'01 201 03 0 00 000000* movei t3, dnbaud ; Yes, has the same test result address 30640 000207'01 321 03 0 00 000244' jumpl t3, $copys ; We don't have a test for this source 30641 30642 remark ; Check destination tests 30643 000210'01 306 06 0 00 000013 cain q2, .dvpty ; Pseudo-terminal? 30644 000211'01 201 04 0 00 000177* movei t4, pvbaud ; Address of test results 30645 000212'01 306 06 0 00 000403 cain q2, .dvpip ; Pipe device? 30646 000213'01 201 04 0 00 000201* movei t4, pibaud ; Address of test results 30647 000214'01 306 06 0 00 000015 cain q2, .dvnul ; NULL (or NIL) device? 30648 000215'01 201 04 0 00 000203* movei t4, nlbaud ; Address of test results 30649 000216'01 302 06 0 00 000023 caie q2, .dvsrv ; DECnet passive component? 30650 000217'01 306 06 0 00 000022 cain q2, .dvdcn ; or DECnet active component 30651 000220'01 201 04 0 00 000206* movei t4, dnbaud ; Yes, has the same test result address 30652 000221'01 321 04 0 00 000246' jumpl t4, $copyd ; We don't have a test for this destination 30653 30654 000222'01 120 01 0 03 000000 dmove t1, (t3) ; Pick up source test 30655 000223'01 323 01 0 00 000233' jumple t1, $copyn ; No test run 30656 000224'01 124 01 0 04 000000 dmovem t1, (t4) ; Overwrite destination results 30657 000225'01 124 01 0 00 000106* dmovem t1, pars4 ; Store for $SHOW 30658 30659 remark ; Turn device numbers back into device 30660 000226'01 524 01 0 00 000005 hrlo t1, q1 ; Reposition source device number 30661 000227'01 661 01 0 00 600000 tlo t1, .dvdes ; Now a device designator 30662 000230'01 200 02 0 00 000006 move t2, q2 ; Load destination device number 30663 000231'01 124 01 0 00 000024* dmovem t1, pars2 ; Store as device designators 30664 30665 000232'01 263 17 0 00 000000 ret ; Return into $SHOW 30666 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 11 K20TIM MAC 3-Apr-23 23:45 various error handlers 30667 subttl various error handlers 30668 30669 chgsec(code,text) ;;Text .psect for strings 30670 000133'03 116 157 040 164 151 $copym: asciz "No timing run yet for " 30671 retsec ;;Get back in code .psect 30672 30673 000233'01 $copyn: remark ; Here if no test has been run 30674 000233'01 561 01 0 00 000000# hrroi t1, $copym ; Load common preamble 30675 000234'01 104 00 0 00 000313 ESOUT% ; Begin blat 30676 30677 000235'01 200 01 0 00 000005 move t1, q1 ; Pick up source device number 30678 000236'01 260 17 0 00 000166* call ascdev ; Convert to a string 30679 000237'01 104 00 0 00 000076 PSOUT% ; Type it 30680 30681 000240'01 561 01 0 00 000047* hrroi t1, crlf ; Tie off the line 30682 000241'01 104 00 0 00 000076 PSOUT% 30683 000242'01 476 00 0 00 000231* setom pars2 ; Flag already blatted 30684 000243'01 263 17 0 00 000000 ret ; Return into $SHOW 30685 30686 000244'01 $copys: remark ; Here if source device is unknown 30687 000244'01 202 05 0 00 000242* movem q1, pars2 ; Load the device number 30688 000245'01 263 17 0 00 000000 ret ; Return into $SHOW 30689 30690 000246'01 $copyd: remark ; Here if destination device is unknown 30691 000246'01 202 06 0 00 000244* movem q2, pars2 ; Load the device number 30692 000247'01 263 17 0 00 000000 ret ; Return into $SHOW 30693 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 12 K20TIM MAC 3-Apr-23 23:45 Determine PTY Virtual Baud rate 30694 subttl Determine PTY Virtual Baud rate 30695 30696 ; N.B., this code is not intended to provide a definitive answer to 30697 ; ANYTHING because Tops-20 is not a real-time system. Even a speck 30698 ; of system load can wildly peturb the results as well as whatever the 30699 ; current monitor's pseudo-terminal implementation happens to be. 30700 ; 30701 ; Also, the speed of a PTY in an intra-job context (as is done below) 30702 ; appears to be slower than the more typical inter-job example, as 30703 ; used by BATCON and Kermit's pseudo-terminal connection code. 30704 ; 30705 ; This result is therefore best viewed as a number suitable for 30706 ; checkout of the calculations performed in the efficiency code for a 30707 ; physical baud rate, if such a thing is ever seen again. 30708 30709 000250'01 dptybd: intern dptybd ; May be invoked as a test 30710 000250'01 265 16 0 00 003456' saveac ;Holds PTY particulars 30711 remark ; N.B., q4 and p1 are aliases!! 30712 30713 000251'01 403 05 0 00 000006 setzb q1, q2 ; No PTY or terminal JFN 30714 000252'01 403 07 0 00 000010 setzb q3, q4 ; No assigned PTY or TTY device 30715 000253'01 400 12 0 00 000013 setz p2, p3 ; No fork created 30716 30717 000254'01 260 17 0 00 000702' call comput ; Get correct byte pointer and count 30718 000255'01 260 17 0 00 000260' call ptyjfn ; Set JFN's to time a PTY: 30719 000256'01 254 00 0 00 001235' jrst epicom ; If failed, hit the epilogue 30720 000257'01 254 00 0 00 000715' callret tcommn ; Otherwise, hit the common code 30721 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 13 K20TIM MAC 3-Apr-23 23:45 Set up a PTY:/TTY: pair for transfer timing 30722 subttl Set up a PTY:/TTY: pair for transfer timing 30723 30724 ; +1/ Couldn't do it 30725 ; +2/ Worked 30726 ; 30727 ; q1/ Open PTY JFN and flags 30728 ; q2/ Open TTY JFN and flags 30729 ; q3/ Assigned PTY device 30730 ; q4/ Assigned TTY device 30731 30732 extern asipty ; Assign a pseudo-terminal 30733 extern ptynam,ttynam ; ASCII names of assigned devices 30734 extern asgflg ; Flag for assigned device 30735 extern asgdev ; Device actually assigned 30736 extern ndvchr ; Double word device characteristics 30737 extern ptytty ; PTY to TTY: line mapping 30738 extern ptyflg ; Using a pseudo-terminal 30739 extern binflg ; Device is in binary (8-bit) mode 30740 30741 000260'01 ptyjfn: remark ;Expects caller to have saved these 30742 remark ; N.B., q4 and p1 are aliases!! 30743 30744 000260'01 402 00 0 00 000000* setzm asgflg ; Force an assignment 30745 000261'01 260 17 0 00 000000* call asipty ; Grab us a PTY 30746 000262'01 263 17 0 00 000000 ret ; or not... 30747 000263'01 200 07 0 00 000002 move q3, t2 ; Store the returned PTY designator 30748 000264'01 505 01 0 00 600012 hrli t1,.dvdes+.dvtty ; Turn returned line into a TTY designator 30749 000265'01 104 00 0 00 000070 ASND% ; Grab associated terminal, too 30750 000266'01 320 12 0 00 000270' %jserr (,r) ; Odd, just got the PTY... 30751 000267'01 254 00 0 00 000273' 30752 000270'01 265 01 0 00 000000* 30753 000271'01 000000000000# 30754 000272'01 254 00 0 00 000000* 30755 000104'04 103 157 165 154 144 30756 000273'01 200 10 0 00 000001 move q4, t1 ; Store assigned terminal's device designator 30757 30758 remark ; PTY takes mode of TTY:, so open that first 30759 dmove t1, [ gj%sht!gj%flg ; Want GTJFN% flags returned 30760 000274'01 120 01 0 00 003472' -1,,ttynam ] ; asipty built this for us 30761 000275'01 104 00 0 00 000020 GTJFN% ; Try to get a JFN on the PTY's associated TTY 30762 000276'01 320 12 0 00 000300' %jserr (,r) 30763 000277'01 254 00 0 00 000303' 30764 000300'01 265 01 0 00 000270* 30765 000301'01 000000000000# 30766 000302'01 254 00 0 00 000272* 30767 000112'04 103 141 156 047 164 30768 000303'01 200 06 0 00 000001 move q2, t1 ; Store TTY JFN and flags 30769 000304'01 621 01 0 00 777777 tlz t1,-1 ; Whack flags so OPENF% doesn't choke 30770 000305'01 200 02 0 00 003474' movx t2, ; 8-bit bytes 30771 000306'01 335 03 0 00 000113* skipge t3, pars3 ; Load parsed OPENF% mode 30772 000307'01 254 00 0 00 000311' ifskp. ; User specified it, let's use it 30773 000310'01 137 03 0 00 003475' dpb t3, [pointr t2, of%mod] 30774 000311'01 endif. 30775 000311'01 337 04 0 00 000225* skipg t4, pars4 ; Load parsed OPENF% byte size 30776 000312'01 254 00 0 00 000314' ifskp. ; User specified it, let's use it K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 13-1 K20TIM MAC 3-Apr-23 23:45 Set up a PTY:/TTY: pair for transfer timing 30777 000313'01 137 04 0 00 003476' dpb t4, [pointr t2, of%bsz] 30778 000314'01 endif. 30779 000314'01 104 00 0 00 000021 OPENF% ; read-only 30780 000315'01 320 12 0 00 000317' %jserr (,r) 30781 000316'01 254 00 0 00 000322' 30782 000317'01 265 01 0 00 000300* 30783 000320'01 000000000000# 30784 000321'01 254 00 0 00 000302* 30785 000120'04 103 141 156 047 164 30786 30787 dmove t1, [ gj%sht!gj%flg ; Want GTJFN% flags returned 30788 000322'01 120 01 0 00 003477' -1,,ptynam ] ; asipty built this for us 30789 000323'01 104 00 0 00 000020 GTJFN% ; Try to get a JFN on the PTY 30790 000324'01 320 12 0 00 000326' %jserr (,r) 30791 000325'01 254 00 0 00 000331' 30792 000326'01 265 01 0 00 000317* 30793 000327'01 000000000000# 30794 000330'01 254 00 0 00 000321* 30795 000126'04 103 141 156 047 164 30796 000331'01 200 05 0 00 000001 move q1, t1 ; Store PTY JFN and flags 30797 000332'01 621 01 0 00 777777 tlz t1,-1 ; Whack flags so OPENF% doesn't choke 30798 000333'01 200 02 0 00 003501' movx t2, ; 8-bit bytes 30799 remark of%mod ; PTY itself *ONLY* supports normal mode 30800 000334'01 337 04 0 00 000311* skipg t4, pars4 ; Load parsed OPENF% byte size 30801 000335'01 254 00 0 00 000337' ifskp. ; User specified it, let's use it 30802 000336'01 137 04 0 00 003476' dpb t4, [pointr t2, of%bsz] 30803 000337'01 endif. 30804 000337'01 104 00 0 00 000021 OPENF% ; normal mode (only one supported), write-only 30805 000340'01 320 12 0 00 000342' %jserr (,r) 30806 000341'01 254 00 0 00 000345' 30807 000342'01 265 01 0 00 000326* 30808 000343'01 000000000000# 30809 000344'01 254 00 0 00 000330* 30810 000136'04 103 141 156 047 164 30811 30812 000345'01 254 00 0 00 000000* retskp ; Return success 30813 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 14 K20TIM MAC 3-Apr-23 23:45 Determine PIP: Virtual Baud Rate 30814 subttl Determine PIP: Virtual Baud Rate 30815 30816 ; N.B., this code is not intended to provide a definitive answer to 30817 ; ANYTHING because Tops-20 is not a real-time system. Even a speck 30818 ; of system load can wildly peturb the results as well as whatever the 30819 ; current monitor's pipe implementation happens to be. 30820 ; 30821 ; See dptybd for more extensive commentary 30822 30823 000346'01 dpipbd: intern dpipbd ; May be invoked as a test 30824 000346'01 265 16 0 00 003456' saveac ;Holds pipe particulars 30825 remark ; N.B., q4 and p1 are aliases!! 30826 30827 000347'01 403 05 0 00 000006 setzb q1, q2 ; No source or destination PIP: JFN 30828 000350'01 403 07 0 00 000010 setzb q3, q4 ; No assigned PIP: device 30829 000351'01 400 12 0 00 000013 setz p2, p3 ; No fork created 30830 30831 000352'01 260 17 0 00 000702' call comput ; Get correct byte pointer and count 30832 000353'01 260 17 0 00 000356' call pipjfn ; Set JFN's to time a PIP: device 30833 000354'01 254 00 0 00 001235' jrst epicom ; If failed, hit the epilogue 30834 000355'01 254 00 0 00 000715' callret tcommn ; Worked, hit the common code 30835 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 15 K20TIM MAC 3-Apr-23 23:45 Set up a PIP: pair for transfer timing 30836 subttl Set up a PIP: pair for transfer timing 30837 30838 ; +1/ Couldn't do it 30839 ; +2/ Worked 30840 ; 30841 ; q1/ Open write PIP: JFN and flags 30842 ; q2/ Open read PIP: JFN and flags 30843 ; q3/ Zero (no assigned write device) 30844 ; q4/ Zero (assigned read device) 30845 30846 ; N.B., Can't use ";RECORD-SIZE:500" attribute. Broken. 30847 ; Proper format is RECORD-LENGTH 30848 30849 chgsec(code,data) ;;Needs some storage 30850 000000'05 pipnam: block ^d20 ; Space to build name 30851 000024'05 pip2nd: block 4 ; Space for 19 characters, plus nul 30852 retsec ;;Get out of data psect 30853 30854 chgsec(code,text) ;;Put strings into text psect 30855 000140'03 120 111 120 072 056 pip1st: ASCIZ /PIP:.;RECORD-LENGTH:/ ; From PIPE.MAC (N.B., NOT RECORD-SIZE!) 30856 remark 12345678901234567890 ; Four words of storage 30857 retsec ;;Back in code psect 30858 30859 remark pars3 ; OPENF% mode 30860 remark pars4 ; OPENF% byte size 30861 remark pars5 ; Buffer size (RECORD-LENGTH) 30862 30863 000356'01 pipjfn: remark ;Expects caller to have saved these 30864 remark ; N.B., q4 and p1 are aliases!! 30865 30866 remark q1, q2, q3, q4 ; Assumes all zero 30867 30868 000356'01 333 02 0 00 000123* skiple t2, pars5 ; See if we have a record length 30869 000357'01 254 00 0 00 000364' ifskp. ; We don't 30870 000360'01 200 03 0 00 000000# move t3, pip1st ; Pick up first five characters (nice hack, Tom) 30871 000361'01 400 04 0 00 000000 setz t4, ; Tie off with .chnul's 30872 000362'01 124 03 0 00 000000# dmovem t3, pipnam ; Stomp into the file specification 30873 000363'01 254 00 0 00 000401' else. ; Otherwise, wants to specify it 30874 000364'01 120 03 0 00 000000# dmove t3, pip1st ; Get the first ten characters 30875 000365'01 124 03 0 00 000000# dmovem t3, pipnam ; Store them 30876 000366'01 120 03 0 00 000000# dmove t3, pip1st+2 ; Get the second ten characters 30877 000367'01 124 03 0 00 000000# dmovem t3, pipnam+2 ; Store them 30878 000370'01 402 00 0 00 000000# setzm pipnam+4 ; Tie off the string 30879 000371'01 561 01 0 00 000000# hrroi t1, ; Puts the decimal number after the colon 30880 000372'01 201 03 0 00 000012 movei t3, ^d10 ; RECORD-LENGTH number is decimal 30881 000373'01 104 00 0 00 000224 NOUT% ; Tack it on to the end 30882 000374'01 320 12 0 00 000376' %jserr (,r) 30883 000375'01 254 00 0 00 000401' 30884 000376'01 265 01 0 00 000342* 30885 000377'01 000000000000# 30886 000400'01 254 00 0 00 000344* 30887 000146'04 103 141 156 047 164 30888 000401'01 endif. 30889 30890 dmove t1,[gj%sht!gj%flg ; Want GTJFN% flags returned K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 15-1 K20TIM MAC 3-Apr-23 23:45 Set up a PIP: pair for transfer timing 30891 000401'01 120 01 0 00 003502' -1,,pipnam ] ; PIP:'s odd syntax 30892 000402'01 104 00 0 00 000020 GTJFN% ; Try to get a JFN on the pipe 30893 000403'01 320 12 0 00 000405' %jserr (,r) 30894 000404'01 254 00 0 00 000410' 30895 000405'01 265 01 0 00 000376* 30896 000406'01 000000000000# 30897 000407'01 254 00 0 00 000400* 30898 000161'04 103 141 156 047 164 30899 000410'01 200 05 0 00 000001 move q1, t1 ; Store first PIP: JFN and flags 30900 30901 000411'01 403 01 0 00 000002 setzb t1, t2 ; Cons up ten .CHNUL's 30902 000412'01 124 01 0 00 000000# dmovem t1, pip2nd+0 ; Whack all the storage 30903 000413'01 124 01 0 00 000000# dmovem t1, pip2nd+2 ; where we'll write more odd syntax 30904 30905 000414'01 561 01 0 00 000000# hrroi t1, pip2nd ; Point to area for JFNS% 30906 000415'01 550 02 0 00 000005 hrrz t2, q1 ; Load our odd first PIP: JFN 30907 dmove t3, [fld(.jsaof,js%dev)!fld(.jsaof,js%nam)!js%paf 30908 000416'01 120 03 0 00 003504' 0 ] ; No strange prefix (whatever that is) 30909 000417'01 104 00 0 00 000030 JFNS% ; Build first part of strange string 30910 000420'01 320 12 0 00 000422' %jserr(,r) 30911 000421'01 254 00 0 00 000425' 30912 000422'01 265 01 0 00 000405* 30913 000423'01 000000000000# 30914 000424'01 254 00 0 00 000407* 30915 000171'04 103 157 165 154 144 30916 000425'01 201 02 0 00 000056 movx t2, "." ; Load a dot 30917 000426'01 136 02 0 00 000001 idpb t2, t1 ; Punctuate the file type 30918 000427'01 550 02 0 00 000005 hrrz t2, q1 ; Load our odd first PIP: JFN 30919 000430'01 205 03 0 00 001000 movx t3, ; File type is the same as the name 30920 000431'01 104 00 0 00 000030 JFNS% ; Build second part of strange string 30921 000432'01 320 12 0 00 000434' %jserr(,r) 30922 000433'01 254 00 0 00 000437' 30923 000434'01 265 01 0 00 000422* 30924 000435'01 000000000000# 30925 000436'01 254 00 0 00 000424* 30926 000205'04 103 157 165 154 144 30927 30928 dmove t1, [ gj%sht!gj%flg ; Want GTJFN% flags returned 30929 000437'01 120 01 0 00 003506' -1,,pip2nd ] ; PIP:'s odd syntax 30930 000440'01 104 00 0 00 000020 GTJFN% ; Try to get a JFN on the PTY 30931 000441'01 320 12 0 00 000443' %jserr (,r) 30932 000442'01 254 00 0 00 000446' 30933 000443'01 265 01 0 00 000434* 30934 000444'01 000000000000# 30935 000445'01 254 00 0 00 000436* 30936 000221'04 103 141 156 047 164 30937 000446'01 200 06 0 00 000001 move q2, t1 ; Store 2nd PIP: JFN and flags 30938 30939 000447'01 550 01 0 00 000005 hrrz t1, q1 ; Load write JFN without flags 30940 000450'01 200 02 0 00 003501' movx t2, ; 8-bit bytes 30941 000451'01 335 03 0 00 000306* skipge t3, pars3 ; Load parsed OPENF% mode 30942 000452'01 254 00 0 00 000454' ifskp. ; User specified it, let's use it 30943 000453'01 137 03 0 00 003475' dpb t3, [pointr t2, of%mod] 30944 000454'01 endif. 30945 000454'01 337 04 0 00 000334* skipg t4, pars4 ; Load parsed OPENF% byte size K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 15-2 K20TIM MAC 3-Apr-23 23:45 Set up a PIP: pair for transfer timing 30946 000455'01 254 00 0 00 000457' ifskp. ; User specified it, let's use it 30947 000456'01 137 04 0 00 003476' dpb t4, [pointr t2, of%bsz] 30948 000457'01 endif. 30949 000457'01 104 00 0 00 000021 OPENF% ; N.B., source JFN is write-only 30950 000460'01 320 12 0 00 000462' %jserr (,r) 30951 000461'01 254 00 0 00 000465' 30952 000462'01 265 01 0 00 000443* 30953 000463'01 000000000000# 30954 000464'01 254 00 0 00 000445* 30955 000231'04 103 141 156 047 164 30956 000465'01 550 01 0 00 000006 hrrz t1, q2 ; Load read JFN without flags 30957 000466'01 200 02 0 00 003510' movx t2, ; 8-bit bytes 30958 000467'01 335 03 0 00 000451* skipge t3, pars3 ; Load parsed OPENF% mode 30959 000470'01 254 00 0 00 000472' ifskp. ; User specified it, let's use it 30960 000471'01 137 03 0 00 003475' dpb t3, [pointr t2, of%mod] 30961 000472'01 endif. 30962 000472'01 337 04 0 00 000454* skipg t4, pars4 ; Load parsed OPENF% byte size 30963 000473'01 254 00 0 00 000475' ifskp. ; User specified it, let's use it 30964 000474'01 137 04 0 00 003476' dpb t4, [pointr t2, of%bsz] 30965 000475'01 endif. 30966 000475'01 104 00 0 00 000021 OPENF% ; Normal mode, read-only 30967 000476'01 320 12 0 00 000500' %jserr (,r) 30968 000477'01 254 00 0 00 000503' 30969 000500'01 265 01 0 00 000462* 30970 000501'01 000000000000# 30971 000502'01 254 00 0 00 000464* 30972 000240'04 103 141 156 047 164 30973 30974 000503'01 254 00 0 00 000345* retskp ; Return success 30975 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 16 K20TIM MAC 3-Apr-23 23:45 Determine SRV: Virtual Baud Rate 30976 subttl Determine SRV: Virtual Baud Rate 30977 30978 ; N.B., this code is not intended to provide a definitive answer to 30979 ; ANYTHING because Tops-20 is not a real-time system. Even a speck 30980 ; of system load can wildly peturb the results as well as whatever the 30981 ; current monitor's DECnet implementation happens to be. 30982 ; 30983 ; It is not going over ANY hardware network interface; traffic is 30984 ; purely inside of Tops-20. 30985 ; 30986 ; See dptybd for more extensive commentary 30987 30988 000504'01 dsrvbd: intern dsrvbd ; May be invoked as a test 30989 000504'01 265 16 0 00 003456' saveac ;Holds DECnet particulars 30990 remark ; N.B., q4 and p1 are aliases!! 30991 30992 000505'01 403 05 0 00 000006 setzb q1, q2 ; No DCN: or SRV: JFN 30993 000506'01 403 07 0 00 000010 setzb q3, q4 ; No assigned DCN: or SRV: device 30994 000507'01 400 12 0 00 000013 setz p2, p3 ; No fork created 30995 30996 000510'01 260 17 0 00 000702' call comput ; Get correct byte pointer and count 30997 000511'01 260 17 0 00 000514' call srvdcn ; Set JFN's to time a DCN:-SRV: device pair 30998 000512'01 254 00 0 00 001235' jrst epicom ; If failed, hit the epilogue 30999 000513'01 254 00 0 00 000715' callret tcommn ; Worked, hit the common code 31000 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 17 K20TIM MAC 3-Apr-23 23:45 Acquire a JFN on a DCN:/SRV: pair 31001 subttl Acquire a JFN on a DCN:/SRV: pair 31002 31003 remark Storage area and string components 31004 31005 chgsec(code,text) ;;Put these in program text strings 31006 000145'03 123 122 126 072 056 srvnam: asciz "SRV:.KERMIT-TIMING" ; Task is Kermit Timing service 31007 000151'03 113 145 162 155 151 srvmsg: asciz "Kermit-20: Ready" 31008 000155'03 055 124 101 123 113 dcntsk: asciz "-TASK-KERMIT-TIMING;USER:" 31009 000163'03 073 104 101 124 101 dcndat: asciz ";DATA:" ; Gets HPTIM% ticks as ASCII 31010 retsec ;;Done with read-only text strings 31011 31012 chgsec(code,const) ;;Read-Only pointers are constant data 31013 000137'02 44 07 0 00 000000# srvacc: point 7, srvmsg ; Acknowledgement message 31014 000140'02 000000 000020 srvlen: ^d16 ;;And its length 31015 retsec 31016 31017 chgsec(code,data) ;;Need some writable storage 31018 000030'05 whoami: block 1 ; Currently signed in user number 31019 intern whoami ; START: in k20mit populates this 31020 000031'05 tsktim: block 1 ; HPTIM% value (max 27487790694) 31021 000032'05 dcname: Block ^d20 ; Space for 100 characters 31022 retsec ;;Back to generating executable code 31023 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 18 K20TIM MAC 3-Apr-23 23:45 Acquire a JFN on a DCN:/SRV: pair 31024 remark Code to get and open the JFN's 31025 31026 000514'01 srvdcn: remark ; First, must get SRV: JFN 31027 dmove t1, [ gj%sht!gj%flg ; Want GTJFN% flags returned 31028 000514'01 120 01 0 00 003511' -1,,srvnam ] ; 31029 000515'01 104 00 0 00 000020 GTJFN% ; Try to get a JFN on the passive component 31030 000516'01 320 12 0 00 000520' %jserr (,r) 31031 000517'01 254 00 0 00 000523' 31032 000520'01 265 01 0 00 000500* 31033 000521'01 000000000000# 31034 000522'01 254 00 0 00 000502* 31035 000247'04 103 157 165 154 144 31036 000523'01 200 06 0 00 000001 move q2, t1 ; Store SRV: JFN and flags 31037 000524'01 621 01 0 00 777777 tlz t1,-1 ; Whack flags so OPENF% doesn't choke 31038 000525'01 200 02 0 00 003510' movx t2, ; 8-bit bytes 31039 000526'01 335 03 0 00 000467* skipge t3, pars3 ; Load parsed OPENF% mode 31040 000527'01 254 00 0 00 000531' ifskp. ; User specified it, let's use it 31041 000530'01 137 03 0 00 003475' dpb t3, [pointr t2, of%mod] 31042 000531'01 endif. 31043 000531'01 337 04 0 00 000472* skipg t4, pars4 ; Load parsed OPENF% byte size 31044 000532'01 254 00 0 00 000534' ifskp. ; User specified it, let's use it 31045 000533'01 137 04 0 00 003476' dpb t4, [pointr t2, of%bsz] 31046 000534'01 endif. 31047 000534'01 104 00 0 00 000021 OPENF% ; normal mode, read-only 31048 000535'01 320 12 0 00 000537' %jserr (,r) 31049 000536'01 254 00 0 00 000542' 31050 000537'01 265 01 0 00 000520* 31051 000540'01 000000000000# 31052 000541'01 254 00 0 00 000522* 31053 000263'04 103 157 165 154 144 31054 31055 000542'01 260 17 0 00 000604' call bldcnt ; Build the (hairy) DCN: task name to SRV: 31056 000543'01 263 17 0 00 000000 ret ; But falled?? 31057 31058 dmove t1, [ gj%sht!gj%flg ; Want GTJFN% flags returned 31059 000544'01 120 01 0 00 003513' -1,,dcname ] ; 31060 000545'01 104 00 0 00 000020 GTJFN% ; Try to get a JFN on the PTY 31061 000546'01 320 12 0 00 000550' %jserr (,r) 31062 000547'01 254 00 0 00 000553' 31063 000550'01 265 01 0 00 000537* 31064 000551'01 000000000000# 31065 000552'01 254 00 0 00 000541* 31066 000275'04 103 157 165 154 144 31067 000553'01 200 05 0 00 000001 move q1, t1 ; Store DCN: JFN and flags 31068 000554'01 621 01 0 00 777777 tlz t1,-1 ; Whack flags so OPENF% doesn't choke 31069 000555'01 200 02 0 00 003501' movx t2, ; 8-bit bytes 31070 000556'01 335 03 0 00 000526* skipge t3, pars3 ; Load parsed OPENF% mode 31071 000557'01 254 00 0 00 000561' ifskp. ; User specified it, let's use it 31072 000560'01 137 03 0 00 003475' dpb t3, [pointr t2, of%mod] 31073 000561'01 endif. 31074 000561'01 337 04 0 00 000531* skipg t4, pars4 ; Load parsed OPENF% byte size 31075 000562'01 254 00 0 00 000564' ifskp. ; User specified it, let's use it 31076 000563'01 137 04 0 00 003476' dpb t4, [pointr t2, of%bsz] 31077 000564'01 endif. 31078 000564'01 104 00 0 00 000021 OPENF% ; normal mode, write-only K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 18-1 K20TIM MAC 3-Apr-23 23:45 Acquire a JFN on a DCN:/SRV: pair 31079 000565'01 320 12 0 00 000567' %jserr (,r) 31080 000566'01 254 00 0 00 000572' 31081 000567'01 265 01 0 00 000550* 31082 000570'01 000000000000# 31083 000571'01 254 00 0 00 000552* 31084 000311'04 103 157 165 154 144 31085 31086 000572'01 550 01 0 00 000006 hrrz t1, q2 ; Load server JFN 31087 000573'01 201 02 0 00 000041 movx t2, .mocc ; Explicitly accept the DCN: 31088 000574'01 120 03 0 00 000000# dmove t3, srvacc ; And the acknowledgement message 31089 000575'01 104 00 0 00 000077 MTOPR% ; Finish the connection negotiation 31090 000576'01 320 12 0 00 000600' %jserr (,r) 31091 000577'01 254 00 0 00 000603' 31092 000600'01 265 01 0 00 000567* 31093 000601'01 000000000000# 31094 000602'01 254 00 0 00 000571* 31095 000323'04 103 157 165 154 144 31096 31097 000603'01 254 00 0 00 000503* retskp 31098 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 19 K20TIM MAC 3-Apr-23 23:45 Build cooresponding DCN: task name to SRV: 31099 subttl Build cooresponding DCN: task name to SRV: 31100 31101 ; N.B., the DCN string is a little convoluted, but it is generalized 31102 ; enough so that we could run tests between Tops-20 nodes, should we 31103 ; want to try that. 31104 31105 extern myname ; Name of local executor 31106 31107 000604'01 bldcnt: remark Means: BuiLd DCN Text 31108 000604'01 200 01 0 00 003515' move t1, [ BYTE (7) "D", "C", "N", ":", .chnul] 31109 000605'01 202 01 0 00 000000# movem t1, dcname ; Start device portion immediately 31110 000606'01 200 01 0 00 003516' move t1, [ point 7, dcname, 27 ] ; point before the .chnul 31111 31112 remark ; Could drop in /REMOTE:NODE here 31113 000607'01 336 00 0 00 000000* ifmn. myname ; Did we ever figure our local node name out? 31114 000610'01 254 00 0 00 000616' 31115 000611'01 200 02 0 00 003517' move t2, [ point 7,myname ] ; We did, so drop that in 31116 000612'01 do. ; Enter loop context 31117 000612'01 134 03 0 00 000002 ildb t3, t2 ; Pick a byte of the node name 31118 000613'01 322 03 0 00 000616' jumpe t3, endlp. ; Unless we've done all of it 31119 000614'01 136 03 0 00 000001 idpb t3, t1 ; Append to active component device 31120 000615'01 254 00 0 00 000612' loop. ; Get some more, wee!! 31121 000616'01 enddo. ; Exit loop context 31122 000616'01 endif. 31123 31124 000616'01 200 02 0 00 003520' move t2, [ point 7, dcntsk ] 31125 000617'01 do. ; Append the rest of the DECnet task gibberish 31126 000617'01 134 03 0 00 000002 ildb t3, t2 ; Pick a byte of the node name 31127 000620'01 322 03 0 00 000623' jumpe t3, endlp. ; Unless we've done all of it 31128 000621'01 136 03 0 00 000001 idpb t3, t1 ; Append to active component device 31129 000622'01 254 00 0 00 000617' loop. ; Get some more, wee!! 31130 000623'01 enddo. 31131 31132 000623'01 200 02 0 00 000000# move t2, whoami ; Load my user number 31133 000624'01 104 00 0 00 000041 DIRST% ; Tack that on after 31134 000625'01 320 12 0 00 000627' %jserr (,r) 31135 000626'01 254 00 0 00 000632' 31136 000627'01 265 01 0 00 000600* 31137 000630'01 000000000000# 31138 000631'01 254 00 0 00 000602* 31139 000337'04 106 141 151 154 145 31140 31141 000632'01 200 02 0 00 003521' move t2, [ point 7, dcndat ] 31142 000633'01 do. ; Append the ;DATA: attribute 31143 000633'01 134 03 0 00 000002 ildb t3, t2 ; Pick a byte of the node name 31144 000634'01 322 03 0 00 000637' jumpe t3, endlp. ; Unless we've done all of it 31145 000635'01 136 03 0 00 000001 idpb t3, t1 ; Append to active component device 31146 000636'01 254 00 0 00 000633' loop. ; Get some more, wee!! 31147 000637'01 enddo. 31148 31149 000637'01 200 04 0 00 000001 move t4, t1 ; Save output pointer 31150 000640'01 201 01 0 00 000000 movei t1, .HPELP ; Elapsed DK10 ticks since start 31151 000641'01 104 00 0 00 000501 HPTIM% ; Grab it 31152 000642'01 320 12 0 00 000644' %jserr (,r) 31153 000643'01 254 00 0 00 000647' K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 19-1 K20TIM MAC 3-Apr-23 23:45 Build cooresponding DCN: task name to SRV: 31154 000644'01 265 01 0 00 000627* 31155 000645'01 000000000000# 31156 000646'01 254 00 0 00 000631* 31157 000351'04 125 156 141 142 154 31158 000647'01 202 01 0 00 000000# movem t1, tsktim ; Store as task time (for ;DATA:) 31159 31160 000650'01 200 02 0 00 000001 move t2, t1 ; Position uptime ticks 31161 000651'01 200 01 0 00 000004 move t1, t4 ; Reload output pointer 31162 000652'01 201 03 0 00 000012 movx t3, fld(^d10,no%rdx) ; 31163 000653'01 104 00 0 00 000224 NOUT% ; Tack that on 31164 000654'01 320 12 0 00 000656' %jserr (,r) 31165 000655'01 254 00 0 00 000661' 31166 000656'01 265 01 0 00 000644* 31167 000657'01 000000000000# 31168 000660'01 254 00 0 00 000646* 31169 000363'04 125 156 141 142 154 31170 31171 000661'01 254 00 0 00 000603* retskp ; Finally won 31172 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 20 K20TIM MAC 3-Apr-23 23:45 Device speed determination storage 31173 subttl Device speed determination storage 31174 31175 .endps code ; Get out of the code .psect 31176 .psect devtim/ronly,devorg; psect for reading and writing for timing 31177 31178 000000'06 devwrt: remark ; Where data will be written from 31179 000000' nulwrt==:devwrt ; Ditto for special case NUL: 31180 000000 $d$=.chnul ; Generated data starts at NUL 31181 000000 $c$=0 ; Rotating check digit starts at zero 31182 xlist ; Don't need silly listing 31183 list ; Turn listing back on 31184 001000 devwrd==.-devwrt ; Device words to write 31185 004000 devchr==devwrd*4 ; Corresponding 8 bit character count 31186 cleans(<$d$,$c$>) ; Chuck worker symbols 31187 31188 ; N.B., The below is a bit of a hack because the page won't exist, which 31189 ; means we can then create it and write it. Heh... 31190 31191 001000'06 devred: block ^d512 ; Where data will be read into 31192 002000'06 devdat: block ^d512 ; Additional data for NUL: timing 31193 003000'06 devda2: block ^d512 ; 2nd part of it 31194 .endps devtim ; End of timing .psect 31195 31196 .psect code ; Get back into code .psect 31197 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 21 K20TIM MAC 3-Apr-23 23:45 Device inferior fork timing code and storage 31198 subttl Device inferior fork timing code and storage 31199 31200 chgsec(code,data) ;;Inferior's storage 31201 000056'05 000000 000011 devpdl: devhlt ; Return to our HALTF% 31202 000057'05 block ^d19 ; Rest of inferior's stack 31203 000024 devstg==.-devpdl ; Length of inferior's storage 31204 retsec ; Back in code segment 31205 31206 ; Inferior code is in the AC's because I thought I was going to have a 31207 ; very restricted address space there. This is not possible because 31208 ; of the need to call the timing ending routine and catch its errors. 31209 ; 31210 ; Note, superior does a SOUTR% to force a 'push'; the inferior also 31211 ; does a SINR% because it appears to be SLIGHTLY faster. 31212 31213 000662' devcod=: . ; Inferior's code 31214 000000 phase 0 ; Inferior's program 31215 000000 44 10 0 00 000000# point 8,devred ; ac0/ Where we're reading to 31216 000001 000000 400000 .fhslf ; 1 t1/ This fork 31217 000002 000000 601405 lstrx1 ; 2 t2/ "Process has not encountered any errors" 31218 000003 777777 774000 - ; 3 t3/ length of data being read 31219 000004 000000 000000 0 ; 4 t4/ Stop on .chnul (ignored) 31220 000005 104 00 0 00 000147 devinf: RESET% ; 5 q1/ Inferior start up 31221 000006 320 12 0 00 000011 erjmpr devhlt ; 6 q2/ Handle any error by just stopping 31222 000007 104 00 0 00 000336 SETER% ; 7 q3/ Otherwise flag everything worked 31223 000010 320 12 0 00 000011 erjmpr devhlt ; 10 q4/ Shouldn't ever break ... 31224 000011 104 00 0 00 000170 devhlt: HALTF% ; 11 p2/ Completed initialization 31225 000012 201 01 0 00 000100 movei t1, .priin ; 12 p3/ Set by superior 31226 000013 200 02 0 00 000000 move t2, 0 ; 13 p4/ Load pointer 31227 000014 104 00 0 00 000052 SIN% ; 14 p5/ Do a counted read 31228 000015 320 12 0 00 000011 erjmpr devhlt ; 15 .fp/ Handle the error 31229 000016 254 00 0 00 002050' callret endtim ; 16 cx/ Finish the timing 31230 000017 777755 000000# -^d19,,devpdl ; p/ stack (17) 31231 31232 000702'01 dephase ; Restore normal location counter 31233 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 22 K20TIM MAC 3-Apr-23 23:45 Timing common storage 31234 subttl Timing common storage 31235 31236 chgsec(code,data) ;;Writeable storage for data transfer 31237 000102'05 timdev:: block 1 ; Device being timed 31238 000103'05 devacs: block ^d16 ; Timing fork AC's 31239 000123'05 chrptr: block 1 ;*** DO NOT ; Left halfword of section local pointer 31240 000124'05 chrcnt: block 1 ;REORDER ** ; Character count in current byte size 31241 retsec 31242 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 23 K20TIM MAC 3-Apr-23 23:45 Computer character pointer and counter construction 31243 subttl Computer character pointer and counter construction 31244 31245 ; Note, PTYLEN is the number of words in a single page and is common 31246 ; for all devices. 31247 31248 000702'01 333 04 0 00 000561* comput: skiple t4, pars4 ; Pick up byte size for SOUTR% 31249 000703'01 254 00 0 00 000706' ifskp. ; Was anything specifed? 31250 dmove t2,[ ; No, use defaults 31251 point 8,0 ; Using 8 bit bits 31252 000704'01 120 02 0 00 003522' - ] ; Number of characters in the single page 31253 000705'01 254 00 0 00 000713' else. ; Otherwise, need to do some coversions 31254 000706'01 120 02 0 00 003524' dmove t2,[exp -1,-^d36] ;Load double negative integer 36 31255 000707'01 234 02 0 00 000004 div t2, t4 ; Calculate bytes per word 31256 000710'01 225 02 0 00 001000 muli t2, ptylen ; Now have total bytes we'll do in t3 31257 000711'01 205 02 0 00 440000 movx t2, ; Set up for an ILDB at bit '36' 31258 000712'01 137 04 0 00 003526' dpb t4, [ pointr t2, sbyte ] ; Drop in the byte size 31259 000713'01 endif. ; End non-standard byte size 31260 31261 000713'01 124 02 0 00 000000# dmovem t2, chrptr ; Store pointer prototype and count 31262 000714'01 263 17 0 00 000000 ret 31263 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 24 K20TIM MAC 3-Apr-23 23:45 Multi-fork timing common code 31264 subttl Multi-fork timing common code 31265 31266 ; See commentary on timing PTY virtual baud rate. These numbers are 31267 ; only used to validate the granularity of regular transfers 31268 31269 extern frclose ; Force a JFN closed 31270 extern cmprmn ; cmpse in k20ioc 31271 31272 000715'01 tcommn: remark ; Assumes these are saved 31273 remark ; N.B., q4 and p1 are aliases!! 31274 31275 000715'01 400 12 0 00 000000 setz p2, ;[223] No inferior fork yet 31276 000716'01 260 17 0 00 001601' call parset ;[223] Set up parity, if doing parity 31277 000717'01 254 00 0 00 001235' jrst epicom ;[223] Beat it, we've got to fix our tables 31278 31279 000720'01 201 01 0 00 000020 movx t1, ^d16 ; Transferring 16 accumulators 31280 dmove t2, [ devcod ; Source is device code 31281 000721'01 120 02 0 00 003527' devacs ] ; Destination is writable storage 31282 000722'01 123 01 0 00 003531' xblt. t1 ; Transfer so we can modify it 31283 31284 000723'01 201 03 0 00 000000# movei t3, devacs ; Resolve address of writable AC's 31285 000724'01 120 01 0 00 000000# dmove t1, chrptr ; Load byte pointer prototype and count 31286 000725'01 502 01 0 03 000000 hllm t1, 0(t3) ; Tweak byte size and pointer 31287 000726'01 202 02 0 03 000003 movem t2, t3(t3) ; Put the correct count in 31288 31289 remark ; N.B., cr%map makes a real gross page map, sigh. 31290 dmove t1, [ cr%map!cr%acs!cr%st!fld(devinf,cr%pcv) 31291 000727'01 120 01 0 00 003532' devacs ] ; Set AC's to have device inferior code 31292 000730'01 104 00 0 00 000152 CFORK% ; Make me a fork (poof! You're a fork) 31293 000731'01 320 12 0 00 000733' %jserr (,epicom) 31294 000732'01 254 00 0 00 000736' 31295 000733'01 265 01 0 00 000656* 31296 000734'01 000000000000# 31297 000735'01 254 00 0 00 001235' 31298 000375'04 103 157 165 154 144 31299 000736'01 200 12 0 00 000001 move p2, t1 ; store inferior handle 31300 31301 000737'01 200 01 0 00 000012 move t1, p2 ; Load inferior's handle 31302 000740'01 104 00 0 00 000163 WFORK% ; Wait for inferior initialization completion 31303 000741'01 320 12 0 00 000743' %jserr(, epicom) 31304 000742'01 254 00 0 00 000746' 31305 000743'01 265 01 0 00 000733* 31306 000744'01 000000000000# 31307 000745'01 254 00 0 00 001235' 31308 000403'04 125 156 141 142 154 31309 000746'01 104 00 0 00 000012 GETER% ; Find out inferior's last error 31310 000747'01 320 12 0 00 000751' %jserr(, epicom) 31311 000750'01 254 00 0 00 000754' 31312 000751'01 265 01 0 00 000743* 31313 000752'01 000000000000# 31314 000753'01 254 00 0 00 001235' 31315 000416'04 125 156 141 142 154 31316 000754'01 621 02 0 00 777777 tlz t2, -1 ; Stomp silly fork handle 31317 000755'01 306 02 0 00 601405 cain t2, lstrx1 ; Everything's Archie, right? 31318 000756'01 254 00 0 00 000766' ifskp. ; It isn't, so complain K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 24-1 K20TIM MAC 3-Apr-23 23:45 Multi-fork timing common code 31319 000757'01 201 01 0 00 400000 movei t1, .fhslf ; Set our last error to inferior's 31320 000760'01 104 00 0 00 000336 SETER% ; So diagnostic message is more meaningful 31321 000761'01 334 00 0 00 000000 %ermsg(,epicom) 31322 000762'01 254 00 0 00 000766' 31323 000763'01 265 01 0 00 000751* 31324 000764'01 000000000000# 31325 000765'01 254 00 0 00 001235' 31326 000430'04 111 156 146 145 162 31327 000766'01 endif. 31328 31329 remark t1, .fhinf ; Still has the fork handle 31330 000766'01 514 02 0 00 000006 hrlz t2, q2 ; Load PTY's TTY JFN as inferior's primary input 31331 000767'01 541 02 0 00 777777 hrri t2, .cttrm ; But it can still write to our terminal 31332 000770'01 104 00 0 00 000207 SPJFN% ; Set it so SINR% doesn't break 31333 000771'01 320 12 0 00 000773' %jserr(, epicom) 31334 000772'01 254 00 0 00 000776' 31335 000773'01 265 01 0 00 000763* 31336 000774'01 000000000000# 31337 000775'01 254 00 0 00 001235' 31338 000441'04 125 156 141 142 154 31339 000776'01 416 00 0 00 000000# setmm devred ; Create reading page, so not creation time charge 31340 000777'01 661 01 0 00 400000 txo t1, sf%con ; Continuing inferior 31341 001000'01 104 00 0 00 000157 SFORK% ; Get it started in its read 31342 001001'01 320 12 0 00 001003' %jserr(, epicom) 31343 001002'01 254 00 0 00 001006' 31344 001003'01 265 01 0 00 000773* 31345 001004'01 000000000000# 31346 001005'01 254 00 0 00 001235' 31347 000451'04 125 156 141 142 154 31348 31349 001006'01 621 01 0 00 400000 txz t1, sf%con ; Get a clean fork handle 31350 001007'01 201 02 0 00 000000# movei t2, devacs ; Load address of inferior AC block 31351 dmove t3, [ lstrx1 ; What indicates it isn't in SINR%, yet 31352 001010'01 120 03 0 00 003534' ^d20 ] ; Only wait 5 seconds (.25 * 20) 31353 31354 001011'01 do. ; Enter inferior fork check loop context 31355 001011'01 104 00 0 00 000154 FFORK% ; Freeze inferor (so we can read its AC's) 31356 001012'01 320 12 0 00 001014' %jserr (,epicom) 31357 001013'01 254 00 0 00 001017' 31358 001014'01 265 01 0 00 001003* 31359 001015'01 000000000000# 31360 001016'01 254 00 0 00 001235' 31361 000461'04 125 156 141 142 154 31362 001017'01 104 00 0 00 000161 RFACS% ; Read inferior's accumulators 31363 001020'01 320 12 0 00 001022' %jserr (,epicom) 31364 001021'01 254 00 0 00 001025' 31365 001022'01 265 01 0 00 001014* 31366 001023'01 000000000000# 31367 001024'01 254 00 0 00 001235' 31368 000467'04 125 156 141 142 154 31369 001025'01 104 00 0 00 000155 RFORK% ; And resume the fork 31370 001026'01 320 12 0 00 001030' %jserr (,epicom) 31371 001027'01 254 00 0 00 001033' 31372 001030'01 265 01 0 00 001022* 31373 001031'01 000000000000# K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 24-2 K20TIM MAC 3-Apr-23 23:45 Multi-fork timing common code 31374 001032'01 254 00 0 00 001235' 31375 000477'04 125 156 141 142 154 31376 001033'01 312 03 0 02 000002 came t3, t2(t2) ; Not in the SINR% yet? 31377 001034'01 254 00 0 00 001041' exit. ; Finally in the SINR% (or real close!!) 31378 001035'01 201 01 0 00 000372 movei t1, ^d250 ; Wait a bit for it to turn back on 31379 001036'01 104 00 0 00 000167 DISMS% ; And chill out for a bit 31380 001037'01 200 01 0 00 000012 move t1, p2 ; Reload the fork handle 31381 001040'01 367 04 0 00 001011' sojg t4, top. ; Try again (but only so long) 31382 001041'01 enddo. ; Exit loop context 31383 31384 001041'01 326 04 0 00 001047' ife. t4 ; Exhausted the count? 31385 001042'01 334 00 0 00 000000 %ermsg (,epicom) 31386 001043'01 254 00 0 00 001047' 31387 001044'01 265 01 0 00 001030* 31388 001045'01 000000000000# 31389 001046'01 254 00 0 00 001235' 31390 000505'04 124 151 155 145 144 31391 001047'01 endif. ; piffle.... 31392 31393 remark ; Loop appears to be unnecessary for inter-job... 31394 001047'01 260 17 0 00 002033' call statim ; Start timing the transfer 31395 001050'01 120 02 0 00 000000# dmove t2, chrptr ; Load pointer prototype and count 31396 001051'01 541 02 0 00 000000# hrri t2, devwrt ; Where we're writing from 31397 001052'01 332 00 0 00 000000# skipe timpar ;[223] Unless doing parity 31398 001053'01 541 02 0 00 000000# hrri t2, devdat ;[223] OK, so we're doing it with parity bits set 31399 001054'01 201 13 0 00 000031 movei p3, ^d25 ; Only wait so long for buffers to drain 31400 ; Loop is because of limited monitor buffers 31401 001055'01 do. ; Enter loop context 31402 001055'01 550 01 0 00 000005 hrrz t1, q1 ; Load the source JFN (no flags) 31403 001056'01 200 04 0 00 000003 move t4, t3 ; Save a copy of remaining character count 31404 001057'01 104 00 0 00 000532 SOUTR% ; Blammo!! 31405 001060'01 320 12 0 00 001062' ifje. r ; Uh oh, investigate the failure 31406 001061'01 254 00 0 00 001071' 31407 001062'01 306 01 0 00 602423 cain t1, IOX33 ; Inferior couldn't swallow all of it at once? 31408 001063'01 254 00 0 00 001071' anskp. ; Nope; however, we can recover from this 31409 001064'01 334 00 0 00 000000 %ermsg(, epicom) 31410 001065'01 254 00 0 00 001071' 31411 001066'01 265 01 0 00 001044* 31412 001067'01 000000000000# 31413 001070'01 254 00 0 00 001235' 31414 000515'04 125 156 141 142 154 31415 001071'01 endif. ; Carry on if worked or IOX33 31416 001071'01 322 03 0 00 001101' jumpe t3, endlp. ; If done, then leave 31417 001072'01 312 03 0 00 000004 came t3, t4 ; Did it do anything, actually? 31418 001073'01 254 00 0 00 001055' loop. ; Yes, so ready to do some more 31419 001074'01 260 17 0 00 001327' call ckdtwr ; Otherwise, check device write status 31420 001075'01 254 00 0 00 001235' jrst epicom ; Something went wrong or is bad 31421 001076'01 201 01 0 00 000144 movei t1, ^d100 ; Give inferior a chance to run 31422 001077'01 104 00 0 00 000167 DISMS% ; So it can catch its breath 31423 001100'01 367 13 0 00 001055' sojg p3, top. ; And try another drop 31424 001101'01 enddo. ; Exit loop context 31425 31426 001101'01 326 13 0 00 001107' ife. p3 ; Exhausted the count? 31427 001102'01 334 00 0 00 000000 %ermsg (,epicom) 31428 001103'01 254 00 0 00 001107' K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 24-3 K20TIM MAC 3-Apr-23 23:45 Multi-fork timing common code 31429 001104'01 265 01 0 00 001066* 31430 001105'01 000000000000# 31431 001106'01 254 00 0 00 001235' 31432 000526'04 124 151 155 145 144 31433 001107'01 endif. ; piffle.... 31434 31435 remark ; Repeating previous code for better error messages 31436 001107'01 200 01 0 00 000012 move t1, p2 ; Load inferior's handle 31437 001110'01 104 00 0 00 000163 WFORK% ; Wait for inferior SINR% to complete 31438 001111'01 320 12 0 00 001113' %jserr(,epicom) 31439 001112'01 254 00 0 00 001116' 31440 001113'01 265 01 0 00 001104* 31441 001114'01 000000000000# 31442 001115'01 254 00 0 00 001235' 31443 000535'04 125 156 141 142 154 31444 001116'01 104 00 0 00 000012 GETER% ; Find out inferior's last error 31445 001117'01 320 12 0 00 001121' %jserr(,epicom) 31446 001120'01 254 00 0 00 001124' 31447 001121'01 265 01 0 00 001113* 31448 001122'01 000000000000# 31449 001123'01 254 00 0 00 001235' 31450 000547'04 125 156 141 142 154 31451 001124'01 621 02 0 00 777777 tlz t2, -1 ; Stomp silly fork handle 31452 001125'01 306 02 0 00 601405 cain t2, lstrx1 ; Everything's Archie, right? 31453 001126'01 254 00 0 00 001136' ifskp. ; It isn't, so complain 31454 001127'01 201 01 0 00 400000 movei t1, .fhslf ; Set our last error to inferior's 31455 001130'01 104 00 0 00 000336 SETER% ; So diagnostic message is more meaningful 31456 001131'01 334 00 0 00 000000 %ermsg(,epicom) 31457 001132'01 254 00 0 00 001136' 31458 001133'01 265 01 0 00 001121* 31459 001134'01 000000000000# 31460 001135'01 254 00 0 00 001235' 31461 000561'04 111 156 146 145 162 31462 001136'01 endif. 31463 31464 001136'01 260 17 0 00 002133' call elptim ; Compute elapsed transfer time 31465 31466 001137'01 260 17 0 00 001750' call parchk ;[223] Check parity, if doing parity 31467 001140'01 254 00 0 00 001235' jrst epicom ;[223] Skip the rest of it 31468 31469 remark ; Check the data made it over correctly 31470 001141'01 415 16 0 00 001161' block. ; Build a stack frame to preserve registers 31471 001142'01 261 17 0 00 000016 31472 001143'01 332 00 0 00 000000# skipe timpar ;[223] Did we already check the parity? 31473 001144'01 254 00 0 00 000661* retskp ;[223] We did, so if made it here, everything is fine 31474 001145'01 265 16 0 00 003536' saveac ; Need to save these 31475 001146'01 210 01 0 00 000000# movn t1, chrcnt ; Load length of string sent 31476 001147'01 200 04 0 00 000001 move t4, t1 ; Strings are the same length 31477 001150'01 403 03 0 00 000006 setzb t3, q2 ; Section local string pointers 31478 001151'01 200 02 0 00 000000# move t2, chrptr ; Load correct character pointer and size 31479 001152'01 510 05 0 00 000002 hllz q1, t2 ; Both sources are equivalent here 31480 001153'01 541 02 0 00 000000# hrri t2, devwrt ; What we wrote 31481 001154'01 541 05 0 00 000000# hrri q1, devred ; What we read 31482 001155'01 123 01 0 00 000000* extend t1, cmprmn ; See if everything made it through OK 31483 001156'01 263 17 0 00 000000 ret ; Not equal, phooey! K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 24-4 K20TIM MAC 3-Apr-23 23:45 Multi-fork timing common code 31484 001157'01 254 00 0 00 001144* retskp ; Equal!! 31485 001160'01 263 17 0 00 000000 endbk. ; End block 31486 001161'01 254 00 0 00 001164' ifskp. ; Worked 31487 001162'01 600 00 0 00 000000 nop ; No special action, carry on 31488 001163'01 254 00 0 00 001202' else. ; Failed??? 31489 001164'01 200 03 0 00 000001 move t3, t1 ; Save source character count 31490 001165'01 200 06 0 00 000002 move q2, t2 ; Save source character pointer 31491 001166'01 200 01 0 00 000000# emsg () 31492 001167'01 104 00 0 00 000313 31493 000141'02 000000000000# 31494 000571'04 124 151 155 151 156 31495 001170'01 201 01 0 00 000101 movei t1, .priou ; Continue blatting 31496 001171'01 210 02 0 00 000000# movn t2, chrcnt ; Load length of string sent 31497 001172'01 274 02 0 00 000003 sub t2, t3 ; Subtract remaining characters 31498 001173'01 201 03 0 00 000012 movei t3, fld(^d10,no%rdx) 31499 001174'01 104 00 0 00 000224 NOUT% ; Shows what character we croaked on 31500 001175'01 320 12 0 00 001176' erjmpr .+1 31501 001176'01 561 01 0 00 000240* hrroi t1, crlf 31502 001177'01 104 00 0 00 000076 PSOUT% 31503 001200'01 320 12 0 00 001201' erjmpr .+1 31504 001201'01 254 00 0 00 001235' jrst epicom 31505 001202'01 endif. 31506 31507 remark ; Finally get to do some arithmatic!! 31508 001202'01 400 01 0 00 000000 setz t1, ; Load integer high order of character count 31509 001203'01 210 02 0 00 000000# movn t2, chrcnt ; Load load order character count 31510 001204'01 116 01 0 00 003546' dmul t1, [exp 0, ^d100000*^d10 ] ; Scale to bits in microsecond time 31511 001205'01 120 01 0 00 000003 dmove t1, t3 ; Load low order double word 31512 001206'01 260 17 0 00 003246' call dfloat ; Convert to double floating point 31513 001207'01 334 00 0 00 000000 %ermsg (, epicom) 31514 001210'01 254 00 0 00 001214' 31515 001211'01 265 01 0 00 001133* 31516 001212'01 000000000000# 31517 001213'01 254 00 0 00 001235' 31518 000603'04 125 156 141 142 154 31519 001214'01 120 03 0 00 000001 dmove t3, t1 ; Save double floating bit count 31520 31521 001215'01 120 01 0 00 000000# dmove t1, ewallt+.datus ; Load tens of nanoseconds used 31522 001216'01 260 17 0 00 003246' call dfloat ; Convert to double floating point 31523 001217'01 334 00 0 00 000000 %ermsg (, epicom) 31524 001220'01 254 00 0 00 001224' 31525 001221'01 265 01 0 00 001211* 31526 001222'01 000000000000# 31527 001223'01 254 00 0 00 001235' 31528 000612'04 125 156 141 142 154 31529 001224'01 113 03 0 00 000001 dfdv t3, t1 ; Divide bits by ticks 31530 31531 001225'01 415 16 0 00 001232' block. ; Enter block context for another frame 31532 001226'01 261 17 0 00 000016 31533 001227'01 265 16 0 00 003550' saveac ; Save result before the call 31534 001230'01 260 17 0 00 001235' call epicom ; Stomp everything 31535 001231'01 263 17 0 00 000000 endbk. ; Exit block context 31536 31537 001232'01 200 05 0 00 000004 move t5, t4 ; Return virtual baud rate for some device 31538 001233'01 200 04 0 00 000003 move t4, t3 ; Return the high order, too K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 24-5 K20TIM MAC 3-Apr-23 23:45 Multi-fork timing common code 31539 001234'01 254 00 0 00 001157* retskp ; Return success 31540 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 25 K20TIM MAC 3-Apr-23 23:45 Common timing test epilogue code 31541 subttl Common timing test epilogue code 31542 31543 ; N.B., Do not change the order of resource release, below! 31544 ; 31545 ; 1) An open JFN that is in active use via an SPJFN% can not be 31546 ; closed or even force closed, the error being an arcane CLSX2, 31547 ; "File cannot be closed by this process". 31548 ; 31549 ; This is why the SPJFN% is done before any close attempts. 31550 ; (Learned that the hard way...) 31551 ; 31552 ; 2) The SPJFN% is also done before the KFORK% as a caution to the 31553 ; JFN being left in an odd way or the KFORK% failing. 31554 31555 001235'01 336 01 0 00 000012 epicom: skipn t1, p2 ; Did we have a fork? 31556 001236'01 254 00 0 00 001257' ifskp. ; We did, chuck it 31557 001237'01 200 02 0 00 003560' movx t2, <.nulio,,.nulio> ; Truely shut it up 31558 001240'01 104 00 0 00 000207 SPJFN% ; Attempt the muzzling 31559 001241'01 320 12 0 00 001243' ifje. r ; Catch and store error 31560 001242'01 254 00 0 00 001245' 31561 001243'01 200 04 0 00 000001 move t4, t1 ; Store error for debuggers 31562 001244'01 200 01 0 00 000012 move t1, p2 ; Reload the fork handle 31563 001245'01 endif. ; But carry on in either case 31564 001245'01 403 03 0 00 000004 setzb t3, t4 ; Whack JSYS error talismen 31565 001246'01 104 00 0 00 000153 KFORK% ; Try to clobber the inferior 31566 001247'01 320 12 0 00 001251' ifje. r ; Catch and store error 31567 001250'01 254 00 0 00 001256' 31568 001251'01 200 04 0 00 000001 move t4, t1 ; Store error for debuggers 31569 001252'01 200 01 0 00 000012 move t1, p2 ; Reload the fork handle again 31570 001253'01 104 00 0 00 000165 RFRKH% ; At least try to release that 31571 001254'01 254 00 0 00 001256' ifskp. ; There is no joy in mudville 31572 001255'01 200 03 0 00 000001 move t3, t1 ; Store for debuggders 31573 001256'01 endif. ; End case RFRKH% failure handling 31574 001256'01 endif. ; Continue and clean up storage 31575 001256'01 400 12 0 00 000000 setz p2, ; Either way, no more fork 31576 001257'01 endif. 31577 31578 001257'01 336 01 0 00 000006 skipn t1, q2 ; Did we ever have a destination JFN? 31579 001260'01 254 00 0 00 001264' ifskp. ; We did 31580 001261'01 260 17 0 00 000000* call frclose ; Force it closed (see k20sub) 31581 001262'01 600 00 0 00 000000 nop ; Failed somehow 31582 001263'01 400 06 0 00 000000 setz q2, ; Either way, no destination JFN 31583 001264'01 endif. 31584 31585 001264'01 336 01 0 00 000005 skipn t1, q1 ; Did we ever have a source JFN? 31586 001265'01 254 00 0 00 001271' ifskp. ; We did 31587 001266'01 260 17 0 00 001261* call frclose ; Force it closed (see k20sub) 31588 001267'01 600 00 0 00 000000 nop ; Failed somehow 31589 001270'01 400 05 0 00 000000 setz q1, ; Either way, no source JFN 31590 001271'01 endif. 31591 31592 001271'01 474 01 0 00 000000 seto t1, ; Removing pages 31593 dmove t2,[.fhslf,,nulpag+1 ;Whacking dirty pages from address space 31594 001272'01 120 02 0 00 003561' pm%cnt!pm%abt!fld(,pm%cnt) ] 31595 001273'01 104 00 0 00 000056 PMAP% ; Reduce our working set size K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 25-1 K20TIM MAC 3-Apr-23 23:45 Common timing test epilogue code 31596 001274'01 320 12 0 00 001276' ifje. r ; Should never happen... 31597 001275'01 254 00 0 00 001277' 31598 001276'01 200 04 0 00 000001 move t4, t1 ; Store error for debuggers 31599 001277'01 endif. 31600 31601 001277'01 336 01 0 00 000010 skipn t1, q4 ; Did we assign the PTY's associated terminal? 31602 001300'01 254 00 0 00 001306' ifskp. ; We did, release it 31603 001301'01 104 00 0 00 000071 RELD% ; Try to punt the TTY 31604 001302'01 320 12 0 00 001304' ifje. r ; Catch and store error 31605 001303'01 254 00 0 00 001305' 31606 001304'01 200 04 0 00 000001 move t4, t1 ; Store error for debuggers 31607 001305'01 endif. ; Carry on! 31608 001305'01 400 10 0 00 000000 setz q4, ; Either way, no assigned terminal 31609 001306'01 endif. 31610 31611 001306'01 336 01 0 00 000007 skipn t1, q3 ; Did we assign a PTY? 31612 001307'01 254 00 0 00 001326' ifskp. ; We did, release it 31613 001310'01 104 00 0 00 000071 RELD% ; Try to punt the PTY 31614 001311'01 320 12 0 00 001313' ifje. r ; Catch and store error 31615 001312'01 254 00 0 00 001314' 31616 001313'01 200 04 0 00 000001 move t4, t1 ; Store error for debuggers 31617 001314'01 endif. ; Continue and clean up storage 31618 001314'01 400 07 0 00 000000 setz q3, ; Either way, no assigned PTY 31619 001315'01 402 00 0 00 000260* setzm asgflg ; Clear device assignment flag 31620 001316'01 402 00 0 00 000000* setzm asgdev ; Clear stored assigned device 31621 001317'01 402 00 0 00 000000* setzm ptytty ; Clear PTY's associated TTY line number 31622 001320'01 402 00 0 00 000000* setzm ptyflg ; Clear pseudo-terminal I/O flag 31623 001321'01 402 00 0 00 000000* setzm binflg ; Clear binary I/O flag 31624 001322'01 403 01 0 00 000002 setzb t1, t2 ; Cons up a zero double word 31625 001323'01 124 01 0 00 000000* dmovem t1, ndvchr ; Whack characteristics double word 31626 001324'01 124 01 0 00 000000* dmovem t1, ttynam ; No ASCII terminal device name 31627 001325'01 124 01 0 00 000000* dmovem t1, ptynam ; No pseudo-terminal device name 31628 001326'01 endif. 31629 31630 001326'01 263 17 0 00 000000 ret ; Phew!! 31631 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 26 K20TIM MAC 3-Apr-23 23:45 Device lower fork checking code 31632 subttl Device lower fork checking code 31633 31634 ; Here if the upper fork SOUTR% fails and the byte count is unchanged 31635 31636 define errtxt (t,%t,%et) < ;;Macro to put a string in text section 31637 move t1,%t ;;Local pointer to text 31638 31639 chgsec(code,const) ;;Put pointer to extended text in const section 31640 %t: .px7!%et ;;OWGP to extended section 31641 retsec ;;Restore .PSECT assumptions 31642 31643 chgsec(code,etext) ;;Open non-section zero text 31644 %et: asciz |'t| ;;Deposit text and label text with generated symbol 31645 retsec ;;Restore .PSECT assumptions 31646 cleans(<%t,%et>) ;;Punt generated symbols 31647 >;;errtxt 31648 31649 001327'01 265 16 0 00 003563' ckdtwr: saveac ; Modifies no registers 31650 31651 remark ; First, pull fork information 31652 001330'01 200 01 0 00 000012 move t1, p2 ; Load inferior's handle 31653 001331'01 104 00 0 00 000012 GETER% ; Get its last error 31654 001332'01 320 12 0 00 001334' %jserr(, r) 31655 001333'01 254 00 0 00 001337' 31656 001334'01 265 01 0 00 001221* 31657 001335'01 000000000000# 31658 001336'01 254 00 0 00 000660* 31659 000621'04 125 156 141 142 154 31660 001337'01 621 02 0 00 777777 tlz t2, -1 ; Stomp silly fork handle 31661 001340'01 200 07 0 00 000002 move q3, t2 ; And save the last error 31662 001341'01 200 01 0 00 000012 move t1, p2 ; Load inferior's handle 31663 001342'01 104 00 0 00 000156 RFSTS% ; Return fork status 31664 001343'01 320 12 0 00 001345' %jserr(, r) 31665 001344'01 254 00 0 00 001350' 31666 001345'01 265 01 0 00 001334* 31667 001346'01 000000000000# 31668 001347'01 254 00 0 00 001336* 31669 000630'04 125 156 141 142 154 31670 001350'01 621 02 0 00 777777 tlz t2, -1 ; Stomp any flags 31671 001351'01 120 05 0 00 000001 dmove q1, t1 ; Save the inferior's status and PC 31672 31673 001352'01 135 04 0 00 003601' ldb t4, [pointr. q1, rf%sts] 31674 001353'01 305 04 0 00 000011 caige t4, .rfmax ; Out of range? 31675 001354'01 254 00 0 00 001366' ifskp. ; Must be a new monitor 31676 001355'01 201 01 0 00 400000 movei t1, .fhslf ; Set our last error 31677 001356'01 200 02 0 00 000007 move t2, q3 ; To inferior's for better 31678 001357'01 104 00 0 00 000336 SETER% ; Diagnostic messages 31679 001360'01 320 12 0 00 001361' erjmpr .+1 ; Catch and ignore error 31680 001361'01 334 00 0 00 000000 %ermsg(,r) 31681 001362'01 254 00 0 00 001366' 31682 001363'01 265 01 0 00 001345* 31683 001364'01 000000000000# 31684 001365'01 254 00 0 00 001347* 31685 000640'04 111 156 146 145 162 31686 001366'01 endif. ; But regular handler won't work K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 26-1 K20TIM MAC 3-Apr-23 23:45 Device lower fork checking code 31687 31688 001366'01 306 07 0 00 601405 cain q3, lstrx1 ; Everything's Archie, right? 31689 001367'01 254 00 0 00 001372' ifskp. ; It isn't, so complain 31690 001370'01 200 01 0 00 000000# errtxt() 31691 000142'02 000000000000# 31692 000650'04 111 156 146 145 162 31693 001371'01 254 00 0 00 001414' callret ckderr ; Return from error type out 31694 001372'01 endif. 31695 31696 001372'01 325 05 0 00 001375' ifxn. q1, rf%frz ; Did it get frozen somehow? 31697 001373'01 200 01 0 00 000000# errtxt() 31698 000143'02 000000000000# 31699 000662'04 111 156 146 145 162 31700 001374'01 254 00 0 00 001414' callret ckderr ; Return from error type out 31701 001375'01 endif. ; Should never happen in the push loop 31702 ; Otherwise, load its status 31703 001375'01 306 04 0 00 000000 cain t4, .rfrun ; Running? 31704 001376'01 254 00 0 00 001234* retskp ; That's OK. I guess... 31705 001377'01 306 04 0 00 000001 cain t4, .rfio ; Doing I/O? 31706 001400'01 254 00 0 00 001376* retskp ; This is expected (what its supposed to be doing) 31707 001401'01 302 04 0 00 000002 caie t4, .rfhlt ; Halted?? 31708 001402'01 254 00 0 00 001413' ifskp. ; That might be OK, actually 31709 001403'01 302 06 0 00 000012 caie q2, devhlt+1 ; Normal halt? 31710 001404'01 254 00 0 00 001411' ifskp. ; Yes, so need to wait for buffers to drain 31711 txmsg <% Inferior timing fork normal termination, waiting on buffers 31712 001405'01 200 01 0 00 000000# > 31713 001406'01 104 00 0 00 000076 31714 001407'01 320 12 0 00 001410' 31715 000144'02 000000000000# 31716 000673'04 045 040 111 156 146 31717 31718 001410'01 254 00 0 00 001400* retskp ; And try again 31719 001411'01 endif. ; Otherwise, a real error 31720 001411'01 200 01 0 00 000000# errtxt() 31721 000145'02 000000000000# 31722 000710'04 111 156 146 145 162 31723 001412'01 254 00 0 00 001414' callret ckderr ; Return from error type out 31724 001413'01 endif. 31725 31726 remark ; Any other status is bad 31727 001413'01 200 01 0 00 000000# errtxt () 31728 000146'02 000000000000# 31729 000720'04 111 156 146 145 162 31730 remark ckderr ; Fall through to error type out 31731 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 27 K20TIM MAC 3-Apr-23 23:45 Handle print out of inferior error 31732 subttl Handle print out of inferior error 31733 31734 ; Expects ckptwr register environment except t1 has an error message 31735 31736 001414'01 104 00 0 00 000313 ckderr: ESOUT% ; First, do the blat 31737 001415'01 320 12 0 00 001416' erjmpr .+1 ; Catch and ignore error 31738 001416'01 201 01 0 00 000054 movei t1, "," ; Punctuate first part of error message 31739 001417'01 104 00 0 00 000074 PBOUT% 31740 001420'01 320 12 0 00 001421' erjmpr .+1 ; Catch and ignore error 31741 001421'01 201 01 0 00 000040 movei t1, .chspc ; And space over 31742 001422'01 104 00 0 00 000074 PBOUT% 31743 001423'01 320 12 0 00 001424' erjmpr .+1 ; Catch and ignore error 31744 31745 001424'01 200 01 0 04 001475' move t1,rfstst(t4) ; Load appropriate status text 31746 001425'01 104 00 0 00 000076 PSOUT% ; Type it 31747 001426'01 320 12 0 00 001427' erjmpr .+1 ; Catch and ignore error 31748 31749 001427'01 302 04 0 00 000003 caie t4, .rffpt ; Forced? 31750 001430'01 254 00 0 00 001445' ifskp. ; Then we have some more information 31751 001431'01 200 01 0 00 000000# errtxt (<, channel: >) ;Meaning, the channel number 31752 000147'02 000000000000# 31753 000730'04 054 040 143 150 141 31754 001432'01 104 00 0 00 000076 PSOUT% ; Type that 31755 001433'01 320 12 0 00 001434' erjmpr .+1 ; Catch and ignore error 31756 001434'01 201 01 0 00 000101 movei t1, .priou ; Output to our terminal 31757 001435'01 135 02 0 00 003602' ldb t2, [pointr. q1, rf%sic] ; Load forcing channel 31758 001436'01 201 03 0 00 000012 movei t3, ^d10 ; Which is in base 10 31759 001437'01 104 00 0 00 000224 NOUT% ; Type it 31760 001440'01 334 00 0 00 000000 %ermsg(,r) 31761 001441'01 254 00 0 00 001445' 31762 001442'01 265 01 0 00 001363* 31763 001443'01 000000000000# 31764 001444'01 254 00 0 00 001365* 31765 000733'04 111 156 146 145 162 31766 001445'01 endif. 31767 31768 001445'01 201 01 0 00 000054 movei t1, "," ; Punctuate first part of error message 31769 001446'01 104 00 0 00 000074 PBOUT% 31770 001447'01 320 12 0 00 001450' erjmpr .+1 ; Catch and ignore error 31771 001450'01 201 01 0 00 000040 movei t1, .chspc ; And space over 31772 001451'01 104 00 0 00 000074 PBOUT% 31773 001452'01 320 12 0 00 001453' erjmpr .+1 ; Catch and ignore error 31774 31775 001453'01 200 01 0 00 000101 move t1, .priou ; Going to primary output 31776 001454'01 505 02 0 00 400000 hrli t2, .fhslf ; Have to use ourself for explicit error 31777 001455'01 540 02 0 00 000007 hrr t2, q3 ; Pick up inferior handle 31778 001456'01 400 03 0 00 000000 setz t3, ; No limit to blat 31779 001457'01 104 00 0 00 000011 ERSTR% ; Blat away! 31780 001460'01 320 12 0 00 001462' erjmpr .+2 ; Ignore its strange return 31781 001461'01 320 12 0 00 001462' erjmpr .+1 ; Ignore its stranger return 31782 31783 001462'01 201 01 0 00 000054 movei t1, "," ; Punctuate first part of error message 31784 001463'01 104 00 0 00 000074 PBOUT% 31785 001464'01 320 12 0 00 001465' erjmpr .+1 ; Catch and ignore error 31786 001465'01 201 01 0 00 000040 movei t1, .chspc ; And space over K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 27-1 K20TIM MAC 3-Apr-23 23:45 Handle print out of inferior error 31787 001466'01 104 00 0 00 000074 PBOUT% 31788 001467'01 320 12 0 00 001470' erjmpr .+1 ; Catch and ignore error 31789 31790 001470'01 200 01 0 00 000006 move t1, q2 ; Load inferior's captured PC 31791 001471'01 260 17 0 00 000000* call symout ; Symbolic type out of failed location 31792 31793 001472'01 561 01 0 00 001176* hrroi t1, crlf ; Tie off the line 31794 001473'01 104 00 0 00 000076 PSOUT% 31795 31796 001474'01 263 17 0 00 000000 ret ; Always return +1 to superior 31797 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 28 K20TIM MAC 3-Apr-23 23:45 Text for fork status codes 31798 subttl Text for fork status codes 31799 31800 remark ; RF%STS (Process Status Code) 31801 001475'01 000000000000# rfstst: eascii (< Runnable>) ; .RFRUN 31802 000741'04 040 122 165 156 156 31803 001476'01 000000000000# eascii (< I/O>) ; .RFIO (Dismissed for I/O) 31804 000743'04 040 111 057 117 000 31805 001477'01 000000000000# eascii (< Halted>) ; .RFHLT 31806 000744'04 040 110 141 154 164 31807 001500'01 000000000000# eascii (< Forced>) ; .RFFPT (Forced process termination) 31808 000746'04 040 106 157 162 143 31809 001501'01 000000000000# eascii (< Waiting>) ; .RFWAT (Waiting for inferior process) 31810 000750'04 040 127 141 151 164 31811 001502'01 000000000000# eascii (< Sleep>) ; .RFSLP 31812 000752'04 040 123 154 145 145 31813 001503'01 000000000000# eascii (< Trapped>) ; .RFTRP (JSYS Trapped) 31814 000754'04 040 124 162 141 160 31815 001504'01 000000000000# eascii (< Address>) ; .RFABK (Address break freeze) 31816 000756'04 040 101 144 144 162 31817 001505'01 000000000000# eascii (< Signal>) ; .RFSIG (Signal JFN freeze) 31818 000760'04 040 123 151 147 156 31819 000011 .rfmax==.rfsig+1 31820 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 29 K20TIM MAC 3-Apr-23 23:45 Discover NUL: baud rate 31821 subttl Discover NUL: baud rate 31822 31823 ; Written to merely check calculations code before writing other timers 31824 ; 31825 ; As above, NUL:'s virtual baud rate means very little. 31826 ; 31827 ; Unlike the above, NOTHING reads the SOUTR% because this is 31828 ; (onviously) impossible to do as the data just got dumped. The 31829 ; reason four times the data is written is to work the rate 31830 ; calculations in a different way, stressing them to look for edge 31831 ; cases 31832 ; 31833 ; Therefore, doing parity on NUL: is relatively to moderately...useless. 31834 31835 remark pars4 ; SOUTR% byte size 31836 31837 770000 000000 pbyte==maskb(0,5) ; Position of a byte in a section local pointer 31838 007700 000000 sbyte==maskb(6,11) ; Size of a byte in a section local pointer 31839 31840 001506'01 dnulbd: intern dnulbd ; Invoked by k20dsp 31841 001506'01 477 04 0 00 000005 setob t4, t5 ; Let's assume we can't do anything 31842 dmove t1,[.fhslf,,nulpag ; Source is NUL: page 31843 001507'01 120 01 0 00 003603' .fhslf,,nulpag+1 ] ; Destination is the second page 31844 001510'01 200 03 0 00 003605' movx t3, pm%cnt!pm%rd!fld(nulpgs,pm%rpt) ; Read only 31845 001511'01 104 00 0 00 000056 PMAP% ; Case III, process to process PMAP% 31846 001512'01 320 12 0 00 001514' %jserr (, nulepi) 31847 001513'01 254 00 0 00 001517' 31848 001514'01 265 01 0 00 001442* 31849 001515'01 000000000000# 31850 001516'01 254 00 0 00 001572' 31851 000762'04 125 156 141 142 154 31852 31853 remark ; NUL counts are different 31854 001517'01 333 04 0 00 000702* skiple t4, pars4 ; Pick up byte size for SOUTR% 31855 001520'01 254 00 0 00 001523' ifskp. ; Was anything specifed? 31856 dmove t2,[ ; No, use defaults 31857 point 8,nulwrt ; Where we're writing from 31858 001521'01 120 02 0 00 003606' - ] ; Number of characters in the pages 31859 001522'01 254 00 0 00 001531' else. ; Otherwise, need to do some coversions 31860 001523'01 120 02 0 00 003524' dmove t2,[exp -1,-^d36] ;Load double negative integer 36 31861 001524'01 234 02 0 00 000004 div t2, t4 ; Calculate bytes per word 31862 001525'01 225 02 0 00 004000 muli t2, nullen ; Now have total bytes we'll do in t3 31863 001526'01 205 02 0 00 440000 movx t2, ; Set up for an ILDB at bit '36' 31864 001527'01 137 04 0 00 003526' dpb t4, [ pointr t2, sbyte ] ; Drop in the byte size 31865 001530'01 541 02 0 00 000000# hrri t2, nulwrt ; Finally drop in the address 31866 001531'01 endif. ; End non-standard byte size 31867 31868 001531'01 201 01 0 00 377777 movx t1, .nulio ; Just dumping, maybe really fast 31869 001532'01 210 04 0 00 000003 movn t4, t3 ; Save count used 31870 001533'01 260 17 0 00 002033' call statim ; Start timing the transfer 31871 001534'01 104 00 0 00 000532 SOUTR% ; Bombs away!!! 31872 001535'01 320 12 0 00 001537' %jserr (, nulepi) 31873 001536'01 254 00 0 00 001542' 31874 001537'01 265 01 0 00 001514* 31875 001540'01 000000000000# K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 29-1 K20TIM MAC 3-Apr-23 23:45 Discover NUL: baud rate 31876 001541'01 254 00 0 00 001572' 31877 000770'04 125 156 141 142 154 31878 001542'01 260 17 0 00 002050' call endtim ; Finish the timing 31879 31880 001543'01 260 17 0 00 002133' call elptim ; Compute elapsed transfer time 31881 001544'01 400 01 0 00 000000 setz t1, ; Zero high order of characters transferred 31882 001545'01 200 02 0 00 000004 move t2, t4 ; Load low order of characters transferred 31883 001546'01 116 01 0 00 003546' dmul t1, [exp 0, ^d100000*^d10 ] ; Scale to bits in microsecond time 31884 001547'01 120 01 0 00 000003 dmove t1, t3 ; Load low order double word 31885 001550'01 260 17 0 00 003246' call dfloat ; Convert to double floating point 31886 001551'01 334 00 0 00 000000 %ermsg (, nulepi) 31887 001552'01 254 00 0 00 001556' 31888 001553'01 265 01 0 00 001537* 31889 001554'01 000000000000# 31890 001555'01 254 00 0 00 001572' 31891 000775'04 125 156 141 142 154 31892 001556'01 120 03 0 00 000001 dmove t3, t1 ; Save double floating bit count 31893 31894 001557'01 120 01 0 00 000000# dmove t1, ewallt+.datus ; Load tens of nanoseconds used 31895 001560'01 260 17 0 00 003246' call dfloat ; Convert to double floating point 31896 001561'01 334 00 0 00 000000 %ermsg (, nulepi) 31897 001562'01 254 00 0 00 001566' 31898 001563'01 265 01 0 00 001553* 31899 001564'01 000000000000# 31900 001565'01 254 00 0 00 001572' 31901 001003'04 125 156 141 142 154 31902 001566'01 113 03 0 00 000001 dfdv t3, t1 ; Divide bits by ticks 31903 001567'01 120 04 0 00 000003 dmove t4, t3 ; Return in the expected place 31904 001570'01 260 17 0 00 001572' call nulepi ; Call the epilogue 31905 001571'01 254 00 0 00 001410* retskp ; Return success 31906 31907 001572'01 nulepi: remark NUL test epilogue 31908 001572'01 474 01 0 00 000000 seto t1, ; Removing pages 31909 dmove t2,[.fhslf,,nulpag+1 ;Whacking dirty pages from address space 31910 001573'01 120 02 0 00 003610' pm%cnt!pm%abt!fld(nulpgs,pm%rpt) ] ; Read only 31911 001574'01 104 00 0 00 000056 PMAP% ; Reduce our working set size 31912 001575'01 320 12 0 00 001577' ifje. r ; Should never happen... 31913 001576'01 254 00 0 00 001600' 31914 001577'01 200 03 0 00 000001 move t3, t1 ; Store error for debuggers 31915 001600'01 endif. 31916 31917 001600'01 263 17 0 00 000000 ret 31918 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 30 K20TIM MAC 3-Apr-23 23:45 Set up for parity checking (if we're doing parity) 31919 subttl Set up for parity checking (if we're doing parity) 31920 31921 ;[223] Begin code insertion 31922 31923 ;N.B., Assumes we're ALWAYS doing 8 bit transfers, which is what 31924 ; Kermit would be sending over the line. However, due to the last 31925 ; four bits of the data being transferred having rotating values, 31926 ; it may be possible to get into the situation here where the byte 31927 ; parity is reported as being fine, but the word comparison can fail. 31928 31929 extern parity, none ; If we're doing any kind of parity 31930 extern genint ; Constructed instruction if generating parity 31931 remark ; If doing parity, ALWAYS sending AND checking it 31932 31933 chgsec(code,data) ;;Needs some writable storage 31934 000125'05 000000 000000 timpar: 0 ; Set if was doing parity 31935 retsec ;;Back in code 31936 31937 001601'01 402 00 0 00 000000# parset: setzm timpar ; Don't assume doing parity 31938 001602'01 200 01 0 00 000000* move t1, parity ; Load parity setting 31939 001603'01 302 01 0 00 000000* caie t1, none ; Not doing any parity? 31940 001604'01 254 00 0 00 001607' ifskp. ; Nope, nothing further to do 31941 001605'01 254 00 0 00 001571* retskp ; so get out of here 31942 001606'01 254 00 0 00 001614' else. ; Otherwise, doing some real work 31943 001607'01 335 01 0 00 000000# skipge t1, timdev ; Load timing device 31944 001610'01 254 00 0 00 001605* retskp ; Unless never got one 31945 001611'01 306 01 0 00 000015 cain t1, .dvnul ; NUL:? 31946 001612'01 254 00 0 00 001610* retskp ; Yeah, no way to read from that, so forget parity 31947 001613'01 476 00 0 00 000000# setom timpar ; Flag we're doing parity 31948 001614'01 endif. 31949 31950 remark ; OK to trash these temporaries 31951 001614'01 265 16 0 00 003612' saveac ; But needs many piggy registers 31952 31953 001615'01 201 01 0 00 004000 movei t1, devchr ; Load number of characters 31954 001616'01 200 04 0 00 000001 move t4, t1 ; destination string is same length 31955 001617'01 201 02 0 00 000000# movei t2, devwrt ; Load address of what will be written 31956 001620'01 201 05 0 00 000000# movei q1, devdat ; Where we'll write the converted data 31957 001621'01 505 02 0 00 441000 hrli t2, (point 8,0) ; Turn source address into a section local point 31958 001622'01 500 05 0 00 000002 hll q1, t2 ; Ditto destination pointer, both being 8 bits 31959 001623'01 403 03 0 00 000006 setzb t3, q2 ; Force pointer to remain section local 31960 001624'01 200 07 0 00 000000* move q3, genint ; Load parity generation instruction 31961 001625'01 400 10 0 00 000000 setz q4, ; Unused fill character will be NUL 31962 001626'01 661 01 0 00 400000 txo t1, S ; Start significance immediately 31963 001627'01 123 01 0 00 000007 extend t1, q3 ; Finally do the conversion 31964 001630'01 600 00 0 00 000000 nop ; Ignore non-skip (which should never happen) 31965 001631'01 254 00 0 00 001632' callret chkleg ; Check generated parity against legacy parity 31966 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 31 K20TIM MAC 3-Apr-23 23:45 Routine to check parity we generated against legacy routines 31967 subttl Routine to check parity we generated against legacy routines 31968 31969 ; +1 If disagreement someplace 31970 ; +2 If complete agreement 31971 31972 extern putc ; Does a small amount of formating 31973 31974 001632'01 chkleg: dmove t2, [ ; Will run legacy routines 31975 point 8, devwrt ; over same string 31976 001632'01 120 02 0 00 003624' point 8, devdat ] ; and compare the results 31977 001633'01 200 07 0 00 000002 move q3, t2 ; Save original string pointer 31978 001634'01 201 06 0 00 004000 movei q2, devchr ; Load number of characters 31979 31980 001635'01 do. ; Enter loop context 31981 001635'01 361 06 0 00 001644' sojl q2, endlp. ; Account for a character pair consumed 31982 001636'01 134 01 0 00 000002 ildb t1, t2 ; Pick up byte from original string 31983 001637'01 260 17 1 00 001602* call @parity ; Compute the correct parity 31984 001640'01 134 04 0 00 000003 ildb t4, t3 ; Pick up byte from MOVST generated string 31985 001641'01 312 01 0 00 000004 came t1, t4 ; The same? 31986 001642'01 254 00 0 00 001644' exit. ; They are not, give up right now 31987 001643'01 254 00 0 00 001635' loop. ; Nose through the rest 31988 001644'01 enddo. ; End loop lexical context 31989 31990 001644'01 321 06 0 00 001612* jumpl q2, RSKP ; Did them all? That's dandy!! 31991 ; Sigh... 31992 001645'01 200 05 0 00 000001 move q1, t1 ; Save legacy parity 31993 001646'01 200 10 0 00 000004 move q4, t4 ; Save MOVST generated parity 31994 001647'01 201 01 0 00 004000 movei t1, devchr ; Load original number of characters 31995 001650'01 274 01 0 00 000006 sub t1, q2 ; Calculate bad byte position 31996 001651'01 200 06 0 00 000001 move q2, t1 ; Save result 31997 001652'01 133 01 0 00 000007 adjbp t1, q3 ; Position to the correct character 31998 001653'01 135 07 0 00 000001 ldb q3, t1 ; And load the character 31999 ; Finally start complaining 32000 001654'01 200 01 0 00 000000# emsg () 32001 001655'01 104 00 0 00 000313 32002 000150'02 000000000000# 32003 001011'04 107 145 156 145 162 32004 001656'01 201 01 0 00 000101 movei t1, .priou ; Still typing on terminal 32005 001657'01 200 02 0 00 000006 move t2, q2 ; Load byte position 32006 001660'01 201 03 0 00 000010 movei t3, ^d8 ; k20ioc table is documented in octal 32007 001661'01 104 00 0 00 000224 NOUT% ; Type it 32008 001662'01 320 12 0 00 001664' %jserr (,) 32009 001663'01 254 00 0 00 001667' 32010 001664'01 265 01 0 00 001563* 32011 001665'01 000000000000# 32012 001666'01 254 00 0 00 001667' 32013 001017'04 125 156 141 142 154 32014 32015 001667'01 200 01 0 00 000000# txmsg (<, legacy: >) 32016 001670'01 104 00 0 00 000076 32017 001671'01 320 12 0 00 001672' 32018 000151'02 000000000000# 32019 001026'04 054 040 154 145 147 32020 001672'01 200 04 0 00 000005 move t4, q1 ; Load what arithmatic calculated 32021 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 15:19 11-Jun-23 Page 31-1 K20TIM MAC 3-Apr-23 23:45 Routine to check parity we generated against legacy routines 32022 001674'01 622 04 0 00 000200 txze t4, 200 ; Check and strip the parity 32023 001675'01 201 01 0 00 000061 movei t1, "1" ; It's set! 32024 001676'01 104 00 0 00 000074 PBOUT% ; Either way, type it 32025 001677'01 201 01 0 00 000101 movei t1, .priou ; Still typing on terminal 32026 001700'01 200 02 0 00 000004 move t2, t4 ; Load the value, itself 32027 001701'01 200 03 0 00 003626' movx t3, 32028 001702'01 104 00 0 00 000224 NOUT% ; Type it 32029 001703'01 320 12 0 00 001705' %jserr (,) 32030 001704'01 254 00 0 00 001710' 32031 001705'01 265 01 0 00 001664* 32032 001706'01 000000000000# 32033 001707'01 254 00 0 00 001710' 32034 001031'04 125 156 141 142 154 32035 32036 001710'01 200 01 0 00 000000# txmsg (<, table: >) 32037 001711'01 104 00 0 00 000076 32038 001712'01 320 12 0 00 001713' 32039 000152'02 000000000000# 32040 001040'04 054 040 164 141 142 32041 001713'01 200 04 0 00 000010 move t4, q4 ; Load what MOVST looked up 32042 001714'01 201 01 0 00 000060 movei t1, "0" ; Let's assume it was zero 32043 001715'01 622 04 0 00 000200 txze t4, 200 ; Check and strip the parity 32044 001716'01 201 01 0 00 000061 movei t1, "1" ; It's set! 32045 001717'01 104 00 0 00 000074 PBOUT% ; Either way, type it 32046 001720'01 201 01 0 00 000101 movei t1, .priou ; Still typing on terminal 32047 001721'01 200 02 0 00 000004 move t2, t4 ; Load the value, itself 32048 001722'01 200 03 0 00 003626' movx t3, 32049 001723'01 104 00 0 00 000224 NOUT% ; Type it 32050 001724'01 320 12 0 00 001726' %jserr (,) 32051 001725'01 254 00 0 00 001731' 32052 001726'01 265 01 0 00 001705* 32053 001727'01 000000000000# 32054 001730'01 254 00 0 00 001731' 32055 001042'04 125 156 141 142 154 32056 32057 001731'01 200 01 0 00 000000# txmsg (<, character: >) 32058 001732'01 104 00 0 00 000076 32059 001733'01 320 12 0 00 001734' 32060 000153'02 000000000000# 32061 001050'04 054 040 143 150 141 32062 001734'01 400 04 0 00 000000 setz t4, ; Let's assume bit 8 is not up 32063 001735'01 200 01 0 00 000007 move t1, q3 ; Load the character 32064 001736'01 622 01 0 00 000200 txze t1, 200 ; Zero bit 8 and skip if wasn't set 32065 001737'01 474 04 0 00 000000 seto t4, ; Was set... 32066 001740'01 260 17 0 00 000000* call putc ; Type our poor character 32067 001741'01 322 04 0 00 001745' ifn. t4 ; Did it have bit eight up? 32068 001742'01 200 01 0 00 000000# txmsg (<(M)>) ; List that as 'Mark' 32069 001743'01 104 00 0 00 000076 32070 001744'01 320 12 0 00 001745' 32071 000154'02 000000000000# 32072 001053'04 050 115 051 000 000 32073 001745'01 endif. 32074 001745'01 561 01 0 00 001472* hrroi t1, crlf 32075 001746'01 104 00 0 00 000076 PSOUT% 32076 001747'01 263 17 0 00 000000 ret K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 31-2 K20TIM MAC 3-Apr-23 23:45 Routine to check parity we generated against legacy routines 32077 32078 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 32 K20TIM MAC 3-Apr-23 23:45 Check parity (if we're doing parity) 32079 subttl Check parity (if we're doing parity) 32080 32081 ;N.B., Assumes parset has been called and will almost surly *BREAK* otherwise 32082 32083 extern chkint ; Constructed instruction if checking parity 32084 32085 001750'01 336 00 0 00 000000# parchk: skipn timpar ; Did we actually do any parity? 32086 001751'01 254 00 0 00 001644* retskp ; Nope, then say all is well 32087 001752'01 335 01 0 00 000000# skipge t1, timdev ; Load timing device 32088 001753'01 254 00 0 00 001751* retskp ; Unless never got one 32089 001754'01 306 01 0 00 000015 cain t1, .dvnul ; NUL:? 32090 001755'01 254 00 0 00 001753* retskp ; Yeah, no way to read from that, so forget parity 32091 32092 remark ; OK to trash these temporaries 32093 001756'01 265 16 0 00 003612' saveac ; But needs many piggy registers 32094 32095 001757'01 201 01 0 00 004000 movei t1, devchr ; Load number of characters 32096 001760'01 200 04 0 00 000001 move t4, t1 ; destination string is same length 32097 001761'01 201 02 0 00 000000# movei t2, devred ; Source is what the subfork read 32098 001762'01 201 05 0 00 000000# movei q1, devda2 ; destination is seperate; do not update in place 32099 001763'01 505 02 0 00 441000 hrli t2, (point 8,0) ; Turn source address into a section local point 32100 001764'01 500 05 0 00 000002 hll q1, t2 ; Ditto destination pointer, both being 8 bits 32101 001765'01 403 03 0 00 000006 setzb t3, q2 ; Force pointer to remain section local 32102 001766'01 200 07 0 00 000000* move q3, chkint ; Load parity checking instruction 32103 001767'01 400 10 0 00 000000 setz q4, ; Fill character is NUL (yet unused...) 32104 remark t1, N!M ; Shut off Negative and Mark (movei cleared them) 32105 001770'01 661 01 0 00 400000 txo t1, S ; Have to dink the foolish significance bit... 32106 001771'01 123 01 0 00 000007 extend t1, q3 ; Get down to some serious string translating 32107 001772'01 600 00 0 00 000000 nop ; Can't happen 32108 001773'01 627 01 0 00 200000 txzn t1, N ; Bump into any bad parity? 32109 001774'01 254 00 0 00 001755* retskp ; Nope, everything's fin 32110 32111 001775'01 120 07 0 00 000001 dmove q3, t1 ; Save failing character position 32112 001776'01 200 01 0 00 000000# emsg 32113 001777'01 104 00 0 00 000313 32114 000155'02 000000000000# 32115 001054'04 120 141 162 151 164 32116 002000'01 201 01 0 00 000101 movei t1, .priou ; Primary output 32117 dmove t2, [ devchr ; Load number of characters 32118 002001'01 120 02 0 00 003627' ^d10 ] ; Positions are in decimal 32119 002002'01 274 02 0 00 000007 sub t2, q3 ; Subtract remaining to get position 32120 002003'01 104 00 0 00 000224 NOUT% ; Type it 32121 002004'01 320 12 0 00 002006' %jserr(,) 32122 002005'01 254 00 0 00 002011' 32123 002006'01 265 01 0 00 001726* 32124 002007'01 000000000000# 32125 002010'01 254 00 0 00 002011' 32126 001063'04 103 157 165 154 144 32127 32128 002011'01 201 06 0 00 004000 movei q2, devchr ; Load original 32129 002012'01 274 06 0 00 000004 sub q2, t4 ; Calculate amount done 32130 002013'01 323 06 0 00 002032' ifg. q2 ; Did we do anything (or gubbish)? 32131 002014'01 200 01 0 00 000000# txmsg (<, translated: ">) 32132 002015'01 104 00 0 00 000076 32133 002016'01 320 12 0 00 002017' K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 32-1 K20TIM MAC 3-Apr-23 23:45 Check parity (if we're doing parity) 32134 000156'02 000000000000# 32135 001074'04 054 040 164 162 141 32136 dmove t1, [ .priou ; Still going to primary output 32137 002017'01 120 01 0 00 003631' point 8, devda2 ] ; From beginning of translation buffer 32138 002020'01 210 03 0 00 000006 movn t3, q2 ; Counted transfer 32139 002021'01 104 00 0 00 000053 SOUT% ; and type what we did 32140 002022'01 320 12 0 00 002024' %jserr(,) 32141 002023'01 254 00 0 00 002027' 32142 002024'01 265 01 0 00 002006* 32143 002025'01 000000000000# 32144 002026'01 254 00 0 00 002027' 32145 001100'04 103 157 165 154 144 32146 txmsg (<" 32147 002027'01 200 01 0 00 000000# >) ; Shutting off font-crock mode 32148 002030'01 104 00 0 00 000076 32149 002031'01 320 12 0 00 002032' 32150 000157'02 000000000000# 32151 001110'04 042 015 012 000 000 32152 002032'01 endif. 32153 002032'01 263 17 0 00 000000 ret ; Failure return 32154 32155 ;[223] End code insertion 32156 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 33 K20TIM MAC 3-Apr-23 23:45 Transfer timing routines 32157 subttl Transfer timing routines 32158 32159 ;[207] Begin code insertion 32160 32161 ; Historically, Kermit timed transfers using the time of day clock 32162 ; which has approximately 1/3 of second resolution. That's probably 32163 ; fine for dial up or even local terminals where the DH11 would limit 32164 ; you to 9600 baud. The most we could get in 1988 was 19.2Kbd on a 32165 ; local Microvax connecting to CU20B. 32166 ; 32167 ; The pseudo-terminal code can do a megabaud and TCP/IP uploads to 32168 ; ckermit are clearing 500 kilobaud. A short file can get sent in FAR 32169 ; less then a time of day tick. So we read some timers here that have 32170 ; greater resolution. 32171 ; 32172 ; Although it is not currently (2023) necessary to exceed DK10 32173 ; internal clock resolution (10 microseconds, see HPTIM%), a 32174 ; certain amount of anticipatory code has been written to do this, 32175 ; particularly in the area of extended uptimes. 32176 ; 32177 ; For example, Kermit can handle the display of terabaud speeds (see 32178 ; ranger in k20dsp). It should be noted that, with faster hosts, a 32179 ; transfer may get done in less time then the scheduling interval, so 32180 ; such times should be carefully reviewed. 32181 ; 32182 ; Another matter is such resolution with the extended uptimes 32183 ; apparently available with certain version of Tops-20. DEC and PANDA 32184 ; Tops-20 7.x can not handle a millisecond uptime which exceeds a 32185 ; signed 35 bit number. It will crash with an UP2LNG BUGHLT (see 32186 ; APRSRV) after 1 Year, 4 Weeks, 5 Days, 16 Hours, 22 Minutes, 18 32187 ; Seconds and 367 Milliseconds. 32188 32189 ; Given the user load on systems and the hardware technology of the 32190 ; early 1980's, this was about 5 times the maximum uptime (a little 32191 ; over two months) that was ever seen on CU20B. It is easily 32192 ; exceeded on systems with commodity hardware and one or two active 32193 ; users. 32194 ; 32195 ; The XKL (and possibly other) version(s) of Tops-20 return the uptime 32196 ; in a signed double word. The full 70 bit millisecond number will be 32197 ; reported as 37,539,161 Millennia, 7 Centuries, 2 Decades, 9 Years, 8 32198 ; Weeks, 2 Days, 11 Hours, 35 Minutes, 3 Seconds and 423 Milliseconds. 32199 ; 32200 ; Since the current estimate of the age of the universe is 13.7 32201 ; billion years, a thirty seven and a half billion year uptime is 32202 ; probably fine. 32203 ; 32204 ; This code handles running on an XKL monitor (which does not have 32205 ; DECnet support). 32206 ; 32207 ; In 2023, doing a get "NUL:" NUL: when connected to a pseudo- 32208 ; terminal gets an elapsed transfer time of 1.6 milliseconds, so we 32209 ; are already getting pretty close to the microsecond realm. 32210 32211 chgsec(code,data) ;;Declare writable storage K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 33-1 K20TIM MAC 3-Apr-23 23:45 Transfer timing routines 32212 32213 remark stdat,etdat,ewallt 32214 32215 xlist ; Save a few trees 32216 list ; Turn the listing back on 32217 32218 retsec 32219 32220 remark Set variables at the beginning of a transfer transfer 32221 32222 002033'01 statim: entry statim ; Allow global use 32223 002033'01 265 16 0 00 003633' saveac ; Don't side effect any accumulators 32224 32225 remark ; Set up initial states of timing blocks 32226 002034'01 415 04 0 00 000000# xmovei t4, etdat ; Resolve address of end time data block 32227 002035'01 260 17 0 00 002042' call zeroit ; Go zero it out 32228 32229 002036'01 415 04 0 00 000000# xmovei t4, ewallt ; Load address of elapsed wall time 32230 002037'01 260 17 0 00 002042' call zeroit ; Go whack that, too 32231 32232 002040'01 415 04 0 00 000000# xmovei t4, stdat ; Resolve address of timing data block 32233 002041'01 254 00 0 00 002052' callret timwrk ; Hit the time worker and return through it 32234 32235 002042'01 zeroit: remark t4,address ; Routine to stomp a time block 32236 002042'01 201 01 0 00 000020 movx t1, dtilen-1 ; Length of remaining structure to whack 32237 002043'01 200 02 0 00 000004 move t2, t4 ; First location to whack 32238 002044'01 201 03 0 02 000001 movei t3, 1(t2) ; Cascading whackage 32239 002045'01 402 00 0 02 000000 setzm (t2) ; Stomp the first word 32240 002046'01 123 01 0 00 003531' xblt. t1 ; Stomp the rest of them 32241 002047'01 263 17 0 00 000000 ret ; Done 32242 32243 remark Set variables at end of transfer 32244 32245 002050'01 endtim: entry endtim ; Allow global use 32246 002050'01 265 16 0 00 003633' saveac ; Don't side effect any accumulator 32247 002051'01 415 04 0 00 000000# xmovei t4, etdat ; Resolve address of timing data block 32248 remark timwrk ; fall through to the time worker 32249 ; (and return through it) 32250 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 34 K20TIM MAC 3-Apr-23 23:45 Time storage worker 32251 subttl Time storage worker 32252 32253 ; Call: Expects t4 to have the block address 32254 ; 32255 ; Be aware that all timing variables have gone from a single word to 32256 ; three words and resolution is stored in increasing resolution in 32257 ; order to not break any overlooked older code. 32258 ; 32259 ; The reads are done in the reverse order to keep HPTIM% as accurate 32260 ; as possible. "Accurate" may be debatable; the point of going to 32261 ; microsecond level reads was not accuracy so much as the timings had 32262 ; gone under a TOD tick (approximately 329.58858646932 milliseconds). 32263 ; 32264 ; It was subsequently discovered that some transfers are happening so 32265 ; quickly that they are approaching sub-millisecond levels (I.E., 32266 ; single digit milliseconds), bringing Kermit into the microsecond 32267 ; realm. 32268 ; 32269 ; Negative numbers will flag errors for uptime because these currently 32270 ; will not go negative. Since the time of day is actually unsigned 32271 ; (mostly), this isn't possible, so that is flagged as zero as Tops-20 32272 ; didn't exist in 1858. 32273 ; 32274 ; Note the compatible use of the strange XKL arguments to the TIME% 32275 ; JSYS, lifted from my rewrite of OS/2 UPTIME.MAC. Documentation of 32276 ; arcane TIME% changes from Ralph Gorin of XKL. The full text is 32277 ; STAR:TOPS-20-UPTIME.TXT. 32278 ; 32279 ; Date: Sat, 07 Mar 2009 14:35:18 -0800 32280 ; From: Ralph Gorin 32281 ; To: Thomas DeBellis 32282 ; CC: Tops-20 Wizards 32283 ; Subject: Re: Another Uptime Record 32284 ; In-Reply-To: <49B29F35.4010402@acedsl.com> 32285 ; Message-ID: <49B2F6A6.3040602@xkl.com> 32286 ; 32287 ; ... 32288 ; 32289 ; If AC 1 contains 'TODSEC' then return the uptime in seconds 32290 ; in AC 1, the residue in milliseconds in LH of AC 2 32291 ; and the divisor to convert to seconds (the number 1) 32292 ; in the RH of AC 2. 32293 ; 32294 ; If AC 1 contains 'MSTIME' then return the uptime in milliseconds 32295 ; as a double word in AC 1 and AC 2. 32296 ; 32297 ; For other values of AC 1, the old behavior is preserved. 32298 ; 32299 ; If the uptime has exceeded 2^35 milliseonds, the program gets the 32300 ; TIMEX3 error. This is an encouragement to fix old programs. 32301 ; 32302 ; Note, the code below is not 'perfect' because it will do the wrong 32303 ; thing on an XKL monitor that is up for 1000 milliseconds in the low 32304 ; order register, no matter is what in the high order. As this will 32305 ; 'only' happen for a single millisecond once every 56 Weeks, 5 Days, K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 34-1 K20TIM MAC 3-Apr-23 23:45 Time storage worker 32306 ; 16 Hours, 22 Minutes, 18 Seconds and 367 Milliseconds, it is 32307 ; expected to be 'relatively' uncommon. 32308 ; 32309 ; It also assumes that the millisecond uptime is stored as a 36 bit 32310 ; unsigned number. This isn't true in 'vanilla' Tops-20; it's a 35 32311 ; bit signed value and should never be negative. A bit of defensive 32312 ; coding for intermediate implementations. 32313 32314 002052'01 timwrk: remark t1,t2,t3 ; Previously saved and available 32315 002052'01 265 16 0 00 003645' saveac ; Will need t1-t4 for the double math 32316 002053'01 200 05 0 00 000004 move q1, t4 ; Save the address so have block of four accumulators 32317 32318 002054'01 403 01 0 00 000002 setzb t1, t2 ; A handy pair of zeros for .HPELP 32319 ; dmove t1, [ .HPELP ; Elapsed DK10 ticks since start 32320 ; 0 ] ; A handy zero 32321 002055'01 104 00 0 00 000501 HPTIM% ; Grab it 32322 002056'01 320 12 0 00 002060' ifje. r ; Failed?? 32323 002057'01 254 00 0 00 002063' 32324 002060'01 560 02 0 00 000001 hrro t2, t1 ; Turn negative to flag error 32325 002061'01 474 01 0 00 000000 seto t1, ; Ditto low order 32326 002062'01 254 00 0 00 002064' else. ; Otherwise worked, 32327 002063'01 250 02 0 00 000001 exch t2, t1 ; so put in low order 32328 002064'01 endif. ; and just use it 32329 002064'01 124 01 0 05 000017 dmovem t1, .datus(q1) ; Store amount or error (and possible flag) 32330 32331 002065'01 120 01 0 00 000000# dmove t1, mstime ; XKL's arcane 'magic' argument (if Toad) 32332 002066'01 104 00 0 00 000014 TIME% ; Get uptime in milliseconds (maybe long) 32333 002067'01 320 12 0 00 002071' ifje. r ; Failed?? 32334 002070'01 254 00 0 00 002074' 32335 002071'01 560 02 0 00 000001 hrro t2, t1 ; Turn negative to flag error 32336 002072'01 474 01 0 00 000000 seto t1, ; Ditto low order 32337 002073'01 254 00 0 00 002102' else. ; Otherwise, some kind of success 32338 002074'01 302 02 0 00 001750 caie t2, ^d1000 ; XKL monitor? 32339 002075'01 254 00 0 00 002102' ifskp. ; No, plain old 'vanilla' 32340 002076'01 200 02 0 00 000001 move t2, t1 ; Put low order in proper place 32341 002077'01 627 02 0 00 400000 tlzn t2,(1b0) ; Test if Negative, fix low order and skip 32342 002100'01 634 01 0 00 000001 tdza t1, t1 ; Positive, zero high order and skip 32343 002101'01 201 01 0 00 000001 movei t1, ^d1 ; Negative, put sign bit in the high order 32344 002102'01 endif. ; Otherwise XKL, so can stay up a lot longer!! 32345 002102'01 endif. ; End TIME% result handling 32346 002102'01 124 01 0 05 000015 dmovem t1, .datms(q1) ; Store error (and possible flag) 32347 32348 002103'01 325 01 0 00 002120' ifl. t1 ; TIME% gronked somehow? 32349 002104'01 104 00 0 00 000227 GTAD% ; Oh well, get time of day 32350 002105'01 320 12 0 00 002107' ifje. r ; Failed?? 32351 002106'01 254 00 0 00 002111' 32352 002107'01 552 01 0 05 000000 hrrzm t1, .dattd(q1) ;Store error and flag it (not 1858!!) 32353 002110'01 254 00 0 00 002117' else. ;Otherwise worked, 32354 002111'01 202 01 0 05 000000 movem t1, .dattd(q1) ; so just use it 32355 002112'01 200 02 0 00 000001 move t2, t1 ; Put low order in proper place 32356 002113'01 627 02 0 00 400000 tlzn t2,(1b0) ; Test if Negative, fix low order and skip 32357 002114'01 634 01 0 00 000001 tdza t1, t1 ; Positive, zero high order and skip 32358 002115'01 201 01 0 00 000001 movei t1, ^d1 ; Negative, put sign bit in the high order 32359 002116'01 124 01 0 05 000001 dmovem t1, .dattl(q1) ;Store signed double word result 32360 002117'01 endif. ; End JSYS result handling K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 34-2 K20TIM MAC 3-Apr-23 23:45 Time storage worker 32361 002117'01 263 17 0 00 000000 ret ; Either way, we're done 32362 002120'01 endif. 32363 32364 002120'01 260 17 0 00 002720' call miltod ; Convert millisecond uptime to TOD ticks 32365 002121'01 124 03 0 05 000013 dmovem t3, .datmr(q1) ; Store millisecond remainder 32366 002122'01 124 01 0 05 000001 dmovem t1, .dattl(q1) ; Time of Date (TOD) as signed double 32367 002123'01 322 01 0 00 002125' ifn. t1 ; Any high order? 32368 002124'01 661 02 0 00 400000 tlo t2,(1b0) ; Yes, coerce to low order 32369 002125'01 endif. 32370 002125'01 202 02 0 05 000000 movem t2, .dattd(q1) ; Time of Date (TOD) in unsigned ticks 32371 002126'01 263 17 0 00 000000 ret ; Done, finally 32372 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 35 K20TIM MAC 3-Apr-23 23:45 Compute Elapsed Wall Times 32373 subttl Compute Elapsed Wall Times 32374 32375 ; Populates a block with elapsed TOD ticks, milliseconds and HPTIM% 32376 ; ticks (10 ms resolution). 32377 ; 32378 ; Note that the HPTIM% elapsed wall time will wrap at a value of 3 32379 ; Days, 4 Hours, 21 Minutes, 17 Seconds, 906 Milliseconds and 940 32380 ; Microseconds (76:21:17.906.940). This is the basis for the comment 32381 ; of 76 hours in the monitor. Therefore, the greatest possible 32382 ; elapsed high precision time that can be measured is the above. 32383 ; 32384 ; The value for maxhpt is gotten by running the monitor code (MTIME:: 32385 ; in APRSRV.MAC with the maximum value that RDTIME could theoretically 32386 ; return, a double word of .infin (377777,,-1). No known processor 32387 ; would do this and other uptime counters would have wrapped far 32388 ; before we got anywhere near this value. 32389 ; 32390 ; Be aware that the value for maxhpt is in HPTIM% ticks or DK10 units 32391 ; when running on the 100 kHz internal clock. Should you wish to double 32392 ; check this value (say by putting it into UPTIME), then you need to 32393 ; multiply it by 10 decimal to scale it to microseconds. That value 32394 ; will be the double word value 7::377777,,777774. 32395 ; 32396 ; If that situation is detected, then we punt and simulate with an 32397 ; appropriately scaled millisecond value. However, the maximum amount 32398 ; of DK10 time that can be held in a single word is .infin, which 32399 ; works out to 95:26:37.383.670. If that situation is hit, then we 32400 ; stop faking DK10 ticks and just pretend we don't have any more of 32401 ; them. 32402 ; 32403 ; maxmil is the value of maxhpt scaled (from DK10 ticks) to milli- 32404 ; seconds, meaning the value is divided by 100 decimal. I didn't see 32405 ; how to compute these values symbolically as there are some 32406 ; intermediate results which are double words, so I just did 32407 ; everything in DDT and documented here. 32408 ; 32409 ; Note that the order of the calculations matters here because Tops-20 32410 ; rounds up TOD ticks, but we can't because, at a minimum, we are 32411 ; timing at millisecond resolution, which is two decimal orders of 32412 ; magnitude less than a TOD tick. The more common case of DK10 (or 32413 ; microsecond) resolution, is five orders of magnitude less. If we 32414 ; don't handle things ourselves, you can have the case where time 32415 ; appears to be going backwards in a high resolution log file. 32416 ; 32417 ; HPTIM% ticks are stored as signed doubles to allow for future code 32418 ; which can read finer times (see documentation for RDTIME instruction) 32419 32420 002127'01 000000 000000 maxhpt: 0 ; See MTIME in APRSRV 32421 002130'01 314631 463146 314631,,463146 ; N.B., DK10 units (10 us), not usecs! 32422 002131'01 000000 000000 maxmil: 0 ; Maximum HPTIM% in milliseconds 32423 002132'01 002030 446722 2030,,446722 ; maxmil is maxhpt divided by 100 decimal 32424 32425 002133'01 elptim: entry elptim ; Called from K20MIT, results used in K20DSP 32426 002133'01 265 16 0 00 003655' saveac ;Don't side-effect any registers!! 32427 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 15:19 11-Jun-23 Page 35-1 K20TIM MAC 3-Apr-23 23:45 Compute Elapsed Wall Times 32428 002135'01 415 13 0 00 000000# xmovei p3, etdat ; Load address of ending time and date block 32429 002136'01 415 12 0 00 000000# xmovei p2, stdat ; Load address of starting time and date block 32430 32431 002137'01 201 01 0 00 000020 movx t1, dtilen-1 ; Length of remaining structure to whack 32432 002140'01 200 02 0 00 000014 move t2, p4 ; First location to whack 32433 002141'01 201 03 0 02 000001 movei t3, 1(t2) ; Cascading whackage 32434 002142'01 476 00 0 02 000000 setom (t2) ; Set first word to ERROR value 32435 002143'01 123 01 0 00 003531' xblt. t1 ; Stomp the rest of them 32436 ; Do milliseconds in case we must fix up 32437 002144'01 415 16 0 00 002166' block. ; Enter block context for better control flow 32438 002145'01 261 17 0 00 000016 32439 002146'01 120 01 0 13 000015 dmove t1, .datms(p3) ; Load ending milliseconds double word 32440 002147'01 120 03 0 12 000015 dmove t3, .datms(p2) ; Load starting milliseconds double word 32441 002150'01 321 01 0 00 001444* jumpl t1, R ; Negative means some kind of failure on TIME% 32442 002151'01 321 03 0 00 002150* jumpl t3, R ; Ditto 32443 002152'01 316 03 0 00 000001 dcamg t3, t1 ; We didn't get anything backwards, did we? 32444 002153'01 254 00 0 00 002157' 32445 002154'01 317 03 0 00 000001 32446 002155'01 254 00 0 00 002160' 32447 002156'01 254 00 0 00 002161' 32448 002157'01 317 04 0 00 000002 32449 002160'01 254 00 0 00 002163' ifskp. ; Well, that's peculiar ... 32450 002161'01 250 01 0 00 000003 exch t1, t3 ; Swap high orders 32451 002162'01 250 02 0 00 000004 exch t2, t4 ; Swap low orders 32452 002163'01 endif. 32453 002163'01 115 01 0 00 000003 dsub t1, t3 ; Calculate elapsed milliseconds (should never wrap) 32454 002164'01 254 00 0 00 001774* retskp ; Success! 32455 002165'01 263 17 0 00 000000 endbk. ; End block context 32456 002166'01 254 00 0 00 002174' ifskp. ; Successful calculation block exit 32457 002167'01 124 01 0 14 000015 dmovem t1, .datms(p4) ; Store millisecond resolution 32458 002170'01 260 17 0 00 002720' call miltod ; Convert to elapsed TOD and remainder milliseconds 32459 002171'01 124 01 0 14 000011 dmovem t1, .datem(p4) ; Save elapsed TOD 32460 002172'01 124 03 0 14 000013 dmovem t3, .datmr(p4) ; Save remainder milliseconds 32461 002173'01 254 00 0 00 002175' else. ; Otherwise, some kind of odd input arguments 32462 002174'01 254 00 0 00 002761' jrst ovrflw ; Complain and punt 32463 002175'01 endif. ; Done elapsed milliseconds 32464 ; Do elapsed HPTIM% ticks 32465 002175'01 415 16 0 00 002236' block. ; Enter block context for better control flow 32466 002176'01 261 17 0 00 000016 32467 002177'01 120 01 0 14 000015 dmove t1, .datms(p4) ; Load millisecond resolution 32468 002200'01 316 01 0 00 002131' dcamg t1, maxmil ; Duration exceeds HPTIM% maximum? 32469 002201'01 254 00 0 00 002205' 32470 002202'01 317 01 0 00 002131' 32471 002203'01 254 00 0 00 002206' 32472 002204'01 254 00 0 00 002207' 32473 002205'01 317 02 0 00 002132' 32474 002206'01 254 00 0 00 002211' ifskp. ; Yes, then fake the HP ticks 32475 002207'01 260 17 0 00 002260' call ms2hp ; Convert milliseconds to equivalent DK10 units 32476 002210'01 254 00 0 00 002164* retskp ; Break out of the block 32477 002211'01 endif. ; End case handling HPTIM% overflow 32478 remark ; Otherwise, can still do DK10 resolution 32479 002211'01 120 01 0 13 000017 dmove t1, .datus(p3) ; Load ending HPTIM% ticks double word 32480 002212'01 120 03 0 12 000017 dmove t3, .datus(p2) ; Load beginning HPTIM% ticks double word 32481 002213'01 321 01 0 00 002151* jumpl t1, R ; Negative means some kind of failure on HPTIM% 32482 002214'01 321 03 0 00 002213* jumpl t3, R ; Ditto K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 35-2 K20TIM MAC 3-Apr-23 23:45 Compute Elapsed Wall Times 32483 002215'01 316 03 0 00 000001 dcaml t3, t1 ; Did the HPTIM% count wrap around? 32484 002216'01 254 00 0 00 002222' 32485 002217'01 311 03 0 00 000001 32486 002220'01 254 00 0 00 002223' 32487 002221'01 254 00 0 00 002224' 32488 002222'01 311 04 0 00 000002 32489 002223'01 254 00 0 00 002227' ifskp. ; No, so safe to subtract 32490 002224'01 115 01 0 00 000003 dsub t1, t3 ; Compute elapsed ticks 32491 002225'01 254 00 0 00 002210* retskp ; Get out of here, we're done 32492 002226'01 254 00 0 00 002235' else. ; Otherwise, calculate the wrap gap 32493 002227'01 261 17 0 00 000012 push p, p2 ; Preserve pointer to starting ticks 32494 002230'01 120 11 0 00 002127' dmove p1, maxhpt ; Load MTIME's odd wrap value 32495 002231'01 115 11 0 00 000003 dsub p1, t3 ; Calculate ticks to wrap point 32496 002232'01 114 01 0 00 000011 dadd t1, p1 ; Calculate total elapsed ticks 32497 002233'01 262 17 0 00 000012 pop p, p2 ; Restore pointer to starting ticks 32498 002234'01 254 00 0 00 002225* retskp ; As per non-wrapped case, result is in t2 32499 002235'01 endif. ; End calculating HP tick difference 32500 002235'01 263 17 0 00 000000 endbk. ; End block context 32501 002236'01 254 00 0 00 002244' ifskp. ; Successful calculation block exit 32502 002237'01 124 01 0 14 000017 dmovem t1, .datus(p4) ; Store elapsed HPTIM% ticks 32503 002240'01 260 17 0 00 002302' call etodhp ; Extract the elapsed TOD and HP ticks 32504 002241'01 124 01 0 14 000005 dmovem t1, .dateh(p4) ; Store elapsed TOD ticks, DK10 base 32505 002242'01 124 03 0 14 000007 dmovem t3, .datdk(p4) ; Store remaining DK10 ticks 32506 002243'01 254 00 0 00 002245' else. ; Otherwise, some kind of odd input arguments 32507 002244'01 254 00 0 00 002761' jrst ovrflw ; Complain and punt 32508 002245'01 endif. ; Done elapsed HPTIM% ticks 32509 32510 remark ; Calculate ending TOD 32511 002245'01 120 01 0 12 000015 dmove t1, .datms(p2) ; Load starting uptime 32512 002246'01 114 01 0 14 000015 dadd t1, .datms(p4) ; Add elapsed milliseconds 32513 002247'01 114 01 0 00 000000# dadd t1, bootrm ; Also original boot millisecond remainder 32514 002250'01 260 17 0 00 002720' call miltod ; Calculate proper elapsed TOD 32515 002251'01 124 03 0 14 000003 dmovem t3, .dattr(p4) ; Store remainder milliseconds 32516 002252'01 114 01 0 00 000000# dadd t1, bootdd ; Bring into range of current date and time 32517 002253'01 124 01 0 14 000001 dmovem t1, .dattl(p4) ; Store as unrounded ending time 32518 002254'01 322 01 0 00 002256' ifn. t1 ; Total is 36 bits, signed double? 32519 002255'01 661 02 0 00 400000 tlo t2, (1b0) ; Coerce to 36 bits unsigned single 32520 002256'01 endif. ; End of date far in the future 32521 002256'01 202 02 0 14 000000 movem t2, .dattd(p4) ; Store as unrounded ending time 32522 002257'01 263 17 0 00 000000 ret ; Done, restoring dirty registers 32523 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 36 K20TIM MAC 3-Apr-23 23:45 Convert Milliseconds to equivalent DK10 internal clock units 32524 subttl Convert Milliseconds to equivalent DK10 internal clock units 32525 32526 ; Used when HPTIM% result exceeds 95:26:37.383.670 (TOD: 1042499) 32527 ; 32528 ; Call: 32529 ; 32530 ;T1,T2/ millisecond signed double word 32531 ; 32532 ; Return: 32533 ; 32534 ;T1,T2/ Equivalent HP ticks (call value times 100 decimal) 32535 ; 32536 ; N.B., Currently does not do anything useful on overflow, +1 always 32537 32538 002260'01 326 01 0 00 002263' ms2hp: ife. t1 ; Maybe bum the math 32539 002261'01 326 02 0 00 002263' ife. t2 ; Got called with a zero double word? 32540 002262'01 263 17 0 00 000000 ret ; Get out of here, we're done 32541 002263'01 endif. 32542 002263'01 endif. 32543 32544 002263'01 265 16 0 00 003550' saveac ; Maybe somebody might be using these 32545 002264'01 255 17 0 00 002265' jfcl 17,.+1 ; Clear all flags 32546 002265'01 116 01 0 00 003673' dmul t1, [exp 0, ^d100] ; Scale milliseconds up to DK10 units 32547 002266'01 415 16 0 00 002275' block. ; Enter block context for easier control flow 32548 002267'01 261 17 0 00 000016 32549 002270'01 255 17 0 00 002214* jfcl 17, R ; Punt if any kind of oddity 32550 002271'01 326 01 0 00 002270* jumpn t1, R ; Upper high order of 140 bit result? 32551 002272'01 326 02 0 00 002271* jumpn t2, R ; Lower high order of 140 bit result? 32552 002273'01 254 00 0 00 002234* retskp ; No to both, return 70 bit result 32553 002274'01 263 17 0 00 000000 endbk. ; End block contxt 32554 002275'01 254 00 0 00 002300' ifskp. ; In range uptime? 32555 002276'01 120 01 0 00 000003 dmove t1, t3 ; Yes, return that 32556 002277'01 254 00 0 00 002301' else. ; Wow... Big uptime 32557 002300'01 254 00 0 00 002761' callret ovrflw ; Go clip down to 'reasonable' maximum 32558 002301'01 endif. ; End case HPTIM% overflow handling 32559 002301'01 263 17 0 00 000000 ret ; Done HPTIM% fixup 32560 32561 ;[207] End code insertion 32562 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 37 K20TIM MAC 3-Apr-23 23:45 Extract TOD ticks from HPTIM% ticks 32563 subttl Extract TOD ticks from HPTIM% ticks 32564 32565 ;[221] Begin code insertion 32566 32567 ; Call: 32568 ; 32569 ; t1/ Elapsed HPTIM% ticks high order 32570 ; t2/ Elapsed HPTIM% ticks low order 32571 ; Return: 32572 ; 32573 ; t1/ Elapsed TOD ticks, high order 32574 ; t2/ Elapsed TOD ticks, low order 32575 ; t3/ Remaining HPTIM% ticks after TOD's are extracted, high order 32576 ; t4/ Remaining HPTIM% ticks after TOD's are extracted, low order 32577 ; 32578 ; Proportion to extract TOD X given DK10 Y is Y:DK10=X:TOD, where TOD 32579 ; is equal to 262,144 and DK10 is equal to 8,640,000,000 (that's eight 32580 ; million, six hundred and fourty thousand). Solving for X gives: 32581 ; 32582 ; X*DK10 = Y*TOD or X = (Y*TOD)/DK10 32583 ; 32584 ; To convert input X TOD ticks to the equivalent Y DK10 ticks, the 32585 ; proportion remains the same, but we solve for Y, instead, viz: 32586 ; 32587 ; X*DK10 = Y*TOD or Y = (X*DK10)/TOD 32588 ; 32589 ; Recall that these fractions are not exact and that there are 32590 ; 32958.98438 DK10 ticks per TOD tick. This can be found by the 32591 ; following code: 32592 ; 32593 ; movx t1, <86400.> ; Numerator is seconds in a day 32594 ; movx t2, <262144.> ; Denominator is TOD tics in a day 32595 ; movx t3, <100000.> ; DK10 ticks in a second 32596 ; fdv t1, t2 ; Gets .3295898438 seconds per TOD tick 32597 ; fmp t1, t3 ; Gets 32958.98438 DK10 ticks per TOD tick 32598 ; 32599 ; Again, this kind of precision is necessary for short messages when 32600 ; doing megabaud communications, a TOD tick being wholly insufficient. 32601 ; It is unknown whether it would be sufficient for the case of short 32602 ; messages when doing gigabaud communications. Time marches on... 32603 ; 32604 ; Assumes signed 72 bit number is ALWAYS positive!! 32605 32606 002302'01 326 01 0 00 002306' etodhp: ife. t1 ; Maybe bum the math 32607 002303'01 326 02 0 00 002306' ife. t2 ; Got called with a zero double word? 32608 002304'01 403 03 0 00 000004 setzb t3, t4 ; Yes, so zero the remainder 32609 002305'01 263 17 0 00 000000 ret ; Get out of here, we're done 32610 002306'01 endif. 32611 002306'01 endif. 32612 32613 002306'01 265 16 0 00 003612' saveac ; Will need some temporary storage 32614 002307'01 120 07 0 00 000001 dmove q3, t1 ; Save the original dividend 32615 32616 002310'01 255 17 0 00 002311' jfcl 17, .+1 ; Clear the flags 32617 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 15:19 11-Jun-23 Page 37-1 K20TIM MAC 3-Apr-23 23:45 Extract TOD ticks from HPTIM% ticks 32618 002312'01 255 17 0 00 002761' jfcl 17, ovrflw ; Over 140 bits??? 32619 002313'01 326 01 0 00 002761' jumpn t1, ovrflw ; Over 105 bits?? 32620 002314'01 326 02 0 00 002761' jumpn t2, ovrflw ; Over 70 bits? 32621 002315'01 117 01 0 00 000000# ddiv t1, dkdayd ; Strip off remaining DK10 ticks 32622 002316'01 255 17 0 00 002761' jfcl 17, ovrflw ; Catch any odd math strangeness 32623 32624 remark ; Remember, returning remainder; NOT ROUNDING 32625 002317'01 120 03 0 00 000001 dmove t3, t1 ; Load quotient 32626 002320'01 116 03 0 00 000000# dmul t3, dkdayd ; Scale TOD ticks by DK10 ticks 32627 002321'01 255 17 0 00 002761' jfcl 17, ovrflw ; Over 140 bits??? 32628 002322'01 326 03 0 00 002761' jumpn t3, ovrflw ; Over 105 bits?? 32629 002323'01 326 04 0 00 002761' jumpn t4, ovrflw ; Over 70 bits? 32630 002324'01 117 03 0 00 000000# ddiv t3, tticdw ; Strip off remaining TOD ticks 32631 002325'01 255 17 0 00 002761' jfcl 17, ovrflw ; Catch any odd math strangeness 32632 32633 remark q1:q2 ; Should we round? For now, don't 32634 002326'01 316 03 0 00 000007 dcamg t3, q3 ; We didn't get anything backwards, did we? 32635 002327'01 254 00 0 00 002333' 32636 002330'01 317 03 0 00 000007 32637 002331'01 254 00 0 00 002334' 32638 002332'01 254 00 0 00 002335' 32639 002333'01 317 04 0 00 000010 32640 002334'01 254 00 0 00 002337' ifskp. ; That's odd; fix it 32641 002335'01 250 07 0 00 000003 exch q3, t3 ; Swap high order 32642 002336'01 250 10 0 00 000004 exch q4, t4 ; Swap low order 32643 002337'01 endif. 32644 002337'01 115 07 0 00 000003 dsub q3, t3 ; Calculate remaining DK10 ticks 32645 ; remark ; This DSUB should not set flags, but does 32646 ; jfcl 17, ovrflw ; Catch any odd math strangeness 32647 32648 ; dcamle q3,[exp 0,^d32958] ;Remainder should never exceed this 32649 ; jrst ovrflw ; But did 32650 002340'01 120 03 0 00 000007 dmove t3, q3 ; Return remaining DK10 ticks 32651 32652 002341'01 263 17 0 00 000000 ret ; Done 32653 32654 ;[221] End code insertion 32655 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 38 K20TIM MAC 3-Apr-23 23:45 Expresses a duration in DK10 units (tens of microseconds) 32656 subttl Expresses a duration in DK10 units (tens of microseconds) 32657 32658 ;[207] Begin code insertion 32659 32660 ; t1/ Output pointer or JFN 32661 ; t2/ Pointer to time structure 32662 32663 002342'01 durtim: entry durtim ; Also called by k20dsp 32664 002342'01 265 16 0 00 003413' saveac ; Used to save a pointer 32665 32666 002343'01 200 05 0 00 000002 move q1, t2 ; Save pointer to structure 32667 002344'01 201 02 0 05 000017 movei t2, .datus(q1) ; Resolve pointer to elapsed DK10 ticks 32668 002345'01 400 03 0 00 000000 setz t3, ;[221] Do not suppress leading seconds 32669 002346'01 260 17 0 00 002370' call ehptim ; Display elapsed HP ticks 32670 002347'01 600 00 0 00 000000 nop ;[221] Ignore +1, it isn't fatal 32671 32672 002350'01 120 03 0 05 000005 dmove t3, .dateh(q1) ;[221] Load elapsed TOD ticks 32673 002351'01 326 03 0 00 002354' ife. t3 ;[221] No high order 32674 002352'01 326 04 0 00 002354' ife. t4 ;[221] and no low order? 32675 002353'01 263 17 0 00 000000 ret ;[221] None; suppress the whole thing 32676 002354'01 endif. ;[221] 32677 002354'01 endif. ;[221] 32678 32679 002354'01 322 03 0 00 002356' ifn. t3 ; Any high order? 32680 002355'01 661 04 0 00 400000 tlo t4,(1b0) ; Yes, coerce to low order 32681 002356'01 endif. 32682 002356'01 322 04 0 00 002367' ifn. t4 ; Got any TOD ticks? 32683 002357'01 120 02 0 00 000000# smsg < (TOD: > 32684 002360'01 260 17 0 00 000000* 32685 000160'02 000000000000# 32686 000161'02 777777 777771 32687 001111'04 040 050 124 117 104 32688 002361'01 200 02 0 00 000004 move t2, t4 ; Load elapsed TOD ticks 32689 002362'01 200 03 0 00 003675' movx t3, ;N.B., Unsigned!! 32690 002363'01 104 00 0 00 000224 NOUT% 32691 002364'01 320 14 0 00 002272* erjmps r 32692 002365'01 120 02 0 00 000000# smsg <)> ; Close off and return 32693 002366'01 260 17 0 00 002360* 32694 000162'02 000000000000# 32695 000163'02 777777 777777 32696 001113'04 051 000 000 000 000 32697 002367'01 endif. 32698 32699 002367'01 263 17 0 00 000000 ret ; Done, restore registers, destroy frame 32700 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 39 K20TIM MAC 3-Apr-23 23:45 Display elapsed HP ticks 32701 subttl Display elapsed HP ticks 32702 32703 ; Call: 32704 ; 32705 ; t1/ Output pointer (or .PRIOU) 32706 ; t2/ Pointer to double word of duration in HPTIM% ticks 32707 ; [DK10 Internal 100 Khz resolution, tens of microseconds] 32708 ; t3/ Leading second suppression flag 32709 ; 32710 ; +1/ Something untoward happened ... 32711 ; +2/ Everything's Archie 32712 ; t1/ Updated, if string pointer 32713 32714 002370'01 ehptim: entry ehptim ; Also called by k20par 32715 remark t1 ; It is deadly to touch t1!! 32716 remark ; Assumes these may be smashed 32717 002370'01 265 16 0 00 000000* trvar <,hrs,mins,secs,mils,dk10,lsflag> ;[221] 32718 002371'01 000000 000010 32719 32720 002372'01 202 03 0 15 000010 movem t3, lsflag ;[221] Save leading second flag 32721 002373'01 120 03 0 02 000000 dmove t3, (t2) ;[221] Load the duration (don't overwrite t2, yet) 32722 002374'01 124 03 0 15 000001 dmovem t3, dur ;[221] Save for internal debugging 32723 002375'01 403 03 0 00 000004 setzb t3, t4 ; Cons up some zeros 32724 002376'01 124 03 0 15 000003 dmovem t3, hrs ; Stomp hours and minutes 32725 002377'01 124 03 0 15 000005 dmovem t3, secs ; Stomp seconds and milliseconds 32726 002400'01 402 00 0 15 000007 setzm dk10 ; Stomp tens of microseconds 32727 002401'01 120 02 0 15 000001 dmove t2,dur ;[221] Load the duration double word 32728 ; Let's get down to some arithmatic 32729 002402'01 415 16 0 00 002430' ehpti1: block. ; Enter block context for easier control flow 32730 002403'01 261 17 0 00 000016 32731 002404'01 255 17 0 00 002405' jfcl 17,.+1 ; Clear any flags, just in case 32732 002405'01 235 02 0 00 000144 divi t2, ^d100 ; Strip out DK10 ticks 32733 002406'01 255 10 0 00 002364* jov r ; Stop on overflow 32734 002407'01 250 03 0 15 000007 exch t3, dk10 ; Store DK10 ticks and rezero remainder 32735 002410'01 322 02 0 00 002406* jumpe t2, r ; If no more quotient, then done 32736 002411'01 250 02 0 00 000003 exch t2, t3 ; Zero in high order, quotient in low order 32737 002412'01 235 02 0 00 001750 divi t2, ^d1000 ; Strip out milliseconds 32738 002413'01 255 10 0 00 002410* jov r ; Stop on overflow 32739 002414'01 250 03 0 15 000006 exch t3, mils ; Store milliseconds and rezero quotient 32740 002415'01 322 02 0 00 002413* jumpe t2, r ; If no more quotient, then done 32741 002416'01 250 02 0 00 000003 exch t2, t3 ; Zero in high order, quotient in low order 32742 002417'01 235 02 0 00 000074 divi t2, ^d60 ; Strip out seconds 32743 002420'01 255 10 0 00 002415* jov r ; Stop on overflow 32744 002421'01 250 03 0 15 000005 exch t3, secs ; Store seconds and rezero quotient 32745 002422'01 322 02 0 00 002420* jumpe t2, r ; If no more quotient, then done 32746 002423'01 250 02 0 00 000003 exch t2, t3 ; Zero in high order, quotient in low order 32747 002424'01 235 02 0 00 000074 divi t2, ^d60 ; Strip out minutes 32748 002425'01 202 03 0 15 000004 movem t3, mins ; Store minutes 32749 002426'01 202 02 0 15 000003 movem t2, hrs ; Store hours 32750 002427'01 263 17 0 00 000000 endbk. ; Exit block context 32751 32752 002430'01 337 02 0 15 000003 ehpti2: skipg t2, hrs ; Have any hours? 32753 002431'01 254 00 0 00 002441' ifskp. ; Yes, print as many as there are 32754 002432'01 201 03 0 00 000012 movx t3, fld(^d10,no%rdx) 32755 002433'01 104 00 0 00 000224 NOUT% K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 39-1 K20TIM MAC 3-Apr-23 23:45 Display elapsed HP ticks 32756 002434'01 320 14 0 00 002422* erjmps r 32757 002435'01 201 02 0 00 000072 movei t2, ":" ; Puctuate hours 32758 002436'01 260 17 0 00 000000* call BOUTI% ;[216] 32759 002437'01 474 04 0 00 000000 seto t4, ; Mark hours were printed 32760 002440'01 254 00 0 00 002442' else. ; Otherwise, no hours 32761 002441'01 400 04 0 00 000000 setz t4, ; Mark no hours printed 32762 002442'01 endif. 32763 32764 002442'01 322 04 0 00 002446' ehpti3: ifn. t4 ; Previous? 32765 002443'01 200 02 0 15 000004 move t2, mins ; Yes, MUST print minutes 32766 002444'01 200 03 0 00 003676' movx t3, no%lfl!no%zro!no%ast!fld(^d2,no%col)!fld(^d10,no%rdx) ; In 2 columns 32767 002445'01 254 00 0 00 002451' else. ; Otherwise, nothing previous 32768 002446'01 201 03 0 00 000012 movx t3, fld(^d10,no%rdx) ; So no leading digits 32769 002447'01 332 02 0 15 000004 skipe t2, mins ; Have any minutes? 32770 002450'01 474 04 0 00 000000 seto t4, ; Yes, force a print 32771 002451'01 endif. 32772 32773 002451'01 322 04 0 00 002464' ifn. t4 ; Have to print minutes 32774 002452'01 322 02 0 00 002456' ifn. t2 ; Do we have a number? 32775 002453'01 104 00 0 00 000224 NOUT% ; We do, so print it 32776 002454'01 320 14 0 00 002434* erjmps r ; Catch and suppress error 32777 002455'01 254 00 0 00 002462' else. ; It's zero, so let's bum the NOUT% 32778 002456'01 201 02 0 00 000060 movei t2, "0" ; Load the zero 32779 002457'01 260 17 0 00 002436* call BOUTI% ; Type it 32780 002460'01 603 03 0 00 100000 txne t3,no%lfl ; Not fixed columns? 32781 002461'01 260 17 0 00 002457* call BOUTI% ; No, so type it twice to make "00" 32782 002462'01 endif. ; End case NOUT% execution determination 32783 002462'01 201 02 0 00 000072 movei t2, ":" ; Punctuate minutes 32784 002463'01 260 17 0 00 002461* call BOUTI% ;[216] 32785 002464'01 endif. 32786 32787 002464'01 322 04 0 00 002467' ehpti4: ifn. t4 ; Columnar if did minutes 32788 002465'01 200 03 0 00 003676' movx t3, no%lfl!no%zro!no%ast!fld(^d2,no%col)!fld(^d10,no%rdx) 32789 002466'01 254 00 0 00 002470' else. ; No, so somewhat more free form 32790 002467'01 201 03 0 00 000012 movx t3, fld(^d10,no%rdx) 32791 002470'01 endif. 32792 32793 002470'01 415 16 0 00 002501' block. ;[221] Enter control block for better flow 32794 002471'01 261 17 0 00 000016 32795 002472'01 326 04 0 00 002273* jumpn t4, RSKP ;[221] If printed minutes, MUST print seconds 32796 002473'01 332 00 0 15 000005 skipe secs ;[221] No seconds? 32797 002474'01 254 00 0 00 002472* retskp ;[221] No, if non-zero, must print them 32798 002475'01 336 00 0 15 000010 skipn lsflag ;[221] Got told to suppress the seconds 32799 002476'01 254 00 0 00 002474* retskp ;[221] No, so print them 32800 002477'01 263 17 0 00 000000 ret ;[221] Otherwise, don't 32801 002500'01 263 17 0 00 000000 endbk. ;[221] End control block context 32802 002501'01 254 00 0 00 002513' ifskp. ;[221] +1 means we must print seconds 32803 002502'01 336 02 0 15 000005 skipn t2, secs ; Load and always print seconds 32804 002503'01 254 00 0 00 002507' ifskp. ; Non-zero, so print it 32805 002504'01 104 00 0 00 000224 NOUT% 32806 002505'01 320 14 0 00 002454* erjmps r 32807 002506'01 254 00 0 00 002513' else. ; Otherwise, was zero 32808 002507'01 201 02 0 00 000060 movei t2, "0" ; So bum the NOUT% 32809 002510'01 260 17 0 00 002463* call BOUTI% ;[216] 32810 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 15:19 11-Jun-23 Page 39-2 K20TIM MAC 3-Apr-23 23:45 Display elapsed HP ticks 32811 002512'01 260 17 0 00 002510* call BOUTI% ;[216] Have to print another zero if minutes 32812 002513'01 endif. 32813 002513'01 endif. ;[221] End case forced print of seconds 32814 32815 ; N.B., Didn't know how or if to punctuate (tens of) microseconds, so 32816 ; broke them out seperately. It still looked funny, so I simply 32817 ; alide them until I find out what the right thing to do is. 32818 32819 002513'01 200 04 0 15 000006 ehpti5: move t4, mils ; Load milliseconds 32820 002514'01 434 04 0 15 000007 or t4, dk10 ; Or in any dk10 total 32821 002515'01 322 04 0 00 002540' ifn. t4 ; If either is set, then display 32822 002516'01 201 02 0 00 000056 movei t2, "." ; Punctuate milliseconds 32823 002517'01 260 17 0 00 002512* call BOUTI% ;[216] 32824 002520'01 336 02 0 15 000006 skipn t2, mils ; Mils can go up to 999 32825 002521'01 254 00 0 00 002526' ifskp. ; Have a real value, so print it 32826 002522'01 200 03 0 00 003677' movx t3, no%lfl!no%zro!no%ast!fld(^d3,no%col)!fld(^d10,no%rdx) 32827 002523'01 104 00 0 00 000224 NOUT% 32828 002524'01 320 14 0 00 002505* erjmps r 32829 ;;;; movei t2, "." ; Punctuate tens of microseconds 32830 ;;;; call BOUTI% ;[216] 32831 002525'01 254 00 0 00 002530' else. ; Otherwise, was zero 32832 ;;;; smsg <000.> ; So bum the NOUT% and the BOUT% 32833 002526'01 120 02 0 00 000000# smsg <000> ; So bum the NOUT% and the BOUT% 32834 002527'01 260 17 0 00 002366* 32835 000164'02 000000000000# 32836 000165'02 777777 777775 32837 001114'04 060 060 060 000 000 32838 002530'01 endif. 32839 002530'01 336 02 0 15 000007 skipn t2, dk10 ; DK10 can go up to 99 32840 002531'01 254 00 0 00 002536' ifskp. ; Have a real value, so print it 32841 002532'01 200 03 0 00 003676' movx t3, no%lfl!no%zro!no%ast!fld(^d2,no%col)!fld(^d10,no%rdx) 32842 002533'01 104 00 0 00 000224 NOUT% 32843 002534'01 320 14 0 00 002524* erjmps r 32844 ;;;; remark ; Don't fool ourselves into thinking we have true mHz 32845 ;;;; movei t2, "0" ; Show it as hundreds of microseconds 32846 ;;;; call BOUTI% ;[216] 32847 002535'01 254 00 0 00 002540' else. ; Otherwise, was zero 32848 ;;;; smsg <000> ; So bum the NOUT% and the BOUT% 32849 002536'01 120 02 0 00 000000# smsg <00> ; So bum the NOUT% and the BOUT% 32850 002537'01 260 17 0 00 002527* 32851 000166'02 000000000000# 32852 000167'02 777777 777776 32853 001115'04 060 060 000 000 000 32854 002540'01 endif. 32855 002540'01 endif. 32856 002540'01 263 17 0 00 000000 ret ; Don't forget to return!!! 32857 32858 endtv. ; End lexical context transient variables 32859 32860 ;[207] End code insertion 32861 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 40 K20TIM MAC 3-Apr-23 23:45 Initialize time variables 32862 subttl Initialize time variables 32863 32864 ; Tops-20 takes the time of day and rounds it to the nearest TOD tick, 32865 ; which is .3295898438, which can easily cause messages to appear to 32866 ; have happened at the same time at high kilobaud and above speeds. 32867 ; 32868 ; Therefore, we never use GTAD% for timing because we can't tell where 32869 ; Tops-20 might have rounded. We use GTAD% precisely once to get the 32870 ; current date and time in internal format. We then use TIME% to get 32871 ; the elapsed milliseconds since system boot and subtract that from 32872 ; from the previous. 32873 ; 32874 ; Note that the math to do this is NOT rounded. The reason for this 32875 ; is to make sure that time doesn't go backwards for higher precision 32876 ; logging. 32877 ; 32878 ; N.B., HPTIM% can not be used because the current interface rounds it 32879 ; every 76 hours. 32880 32881 chgsec(code,const) ; Monitor symbol names are constants 32882 000170'02 55 63 64 51 55 45 mstime: sixbit "MSTIME" ; XKL's arcane 'magic' argument 32883 000171'02 000000 000000 0 ; Used to side-effect T2 32884 retsec ; Return back to original .PSECT 32885 32886 chgsec(code,data) ; Values go in writable storage 32887 000211'05 prgsdt: block 1 ; Program start date and time (unsigned!) 32888 000212'05 prgsdd: block 2 ; Same thing as a signed double word 32889 000214'05 sysums: block 2 ; System uptime in milliseconds on startup 32890 000216'05 bootdt: block 1 ; System boot as unsigned GTAD% word 32891 000217'05 bootdd: block 2 ; Same thing as a signed double word 32892 000221'05 bootrm: block 2 ; Remainder milliseconds in calculation 32893 retsec ; Return back to original .PSECT 32894 32895 002541'01 initim: entry initim ; Called once by START in K20MIT 32896 002541'01 265 16 0 00 003536' saveac ; Used as index and capability word 32897 32898 002542'01 104 00 0 00 000227 GTAD% ; Get current date and time 32899 002543'01 320 12 0 00 002545' ifje. r ; Failed?? 32900 002544'01 254 00 0 00 002560' 32901 002545'01 552 01 0 00 000000# hrrzm t1, prgsdt ; Store error and flag it (not 1858!!) 32902 002546'01 550 01 0 00 000000# hrrz t1, bootdt ; Save single word format (not 1858!!) 32903 002547'01 334 00 0 00 000000 %ermsg (,) 32904 002550'01 254 00 0 00 002554' 32905 002551'01 265 01 0 00 002024* 32906 002552'01 000000000000# 32907 002553'01 254 00 0 00 002554' 32908 001116'04 105 162 162 157 162 32909 002554'01 477 05 0 00 000006 setob q1, q2 ; Flag date and time not set 32910 002555'01 124 05 0 00 000000# dmovem q1, bootdd ; Store boot date and time double word 32911 002556'01 263 17 0 00 000000 ret ; Can't go any further 32912 002557'01 254 00 0 00 002567' else. ; Otherwise worked, 32913 002560'01 202 01 0 00 000000# movem t1, prgsdt ; so just use it 32914 002561'01 200 02 0 00 000001 move t2, t1 ; Cast to signed long 32915 002562'01 627 02 0 00 400000 tlzn t2,(1b0) ; Test if Negative, fix low order and skip 32916 002563'01 634 01 0 00 000001 tdza t1, t1 ; Positive, zero high order and skip K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 40-1 K20TIM MAC 3-Apr-23 23:45 Initialize time variables 32917 002564'01 201 01 0 00 000001 movei t1, ^d1 ; Negative, put sign bit in the high order 32918 002565'01 124 01 0 00 000000# dmovem t1, prgsdd ; Store for later inspection 32919 002566'01 120 05 0 00 000001 dmove q1, t1 ; Cache as we are soon to use it 32920 002567'01 endif. 32921 32922 002567'01 120 01 0 00 000000# dmove t1, mstime ; XKL's arcane 'magic' argument (if Toad) 32923 002570'01 104 00 0 00 000014 TIME% ; Get uptime in milliseconds (maybe long) 32924 002571'01 320 12 0 00 002573' ifje. r ; Failed?? 32925 002572'01 254 00 0 00 002603' 32926 002573'01 560 02 0 00 000001 hrro t2, t1 ; Turn negative to flag error 32927 002574'01 474 01 0 00 000000 seto t1, ; Ditto high order 32928 002575'01 334 00 0 00 000000 %ermsg (,) 32929 002576'01 254 00 0 00 002602' 32930 002577'01 265 01 0 00 002551* 32931 002600'01 000000000000# 32932 002601'01 254 00 0 00 002602' 32933 001125'04 105 162 162 157 162 32934 002602'01 254 00 0 00 002611' else. ; Otherwise, some kind of success 32935 002603'01 302 02 0 00 001750 caie t2, ^d1000 ; XKL monitor? 32936 002604'01 254 00 0 00 002611' ifskp. ; No, plain old 'vanilla' 32937 002605'01 200 02 0 00 000001 move t2, t1 ; Put low order in proper place 32938 002606'01 627 02 0 00 400000 tlzn t2,(1b0) ; Test if Negative, fix low order and skip 32939 002607'01 634 01 0 00 000001 tdza t1, t1 ; Positive, zero high order and skip 32940 002610'01 201 01 0 00 000001 movei t1, ^d1 ; Negative, put sign bit in the high order 32941 002611'01 endif. ; And case casting vanilla Tops-20 to double word 32942 002611'01 endif. ; End TIME% result handling 32943 002611'01 124 01 0 00 000000# dmovem t1, sysums ; Either way, store double word millisecond uptime 32944 32945 002612'01 415 16 0 00 002625' block. ; Enter block for better control flow 32946 002613'01 261 17 0 00 000016 32947 002614'01 321 01 0 00 002534* jumpl t1, R ; Only do this if 32948 002615'01 321 02 0 00 002614* jumpl t2, R ; current time is reasonable 32949 002616'01 321 05 0 00 002615* jumpl q1, R ; Only do this if 32950 002617'01 321 06 0 00 002616* jumpl q2, R ; uptime is reasonable 32951 002620'01 260 17 0 00 002640' call initod ; Convert uptime to elapsed TOD uptime 32952 002621'01 115 05 0 00 000001 dsub q1, t1 ; Subtract from current time of day 32953 002622'01 321 05 0 00 002617* jumpl q1, R ; Wrapped?? 32954 002623'01 254 00 0 00 002476* retskp ; Succeed with boot TOD in a signed double word 32955 002624'01 263 17 0 00 000000 endbk. ; Block exit 32956 002625'01 254 00 0 00 002632' ifskp. ; Worked 32957 002626'01 200 01 0 00 000006 move t1, q2 ; Load low order of result 32958 002627'01 322 05 0 00 002631' ifn. q1 ; Any high order? 32959 002630'01 661 01 0 00 400000 tlo t1,(1b0) ; Yes, coerce to low order 32960 002631'01 endif. 32961 002631'01 254 00 0 00 002634' else. ; Something didn't work 32962 002632'01 474 01 0 00 000000 seto t1, ; And no valid time of day 32963 002633'01 477 05 0 00 000006 setob q1, q2 ; Ditto double word 32964 002634'01 endif. 32965 32966 002634'01 124 05 0 00 000000# dmovem q1, bootdd ; Store boot date and time double word 32967 002635'01 202 01 0 00 000000# movem t1, bootdt ; Save single word format 32968 002636'01 124 03 0 00 000000# dmovem t3, bootrm ; And remainder milliseconds 32969 32970 002637'01 263 17 0 00 000000 ret ; Finally done 32971 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 41 K20TIM MAC 3-Apr-23 23:45 Initialize Time of Day offset from current uptime 32972 subttl Initialize Time of Day offset from current uptime 32973 32974 ; Like miltod, but doesn't peel off a subsecond first, but rather 32975 ; Returns a remainder if not rounding 32976 ; 32977 ; Calling arguments are the same as are the return values 32978 32979 002640'01 initod: remark ; Almost impossible for this to happen, but... 32980 002640'01 321 01 0 00 002761' jumpl t1, ovrflw ; Sanity check calling arguments 32981 002641'01 321 02 0 00 002761' jumpl t2, ovrflw 32982 002642'01 326 01 0 00 002646' ife. t1 ; Maybe bum the math 32983 002643'01 326 02 0 00 002646' ife. t2 ; Got called with a zero double word? 32984 002644'01 403 03 0 00 000004 setzb t3, t4 ; Yes, so there can't be any remainder 32985 002645'01 263 17 0 00 000000 ret ; Yes, we're done 32986 002646'01 endif. 32987 002646'01 endif. 32988 32989 002646'01 265 16 0 00 003612' saveac ; Intermediate double word results 32990 002647'01 120 07 0 00 000001 dmove q3, t1 ; Save calling milliseconds to extract remainder 32991 002650'01 255 17 0 00 002651' jfcl 17,.+1 ; Clear flags 32992 32993 remark ; Calculate T = (M*262144)/86400000 32994 002651'01 116 01 0 00 000000# dmul t1, tticdw ; Scale milliseconds up by time of day ticks 32995 002652'01 255 17 0 00 002761' jfcl 17, ovrflw ; Over 140 bits??? 32996 002653'01 326 01 0 00 002761' jumpn t1, ovrflw ; Over 105 bits?? 32997 002654'01 326 02 0 00 002761' jumpn t2, ovrflw ; Over 70 bits? 32998 002655'01 117 01 0 00 000000# ddiv t1, msidad ; Then strip off partial TOD 32999 002656'01 255 17 0 00 002761' jfcl 17, ovrflw ; Punt if any kind of funny business 33000 remark ; Don't round because extracting milliseconds 33001 33002 remark ; Now convert TOD quotient back to ms 33003 002657'01 120 03 0 00 000001 dmove t3, t1 ; Load TOD quotient as input 33004 remark 17,ovlflw ; Flags are still clear 33005 33006 remark ; Calculate M = (86400000*T)/262144. 33007 002660'01 116 03 0 00 000000# dmul t3, msidad ; Scale TOD ticks by milliseconds 33008 002661'01 255 17 0 00 002761' jfcl 17, ovrflw ; Over 140 bits??? 33009 002662'01 326 03 0 00 002761' jumpn t3, ovrflw ; Over 105 bits?? 33010 002663'01 326 04 0 00 002761' jumpn t4, ovrflw ; Over 70 bits? 33011 002664'01 117 03 0 00 000000# ddiv t3, tticdw ; Strip off partial milliseconds 33012 002665'01 255 17 0 00 002761' jfcl 17, ovrflw ; Punt if any kind of funny business 33013 33014 002666'01 115 07 0 00 000003 dsub q3, t3 ; Calculate remaining milliseconds 33015 002667'01 321 07 0 00 002761' jumpl q3, ovrflw ; Sanity check arithmatic 33016 002670'01 120 03 0 00 000007 dmove t3, q3 ; Return millisecond remainder 33017 002671'01 263 17 0 00 000000 ret ; Finally done 33018 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 42 K20TIM MAC 3-Apr-23 23:45 Fine Grained Time of Day 33019 subttl Fine Grained Time of Day 33020 33021 ; At megabaud (and even high kilobaud) speeds, messages can easily 33022 ; transfer in under the TOD resolution (a single TOD tick being 33023 ; 329.5898438 ms), so a simple subtraction of before and after GTAD%'s 33024 ; really won't work as it will seem as if no time elapsed. 33025 ; 33026 ; Kermit-20 therefore does not use GTAD% difference, but rather uptime 33027 ; (I.E., TIME% a.k.a milliseconds). Can't make DK10 ticks work for 33028 ; elapsed TOD on an unmodified Tops-20 (see above). 33029 ; 33030 ; Expects to smash t1 - t3, others preserved 33031 ; 33032 ; +1/ Unrecoverable error 33033 ; +2/ Worked 33034 33035 002672'01 fintim: entry fintim ; Used in K20PDC, but coded here 33036 002672'01 265 16 0 00 003413' saveac ; Set up a pointer register 33037 33038 002673'01 260 17 0 00 002050' call endtim ; Get current time of day into ending variables 33039 002674'01 260 17 0 00 002133' call elptim ; Calculated elapsed time in various formats 33040 002675'01 201 05 0 00 000000# movei q1, ewallt ; Pointer to elapsed time structure 33041 33042 002676'01 550 01 0 00 000013 hrrz t1, p3 ; Load the logging file JFN 33043 002677'01 200 02 0 05 000000 move t2, .dattd(q1) ; Load ending signed time of day (unrounded) 33044 002700'01 400 03 0 00 000000 setz t3, 33045 002701'01 104 00 0 00 000220 ODTIM% ; Put into the log file 33046 002702'01 320 12 0 00 002622* erjmpr r ; Unless couldn't... 33047 33048 remark p3, ; Continues to have JFN 33049 002703'01 120 02 0 05 000003 dmove t2, .dattr(q1) ; Load remainder milliseconds, if any 33050 002704'01 326 02 0 00 002710' ife. t2 ; Zero high order 33051 002705'01 326 03 0 00 002707' ife. t3 ; and zero low order? 33052 002706'01 254 00 0 00 002623* retskp ; None there, so done 33053 002707'01 endif. ; End case zero double word 33054 002707'01 254 00 0 00 002711' else. ; Non-zero high order 33055 002710'01 661 03 0 00 400000 tlo t3, (1b0) ; Cast low order to unsigned 33056 002711'01 endif. 33057 33058 002711'01 201 02 0 00 000056 movei t2, "." ; Otherwise, punctuate milliseconds 33059 002712'01 260 17 0 00 002517* call BOUTI% ;[216] 33060 002713'01 200 02 0 00 000003 move t2, t3 ; Load the remainder milliseconds 33061 002714'01 200 03 0 00 003677' movx t3, no%lfl!no%zro!no%ast!fld(^d3,no%col)!fld(^d10,no%rdx) 33062 002715'01 104 00 0 00 000224 NOUT% ; Gives ".012" 33063 002716'01 320 14 0 00 002702* erjmps r 33064 33065 002717'01 254 00 0 00 002706* retskp ; Done 33066 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 43 K20TIM MAC 3-Apr-23 23:45 Convert Milliseconds to Time of Day Ticks 33067 subttl Convert Milliseconds to Time of Day Ticks 33068 33069 ; We have two fixed point fractions, one in TOD ticks in a day and the 33070 ; other in milliseconds in a day. The denominator for the former is 33071 ; 262,144 (2^18) whilst the denominator for the later is 86,400,000 33072 ; (24*60*60*1000). 33073 ; 33074 ; If M is the number of milliseconds (input), and T is the number of 33075 ; TOD ticks (output), then the proportion is M:86400000 = T:262144. 33076 ; Solving for T yields M*262144 = T*86400000 (intermediate) or T = 33077 ; (M*262144)/86400000. 33078 ; 33079 ; To extract the remainder, we simply solve the same equation for a 33080 ; different variable, that is, the input is now TOD or T, thus we 33081 ; have T:262144 = M:86400000, or 262144*M = 86400000*T intermediate, 33082 ; or M = (86400000*T)/262144. We then subtract this new M from the 33083 ; input arguments to yield the integer remainder. 33084 ; 33085 ; Call: 33086 ; 33087 ;t1:t2/ Milliseconds as a signed double word 33088 ; 33089 ; Return: 33090 ; 33091 ;t1:t2/ Cooresponding quantity in Time of Day ticks 33092 ; as a signed double word. 33093 ;t3:t4/ Remainder milliseconds as a signed double. 33094 ; The double is used to speed downstream calculations 33095 ; by avoiding conversions. 33096 ; 33097 ; Caution! 33098 ; 33099 ; Be aware that a Time of Day tick equals 329.5898438 milliseconds. 33100 ; So, this conversion is going to cause a REDUCTION in precision 33101 ; between two and three decimal orders of magnitude (!!) 33102 ; 33103 ; Therefore, all intermediate results should be kept in milliseconds 33104 ; and not TOD ticks. 33105 ; 33106 ; We also do not round because the display is printing the milli- 33107 ; seconds and we don't want time to appear to be going backwards. 33108 ; The remainder milliseconds are returned for possible later use. 33109 33110 chgsec(code,const) ;;Constants do not go in the code .PSECT 33111 000172'02 000000 000000 msidad: ^d0 ; Milliseconds in a day, high order 33112 000173'02 000511 456000 msiday ; Milliseconds in a day, low order 33113 000174'02 000000 000000 ms1000: ^d0 ; High order milliseconds in a second 33114 000175'02 000000 001750 ^d1000 ; Low order millisecond in a second 33115 000176'02 000000 000000 lione: ^d0 ; Long integer one, high order 33116 000177'02 000000 000001 ^d1 ; Long integer one, low order 33117 000200'02 000000 000000 dkdayd: ^d0 ; DK10 ticks in a day, high order 33118 000201'02 100276 770000 dkday ; DK10 ticks in a day, low order 33119 000202'02 000000 000000 tticdw: ^d0 ; TOD ticks in a day as a double word, high order 33120 000203'02 000001 000000 todtic ; TOD ticks in a day as a single word, low order 33121 000204'02 000000 000000 tticd2: ^d0 ; Half previous, high order K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 43-1 K20TIM MAC 3-Apr-23 23:45 Convert Milliseconds to Time of Day Ticks 33122 000205'02 000000 400000 ; Half previous, low order 33123 000206'02 377777 777777 clipmx: exp .infin,.infin ; Maximum if we go over 70 bits 33124 retsec ;;Restore .PSECT assumptions 33125 33126 002720'01 321 01 0 00 002761' miltod: jumpl t1, ovrflw ; Sanity check calling arguments 33127 002721'01 321 02 0 00 002761' jumpl t2, ovrflw 33128 002722'01 326 01 0 00 002726' ife. t1 ; Maybe bum the math 33129 002723'01 326 02 0 00 002726' ife. t2 ; Got called with a zero double word? 33130 002724'01 403 03 0 00 000004 setzb t3, t4 ; Yes, so there can't be any remainder 33131 002725'01 263 17 0 00 000000 ret ; Yes, we're done 33132 002726'01 endif. 33133 002726'01 endif. 33134 33135 002726'01 265 16 0 00 003536' saveac ; Intermediate double word results 33136 002727'01 120 05 0 00 000001 dmove q1, t1 ; Save calling milliseconds 33137 002730'01 255 17 0 00 002731' jfcl 17,.+1 ; Clear flags 33138 33139 remark ; First strip off the milliseconds 33140 002731'01 120 03 0 00 000001 dmove t3, t1 ; Cast to a 140 bit intermediate quantity 33141 002732'01 403 01 0 00 000002 setzb t1, t2 ; Nothing in high 70 bits 33142 002733'01 117 01 0 00 000000# ddiv t1, ms1000 ; Strip off anything less than a second 33143 002734'01 255 17 0 00 002761' jfcl 17, ovrflw ; Shouldn't be strange ... 33144 002735'01 120 01 0 00 000005 dmove t1, q1 ; Restore original dividend 33145 002736'01 115 01 0 00 000003 dsub t1, t3 ; Subtract remainder to get to greatest second 33146 002737'01 255 17 0 00 002740' jfcl 17,.+1 ; Clear dsub's strange flags 33147 002740'01 321 01 0 00 002761' jumpl t1, ovrflw ; But double check for any funny business 33148 002741'01 120 05 0 00 000003 dmove q1, t3 ; Save remainder for return 33149 33150 remark ; Calculate T = (M*262144)/86400000 33151 002742'01 116 01 0 00 000000# dmul t1, tticdw ; Scale milliseconds up by time of day ticks 33152 002743'01 255 17 0 00 002761' jfcl 17, ovrflw ; Over 140 bits??? 33153 002744'01 326 01 0 00 002761' jumpn t1, ovrflw ; Over 105 bits?? 33154 002745'01 326 02 0 00 002761' jumpn t2, ovrflw ; Over 70 bits? 33155 002746'01 117 01 0 00 000000# ddiv t1, msidad ; Then strip off partial TOD 33156 002747'01 255 17 0 00 002761' jfcl 17, ovrflw ; Punt if any kind of funny business 33157 002750'01 316 03 0 00 000000# dcaml t3, tticd2 ; Should we round? 33158 002751'01 254 00 0 00 002755' 33159 002752'01 311 03 0 00 000000# 33160 002753'01 254 00 0 00 002756' 33161 002754'01 254 00 0 00 002757' 33162 002755'01 311 04 0 00 000000# 33163 002756'01 114 01 0 00 000000# dadd t1, lione ; Give us an extra tick 33164 33165 remark t1, t2 ; Has TOD ticks 33166 002757'01 120 03 0 00 000005 dmove t3, q1 ; Return millisecond remainder 33167 002760'01 263 17 0 00 000000 ret ; Finally done 33168 33169 002761'01 200 01 0 00 000000# ovrflw: emsg 33170 002762'01 104 00 0 00 000313 33171 000210'02 000000000000# 33172 001133'04 101 162 151 164 150 33173 002763'01 120 01 0 00 000000# dmove t1, clipmx ; Clip down to 'reasonable' maximum 33174 002764'01 263 17 0 00 000000 ret ; Get out of here 33175 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 44 K20TIM MAC 3-Apr-23 23:45 Convert Time of Day Ticks to Seconds 33176 subttl Convert Time of Day Ticks to Seconds 33177 33178 ; Do the math right. We have two fixed point fractions, one in TOD 33179 ; ticks in a day and the other in seconds in a day. The denominator 33180 ; for the former is 262,144 (2^18) whilst the denominator for the 33181 ; later is 86,400 (24*60*60). 33182 ; 33183 ; If T is the number of ticks (input) and S is the number seconds 33184 ; (output), then the proportion is T:262144 = S:86400. Solving for 33185 ; S yields S*262144=T*86400 intermediate or S=(T*86400)/262144. 33186 ; 33187 ; It will be noted that a second is a little more than three TOD ticks 33188 ; (3.034074074). So dividing by 3 will get an increasingly wrong 33189 ; answer, the longer a transfer goes. 33190 ; 33191 ; For example, consider 2,560 time of day ticks. Dividing by three 33192 ; yields a quotient of 853 seconds whereas the actual value is closer 33193 ; to 844 seconds, a difference of nine seconds. For a transfer taking 33194 ; over a day and a half, the difference is over 10,000 seconds 33195 ; 33196 ; Note intermediate double word result which is designed to handle 33197 ; dial up transfers that go on over a weekend (some did) 33198 ; 33199 ; Ticks are in t2, t1 is *** SACRED *** 33200 ; 33201 ; The below is about as fast as we can make this because the only 33202 ; math that is being done is the muli. The lsh with halfword moves 33203 ; and the or are faster than the ashc and whatever else we'd have 33204 ; to do. Div works too, but is blindingly slow. 33205 33206 002765'01 todsec: entry todsec ; Keep LINK informed of our location 33207 002765'01 265 16 0 00 003550' saveac ; Intermediate double word results 33208 002766'01 225 02 0 00 250600 muli t2,^d86400 ; Convert to base 86400 33209 002767'01 514 04 0 00 000002 hrlz t4,t2 ; Pick up high order 33210 002770'01 242 04 0 00 777777 lsh t4,-1 ; Strip off the extra sign bit 33211 002771'01 554 02 0 00 000003 hlrz t2,t3 ; Pick up low order of quotient 33212 002772'01 434 02 0 00 000004 or t2,t4 ; Build final quotient 33213 002773'01 621 03 0 00 777777 tlz t3,-1 ; Clear out from the remainder 33214 002774'01 303 03 0 00 124300 caile t3,^d<86400/2> ; Greater than a half second? 33215 002775'01 340 02 0 00 000000 aoj t2, ; Round up a second, then 33216 002776'01 263 17 0 00 000000 ret ; All done! 33217 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 45 K20TIM MAC 3-Apr-23 23:45 Previous todsec attempts, both good and bad 33218 subttl Previous todsec attempts, both good and bad 33219 33220 repeat 0,< ; First part works 33221 muli t2,^d86400 ; Convert to base 86400, double word result t2,t3 33222 ashc t2,-^d18 ; Strip out TOD ticks 33223 caile t3,^d<86400/2> ; Greater than a half second? 33224 aoj t2, ; Yes, round up a tick, then 33225 ret 33226 > 33227 repeat 0,< ; This works, but is slow 33228 muli t2,^d86400 ; Convert to base 86400 33229 div t2,[^d262144] ; Strip of TOD ticks 33230 caile t3,^d<86400/2> ; Greater than a half second? 33231 aoj t2, ; Round up a second, then 33232 ret ; All done! 33233 > 33234 33235 repeat 0,< ; This won't work for double length results 33236 hrl t2,t2 ; 'Divide' by 2^18 33237 hlr t2,t3 ; Pick up low order of quotient 33238 tlz t3,-1 ; Clear out from the remainder 33239 > 33240 33241 repeat 0,< ; Won't handle over a day 33242 imuli t2,^d86400 ; Convert to base 86400 33243 hrrz t3,t2 ; Pick up the remainder 33244 hlrz t2,t2 ; Properly position quotient 33245 caile t3,^d<86400/2> ; Greater than a half second? 33246 aoj t2, ; Round up a second, then 33247 ret ; All done! 33248 > K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 46 K20TIM MAC 3-Apr-23 23:45 subtract two (unsigned) times of day 33249 subttl subtract two (unsigned) times of day 33250 33251 ; Time of Day in TOD ticks is an ***UNSIGNED*** 36 bit number 33252 ; 33253 ; Therefore, a simple signed 35 bit subtract will eventually not 33254 ; work. Avoid the problem by using signed 70 bit math 33255 ; 33256 ; Returns result in t2, t1 is sacred 33257 33258 002777'01 elapst: entry elapst ; Keep LINK informed of our location 33259 33260 002777'01 265 16 0 00 003700' saveac 33261 003000'01 474 02 0 00 000000 seto t2, ; Assume unlikely case of something wrong 33262 003001'01 200 03 0 00 000000# move t3, etdat ; Load ending TOD 33263 003002'01 603 03 0 00 777777 tlne t3, -1 ; Any kind 33264 003003'01 316 03 0 00 003422' camn t3, [-1] ; of phonkey? 33265 003004'01 263 17 0 00 000000 ret ; Bad, return talisman 33266 003005'01 200 12 0 00 000000# move p2, stdat ; Load starting TOD 33267 003006'01 603 12 0 00 777777 tlne p2, -1 ; Any kind 33268 003007'01 316 12 0 00 003422' camn p2, [-1] ; of phonkey? 33269 003010'01 263 17 0 00 000000 ret ; Bad, return talisman 33270 33271 remark ; TOD is a 36 bit unsigned number!! 33272 003011'01 403 02 0 00 000011 setzb t2, p1 ; Zero high orders 33273 003012'01 623 03 0 00 400000 tlze t3, (1b0) ; Cast unsigned to signed long 33274 003013'01 201 02 0 00 000001 movei t2, ^d1 ; Propagate to high order 33275 003014'01 623 12 0 00 400000 tlze p2, (1b0) ; Cast unsigned to signed long 33276 003015'01 201 11 0 00 000001 movei p1, ^d1 ; Propagate to high order 33277 ; Make sure beginning is before last 33278 003016'01 316 02 0 00 000011 camn t2, p1 ; Compare high order 33279 003017'01 254 00 0 00 003025' ifskp. ; Not equal so just compare high order 33280 003020'01 311 02 0 00 000011 caml t2, p1 ; Is beginning before end? 33281 003021'01 254 00 0 00 003024' ifskp. ; Yep, swap them 33282 003022'01 250 02 0 00 000011 exch t2, p1 ; Swap high order 33283 003023'01 250 03 0 00 000012 exch t3, p2 ; Swap low order 33284 003024'01 endif. 33285 003024'01 254 00 0 00 003031' else. ; Equal, so compare low order 33286 003025'01 311 03 0 00 000012 caml t3, p2 ; Is beginning before end? 33287 003026'01 254 00 0 00 003031' ifskp. ; Yep, swap them 33288 003027'01 250 02 0 00 000011 exch t2, p1 ; Swap high order 33289 003030'01 250 03 0 00 000012 exch t3, p2 ; Swap low order 33290 003031'01 endif. 33291 003031'01 endif. 33292 ; Finally ok to subtract 33293 003031'01 115 02 0 00 000011 dsub t2, p1 ; Do a signed subtract 33294 003032'01 332 00 0 00 000002 skipe t2 ; Signed result of 36 bits? 33295 003033'01 661 03 0 00 400000 tlo t3,(1b0) ; Cast to unsigned 36 bits 33296 33297 003034'01 200 02 0 00 000003 move t2, t3 ; Load low order into return AC 33298 003035'01 263 17 0 00 000000 ret 33299 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 47 K20TIM MAC 3-Apr-23 23:45 Calculates character rate with double floating point arithmatic 33300 subttl Calculates character rate with double floating point arithmatic 33301 33302 ; Call: 33303 ; 33304 ; t2/ Pointer to elapsed HPTIM% (DK10) ticks for transfer (double word) 33305 ; t3/ Total characters sent or received 33306 ; 33307 ; Characters are handled as if they were unsigned int's, but currently, 33308 ; they never will be. This is done for future expansion. 33309 ; 33310 ; Returns: 33311 ; 33312 ; +1 - Failed 33313 ; +2 - Success!! 33314 ; t4/ Double floating raw baud rate, high order mantissa 33315 ; t5/ Ditto, low order mantissa 33316 ; 33317 ; Maintains precision by keeping numerator and denominator in fixed 33318 ; point as long as possible with the assumption that a dmul is faster 33319 ; than a dfmp and a ddiv is WAY faster than a dfdv. 33320 ; 33321 ; Since t5 is a lexical alias for q1, assumes q1 has been saved 33322 ; by caller. DON'T BREAK THIS ASSUMPTION! 33323 ; 33324 ; The odd calling conventions are because this used to be passed an 33325 ; unsigned int which did not have enough precision for certain extreme 33326 ; cases. However, because of agressive register scheduling, only a 33327 ; single register was available, so this was changed to a pointer, 33328 ; to a long int, instead. 33329 33330 chgsec(code,const) ;;Constants do not go in the code .PSECT 33331 000211'02 dblscl: intern dblscl ; Also used in k20dsp 33332 000211'02 000000 000000 0 ; Scaling factor between DK10 ticks and seconds 33333 000212'02 000000 303240 ^d100000 ; Low order of same (100000 ticks per second) 33334 retsec ;;Return to regular .PSECT assumptions 33335 33336 chgsec(code,data) ;;Intermediate results, largely used for debugging 33337 000223'05 tickpt: block 1 ; Pointer to HP tick double word (not always .datus!) 33338 000224'05 dbltic: block 2 ; Double INTEGER value that tickpt points to 33339 000226'05 dfltic: block 2 ; Double floating version of same 33340 000230'05 dblchr: block 2 ; Double INTEGER value of unsigned characters (exact) 33341 000232'05 dflchr: block 2 ; Double floating version of same 33342 retsec ;;Return to regular .PSECT assumptions 33343 33344 003036'01 dblcal: entry dblcal ; Used by k20dsp 33345 remark q1, t5 ; Recall this alias 33346 003036'01 265 16 0 00 003712' saveac ; Don't touch output pointer 33347 33348 003037'01 202 02 0 00 000000# movem t2, tickptr ; Save pointer to calling double word DK10 count 33349 33350 remark t3,chars ; Treated as unsigned 36; I.E., never negative 33351 003040'01 400 01 0 00 000000 setz t1, ; Form high order in t1 33352 003041'01 623 03 0 00 400000 tlze t3, (1b0) ; Cast unsigned to signed long 33353 003042'01 201 01 0 00 000001 movei t1, ^d1 ; Propagate to high order 33354 003043'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 15:19 11-Jun-23 Page 47-1 K20TIM MAC 3-Apr-23 23:45 Calculates character rate with double floating point arithmatic 33355 003044'01 124 01 0 00 000000# dmovem t1, dblchr ; Store interim long (double) signed integer 33356 33357 003045'01 200 03 0 00 000000# move t3, tickptr ; Load pointer to DK10 double word 33358 003046'01 120 01 0 03 000000 dmove t1, (t3) ; and then load said double word 33359 003047'01 124 01 0 00 000000# dmovem t1, dbltic ; Store long integer ticks 33360 003050'01 260 17 0 00 003246' call dfloat ; Convert to KL10 double floating point 33361 003051'01 263 17 0 00 000000 ret ; But failed for some reason 33362 003052'01 124 01 0 00 000000# dmovem t1, dfltic ; Store double floating ticks 33363 33364 003053'01 120 01 0 00 000000# dmove t1, dblchr ; Load interim long integer characters 33365 003054'01 403 03 0 00 000004 setzb t3, t4 ; Clear low order 33366 003055'01 116 01 0 00 000000# dmul t1, dblscl ; Scale to DK10 resolution 33367 003056'01 124 03 0 00 000000# dmovem t3, dblchr ; Store final long integer characters 33368 003057'01 120 01 0 00 000003 dmove t1, t3 ; Load scaled double integer for double float 33369 003060'01 260 17 0 00 003246' call dfloat ; Convert to double floating form 33370 003061'01 263 17 0 00 000000 ret ; Failed 33371 003062'01 124 01 0 00 000000# dmovem t1, dflchr ; Store interim double floating characters 33372 33373 003063'01 120 04 0 00 000001 dmove t4, t1 ; Position characters for return 33374 003064'01 113 04 0 00 000000# dfdv t4, dfltic ; Calculate character rate 33375 003065'01 254 00 0 00 002717* retskp ; Finally return successful result 33376 33377 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 48 K20TIM MAC 3-Apr-23 23:45 Single word to double integer and double float 33378 subttl Single word to double integer and double float 33379 33380 ; Call: 33381 ; 33382 ; t2/ Unsigned 36 bit integer to be converted to long and double float 33383 ; 33384 ; Result: 33385 ; 33386 ; +1/ Failed 33387 ; +2/ 33388 ; t2/ double floating high order 33389 ; t3/ double floating low order 33390 ; t4/ long integer high order 33391 ; t5/ long integer low order 33392 33393 003066'01 singdf: entry singdf ; Called by display 33394 003066'01 265 16 0 00 003712' saveac ; Save because dfloat will trash it 33395 33396 003067'01 400 01 0 00 000000 setz t1, ; Assume not more than 35 bits 33397 003070'01 623 02 0 00 400000 tlze t2, (1b0) ; Cast unsigned to signed long 33398 003071'01 201 01 0 00 000001 movei t1, ^d1 ; Propagate to high order 33399 003072'01 120 04 0 00 000001 dmove t4, t1 ; Now save the signed long 33400 33401 003073'01 260 17 0 00 003246' call dfloat ; Float signed long 33402 003074'01 263 17 0 00 000000 ret ; Or not... 33403 33404 003075'01 200 03 0 00 000002 move t3, t2 ; Reposition double floating low order 33405 003076'01 200 02 0 00 000001 move t2, t1 ; Reposition double floating high order 33406 003077'01 254 00 0 00 003065* retskp ; Succeed 33407 33408 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 49 K20TIM MAC 3-Apr-23 23:45 Schedule, Class and Load storage declarations 33409 subttl Schedule, Class and Load storage declarations 33410 33411 chgsec(code,data) ;;Declare non-global writable storage 33412 000234'05 000000 000000 class: 0 ;[130] My scheduler class. 33413 000235'05 000000 000000 skdflg: 0 ;[130] Nonzero if class scheduler on. 33414 000236'05 skdblk: block .saclu+1 ; Argument block for SKED% jsys. 33415 000245'05 000000 000000 skedx: 0 ;[194] SKED% error count 33416 000246'05 000000 601405 lgetbe: lstrx1 ;[194] Last GETAB% error 33417 000247'05 000000 000000 getabx: 0 ;[194] GETAB% error count 33418 000250'05 000000 601405 lskede: lstrx1 ;[194] Last error from SKED% (none) 33419 000251'05 000000 000000 ksajus: 0 ;[194] Kermit's (floating) job utilization 33420 retsec ;;Back into code 33421 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 50 K20TIM MAC 3-Apr-23 23:45 Get Scheduler Class information. 33422 subttl Get Scheduler Class information. 33423 33424 003100'01 gtclas: entry gtclas ; Identfy ourselves for LINK 33425 33426 003100'01 402 00 0 00 000000# setzm class ; Assume we ain't got no class ... (boo) 33427 003101'01 201 01 0 00 000014 movei t1, .skrcv ; Read scheduler status 33428 003102'01 120 02 0 00 003720' dmove t2, [exp t3 , 2] ; Two words, starting at t3 33429 003103'01 201 03 0 00 000002 movei t3, 2 ; Just want 2 words. 33430 003104'01 104 00 0 00 000577 SKED% 33431 003105'01 320 12 0 00 003107' ifje. r ; Catch and ignore error 33432 003106'01 254 00 0 00 003113' 33433 003107'01 202 01 0 00 000000# movem t1, lskede ; Save as last SKED% error 33434 003110'01 350 00 0 00 000000# aos skedx ; Count the error (should be only one) 33435 003111'01 402 00 0 00 000000# setzm skdflg ; Flag that the class scheduler is off 33436 003112'01 263 17 0 00 000000 ret ; Nothing else we can do 33437 003113'01 endif. ; End JSYS error handling 33438 33439 003113'01 603 04 0 00 100000 txne t4, sk%stp ; Class scheduler on? (bit means "stopped") 33440 003114'01 400 04 0 00 000000 setz t4, ; No, then whack all the bits we got back 33441 003115'01 202 04 0 00 000000# movem t4, skdflg ; And save some interesting bits 33442 003116'01 322 04 0 00 002716* jumpe t4, r ; If no scheduler, we're basically done here 33443 33444 ;[130] Scheduler is on, get my scheduler class. 33445 33446 003117'01 104 00 0 00 000013 GJINF% ; Get my job information 33447 003120'01 200 04 0 00 000003 move t4, t3 ; Put my job number in the right place 33448 33449 003121'01 265 16 0 00 000000* anstkv (t2,<.saclu+1>) ; Allocate an anonymous stack variable 33450 003122'01 000000 000007 33451 003123'01 415 02 0 17 777770 33452 remark ; Now fill out the argument block 33453 003124'01 124 03 0 02 000000 dmovem t3, .sacnt(t2) ; Pop them into the block 33454 003125'01 403 03 0 00 000004 setzb t3, t4 ; Cons up a pair of zeros 33455 003126'01 124 03 0 02 000002 dmovem t3, .sajcl(t2) ; Whack job class and job share 33456 003127'01 124 03 0 02 000004 dmovem t3, .sajus(t2) ; Whack job utilization and class share 33457 003130'01 402 00 0 02 000006 setzm .saclu(t2) ; Whack class utilization 33458 33459 003131'01 201 01 0 00 000007 movx t1, .skrjp ; Function code for getting job's class info. 33460 003132'01 104 00 0 00 000577 SKED% ; Cross our fingers 33461 003133'01 320 12 0 00 003135' ifje. r ; Failed?? 33462 003134'01 254 00 0 00 003141' 33463 003135'01 202 01 0 00 000000# movem t1, lskede ; Save as last SKED% error 33464 003136'01 350 00 0 00 000000# aos skedx ; Count the error (should be only one) 33465 003137'01 477 01 0 02 000002 setob t1, .sajcl(t2) ; Set class to -1 as a talisman 33466 003140'01 254 00 0 00 003142' else. ; Otherwise, worked! 33467 003141'01 200 01 0 02 000002 move t1, .sajcl(t2) ; So get a legitimate class 33468 003142'01 endif. ; End JSYS error 'recovery' 33469 33470 003142'01 202 01 0 00 000000# movem t1, class ; Who says I ain't got no class? 33471 003143'01 200 01 0 02 000004 move t1, .sajus(t2) ; Load job utilization because it's cool 33472 003144'01 202 01 0 00 000000# movem t1, ksajus ; Save it in case somebody ever cares 33473 003145'01 263 17 0 00 000000 ret 33474 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 51 K20TIM MAC 3-Apr-23 23:45 LDAV -- Get the current load average. 33475 subttl LDAV -- Get the current load average. 33476 33477 ;[130] This routine added as part of edit 130. 33478 ; 33479 ; Takes class scheduling into account. 33480 ; 33481 ; Call with 33482 ; 33483 ; t1/ 0 for 1 minute load average 33484 ; 1 for 5 minute load average 33485 ; 2 for 15 minute load average 33486 ; 33487 ; SKDFLG/ -1 if class scheduler running, 33488 ; 0 if no class scheduler or class scheduler stopped 33489 ; 33490 ; CLASS/ This job's scheduler class. 33491 ; 33492 ; Returns +1 always, with requested load average in t1. 33493 33494 003146'01 ldav: entry ldav ; Inform LINK of our location 33495 003146'01 265 16 0 00 003413' saveac ; Copy of deglitched calling argument 33496 003147'01 301 01 0 00 000000 cail t1, 0 ; Argument in range? 33497 003150'01 303 01 0 00 000002 caile t1, 2 33498 003151'01 400 01 0 00 000000 setz t1, ; Gubbish, silently force to 0. 33499 003152'01 200 05 0 00 000001 move q1, t1 ; Save a copy of it 33500 003153'01 332 00 0 00 000000# skipe skdflg ; Class scheduler on? 33501 003154'01 254 00 0 00 003166' jrst cldav ; Yes, go get class load average 33502 33503 ; No class scheduler or it's off, so use GETAB for system-wide load average 33504 33505 003155'01 514 01 0 00 000005 gldav: hrlz t1, q1 ; Desired load average. 33506 003156'01 270 01 0 00 003722' add t1, [14,,.systa] ; Goes from offset 14 to 16 (see 2.3.2) 33507 003157'01 104 00 0 00 000010 GETAB ; use load avg from SYSTAT monitor table. 33508 003160'01 320 12 0 00 003162' ifje. r ;[194] Catch and ignore error 33509 003161'01 254 00 0 00 003165' 33510 003162'01 202 01 0 00 000000# movem t1, lgetbe ;[194] Save last error 33511 003163'01 350 00 0 00 000000# aos getabx ;[194] Bump GETAB error count 33512 003164'01 205 01 0 00 203400 movx t1, ; Return minimum load in case of any error. 33513 003165'01 endif. ;[194] 33514 003165'01 263 17 0 00 000000 ret ; Otherwise, got some useful 33515 33516 ; Class scheduler on, get load avg for this class from SKED%. 33517 33518 003166'01 335 04 0 00 000000# cldav: skipge t4, class ; This job's scheduler class. 33519 003167'01 254 00 0 00 003155' jrst gldav ; We're in an odd way, fall back to GETAB 33520 33521 003170'01 265 16 0 00 003121* anstkv (t2,<.sa15l+1>) ; Allocate an anonymous stack variable 33522 003171'01 000000 000007 33523 003172'01 415 02 0 17 777770 33524 003173'01 124 03 0 02 000000 dmovem t3, .sacnt(t2) ; Store length and requested class 33525 003174'01 403 03 0 00 000004 setzb t3, t4 ; Cons up a pair of zeros 33526 003175'01 124 03 0 02 000002 dmovem t3, .sashr(t2) ; Whack returned share and use 33527 003176'01 124 03 0 02 000004 dmovem t3, .sa1ml(t2) ; Whack one and five minute load averages 33528 003177'01 402 00 0 02 000006 setzm .sa15l(t2) ; Whack 15 minute load average 33529 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 51-1 K20TIM MAC 3-Apr-23 23:45 LDAV -- Get the current load average. 33530 003200'01 201 01 0 00 000003 movei t1, .skrcs ; Function is read class parameters. 33531 003201'01 104 00 0 00 000577 SKED% 33532 003202'01 320 12 0 00 003204' ifje. r ; Catch and ignore error 33533 003203'01 254 00 0 00 003210' 33534 003204'01 202 01 0 00 000000# movem t1, lskede ; Save as last SKED% error 33535 003205'01 350 00 0 00 000000# aos skedx ; Count the error (should be only one) 33536 003206'01 402 00 0 00 000000# setzm skdflg ; Flag that the class scheduler went off 33537 003207'01 254 00 0 00 003155' jrst gldav ; Fall back to GETAB 33538 003210'01 endif. ; End JSYS error handling 33539 33540 003210'01 201 03 0 02 000004 movei t3,.sa1ml(t2) ; Resolve base of load average block 33541 003211'01 270 03 0 00 000005 add t3, q1 ; Add offset to get to the one we want 33542 003212'01 200 01 0 03 000000 move t1, (t3) ; Finally load whatever it is 33543 003213'01 263 17 0 00 000000 ret ; Done 33544 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 52 K20TIM MAC 3-Apr-23 23:45 Increase wait time, depending on system load (very clever) 33545 subttl Increase wait time, depending on system load (very clever) 33546 33547 ;[128] Make this a separate routine. 33548 ; 33549 ; ADJTIM -- Adjust timeout interval based on load average (ldav). 33550 ; 33551 ; Timeout = mintim + (ldav-MINLOD)*((MAXTIM-mintim)/MAXLOD) 33552 ; 33553 ; 1) If the load is low, gives the minimum acceptable timeout, mintim. 33554 ; 2) If the load is very high, gives the maximum timeout, MAXTIM. 33555 ; 33556 ; In between, the timeout goes up linearly with given load average. 33557 ; 33558 ; MINLOD, MAXLOD, and MAXTIM are defined as global symbols. 33559 ; 33560 ; Call with: 33561 ; 33562 ; t1/ 1, 5, or 15 minute ldav, 33563 ; (floating point number as returned by ldav) 33564 ; t2/ minimum acceptable timeout (mintim), milliseconds (integer). 33565 ; 33566 ; Returns +1 always, with 33567 ; 33568 ; t2/ adjusted timeout interval, in milliseconds (integer). 33569 ; 33570 ; N.B., 33571 ; 33572 ; Will never return a number larger than MAXTIM. 33573 ; Zero means no time out and is always returned as zero 33574 33575 003214'01 adjtim: entry adjtim ; Inform LINK of our location 33576 003214'01 327 02 0 00 003217' ifle. t2 ;[212] Zero or goofy? 33577 003215'01 400 02 0 00 000000 setz t2, ;[212] Load zero (to never time out) 33578 003216'01 263 17 0 00 000000 ret ;[212] And return that 33579 003217'01 endif. 33580 33581 remark ;[212] Otherwise, have some math to do 33582 003217'01 265 16 0 00 000000* acvar ; Local storage for second argument. 33583 003220'01 202 02 0 00 000005 movem t2, mintim ; Save the minimum for later. 33584 33585 remark (ldav-MINLOD) ;[212] Normalize load to trigger after minlod 33586 003221'01 155 01 0 00 203400 fsbrx t1, ;[194] Adjust load by subtracting the minimum. 33587 003222'01 327 01 0 00 003226' ifle. t1 ;[212] Zero or negative load? 33588 003223'01 200 02 0 00 000005 move t2, mintim ;[212] Then second term has no effect 33589 003224'01 263 17 0 00 000000 ret ;[212] So just return the number, unaltered 33590 003225'01 254 00 0 00 003230' else. ;[212] Otherwise, range check the result 33591 003226'01 311 01 0 00 003723' caxl t1, ;[194] If too big, clamp to maximum 33592 003227'01 205 01 0 00 206620 movx t1, ;[194] It was, so load the maximum 33593 003230'01 endif. 33594 33595 remark (MAXTIM-mintim) ;[212] Range check and correct timeout 33596 003230'01 201 02 0 00 267460 movx t2, maxtim ;[212] Maximum timeout, milliseconds. 33597 003231'01 274 02 0 00 000005 sub t2, mintim ; Less specified timeout interval. 33598 003232'01 327 02 0 00 003236' ifle. t2 ;[212] Efficiency hack, is this not positive? 33599 003233'01 201 02 0 00 267460 movx t2, maxtim ;[212] Clamp result to maximum K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 52-1 K20TIM MAC 3-Apr-23 23:45 Increase wait time, depending on system load (very clever) 33600 003234'01 263 17 0 00 000000 ret ;[212] And done 33601 003235'01 254 00 0 00 003237' else. ;[212] Otherwise, 33602 003236'01 127 02 0 00 000002 fltr t2, t2 ;[212] float the result 33603 003237'01 endif. ;[212] End term check 33604 33605 003237'01 175 02 0 00 206620 fdvrx t2, ;[194] Divided by maximum load. 33606 003240'01 164 01 0 00 000002 fmpr t1, t2 ; Multiplied by actual (adjusted) load. 33607 003241'01 126 02 0 00 000001 fixr t2, t1 ; Fixed & rounded. 33608 003242'01 270 02 0 00 000005 add t2, mintim ; Add in requested minimum timeout. 33609 003243'01 303 02 0 00 267460 caile t2, maxtim ;[212] Larger than largest? 33610 003244'01 201 02 0 00 267460 movx t2, maxtim ;[212] Clamp to maximum 33611 33612 003245'01 263 17 0 00 000000 ret ; Return with result in t2. 33613 33614 endav. ;[194] End scope mintim acvar 33615 33616 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 53 K20TIM MAC 3-Apr-23 23:45 Tables to support integer to double floating conversion 33617 SUBTTL Tables to support integer to double floating conversion 33618 33619 ;[206] Begin code insertion, selflessly donated from my very 33620 ; own Tops-20 Extended mode FTP Server. "Share and Enjoy" 33621 33622 REMARK Table to see if we can do a simple shift 33623 33624 ; When converting a single word integer to double floating point 33625 ; format, there is no case where we are ever going to have to round. 33626 ; However, in certain instances where the lower part of the word is 33627 ; clear, we can bum the combined (double accumulator) arithmetic shift 33628 ; and get by with a faster single accumulator logical shift. 33629 ; 33630 ; This is accomplished by checking to see if any bits would go from 33631 ; the lower high order word to the upper lower order word with these 33632 ; masks whose indices correspond to the amount of bits we'd need to 33633 ; shift over. 33634 33635 chgsec(code,const) ;;Constants go into CONST area 33636 33637 000213'02 000000 000000 SLSHMK: 0 ; Always positive means we'll skip the first entry 33638 000214'02 000000 000377 ^B11111111 ; 8 ; and will always be at least one 33639 000215'02 000000 000177 ^B1111111 ; 7 ; Means we have to have entire field free 33640 000216'02 000000 000077 ^B111111 ; 6 33641 000217'02 000000 000037 ^B11111 ; 5 33642 000220'02 000000 000017 ^B1111 ; 4 33643 000221'02 000000 000007 ^B111 ; 3 33644 000222'02 000000 000003 ^B11 ; 2 33645 000223'02 000000 000001 ^B1 ; 1 33646 000224'02 000 00 0 00 000000 Z ; 0 ; Should never happen because should have 33647 ; been caught by the rounding logic 33648 33649 REMARK Binary exponent increment 33650 33651 ; The table cooresponds to the simple shift hack, above. In this 33652 ; case, we already have the correct magnitude and simply need to 33653 ; change it based on the amount of the shift. 33654 33655 000225'02 000000 000000 BXPINC: 0 ; Always positive means we'll skip the first entry 33656 000226'02 010000 000000 FLD(^D8,EXPMSK) ; and will always be at least one bit because JFFO 33657 000227'02 007000 000000 FLD(^D7,EXPMSK) ; is always going to count the sign. Thus, having 33658 000230'02 006000 000000 FLD(^D6,EXPMSK) ; one bit set means we would have shifted out an 33659 000231'02 005000 000000 FLD(^D5,EXPMSK) ; entire exponent field 33660 000232'02 004000 000000 FLD(^D4,EXPMSK) 33661 000233'02 003000 000000 FLD(^D3,EXPMSK) 33662 000234'02 002000 000000 FLD(^D2,EXPMSK) 33663 000235'02 001000 000000 FLD(^D1,EXPMSK) 33664 000236'02 000 00 0 00 000000 Z ; Should never happen because should have caught 33665 ; by the rounding decision logic 33666 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 54 K20TIM MAC 3-Apr-23 23:45 Tables to support integer to double floating conversion 33667 REMARK Double word binary exponent 33668 33669 ; In this case, the table contains all of the possible exponent values 33670 ; for corresponding shifts when normalizing an integer in the high 33671 ; order word. 33672 33673 000237'02 000000 000000 DWBEXP: 0 ; Ignore the sign bit 33674 000240'02 306000 000000 FLD(^D<35+35+128>,EXPMSK) 33675 000241'02 305000 000000 FLD(^D<34+35+128>,EXPMSK) 33676 000242'02 304000 000000 FLD(^D<33+35+128>,EXPMSK) 33677 000243'02 303000 000000 FLD(^D<32+35+128>,EXPMSK) 33678 000244'02 302000 000000 FLD(^D<31+35+128>,EXPMSK) 33679 000245'02 301000 000000 FLD(^D<30+35+128>,EXPMSK) 33680 000246'02 300000 000000 FLD(^D<29+35+128>,EXPMSK) 33681 000247'02 277000 000000 FLD(^D<28+35+128>,EXPMSK) 33682 000250'02 000 00 0 00 000000 Z ; Should be caught by non-shifting case!!! 33683 000251'02 275000 000000 FLD(^D<26+35+128>,EXPMSK) 33684 000252'02 274000 000000 FLD(^D<25+35+128>,EXPMSK) 33685 000253'02 273000 000000 FLD(^D<24+35+128>,EXPMSK) 33686 000254'02 272000 000000 FLD(^D<23+35+128>,EXPMSK) 33687 000255'02 271000 000000 FLD(^D<22+35+128>,EXPMSK) 33688 000256'02 270000 000000 FLD(^D<21+35+128>,EXPMSK) 33689 000257'02 267000 000000 FLD(^D<20+35+128>,EXPMSK) 33690 000260'02 266000 000000 FLD(^D<19+35+128>,EXPMSK) 33691 000261'02 265000 000000 FLD(^D<18+35+128>,EXPMSK) 33692 000262'02 264000 000000 FLD(^D<17+35+128>,EXPMSK) 33693 000263'02 263000 000000 FLD(^D<16+35+128>,EXPMSK) 33694 000264'02 262000 000000 FLD(^D<15+35+128>,EXPMSK) 33695 000265'02 261000 000000 FLD(^D<14+35+128>,EXPMSK) 33696 000266'02 260000 000000 FLD(^D<13+35+128>,EXPMSK) 33697 000267'02 257000 000000 FLD(^D<12+35+128>,EXPMSK) 33698 000270'02 256000 000000 FLD(^D<11+35+128>,EXPMSK) 33699 000271'02 255000 000000 FLD(^D<10+35+128>,EXPMSK) 33700 000272'02 254000 000000 FLD(^D<09+35+128>,EXPMSK) 33701 000273'02 253000 000000 FLD(^D<08+35+128>,EXPMSK) 33702 000274'02 252000 000000 FLD(^D<07+35+128>,EXPMSK) 33703 000275'02 251000 000000 FLD(^D<06+35+128>,EXPMSK) 33704 000276'02 250000 000000 FLD(^D<05+35+128>,EXPMSK) 33705 000277'02 247000 000000 FLD(^D<04+35+128>,EXPMSK) 33706 000300'02 246000 000000 FLD(^D<03+35+128>,EXPMSK) 33707 000301'02 245000 000000 FLD(^D<02+35+128>,EXPMSK) 33708 000302'02 244000 000000 FLD(^D<01+35+128>,EXPMSK) 33709 000303'02 000 00 0 00 000000 Z ; Indicates a zero upper word which should 33710 ; have already been accounted for 33711 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 55 K20TIM MAC 3-Apr-23 23:45 Tables to support integer to double floating conversion 33712 REMARK Double word arithmetic shift normalization 33713 33714 RADIX ^D10 33715 33716 ; N.B., negative shift is the only case where a round operation would be needed 33717 33718 000304'02 000000 000000 DWASHN: 0 ; Ignore the sign bit 33719 000305'02 777777 777770 EXP -8,-7,-6,-5,-4,-3,-2,-1 ; Cases of opening up exponent field 33720 000315'02 000 00 0 00 000000 Z ; Should be caught by non-shifting case!! 33721 000316'02 000000 000001 EXP 1, 2, 3, 4, 5, 6, 7, 8, 9 ; Cases of shifting significance towards 33722 000327'02 000000 000012 EXP 10,11,12,13,14,15,16,17,18,19 ; the exponent field--never any rounding 33723 000341'02 000000 000024 EXP 20,21,22,23,24,25,26 ; Should never exceed 26 shifts 33724 000350'02 000 00 0 00 000000 Z ; Indicates a zero upper word which 33725 ; should have already been accounted for 33726 RADIX ^D8 33727 33728 retsec ;;Restore psect assumptions 33729 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 56 K20TIM MAC 3-Apr-23 23:45 Routine to implement double float 33730 SUBTTL Routine to implement double float 33731 33732 ; The routine assumes that the exponent will always be positive (I.E., 33733 ; greater than 128 decimal, 200 octal). This is--by definition-- 33734 ; always true for integers: there will NEVER be fractions, much less 33735 ; values less than 1 other than zero (0) or a negative. 33736 ; 33737 ; It assumes that the number will be positive. If this is not the 33738 ; case, it takes the magitude of the integer and multiplies the 33739 ; eventual result by double floating negative 1. This will slow down 33740 ; the double floatation of negative numbers, but in this program we 33741 ; never produce those. 33742 ; 33743 ; It also doesn't do any rounding. However, rounding would only occur 33744 ; for values that are in excess of 4,611,686,018,427,387,903 33745 ; (approximately 4.5 million trillion). Since the numbers in question 33746 ; are not going to be THAT large, this is not a problem in this 33747 ; program. 33748 ; 33749 ; We're just looking to keep the original number in the fraction (or 33750 ; mantissa) and hence need the additional word of dynamic range 33751 ; 33752 ; N.B., Toad doesn't have dfltr yet it has dgfltr... Why?? 33753 ; 33754 ; Call: 33755 ; 33756 ; T1/ High order double integer 33757 ; T2/ Low order double integer 33758 ; 33759 ; Return: 33760 ; 33761 ; +1 Something failed, T1 and T2 indeterminate 33762 ; +2 Success 33763 ; T1/ High order double floating point (most significant bits of mantissa) 33764 ; T2/ Low order double floating point number 33765 33766 377000 000000 EXPMSK==MASKB(1,8) ; Exponent field mask 33767 33768 003246'01 DFLOAT: ENTRY DFLOAT ; Make available to the world 33769 003246'01 326 01 0 00 003251' IFE. T1 ; No high order. Might be zero ... 33770 003247'01 326 02 0 00 003251' IFE. T2 ; Any low order? 33771 003250'01 263 17 0 00 000000 RET ; No, got passed a zero, so nothing to do 33772 003251'01 ENDIF. ; End case of zero low order 33773 003251'01 ENDIF. ; End case of zero high order 33774 33775 003251'01 265 16 0 00 003724' SAVEAC ; Real work! Will need some scratch storage 33776 003252'01 321 01 0 00 003256' IFGE. T1 ; Something positivishly flavored? 33777 003253'01 120 03 0 00 000001 DMOVE T3,T1 ; Yes, save a copy of the number 33778 003254'01 400 06 0 00 000000 SETZ Q2, ; flag positivity 33779 003255'01 254 00 0 00 003261' ELSE. ; Otherwise make positive and fix later 33780 REMARK DMOVN ; Don't use; floating only, will break on ints 33781 003256'01 403 03 0 00 000004 SETZB T3,T4 ; Make a big fat zero 33782 003257'01 115 03 0 00 000001 DSUB T3,T1 ; Make negative a positive in T3:T4 33783 003260'01 474 06 0 00 000000 SETO Q2, ; Flag negativity 33784 003261'01 ENDIF. ; End case of negative signed double K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 56-1 K20TIM MAC 3-Apr-23 23:45 Routine to implement double float 33785 33786 003261'01 326 03 0 00 003314' IFE. T3 ; Not really a HUGE number after all? 33787 003262'01 603 04 0 00 377000 TXNE T4,EXPMSK ; Would we have to round???? 33788 003263'01 254 00 0 00 003274' IFSKP. ; No, maybe we can bum the FLTR ... 33789 003264'01 607 04 0 00 000400 TXNN T4,1B9 ; In the range of 67,108,864 to 134,217,727? 33790 003265'01 254 00 0 00 003271' IFSKP. ; Yes, already normalized! 33791 003266'01 205 01 0 00 233000 MOVX T1,FLD(^D<128+27>,EXPMSK) 33792 003267'01 434 01 0 00 000004 IOR T1,T4 ; Cons the exponent and mantissa 33793 003270'01 254 00 0 00 003272' ELSE. ; Otherwise, can use plain old reliable ... 33794 003271'01 127 01 0 00 000004 FLTR T1,T4 ; and float it (slowly) 33795 003272'01 ENDIF. ; Either way, T1 is complete 33796 003272'01 400 02 0 00 000000 SETZ T2, ; There is no low order mantissa 33797 003273'01 254 00 0 00 003313' ELSE. ; Otherwise more than 27 bit mantissa 33798 003274'01 200 01 0 00 000004 MOVE T1,T4 ; Load the integer 33799 003275'01 260 17 0 00 003376' CALL EXPSFT ; Compute shift amount to clear field 33800 003276'01 263 17 0 00 000000 RET ; Oh dear, we're ill, beat it 33801 003277'01 205 01 0 00 233000 MOVX T1,FLD(^D<128+27>,EXPMSK) 33802 003300'01 270 01 0 02 000000# ADD T1,BXPINC(T2) ; Load maximum unrounded and calculate shift 33803 003301'01 612 04 0 02 000000# TDNE T4,SLSHMK(T2) ; Is there enough space for a single shift 33804 003302'01 254 00 0 00 003307' IFSKP. ; Yes, use logical since FASTER than a combined 33805 003303'01 242 04 0 05 000000 LSH T4,(Q1) ; Finally get the bits out of the way 33806 003304'01 434 01 0 00 000004 IOR T1,T4 ; Cons the exponent and mantissa 33807 003305'01 400 02 0 00 000000 SETZ T2, ; And nothing in the low order 33808 003306'01 254 00 0 00 003313' ELSE. ; Otherwise part of mantissa will be in low word 33809 003307'01 250 03 0 00 000004 EXCH T3,T4 ; Bum a word's worth of shifting 33810 003310'01 244 03 0 05 000000 ASHC T3,(Q1) ; Split the fraction across two words 33811 003311'01 434 01 0 00 000003 IOR T1,T3 ; Cons the exponent and high mantissa 33812 003312'01 200 02 0 00 000004 MOVE T2,T4 ; And return the low mantissa 33813 003313'01 ENDIF. ; End case of combined shift decision 33814 003313'01 ENDIF. ; End case of 27 bit (non-rounded) mantissa 33815 003313'01 254 00 0 00 003371' JRST DFLRET ; And return the value 33816 003314'01 ENDIF. ; End case of no high order mantissa 33817 ; Some kind of large number ... 33818 003314'01 326 04 0 00 003347' IFE. T4 ; Maybe no low order mantissa? 33819 003315'01 603 03 0 00 377000 TXNE T3,EXPMSK ; Would we round the high order? 33820 003316'01 254 00 0 00 003330' IFSKP. ; No, maybe we can bum the FLTR ... 33821 003317'01 607 03 0 00 000400 TXNN T3,1B9 ; If between 2,305,843,009,213,693,952 and 33822 003320'01 254 00 0 00 003324' IFSKP. ; 4,611,685,984,067,649,536, already normalized! 33823 003321'01 205 01 0 00 276000 MOVX T1,FLD(^D<128+27+35>,EXPMSK) 33824 003322'01 434 01 0 00 000003 IOR T1,T3 ; Cons the exponent and mantissa 33825 003323'01 254 00 0 00 003326' ELSE. ; Otherwise, can use plain old reliable ... 33826 003324'01 127 01 0 00 000003 FLTR T1,T3 ; and float it (slowly) 33827 003325'01 270 01 0 00 003736' ADDX T1,FLD(^D35,EXPMSK) ; However, it is a lot larger 33828 003326'01 ENDIF. ; Either way, T1 is complete 33829 003326'01 400 02 0 00 000000 SETZ T2, ; There is no low order mantissa 33830 003327'01 254 00 0 00 003346' ELSE. ; Must get some bits out of the exponent field 33831 003330'01 200 01 0 00 000003 MOVE T1,T3 ; Load the (large) integer 33832 003331'01 260 17 0 00 003376' CALL EXPSFT ; Compute shift amount to clear field 33833 003332'01 263 17 0 00 000000 RET ; Oh dear, we're ill, beat it 33834 003333'01 205 01 0 00 276000 MOVX T1,FLD(^D<128+27+35>,EXPMSK) 33835 003334'01 270 01 0 02 000000# ADD T1,BXPINC(T2) ; Load maximum unrounded and calculate shift 33836 003335'01 612 03 0 02 000000# TDNE T3,SLSHMK(T2) ; Is there enough space for a single shift 33837 003336'01 254 00 0 00 003343' IFSKP. ; Yes, use logical since FASTER than a combined 33838 003337'01 242 03 0 05 000000 LSH T3,(Q1) ; Finally get the bits out of the way 33839 003340'01 434 01 0 00 000003 IOR T1,T3 ; Cons the exponent and mantissa K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 56-2 K20TIM MAC 3-Apr-23 23:45 Routine to implement double float 33840 003341'01 400 02 0 00 000000 SETZ T2, ; And nothing in the low order 33841 003342'01 254 00 0 00 003346' ELSE. ; Otherwise part of mantissa will be in low word 33842 003343'01 244 03 0 05 000000 ASHC T3,(Q1) ; Split the fraction across two words 33843 003344'01 434 01 0 00 000003 IOR T1,T3 ; Cons the exponent and high mantissa 33844 003345'01 200 02 0 00 000004 MOVE T2,T4 ; And return the low mantissa 33845 003346'01 ENDIF. ; End case of combined shift decision 33846 003346'01 ENDIF. ; End case of 27 or less bit high order mantissa 33847 003346'01 254 00 0 00 003371' JRST DFLRET ; and return the value 33848 003347'01 ENDIF. ; End case of no low order mantissa 33849 ; Here if more than 35 significant bits 33850 003347'01 603 03 0 00 377000 TXNE T3,EXPMSK ; If we are between 2,305,843,009,213,693,952 33851 003350'01 254 00 0 00 003357' IFSKP. ; and 4,611,686,018,427,387,903 then the double 33852 003351'01 607 03 0 00 000400 TXNN T3,1B9 ; float will be trivial as the mantissa is already 33853 003352'01 254 00 0 00 003357' ANSKP. ; in the right place, 'normalized' so to speak 33854 003353'01 205 01 0 00 276000 MOVX T1,FLD(^D<128+27+35>,EXPMSK) 33855 003354'01 434 01 0 00 000003 IOR T1,T3 ; Cons the exponent and mantissa 33856 003355'01 200 02 0 00 000004 MOVE T2,T4 ; lower order fraction will not move, either 33857 003356'01 254 00 0 00 003371' JRST DFLRET ; and return the value 33858 003357'01 ENDIF. ; End case of exactly perfect double mantissa 33859 ; Finally have to do some honest work ... 33860 003357'01 332 01 0 00 000003 SKIPE T1,T3 ; Load (and check) the high order of the mantissa 33861 003360'01 243 01 0 00 003362' JFFO T1,.+2 ; Find the first significant bit 33862 003361'01 263 17 0 00 000000 RET ; Broken JFFO, we just checked T3! 33863 003362'01 337 01 0 02 000000# SKIPG T1,DWBEXP(T2) ; Load the appropriate double word binary exponent 33864 003363'01 263 17 0 00 000000 RET ; Probably an errorneous table ... 33865 003364'01 336 05 0 02 000000# SKIPN Q1,DWASHN(T2) ; Load and check the normalization shift 33866 003365'01 263 17 0 00 000000 RET ; Probably an errorneous table ... 33867 003366'01 244 03 0 05 000000 ASHC T3,(Q1) ; Otherwise normalize the double integer 33868 003367'01 434 01 0 00 000003 IOR T1,T3 ; Cons up the exponent and high order mantissa 33869 003370'01 200 02 0 00 000004 MOVE T2,T4 ; Return the properly normalized low order 33870 REMARK DFLRET ; And hit the exit code 33871 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 57 K20TIM MAC 3-Apr-23 23:45 Double floating integer conversion support 33872 SUBTTL Double floating integer conversion support 33873 33874 REMARK Common exit, converts number to negative, if necessary 33875 33876 003371'01 305 06 0 00 000000 DFLRET: CAIGE Q2,0 ; If the original was positive, then we're through 33877 003372'01 112 01 0 00 003374' DFMP T1,DFLM1 ; No, (re)negativize our result (slowly) 33878 003373'01 254 00 0 00 003077* RETSKP ; Done 33879 33880 003374'01 576400 000000 DFLM1: EXP <576400,,0>,0 ; -1 DFMP multiplicand is what DFIN% gave us 33881 33882 33883 REMARK Here to compute number of bits to shift out of exponent field 33884 33885 ; Call: 33886 ; 33887 ; T1/ Has a number with bits in the exponent field 33888 ; 33889 ; Return: 33890 ; 33891 ; +1 Something failed, T2 and Q1 indeterminate 33892 ; +2 Success 33893 ; T2/ JFFO results (first set bit) 33894 ; Q1/ Number of bits to shift to clear the field 33895 33896 003376'01 307 01 0 00 000000 EXPSFT: CAIG T1,0 ; Zero or negative? 33897 003377'01 263 17 0 00 000000 RET ; Gronk, got called with junk 33898 003400'01 607 01 0 00 377000 TXNN T1,EXPMSK ; But is there anything to be shifted out? 33899 003401'01 263 17 0 00 000000 RET ; No, we should never have been invoked 33900 003402'01 243 01 0 00 003404' JFFO T1,.+2 ; Now find out how many leading bits 33901 003403'01 263 17 0 00 000000 RET ; Broken JFFO ... 33902 003404'01 301 02 0 00 000011 CAXL T2,1+WID(EXPMSK) ; More bits than the exponent field? 33903 003405'01 263 17 0 00 000000 RET ; Already clear and we shouldn't be here 33904 003406'01 307 02 0 00 000000 CAIG T2,0 ; However, there better be at least the sign bit! 33905 003407'01 263 17 0 00 000000 RET ; Broken JFFO (negative number check) 33906 003410'01 561 05 0 00 777767 MOVX Q1,-<1+WID(EXPMSK)> ;Load maximum possible shift 33907 003411'01 270 05 0 00 000002 ADD Q1,T2 ; And calculate the shift 33908 003412'01 254 00 0 00 003373* RETSKP ; Done! 33909 33910 ;[206] End code insertion. Or transfer. Or graft. Or something... 33911 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 58 K20TIM MAC 3-Apr-23 23:45 Calculates rate assuming input mantissas of less tnen 2^27 33912 subttl Calculates rate assuming input mantissas of less tnen 2^27 33913 33914 repeat 0,< ; Vestigial, unused 33915 33916 ; Call: 33917 ; 33918 ; t2/ Elapsed TOD ticks for transfer 33919 ; t3/ Total characters sent or received 33920 ; 33921 ; Returns: 33922 ; 33923 ; t4/ Double floating raw baud rate, high order mantissa 33924 ; t5/ Ditto, low order mantissa 33925 ; 33926 ; N.B., assumes input arguments (t3 and elapsed TOD ticks) 33927 ; do not have more than a 27 bit mantissa. 33928 ; 33929 ; Note refactoring of mathmatical operations to maintain better 33930 ; precision, Also bums a double floating divide (see below), the 33931 ; slowest instruction going. Thanks to Professor Anne for the 33932 ; multiplicative identities. 33933 33934 33935 calr27: fltr t4,t3 ; Float the count 33936 setz t5, ; Whack low order 33937 dfmp t4,[exp 2621440.,0] ;Intermediate bit ticks 33938 fltr t2,t2 ; Float those, too 33939 setz t3, ; Double float, almost (see peffif, sigh) 33940 dfmp t2,[exp 86400.,0] ; Intermediate seconds 33941 dfdv t4,t2 ; Calculates bits per second 33942 ret ; Returns rate in t4,t5 33943 33944 >;;End repeat 0 33945 K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page 59 K20TIM MAC 3-Apr-23 23:45 Calculates rate assuming input mantissas of less then 2^27 33946 subttl Calculates rate assuming input mantissas of less then 2^27 33947 33948 repeat 0,< ; See numerical analysis, above 33949 33950 ; Call: 33951 ; 33952 ; t2/ Elapsed TOD ticks for transfer 33953 ; t3/ Total characters sent or received 33954 ; 33955 ; Returns: 33956 ; 33957 ; t4/ Double floating raw baud rate, high order mantissa 33958 ; t5/ Ditto, low order mantissa 33959 ; 33960 ; N.B., Assumes input arguments (t3 and elapsed TOD ticks) 33961 ; do not have more than a 27 bit mantissa. 33962 33963 calr27: fltr t4,t3 ; Float the count 33964 setz t5, ; Whack low order 33965 fltr t2,t2 ; Float elapsed ticks 33966 setz t3, ; Double float, almost (see peffif, sigh) 33967 dfmp t2,[exp 86400.,0] ; Convert to characters per second 33968 dfdv t2,[exp 262144.,0] ; Strip off TOD ticks 33969 dfdv t4,t2 ; Calculates characters per second 33970 dfmp t4,[exp 10.,0] ; Convert cps to bps 33971 ret ; Returns rate in t4,t5 33972 33973 >;;End repeat 0 33974 33975 .xcmsy ; Ditch any MACSYM junk 33976 33977 end NO ERRORS DETECTED PROGRAM BREAK IS 000000 PSECT 1 BREAK IS 003740 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 000252 FOR DATA PSECT 6 BREAK IS 004000 FOR DEVTIM CPU TIME USED 00:01.550 123P CORE USED K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page S-1 K20TIM MAC 3-Apr-23 23:45 SYMBOL TABLE ASCDEV 000000 ext N 200000 000000 spd RFSTS% 104000 000156 int .GSDMP 000017 sin ASND% 104000 000070 int NO%AST 010000 000000 sin RSKP 000000 ext .GSIMG 000010 sin BOUTI% 000000 ext NO%COL 000177 000000 sin S 400000 000000 spd .GSNRM 000000 sin CALL 260740 000000 NO%LFL 100000 000000 sin SETER% 104000 000336 int .GSSMB 000001 sin CALLRE 254000 000000 spd NO%MAG 400000 000000 sin SF%CON 400000 000000 sin .HPELP 000000 sin CFMRTN 000000 ext NO%OOV 020000 000000 sin SFORK% 104000 000157 int .INFIN 377777 777777 sin CFORK% 104000 000152 int NO%RDX 777777 sin SIN% 104000 000052 int .JSAOF 000001 sin CM%ABR 000004 sin NO%ZRO 040000 000000 sin SK%STP 100000 000000 sin .MOCC 000041 sin CM%FNC 777000 000000 sin NOIRTN 000000 ext SKED% 104000 000577 int .NPAC 000010 spd CM%FW 002000 000000 sin NOP 600000 000000 sin SOUT% 104000 000053 int .NULIO 377777 sin CM%HPP 000004 000000 sin NOUT% 104000 000224 int SOUTR% 104000 000532 int .PRIIN 000100 sin CM%INV 000001 sin NULLEN 004000 spd SPJFN% 104000 000207 int .PRIOU 000101 sin CMDER1 000000 ext NULPAG 000002 spd SYMOUT 000000 ext .PX7 610001 000000 spd CODE 000000 ext NULPGS 000003 spd T1 000001 spd .RFFPT 000003 sin CONST 000000 ext ODTIM% 104000 000220 int T2 000002 spd .RFHLT 000002 sin CR%ACS 040000 000000 sin OF%BSZ 770000 000000 sin T3 000003 spd .RFIO 000001 sin CR%MAP 400000 000000 sin OF%MOD 007400 000000 sin T4 000004 spd .RFRUN 000000 sin CR%PCV 777777 sin OF%RD 200000 sin T5 000005 spd .RFSIG 000010 sin CR%ST 020000 000000 sin OF%WR 100000 sin TEXT 000000 ext .SA15L 000006 sin CRLF 000000 ext OPENF% 104000 000021 int TIME% 104000 000014 int .SA1ML 000004 sin CX 000016 P 000017 TODTIC 000001 000000 spd .SAC 000016 DATA 000000 ext P1 000011 spd WFORK% 104000 000163 int .SACLU 000006 sin DEVORG 002000 spd P2 000012 spd XMOVEI 415000 000000 int .SACNT 000000 sin DEVTIM 000000 ext P3 000013 spd %%JSER 000000 ext .SAJCL 000002 sin DIRST% 104000 000041 int P4 000014 spd %%SMSG 000000 ext .SAJUS 000004 sin DISMS% 104000 000167 int P5 000015 spd ..MSK 777777 777777 spd .SASHR 000002 sin DKDAY 100276 770000 spd PARS1 000000 ext .A16 000016 spd .SAV1 000000 ext DTILEN 000021 spd PARS2 000000 ext .CHNUL 000000 sin .SAV2 000000 ext ERJMPR 320500 000000 int PARS3 000000 ext .CHSPC 000040 sin .SAV3 000000 ext ERJMPS 320600 000000 int PARS4 000000 ext .CMCFM 000010 sin .SKRCS 000003 sin ERSTR% 104000 000011 int PARS5 000000 ext .CMDEV 000016 sin .SKRCV 000014 sin ESOUT% 104000 000313 int PBOUT% 104000 000074 int .CMFNP 000000 sin .SKRJP 000007 sin ETEXT 000000 ext PM%ABT 000100 000000 sin .CMKEY 000000 sin .SYSTA 000014 sin FFORK% 104000 000154 int PM%CNT 400000 000000 sin .CMNUM 000001 sin .XSTKS 000000 ext GETAB 104000 000010 int PM%RD 100000 000000 sin .CMSWI 000003 sin .XTRST 000000 ext GETER% 104000 000012 int PM%RPT 777777 sin .CTTRM 777777 sin 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 MTOPR% 104000 000077 int RFRKH% 104000 000165 int .FPAC 000005 spd K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page S-2 K20TIM MAC 3-Apr-23 23:45 SYMBOL TABLE FOR PSECT CODE ADJTIM 003214' ent MILTOD 002720' $MILS 000015 000006 spd ..0633 001245' spd ASCDEV 000236' ext MS2HP 002260' $MINS 000015 000004 spd ..0641 001251' spd ASGDEV 001316' ext MYNAME 003517' 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% 002712' ext NULEPI 001572' ..0034 000020' spd ..0673 001277' spd BROKEN 000040' OVRFLW 002761' ..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 003166' 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 003036' 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 003374' PARSWI 000062' ..0306 000457' spd ..1057 001600' spd DFLOAT 003246' ent PBYTE 770000 000000 spd ..0317 000472' spd ..1065 001607' spd DFLRET 003371' 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 003500' 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 003116' 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 003412' ext ..0436 000637' spd ..1173 002102' spd EHPTIM 002370' ent SBYTE 007700 000000 spd ..0451 000706' spd ..1175 002120' spd ELAPST 002777' ent SINGDF 003066' 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 003376' TODSEC 002765' ent ..0540 001101' spd ..1223 002160' spd FINTIM 002672' ent TTYNAM 003473' 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 003155' $COPYD 000246' ..0574 001136' spd ..1240 002175' spd GTCLAS 003100' ent $COPYN 000233' ..0601 001161' spd ..1242 002236' spd INITIM 002541' ent $COPYS 000244' ..0606 001164' spd ..1243 002205' spd INITOD 002640' $DK10 000015 000007 spd ..0607 001202' spd ..1244 002206' spd LDAV 003146' 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 15:19 11-Jun-23 Page S-3 K20TIM MAC 3-Apr-23 23:45 SYMBOL TABLE FOR PSECT CODE ..1255 002223' spd ..1605 002711' spd .SAV2 000000 ext ..1256 002224' spd ..1606 002707' spd .SAV3 000000 ext ..1263 002227' spd ..1614 002726' spd .TIME 000000' int ..1264 002235' spd ..1622 002726' spd .XSTKS 003170' ext ..1271 002244' spd ..1630 002755' spd .XTRST 002370' ext ..1272 002245' spd ..1631 002756' spd ..1273 002256' spd ..1632 002757' spd ..1301 002263' spd ..1641 003025' spd ..1307 002263' spd ..1642 003031' spd ..1316 002275' spd ..1647 003024' spd ..1323 002300' spd ..1655 003031' spd ..1324 002301' spd ..1663 003107' spd ..1325 002306' spd ..1664 003113' spd ..1333 002306' spd ..1672 003135' spd ..1341 002333' spd ..1673 003141' spd ..1342 002334' spd ..1674 003142' spd ..1343 002335' spd ..1701 003162' spd ..1350 002337' spd ..1702 003165' spd ..1352 002354' spd ..1710 003204' spd ..1360 002354' spd ..1711 003210' spd ..1366 002356' spd ..1713 003217' spd ..1374 002367' spd ..1721 003226' spd ..1411 002430' spd ..1726 003230' spd ..1416 002441' spd ..1727 003236' spd ..1417 002442' spd ..1734 003237' spd ..1420 002446' spd ..1735 003251' spd ..1425 002451' spd ..1743 003251' spd ..1426 002464' spd ..1751 003256' spd ..1434 002456' spd ..1756 003261' spd ..1441 002462' spd ..1757 003314' spd ..1442 002467' spd ..1771 003274' spd ..1447 002470' spd ..1772 003313' spd ..1451 002501' spd ..1777 003271' spd ..1456 002513' spd ..2000 003272' spd ..1464 002507' spd ..2005 003307' spd ..1465 002513' spd ..2006 003313' spd ..1466 002540' spd ..2007 003347' spd ..1500 002526' spd ..2021 003330' spd ..1501 002530' spd ..2022 003346' spd ..1511 002536' spd ..2027 003324' spd ..1512 002540' spd ..2030 003326' spd ..1522 002545' spd ..2035 003343' spd ..1523 002560' spd ..2036 003346' spd ..1524 002567' spd ..2043 003357' spd ..1533 002573' spd ..IFT 000000 spd ..1534 002603' spd ..JX1 400000 000000 spd ..1535 002611' spd ..MX1 777777 777767 spd ..1544 002611' spd ..MX2 000001 spd ..1547 002625' spd ..NV 000011 spd ..1554 002632' spd ..TRR 000010 spd ..1555 002634' spd ..TX1 377000 000000 spd ..1556 002631' spd ..TX2 000001 spd ..1564 002646' spd .COPY 000125' ..1572 002646' spd .RFMAX 000011 spd ..1600 002710' spd .SAV1 003217' ext K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page S-4 K20TIM MAC 3-Apr-23 23:45 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 15:19 11-Jun-23 Page S-5 K20TIM MAC 3-Apr-23 23:45 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 15:19 11-Jun-23 Page S-6 K20TIM MAC 3-Apr-23 23:45 SYMBOL TABLE FOR PSECT DATA BOOTDD 000217' BOOTDT 000216' BOOTRM 000221' CHRCNT 000124' CHRPTR 000123' CLASS 000234' DBLCHR 000230' DBLTIC 000224' DCNAME 000032' DEVACS 000103' DEVPDL 000056' DEVSTG 000024 spd DFLCHR 000232' DFLTIC 000226' ETDAT 000147' EWALLT 000170' int GETABX 000247' KSAJUS 000251' LGETBE 000246' LSKEDE 000250' PIP2ND 000024' PIPNAM 000000' PRGSDD 000212' PRGSDT 000211' SKDBLK 000236' SKDFLG 000235' SKEDX 000245' STDAT 000126' int SYSUMS 000214' TICKPT 000223' TIMDEV 000102' int TIMPAR 000125' TSKTIM 000031' WHOAMI 000030' int K20TIM - Kermit (Virtual) Device Timing MACRO %53B(1254)-4 15:19 11-Jun-23 Page S-7 K20TIM MAC 3-Apr-23 23:45 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 15:19 11-Jun-23 Page 1 K20SRV MAC 9-Jun-23 23:24 Preliminaries 33978 title k20srv - Kermit-20 High Level Server and Associated Local Commands 33979 33980 ; Much of the server code was moved from k20mit to this module as part 33981 ; of Edit 194 to address the issue of a very large single source file 33982 ; that unexpectedly began generating MCRNEC errors. 33983 ; ; Another goal was to make the server code more robust, easier to 33984 ; maintain and add new features. If an efficiency gain was obvious, 33985 ; then it was taken. 33986 ; 33987 ; One example of robustness was an attempt to combine the semanic 33988 ; action routines of the LOCAL commands with those of the REMOTE 33989 ; commands. This allowed for easier debugging with the understanding 33990 ; that, if something works as a LOCAL command, some amount of 33991 ; confidence could be assumed for at least that part would work as a 33992 ; server command. 33993 ; 33994 ; Thus, the supporting code for the LOCAL and remote commands is also 33995 ; here. One example would be the file deleting and directory code. 33996 33997 subttl Preliminaries 33998 33999 search monsym,macsym,cmd,k20unv ;[194] 34000 cmdacs ^ ;Clean up p1-p4 definitions 34001 34002 sall ; Tidy listing 34003 .directive flblst ; We don't need to see all the ASCIZ bytes... 34004 34005 remark common parsing external data 34006 extern pars1 ; Data from first parse. 34007 extern pars2 ; Data from second parse. 34008 extern pars3 ; Data from third parse. 34009 extern pars4 ; Data from fourth parse. 34010 extern pars5 ;[41] ... 34011 extern pars6 ;[218] 34012 34013 remark ; COMND% storage from CMD 34014 extern cjfnbk ; COMND% GTJFN block (long form) 34015 extern atmbuf ; The ubiquitous atom buffer 34016 extern atmbln ; Its length 34017 34018 remark ; Packet level storage and routines 34019 extern xflg ; Sending with X header (probably will be displayed) 34020 extern gotx ; Flag for "already got an X-packet". 34021 extern gots ; Flag for "already got an S-packet". 34022 extern sinit ; Sends an "S" or "I" (initialize parameters) 34023 extern iflg ; Sending an "I" packet 34024 extern spack ; Send a packet 34025 extern spsiz ; Maximimum size packet to send 34026 extern spar ; Get the arguments from a Send-Init packet. 34027 extern sptot ; Total of sent packets 34028 extern rpack ; Receive a packet 34029 extern rpsiz ; Maximimum size packet to receive 34030 extern $sends ; Entry point of $send for server 34031 extern rpar ; Set arguments we'd like honored 34032 extern rptot ; Total of recieved packets k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 1-1 K20SRV MAC 9-Jun-23 23:24 Preliminaries 34033 extern rrinit ; Set up various variables for receiving 34034 extern $recvs ; Entry point of $recv for server 34035 extern $recvb ; Alternate entry point in $recv for server 34036 34037 extern nak ; Negative acknowledgde; bounce a packet 34038 extern nnak ; Number of NACK's sent 34039 extern pktnum ; Current packet number 34040 extern strbuf ; String buffer, used to decode data 34041 extern strptr ; Pointer into the above (also used by k20ioc) 34042 extern strbz ; Last address of combined string areas (used to zero) 34043 extern bctone ; Set if doing single character checksum 34044 extern maxdat ; Maximum length of data field 34045 extern pktacs ; Place to save RPACK/SPACK ACs. 34046 34047 remark ; Data flow routines that feed and drain packets 34048 extern source ; Routine that GETCH calls to get data 34049 extern dest ; Routine that PUTCH calls to put data 34050 remark ch ; Current character 34051 extern next ; Next character in stream 34052 34053 remark ; JFN related storage 34054 extern filjfn ; JFN of open file 34055 extern nxtjfn ; Next JFN in wildcarding 34056 extern ndxjfn ; Stepping JFN 34057 extern logjfn ; Log file JFN (if logging) 34058 extern netjfn ; Network or non-controlling TTY JFN 34059 extern ttyjfn ; JFN of local terminal (never the same as TTYJFN) 34060 34061 remark ; File related routines and storage 34062 extern decodf ; Decode a file name 34063 extern typfil ; Display a file's contents on the terminal 34064 extern typnam ; Type a file's name (special casing .nulio) 34065 extern whakfp ; Whack a mapped file page from our address space 34066 extern frclos ; Force a JFN to close 34067 extern isnulj ; Is this JFN some flavor of NUL:? 34068 extern putbuf ; Put a buffer full of data from a packet in a file 34069 extern getbuf ; Get a buffer full of data from a file for a packet 34070 extern datbuf ; Data field of the packet 34071 extern subbp ; 'subtract' two byte pointers 34072 extern filbuf ; Buffer to build a file listing entry in 34073 extern filbfz ; End of buffer marker (address) 34074 extern mxascz ; Crazy long length for moving strings 34075 extern movasc ; Routine to move ASCII bytes quickly (hopefully) 34076 34077 remark ; N.B., the next three must be in order! 34078 extern pagcnt ; .FBBYV, Number of pages in the file and byte size 34079 extern bytcnt ; .FBSIZ and byte count 34080 extern crdate ; .FBCRV and creation date (these 3 must be adjacent!) 34081 34082 remark ; Various interrupt routines and storage 34083 extern ccon ; Enable Control-C handling 34084 extern ccoff ; Shut Control-C handling off 34085 extern caxzof ; Turn file processing interrupts off 34086 extern timeit ; Begin timing an activity 34087 extern timoff ; Shut off an asynchronous timer k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 1-2 K20SRV MAC 9-Jun-23 23:24 Preliminaries 34088 extern clrcno ; Clear Control-O 34089 extern czseen ; Control-Z seen 34090 34091 remark ; Variables for local/non-local communications 34092 extern ptyflg ; Set if the 'network' is a pseudo-terminal 34093 extern ptytty ; Mapping from PTY number to TTY number 34094 extern ttynum ; Number of controlling terminal 34095 extern speed ; Speed of physical line (if we have one) 34096 extern carier ; Carrier signal if dial up, otherwise, connection status 34097 extern mdmlin ; Set if modem-controlled line (I.E., dialup) 34098 34099 remark ; Low level communications routines and variables 34100 extern inilin ; Initialize the line 34101 extern rrslin ; Reset/Restore the communications line. 34102 extern rrsl2 ; Really reset (don't allow ^C) 34103 extern ttxon ; ^Q a line, if flow control 34104 extern statim ; Start timing (a generic command) 34105 extern delay ; Time to wait in milliseconds before first send 34106 extern odelay ; What it used to be (for saving and restoring) 34107 extern ntimou ; Number of timeouts 34108 extern stimou ; Send timeout interval 34109 extern otimou ; Its previous value, if overriden by transfer 34110 extern numtry ; Number of times we'vre tried sending this packet 34111 extern maxtry ; Maximum number of times to try 34112 extern seolch ; Remote host's End of Line character 34113 34114 remark ; Low level Top-20 monitor buffer management 34115 extern clrbuf ; Clear all characters in Tops-20 buffers 34116 extern clread ; As clrbuf, but lets us see what was in there 34117 34118 remark ; Low level I/O counters 34119 extern vchrcn ;[211] Virtual characters cleared 34120 extern nsici ;[211] Network SIN% count (SIN%'s issued) 34121 extern nsitc ;[211] Network SIN% total characters 34122 extern nsimx ;[211] Network SIN% maximum length 34123 34124 remark ; Server specific routines storage 34125 extern srvflg ; If running as a server 34126 extern local ; Set if we are not remote 34127 extern srvtim ; Server command time out 34128 34129 remark ;[189] Timing routines in K20TIM 34130 extern statim ;[189] Start timing an interval 34131 extern endtim ;[189] Stop timing an interval 34132 extern elptim ;[189] Compute elapsed HPTIM% ticks 34133 34134 remark ; Error and string macro support 34135 extern errptr ; Pointer to error text 34136 extern %%jser ; Handler for %jsErr macro 34137 extern %%krms ; Same as above, but sends to remote Kermit, too 34138 extern %%smsg ; Used to get text from non-zero section 34139 extern %kerms ; Addition messages when in protocol 34140 extern %wtlog ; Write to transaction log 34141 extern scrlft ;[233] Set to -1 to suppress trailing crlf 34142 extern tlgjfn ;[233] Transaction log JFN k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 1-3 K20SRV MAC 9-Jun-23 23:24 Preliminaries 34143 extern setlog ; Open debugging log 34144 34145 remark ; Other external variables of interest 34146 extern jobtab ;[220] Our job's GETJI% 34147 extern expung ; Set if expunging files on delete 34148 extern crlf ; Carriage Return/Line Feed 34149 extern mycaps ; Capability vector double word 34150 extern capas ; Enabled process capabilities 34151 extern f$exit ; The exit flag which tells main loop to stop 34152 34153 .psect code/ronly ; Pure code, pure Heaven 34154 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 2 K20SRV MAC 9-Jun-23 23:24 Parse tables, used as a kind of table of contents 34155 subttl Parse tables, used as a kind of table of contents 34156 34157 ;N.B., When parsing for .cmtxt and .cmcfm, .cmcfm must come first!!!! 34158 34159 remark Parse table for LOCAL commands 34160 34161 000000'02 000000 000000 %table(loctab,G) ;[220] Used as a kind of table of contents 34162 000001'02 000000# 000003' %keyf3 , %cwd, 34163 000000'03 002000 000005 34164 000001'03 143 000 000 000 000 34165 000002'02 000000# 000000# %keyf4 , .ycwd, $ycwd, cm%inv 34166 000002'03 002000 000001 34167 000003'03 143 144 000 000 000 34168 000004'03 000000# 000000# 34169 000003'02 000000# 000000# %cwd: %key3 , .ycwd, $ycwd 34170 000005'03 143 167 144 000 000 34171 000006'03 000000# 000000# 34172 000004'02 000000# 000000# %key3 , .ydele, $ydele 34173 000007'03 144 145 154 145 164 34174 000011'03 000000# 000000# 34175 000005'02 000000# 000000# %key3 , .ydire, $ydire 34176 000012'03 144 151 162 145 143 34177 000014'03 000000# 000000# 34178 000006'02 000000# 000000# %key3 , .ypwd, $ypwd ;[188] ;[194] 34179 000015'03 160 167 144 000 000 34180 000016'03 000000# 000000# 34181 000007'02 000000# 000000# %key3 , .yrun, $yrun 34182 000017'03 162 165 156 000 000 34183 000020'03 000000# 000000# 34184 000010'02 000000# 000000# %key3 , .ydisk, $ydisk ;[194] 34185 000021'03 163 160 141 143 145 34186 000023'03 000000# 000000# 34187 000011'02 000000# 000015' %keyf3 , %lst, 34188 000024'03 002000 000005 34189 000025'03 163 164 000 000 000 34190 000012'02 000000# 000015' %keyf3 , %lst, 34191 000026'03 002000 000005 34192 000027'03 163 164 141 000 000 34193 000013'02 000000# 000015' %keyf3 , %lst, 34194 000030'03 002000 000005 34195 000031'03 163 164 141 164 000 34196 000014'02 000000# 000000# %keyf4 , .stat, $ysrvt, cm%inv 34197 000032'03 002000 000001 34198 000033'03 163 164 141 164 151 34199 000036'03 000000# 000000# 34200 000015'02 000000# 000000# %lst: %key3 , .stat, $ysrvt ;[189] ;[194] 34201 000037'03 163 164 141 164 165 34202 000041'03 000000# 000000# 34203 000016'02 000000# 000000# %key3 , .ytype, $ytype 34204 000042'03 164 171 160 145 000 34205 000043'03 000000# 000000# 34206 000000'02 000016 000016 %tbend 34207 34208 cleans(<%cwd,%lst>) 34209 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 2-1 K20SRV MAC 9-Jun-23 23:24 Parse tables, used as a kind of table of contents 34210 remark Parse table for REMOTE commands 34211 34212 000017'02 000000 000000 %table(remtab,G) ;[220] Moved here as a kind of table of contents 34213 000020'02 000000# 000000# %keyf4 , .bye, $bye, cm%inv ;[186] Tom can't remember.. 34214 000044'03 002000 000001 34215 000045'03 142 171 145 000 000 34216 000046'03 000000# 000000# 34217 000021'02 000000# 000000# %key3 , .xcwd, $xcwd ;[194] 34218 000047'03 143 167 144 000 000 34219 000050'03 000000# 000000# 34220 000022'02 000000# 000000# %key3 , .rmfil, $xdele ;[194] 34221 000051'03 144 145 154 145 164 34222 000053'03 000000# 000000# 34223 000023'02 000000# 000000# %key3 , .rmfil, $xdire ;[194] 34224 000054'03 144 151 162 145 143 34225 000056'03 000000# 000000# 34226 000024'02 000000# 000000# %keyf4 , .xerr, $xerr, cm%inv ;[194] 34227 000057'03 002000 000001 34228 000060'03 145 162 162 157 162 34229 000062'03 000000# 000000# 34230 000025'02 000000# 000000# %keyf4 , .finis, $finis, cm%inv ;[186] Tom can't remember.. 34231 000063'03 002000 000001 34232 000064'03 146 151 156 151 163 34233 000066'03 000000# 000000# 34234 000026'02 000000# 000000# %key3 , .xhelp, $xhelp ;[120] ;[194] 34235 000067'03 150 145 154 160 000 34236 000070'03 000000# 000000# 34237 000027'02 000000# 000000# %key3 , .xhost, $xhost ;[105] 34238 000071'03 150 157 163 164 000 34239 000072'03 000000# 000000# 34240 000030'02 000000# 000000# %key3 , .xpwd, $xpwd ;[188] ;[194] 34241 000073'03 160 167 144 000 000 34242 000074'03 000000# 000000# 34243 ;;;* %key3 , .???, $??? 34244 000031'02 000000# 000000# %key3 , .xdisk, $xdisk ;[194] 34245 000075'03 163 160 141 143 145 34246 000077'03 000000# 000000# 34247 000032'02 000000# 000036' %keyf3 , %rst, 34248 000100'03 002000 000005 34249 000101'03 163 164 000 000 000 34250 000033'02 000000# 000036' %keyf3 , %rst, 34251 000102'03 002000 000005 34252 000103'03 163 164 141 000 000 34253 000034'02 000000# 000036' %keyf3 , %rst, 34254 000104'03 002000 000005 34255 000105'03 163 164 141 164 000 34256 000035'02 000000# 000000# %keyf4 , .xstat, $xstat, cm%inv 34257 000106'03 002000 000001 34258 000107'03 163 164 141 164 151 34259 000112'03 000000# 000000# 34260 000036'02 000000# 000000# %rst: %key3 , .xstat, $xstat ;[189] ;[194] 34261 000113'03 163 164 141 164 165 34262 000115'03 000000# 000000# 34263 000037'02 000000# 000000# %key3 , .rmfil, $xtype 34264 000116'03 164 171 160 145 000 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 2-2 K20SRV MAC 9-Jun-23 23:24 Parse tables, used as a kind of table of contents 34265 000117'03 000000# 000000# 34266 000017'02 000020 000020 %tbend 34267 34268 cleans(<%rst>) 34269 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 3 K20SRV MAC 9-Jun-23 23:24 BYE command 34270 subttl BYE command 34271 34272 remark Parse the BYE command. 34273 34274 000000'01 .bye: entry .bye ; Can be invoked as top-level by k20par 34275 000000'01 200 16 0 00 000000# guide (to remote server) ; Parse rest of BYE command. 34276 000001'01 260 17 0 00 000000* 34277 000040'02 000000000000# 34278 000000'04 164 157 040 162 145 34279 000002'01 260 17 0 00 000000* confrm 34280 000003'01 263 17 0 00 000000 ret 34281 34282 remark Execute the BYE command. 34283 34284 ; N.B., Uses clread to drain the terminal buffer. However, we are 34285 ; SOUT%'ing raw eight bit data, no parity. Maybe this should be 34286 ; fixed? However, the previous code didn't do parity, either 34287 ; Maybe controlify? 34288 34289 000004'01 $bye: entry $bye ; Can be invoked as top-level by k20par 34290 000004'01 265 16 0 00 005447' saveac ;[211] Needs some additional storage 34291 000005'01 260 17 0 00 000000* call statim ;[189] Start timing so k20pdc doesn't choke 34292 dmove t1, [ ;[220] 34293 point 7, [asciz/L/] ; An "L" for the data field. 34294 000006'01 120 01 0 00 005456' "G" ] ; Packet type is G. 34295 000007'01 260 17 0 00 004327' call srvcmd ;[121] Send the command. 34296 000010'01 254 00 0 00 000050' jrst $byez ; Some error, don't exit. 34297 34298 ;[16] From here to end is part of edit 16. 34299 34300 000011'01 201 05 0 00 000005 movei q1, ^d5 ;[211] ; Waiting a total of 1.25 seconds 34301 000012'01 201 01 0 00 001750 movei t1, ^d1000 ;[211] ; Wait a second right now 34302 000013'01 104 00 0 00 000167 DISMS% 34303 34304 000014'01 do. ;[211] Enter loop context 34305 000014'01 260 17 0 00 000000* call clread ;[211] Get and clear data 34306 000015'01 254 00 0 00 000040' exit. ;[211] Unless there was an error 34307 000016'01 323 01 0 00 000034' ifg. t1 ;[211] Any goodies? 34308 000017'01 350 00 0 00 000000* aos nsici ;[211] Network SIN%'s Issued 34309 000020'01 210 03 0 00 000001 movn t3, t1 ;[211] Set up for counted SOUT% 34310 000021'01 272 03 0 00 000000* addm t3, vchrcn ;[211] Subtract from cleared 34311 000022'01 272 01 0 00 000000* addm t1, nsitc ;[211] And give them to Network SIN% 34312 000023'01 313 01 0 00 000000* camle t1, nsimx ;[211] Smaller than largest? 34313 000024'01 202 01 0 00 000023* movem t1, nsimx ;[211] Nope, have a new largest! 34314 000025'01 201 01 0 00 000101 movei t1, .priou ;[211] This terminal 34315 remark t2, ;[211] Raw 8 bit pointer! 34316 000026'01 104 00 0 00 000053 SOUT% ;[211] Type it 34317 000027'01 320 12 0 00 000031' %jserr (,) ;[211] ?? 34318 000030'01 254 00 0 00 000034' 34319 000031'01 265 01 0 00 000000* 34320 000032'01 000000 000000 34321 000033'01 254 00 0 00 000034' 34322 000034'01 endif. ;[211] End case got some data 34323 000034'01 363 05 0 00 000040' sojle q1, endlp. ;[211] Stop looking if done waiting 34324 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 15:19 11-Jun-23 Page 3-1 K20SRV MAC 9-Jun-23 23:24 BYE command 34325 000036'01 104 00 0 00 000167 DISMS% 34326 000037'01 254 00 0 00 000014' loop. ;[211] Try again 34327 000040'01 enddo. ;[211] Exit loop lexical context 34328 34329 txmsg < 34330 000040'01 200 01 0 00 000000# ...> ; Maybe there's more, but... 34331 000041'01 104 00 0 00 000076 34332 000042'01 320 12 0 00 000043' 34333 000041'02 000000000000# 34334 000004'04 015 012 056 056 056 34335 000043'01 260 17 0 00 000000* call clrbuf ;[194] can't wait forever for it, 34336 000044'01 600 00 0 00 000000 nop ;[186] ; throw the rest away. 34337 000045'01 476 00 0 00 000000* setom f$exit ;[38] Set exit flag. 34338 000046'01 260 17 0 00 000000* call endtim ;[189] Stop timing 34339 000047'01 260 17 0 00 000000* call elptim ;[189] Compute elapsed time 34340 34341 ; Error exit 34342 34343 000050'01 402 00 0 00 000045* $byez: setzm f$exit ;[70] Don't exit. 34344 000051'01 263 17 0 00 000000 ret ;[70] 34345 34346 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 4 K20SRV MAC 9-Jun-23 23:24 CWD command 34347 subttl CWD command 34348 34349 remark [137] LOCAL CWD command parsing. 34350 34351 ; Changed to only parse for a password if it is determined that we 34352 ; can't connect without one. Trying the ACESS% more than once can get 34353 ; the ACJ or monitor delay code involved. 34354 ; 34355 ; N.B., The following COMND% oddity. If you are parsing for .cmdir 34356 ; and .cmdev (as is done below) and if you are connected to one 34357 ; structure and you type only the device name of another structure 34358 ; with the same named directory, then COMND% will actually parse a 34359 ; .cmdir of that directory on the other structure! 34360 34361 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 34362 000042'02 011004 000045' ycwfdb: flddb. .cmdir,,,,,ycwfd1 34363 000043'02 000000 000000 34364 000044'02 44 07 0 00 000333' 34365 000045'02 016004 000050' ycwfd1: flddb. .cmdev,,,,,ycwfd2 34366 000046'02 000000 000000 34367 000047'02 44 07 0 00 000342' 34368 000050'02 010004 000000 ycwfd2: flddb. .cmcfm,,,,, ;[220] 34369 000051'02 000000 000000 34370 000052'02 44 07 0 00 000352' 34371 000053'02 010004 000056' ypwfdb: flddb. .cmcfm,,,,,ypwfd1 34372 000054'02 000000 000000 34373 000055'02 44 07 0 00 000362' 34374 000056'02 021004 000061' ypwfd1: flddb. .cmqst,,,,,ypwfd2 34375 000057'02 000000 000000 34376 000060'02 44 07 0 00 000371' 34377 000061'02 017004 000000 ypwfd2: flddb. .cmtxt,,,,, ;[220] 34378 000062'02 000000 000000 34379 000063'02 44 07 0 00 000371' 34380 retsec ;;Get back to wherever we came from 34381 cleans() 34382 34383 000052'01 .ycwd: entry .ycwd ; Invoked from k20par 34384 000052'01 265 16 0 00 005460' saveac ; Save some accumulators for interim parse results 34385 34386 000053'01 200 16 0 00 000000# guide ; Issue guide words. 34387 000054'01 260 17 0 00 000001* 34388 000064'02 000000000000# 34389 000006'04 164 157 040 144 151 34390 000055'01 201 01 0 00 000000# movei t1, ycwfdb ;[220] 34391 000056'01 260 17 0 00 000000* call rfield ; Parse a directory specification. 34392 000057'01 135 03 0 00 005470' ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 34393 000060'01 120 06 0 00 000002 dmove q2, t2 ;[220] Save these for downstream parsing 34394 34395 000061'01 302 07 0 00 000010 caie q3, .cmcfm ; Confirmation? 34396 000062'01 254 00 0 00 000070' ifskp. ; Yes, then use our own logged-in directory 34397 000063'01 200 02 0 00 000000# move t2, .jilno+jobtab ; number, which always works without a password 34398 000064'01 201 03 0 00 000011 movei t3, .cmdir ;[220] Lie and say we parsed a directory 34399 000065'01 124 02 0 00 000000* dmovem t2, pars3 ;[220] Pass to semantic action 34400 000066'01 402 00 0 00 000000* setzm pars5 ;[220] No password string being passed 34401 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 15:19 11-Jun-23 Page 4-1 K20SRV MAC 9-Jun-23 23:24 CWD command 34402 000070'01 endif. 34403 34404 000070'01 302 07 0 00 000016 caie q3, .cmdev ;[220] Parsed a device?? 34405 000071'01 254 00 0 00 000103' ifskp. ;[193] Yes (can't connect to DECtape) 34406 000072'01 200 01 0 00 000006 move t1, q2 ;[220] Let's check it 34407 000073'01 260 17 0 00 000000* call isnulj ;[193] Is it NUL:? 34408 000074'01 254 00 0 00 000103' anskp. ;[193] It isn't, must be some other odd thing 34409 000075'01 200 06 0 00 000001 move q2, t1 ;[220] It is, so remember that 34410 000076'01 260 17 0 00 000002* confrm ;[220] Confirm the line, do not allow .cmqst 34411 000077'01 124 06 0 00 000065* dmovem q2, pars3 ;[220] Pass both to semantic action 34412 000100'01 402 00 0 00 000066* setzm pars5 ;[220] No password string being passed 34413 000101'01 263 17 0 00 000000 ret ;[220] Done, skipping the .cmqst 34414 000102'01 254 00 0 00 000136' else. ;[220] Here if some other device 34415 000103'01 302 07 0 00 000016 caie q3, .cmdev ;[220] Are we here because of phonkey .cmdev? 34416 000104'01 254 00 0 00 000136' anskp. ;[220] No, it's a .cmdir, so that's fine 34417 000105'01 200 01 0 00 000006 move t1, q2 ;[220] Let's see if it can do files 34418 000106'01 260 17 0 00 004667' call isdird ;[220] See if this is a directory device 34419 000107'01 254 00 0 00 000114' ifskp. ;[220] It is, see what kind 34420 000110'01 135 03 0 00 005471' ldb t3,[pointr(t2,dv%typ)] ;[220] Load type 34421 000111'01 302 03 0 00 000000 caie t3, .dvdsk ;[220] Structure? 34422 000112'01 254 00 0 00 000114' anskp. ;[220] Can't connect to DECtape... 34423 000113'01 254 00 0 00 000133' else. ;[220] Not a disk based directory structure 34424 000114'01 200 01 0 00 000000# sxtext(t1,) ;[220] Initial part of error message 34425 000065'02 000000000000# 34426 000011'04 115 141 171 040 156 34427 000115'01 104 00 0 00 000313 ESOUT% ;[220] Begin whining 34428 000116'01 403 03 0 00 000004 setzb t3, t4 ;[220] Clear up some storage 34429 000117'01 561 01 0 00 000003 hrroi t1, t3 ;[220] Writing device name into registers 34430 000120'01 200 02 0 00 000006 move t2, q2 ;[220] Load device 34431 000121'01 104 00 0 00 000121 DEVST% ;[220] Write it 34432 000122'01 320 12 0 00 000124' ifje. r ;[220] Failed?? We just parsed it! 34433 000123'01 254 00 0 00 000126' 34434 000124'01 120 03 0 00 005472' dmove t3, [asciz /(error)/] ;[220] Stomp in something 34435 000125'01 254 00 0 00 000130' else. ;[220] Otherwise, worked 34436 000126'01 201 02 0 00 000072 movei t2, ":" ;[220] Load terminating device punctuation 34437 000127'01 136 02 0 00 000001 idpb t2, t1 ;[220] Take on the end, rest of word is .chnul's 34438 000130'01 endif. ;[220] End case DEVST% handling 34439 000130'01 561 01 0 00 000003 hrroi t1, t3 ;[220] Point to t3 again 34440 000131'01 104 00 0 00 000076 PSOUT% ;[220] Blat that out, too 34441 000132'01 254 00 0 00 000000* callret cmder1 ;[220] Allow a reparse, however 34442 000133'01 endif. ;[220] End case acceptable directory analysis 34443 000133'01 260 17 0 00 000163' call defdir ;[220] Try to default the directory on the structure 34444 000134'01 254 00 0 00 000132* callret cmder1 ;[220] Couldn't... Allow reparse 34445 000135'01 201 07 0 00 000011 movei q3, .cmdir ;[220] Pretend they typed the directory 34446 000136'01 endif. ;[193] End case parsed a device 34447 34448 remark .cmdir ;[220] At this point, we know the directory exists 34449 000136'01 200 01 0 00 000006 move t1, q2 ;[220] Load the directory in question 34450 000137'01 260 17 0 00 000642' call pwconp ;[220] Do we need a password to get to this? 34451 000140'01 254 00 0 00 000145' ifskp. ;[220] No, so do not parse for a quoted string 34452 000141'01 260 17 0 00 000076* confrm ;[220] Just confirm the command 34453 000142'01 124 06 0 00 000077* dmovem q2, pars3 ;[220] Pass directory and parse type to semantic action 34454 000143'01 402 00 0 00 000100* setzm pars5 ;[220] No password string being passed 34455 000144'01 263 17 0 00 000000 ret ;[220] And we're done 34456 000145'01 endif. ;[220] k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 4-2 K20SRV MAC 9-Jun-23 23:24 CWD command 34457 34458 remark ;[220] May need a password, so allow a parse for that 34459 000145'01 201 01 0 00 000000# movei t1, ypwfdb ;[220] Allow a password on the same line 34460 000146'01 260 17 0 00 000056* call rfield ;[220] See if they want the password right now 34461 000147'01 135 03 0 00 005470' ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 34462 34463 000150'01 302 03 0 00 000010 caie t3, .cmcfm ;[220] Didn't specify anything? 34464 000151'01 254 00 0 00 000155' ifskp. ;[220] Nope, so we're done with the parse 34465 000152'01 124 06 0 00 000142* dmovem q2, pars3 ;[220] Pass directory and parse type to semantic action 34466 000153'01 402 00 0 00 000143* setzm pars5 ;[220] No password string being passed 34467 000154'01 263 17 0 00 000000 ret ;[220] And get out of here 34468 000155'01 endif. ;[220] End case no string parsed 34469 34470 000155'01 260 17 0 00 000141* confrm ; Get confirmation. 34471 000156'01 124 06 0 00 000152* dmovem q2, pars3 ;[220] Pass directory and parse type to semantic action 34472 000157'01 201 01 0 00 000000* movei t1, atmbuf ;[220] Load address of the atom buffer 34473 000160'01 505 01 0 00 440700 hrli t1, () ;[220] Turn into a local pointer 34474 000161'01 202 01 0 00 000153* movem t1, pars5 ;[220] Flag that we are passing in a password 34475 000162'01 263 17 0 00 000000 ret 34476 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 5 K20SRV MAC 9-Jun-23 23:24 Vestigial Echoing code 34477 subttl Vestigial Echoing code 34478 34479 comment " ;[220] Removed because it got too hairy on a reparse 34480 ifmn. takdep ;[220] Are we in a take file? 34481 setz q5, ;[220] We are, flag that 34482 else. ;[220] Aren't; so monkey with terminal mode 34483 seto q5, ;[220] Let's assume not in a take file 34484 remark cm%wkf ;[220] Maybe tweak this? 34485 endif. 34486 34487 remark ... 34488 34489 ifn. q5 ;[220] Not in a take file? 34490 skipg t1, ttyjfn ;[220] This terminal 34491 anskp. ;[220] We don't have one, don't do this 34492 RFMOD% ;[220] Pull its mode word 34493 annje. ;[220] Punt the rest if this fails 34494 txz t2, tt%osp ;[220] Clear control-O so prompt comes out 34495 move q5, t2 ;[220] And save it 34496 txz t2, tt%eco ;[220] Turn off echoing. 34497 SFMOD% ;[220] Try doing it ... 34498 annje. ;[220] Punt the rest if this fails 34499 remark ;[220] At this point, echo is off 34500 else. ;[220] Otherwise, q5 is zero or should be 34501 setz q5, ;[220] If here because of error, disallow 34502 endif. ;[220] 34503 34504 remark ... 34505 34506 ifn. q5 ;[220] Hacking terminal modes? 34507 push p, t1 ;[220] Save temporaries around SFMOD% 34508 push p, t2 ;[220] it wants t1 and t2 34509 move t1, ttyjfn ;[220] Load terminal JFN 34510 move t2, q5 ;[220] and whatever we saved 34511 SFMOD% ;[220] Restore TTY to normal echoing. 34512 %jserr (,) ;[220] Carry on 34513 pop p, t2 ;[220] Restore temporaries SFMOD% used 34514 pop p, t1 ;[220] it wanted t1 and t2 34515 endif. ;[220] End case mode detweak 34516 34517 ";;comment k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 6 K20SRV MAC 9-Jun-23 23:24 Default a directory on a structure 34518 subttl Default a directory on a structure 34519 34520 ;[220] Begin code insertion 34521 34522 ; Largely unnecessary, as Tops-20 will do this for domestic structures. 34523 34524 000163'01 265 16 0 00 005474' defdir: saveac ; Needs two index registers 34525 000164'01 265 16 0 00 000000* anstkv (q3,dirmxw) ; Place to build the default directory 34526 000165'01 000000 000012 34527 000166'01 415 07 0 17 777765 34528 000167'01 265 16 0 00 000164* anstkv (q4,dirmxw) ; Place to put currently connected directory 34529 000170'01 000000 000012 34530 000171'01 415 10 0 17 777765 34531 34532 000172'01 201 01 0 00 000011 movx t1, ; Length of area in words 34533 000173'01 200 02 0 00 000007 move t2, q3 ; First address in area 34534 000174'01 201 03 0 02 000001 movei t3, 1(t2) ; Doing a cascade xblt 34535 000175'01 402 00 0 02 000000 setzm (t2) ; Zero first word 34536 000176'01 123 01 0 00 005506' xblt. t1 ; Clear the rest of the area 34537 34538 000177'01 560 01 0 00 000007 hrro t1, q3 ; Build Tops-20 pointer to area 34539 000200'01 200 02 0 00 000006 move t2, q2 ; Load device 34540 000201'01 104 00 0 00 000121 DEVST% ; Construct first part of defaulted directory 34541 000202'01 320 12 0 00 000204' %jserr (,r) 34542 000203'01 254 00 0 00 000207' 34543 000204'01 265 01 0 00 000031* 34544 000205'01 000000000000# 34545 000206'01 254 00 0 00 000000* 34546 000015'04 125 156 141 142 154 34547 000207'01 200 11 0 00 000001 move q5, t1 ; Save the final pointer for appending 34548 34549 000210'01 201 01 0 00 000011 movx t1, ; Length of area in words 34550 000211'01 200 02 0 00 000010 move t2, q4 ; First address in area 34551 000212'01 201 03 0 02 000001 movei t3, 1(t2) ; Doing a cascade xblt 34552 000213'01 402 00 0 02 000000 setzm (t2) ; Zero first word 34553 000214'01 123 01 0 00 005506' xblt. t1 ; Clear the rest of the area 34554 34555 000215'01 560 01 0 00 000010 hrro t1, q4 ; Build Tops-20 pointer to area 34556 000216'01 200 02 0 00 000000# move t2, .jidno+jobtab ; Load currently connected directory 34557 000217'01 104 00 0 00 000041 DIRST% ; Render as a string 34558 000220'01 320 12 0 00 000222' %jserr (,r) 34559 000221'01 254 00 0 00 000225' 34560 000222'01 265 01 0 00 000204* 34561 000223'01 000000000000# 34562 000224'01 254 00 0 00 000206* 34563 000027'04 125 156 141 142 154 34564 34565 000225'01 200 02 0 00 000010 move t2, q4 ; Load address of connected directory string 34566 000226'01 505 02 0 00 440700 hrli t2, () ; Turn into a local pointer 34567 34568 000227'01 do. ; Enter loop context to find end of device 34569 000227'01 134 03 0 00 000002 ildb t3, t2 ; Pick up a byte 34570 000230'01 306 03 0 00 000072 cain t3, ":" ; Hit the colon? 34571 000231'01 254 00 0 00 000241' exit. ; We did, break out of the loop 34572 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 15:19 11-Jun-23 Page 6-1 K20SRV MAC 9-Jun-23 23:24 Default a directory on a structure 34573 000233'01 334 01 0 00 000000# ermsg% (,r) 34574 000234'01 254 00 0 00 000240' 34575 000235'01 202 01 0 00 000000* 34576 000236'01 104 00 0 00 000313 34577 000237'01 254 00 0 00 000224* 34578 000066'02 000000000000# 34579 000041'04 113 105 122 115 111 34580 34581 000240'01 endif. ; End check 34582 000240'01 254 00 0 00 000227' loop. ; Try next character 34583 000241'01 enddo. ; End loop lexical context 34584 34585 000241'01 200 01 0 00 000011 move t1, q5 ; Load end of device 34586 34587 000242'01 do. ; Enter loop context to copy over the directory 34588 000242'01 136 03 0 00 000001 idpb t3, t1 ; Deposit into new device string 34589 000243'01 306 03 0 00 000076 cain t3, .chrpt ; Hit the right pointy bracket? 34590 000244'01 254 00 0 00 000247' exit. ; We did, so we're done 34591 000245'01 134 03 0 00 000002 ildb t3, t2 ; Pick next byte of source connected directory 34592 000246'01 254 00 0 00 000242' loop. ; Deposit it and get next byte 34593 000247'01 enddo. ; End loop lexical context 34594 34595 000247'01 400 03 0 00 000000 setz t3, ; Cons up a .chnul 34596 000250'01 136 03 0 00 000001 idpb t3, t1 ; Tie off the proposed default directory 34597 ; Now see if it exists.. 34598 000251'01 205 01 0 00 000001 movx t1, rc%emo ; Therefore, exact-match, only 34599 000252'01 560 02 0 00 000007 hrro t2, q3 ; Build Tops-20 pointer to candidate 34600 000253'01 400 03 0 00 000000 setz t3, ; Not doing any stepping, but... 34601 000254'01 104 00 0 00 000553 RCDIR% ; See if it exists 34602 000255'01 320 12 0 00 000257' %jserr (,r) 34603 000256'01 254 00 0 00 000262' 34604 000257'01 265 01 0 00 000222* 34605 000260'01 000000000000# 34606 000261'01 254 00 0 00 000237* 34607 000053'04 106 141 151 154 165 34608 000262'01 607 01 0 00 040000 ifxn. t1, rc%nom ; Doesn't exist? We surely can't connect... 34609 000263'01 254 00 0 00 000272' 34610 000264'01 560 01 0 00 000007 hrro t1, q3 ; Load pointer to our created directory 34611 000265'01 104 00 0 00 000313 ESOUT% ; Begin complaining 34612 000266'01 200 01 0 00 000000# txmsg (< does not exist, so can't be used as a default>) 34613 000267'01 104 00 0 00 000076 34614 000270'01 320 12 0 00 000271' 34615 000067'02 000000000000# 34616 000064'04 040 144 157 145 163 34617 000271'01 263 17 0 00 000000 ret ; Return +1 34618 000272'01 endif. 34619 34620 000272'01 200 06 0 00 000003 move q2, t3 ; Pretend they asked for this 34621 000273'01 254 00 0 00 000000* retskp ; Have a default 34622 34623 ;[220] End code insertion 34624 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 7 K20SRV MAC 9-Jun-23 23:24 Update GETJI% information from GJINV% 34625 subttl Update GETJI% information from GJINV% 34626 34627 ;[220] Begin code insertion 34628 34629 000274'01 udjinf: entry udjinf ; Also used by k20mit 34630 000274'01 265 16 0 00 005507' saveac ; Only side-effect storage, not accumulators 34631 34632 000275'01 104 00 0 00 000013 GJINF% ; Faster than GETJI% and always works 34633 remark t1,.jiuno+jobtab ; User number will NEVER change; no SETUID. 34634 000276'01 202 02 0 00 000000# movem t2, .jidno+jobtab ; Connected directory, which CWD changes 34635 remark t3,.jijno+jobtab ; Job number will NEVER change during execution 34636 000277'01 202 04 0 00 000000# movem t4, .jitno+jobtab ; Update current controlling terminal 34637 000300'01 263 17 0 00 000000 ret ; Always works, so return +1, always 34638 34639 ;[220] End code insertion 34640 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 8 K20SRV MAC 9-Jun-23 23:24 GETPAS -- Get a password from the terminal or file 34641 subttl GETPAS -- Get a password from the terminal or file 34642 34643 ; Call: 34644 ; 34645 ; t1/ Length of password buffer (in characters) 34646 ; t2/ Pointer to password buffer 34647 ; 34648 ; Return: 34649 ; 34650 ; +1, Some kind of failure 34651 ; +2, Got some text: 34652 ; 34653 ; t1/ Password length (in characters) 34654 ; t2/ Updated to end of password 34655 ; 34656 ; Other accumulators are unmodified 34657 ; 34658 ; Performs the following: 34659 ; 34660 ; If invoked from a TAKE file, reads the password from the file, 34661 ; using end of line as the ending delimiter. 34662 ; 34663 ; Otherwise: 34664 ; 34665 ; 1) Prompts for password, 34666 ; 2) Turns off echoing during typein, 34667 ; 3) Restores echoing 34668 ; 4) Returns with result in buffer 34669 ; 34670 ; smashes t1-t4, others preserved 34671 ; 34672 ; Partially rewritten as part of [194] for better security 34673 34674 ; In TEXT, not ETEXT because brain damaged RDTTY% can not handle the 34675 ; OWGP that PSOUT% has just typed. The RDCBP routine in COMND% only 34676 ; allows OWGP's from a non-zero section. Bogus... 34677 34678 chgsec(code,text) ;[220] Section zero text, sigh... 34679 000120'03 040 120 141 163 163 pwdprm: asciz / Password: / ;[220] Prompt for when requesting passwords 34680 retsec ;[220] Back into mainline code 34681 34682 000301'01 getpas: extern takdep, takjfn ;[194] and of our necessaries 34683 000301'01 327 01 0 00 000307' ifle. t1 ;[194] You're kidding, right? 34684 000302'01 334 01 0 00 000000# ermsg% (,r) ;[194] 34685 000303'01 254 00 0 00 000307' 34686 000304'01 202 01 0 00 000235* 34687 000305'01 104 00 0 00 000313 34688 000306'01 254 00 0 00 000261* 34689 000070'02 000000000000# 34690 000076'04 113 105 122 115 111 34691 34692 000307'01 endif. ;[194] Useless to go further 34693 ;[194] Otherwise, got a positive length 34694 000307'01 265 16 0 00 005521' saveac ;[194] 34695 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 15:19 11-Jun-23 Page 8-1 K20SRV MAC 9-Jun-23 23:24 GETPAS -- Get a password from the terminal or file 34696 000311'01 201 01 0 00 000047 movx t1, mxpwlc ;[194] Yes, clip it down 34697 000312'01 120 05 0 00 000001 dmove q1, t1 ;[194] Save the calling parameters 34698 000313'01 231 01 0 00 000005 idivi t1, ^d5 ;[194] Convert from characters to words 34699 000314'01 322 02 0 00 000316' ifn. t2 ;[194] Any remainder? 34700 000315'01 271 01 0 00 000001 addi t1, ^d1 ;[194] Yes, round up a word 34701 000316'01 endif. ;[194] 34702 000316'01 200 07 0 00 000001 move q3, t1 ;[194] Store final length 34703 000317'01 550 02 0 00 000006 hrrz t2, q2 ;[194] Load word address of password buffer 34704 000320'01 260 17 0 00 000467' call scrubp ;[194] Clobber it, first 34705 34706 000321'01 336 00 0 00 000000* ifmn. takdep ;[194] ;[178] Do specially for TAKE files 34707 000322'01 254 00 0 00 000351' 34708 000323'01 200 01 0 00 000000* move t1, takjfn ; Read line from the TAKE file 34709 000324'01 120 02 0 00 000006 dmove t2, q2 ;[194] Into buffer, clipping maximum 34710 000325'01 201 04 0 00 000012 movei t4, .CHLFD ; terminate on linefeed. 34711 000326'01 104 00 0 00 000052 SIN 34712 000327'01 320 12 0 00 000331' %jserr (,r) ;[194] 34713 000330'01 254 00 0 00 000334' 34714 000331'01 265 01 0 00 000257* 34715 000332'01 000000000000# 34716 000333'01 254 00 0 00 000306* 34717 000113'04 107 145 164 040 160 34718 000334'01 474 01 0 00 000000 seto t1, ;[194] Let's investigate the read 34719 000335'01 133 01 0 00 000002 adjbp t1, t2 ;[194] Decrement the returned byte pointer. 34720 000336'01 135 04 0 00 000001 ldb t4, t1 ;[194] Load the previous character 34721 000337'01 302 04 0 00 000015 caie t4, .chcrt ;[194] Better have been a carriage return 34722 000340'01 263 17 0 00 000000 ret ;[194] It wasn't, so fail the call 34723 000341'01 400 04 0 00 000000 setz t4, ; Write a zero over the terminating CR. 34724 000342'01 137 04 0 00 000001 dpb t4, t1 34725 000343'01 136 04 0 00 000001 idpb t4, t1 ; And linefeed. 34726 000344'01 200 01 0 00 000005 move t1, q1 ;[194] Load original length 34727 000345'01 271 03 0 00 000002 addi t3, ^d2 ;[194] Account for .chcrt and .chlfd we pitched 34728 000346'01 274 01 0 00 000003 sub t1, t3 ;[194] Subtract what we didn't read, yielding length 34729 000347'01 200 02 0 00 000006 move t2, q2 ;[194] ; Return pointer to password. 34730 000350'01 254 00 0 00 000273* retskp ;[194] ;[178] Won!! 34731 000351'01 endif. ;[194] 34732 34733 remark ;[194] Otherwise, user has to type something 34734 000351'01 201 01 0 00 000100 movei t1, .priin ; Get TTY mode word 34735 000352'01 104 00 0 00 000107 RFMOD 34736 000353'01 320 12 0 00 000355' %jserr (,r) ;[194] 34737 000354'01 254 00 0 00 000360' 34738 000355'01 265 01 0 00 000331* 34739 000356'01 000000000000# 34740 000357'01 254 00 0 00 000333* 34741 000124'04 107 145 164 040 160 34742 000360'01 621 02 0 00 400000 txz t2, tt%osp ;[194] Clear control-O so prompt comes out 34743 000361'01 202 02 0 00 000010 movem t2, q4 ;[194] And save it 34744 000362'01 620 02 0 00 004000 txz t2, tt%eco ; Turn off echoing. 34745 000363'01 104 00 0 00 000110 SFMOD 34746 000364'01 320 12 0 00 000366' %jserr (,r) ;[194] 34747 000365'01 254 00 0 00 000371' 34748 000366'01 265 01 0 00 000355* 34749 000367'01 000000000000# 34750 000370'01 254 00 0 00 000357* k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 8-2 K20SRV MAC 9-Jun-23 23:24 GETPAS -- Get a password from the terminal or file 34751 000136'04 107 145 164 040 160 34752 34753 000371'01 561 01 0 00 000000# hrroi t1, pwdprm ;[194] Issue first prompt. 34754 000372'01 104 00 0 00 000076 PSOUT 34755 000373'01 200 01 0 00 000006 move t1, q2 ;[194] Load pointer to password buffer 34756 000374'01 550 02 0 00 000005 hrrz t2, q1 ;[194] Load length of buffer 34757 000375'01 661 02 0 00 060100 txo t2, rd%bel!rd%crf!rd%sui ;[194] Break on .chcrt or .chlfd, suppress .chcrt 34758 000376'01 561 03 0 00 000000# hrroi t3, pwdprm ;[194] Prompt if ^R typed 34759 000377'01 104 00 0 00 000523 RDTTY 34760 000400'01 320 12 0 00 000402' ifje. r ;[194] Failed?? 34761 000401'01 254 00 0 00 000424' 34762 000402'01 200 04 0 00 000001 move t4, t1 ;[194] Save the error 34763 000403'01 200 01 0 00 000007 move t1, q3 ;[220] Load word length of buffer 34764 000404'01 550 02 0 00 000006 hrrz t2, q2 ;[220] Load word address of password buffer 34765 000405'01 260 17 0 00 000467' call scrubp ;[220] Ditch anything that we might have gotten 34766 000406'01 334 00 0 00 000000 %ermsg (,) ;[194] Begin complaining 34767 000407'01 254 00 0 00 000413' 34768 000410'01 265 01 0 00 000366* 34769 000411'01 000000000000# 34770 000412'01 254 00 0 00 000413' 34771 000146'04 107 145 164 040 160 34772 000413'01 201 01 0 00 000100 movei t1, .priin ;[194] Diddle primary input 34773 000414'01 200 02 0 00 000010 move t2, q4 ;[194] Load original mode word 34774 000415'01 104 00 0 00 000110 SFMOD% ;[194] Restore terminal to original mode 34775 000416'01 320 12 0 00 000420' %jserr (,) ;[194] 34776 000417'01 254 00 0 00 000423' 34777 000420'01 265 01 0 00 000410* 34778 000421'01 000000000000# 34779 000422'01 254 00 0 00 000423' 34780 000155'04 107 145 164 040 160 34781 000423'01 263 17 0 00 000000 ret ;[220] Fail the call 34782 000424'01 endif. ;[194] 34783 34784 000424'01 415 16 0 00 000441' block. ;[194] Get a stack frame 34785 000425'01 261 17 0 00 000016 34786 000426'01 265 16 0 00 005535' saveac ;[194] Preserve these over SFMOD% 34787 000427'01 201 01 0 00 000100 movei t1, .priin ;[194] Diddle primary input 34788 000430'01 200 02 0 00 000010 move t2, q4 ;[194] Load original mode word 34789 000431'01 104 00 0 00 000110 SFMOD ; Restore TTY to normal echoing. 34790 000432'01 320 12 0 00 000434' %jserr (,r) ;[194] 34791 000433'01 254 00 0 00 000437' 34792 000434'01 265 01 0 00 000420* 34793 000435'01 000000000000# 34794 000436'01 254 00 0 00 000370* 34795 000170'04 107 145 164 040 160 34796 000437'01 254 00 0 00 000350* retskp ;[194] Otherwise, worked 34797 000440'01 263 17 0 00 000000 endbk. ;[194] End of block context 34798 000441'01 600 00 0 00 000000 nop ;[220] Ignore error and carry on 34799 34800 000442'01 400 03 0 00 000000 setz t3, ;[194] Cons up a .chnul 34801 000443'01 137 03 0 00 000001 dpb t3, t1 ;[194] ; Write a zero over the terminating linefeed. 34802 000444'01 550 04 0 00 000002 hrrz t4, t2 ;[194] Pick up the remaining length 34803 000445'01 271 04 0 00 000001 addi t4, ^d1 ;[194] Account for linefeed we'll toss 34804 000446'01 274 05 0 00 000004 sub q1, t4 ;[194] Calculate length of password 34805 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 15:19 11-Jun-23 Page 8-3 K20SRV MAC 9-Jun-23 23:24 GETPAS -- Get a password from the terminal or file 34806 000450'01 510 04 0 00 000002 hllz t4, t2 ;[169] Remember flag bits that were returned. 34807 000451'01 561 01 0 00 000000* hrroi t1, crlf ;[194] Point to carriage return line feed 34808 000452'01 104 00 0 00 000076 PSOUT% ;[194] ; Echo the crlf that wasn't echoed. 34809 34810 000453'01 603 04 0 00 000040 ifxe. t4, rd%btm ;[194] Too long? 34811 000454'01 254 00 0 00 000465' 34812 000455'01 334 01 0 00 000000# ermsg% (,) ;[194] Complain 34813 000456'01 254 00 0 00 000461' 34814 000457'01 202 01 0 00 000304* 34815 000460'01 104 00 0 00 000313 34816 000071'02 000000000000# 34817 000202'04 113 105 122 115 111 34818 34819 000461'01 200 01 0 00 000007 move t1, q3 ;[220] Load word length of buffer 34820 000462'01 550 02 0 00 000006 hrrz t2, q2 ;[220] Load word address of password buffer 34821 000463'01 260 17 0 00 000467' call scrubp ;[220] Ditch anything that we might have gotten 34822 000464'01 263 17 0 00 000000 ret ;[220] Fail the call 34823 000465'01 endif. ;[194] 34824 34825 000465'01 120 01 0 00 000005 dmove t1, q1 ;[194] Load updated results 34826 000466'01 254 00 0 00 000437* retskp ;[194] And return them 34827 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 9 K20SRV MAC 9-Jun-23 23:24 Scrub the password buffer 34828 subttl Scrub the password buffer 34829 34830 ;[194] Begin code insertion 34831 34832 ; Call: 34833 ; 34834 ; t1/ Length of password buffer (in WORDS) 34835 ; t2/ Pointer to password buffer 34836 ; 34837 ; Returns: 34838 ; 34839 ; +1, always 34840 ; Stomps the buffer to all zeros, all AC's preserved 34841 34842 000467'01 323 01 0 00 000436* scrubp: jumple t1, r ; You're kidding, right? 34843 000470'01 265 16 0 00 005507' saveac ; Don't touch anything 34844 000471'01 200 04 0 02 000000 move t4, (t2) ; First of all, does the memory even exist? 34845 000472'01 320 12 0 00 000467* erjmpr r ; Nope, so nothing to scrub 34846 34847 000473'01 302 01 0 00 000001 caie t1, ^d1 ; Is the password really short? 34848 000474'01 254 00 0 00 000477' ifskp. ; Not a great idea, but easy enough to do 34849 000475'01 402 00 0 02 000000 setzm (t2) ; Scrub the buffer 34850 000476'01 263 17 0 00 000000 ret ; And we're done 34851 000477'01 endif. 34852 34853 remark ; Otherwise, doing two or more words 34854 000477'01 403 03 0 00 000004 setzb t3, t4 ; Cons up 10 .chnul's 34855 000500'01 124 03 0 02 000000 dmovem t3, (t2) ; Stomp at least that much 34856 000501'01 307 01 0 00 000002 caig t1, ^d2 ; Wanted to clear more than two words? 34857 000502'01 263 17 0 00 000000 ret ; No, then we're done 34858 34859 000503'01 275 01 0 00 000002 subi t1, ^d2 ; Account for two words cleared 34860 000504'01 415 03 0 02 000002 xmovei t3, 2(t2) ; Skip already cleared words 34861 000505'01 123 01 0 00 005506' xblt. t1 ; Clear the rest of the block 34862 000506'01 263 17 0 00 000000 ret ; Return all nice and tidy 34863 34864 ;[194] End code insertion 34865 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 10 K20SRV MAC 9-Jun-23 23:24 Execute the LOCAL CWD command. 34866 subttl Execute the LOCAL CWD command. 34867 34868 ;[171] Rewritten to only prompt for the password when necessary, as 34869 ; the Exec CONNECT command does, and to print the name of the 34870 ; directory connected to. 34871 ; 34872 ; First try to connect with no password. This returns immediately on 34873 ; error. 34874 ; 34875 ; [194] The previous sentence is no longer true; a connection attempt 34876 ; that fails will put the process to sleep so that it can not stay in 34877 ; a loop, trying passwords. Eventually, alerts will come out on the 34878 ; CTY. 34879 ; 34880 ; Thus, we try to guess whether we'll need a password with CHKAC% 34881 34882 000003 acabl==<.acjob+1> ; ACCES% argument block length 34883 34884 000507'01 $ycwd: entry $ycwd ;Invoked from k20par 34885 000507'01 265 16 0 00 005460' saveac ;[194] Used for anonymous stkvars 34886 000510'01 265 16 0 00 000167* anstkv (q1, ) ;[194] Argument block and password 34887 000511'01 000000 000013 34888 000512'01 415 05 0 17 777764 34889 000513'01 415 06 0 05 000003 xmovei q2, (q1) ;[194] Base of password buffer 34890 34891 000514'01 336 01 0 00 000156* skipn t1, pars3 ;[194] Load the directory (if there is one) 34892 000515'01 334 01 0 00 000000# ermsg% (,r) ;[194] 34893 000516'01 254 00 0 00 000522' 34894 000517'01 202 01 0 00 000457* 34895 000520'01 104 00 0 00 000313 34896 000521'01 254 00 0 00 000472* 34897 000072'02 000000000000# 34898 000211'04 113 105 122 115 111 34899 34900 000522'01 302 01 0 00 377777 caie t1, .nulio ;[193] Connecting to NUL:? 34901 000523'01 254 00 0 00 000526' ifskp. ;]193] We are, so do nothing 34902 000524'01 476 00 0 05 000000 setom .acdir(q1) ;[194] And impossible connected directory 34903 000525'01 254 00 0 00 000574' jrst $ycwdz ;[193] Continue as if we did something... 34904 000526'01 endif. ;[193] End NUL: special case 34905 000526'01 200 02 0 00 000000* move t2, pars4 ;[193] Load the parse type 34906 000527'01 306 02 0 00 000016 cain t2, .cmdev ;[193] Not a device, was it?? 34907 000530'01 254 00 0 00 000624' jrst cwdeve ;[193] Go handle a bogus connect device 34908 000531'01 400 02 0 00 000000 setz t2, ;[220] assume no password 34909 000532'01 124 01 0 05 000000 dmovem t1, .acdir(q1) ;[194] Store in block 34910 000533'01 476 00 0 05 000002 setom .acjob(q1) ;[194] Do the connect for this job 34911 34912 000534'01 336 00 0 00 000161* ifmn. pars5 ;[220] Did they already give us a password 34913 000535'01 254 00 0 00 000550' 34914 000536'01 201 01 0 00 000010 movx t1, mxpwlw ;[220] Load length of password buffer 34915 000537'01 550 02 0 00 000534* hrrz t2, pars5 ;[220] Load section local address of where it was parsed 34916 000540'01 200 03 0 00 000006 move t3, q2 ;[220] and the address of the password buffer 34917 000541'01 123 01 0 00 005506' xblt. t1 ;[220] Transfer it 34918 remark ;[220] This is wrong if the password isn't in atmbuf 34919 dmove t1, [ atmbln ;[220] Load length of atom buffer again 34920 000542'01 120 01 0 00 005545' atmbuf ] ;[220] and the address of atom buffer k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 10-1 K20SRV MAC 9-Jun-23 23:24 Execute the LOCAL CWD command. 34921 000543'01 260 17 0 00 000467' call scrubp ;[220] Scrub any password text out of it 34922 000544'01 550 02 0 00 000006 hrrz t2, q2 ;[220] Load address of password buffer 34923 000545'01 505 02 0 00 440700 hrli t2,() ;[220] Turn into a local pointer 34924 000546'01 202 02 0 05 000001 movem t2, .acpsw(q1) ;[220] Store in access argument block 34925 000547'01 254 00 0 00 000564' jrst $ycwdy ;[220] Skip access check and first attempt 34926 000550'01 endif. ;[220] End case password already specified 34927 34928 000550'01 260 17 0 00 000642' call pwconp ;[194] Can we connect without a password? 34929 000551'01 254 00 0 00 000557' jrst $ycwdx ;[194] No, go get one 34930 000552'01 200 01 0 00 005547' movx t1, ac%con!acabl ;[194] Ask for connect function,,arg block length 34931 000553'01 200 02 0 00 000005 move t2, q1 ;[194] Load address of argument block 34932 000554'01 104 00 0 00 000552 ACCES ; Try to connect. 34933 000555'01 320 12 0 00 000557' erjmpr $ycwdx ; If error, go prompt for password. 34934 000556'01 254 00 0 00 000574' jrst $ycwdz ; Connected OK, exit. 34935 34936 ; Handle error by prompting for password and then trying to connect again. 34937 34938 000557'01 120 01 0 00 005550' $ycwdx: dmove t1, [ exp mxpwlc,] ;[194] Load length and byte size 34939 000560'01 540 02 0 00 000006 hrr t2, q2 ;[194] Now have an ASCII pointer to password buffer 34940 000561'01 202 02 0 05 000001 movem t2, .acpsw(q1) ;[194] Store in access argument block 34941 000562'01 260 17 0 00 000301' call getpas ; Ask for password. 34942 000563'01 263 17 0 00 000000 ret ;[194] Return failure 34943 000564'01 200 01 0 00 005547' $ycwdy: movx t1, ac%con!acabl ;[194] Ask for connect function,,arg block length 34944 000565'01 200 02 0 00 000005 move t2, q1 ;[194] Load address of argument block 34945 000566'01 104 00 0 00 000552 ACCES ;[194] Failure here will trigger a wait 34946 000567'01 320 12 0 00 000571' %jserr (,) ;[194] On failure, whine and continue 34947 000570'01 254 00 0 00 000574' 34948 000571'01 265 01 0 00 000434* 34949 000572'01 000000000000# 34950 000573'01 254 00 0 00 000574' 34951 000225'04 103 127 104 040 146 34952 34953 ; At this point, done either way, whether succeeded or not 34954 34955 000574'01 201 01 0 00 000010 $ycwdz: movx t1, mxpwlw ;[194] Load maximum password length, words 34956 000575'01 200 02 0 00 000006 move t2, q2 ;[194] Load address of password buffer 34957 000576'01 260 17 0 00 000467' call scrubp ;[194] Scrub any password text out of it 34958 34959 000577'01 201 01 0 00 000133 movei t1, "[" ;[194] Begin message 34960 000600'01 104 00 0 00 000074 PBOUT ;[194] 34961 000601'01 104 00 0 00 000013 GJINF% ;[194] Get job information 34962 000602'01 202 02 0 00 000000# movem t2, jobtab+.jidno ;[194] Remember for future reference. 34963 000603'01 312 02 0 05 000000 came t2, .acdir(q1) ;[194] Did we go where we wanted? 34964 000604'01 254 00 0 00 000611' ifskp. ;[194] Yes, advise of such 34965 000605'01 200 01 0 00 000000# txmsg ;[194] Print what we're connected to. 34966 000606'01 104 00 0 00 000076 34967 000607'01 320 12 0 00 000610' 34968 000073'02 000000000000# 34969 000232'04 103 157 156 156 145 34970 000610'01 254 00 0 00 000614' else. ;[194] Otherwise, say nothing happened 34971 000611'01 200 01 0 00 000000# txmsg ;[194] 34972 000612'01 104 00 0 00 000076 34973 000613'01 320 12 0 00 000614' 34974 000074'02 000000000000# 34975 000235'04 122 145 155 141 151 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 10-2 K20SRV MAC 9-Jun-23 23:24 Execute the LOCAL CWD command. 34976 000614'01 endif. ;[194] 34977 000614'01 201 01 0 00 000101 movei t1, .priou 34978 000615'01 104 00 0 00 000041 DIRST 34979 000616'01 320 12 0 00 000617' erjmpr .+1 ;[194] 34980 000617'01 201 01 0 00 000135 movei t1, "]" 34981 000620'01 104 00 0 00 000074 PBOUT 34982 000621'01 561 01 0 00 000451* hrroi t1, crlf ;[194] Tie off the line 34983 000622'01 104 00 0 00 000076 PSOUT% ;[194] 34984 000623'01 263 17 0 00 000000 ret 34985 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 11 K20SRV MAC 9-Jun-23 23:24 Here to handle some bogus connect device 34986 subttl Here to handle some bogus connect device 34987 34988 ; t1/ device designator 34989 ; t2/ parsed function code 34990 34991 000624'01 200 02 0 00 000001 cwdeve: move t2, t1 ;[193] Save device designator 34992 000625'01 403 03 0 00 000004 setzb t3, t4 ;[193] Cons up ten nulls 34993 000626'01 124 03 0 06 000000 dmovem t3, (q2) ;[193] Scrub the buffer 34994 000627'01 561 01 0 06 000000 hrroi t1, (q2) ;[193] Point to buffer 34995 000630'01 104 00 0 00 000121 DEVST% ;[193] Convert devie to a string 34996 000631'01 320 14 0 00 000632' erjmps .+1 ;[193] Catch and suppress error 34997 000632'01 561 01 0 06 000000 hrroi t1, (q2) ;[193] Point to buffer 34998 000633'01 104 00 0 00 000313 ESOUT% ;[194] Begin blatting at user 34999 000634'01 320 12 0 00 000635' erjmpr .+1 ;[194] Catch and ignore error 35000 txmsg <: is not a file structure, so can't connect to it. 35001 000635'01 200 01 0 00 000000# > ;[193] Rest of the blat 35002 000636'01 104 00 0 00 000076 35003 000637'01 320 12 0 00 000640' 35004 000075'02 000000000000# 35005 000242'04 072 040 151 163 040 35006 35007 000640'01 124 03 0 06 000000 dmovem t3,(q2) ;[193] Scrub again 35008 000641'01 263 17 0 00 000000 ret ;[193] Return from failure 35009 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 12 K20SRV MAC 9-Jun-23 23:24 Can we do a passwordless connect to a directory? 35010 subttl Can we do a passwordless connect to a directory? 35011 35012 ;[194] Begin code insertion 35013 ; 35014 ; Call: 35015 ; 35016 ; t1/ Directory (number) to connect to 35017 ; 35018 ; Return: 35019 ; 35020 ; +1, t1/ Has a zero if can't connect 35021 ; t2/ Zero if CHKAC% succeed or last error 35022 ; t1/ Has last error code if we failed the CHKAC% 35023 ; 35024 ; +2, t1/ Negative one 35025 ; t2/ Zero 35026 ; 35027 ; Smashes t1-t4 35028 35029 000642'01 265 16 0 00 000510* pwconp: anstkv(t4,<.ckapr+1>) ; Allocate an argument block 35030 000643'01 000000 000006 35031 000644'01 415 04 0 17 777771 35032 35033 000645'01 474 02 0 00 000000 seto t2, ; Request complete file access (everything) 35034 000646'01 124 01 0 04 000004 dmovem t1, .ckaud(t4) ; Store with directory number in argument block 35035 000647'01 200 01 0 00 000000# move t1, jobtab+.jidno ; Load currently connected directory 35036 000650'01 200 02 0 00 000000# move t2, mycaps+1 ; Load my enabled capabilities 35037 000651'01 124 01 0 04 000002 dmovem t1, .ckacd(t4) ; Store in argument block 35038 000652'01 201 01 0 00 000010 movx t1, .ckacn ; Checking for connect access 35039 000653'01 200 02 0 00 000000# move t2, jobtab+.jiuno ; Load my login user number 35040 000654'01 124 01 0 04 000000 dmovem t1, .ckaac(t4) ; Store in argument block 35041 35042 000655'01 201 01 0 00 000006 movx t1, <.ckapr+1> ; Load length of block 35043 000656'01 200 02 0 00 000004 move t2, t4 ; Load address of block 35044 000657'01 104 00 0 00 000521 CHKAC% ; See if we can do anything 35045 000660'01 320 12 0 00 000662' ifje. r ; Failed?? 35046 000661'01 254 00 0 00 000665' 35047 000662'01 200 02 0 00 000001 move t2, t1 ; Return the error 35048 000663'01 400 01 0 00 000000 setz t1, ; Say we can't access it 35049 000664'01 254 00 0 00 000666' else. ; Otherwise, JSYS worked 35050 000665'01 400 02 0 00 000000 setz t2, ; In which case there is no error code 35051 000666'01 endif. 35052 35053 000666'01 322 01 0 00 000521* jumpe t1, r ; If zero, then return +1 35054 000667'01 254 00 0 00 000466* retskp ; Otherwise, won!! 35055 35056 ;[194] End code insertion 35057 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 13 K20SRV MAC 9-Jun-23 23:24 REMOTE CWD Parsing 35058 subttl REMOTE CWD Parsing 35059 35060 ;[106] Parsing and execution all for Edit 106 35061 35062 ;N.B., all the extra scrubbing being done here is to try to enhance 35063 ; security by getting rid of any password remnants. 35064 35065 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 35066 000076'02 010004 000101' xcwfdb: flddb. .cmcfm,,,,,xcwfd1 35067 000077'02 000000 000000 35068 000100'02 44 07 0 00 000400' 35069 000101'02 021004 000104' xcwfd1: flddb. .cmqst,,,,,xcwfd2 35070 000102'02 000000 000000 35071 000103'02 44 07 0 00 000410' 35072 000104'02 017004 000000 xcwfd2: flddb. .cmtxt,,,,, 35073 000105'02 000000 000000 35074 000106'02 44 07 0 00 000410' 35075 000107'02 010004 000112' xpwfdb: flddb. .cmcfm,,,,,xpwfd1 35076 000110'02 000000 000000 35077 000111'02 44 07 0 00 000416' 35078 000112'02 021004 000115' xpwfd1: flddb. .cmqst,,,,,xpwfd2 35079 000113'02 000000 000000 35080 000114'02 44 07 0 00 000425' 35081 000115'02 017004 000000 xpwfd2: flddb. .cmtxt,,,,, 35082 000116'02 000000 000000 35083 000117'02 44 07 0 00 000425' 35084 retsec ;;Get back to wherever we came from 35085 cleans() 35086 35087 000670'01 .xcwd: entry .xcwd ;[220] Invoked by k20par 35088 000670'01 265 16 0 00 005552' saveac ;[220] Necessary for intermediate parse results 35089 35090 remark ;[220] Note, these lengths are for foreign directories 35091 000671'01 120 01 0 00 005564' dmove t1, [exp fdrmxw,dirbuf] 35092 000672'01 260 17 0 00 000467' call scrubp ;[194] Scrub the directory buffer 35093 000673'01 120 01 0 00 005566' dmove t1, [exp fpwmxw,pasbuf] 35094 000674'01 260 17 0 00 000467' call scrubp ;[194] Scrub the password buffer 35095 35096 remark ;[220] First get directory, if specified 35097 000675'01 200 16 0 00 000000# guide ; Issue guide words. 35098 000676'01 260 17 0 00 000054* 35099 000120'02 000000000000# 35100 000255'04 164 157 040 144 151 35101 000677'01 201 01 0 00 000000# movei t1, xcwfdb ;[220] Allow a quote of the remote directory 35102 000700'01 260 17 0 00 000146* call rfield ;[220] Parse something 35103 000701'01 120 05 0 00 000001 dmove q1, t1 ;[220] Store parse results 35104 000702'01 135 07 0 00 005470' ldb q3, [pointr (.cmfnp(t3),cm%fnc)] ;[220] Get function code 35105 000703'01 306 07 0 00 000010 cain q3, .cmcfm ;[220] Was it a confirm? 35106 000704'01 263 17 0 00 000000 ret ;[220] It was, so taking default (with no password) 35107 35108 remark ;[220] BUT!! Did they type anything?? 35109 000705'01 200 02 0 00 005570' move t2, [point 7, atmbuf] ;[220] Let's see what they did 35110 000706'01 134 01 0 00 000002 ildb t1, t2 ;[220] Pick up the first byte 35111 000707'01 326 01 0 00 000712' ife. t1 ;[220] They didn't, so still using default area 35112 000710'01 260 17 0 00 000155* confrm ;[220] Line needs to be confirmed, however k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 13-1 K20SRV MAC 9-Jun-23 23:24 REMOTE CWD Parsing 35113 000711'01 263 17 0 00 000000 ret ;[220] We're done; not sending a directory 35114 000712'01 endif. ;[220] or its related password 35115 35116 000712'01 201 01 0 00 000141 movx t1, fdrmxw ;[220] Load maximum length of foreign directory 35117 dmove t2, [ atmbuf ;[220] Source is atom buffer 35118 000713'01 120 02 0 00 005571' dirbuf ] ;[220] Destination is foreign 35119 000714'01 123 01 0 00 005506' xblt. t1 ;[220] Store for semantic action 35120 000715'01 201 01 0 00 000000# movei t1, dirbuf ;[220] Load address of foreign directory 35121 000716'01 505 01 0 00 440700 hrli t1,() ;[220] Turn into a local pointer 35122 000717'01 202 01 0 00 000514* movem t1, pars3 ;[220] Store for semantic action 35123 35124 remark ;[220] Second, get password, one way or another 35125 ;;;; remark shut off echoing here like exec? 35126 000720'01 201 01 0 00 000000# movei t1, xpwfdb ;[220] Allow a quote of the remote directory 35127 000721'01 260 17 0 00 000700* call rfield ;[220] Parse something 35128 000722'01 120 05 0 00 000001 dmove q1, t1 ;[220] Store parse results 35129 000723'01 135 07 0 00 005470' ldb q3, [pointr (.cmfnp(t3),cm%fnc)] ;[220] Get function code 35130 ;;;; remark turn back on, but only if not in take file 35131 35132 000724'01 306 07 0 00 000010 cain q3, .cmcfm ;[220] Was it a confirm? 35133 000725'01 254 00 0 00 000743' jrst .xcwd1 ;[220] It was, so specifying password on next line 35134 35135 remark ;[220] BUT!! Did they type anything?? 35136 000726'01 200 02 0 00 005570' move t2, [point 7, atmbuf] ;[220] Let's see what they did 35137 000727'01 134 01 0 00 000002 ildb t1, t2 ;[220] Pick up the first byte 35138 000730'01 326 01 0 00 000733' ife. t1 ;[220] Did they do a "" for no password? 35139 000731'01 260 17 0 00 000710* confrm ;[220] They did; still needs to be confirmed 35140 000732'01 263 17 0 00 000000 ret ;[220] Leave, explicitly not sending a password 35141 000733'01 endif. 35142 35143 remark ;[220] Otherwise, nearly done 35144 000733'01 260 17 0 00 000731* confrm ;[220] Confirm before copying sensitive data 35145 000734'01 201 01 0 00 000141 movx t1, fpwmxw ;[220] Load maximum length of foreign password 35146 dmove t2, [ atmbuf ;[220] Source is atom buffer 35147 000735'01 120 02 0 00 005573' pasbuf ] ;[220] Destination is foreign password 35148 000736'01 123 01 0 00 005506' xblt. t1 ;[220] Store for semantic action 35149 000737'01 201 01 0 00 000000# movei t1, pasbuf ;[220] Load address of foreign password 35150 000740'01 505 01 0 00 440700 hrli t1,() ;[220] Turn into a local pointer 35151 000741'01 202 01 0 00 000526* movem t1, pars4 ;[220] Store for semantic action 35152 000742'01 263 17 0 00 000000 ret ;[220] Successfully completed parse 35153 35154 000743'01 .xcwd1: dmove t1, [ ;[220] No, they did not 35155 mxpwlc ;[220] Maximum password length in words 35156 000743'01 120 01 0 00 005575' point 7,pasbuf ] ;[220] Point to password buffer 35157 000744'01 260 17 0 00 000301' call getpas ;[220] Ask for a password. 35158 000745'01 254 00 0 00 000134* jrst cmder1 ;[220] Handle like a parse error, do not do semantics 35159 000746'01 200 01 0 00 005577' move t1,[point 7,pasbuf];[220] Point to password buffer 35160 000747'01 202 01 0 00 000741* movem t1, pars4 ;[220] Save pointer to it. 35161 000750'01 263 17 0 00 000000 ret ;[220] Done 35162 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 14 K20SRV MAC 9-Jun-23 23:24 REMOTE CWD Execution 35163 subttl REMOTE CWD Execution 35164 35165 000751'01 $xcwd: extern strbuf, strptr ; Defined in k20mit 35166 000751'01 260 17 0 00 000005* call statim ;[189] Start timing so k20pdc doesn't choke 35167 35168 000752'01 403 01 0 00 000002 setzb t1, t2 ;[220] Cons up some .chnul's 35169 000753'01 124 01 0 00 000000* dmovem t1, strbuf ;[220] Zero out old stuff 35170 000754'01 124 01 0 00 000000# dmovem t1, strbuf+2 ;[220] and a bit more of it 35171 000755'01 200 02 0 00 005600' move t2, [ point 7, strbuf ] ;[220] Point to string buffer 35172 000756'01 202 02 0 00 000000* movem t2, strptr ;[220] Save current location 35173 35174 000757'01 201 04 0 00 000103 movei t4, "C" ; CWD generic command letter 35175 000760'01 136 04 0 00 000002 idpb t4, t2 ;[220] First character of data 35176 000761'01 133 00 0 00 000002 ibp t2 ; Leave room for length. 35177 35178 000762'01 332 01 0 00 000717* skipe t1, pars3 ;[220] But!! Did they specify a directory? 35179 000763'01 254 00 0 00 000772' ifskp. ;[220] They did not, we're done 35180 dmove t3, [ ;[220] Force zero length data area 35181 .chspc ;[220] Space is ASCII for zero length 35182 000764'01 120 03 0 00 005601' point 7,strbuf,13 ] ;[220] Point to second character in packet 35183 000765'01 137 03 0 00 000004 dpb t3, t4 ;[220] Deposit count at head of field. 35184 000766'01 200 01 0 00 000756* move t1, strptr ;[220] Point to beginning of packet (before "C") 35185 000767'01 201 02 0 00 000107 movei t2, "G" ;[220] Packet type is generic 35186 000770'01 254 00 0 00 004601' callret dosrv ;[220] Go send it, handle the reply and return 35187 000771'01 254 00 0 00 000773' else. ;[220] Otherwise, have a directory to copy 35188 000772'01 400 03 0 00 000000 setz t3, ;[220] Initialize counter 35189 000773'01 endif. ;[220] End case default area 35190 35191 000773'01 do. ; Enter loop context to copy directory 35192 000773'01 134 04 0 00 000001 ildb t4, t1 ; Pick up a byte of the directory 35193 000774'01 322 04 0 00 000777' jumpe t4, endlp. ; Stop at the end of the string 35194 000775'01 136 04 0 00 000002 idpb t4, t2 ; Deposit it in string buffer 35195 000776'01 344 03 0 00 000773' aoja t3, top. ; Get some more bytes, weee!! 35196 000777'01 enddo. ; End of loop context 35197 35198 ; Note that lengths here apply to UNPREFIXED values. If a length 35199 ; turns out to be the same as a prefix character, it will be quoted 35200 ; itself. 35201 35202 000777'01 200 04 0 00 005602' move t4, [point 7, strbuf, 13] ; Deposit count at head of field. 35203 001000'01 271 03 0 00 000040 addi t3, 40 ; Make it printable. 35204 001001'01 137 03 0 00 000004 dpb t3, t4 35205 35206 001002'01 336 00 0 00 000747* ifmn. pars4 ; Got a password too? 35207 001003'01 254 00 0 00 001017' 35208 001004'01 202 02 0 00 000766* movem t2, strptr ; Yes. Save current pointer. 35209 001005'01 133 00 0 00 000002 ibp t2 ; Save a place for length of this field. 35210 001006'01 400 03 0 00 000000 setz t3, ; Reset counter for new field. 35211 001007'01 200 01 0 00 001002* move t1, pars4 ; Load pointer to password 35212 001010'01 do. ; Enter loop context to copy that over 35213 001010'01 134 04 0 00 000001 ildb t4, t1 ; Get a character from the password 35214 001011'01 322 04 0 00 001014' jumpe t4, endlp. ; If zero, done. 35215 001012'01 136 04 0 00 000002 idpb t4, t2 ; Append it 35216 001013'01 344 03 0 00 001010' aoja t3, top. ; Count it & loop. 35217 001014'01 enddo. ; End loop context k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 14-1 K20SRV MAC 9-Jun-23 23:24 REMOTE CWD Execution 35218 001014'01 136 04 0 00 000002 idpb t4, t2 ; Make it asciz. 35219 001015'01 271 03 0 00 000040 addi t3, 40 ; Make count printable. 35220 001016'01 136 03 0 00 001004* idpb t3, strptr ; Deposit it at head of field. 35221 001017'01 endif. ; End case password supplied 35222 ; Point to completed buffer 35223 dmove t1, [ point 7, strbuf 35224 001017'01 120 01 0 00 005603' "G" ] ; Packet type is H. 35225 001020'01 254 00 0 00 004601' jrst dosrv ; Go send it and handle the reply. 35226 35227 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 15 K20SRV MAC 9-Jun-23 23:24 LOCAL DELETE parsing 35228 subttl LOCAL DELETE parsing 35229 35230 chgsec(code,const) ;;Parsing and tables go in constants 35231 000121'02 100120 777775 delbk: gj%old!gj%ifg!gj%flg!.gjall ; Flag bits,,generation number. 35232 000122'02 000100 000101 .priin,,.priou ; COMND i/o. 35233 repeat 6,<0> ; No defaults, except all generations. 35234 000123'02 000000 000000 35235 000124'02 000000 000000 35236 000125'02 000000 000000 35237 000126'02 000000 000000 35238 000127'02 000000 000000 35239 000130'02 000000 000000 35240 000010 delbkl==<.-delbk> ; Length of this GTJFN argument block. 35241 35242 000131'02 006000 000000 ydefdb: flddb. .cmfil 35243 000132'02 000000 000000 35244 retsec 35245 35246 001021'01 .ydele: entry .ydele ; Invoked from k20par 35247 001021'01 200 01 0 00 005605' movx t1, cz%ncl!.fhslf ; Close any nonopen JFNs. 35248 001022'01 104 00 0 00 000034 CLZFF 35249 001023'01 200 16 0 00 000000# guide ; Issue guide words. 35250 001024'01 260 17 0 00 000676* 35251 000133'02 000000000000# 35252 000260'04 146 151 154 145 163 35253 001025'01 200 01 0 00 005606' move t1, [delbk,,cjfnbk] ; Insert our file parsing defaults. 35254 001026'01 251 01 0 00 000000# blt t1, cjfnbk+delbkl 35255 001027'01 201 01 0 00 000000# movei t1, ydefdb 35256 001030'01 260 17 0 00 000000* call cfield 35257 001031'01 202 02 0 00 000762* movem t2, pars3 ; Here's the JFN just parsed. 35258 001032'01 550 01 0 00 000002 hrrz t1,t2 ;[193] Load the JFN, sans flags 35259 001033'01 260 17 0 00 000073* call isnulj ;[193] Is this NUL:? 35260 001034'01 254 00 0 00 001037' ifskp. ;[193] Yes, so let's fix up the parse 35261 001035'01 202 01 0 00 001031* movem t1, pars3 ;[193] Store the .nulio in there 35262 001036'01 200 02 0 00 000001 move t2,t1 ;[193] Leave for anybody downstream 35263 001037'01 endif. ;[193] 35264 001037'01 263 17 0 00 000000 ret 35265 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 16 K20SRV MAC 9-Jun-23 23:24 [113] LOCAL DELETE execution 35266 subttl [113] LOCAL DELETE execution 35267 35268 001040'01 $ydele: entry $ydele ; Invoked from k20par 35269 35270 extern ffunc ; File function being performed 35271 001040'01 550 01 0 00 001035* hrrz t1, pars3 ; Load parsed JFN 35272 001041'01 260 17 0 00 004667' call isdird ;[193] Is this a directory device? 35273 001042'01 254 00 0 00 001055' ifskp. ;[193] If worked, proceed 35274 001043'01 201 02 0 00 005177' movei t2, delfil ; Address of delete-file code. 35275 001044'01 202 02 0 00 000000* movem t2, ffunc ; Make it the file function. 35276 001045'01 332 00 0 00 000000* ifme. expung ;[199] Can only speed up the non-expunge case 35277 001046'01 254 00 0 00 001053' 35278 001047'01 200 01 0 00 001040* move t1, pars3 ;[199] Reload the parsed JFN with flags 35279 001050'01 260 17 0 00 005120' call ffjfgd ;[199] Fix file JFN for fast generational delete 35280 001051'01 254 00 0 00 001334' callret $ydir1 ;[199] Failed or exact generation; do each file by hand 35281 001052'01 202 01 0 00 001047* movem t1, pars3 ;[199] Store the updated JFN with flags 35282 001053'01 endif. ;[199] End case not expunging 35283 001053'01 254 00 0 00 001334' callret $ydir1 ; Go do it like a directory. 35284 001054'01 254 00 0 00 001111' else. ;[193] Otherwise, not a directory device (or failed) 35285 001055'01 265 16 0 00 000642* anstkv (t4,^d4) ;[193] Allocate an anonymous stack variable 35286 001056'01 000000 000004 35287 001057'01 415 04 0 17 777773 35288 001060'01 200 02 0 00 000001 move t2, t1 ;[193] Save the device designator 35289 001061'01 560 01 0 00 000004 hrro t1, t4 ;[193] Create pointer to stack space 35290 001062'01 104 00 0 00 000121 DEVST% ;[193] Convert to a string 35291 001063'01 320 12 0 00 001065' ifje. r ;[193] Failed?? 35292 001064'01 254 00 0 00 001070' 35293 001065'01 200 03 0 00 000001 move t3, t1 ;[193] Save error for debugger 35294 001066'01 561 04 0 00 001111' hrroi t4, badevc ;[193] Load a default 35295 001067'01 254 00 0 00 001074' else. ;[193] Otherwise, we have a good device 35296 001070'01 120 02 0 00 005607' dmove t2, [exp ":", .chnul] ;[193] 35297 001071'01 136 02 0 00 000001 idpb t2, t1 ;[193] Punctuate device 35298 001072'01 136 03 0 00 000001 idpb t3, t1 ;[193] Tie off the string 35299 001073'01 661 04 0 00 777777 tlo t4, -1 ;[193] So turn it into a pointer 35300 001074'01 endif. ;[193] End case DEVST% error handling 35301 001074'01 200 01 0 00 000004 move t1, t4 ;[193] Load pointer to something 35302 001075'01 104 00 0 00 000313 ESOUT% ;[193] Start complaining 35303 001076'01 200 01 0 00 000000# txmsg < has no directory to delete files from> ;[193] 35304 001077'01 104 00 0 00 000076 35305 001100'01 320 12 0 00 001101' 35306 000134'02 000000000000# 35307 000262'04 040 150 141 163 040 35308 001101'01 561 01 0 00 000621* hrroi t1, crlf ;[193] Newline 35309 001102'01 104 00 0 00 000076 PSOUT% ;[193] 35310 001103'01 400 01 0 00 000000 setz t1, ;[193] Cons up a zero 35311 001104'01 250 01 0 00 001052* exch t1, pars3 ;[193] Get and clear parsed JFN 35312 001105'01 621 01 0 00 777777 tlz t1, -1 ;[193] Clear any goofy flags 35313 001106'01 104 00 0 00 000023 RLJFN% ;[193] Punt it 35314 001107'01 320 12 0 00 001110' erjmpr .+1 ;[193] Catch and ignore error 35315 001110'01 263 17 0 00 000000 ret ;[193] And get out of here 35316 001111'01 endif. ;[193] End case device check 35317 35318 001111'01 125 156 153 156 157 badevc: asciz "Unknown device" 35319 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 17 K20SRV MAC 9-Jun-23 23:24 REMOTE DELETE, DIRECTORY, TYPE parsing 35320 subttl REMOTE DELETE, DIRECTORY, TYPE parsing 35321 35322 chgsec(code,const) ;;Chained FDB's are not in code, they're in const 35323 000135'02 021004 000140' rmffdb: flddb. .cmqst,,,,,rmffd1 35324 000136'02 000000 000000 35325 000137'02 44 07 0 00 000431' 35326 000140'02 017004 000000 rmffd1: flddb. .cmtxt,,,,, 35327 000141'02 000000 000000 35328 000142'02 44 07 0 00 000431' 35329 retsec 35330 cleans() 35331 35332 001114'01 200 16 0 00 000000# .rmfil: guide ; Parse the rest of the command. 35333 001115'01 260 17 0 00 001024* 35334 000143'02 000000000000# 35335 000272'04 162 145 155 157 164 35336 001116'01 201 01 0 00 000000# movei t1, rmffdb ;[220] Allow a quote of the remote file specification 35337 001117'01 260 17 0 00 001030* call cfield 35338 001120'01 263 17 0 00 000000 ret 35339 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 18 K20SRV MAC 9-Jun-23 23:24 REMOTE DELETE (Erase) execution 35340 subttl REMOTE DELETE (Erase) execution 35341 35342 001121'01 336 00 0 00 000000* $xdele: ifmn. tlgjfn ;[233] Doing transaction logging? 35343 001122'01 254 00 0 00 001144' 35344 001123'01 415 16 0 00 001144' block. ;[233] Get a stack frame 35345 001124'01 261 17 0 00 000016 35346 001125'01 265 16 0 00 005507' saveac ;[233] Save even the temporaries 35347 001126'01 476 00 0 00 000000* setom scrlft ;[233] Suppress the trailing line feed 35348 001127'01 265 01 0 00 000000* wtlog(,) ;[233] 35349 001130'01 000000000000# 35350 001131'01 777777 777743 35351 001132'01 000000 000000 35352 000275'04 122 145 161 165 145 35353 001133'01 200 01 0 00 001121* move t1, tlgjfn ;[233] Put the file name name in the log 35354 001134'01 561 02 0 00 000157* hrroi t2,atmbuf ;[233] It's in the atom buffer 35355 001135'01 403 03 0 00 000004 setzb t3,t4 ;[233] Don't know how long, stop on a NUL 35356 001136'01 104 00 0 00 000053 SOUT% ;[233] Out it goes! 35357 001137'01 320 14 0 00 001140' erjmps .+1 ;[233] Catch and suppress error 35358 dmove t2,[ -1,,crlf ;[233] Tops-20 pointer to carriage return line feed 35359 001140'01 120 02 0 00 005611' -2 ] ;[233] Counted SOUT%'s are faster 35360 001141'01 104 00 0 00 000053 SOUT% ;[233] Out it goes! 35361 001142'01 320 14 0 00 001143' erjmps .+1 ;[233] Catch and suppress error 35362 001143'01 263 17 0 00 000000 endbk. ;[233] Release stack frame, restoring AC's 35363 001144'01 endif. ;[233] 35364 35365 001144'01 260 17 0 00 000751* call statim ;[189] Start timing so k20pdc doesn't choke 35366 001145'01 201 04 0 00 000105 movei t4, "E" ; Generic command is E. 35367 001146'01 254 00 0 00 004555' jrst srvfil 35368 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 19 K20SRV MAC 9-Jun-23 23:24 DIRECTORY command 35369 subttl DIRECTORY command 35370 35371 ; Default wildcard filespec fields for .CMFIL: 35372 35373 chgsec(code,const) ;;Tables and fdb's go in const 35374 000144'02 100120 777775 dirbk: gj%old!gj%ifg!gj%flg!.gjall ; Flag bits,,generation number. 35375 000145'02 000100 000101 .priin,,.priou ; COMND i/o. 35376 repeat 2,<0> ; Normal defaults for dev: and gen. 35377 000146'02 000000 000000 35378 000147'02 000000 000000 35379 repeat 2,)> ; *.* for name and type. 35380 000150'02 000000000000# 35381 000303'04 052 000 000 000 000 35382 000151'02 000000000000# 35383 000304'04 052 000 000 000 000 35384 35385 000152'02 000000000000# 0 ; Default protection, 35386 000153'02 000000 000000 0 ; and account. 35387 000010 dirbkl==<.-dirbk> ; Length of this GTJFN argument block. 35388 35389 000154'02 006000 000156' ydifdb: flddb. .cmfil,,,,,ydifd1 35390 000155'02 000000 000000 35391 000156'02 016001 000000 ydifd1: flddb. .cmdev,cm%sdh ;[193] 35392 000157'02 000000 000000 35393 retsec 35394 cleans() 35395 35396 001147'01 .ydire: entry .ydire ; Invoked from k20par 35397 001147'01 265 16 0 00 005613' saveac 35398 001150'01 200 01 0 00 005625' move t1, [dirbk,,cjfnbk] ; Insert our file parsing defaults. 35399 001151'01 251 01 0 00 000000# blt t1, cjfnbk+dirbkl 35400 001152'01 200 01 0 00 005605' movx t1, cz%ncl!.fhslf ; Close any nonopen JFNs. 35401 001153'01 104 00 0 00 000034 CLZFF 35402 001154'01 320 12 0 00 001155' erjmpr .+1 35403 35404 001155'01 200 16 0 00 000000# guide ; Issue guide words. 35405 001156'01 260 17 0 00 001115* 35406 000160'02 000000000000# 35407 000305'04 157 146 040 146 151 35408 001157'01 201 01 0 00 000000# movei t1, ydifdb ;[193] 35409 001160'01 260 17 0 00 000721* call rfield ;[193] Parse for a file, really 35410 001161'01 200 05 0 00 000002 move q1, t2 ;[193] Store whatever we got 35411 001162'01 135 07 0 00 005470' ldb q3, [pointr (.cmfnp(t3),cm%fnc)] ;[193] Get function code. 35412 35413 001163'01 302 07 0 00 000016 caie q3, .cmdev ;[193] Picked up a device? 35414 001164'01 254 00 0 00 001215' ifskp. ;[193] Yes, let's see if we can work with it 35415 001165'01 265 16 0 00 001055* anstkv(t4,^d4) ;[193] 20 characters of device name 35416 001166'01 000000 000004 35417 001167'01 415 04 0 17 777773 35418 001170'01 402 00 0 04 000000 setzm (t4) ;[193] Let's scrub a bit of it 35419 001171'01 560 01 0 00 000004 hrro t1, t4 ;[193] Create a Tops-20 ASCII pointer 35420 001172'01 104 00 0 00 000121 DEVST% ;[193] Turn it into a string (I hope) 35421 001173'01 320 12 0 00 001175' ifje. r ;[193] Failed?? 35422 001174'01 254 00 0 00 001200' 35423 001175'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 15:19 11-Jun-23 Page 19-1 K20SRV MAC 9-Jun-23 23:24 DIRECTORY command 35424 001176'01 474 06 0 00 000000 seto q2, ;[193] Cons up an impossible JFN 35425 001177'01 254 00 0 00 001214' else. ;[193] Otherwise, have a string we can maybe use 35426 001200'01 120 02 0 00 005607' dmove t2, [ exp ":", 0] ;[193] Load final characters 35427 001201'01 136 02 0 00 000001 idpb t2, t1 ;[193] Punctuate the device 35428 001202'01 136 03 0 00 000001 idpb t3, t1 ;[193] Tie off the device string 35429 001203'01 205 01 0 00 000021 movx t1, ;[193] Short form, want flags 35430 001204'01 560 02 0 00 000004 hrro t2, t4 ;[193] Recreate a Tops-20 ASCII pointer 35431 001205'01 104 00 0 00 000020 GTJFN% ;[193] Try to get a handle 35432 001206'01 320 12 0 00 001210' ifje. r ;[193] Sigh... 35433 001207'01 254 00 0 00 001213' 35434 001210'01 200 03 0 00 000001 move t3, t1 ;[193] Save error code for debuggers 35435 001211'01 474 06 0 00 000000 seto q2, ;[193] Cons up an impossible JFN 35436 001212'01 254 00 0 00 001214' else. ;[193] Otherwise, worked 35437 001213'01 200 06 0 00 000001 move q2, t1 ;[193] Put JFN in a COMND% kind of place 35438 001214'01 endif. ;[193] 35439 001214'01 endif. ;[193] End case of DEVST% handling 35440 001214'01 254 00 0 00 001216' else. ;[193] Otherwise, got a JFN 35441 001215'01 200 06 0 00 000005 move q2, q1 ;[193] Put JFN in a COMND% kind of place 35442 001216'01 endif. ;[193] End case .cmdev transmogrification 35443 35444 001216'01 337 01 0 00 000006 skipg t1, q2 ;[193] Load the JFN, unless we couldn't get one 35445 001217'01 200 01 0 00 000005 move t1, q1 ;[193] Otherwise, load the device 35446 001220'01 200 04 0 00 000001 move t4, t1 ;[193] Save a handy copy 35447 001221'01 260 17 0 00 001033* call isnulj ;[193] Is this NUL:? 35448 001222'01 254 00 0 00 001225' ifskp. ;[193] Yes, so let's fix up the parse 35449 001223'01 200 06 0 00 000001 move q2, t1 ;[193] Store the .nulio in there 35450 001224'01 254 00 0 00 001267' else. ;[193] Otherwise, isn't NUL: 35451 001225'01 200 01 0 00 000004 move t1, t4 ;[193] Load whatever we parsed 35452 001226'01 302 07 0 00 000016 caie q3, .cmdev ;[193] Did we parse a device? 35453 001227'01 254 00 0 00 001232' ifskp. ;[193] We did 35454 001230'01 200 01 0 00 000005 move t1, q1 ;[193] so use that 35455 001231'01 254 00 0 00 001233' else. ;[193] Otherwise, got a JFN 35456 001232'01 621 01 0 00 777777 tlz t1, -1 ;[193] So use that 35457 001233'01 endif. 35458 001233'01 104 00 0 00 000117 DVCHR% ;[198] Let's find out about the device 35459 001234'01 320 12 0 00 001236' %jserr (,r) ;[193] 35460 001235'01 254 00 0 00 001241' 35461 001236'01 265 01 0 00 000571* 35462 001237'01 000000000000# 35463 001240'01 254 00 0 00 000666* 35464 000307'04 117 160 145 156 040 35465 001241'01 135 03 0 00 005471' ldb t3,[pointr t2, dv%typ] ;[193] Pick up the device type 35466 001242'01 306 03 0 00 000000 cain t3, .dvdsk ;[193] Isn't a disk? 35467 001243'01 254 00 0 00 001267' anskp. ;[193] It is, so we're fine 35468 001244'01 200 02 0 00 000001 move t2, t1 ;[193] Load device designator for DEVST% 35469 001245'01 561 01 0 00 000003 hrroi t1, t3 ;[193] String is going in the registers 35470 001246'01 403 03 0 00 000004 setzb t3, t4 ;[193] Get 9 characters of device (only need 6) 35471 001247'01 104 00 0 00 000121 DEVST% ;[193] Get a string representation 35472 001250'01 320 12 0 00 001252' ifje. r ;[193] Pick up and ignore error 35473 001251'01 254 00 0 00 001254' 35474 001252'01 200 02 0 00 000001 move t2, t1 ;[193] Save error code for debuggers 35475 001253'01 120 03 0 00 005626' dmove t3, [asciz /Unknown/] ;[193] Phoney up something 35476 001254'01 endif. ;[193] 35477 001254'01 337 01 0 00 000006 skipg t1, q2 ;[193] Load the JFN 35478 001255'01 254 00 0 00 001261' ifskp. ;[193] If it was a JFN... k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 19-2 K20SRV MAC 9-Jun-23 23:24 DIRECTORY command 35479 001256'01 621 01 0 00 777777 tlz t1, -1 ;[193] Stomp any flags 35480 001257'01 104 00 0 00 000023 RLJFN% ;[193] Toss it 35481 001260'01 320 12 0 00 001261' erjmpr .+1 ;[193] Catch and ignore error 35482 001261'01 endif. ;[193] 35483 001261'01 561 01 0 00 000003 hrroi t1, t3 ;[193] String is coming from registers 35484 001262'01 104 00 0 00 000313 ESOUT% ;[193] Begin complaining 35485 txmsg <: is not a directory structured device 35486 001263'01 200 01 0 00 000000# > ;[193] Complete the blat 35487 001264'01 104 00 0 00 000076 35488 001265'01 320 12 0 00 001266' 35489 000161'02 000000000000# 35490 000322'04 072 040 151 163 040 35491 35492 001266'01 254 00 0 00 000745* callret cmder1 ;[193] Allow a reparse 35493 001267'01 endif. ;[193] 35494 35495 001267'01 260 17 0 00 000733* confrm ;[193] Tie off the line 35496 001270'01 202 06 0 00 001104* movem q2, pars3 ; Here's the JFN just parsed. 35497 001271'01 263 17 0 00 000000 ret 35498 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 20 K20SRV MAC 9-Jun-23 23:24 LOCAL DIRECTORY command execution [111] 35499 subttl LOCAL DIRECTORY command execution [111] 35500 35501 001272'01 $ydire: entry $ydire ; Invoked from k20par 35502 001272'01 550 01 0 00 001270* hrrz t1, pars3 ; Load parsed JFN 35503 001273'01 260 17 0 00 004667' call isdird ;[193] Is this a directory device? 35504 001274'01 254 00 0 00 001300' ifskp. ;[193] If worked, proceed 35505 001275'01 402 00 0 00 001044* setzm ffunc ; Function is "directory". 35506 001276'01 254 00 0 00 001334' jrst $ydir1 ; Go do the directory 35507 001277'01 254 00 0 00 001334' else. ;[193] Otherwise, not a directory device (or failed) 35508 001300'01 265 16 0 00 001165* anstkv (t4,^d4) ;[193] Allocate an anonymous stack variable 35509 001301'01 000000 000004 35510 001302'01 415 04 0 17 777773 35511 001303'01 200 02 0 00 000001 move t2, t1 ;[193] Reposition the device designator 35512 001304'01 560 01 0 00 000004 hrro t1, t4 ;[193] Create pointer to stack space 35513 001305'01 104 00 0 00 000121 DEVST% ;[193] Convert to a string 35514 001306'01 320 12 0 00 001310' ifje. r ;[193] Failed?? 35515 001307'01 254 00 0 00 001313' 35516 001310'01 200 03 0 00 000001 move t3, t1 ;[193] Save error for debugger 35517 001311'01 561 04 0 00 001111' hrroi t4, badevc ;[193] Load a default 35518 001312'01 254 00 0 00 001317' else. ;[193] Otherwise, we have a good device 35519 001313'01 120 02 0 00 005607' dmove t2, [exp ":", .chnul] ;[193] 35520 001314'01 136 02 0 00 000001 idpb t2, t1 ;[193] Punctuate device 35521 001315'01 136 03 0 00 000001 idpb t3, t1 ;[193] Tie off the string 35522 001316'01 661 04 0 00 777777 tlo t4, -1 ;[193] So turn it into a pointer 35523 001317'01 endif. ;[193] 35524 001317'01 200 01 0 00 000004 move t1, t4 ;[193] Device name 35525 001320'01 104 00 0 00 000313 ESOUT% ;[193] Begin complaining 35526 001321'01 200 01 0 00 000000# txmsg < does not have a directory to list files> ;[193] 35527 001322'01 104 00 0 00 000076 35528 001323'01 320 12 0 00 001324' 35529 000162'02 000000000000# 35530 000333'04 040 144 157 145 163 35531 001324'01 561 01 0 00 001101* hrroi t1, crlf ;[193] Newline 35532 001325'01 104 00 0 00 000076 PSOUT% ;[193] 35533 001326'01 400 01 0 00 000000 setz t1, ;[193] Cons up a zero 35534 001327'01 250 01 0 00 001272* exch t1, pars3 ;[193] Get and clear parsed JFN 35535 001330'01 621 01 0 00 777777 tlz t1, -1 ;[193] Clear any goofy flags 35536 001331'01 104 00 0 00 000023 RLJFN% ;[193] Punt it 35537 001332'01 320 12 0 00 001333' erjmpr .+1 ;[193] Catch and ignore error 35538 001333'01 263 17 0 00 000000 ret ;[193] And get out of here 35539 001334'01 endif. ;[193] End case device check 35540 35541 001334'01 200 02 0 00 001327* $ydir1: move t2, pars3 ; Here's the JFN. 35542 001335'01 402 00 0 00 000000* setzm filjfn ; Make sure no one thinks this is in use. 35543 001336'01 260 17 0 00 001365' call dirhdr ; Do the header first. 35544 35545 ; File-listing loop 35546 35547 001337'01 do. ;[194] Enter loop lexical context 35548 001337'01 260 17 0 00 005337' call dmpbuf ; Get some directory listing. 35549 001340'01 260 17 0 00 001417' call dirlst ; Print it. 35550 001341'01 326 01 0 00 001337' jumpn t1, top. ;[194] Go back for more. 35551 001342'01 enddo. ;[194] Exit loop lexical context 35552 35553 001342'01 263 17 0 00 000000 ret ; Till done. k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 20-1 K20SRV MAC 9-Jun-23 23:24 LOCAL DIRECTORY command execution [111] 35554 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 21 K20SRV MAC 9-Jun-23 23:24 Directory Header Set Up 35555 subttl Directory Header Set Up 35556 35557 ; Call: 35558 ; 35559 ; t2/ JFN of files to list. 35560 ; 35561 ; Returns: 35562 ; 35563 ; +1, always. 35564 ; 35565 ; Puts the directory listing header into the server buffer. 35566 ; Initializes buffer pointers, counters, etc. 35567 35568 001343'01 hdrtxt: asciz / 35569 001343'01 015 012 116 141 155 Name Pages Bytes(Size) Creation Date 35570 / ;[193] Directory listing header 35571 001360'01 44 07 0 00 001343' hdrptr: point 7, hdrtxt ;[193] Pointer to heading text 35572 001361'01 777777 777702 -^d62 ;[193] Length of text 35573 35574 35575 001362'01 472531 435000 nuldev: byte (7) "N","U","L",":",.chnul ;[193] 35576 001363'01 44 07 0 00 001362' nul4:: point 7, nuldev ; Pointer to fixed "NUL:" string 35577 001364'01 777777 777774 -^d4 ; Length 35578 35579 001365'01 202 02 0 00 000000* dirhdr: movem t2, ndxjfn ; Save wildcard bits. 35580 001366'01 552 02 0 00 000000* hrrzm t2, nxtjfn ; Initialize lookahead 35581 001367'01 402 00 0 00 000000# setzm filcnt ; File counter 35582 001370'01 476 00 0 00 000000# setom dirfin ; Initialize directory finished flag to assume error 35583 ; Put the listing in the server buffer. 35584 001371'01 332 00 0 00 001275* ifme. ffunc ; Directory listing? 35585 001372'01 254 00 0 00 001413' 35586 001373'01 550 03 0 00 000002 hrrz t3,t2 ;[193] Pick up just the JFN, no flags 35587 001374'01 302 03 0 00 377777 caie t3, .nulio ;[193] Data sink? 35588 001375'01 254 00 0 00 001404' ifskp. ;[193] Yep, that's easy enough 35589 001376'01 200 01 0 00 005630' move t1, [point 7, srvbuf, 27] ;[193] Points to ":" 35590 001377'01 621 02 0 00 777777 tlz t2, -1 ;[193] Shut off the flags (shouldn't be any) 35591 001400'01 211 03 0 00 000004 movni t3, ^d4 ;[193] What counted SOUT% would have wanted 35592 001401'01 200 04 0 00 001362' move t4, nuldev ;[193] Load device name in ASCII 35593 001402'01 202 04 0 00 000000# movem t4, srvbuf ;[193] Drop right into the buffer 35594 remark SOUT% ;[193] Bum the JSYS 35595 001403'01 254 00 0 00 001410' else. ;[193] Otherwise, put real file name in buffer 35596 001404'01 200 01 0 00 005631' move t1, [point 7, srvbuf] 35597 dmove t3,[111110,,js%paf ;[194] dev:name.typ.gen 35598 001405'01 120 03 0 00 005632' 0 ] ;[194] No goofy prefix 35599 001406'01 104 00 0 00 000030 JFNS 35600 001407'01 320 14 0 00 001410' erjmps .+1 ;[193] Catch and suppress error 35601 001410'01 endif. ;[193] End special case .nulio 35602 001410'01 120 02 0 00 001360' dmove t2, hdrptr ;[193] The standard header 35603 001411'01 260 17 0 00 000000* call %%smsg ;[216] Print heading. 35604 ;[216] erjmps +1 ;[194] Catch and suppress error 35605 001412'01 254 00 0 00 001414' else. ;[193] Otherwise, just reset the buffer pointer 35606 001413'01 200 01 0 00 005634' move t1, [point 7, srvbuf] 35607 001414'01 endif. ;[194] End case file function decision 35608 35609 001414'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 15:19 11-Jun-23 Page 21-1 K20SRV MAC 9-Jun-23 23:24 Directory Header Set Up 35610 001415'01 202 01 0 00 000000# movem t1, srvptr ; Preserve string buffer pointer. 35611 001416'01 263 17 0 00 000000 ret 35612 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 22 K20SRV MAC 9-Jun-23 23:24 Directory Listing Display Logic 35613 subttl Directory Listing Display Logic 35614 35615 ; Constructs directory listing text in a chunk of memory starting at 35616 ; SRVBUF and ending at (or slightly after) SRVBZ. Updates SRVPTR. 35617 ; 35618 ; Returns +1 always, with t1/ -1 if we got some data, t1/ 0 if done. 35619 ; 35620 ; Keeps global file counter in FILCNT. 35621 ; 35622 ; Be aware that the routine is doing double duty for ANY file function 35623 ; that might need to be executed over a set of files. 35624 35625 001417'01 400 01 0 00 000000 dirlst: setz t1, 35626 001420'01 332 00 0 00 000000# skipe dirfin ; Finished? 35627 001421'01 263 17 0 00 000000 ret ; Yes. 35628 001422'01 200 01 0 00 000000# move t1, srvptr ; No, there's more to do. 35629 001423'01 120 02 0 00 005635' dmove t2, [ exp .chcrt, .chlfd ] ;[194] Load the line break. 35630 001424'01 136 02 0 00 000001 idpb t2, t1 ;[194] And issue 35631 001425'01 136 03 0 00 000001 idpb t3, t1 ;[194] it 35632 001426'01 202 01 0 00 000000# movem t1, srvptr ; Save the buffer pointer. 35633 001427'01 260 17 0 00 004720' call gtnfil ; Get next file. 35634 001430'01 254 00 0 00 001520' jrst dirlsz ; If none, done. 35635 001431'01 350 00 0 00 000000# aos filcnt ; Got one, count it. 35636 35637 ;[133] Get detailed size info from FDB. 35638 35639 001432'01 553 02 0 00 000001 hrrzs t2, t1 ; Get rid of any flags. 35640 001433'01 200 01 0 00 005637' move t1, [byte (7) .chspc,.chspc,.chspc,.chspc,.chspc] ;[193] 35641 001434'01 202 01 0 00 000000* movem t1, filbuf ;[194] Fill the filename buffer with blanks. 35642 001435'01 200 01 0 00 005640' move t1, [filbuf,,filbuf+1] 35643 001436'01 251 01 0 00 000000# blt t1, filbfz-1 35644 35645 remark ;[193] Always put the file name in 35646 001437'01 302 02 0 00 377777 caie t2, .nulio ;[193] Data sink? 35647 001440'01 254 00 0 00 001445' ifskp. ;[193] Yes, don't do any of the file stuff 35648 001441'01 200 03 0 00 001362' move t3, nuldev ;[193] Just the device name 35649 001442'01 202 03 0 00 001434* movem t3, filbuf ;[193] Store a hardwired name 35650 001443'01 200 01 0 00 005641' move t1, [ point 7, filbuf, 27] ;[193] Where SOUT% would leave it 35651 001444'01 254 00 0 00 001452' else. ;[193] Otherwise, an honest file 35652 001445'01 200 01 0 00 005642' move t1, [point 7, filbuf] ; Now start filling in the fields. 35653 001446'01 200 03 0 00 005643' movx t3, fld(.jsaof,js%nam)!fld(.jsaof,js%typ)!fld(.jsaof,js%gen)!js%tmp!js%paf 35654 001447'01 400 04 0 00 000000 setz t4, ;[193] No goofy prefix 35655 001450'01 104 00 0 00 000030 JFNS 35656 001451'01 320 14 0 00 001520' erjmps dirlsz ;[193] Failed, get out of here 35657 001452'01 endif. ;[193] End special case NUL: 35658 001452'01 202 01 0 00 000000# movem t1, filptr ;[193] Store updated pointer 35659 35660 001453'01 332 00 0 00 001371* ifme. ffunc ; What was the file function? 35661 001454'01 254 00 0 00 001466' 35662 001455'01 260 17 0 00 005025' call filinf ;[200] Pull the file information 35663 001456'01 254 00 0 00 001520' jrst dirlsz ;[200] Or fail the loop 35664 001457'01 302 02 0 00 377777 caie t2, .nulio ;[193] Was it a directory of NUL:? 35665 001460'01 254 00 0 00 001464' ifskp. ;[193] Yes, so go make that up 35666 001461'01 260 17 0 00 001553' call nulist ;[193] Just make up our own entry 35667 001462'01 254 00 0 00 001520' jrst dirlsz ;[193] Failed, get out of here k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 22-1 K20SRV MAC 9-Jun-23 23:24 Directory Listing Display Logic 35668 001463'01 254 00 0 00 001466' else. ;[193] Otherwise, 35669 001464'01 260 17 0 00 001570' call filist ;[193] Construct text for this file 35670 001465'01 254 00 0 00 001520' jrst dirlsz ;[193] Failed, get out of here 35671 001466'01 endif. ;[193] End .nulio special casing 35672 001466'01 endif. ;[193] End case doing a directory 35673 35674 001466'01 202 01 0 00 000000# movem t1, filptr ;[193] Store updated pointer 35675 001467'01 400 03 0 00 000000 setz t3, ; Done with this line, make it asciz. 35676 001470'01 136 03 0 00 000001 idpb t3, t1 35677 35678 ; Copy the result into the server sending buffer. 35679 35680 001471'01 415 16 0 00 001505' block. ;[202] Set up a stack frame 35681 001472'01 261 17 0 00 000016 35682 001473'01 265 16 0 00 005644' saveac ;[202] movst gorges on registers 35683 001474'01 200 05 0 00 000000# move q1, srvptr ;[202] Load server buffer pointer 35684 001475'01 200 02 0 00 005642' move t2, [point 7, filbuf] ;[202] Load source pointer 35685 001476'01 403 03 0 00 000006 setzb t3, q2 ;[202] Force section local pointers 35686 001477'01 200 01 0 00 005656' move t1, [S!mxascz] ;[202] Limit source length, start significance 35687 001500'01 200 04 0 00 005661' movx t4, [mxascz] ;[202] Limit destination length 35688 001501'01 123 01 0 00 000000* extend t1, movasc ;[202] Move characters, doing useless translating 35689 001502'01 600 00 0 00 000000 nop ;[202] Will never +1 because t1 and t4 are equal 35690 001503'01 202 05 0 00 000000# movem q1, srvptr ;[202] Save updated destination pointer 35691 001504'01 263 17 0 00 000000 endbk. ;[202] End of stack frame 35692 35693 ; Still expect to have file jfn in t2 when we get here. 35694 35695 001505'01 336 01 0 00 001453* skipn t1, ffunc ;[199] What is the function? 35696 001506'01 254 00 0 00 001511' ifskp. ;[200] Not doing a directory 35697 remark t2, ;[200] Already has the right JFN 35698 001507'01 500 02 0 00 001365* hll t2, ndxjfn ;[200] Put in the global stepping flags 35699 001510'01 260 17 0 01 000000 call (t1) ;[200] and go do selected function. 35700 001511'01 endif. ;[200] 35701 35702 001511'01 200 01 0 00 000000# move t1, srvptr 35703 001512'01 550 02 0 00 000001 hrrz t2, t1 ; See if buffer full. 35704 001513'01 305 02 0 00 000000# caige t2, srvbz ;[194] Full? 35705 001514'01 254 00 0 00 001517' ifskp. ;[194] It is 35706 001515'01 474 01 0 00 000000 seto t1, ; Return indicating we have data. 35707 001516'01 263 17 0 00 000000 ret 35708 001517'01 endif. ;[194] 35709 001517'01 254 00 0 00 001417' jrst dirlst ; Loop for another file 35710 35711 ; Done, print summary. 35712 35713 001520'01 200 01 0 00 000000# dirlsz: move t1, srvptr ; Get the buffer pointer. 35714 001521'01 201 02 0 00 000040 movei t2, .chspc ;[194] Summary. First a space. 35715 001522'01 104 00 0 00 000051 BOUT 35716 001523'01 200 02 0 00 000000# move t2, filcnt ; Then the number of files. 35717 001524'01 201 03 0 00 000012 movei t3, ^d10 35718 001525'01 104 00 0 00 000224 NOUT 35719 001526'01 320 16 0 00 001527' erjmp .+1 35720 001527'01 376 00 0 00 000000# sosn filcnt ; Do singular or plural right. 35721 001530'01 254 00 0 00 001534' ifskp. ; Was more than one 35722 smsg < files k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 22-2 K20SRV MAC 9-Jun-23 23:24 Directory Listing Display Logic 35723 001531'01 120 02 0 00 000000# > 35724 001532'01 260 17 0 00 001411* 35725 000163'02 000000000000# 35726 000164'02 777777 777770 35727 000344'04 040 146 151 154 145 35728 35729 001533'01 254 00 0 00 001536' else. ; Otherwise, unary case 35730 smsg < file 35731 001534'01 120 02 0 00 000000# > 35732 001535'01 260 17 0 00 001532* 35733 000165'02 000000000000# 35734 000166'02 777777 777771 35735 000346'04 040 146 151 154 145 35736 35737 001536'01 endif. 35738 35739 001536'01 202 01 0 00 000000# movem t1, srvptr ; Save pointer. 35740 001537'01 477 01 0 00 000000# setob t1, dirfin ; Say we're returning data. 35741 remark dirfin ; Set finished flag for next time through. 35742 001540'01 263 17 0 00 000000 ret 35743 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 23 K20SRV MAC 9-Jun-23 23:24 NUL: device directory listing 35744 subttl NUL: device directory listing 35745 35746 ;[193] Begin Code Insertion 35747 35748 ; Expects t1 to point to a buffer area to write text 35749 35750 001541'01 011 011 040 040 040 nuldir: asciz / 0 0(7) Now/ 35751 001547'01 000000 000031 nulfil: ^d25 ; Length of phoney directory entry 35752 001550'01 44 07 0 00 001541' point 7, nuldir ; Pointer to our phoney directory entry 35753 35754 001551'01 movchr: intern movchr ; Extended opcode is also used elsewhere 35755 001551'01 016 00 0 00 000000 movslj 0, 0 ; No accumulator; E1 unused 35756 001552'01 000000 000040 .chspc ; Fill with spaces 35757 35758 001553'01 261 17 0 00 000005 nulist: push p, q1 ; Extend gorges on registers 35759 001554'01 261 17 0 00 000006 push p, q2 35760 35761 001555'01 200 05 0 00 000001 move q1, t1 ; Reposition destination 35762 001556'01 120 01 0 00 001547' dmove t1, nulfil ; Load source length and pointer 35763 001557'01 200 04 0 00 000001 move t4, t1 ; Source and destination are the same length 35764 001560'01 400 03 0 00 000006 setz t3, q2 ; Force section local pointers 35765 001561'01 123 01 0 00 001551' extend t1, movchr ; Copy the listing over 35766 001562'01 600 00 0 00 000000 nop ; Will never +1 since t1 == t4 35767 001563'01 200 01 0 00 000005 move t1, q1 ; Return final destination pointer 35768 remark t4, ; t4 is still zero 35769 001564'01 136 04 0 00 000005 idpb t4, q1 ; Tie of the string, allowing append 35770 35771 001565'01 262 17 0 00 000006 pop p, q2 ; Restore registers 35772 001566'01 262 17 0 00 000005 pop p, q1 35773 001567'01 254 00 0 00 000667* retskp ; Return success, pointing to .chnul 35774 35775 ;[193] End Code Insertion 35776 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 24 K20SRV MAC 9-Jun-23 23:24 Real directory listing, including file size and creation date. 35777 subttl Real directory listing, including file size and creation date. 35778 35779 ; Call: 35780 ; 35781 ; t1/ Pointer to buffer area 35782 ; 35783 ; Assumes the following are valid: 35784 ; 35785 ; pagcnt/ Number of pages (or blocks) in the file 35786 ; bytcnt/ Count of bytes in the file and byte size 35787 ; crdate/ Creation date and time 35788 ; 35789 ; In other words that filinf has been called. Note that it is a 35790 ; mistake to use this when doing .nulio, even though filinf will 35791 ; put reasonable (yet false) data in. The resulting string will 35792 ; always be the same, so this is special cased. 35793 35794 ;[122] The rest of this routine rewritten to provide nice columnar listing. 35795 35796 001570'01 200 01 0 00 000000# filist: move t1, filptr ;[193] Load current buffer pointer 35797 001571'01 201 03 0 00 000040 movei t3, .chspc ; Put a blank over the null left by JFNS. 35798 001572'01 136 03 0 00 000001 idpb t3, t1 35799 35800 001573'01 550 02 0 00 000001 hrrz t2, t1 ; Get address from updated pointer. 35801 001574'01 301 02 0 00 000000# cail t2, filbuf+4 ; Name stayed within its field? 35802 001575'01 254 00 0 00 001601' ifskp. ;[194] It did 35803 001576'01 200 01 0 00 005662' move t1, [point 7, filbuf+4] ; Yes, advance to next field. 35804 001577'01 200 03 0 00 005663' movx t3, 35805 001600'01 254 00 0 00 001604' else. ;[194] Otherwise, blew through it 35806 001601'01 201 02 0 00 000040 movei t2, .chspc ; No, do free format. 35807 001602'01 136 02 0 00 000001 idpb t2, t1 ; Deposit a blank, advance pointer. 35808 001603'01 201 03 0 00 000012 movei t3, ^d10 ; No fixed-field stuff on page count. 35809 001604'01 endif. ;[194] 35810 35811 ;[133] More detailed info about size: pages, byte count, byte size. 35812 35813 001604'01 550 02 0 00 000000* hrrz t2, pagcnt ; Number of pages in file. 35814 001605'01 104 00 0 00 000224 NOUT 35815 001606'01 320 14 0 00 001240* erjmps r ; Catch and suppress error, returning +1 35816 001607'01 201 03 0 00 000040 movei t3, .chspc ; A blank 35817 001610'01 136 03 0 00 000001 idpb t3, t1 35818 001611'01 200 02 0 00 000000* move t2, bytcnt ; Byte count, free format. 35819 001612'01 201 03 0 00 000012 movei t3, ^d10 35820 001613'01 104 00 0 00 000224 NOUT 35821 001614'01 320 14 0 00 001606* erjmps r ; Catch and suppress error, returning +1 35822 35823 001615'01 135 02 0 00 005664' ldb t2, [pointr (pagcnt,fb%bsz)] ;[200] Load the byte size 35824 001616'01 322 02 0 00 001627' ifn. t2 ;[200] Device may not do byte sizes 35825 001617'01 201 03 0 00 000050 movei t3, "(" ; Byte size, in parens. 35826 001620'01 136 03 0 00 000001 idpb t3, t1 35827 001621'01 201 03 0 00 000012 movei t3, ^d10 35828 001622'01 104 00 0 00 000224 NOUT 35829 001623'01 320 14 0 00 001614* erjmps r ; Catch and suppress error, returning +1 35830 001624'01 201 03 0 00 000051 movei t3, ")" 35831 001625'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 15:19 11-Jun-23 Page 24-1 K20SRV MAC 9-Jun-23 23:24 Real directory listing, including file size and creation date. 35832 001626'01 254 00 0 00 001632' else. ;[200] Fix string contiguity 35833 001627'01 200 02 0 00 000001 move t2, t1 ;[200] Get a copy of the pointer 35834 001630'01 201 03 0 00 000040 movei t3, .chspc ;[200] Load a space 35835 001631'01 136 03 0 00 000002 idpb t3, t2 ;[200] Overwrite the .chnul 35836 001632'01 endif. ;[200] 35837 35838 001632'01 301 03 0 00 000000# cail t3, filbuf+11 ;[194] Out of the field? 35839 001633'01 254 00 0 00 001636' ifskp. ;[194] No, that's great! 35840 001634'01 200 01 0 00 005665' move t1, [point 7, filbuf+11] 35841 001635'01 254 00 0 00 001640' else. ;[194] Otherwise, overflowed field 35842 001636'01 201 02 0 00 000040 movei t2, .chspc ; Put in a blank to separate. 35843 001637'01 136 02 0 00 000001 idpb t2, t1 35844 001640'01 endif. 35845 35846 001640'01 336 02 0 00 000000* skipn t2, crdate ;[200] Pick up creation date, if there is one 35847 001641'01 254 00 0 00 001645' ifskp. ;[200] There was, let's type it 35848 001642'01 205 03 0 00 010000 movx t3, ot%4yr ;[200] We're waaaaay past the millenium 35849 001643'01 104 00 0 00 000220 ODTIM% ;[200] Finally display something 35850 001644'01 320 14 0 00 001623* erjmps r ;[200] Catch and suppress error, returning +1 35851 001645'01 endif. ;[200] 35852 001645'01 254 00 0 00 001567* retskp ;[193] Won 35853 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 25 K20SRV MAC 9-Jun-23 23:24 REMOTE DIRECTORY execution 35854 subttl REMOTE DIRECTORY execution 35855 35856 001646'01 336 00 0 00 001133* $xdire: ifmn. tlgjfn ;[233] Doing transaction logging? 35857 001647'01 254 00 0 00 001671' 35858 001650'01 415 16 0 00 001671' block. ;[233] Get a stack frame 35859 001651'01 261 17 0 00 000016 35860 001652'01 265 16 0 00 005507' saveac ;[233] Save even the temporaries 35861 001653'01 476 00 0 00 001126* setom scrlft ;[233] Don't append the crlf! 35862 001654'01 265 01 0 00 001127* wtlog(,) ;[233] 35863 001655'01 000000000000# 35864 001656'01 777777 777734 35865 001657'01 000000 000000 35866 000350'04 122 145 161 165 145 35867 001660'01 200 01 0 00 001646* move t1, tlgjfn ;[233] Put the directory name in the log 35868 001661'01 561 02 0 00 001134* hrroi t2,atmbuf ;[233] It's in the atom buffer 35869 001662'01 403 03 0 00 000004 setzb t3,t4 ;[233] Don't know how long, stop on a NUL 35870 001663'01 104 00 0 00 000053 SOUT% ;[233] Out it goes! 35871 001664'01 320 14 0 00 001665' erjmps .+1 ;[233] Catch and suppress error 35872 dmove t2,[ -1,,crlf ;[233] Tops-20 pointer to carriage return line feed 35873 001665'01 120 02 0 00 005611' -2 ] ;[233] Counted SOUT%'s are faster 35874 001666'01 104 00 0 00 000053 SOUT% ;[233] Out it goes! 35875 001667'01 320 14 0 00 001670' erjmps .+1 ;[233] Catch and suppress error 35876 001670'01 263 17 0 00 000000 endbk. ;[233] Release stack frame, restoring AC's 35877 001671'01 endif. ;[233] 35878 35879 001671'01 260 17 0 00 001144* call statim ;[189] Start timing so k20pdc doesn't choke 35880 001672'01 201 04 0 00 000104 movei t4, "D" ; Generic command is D. 35881 001673'01 254 00 0 00 004555' jrst srvfil 35882 35883 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 26 K20SRV MAC 9-Jun-23 23:24 REMOTE ERROR parsing 35884 subttl REMOTE ERROR parsing 35885 35886 ; This is a SECRET command to send an (optionally) null error packet. Shh!! 35887 35888 chgsec(code,const) ;;Chained fdb's go in const 35889 000167'02 010004 000172' xerfdb: flddb. .cmcfm,,,,,xerfd1 35890 000170'02 000000 000000 35891 000171'02 44 07 0 00 000437' 35892 000172'02 021004 000175' xerfd1: flddb. .cmqst,,,,,xerfd2 35893 000173'02 000000 000000 35894 000174'02 44 07 0 00 000445' 35895 000175'02 017004 000000 xerfd2: flddb. .cmtxt,,,,, 35896 000176'02 000000 000000 35897 000177'02 44 07 0 00 000445' 35898 retsec 35899 cleans() 35900 35901 001674'01 201 01 0 00 000000# .xerr: movei t1, xerfdb ;[220] Allow a quote of the remote file specification 35902 001675'01 260 17 0 00 001160* call rfield ;[220] Try to parse something 35903 001676'01 135 03 0 00 005470' ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ;[220] Get function code. 35904 35905 001677'01 306 03 0 00 000010 cain t3, .cmcfm ;[220] Confirm? 35906 001700'01 263 17 0 00 000000 ret ;[220] We're done 35907 35908 001701'01 260 17 0 00 001267* confrm ;[220] Otherwise tie off the line 35909 001702'01 200 01 0 00 005570' move t1,[point 7,atmbuf];[220] Load pointer to complaint department 35910 001703'01 202 01 0 00 001334* movem t1, pars3 ;[220] and ask to ship that off 35911 35912 001704'01 263 17 0 00 000000 ret 35913 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 27 K20SRV MAC 9-Jun-23 23:24 REMOTE ERROR semantic action 35914 subttl REMOTE ERROR semantic action 35915 35916 001705'01 265 16 0 00 005447' $xerr: saveac ;[220] Extra register for possible pointer 35917 001706'01 260 17 0 00 001671* call statim ;[189] Start timing so k20pdc doesn't choke 35918 001707'01 336 05 0 00 001703* skipn q1, pars3 ;[220] Wants to send accompanying text 35919 001710'01 254 00 0 00 001720' ifskp. ;[220] Must be really annoyed... 35920 001711'01 400 03 0 00 000000 setz t3, ;[220] Let's assume a bogus parse 35921 001712'01 200 02 0 00 000005 move t2, q1 ;[220] Load the pointer we were passed 35922 001713'01 134 03 0 00 000002 ildb t3, t2 ;[220] Try to get a character 35923 001714'01 320 12 0 00 001715' erjmpr .+1 ;[220] Catch and store error for debuggers 35924 001715'01 306 03 0 00 000000 cain t3, 0 ;[220] Anything there? 35925 001716'01 254 00 0 00 001720' anskp. ;[220] No, so still sending a null packet 35926 001717'01 254 00 0 00 001726' else. ;[220] No pointer, or bad pointer or no data 35927 001720'01 201 01 0 00 000105 movei t1, "E" ; Send an error packet. 35928 001721'01 200 02 0 00 000000* move t2, pktnum ;[220] Packet number must match 35929 001722'01 403 03 0 00 000004 setzb t3, t4 ;[220] Yet no data 35930 001723'01 260 17 0 00 000000* call spack ;[220] Send the packet... 35931 001724'01 600 00 0 00 000000 nop ;[220] ... and ignore the response 35932 001725'01 263 17 0 00 000000 ret ;[220] Done with this trivial case 35933 001726'01 endif. ;[220] End argument check 35934 35935 remark ;[220] Otherwise, stuff some text in 35936 001726'01 403 01 0 00 000002 setzb t1, t2 ;[220] Cons up some .chnul's 35937 001727'01 124 01 0 00 000753* dmovem t1, strbuf ;[220] Zero out old stuff 35938 001730'01 124 01 0 00 000000# dmovem t1, strbuf+2 ;[220] and a bit more of it 35939 001731'01 200 02 0 00 005600' move t2, [ point 7, strbuf ] ;[220] Point to string buffer 35940 001732'01 202 02 0 00 001016* movem t2, strptr ;[220] Save current location 35941 35942 001733'01 200 01 0 00 000005 move t1, q1 ;[220] Load pointer to error text 35943 001734'01 400 03 0 00 000000 setz t3, ;[220] Zero the count 35944 35945 001735'01 do. ; Enter loop context to copy the complaint 35946 001735'01 134 04 0 00 000001 ildb t4, t1 ; Pick up a byte of the wahhh 35947 001736'01 322 04 0 00 001741' jumpe t4, endlp. ; Stop at the end of the string 35948 001737'01 136 04 0 00 000002 idpb t4, t2 ; Deposit it in string buffer 35949 001740'01 344 03 0 00 001735' aoja t3, top. ; Get some more bytes, weee!! 35950 001741'01 enddo. ; End of loop context 35951 35952 001741'01 400 04 0 00 000000 setz t4, ;[220] Cons up a NUL 35953 001742'01 136 04 0 00 000002 idpb t4, t2 ;[220] Tie off string but don't count it 35954 35955 001743'01 201 01 0 00 000105 movei t1, "E" ;[220] Sending an error packet with extra flavoring 35956 001744'01 200 02 0 00 001721* move t2, pktnum ;[220] Packet number must match 35957 remark t3, data count ;[220] Unchanged from do. loop 35958 001745'01 200 04 0 00 001732* move t4, strptr ;[220] Load beginning of data area 35959 001746'01 260 17 0 00 001723* call spack ;[220] Send the packet... 35960 001747'01 600 00 0 00 000000 nop ;[220] ... and ignore the response 35961 001750'01 263 17 0 00 000000 ret ;[220] Done with the semantic action for ERROR 35962 35963 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 28 K20SRV MAC 9-Jun-23 23:24 FINISH command 35964 subttl FINISH command 35965 35966 ;[28] The FINISH command is edit 28. 35967 35968 ; Invoked by K20PAR 35969 35970 001751'01 .finis: entry .finis ;[220] 35971 001751'01 200 16 0 00 000000# guide (remote server operation) ; Parse rest of FINISH command. 35972 001752'01 260 17 0 00 001156* 35973 000200'02 000000000000# 35974 000360'04 162 145 155 157 164 35975 001753'01 260 17 0 00 001701* confrm 35976 001754'01 263 17 0 00 000000 ret 35977 35978 remark Execute FINISH command. 35979 35980 001755'01 $finis: entry $finis ;[220] 35981 001755'01 260 17 0 00 001706* call statim ;[189] Start timing so k20pdc doesn't choke 35982 001756'01 200 01 0 00 005667' move t1, [point 7, [asciz/F/]] ; An "F" for the data field. 35983 001757'01 201 02 0 00 000107 movei t2, "G" ; Packet type is G. 35984 001760'01 260 17 0 00 004327' call srvcmd ; Go send the command. 35985 001761'01 600 00 0 00 000000 nop ; Ignore any failure. 35986 001762'01 263 17 0 00 000000 ret ; Done. 35987 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 29 K20SRV MAC 9-Jun-23 23:24 REMOTE HELP 35988 subttl REMOTE HELP 35989 35990 remark REMOTE HELP parsing 35991 35992 001763'01 .xhelp: entry .xhelp ;[220] 35993 001763'01 200 16 0 00 000000# guide 35994 001764'01 260 17 0 00 001752* 35995 000201'02 000000000000# 35996 000365'04 146 162 157 155 040 35997 001765'01 260 17 0 00 001753* confrm 35998 001766'01 263 17 0 00 000000 ret 35999 36000 remark REMOTE HELP execution 36001 36002 001767'01 $xhelp: entry $xhelp ;[220] 36003 001767'01 336 00 0 00 001660* ifmn. tlgjfn ;[233] Doing transaction logging? 36004 001770'01 254 00 0 00 002001' 36005 001771'01 415 16 0 00 002001' block. ;[233] Get a stack frame 36006 001772'01 261 17 0 00 000016 36007 001773'01 265 16 0 00 005507' saveac ;[233] Save even the temporaries 36008 001774'01 265 01 0 00 001654* wtlog(,) ;[233] 36009 001775'01 000000000000# 36010 001776'01 777777 777741 36011 001777'01 000000 000000 36012 000371'04 122 145 161 165 145 36013 002000'01 263 17 0 00 000000 endbk. ;[233] Release stack frame, restoring AC's 36014 002001'01 endif. ;[233] 36015 36016 002001'01 260 17 0 00 001755* call statim ;[189] Start timing so k20pdc doesn't choke 36017 002002'01 260 17 0 00 004524' call sinfo ; Exchange parameters. 36018 002003'01 263 17 0 00 000000 ret ;[133] Failed, give up. 36019 dmove t1, [point 7, [asciz/H/] ; H command for data field. 36020 002004'01 120 01 0 00 005671' "G" ] ; Packet type is G. 36021 002005'01 254 00 0 00 004601' jrst dosrv 36022 36023 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 30 K20SRV MAC 9-Jun-23 23:24 REMOTE HOST parsing 36024 subttl REMOTE HOST parsing 36025 36026 chgsec(code,const) ;;Chained fdb's go in const 36027 000202'02 021004 000205' xhofdb: flddb. .cmqst,,,,,xhofd1 36028 000203'02 000000 000000 36029 000204'02 44 07 0 00 000452' 36030 000205'02 017004 000000 xhofd1: flddb. .cmtxt,,,,, 36031 000206'02 000000 000000 36032 000207'02 44 07 0 00 000452' 36033 retsec 36034 cleans() 36035 36036 002006'01 200 16 0 00 000000# .xhost: guide 36037 002007'01 260 17 0 00 001764* 36038 000210'02 000000000000# 36039 000400'04 143 157 155 155 141 36040 002010'01 201 01 0 00 000000# movei t1, xhofdb ;[220] Allow a quote of the remote command 36041 002011'01 260 17 0 00 001117* call cfield 36042 002012'01 263 17 0 00 000000 ret 36043 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 31 K20SRV MAC 9-Jun-23 23:24 REMOTE HOST command [105] 36044 subttl REMOTE HOST command [105] 36045 36046 002013'01 $xhost: entry $xhost ;[220] 36047 002013'01 336 00 0 00 000321* ifmn. takdep ;[176] Allow commands to servers from TAKE file 36048 002014'01 254 00 0 00 002024' 36049 002015'01 336 00 0 00 000000* ifmn. local ; This only works if local Kermit. 36050 002016'01 254 00 0 00 002024' 36051 002017'01 334 01 0 00 000000# ermsg% (,r) 36052 002020'01 254 00 0 00 002024' 36053 002021'01 202 01 0 00 000517* 36054 002022'01 104 00 0 00 000313 36055 002023'01 254 00 0 00 001644* 36056 000211'02 000000000000# 36057 000402'04 113 105 122 115 111 36058 36059 002024'01 endif. ;[194] End case not remote 36060 002024'01 endif. ;[194] End case allowing from take file 36061 36062 002024'01 260 17 0 00 002001* call statim ;[189] Start timing so k20pdc doesn't choke 36063 dmove t1, [point 7, atmbuf ; And move them from here 36064 002025'01 120 01 0 00 005673' point 7, strbuf] ; to here. 36065 36066 002026'01 do. ;[194] Enter loop context 36067 002026'01 134 04 0 00 000001 ildb t4, t1 ; Copy the string. 36068 002027'01 322 04 0 00 002032' jumpe t4, endlp. ;[194] 36069 002030'01 136 04 0 00 000002 idpb t4, t2 36070 002031'01 254 00 0 00 002026' loop. ;[194] 36071 002032'01 enddo. ;[194] 36072 36073 002032'01 200 03 0 00 000000* move t3, seolch ; Terminate it with the host's eol character. 36074 002033'01 136 03 0 00 000002 idpb t3, t2 36075 002034'01 136 04 0 00 000002 idpb t4, t2 ; And a null. 36076 36077 002035'01 260 17 0 00 000000* call ccon ;[169] Enable ^C during this bit. 36078 002036'01 254 00 0 00 000000* jrst ccoff ;[169] Where to go if ^C happens. 36079 002037'01 260 17 0 00 004524' call sinfo ; Exchange params. 36080 002040'01 254 00 0 00 002036* jrst ccoff ;[169] Failed, give up, turn off ^C trap. 36081 002041'01 260 17 0 00 002040* call ccoff ;[169] 36082 002042'01 200 01 0 00 005600' move t1, [point 7, strbuf] ; Point to command. 36083 002043'01 201 02 0 00 000103 movei t2, "C" ; Packet type is C. 36084 002044'01 254 00 0 00 004601' jrst dosrv ; Go send it and handle the reply. 36085 36086 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 32 K20SRV MAC 9-Jun-23 23:24 PWD command 36087 subttl PWD command 36088 36089 remark LOCAL PWD (trivial) parsing 36090 36091 002045'01 .ypwd: entry .ypwd 36092 002045'01 200 16 0 00 000000# guide 36093 002046'01 260 17 0 00 002007* 36094 000212'02 000000000000# 36095 000417'04 160 162 151 156 164 36096 002047'01 260 17 0 00 001765* confrm 36097 002050'01 263 17 0 00 000000 ret 36098 36099 remark LOCAL PWD semanic action 36100 36101 002051'01 $ypwd: entry $ypwd 36102 002051'01 561 01 0 00 001324* hrroi t1, crlf ; Offset from prompt 36103 002052'01 104 00 0 00 000076 PSOUT% 36104 002053'01 104 00 0 00 000013 GJINF% ; Get current job information. 36105 002054'01 201 01 0 00 000101 movei t1, .priou ; Type on terminal 36106 remark t2, ; Already has the connected directory 36107 002055'01 104 00 0 00 000041 DIRST% ; Translate into a string 36108 002056'01 320 12 0 00 002060' %jserr (,r) 36109 002057'01 254 00 0 00 002063' 36110 002060'01 265 01 0 00 001236* 36111 002061'01 000000 000000 36112 002062'01 254 00 0 00 002023* 36113 002063'01 561 01 0 00 002051* hrroi t1,crlf ; Tie off the line 36114 002064'01 104 00 0 00 000076 PSOUT% 36115 002065'01 263 17 0 00 000000 ret 36116 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 33 K20SRV MAC 9-Jun-23 23:24 REMOTE PWD 36117 subttl REMOTE PWD 36118 36119 ;[188] Begin Code Insertion 36120 36121 remark REMOTE PWD parsing 36122 36123 002066'01 .xpwd: entry .xpwd ;[220] 36124 002066'01 200 16 0 00 000000# guide 36125 002067'01 260 17 0 00 002046* 36126 000213'02 000000000000# 36127 000425'04 160 162 151 156 164 36128 002070'01 260 17 0 00 002047* confrm 36129 002071'01 263 17 0 00 000000 ret 36130 36131 remark REMOTE PWD execution 36132 36133 002072'01 $xpwd: entry $xpwd ;[220] 36134 002072'01 260 17 0 00 002024* call statim ;[189] Start timing so k20pdc doesn't choke 36135 dmove t1, [ 36136 point 7, [asciz/A/] ; 'A' command for data field. 36137 002073'01 120 01 0 00 005676' "G" ] ; Packet type is G. 36138 002074'01 254 00 0 00 004601' jrst dosrv 36139 36140 36141 ;[188] End Code Insertion 36142 36143 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 34 K20SRV MAC 9-Jun-23 23:24 LOCAL SPACE 36144 subttl LOCAL SPACE 36145 36146 remark LOCAL SPACE (trivial) parsing 36147 36148 002075'01 .ydisk: entry .ydisk 36149 002075'01 200 16 0 00 000000# guide 36150 002076'01 260 17 0 00 002067* 36151 000214'02 000000000000# 36152 000433'04 165 163 141 147 145 36153 002077'01 260 17 0 00 002070* confrm 36154 002100'01 263 17 0 00 000000 ret 36155 36156 remark LOCAL SPACE semanic action 36157 36158 002101'01 $ydisk: entry $ydisk 36159 002101'01 474 01 0 00 000000 seto t1, ; local disk usage query. 36160 002102'01 104 00 0 00 000305 GTDAL% 36161 002103'01 320 12 0 00 002105' %jserr (,r) 36162 002104'01 254 00 0 00 002110' 36163 002105'01 265 01 0 00 002060* 36164 002106'01 000000 000000 36165 002107'01 254 00 0 00 002062* 36166 002110'01 120 05 0 00 000001 dmove q1, t1 36167 txmsg < 36168 002111'01 200 01 0 00 000000# Quota: > ;[194] 36169 002112'01 104 00 0 00 000076 36170 002113'01 320 12 0 00 002114' 36171 000215'02 000000000000# 36172 000436'04 015 012 040 121 165 36173 36174 002114'01 305 05 0 00 005700' caige q1, [^d100000000] ;[194] Where did this number come from? 36175 002115'01 254 00 0 00 002122' ifskp. ;[194] Really big ... 36176 002116'01 200 01 0 00 000000# txmsg <+Inf> ;[194] 36177 002117'01 104 00 0 00 000076 36178 002120'01 320 12 0 00 002121' 36179 000216'02 000000000000# 36180 000441'04 053 111 156 146 000 36181 002121'01 254 00 0 00 002127' else. ;[194] 36182 002122'01 201 01 0 00 000101 numout q1 36183 002123'01 200 02 0 00 000005 36184 002124'01 201 03 0 00 000012 36185 002125'01 104 00 0 00 000224 36186 002126'01 320 14 0 00 002127' 36187 002127'01 endif. 36188 36189 002127'01 200 01 0 00 000000# txmsg <, used: > 36190 002130'01 104 00 0 00 000076 36191 002131'01 320 12 0 00 002132' 36192 000217'02 000000000000# 36193 000442'04 054 040 165 163 145 36194 002132'01 201 01 0 00 000101 numout q2 36195 002133'01 200 02 0 00 000006 36196 002134'01 201 03 0 00 000012 36197 002135'01 104 00 0 00 000224 36198 002136'01 320 14 0 00 002137' k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 34-1 K20SRV MAC 9-Jun-23 23:24 LOCAL SPACE 36199 002137'01 200 01 0 00 000000# txmsg < (pages)> 36200 002140'01 104 00 0 00 000076 36201 002141'01 320 12 0 00 002142' 36202 000220'02 000000000000# 36203 000444'04 040 050 160 141 147 36204 002142'01 263 17 0 00 000000 ret 36205 36206 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 35 K20SRV MAC 9-Jun-23 23:24 REMOTE SPACE 36207 subttl REMOTE SPACE 36208 36209 remark REMOTE SPACE parsing 36210 36211 002143'01 .xdisk: entry .xdisk ;[220] 36212 002143'01 200 16 0 00 000000# guide 36213 002144'01 260 17 0 00 002076* 36214 000221'02 000000000000# 36215 000446'04 165 163 141 147 145 36216 002145'01 260 17 0 00 002077* confrm 36217 002146'01 263 17 0 00 000000 ret 36218 36219 remark REMOTE SPACE execution 36220 36221 002147'01 $xdisk: entry $xdisk ;[220] 36222 002147'01 260 17 0 00 002072* call statim ;[189] Start timing so k20pdc doesn't choke 36223 dmove t1, [ 36224 point 7, [asciz/U/] ; U command for data field. 36225 002150'01 120 01 0 00 005702' "G" ] ; Packet type is G. 36226 002151'01 254 00 0 00 004601' jrst dosrv 36227 36228 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 36 K20SRV MAC 9-Jun-23 23:24 LOCAL STATISTICS 36229 subttl LOCAL STATISTICS 36230 36231 ; Parse rest of STATISTICS command. 36232 36233 002152'01 .stat: entry .stat 36234 002152'01 200 16 0 00 000000# guide 36235 002153'01 260 17 0 00 002144* 36236 000222'02 000000000000# 36237 000451'04 141 142 157 165 164 36238 002154'01 260 17 0 00 002145* confrm 36239 002155'01 263 17 0 00 000000 ret 36240 36241 remark LOCAL STATUS execution 36242 36243 ;[189] All part of edit [189] 36244 36245 002156'01 $ysrvt: entry $ysrvt 36246 extern $srvt,statxt ;[194] Our necessary 36247 002156'01 260 17 0 00 000000* call $srvt ; Format the stuff 36248 002157'01 561 01 0 00 000000* hrroi t1,statxt ; Point to text it built 36249 002160'01 104 00 0 00 000076 PSOUT% ; Print it 36250 002161'01 320 12 0 00 002107* erjmpr r ; Get error, get out of here 36251 002162'01 263 17 0 00 000000 ret ; Get out of here 36252 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 37 K20SRV MAC 9-Jun-23 23:24 REMOTE STATUS 36253 subttl REMOTE STATUS 36254 36255 ;[189] Begin Code Insertion 36256 36257 remark REMOTE STATUS parsing 36258 36259 002163'01 .xstat: entry .xstat ;[220] 36260 002163'01 200 16 0 00 000000# guide 36261 002164'01 260 17 0 00 002153* 36262 000223'02 000000000000# 36263 000456'04 157 146 040 154 141 36264 002165'01 260 17 0 00 002154* confrm 36265 002166'01 263 17 0 00 000000 ret 36266 36267 remark REMOTE STATUS execution 36268 36269 002167'01 336 00 0 00 001767* $xstat: ifmn. tlgjfn ;[233] Doing transaction logging? 36270 002170'01 254 00 0 00 002201' 36271 002171'01 415 16 0 00 002201' block. ;[233] Get a stack frame 36272 002172'01 261 17 0 00 000016 36273 002173'01 265 16 0 00 005507' saveac ;[233] Save even the temporaries 36274 002174'01 265 01 0 00 001774* wtlog(,) ;[233] 36275 002175'01 000000000000# 36276 002176'01 777777 777732 36277 002177'01 000000 000000 36278 000462'04 122 145 161 165 145 36279 002200'01 263 17 0 00 000000 endbk. ;[233] Release stack frame, restoring AC's 36280 002201'01 endif. ;[233] 36281 36282 002201'01 260 17 0 00 002147* call statim ;[189] Start timing so k20pdc doesn't choke 36283 dmove t1, [ 36284 point 7, [asciz/Q/] ; 'Q' command for data field. 36285 002202'01 120 01 0 00 005705' "G" ] ; Packet type is G. 36286 002203'01 254 00 0 00 004601' jrst dosrv 36287 36288 ;[198] End Code Insertion 36289 36290 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 38 K20SRV MAC 9-Jun-23 23:24 LOCAL TYPE [143] 36291 subttl LOCAL TYPE [143] 36292 36293 chgsec(code,const) ;;Tables and fdb's go in const 36294 000224'02 100120 000000 typbk: gj%old!gj%ifg!gj%flg ; Flag bits,,most recent generation. 36295 000225'02 000100 000101 .priin,,.priou ; COMND i/o. 36296 repeat 6,<0> ; No defaults, except all generations. 36297 000226'02 000000 000000 36298 000227'02 000000 000000 36299 000230'02 000000 000000 36300 000231'02 000000 000000 36301 000232'02 000000 000000 36302 000233'02 000000 000000 36303 000010 typbkl==<.-typbk> ; Length of this GTJFN argument block. 36304 36305 000234'02 006000 000236' typfdb: flddb. .cmfil,,,,,typfd1 36306 000235'02 000000 000000 36307 000236'02 016001 000000 typfd1: flddb. .cmdev,cm%sdh ;[193] 36308 000237'02 000000 000000 36309 retsec 36310 cleans() 36311 36312 002204'01 .ytype: entry .ytype 36313 002204'01 200 01 0 00 005605' movx t1, cz%ncl!.fhslf ; Close any nonopen JFNs. 36314 002205'01 104 00 0 00 000034 CLZFF 36315 002206'01 320 12 0 00 002207' erjmpr .+1 ;[194] Catch and ignore any odd error 36316 002207'01 200 16 0 00 000000# guide ; Issue guide words. 36317 002210'01 260 17 0 00 002164* 36318 000240'02 000000000000# 36319 000472'04 146 151 154 145 163 36320 36321 002211'01 200 01 0 00 005707' move t1, [typbk,,cjfnbk] ; Insert our file parsing defaults. 36322 002212'01 251 01 0 00 000000# blt t1, cjfnbk+typbkl ; Same as for DELETE. 36323 002213'01 201 01 0 00 000000# movei t1, typfdb ;[193] 36324 002214'01 260 17 0 00 001675* call rfield ;[193] Parse something 36325 002215'01 200 05 0 00 000002 move q1, t2 ;[193] Store whatever we got 36326 002216'01 135 07 0 00 005470' ldb q3, [pointr (.cmfnp(t3),cm%fnc)] ;[193] Get function code. 36327 36328 002217'01 302 07 0 00 000016 caie q3, .cmdev ;[193] Picked up a device? 36329 002220'01 254 00 0 00 002251' ifskp. ;[193] Yes, let's see if we can work with it 36330 002221'01 265 16 0 00 001300* anstkv(t4,^d4) ;[193] 20 characters of device name 36331 002222'01 000000 000004 36332 002223'01 415 04 0 17 777773 36333 002224'01 402 00 0 04 000000 setzm (t4) ;[193] Let's scrub a bit of it 36334 002225'01 560 01 0 00 000004 hrro t1, t4 ;[193] Create a Tops-20 ASCII pointer 36335 002226'01 104 00 0 00 000121 DEVST% ;[193] Turn it into a string (I hope) 36336 002227'01 320 12 0 00 002231' ifje. r ;[193] Failed?? 36337 002230'01 254 00 0 00 002234' 36338 002231'01 200 03 0 00 000001 move t3, t1 ;[193] Save error code for debuggers 36339 002232'01 474 06 0 00 000000 seto q2, ;[193] Cons up an impossible JFN 36340 002233'01 254 00 0 00 002250' else. ;[193] Otherwise, have a string we can maybe use 36341 002234'01 120 02 0 00 005607' dmove t2, [ exp ":", 0] ;[193] Load final characters 36342 002235'01 136 02 0 00 000001 idpb t2, t1 ;[193] Punctuate the device 36343 002236'01 136 03 0 00 000001 idpb t3, t1 ;[193] Tie off the device string 36344 002237'01 205 01 0 00 000021 movx t1, ;[193] Short form, want flags 36345 002240'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 15:19 11-Jun-23 Page 38-1 K20SRV MAC 9-Jun-23 23:24 LOCAL TYPE [143] 36346 002241'01 104 00 0 00 000020 GTJFN% ;[193] Try to get a handle 36347 002242'01 320 12 0 00 002244' ifje. r ;[193] Sigh... 36348 002243'01 254 00 0 00 002247' 36349 002244'01 200 03 0 00 000001 move t3, t1 ;[193] Save error code for debuggers 36350 002245'01 474 06 0 00 000000 seto q2, ;[193] Cons up an impossible JFN 36351 002246'01 254 00 0 00 002250' else. ;[193] Otherwise, worked 36352 002247'01 200 06 0 00 000001 move q2, t1 ;[193] Put JFN in a COMND% kind of place 36353 002250'01 endif. ;[193] 36354 002250'01 endif. ;[193] End case of DEVST% handling 36355 002250'01 254 00 0 00 002252' else. ;[193] Otherwise, got a JFN 36356 002251'01 200 06 0 00 000005 move q2, q1 ;[193] Put JFN in a COMND% kind of place 36357 002252'01 endif. ;[193] End case .cmdev transmogrification 36358 36359 002252'01 337 01 0 00 000006 skipg t1, q2 ;[193] Load the JFN, unless we couldn't get one 36360 002253'01 200 01 0 00 000005 move t1, q1 ;[193] Otherwise, load the device 36361 002254'01 200 04 0 00 000001 move t4, t1 ;[193] Save a handy copy 36362 002255'01 260 17 0 00 001221* call isnulj ;[193] Is this NUL:? 36363 002256'01 254 00 0 00 002261' ifskp. ;[193] Yes, so let's fix up the parse 36364 002257'01 200 06 0 00 000001 move q2, t1 ;[193] Store the .nulio in there 36365 002260'01 254 00 0 00 002323' else. ;[193] Otherwise, isn't NUL: 36366 002261'01 200 01 0 00 000004 move t1, t4 ;[193] Load whatever we parsed 36367 002262'01 302 07 0 00 000016 caie q3, .cmdev ;[193] Did we parse a device? 36368 002263'01 254 00 0 00 002266' ifskp. ;[193] We did 36369 002264'01 200 01 0 00 000005 move t1, q1 ;[193] so use that 36370 002265'01 254 00 0 00 002267' else. ;[193] Otherwise, got a JFN 36371 002266'01 621 01 0 00 777777 tlz t1, -1 ;[193] So use that 36372 002267'01 endif. 36373 002267'01 104 00 0 00 000117 DVCHR% ;[198] Let's find out about the device 36374 002270'01 320 12 0 00 002272' %jserr (,r) ;[193] 36375 002271'01 254 00 0 00 002275' 36376 002272'01 265 01 0 00 002105* 36377 002273'01 000000000000# 36378 002274'01 254 00 0 00 002161* 36379 000474'04 124 171 160 145 040 36380 002275'01 135 03 0 00 005471' ldb t3,[pointr t2, dv%typ] ;[193] Pick up the device type 36381 002276'01 306 03 0 00 000000 cain t3, .dvdsk ;[193] Isn't a disk? 36382 002277'01 254 00 0 00 002323' anskp. ;[193] It is, so we're fine 36383 002300'01 200 02 0 00 000001 move t2, t1 ;[193] Load device designator for DEVST% 36384 002301'01 561 01 0 00 000003 hrroi t1, t3 ;[193] String is going in the registers 36385 002302'01 403 03 0 00 000004 setzb t3, t4 ;[193] Get 9 characters of device (only need 6) 36386 002303'01 104 00 0 00 000121 DEVST% ;[193] Get a string representation 36387 002304'01 320 12 0 00 002306' ifje. r ;[193] Pick up and ignore error 36388 002305'01 254 00 0 00 002310' 36389 002306'01 200 02 0 00 000001 move t2, t1 ;[193] Save error code for debuggers 36390 002307'01 120 03 0 00 005626' dmove t3, [asciz /Unknown/] ;[193] Phoney up something 36391 002310'01 endif. ;[193] 36392 002310'01 337 01 0 00 000006 skipg t1, q2 ;[193] Load the JFN 36393 002311'01 254 00 0 00 002315' ifskp. ;[193] If it was a JFN... 36394 002312'01 621 01 0 00 777777 tlz t1, -1 ;[193] Stomp any flags 36395 002313'01 104 00 0 00 000023 RLJFN% ;[193] Toss it 36396 002314'01 320 12 0 00 002315' erjmpr .+1 ;[193] Catch and ignore error 36397 002315'01 endif. ;[193] 36398 002315'01 561 01 0 00 000003 hrroi t1, t3 ;[193] String is coming from registers 36399 002316'01 104 00 0 00 000313 ESOUT% ;[193] Begin complaining 36400 txmsg <: is not a directory structured device k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 38-2 K20SRV MAC 9-Jun-23 23:24 LOCAL TYPE [143] 36401 002317'01 200 01 0 00 000000# > ;[193] Complete the blat 36402 002320'01 104 00 0 00 000076 36403 002321'01 320 12 0 00 002322' 36404 000241'02 000000000000# 36405 000506'04 072 040 151 163 040 36406 36407 002322'01 254 00 0 00 001266* callret cmder1 ;[193] Allow a reparse 36408 002323'01 endif. ;[193] 36409 36410 002323'01 260 17 0 00 002165* confrm ;[193] Tie off the line 36411 002324'01 202 06 0 00 001707* movem q2, pars3 ; Here's the JFN just parsed. 36412 002325'01 263 17 0 00 000000 ret 36413 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 39 K20SRV MAC 9-Jun-23 23:24 LOCAL TYPE command execution. 36414 subttl LOCAL TYPE command execution. 36415 36416 002326'01 $ytype: entry $ytype ;[194] Maybe move this? 36417 002326'01 337 01 0 00 002324* skipg t1, pars3 ; Get the JFN. 36418 002327'01 263 17 0 00 000000 ret ; Junk, just don't do anything ... 36419 36420 002330'01 265 16 0 00 005460' saveac ; Save for fast copy of current JFN 36421 002331'01 200 05 0 00 000001 move q1, t1 ; Save the JFN (and its flags) 36422 002332'01 260 17 0 00 002255* call isnulj ; BUT!! Is this JFN open on NUL:? 36423 002333'01 254 00 0 00 002342' ifskp. ; It is, so fix some things up 36424 002334'01 202 01 0 00 001335* movem t1, filjfn ; Let's say .nulio is 'open' 36425 002335'01 202 01 0 00 001366* movem t1, nxtjfn ; And that it is our next JFN 36426 002336'01 202 01 0 00 001507* movem t1, ndxjfn ; Store as our pseudo-stepping JFN 36427 002337'01 502 05 0 00 002336* hllm q1, ndxjfn ; Also store original flags on NUL: 36428 002340'01 550 05 0 00 000001 hrrz q1, t1 ; And over the previous JFN and flags 36429 002341'01 254 00 0 00 002376' else. ; Otherwise, set up for real file stepping. 36430 002342'01 550 01 0 00 000005 hrrz t1, q1 ;[220] Load just the JFN, no flags 36431 002343'01 260 17 0 00 004667' call isdird ;[193] But! Did somebody slip something phonkey in? 36432 002344'01 254 00 0 00 002351' ifskp. ;[193] Nope, this is a directory device 36433 002345'01 202 05 0 00 002337* movem q1, ndxjfn ; Store JFN and flags 36434 002346'01 552 05 0 00 002335* hrrzm q1, nxtjfn ; Just the JFN, no flags 36435 002347'01 402 00 0 00 002334* setzm filjfn ; No file currently open 36436 002350'01 254 00 0 00 002376' else. ;[193] Otherwise, not NUL:, so we can't use this 36437 002351'01 265 16 0 00 002221* anstkv(q2,^d4) ;[193] 20 characters of device name 36438 002352'01 000000 000004 36439 002353'01 415 06 0 17 777773 36440 002354'01 403 03 0 00 000004 setzb t3, t4 ;[193] Cons up some NUL's 36441 002355'01 124 03 0 06 000000 dmovem t3, 0(q2) ;[193] Let's scrub 36442 002356'01 124 03 0 06 000002 dmovem t3, 2(q2) ;[193] a dub dub 36443 002357'01 561 01 0 06 000000 hrroi t1, 0(q2) ;[193] Tops-20 pointer to beginning of buffer 36444 002360'01 550 02 0 00 000005 hrrz t2, q1 ;[193] Load the JFN, sans flags 36445 dmove t3, [fld(.jsaof,js%dev)!js%paf 36446 002361'01 120 03 0 00 005710' 0 ] ;[193] Just the punctuated device, no prefix 36447 002362'01 104 00 0 00 000030 JFNS% ;[193] Convert it 36448 002363'01 320 12 0 00 002365' ifje. r ;[193] Failed?? 36449 002364'01 254 00 0 00 002370' 36450 002365'01 200 02 0 00 000001 move t2, t1 ;[193] Save the error for debuggers 36451 002366'01 120 03 0 00 005712' dmove t3, [ asciz /Unknown:/ ] ;[193] 36452 002367'01 124 03 0 06 000000 dmovem t3, 0(q2) ;[193] Store some kind of message... 36453 002370'01 endif. 36454 002370'01 561 01 0 06 000000 hrroi t1, 0(q2) ;[193] Tops-20 pointer to beginning of buffer 36455 002371'01 104 00 0 00 000313 ESOUT% ;[193] Begin whining 36456 txmsg < is not a directory structured device 36457 002372'01 200 01 0 00 000000# > 36458 002373'01 104 00 0 00 000076 36459 002374'01 320 12 0 00 002375' 36460 000242'02 000000000000# 36461 000517'04 040 151 163 040 156 36462 36463 002375'01 254 00 0 00 002460' jrst $ytypz ;[193] Finally get out of here 36464 002376'01 endif. ;[193] End directory device double check 36465 002376'01 endif. ;[193] End NUL: 'directory' special check 36466 36467 002376'01 260 17 0 00 002035* call ccon ;[169] Allow ^C out of this. 36468 002377'01 254 00 0 00 002455' jrst $ytypy ;[169] Upon ^C, get out of here k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 39-1 K20SRV MAC 9-Jun-23 23:24 LOCAL TYPE command execution. 36469 36470 002400'01 do. ; Enter loop context 36471 002400'01 260 17 0 00 004720' call gtnfil ; Any more files? 36472 002401'01 254 00 0 00 002455' exit. ; Nope, beat it 36473 002402'01 550 05 0 00 000001 hrrz q1, t1 ; OK, so save what we're doing now 36474 002403'01 260 17 0 00 000000* call clrcno ; Clear Control-O, if set 36475 002404'01 561 01 0 00 002063* hrroi t1, crlf ; Tie off the line 36476 002405'01 104 00 0 00 000076 PSOUT% 36477 002406'01 201 01 0 00 000101 movei t1, .priou ; Going to primary output 36478 002407'01 200 02 0 00 000005 move t2, q1 ; Load the current JFN to do 36479 002410'01 260 17 0 00 000000* call typnam ; Type the file name 36480 002411'01 254 00 0 00 002455' exit. ; Stop processing files on error 36481 002412'01 200 01 0 00 000005 move t1, q1 ; Load JFN 36482 002413'01 302 01 0 00 377777 caie t1, .nulio ;[193] Not actually typing anything? 36483 002414'01 254 00 0 00 002417' ifskp. ;[193] No, so that's easy to set up 36484 002415'01 201 03 0 00 000010 movx t3, ^d8 ;[193] Assume NUL: is always eight bit 36485 002416'01 254 00 0 00 002441' else. ;[193] Otherwise, a real JFN, maybe? 36486 002417'01 200 02 0 00 005714' move t2, [1,,.fbbyv] ;Get bytesize. 36487 002420'01 201 03 0 00 000004 movei t3, t4 36488 002421'01 104 00 0 00 000063 GTFDB 36489 002422'01 320 12 0 00 002424' ifje. r ;[194] Might fail if not disk 36490 002423'01 254 00 0 00 002427' 36491 002424'01 200 03 0 00 000001 move t3, t1 ;[194] Save error code for debugger 36492 002425'01 400 04 0 00 000000 setz t4, ;[194] If failed, say no byte size 36493 002426'01 200 01 0 00 000005 move t1, q1 ;[194] Reload JFN 36494 002427'01 endif. ;[194] 36495 002427'01 200 02 0 00 005715' movx t2, of%rd+fld(7,of%bsz) ; Assume 7-bit mode. 36496 002430'01 135 03 0 00 005716' ldb t3, [pointr (t4,fb%bsz)] ; Extract the bytesize. 36497 002431'01 306 03 0 00 000010 cain t3, ^d8 ; 8 bit? 36498 002432'01 200 02 0 00 005717' movx t2, of%rd+fld(^d8,of%bsz) ; Yes, 8-bit. 36499 002433'01 104 00 0 00 000021 OPENF ; Open the file in appropriate mode. 36500 002434'01 320 12 0 00 002436' %jserr (,endlp.) 36501 002435'01 254 00 0 00 002441' 36502 002436'01 265 01 0 00 002272* 36503 002437'01 000000000000# 36504 002440'01 254 00 0 00 002455' 36505 000527'04 103 157 165 154 144 36506 002441'01 endif. ;[193] End .nulio special casing 36507 002441'01 260 17 0 00 000000* call typfil ; Type the file 36508 002442'01 254 00 0 00 002455' exit. ; If failed, go no further 36509 002443'01 200 01 0 00 000005 move t1, q1 ; Close the file. 36510 002444'01 302 01 0 00 377777 caie t1, .nulio ; Unless there is no need 36511 002445'01 104 00 0 00 000022 CLOSF 36512 002446'01 320 12 0 00 002450' %jserr (,endlp.) 36513 002447'01 254 00 0 00 002453' 36514 002450'01 265 01 0 00 002436* 36515 002451'01 000000000000# 36516 002452'01 254 00 0 00 002455' 36517 000535'04 103 157 165 154 144 36518 002453'01 400 05 0 00 000000 setz q1, ;[194] Done with this file 36519 002454'01 254 00 0 00 002400' loop. ;[194] Do the next file 36520 002455'01 enddo. ;[193] End loop context 36521 36522 002455'01 260 17 0 00 002041* $ytypy: call ccoff ; Turn off ^C 36523 002456'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 15:19 11-Jun-23 Page 39-2 K20SRV MAC 9-Jun-23 23:24 LOCAL TYPE command execution. 36524 002457'01 600 00 0 00 000000 nop ; Ignore any error 36525 36526 002460'01 322 05 0 00 002463' $ytypz: ifn. q1 ; Any JFN left lying around maybe? 36527 002461'01 200 01 0 00 000005 move t1, q1 ; OK, so load it 36528 002462'01 260 17 0 00 000000* call frclos ; Force it to close 36529 002463'01 endif. 36530 002463'01 263 17 0 00 000000 ret ; No more, done. 36531 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 40 K20SRV MAC 9-Jun-23 23:24 REMOTE TYPE command execution. 36532 subttl REMOTE TYPE command execution. 36533 36534 002464'01 $xtype: entry $xtype 36535 002464'01 336 00 0 00 002167* ifmn. tlgjfn ;[233] Doing transaction logging? 36536 002465'01 254 00 0 00 002507' 36537 002466'01 415 16 0 00 002507' block. ;[233] Get a stack frame 36538 002467'01 261 17 0 00 000016 36539 002470'01 265 16 0 00 005507' saveac ;[233] Save even the temporaries 36540 002471'01 476 00 0 00 001653* setom scrlft ;[233] Don't append the crlf! 36541 002472'01 265 01 0 00 002174* wtlog(,) ;[233] 36542 002473'01 000000000000# 36543 002474'01 777777 777744 36544 002475'01 000000 000000 36545 000543'04 122 145 161 165 145 36546 002476'01 200 01 0 00 002464* move t1, tlgjfn ;[233] Put the directory name in the log 36547 002477'01 561 02 0 00 001661* hrroi t2,atmbuf ;[233] It's in the atom buffer 36548 002500'01 403 03 0 00 000004 setzb t3,t4 ;[233] Don't know how long, stop on a NUL 36549 002501'01 104 00 0 00 000053 SOUT% ;[233] Out it goes! 36550 002502'01 320 14 0 00 002503' erjmps .+1 ;[233] Catch and suppress error 36551 dmove t2,[ -1,,crlf ;[233] Tops-20 pointer to carriage return line feed 36552 002503'01 120 02 0 00 005611' -2 ] ;[233] Counted SOUT%'s are faster 36553 002504'01 104 00 0 00 000053 SOUT% ;[233] Out it goes! 36554 002505'01 320 14 0 00 002506' erjmps .+1 ;[233] Catch and suppress error 36555 002506'01 263 17 0 00 000000 endbk. ;[233] Release stack frame, restoring AC's 36556 002507'01 endif. ;[233] 36557 36558 002507'01 260 17 0 00 002201* call statim ;[189] Start timing so k20pdc doesn't choke 36559 002510'01 201 04 0 00 000124 movei t4, "T" ; Generic command is T. 36560 002511'01 254 00 0 00 004555' jrst srvfil 36561 36562 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 41 K20SRV MAC 9-Jun-23 23:24 Server Operation 36563 subttl Server Operation 36564 36565 ; GETCOM 36566 ; 36567 ; We come here if we are in server mode. We just wait for a packet of one of 36568 ; the following types: 36569 ; 36570 ; S Send init - just follow the normal path from here 36571 ; R Receive init - like a local "send filespec" 36572 ; I Init (all-purpose exchange of parameters) 36573 ; G Generic command: 36574 ; L Logout - the other side is done, log out this job 36575 ; F Finish - exit from Kermit 36576 ; U Disk Usage query 36577 ; T Type a file 36578 ; etc 36579 ; 36580 ; First, issue a message telling the user what to do. 36581 ; 36582 002512'01 getcom: entry getcom ;[194] Also invoked from k20par 36583 movei t1, [ ;[157] In case line gets XOFF'd while 36584 call ttxon ;[157] typing the message, unstick it, 36585 002512'01 201 01 0 00 005720' jrst getcm2 ] ;[157] and proceed. 36586 002513'01 260 17 0 00 000000* call timeit ;[157] Set the timer. 36587 002514'01 336 00 0 00 002015* ifmn. local ;[174] Local mode? 36588 002515'01 254 00 0 00 002542' 36589 txmsg < 36590 002516'01 200 01 0 00 000000# Entering server mode on TTY> ;[174] Yes, give appropriate message. 36591 002517'01 104 00 0 00 000076 36592 002520'01 320 12 0 00 002521' 36593 000243'02 000000000000# 36594 000551'04 015 012 040 105 156 36595 002521'01 201 01 0 00 000101 numout ttynum, 8 36596 002522'01 200 02 0 00 000000* 36597 002523'01 201 03 0 00 000010 36598 002524'01 104 00 0 00 000224 36599 002525'01 320 14 0 00 002526' 36600 002526'01 337 02 0 00 000000* skipg t2, speed ;[194] Load speed 36601 002527'01 254 00 0 00 002541' ifskp. ;[194] If we have one .. 36602 002530'01 200 01 0 00 000000# txmsg <, > 36603 002531'01 104 00 0 00 000076 36604 002532'01 320 12 0 00 002533' 36605 000244'02 000000000000# 36606 000560'04 054 040 000 000 000 36607 002533'01 201 01 0 00 000101 movei t1, .priou ;[194] 36608 002534'01 201 03 0 00 000012 movei t3, ^d10 ;[194] 36609 002535'01 104 00 0 00 000224 NOUT% 36610 002536'01 200 01 0 00 000000# txmsg < baud> 36611 002537'01 104 00 0 00 000076 36612 002540'01 320 12 0 00 002541' 36613 000245'02 000000000000# 36614 000561'04 040 142 141 165 144 36615 002541'01 endif. ;[194] 36616 002541'01 254 00 0 00 002552' jrst getcmm ;[174] 36617 002542'01 endif. ;[194] k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 41-1 K20SRV MAC 9-Jun-23 23:24 Server Operation 36618 36619 txmsg < 36620 002542'01 200 01 0 00 000000# Kermit Server running on > ;[186] 36621 002543'01 104 00 0 00 000076 36622 002544'01 320 12 0 00 002545' 36623 000246'02 000000000000# 36624 000563'04 015 012 040 113 145 36625 002545'01 561 01 0 00 000000* hrroi t1,sysnam## ;[186] Load local node name 36626 002546'01 104 00 0 00 000076 PSOUT% ;[186] Type it, not "DEC-20" 36627 txmsg < host. Please type your escape 36628 sequence to return to your local machine. Shut down the server by 36629 002547'01 200 01 0 00 000000# typing the BYE command to KERMIT on your local machine.> ;[186] 36630 002550'01 104 00 0 00 000076 36631 002551'01 320 12 0 00 002552' 36632 000247'02 000000000000# 36633 000571'04 040 150 157 163 164 36634 36635 36636 36637 getcmm: txmsg < 36638 002552'01 200 01 0 00 000000# > 36639 002553'01 104 00 0 00 000076 36640 002554'01 320 12 0 00 002555' 36641 000250'02 000000000000# 36642 000631'04 015 012 000 000 000 36643 002555'01 260 17 0 00 000000* getcm2: call timoff ;[157] Turn off timer. 36644 002556'01 260 17 0 00 002507* call statim ;[189] Give k20pdc something to not choke on 36645 002557'01 476 00 0 00 000000* setom srvflg ; Flag that we are serving. 36646 002560'01 260 17 0 00 000000* call inilin ; Initialize the line. 36647 002561'01 260 17 0 00 002376* call ccon ; Don't let someone ^C without reseting line. 36648 002562'01 254 00 0 00 003101' jrst xgfin2 ; On control-C, go "finish". 36649 002563'01 403 03 0 00 000004 setzb t3, t4 ; Set default parameters in case we get some 36650 002564'01 124 03 0 00 000000* dmovem t3, delay ;[212] No delay in server mode (gets floating value) 36651 002565'01 260 17 0 00 000000* call spar ; command before first Send-Init or Info. 36652 002566'01 254 00 0 00 002567' jrst xxwait ; Go wait for a command packet. 36653 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 42 K20SRV MAC 9-Jun-23 23:24 Server command loop 36654 subttl Server command loop 36655 36656 ; Server commands should always jrst back to here, even upon error, 36657 ; except for those that specify exit from server mode. 36658 36659 002567'01 332 00 0 00 000000* xxwait: skipe mdmlin ;[130] Modem line? 36660 002570'01 332 00 0 00 000000* skipe carier ;[130] Did carrier drop? 36661 002571'01 334 00 0 00 000000 skipa ;[130] No. 36662 002572'01 254 00 0 00 003101' jrst xgfin2 ;[130] Yes, go clean up. 36663 36664 002573'01 476 00 0 00 000000* setom sptot ;[134] Clear packet statistics counters 36665 002574'01 476 00 0 00 000000* setom rptot ;[134] ... 36666 002575'01 402 00 0 00 000000* setzm xflg ; Clear the server "type" flag. 36667 002576'01 402 00 0 00 000000* setzm source ; Ditto for GETCH source. 36668 002577'01 402 00 0 00 000000* setzm dest ; Ditto for PUTCH destination. 36669 002600'01 402 00 0 00 001505* setzm ffunc ; And for file function. 36670 002601'01 120 01 0 00 000000* dmove t1, srvtim ;[212] ; Get the default server packet time out. 36671 002602'01 124 01 0 00 000000* dmovem t1, stimou ;[212] ; Set it so we don't time out as often. 36672 36673 002603'01 do. ;[194] Enter loop context 36674 002603'01 476 00 0 00 000000* setom bctone ;[98] Set this so we use type 1 checksum. 36675 002604'01 402 00 0 00 001744* setzm pktnum ; Initial packet sequence number. 36676 002605'01 260 17 0 00 000000* call rpack ; Get a packet. 36677 002606'01 254 00 0 00 002623' ifskp. ;[194] Worked 36678 002607'01 306 01 0 00 000124 cain t1, "T" ;[194] But!! A TIMER interrupt pseudo packet? 36679 002610'01 254 00 0 00 002623' anskp. ; On timeout, NAK what we're looking for. 36680 002611'01 301 01 0 00 000101 cail t1, "A" ;[150] Packet type in range? 36681 002612'01 303 01 0 00 000132 caile t1, "Z" ;[150] 36682 002613'01 334 00 0 00 000000 kermsg (,xxwait) ;[150] No. 36683 002614'01 254 00 0 00 002621' 36684 002615'01 265 01 0 00 000000* 36685 002616'01 000000 000043 36686 002617'01 000000000000# 36687 002620'01 254 00 0 00 002567' 36688 000632'04 120 141 143 153 145 36689 002621'01 254 00 0 00 002627' exit. ;[194] Otherwise, goo so break out of the loop 36690 002622'01 254 00 0 00 002627' else. ;[194] Some kind of error 36691 002623'01 200 02 0 00 002604* move t2, pktnum ; Load current packet number 36692 002624'01 260 17 0 00 000000* call nak ; NAK that "packet". 36693 002625'01 254 00 0 00 002603' loop. ;[194] Go round again. 36694 002626'01 254 00 0 00 002603' loop. ; (no matter what) 36695 002627'01 endif. ;[194] End packet reception analysis 36696 002627'01 enddo. ;[194] End loop lexical context 36697 36698 ; Got a real command. Restore the normal timeout interval and do the command. 36699 36700 002627'01 202 02 0 00 002623* movem t2, pktnum ; Save packet number. 36701 002630'01 261 17 0 00 000001 push p, t1 ; We can't use any normal AC's here... 36702 002631'01 261 17 0 00 000002 push p, t2 ;[212] Ditto floating display value 36703 002632'01 120 01 0 00 000000* dmove t1, otimou ;[212] Put normal timeout back. 36704 002633'01 124 01 0 00 002602* dmovem t1, stimou ;[212] 36705 002634'01 262 17 0 00 000002 pop p, t2 ;[212] Restore this, too 36706 002635'01 262 17 0 00 000001 pop p, t1 36707 002636'01 275 01 0 00 000101 subi t1, "A" ;[194] Get into range (easier to debug) 36708 002637'01 254 00 1 01 002640' jrst @xxcmd(t1) ;[150] Go do the indicated command. k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 42-1 K20SRV MAC 9-Jun-23 23:24 Server command loop 36709 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 43 K20SRV MAC 9-Jun-23 23:24 Server command loop 36710 36711 ;[150] Server command dispatch table and error message routines. 36712 36713 36714 002640'01 000000 002676' xxcmd: xxinv ; A - Attributes, shouldn't come now 36715 002641'01 000000 002676' xxinv ; B - EOT, shouldn't come now 36716 002642'01 000000 002763' xhost ; C - Host Command 36717 002643'01 000000 002676' xxinv ; D - Data, shouldn't come now 36718 002644'01 000000 002567' xxwait ; E - Error, just ignore 36719 002645'01 000000 002676' xxinv ; F - File header, shouldn't come now 36720 002646'01 000000 002771' xgen ; G - Generic Command 36721 002647'01 000000 002673' xxunk ; H - Undefined 36722 002650'01 000000 003224' xinfo ; I - Info Packet 36723 002651'01 000000 002673' xxunk ; J - Undefined 36724 002652'01 000000 002673' xxunk ; K - Undefined 36725 002653'01 000000 002673' xxunk ; L - Undefined 36726 002654'01 000000 002673' xxunk ; M - Undefined 36727 002655'01 000000 002567' xxwait ; N - NAK, ignore 36728 002656'01 000000 002673' xxunk ; O - Undefined 36729 002657'01 000000 002673' xxunk ; P - Undefined 36730 002660'01 000000 002673' xxunk ; Q - Undefined 36731 002661'01 000000 002727' xrecv ; R - Receive (GET), server sends 36732 002662'01 000000 002711' xsend ; S - Send, server receives 36733 002663'01 000000 002567' xxwait ; T - (Already handled specially above) 36734 002664'01 000000 002673' xxunk ; U - Undefined 36735 002665'01 000000 002673' xxunk ; V - Undefined 36736 002666'01 000000 002673' xxunk ; W - Undefined 36737 002667'01 000000 002676' xxinv ; X - Text Header, shouldn't come now 36738 002670'01 000000 002567' xxwait ; Y - ACK, ignore 36739 002671'01 000000 002676' xxinv ; Z - EOF, shouldn't come now 36740 002672'01 000000 000000 0 ; (superstition) 36741 36742 ; Routine to issue informative error messages. 36743 36744 002673'01 200 04 0 00 005722' xxunk: move t4, [point 7, xxumsg] ; Get "unknown command" message. 36745 002674'01 201 03 0 00 000034 movei t3, xxulen ; And its length 36746 002675'01 254 00 0 00 002700' jrst xxmsg 36747 36748 002676'01 200 04 0 00 005723' xxinv: move t4, [point 7, xxbmsg] ; Get "invalid use of..." message. 36749 002677'01 201 03 0 00 000041 movei t3, xxblen ; And its lentgh. 36750 36751 002700'01 261 17 0 00 000004 xxmsg: push p, t4 ; Save msg pointer. 36752 002701'01 133 00 0 00 000004 ibp t4 ; Point past opening quote. 36753 002702'01 136 01 0 00 000004 idpb t1, t4 ; Deposit the packet type. 36754 002703'01 201 01 0 00 000105 movei t1, "E" ; Send an Error packet. 36755 002704'01 200 02 0 00 002627* move t2, pktnum ; This is the packet number. 36756 002705'01 262 17 0 00 000004 pop p, t4 ; Get original pointer back. 36757 002706'01 260 17 0 00 001746* call spack ; Send the error packet. 36758 002707'01 600 00 0 00 000000 nop 36759 002710'01 254 00 0 00 002567' jrst xxwait ; Go back to command wait. k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 44 K20SRV MAC 9-Jun-23 23:24 Server command loop 36760 36761 subttl Server commands. 36762 36763 ; Server SEND command (i.e. send to me, I'm the server, I receive the files.) 36764 ; 36765 ; We've just received a Send-Init. 36766 ; 36767 002711'01 402 00 0 00 000000* xsend: setzm numtry ; Packet retry counter. 36768 002712'01 202 02 0 00 002704* movem t2, pktnum ; Synchronize packet numbers. 36769 002713'01 260 17 0 00 002565* call spar ; Get the Send-Init parameters. 36770 002714'01 200 04 0 00 005724' move t4, [point 8, datbuf] ;[190] ;[50] Now send back our own, 36771 002715'01 260 17 0 00 000000* call rpar ; which we put in the data field of our ACK. 36772 002716'01 201 01 0 00 000131 movei t1, "Y" ; Set up the ACK. 36773 002717'01 200 02 0 00 002712* move t2, pktnum ; Packet number. 36774 002720'01 260 17 0 00 002706* call spack ; Send the packet. 36775 002721'01 254 00 0 00 002567' jrst xxwait ;* Give up if we can't.(?) 36776 002722'01 260 17 0 00 000000* call rrinit ;[126] Set things up for receiving. 36777 002723'01 201 11 0 00 000106 movei state, "F" ; Set the state to file send. 36778 002724'01 260 17 0 00 000000* call $recvs ;[42] Go look like we're receiving. 36779 002725'01 600 00 0 00 000000 nop ; 36780 002726'01 254 00 0 00 002567' jrst xxwait ; Get another command when done. 36781 36782 36783 ; Server RECEIVE (or GET) command -- Server sends files. 36784 ; 36785 ; We've just received a Receive-Init packet, containing a filename. 36786 ; (Or a remote TYPE command). T1-T4 contain packet parameters returned 36787 ; by RPACK. 36788 ; 36789 002727'01 200 01 0 00 000004 xrecv: move t1, t4 ;[141] Pointer to encoded filespec. 36790 002730'01 200 02 0 00 000003 move t2, t3 ;[141] Number of characters. 36791 002731'01 260 17 0 00 000000* call decodf ;[141] Decode it. 36792 002732'01 334 00 0 00 000000 kermsg (, xxwait) ;[141] Can't? Give message. 36793 002733'01 254 00 0 00 002740' 36794 002734'01 265 01 0 00 002615* 36795 002735'01 000000 000040 36796 002736'01 000000000000# 36797 002737'01 254 00 0 00 002567' 36798 000637'04 103 141 156 047 164 36799 002740'01 200 02 0 00 000001 move t2, t1 ;[141] Decoded OK, point to decoded filespec. 36800 36801 ; Entry point when filespec already decoded. 36802 36803 002741'01 205 01 0 00 100101 xrecv2: movx t1, gj%sht!gj%old!gj%ifg ; Old file and allow wildcarding. 36804 002742'01 104 00 0 00 000020 GTJFN% ; Get a JFN. 36805 002743'01 320 14 0 00 002745' %jsker (,xxwait) ; Can't, send error packet and loop. 36806 002744'01 254 00 0 00 002750' 36807 002745'01 265 01 0 00 000000* 36808 002746'01 000000 000000 36809 002747'01 254 00 0 00 002567' 36810 002750'01 202 01 0 00 002345* movem t1, ndxjfn ;[111] Got JFN, save wildcard bits here. 36811 002751'01 552 01 0 00 002346* hrrzm t1, nxtjfn ;[111] Initialize file lookahead. 36812 002752'01 260 17 0 00 002332* call isnulj ;[193] Is this the NUL: device? 36813 002753'01 254 00 0 00 002756' ifskp. ;[193] It is, propagate our talisman 36814 002754'01 552 01 0 00 002751* hrrzm t1, nxtjfn ;[193] Re-initialize file lookahead k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 44-1 K20SRV MAC 9-Jun-23 23:24 Server commands. 36815 002755'01 552 01 0 00 002750* hrrzm t1, ndxjfn ;[193] Save JFN with whacked wildcard bits 36816 002756'01 endif. ;[193] 36817 36818 002756'01 260 17 0 00 004720' call gtnfil ;[111] Get next (in this case, first) file. 36819 002757'01 600 00 0 00 000000 nop ;[111] Could never fail, right? 36820 002760'01 260 17 0 00 000000* call $sends ; Go send the file(s). 36821 002761'01 600 00 0 00 000000 nop ; (in case it skips for some reason...) 36822 002762'01 254 00 0 00 002567' jrst xxwait ; Go back & get another command. 36823 36824 36825 ; HOST command. 36826 36827 002763'01 334 00 0 00 000000 xhost: kermsg (, xxwait) 36828 002764'01 254 00 0 00 002771' 36829 002765'01 265 01 0 00 002734* 36830 002766'01 000000 000050 36831 002767'01 000000000000# 36832 002770'01 254 00 0 00 002567' 36833 000644'04 110 157 163 164 040 36834 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 45 K20SRV MAC 9-Jun-23 23:24 Server commands. 36835 36836 ;[150] Server GENERIC command. Get the subcommand and execute it. 36837 36838 002771'01 134 01 0 00 000004 xgen: ildb t1, t4 ; Get the first character of the data field. 36839 002772'01 301 01 0 00 000101 cail t1, "A" ; Validate. 36840 002773'01 303 01 0 00 000132 caile t1, "Z" 36841 002774'01 334 00 0 00 000000 kermsg (, xxwait) ; Bad. 36842 002775'01 254 00 0 00 003002' 36843 002776'01 265 01 0 00 002765* 36844 002777'01 000000 000047 36845 003000'01 000000000000# 36846 003001'01 254 00 0 00 002567' 36847 000652'04 107 145 156 145 162 36848 36849 003002'01 370 00 0 00 000003 sos t3 ; Command in range, account for it. 36850 003003'01 275 01 0 00 000101 subi t1, "A" ;[194] Command in range, change to table offset 36851 003004'01 306 01 0 00 000121 cain t1, "Q" ;[189] Don't overwrite times on status query!! 36852 003005'01 254 00 1 01 003012' jrst @xxgcmd(t1) ;[194] Dispatch to it. 36853 36854 003006'01 260 17 1 01 003012' call @xxgcmd(t1) ;[189] Go do whatever we're supposed to be doing 36855 003007'01 260 17 0 00 000046* call endtim ;[189] Stop timing 36856 003010'01 260 17 0 00 000047* call elptim ;[189] Compute elapsed time 36857 003011'01 263 17 0 00 000000 ret ;[189] 36858 36859 36860 36861 ;[150] Server generic command dispatch table. 36862 36863 003012'01 000000 003546' xxgcmd: xgpwd ;[188] ; A - PWD 36864 003013'01 000000 003045' xgundf ; B - Undefined 36865 003014'01 000000 003311' xgcwd ; C - CWD 36866 003015'01 000000 003720' xgdir ; D - Directory 36867 003016'01 000000 004051' xgdel ; E - Erase (delete) 36868 003017'01 000000 003053' xgfin ; F - Finish 36869 003020'01 000000 003045' xgundf ; G - Undefined 36870 003021'01 000000 003642' xghelp ; H - Help 36871 003022'01 000000 003050' xgnyi ; I - Login (not yet implemented) 36872 003023'01 000000 003050' xgnyi ; J - Journal control (nyi) 36873 003024'01 000000 003050' xgnyi ; K - Copy (nyi) 36874 003025'01 000000 003114' xglogo ; L - Logout, Bye 36875 003026'01 000000 003050' xgnyi ; M - Short message 36876 003027'01 000000 003045' xgundf ; N - Undef 36877 003030'01 000000 003045' xgundf ; O - Undef 36878 003031'01 000000 003050' xgnyi ; P - Program invocation (nyi) 36879 003032'01 000000 003621' xgstat ; Q - Server status query 36880 003033'01 000000 003050' xgnyi ; R - Rename (nyi) 36881 003034'01 000000 003045' xgundf ; S - Undef 36882 003035'01 000000 003164' xgtype ; T - Type 36883 003036'01 000000 003454' xgdisk ; U - Disk Usage 36884 003037'01 000000 003050' xgnyi ; V - Variable Set/Query 36885 003040'01 000000 003050' xgnyi ; W - Who (Finger) 36886 003041'01 000000 003045' xgundf ; X - Undef 36887 003042'01 000000 003045' xgundf ; Y - Undef 36888 003043'01 000000 003045' xgundf ; Z - Undef 36889 003044'01 000000 000000 0 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 45-1 K20SRV MAC 9-Jun-23 23:24 Server commands. 36890 36891 003045'01 200 04 0 00 005725' xgundf: move t4, [point 7, xxgums] ; Issue message for undefined command. 36892 003046'01 201 03 0 00 000037 movei t3, xxguln 36893 003047'01 254 00 0 00 002700' jrst xxmsg 36894 36895 003050'01 200 04 0 00 005726' xgnyi: move t4, [point 7, xxgnms] ; Issue msg for unimplemented command. 36896 003051'01 201 03 0 00 000043 movei t3, xxgnln 36897 003052'01 254 00 0 00 002700' jrst xxmsg k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 46 K20SRV MAC 9-Jun-23 23:24 Server commands. 36898 36899 ; Generic commands... 36900 36901 36902 ; FINISH. Shut down the server, but don't log out. 36903 36904 003053'01 201 01 0 00 000131 xgfin: movei t1, "Y" ; Acknowledge packet. 36905 003054'01 403 03 0 00 000004 setzb t3, t4 ; No data. 36906 003055'01 260 17 0 00 002720* call spack ; Send the packet. 36907 003056'01 600 00 0 00 000000 nop ;[56] 36908 003057'01 201 01 0 00 003101' movei t1,xgfin2 ;[186] Where to go on a time out 36909 003060'01 260 17 0 00 002513* call timeit ;[186] Start a timer 36910 003061'01 337 01 0 00 000000* skipg t1, netjfn ;[186] Wait until the packet 36911 003062'01 200 01 0 00 000000* move t1, ttyjfn ;[186] Unless using local terminal 36912 003063'01 336 00 0 00 000000* ifmn. ptyflg ;[186] On a pseudo-terminal? 36913 003064'01 254 00 0 00 003075' 36914 003065'01 200 01 0 00 000000* move t1,ptytty ;[186] Load PTY's associated TTY 36915 003066'01 104 00 0 00 000212 DIBE% ;[186] Wait for it to swallow everything 36916 003067'01 320 12 0 00 003071' %jsErr (,) ;[186] 36917 003070'01 254 00 0 00 003074' 36918 003071'01 265 01 0 00 002450* 36919 003072'01 000000000000# 36920 003073'01 254 00 0 00 003074' 36921 000660'04 103 157 165 154 144 36922 003074'01 254 00 0 00 003077' else. ;[186] Otherwise, do it the ordinary way 36923 003075'01 104 00 0 00 000104 DOBE ;[158] gets all the way out. 36924 003076'01 320 12 0 00 003077' erjmpr .+1 ;[186] Catch and ignore error 36925 003077'01 endif. ;[186] End case waiting for output done 36926 003077'01 260 17 0 00 002555* call timoff ;[186] Shut off the timer 36927 003100'01 476 00 0 00 000050* setom f$exit ;[137] Say we want to go back to command level. 36928 36929 003101'01 260 17 0 00 000000* xgfin2: call rrslin ;[121] Put line back in interactive state. 36930 003102'01 120 01 0 00 000000* dmove t1, odelay ;[194] ;[27] Restore normal delay 36931 003103'01 124 01 0 00 002564* dmovem t1, delay ;[194] ;[27] 36932 003104'01 120 01 0 00 002632* dmove t1, otimou ;[212] ;[27] and timout interval 36933 003105'01 124 01 0 00 002633* dmovem t1, stimou ;[212] ;[27] 36934 003106'01 402 00 0 00 002557* setzm srvflg ;[27] and reset the server flag 36935 003107'01 332 01 0 00 000000* skipe t1, logjfn ;[38] If we were logging, 36936 003110'01 104 00 0 00 000022 CLOSF ;[38] close the log. 36937 003111'01 320 16 0 00 003112' erjmp .+1 ;[38] (Ignore any errors here.) 36938 003112'01 402 00 0 00 003107* setzm logjfn ;[38] 36939 003113'01 263 17 0 00 000000 ret ; Done 36940 36941 ; LOGOUT (or BYE) -- Shut down the server and log out. 36942 36943 003114'01 201 01 0 00 000131 xglogo: movei t1, "Y" ; Acknowledge the command. 36944 003115'01 403 03 0 00 000004 setzb t3, t4 ; No data. 36945 003116'01 260 17 0 00 003055* call spack ; Send the packet. 36946 003117'01 600 00 0 00 000000 nop ; 36947 003120'01 201 01 0 00 003141' movei t1,xglog1 ;[186] Where to go on a time out 36948 003121'01 260 17 0 00 003060* call timeit ;[186] Start a timer 36949 003122'01 337 01 0 00 003061* skipg t1, netjfn ;[186] Wait until the packet 36950 003123'01 200 01 0 00 003062* move t1, ttyjfn ;[186] Unless using local terminal 36951 003124'01 336 00 0 00 003063* ifmn. ptyflg ;[186] On a pseudo-terminal? 36952 003125'01 254 00 0 00 003136' k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 46-1 K20SRV MAC 9-Jun-23 23:24 Server commands. 36953 003126'01 200 01 0 00 003065* move t1,ptytty ;[186] Load PTY's associated TTY 36954 003127'01 104 00 0 00 000212 DIBE% ;[186] Wait for it to swallow everything 36955 003130'01 320 12 0 00 003132' %jsErr (,) ;[186] 36956 003131'01 254 00 0 00 003135' 36957 003132'01 265 01 0 00 003071* 36958 003133'01 000000000000# 36959 003134'01 254 00 0 00 003135' 36960 000667'04 103 157 165 154 144 36961 003135'01 254 00 0 00 003140' else. ;[186] Otherwise, do it the ordinary way 36962 003136'01 104 00 0 00 000104 DOBE ;[158] gets all the way out. 36963 003137'01 320 12 0 00 003140' erjmpr .+1 ;[186] Catch and ignore error 36964 003140'01 endif. ;[186] End case waiting for output done 36965 003140'01 260 17 0 00 003077* call timoff ;[186] Shut off the timer 36966 003141'01 260 17 0 00 003101* xglog1: call rrslin ;[186] Restore the line for interactive use. 36967 003142'01 120 01 0 00 003102* dmove t1, odelay ;[194] Restore normal delay 36968 003143'01 124 01 0 00 003103* dmovem t1, delay ;[194] 36969 003144'01 120 01 0 00 003104* dmove t1, otimou ;[212] and timout interval 36970 003145'01 124 01 0 00 003105* dmovem t1, stimou ;[212] 36971 003146'01 402 00 0 00 003106* setzm srvflg ; and reset the server flag. 36972 003147'01 265 01 0 00 002472* wtlog (,) ;[126] Log the BYE. 36973 003150'01 000000000000# 36974 003151'01 777777 777764 36975 003152'01 000000 000000 36976 000676'04 102 131 105 040 122 36977 003153'01 260 17 0 00 000000* call clenup## ;[126] Close all logs. 36978 003154'01 476 00 0 00 003100* setom f$exit ; Just in case we can't logout, set exit flag. 36979 003155'01 474 01 0 00 000000 seto t1, ; -1 = Myself. 36980 003156'01 104 00 0 00 000003 LGOUT% ; Log me out. 36981 003157'01 320 14 0 00 003161' %jsker (,r) ; If this fails, print msg & go back. 36982 003160'01 254 00 0 00 003164' 36983 003161'01 265 01 0 00 002745* 36984 003162'01 000000 000000 36985 003163'01 254 00 0 00 002274* 36986 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 47 K20SRV MAC 9-Jun-23 23:24 Server commands. 36987 36988 ; Command to TYPE a file. Just like sending a file, except must send "X" 36989 ; packet instead of file header. 36990 36991 003164'01 260 17 0 00 003257' xgtype: call getarg ; Get the argument. 36992 003165'01 476 00 0 00 002575* setom xflg ; Send file with X header. 36993 003166'01 336 00 0 00 002476* ifmn. tlgjfn ;[233] Doing transaction logging? 36994 003167'01 254 00 0 00 003222' 36995 003170'01 415 16 0 00 003222' block. ;[233] Get a stack frame 36996 003171'01 261 17 0 00 000016 36997 003172'01 265 16 0 00 005507' saveac ;[233] Save even the temporaries 36998 003173'01 202 04 0 00 000000# movem t4,tmpjfn ;[233] Save the pointer 36999 003174'01 476 00 0 00 002471* setom scrlft ;[233] Don't append the crlf! 37000 003175'01 265 01 0 00 003147* wtlog(,) ;[233] 37001 003176'01 000000000000# 37002 003177'01 777777 777770 37003 003200'01 000000 000000 37004 000701'04 123 145 156 144 151 37005 003201'01 200 01 0 00 003166* move t1, tlgjfn ;[233] Put the directory name in the log 37006 003202'01 200 02 0 00 000000# move t2,tmpjfn ;[233] Reload the pointer 37007 003203'01 403 03 0 00 000004 setzb t3,t4 ;[233] Don't know how long, stop on a NUL 37008 003204'01 104 00 0 00 000053 SOUT% ;[233] Out it goes! 37009 003205'01 320 14 0 00 003206' erjmps .+1 ;[233] Catch and suppress error 37010 003206'01 402 00 0 00 000000# setzm tmpjfn ;[233] Scrub it, not a JFN anyway 37011 003207'01 120 02 0 00 000000# dxtext (t2,< for local display >) ;[233] 37012 000251'02 000000000000# 37013 000252'02 777777 777755 37014 000703'04 040 146 157 162 040 37015 003210'01 415 16 0 00 003221' block. ;[233] Set up ANOTHER stack context 37016 003211'01 261 17 0 00 000016 37017 003212'01 265 16 0 00 005474' saveac ;[233] Needs plenty registers for intersection jumps 37018 003213'01 254 14 0 00 000007 xsfm q3 ;[233] Get and store current processor flags 37019 003214'01 200 10 0 00 000000* move q4, bigsou## ;[233] Load up inter-section transfer address 37020 003215'01 201 11 0 00 003217' movei q5, .+2 ;[233] And the inter-section return adress 37021 003216'01 254 05 0 00 000007 xjrstf q3 ;[233] and take a giant step! 37022 003217'01 263 17 0 00 000000 ret ;[232] Get out of the block, restoring registers 37023 003220'01 263 17 0 00 000000 endbk. ;[232] End lexical SOUT% block 37024 003221'01 263 17 0 00 000000 endbk. ;[233] Release stack frame, restoring AC's 37025 003222'01 endif. ;[233] End case transaction logging 37026 003222'01 200 02 0 00 000004 move t2, t4 ;[141] Point to filespec. 37027 003223'01 254 00 0 00 002741' 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 15:19 11-Jun-23 Page 48 K20SRV MAC 9-Jun-23 23:24 Server commands. 37028 37029 ;[58] Init-Info mechanism added as edit 58. 37030 ; 37031 ; Get an "I" parameters packet from the user, record the parameters, and send 37032 ; our own back in return. This exchange is optional, but should take place 37033 ; before any server/user transaction except file transfer, where it is required 37034 ; and always takes place via the Send-Init mechanism. 37035 ; 37036 003224'01 202 02 0 00 002717* xinfo: movem t2, pktnum ; Set the parameters we just got. 37037 003225'01 260 17 0 00 002713* call spar 37038 003226'01 402 00 0 00 002711* setzm numtry 37039 003227'01 200 04 0 00 005724' move t4, [point 8, datbuf] ;[190] Respond with ours. 37040 003230'01 260 17 0 00 002715* call rpar 37041 003231'01 201 01 0 00 000131 movei t1, "Y" 37042 003232'01 200 02 0 00 003224* move t2, pktnum 37043 003233'01 260 17 0 00 003116* call spack 37044 003234'01 600 00 0 00 000000 nop ; If they don't get it, they'll ask again... 37045 003235'01 254 00 0 00 002567' jrst xxwait k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 49 K20SRV MAC 9-Jun-23 23:24 Server commands. 37046 37047 ; GTSCH -- Get String Character 37048 ; 37049 ; Alternate GETCH routine for getting a character from an ASCIZ string in 37050 ; memory. Uses global STRPTR for input string. 37051 ; 37052 ; Returns: 37053 ; +1 if no more characters left in string. 37054 ; +2 always, with NEXT containing next character, -1 if no more. 37055 ; 37056 003236'01 gtsch: entry gtsch ;[220] 37057 003236'01 134 01 0 00 001745* ildb t1, strptr ; Get next character. 37058 003237'01 322 01 0 00 003242' jumpe t1, gtschz ; If zero, must be done. 37059 37060 ; Return with character like GETCH. 37061 37062 003240'01 202 01 0 00 000000* gtschx: movem t1, next ; Put result in NEXT, as GETCH does. 37063 003241'01 254 00 0 00 001645* retskp ; Done. 37064 37065 ; "EOF" return, like GETCH 37066 37067 003242'01 400 01 0 00 000000 gtschz: setz t1, 37068 003243'01 476 00 0 00 003240* setom next 37069 003244'01 263 17 0 00 000000 ret k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 50 K20SRV MAC 9-Jun-23 23:24 Server commands. 37070 37071 ; PUTSCH 37072 ; 37073 ; Alternate PUTCH routine. Just writes the character to a string in memory. 37074 ; Call with t2/ character to write. 37075 ; 37076 003245'01 putsch: entry putsch ;[220] 37077 003245'01 136 02 0 00 003236* idpb t2, strptr ; Here's the alternate PUTCH routine. 37078 003246'01 254 00 0 00 003241* retskp ; It always succeeds. 37079 37080 37081 ; PUTTCH 37082 ; 37083 ; Another alternate PUTCH routine. Writes the character to the terminal. 37084 ; Call like PUTCH and PUTSCH. 37085 ; 37086 37087 003247'01 puttch: entry puttch ;[220] 37088 003247'01 336 00 0 00 002514* skipn local ;[186] ;[177] But only if local. 37089 003250'01 254 00 0 00 003246* retskp ;[177] ... 37090 003251'01 261 17 0 00 000001 push p, t1 37091 003252'01 201 01 0 00 000101 movei t1, .priou 37092 003253'01 104 00 0 00 000051 BOUT 37093 003254'01 320 16 0 00 003255' erjmp .+1 37094 003255'01 262 17 0 00 000001 pop p, t1 37095 003256'01 254 00 0 00 003250* retskp 37096 37097 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 51 K20SRV MAC 9-Jun-23 23:24 Get Argument 37098 subttl Get Argument 37099 37100 ; Does the following: 37101 ; 37102 ; 1) Decodes server command packet 37103 ; 2) Sets up pointers to packet 37104 ; 3) Gets first argument 37105 ; 37106 ; Returns +1 always with: 37107 ; 37108 ; t3/ Length of first argument 37109 ; t4/ pointer to first argument 37110 37111 003257'01 201 01 0 00 003245' getarg: movei t1, putsch ; Address of alternate PUTCH routine. 37112 003260'01 202 01 0 00 002577* movem t1, dest 37113 003261'01 402 00 0 00 001727* setzm strbuf ; Clear decoding area. 37114 003262'01 200 01 0 00 005727' move t1, [strbuf,,strbuf+1] 37115 003263'01 251 01 0 00 000000* blt t1, strbz 37116 003264'01 200 01 0 00 005600' move t1, [point 7, strbuf] ; Where to put the decoded string. 37117 003265'01 202 01 0 00 003245* movem t1, strptr 37118 003266'01 200 01 0 00 000004 move t1, t4 ; Pointer to data to decode. 37119 003267'01 200 02 0 00 000003 move t2, t3 ; Length. 37120 003270'01 260 17 0 00 000000* call putbuf ; Go decode the packet. 37121 003271'01 254 00 0 00 003274' ifskp. ;[194] Worked, that's promising 37122 003272'01 402 00 0 00 003260* setzm dest ; Put PUTCH back to normal. 37123 003273'01 254 00 0 00 003303' else. ;[194] Failed somehow 37124 003274'01 402 00 0 00 003272* setzm dest ;[194] Stomp whatever's driving PUTCH 37125 003275'01 334 00 0 00 000000 kermsg (, xxwait) ;[194] 37126 003276'01 254 00 0 00 003303' 37127 003277'01 265 01 0 00 002776* 37128 003300'01 000000 000046 37129 003301'01 000000000000# 37130 003302'01 254 00 0 00 002567' 37131 000707'04 103 141 156 047 164 37132 003303'01 endif. ;[194] 37133 003303'01 200 04 0 00 005600' move t4, [point 7, strbuf] ; Point to decoded string. 37134 003304'01 134 03 0 00 000004 ildb t3, t4 ; Get CHAR(length) of directory string. 37135 003305'01 305 03 0 00 000040 caige t3, 40 ;[128] If null, no need to convert. 37136 003306'01 201 03 0 00 000040 movei t3, 40 ;[128] This also catches funny cases. 37137 003307'01 275 03 0 00 000040 subi t3, 40 ; UNCHAR of that to make a number. 37138 003310'01 263 17 0 00 000000 ret k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 52 K20SRV MAC 9-Jun-23 23:24 Get Argument 37139 37140 ;[107] CWD server command (Connect to directory in DEC-20 parlance). 37141 ; 37142 ; Changes Working Directory, sends new directory name back in ACK, or else 37143 ; error packet if there's a problem. 37144 ; 37145 ; Arrive here with t4 containing pointer to argument string of form 37146 ; 37147 ; where is a single character (offset by CHAR), 37148 ; and t3 containing the length of the string. 37149 ; 37150 003311'01 260 17 0 00 003257' xgcwd: call getarg ; Get the first argument. 37151 003312'01 327 03 0 00 003322' jumpg t3, xgcwd2 ; If positive, go handle string. 37152 003313'01 322 03 0 00 003412' jumpe t3, xgcwd5 ; If null, go connect back to own directory. 37153 37154 003314'01 334 00 0 00 000000 kermsg (,xxwait) ; Negative length??? 37155 003315'01 254 00 0 00 003322' 37156 003316'01 265 01 0 00 003277* 37157 003317'01 000000 000051 37158 003320'01 000000000000# 37159 003321'01 254 00 0 00 002567' 37160 000715'04 102 141 144 040 154 37161 37162 ; Set up argument block for ACCES 37163 37164 003322'01 200 05 0 00 000004 xgcwd2: move q1, t4 ; Byte pointer to directory string. 37165 003323'01 133 03 0 00 000004 adjbp t3, t4 ; Now point to password. 37166 003324'01 134 04 0 00 000003 ildb t4, t3 ; Get its length. 37167 003325'01 200 06 0 00 000003 move q2, t3 ; Put pointer in ACCES arg block. 37168 003326'01 275 04 0 00 000040 subi t4, 40 ; UNCHAR to make it a number. 37169 003327'01 335 00 0 00 000004 skipge t4 ; Normal kind of number? 37170 003330'01 400 04 0 00 000000 setz t4, ; No, must have fallen off end, so no pswd. 37171 003331'01 400 02 0 00 000000 setz t2, ; Zero the length to make directory asciz. 37172 003332'01 137 02 0 00 000003 dpb t2, t3 ; ... 37173 003333'01 133 04 0 00 000003 adjbp t4, t3 ; Make sure password is asciz. 37174 003334'01 136 02 0 00 000004 idpb t2, t4 37175 37176 ;[193] Check to see what we might be connecting to 37177 37178 003335'01 205 01 0 00 000001 xgcwd3: movx t1, rc%emo ;[193] Exact machine only 37179 003336'01 200 02 0 00 000005 move t2, q1 ;[193] Load pointer to the string that got sent 37180 003337'01 400 03 0 00 000000 setz t3, ;[193] Not doing any directory stepping 37181 003340'01 104 00 0 00 000553 RCDIR% ;[193] See if it exists 37182 003341'01 320 12 0 00 003343' ifje. r ;[193] Catch and ignore error 37183 003342'01 254 00 0 00 003345' 37184 003343'01 200 02 0 00 000001 move t2, t1 ;[193] May be of interest to debuggers 37185 003344'01 205 01 0 00 040000 movx t1, rc%nom ;[193] So say no match 37186 003345'01 endif. ;[193] End RCDIR% error handling 37187 003345'01 607 01 0 00 040000 jxe t1, rc%nom, xgcwd4 ;[193] If no match is off, then it worked! 37188 003346'01 254 00 0 00 003400' 37189 003347'01 200 01 0 00 000005 move t1, q1 ;[193] Load pointer to the string that got sent 37190 003350'01 104 00 0 00 000120 STDEV% ;[193] Translate to a device 37191 003351'01 320 14 0 00 003353' %jsker (,xxwait) ;[193] Ship error message back in an error packet. 37192 003352'01 254 00 0 00 003356' 37193 003353'01 265 01 0 00 003161* k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 52-1 K20SRV MAC 9-Jun-23 23:24 Get Argument 37194 003354'01 000000 000000 37195 003355'01 254 00 0 00 002567' 37196 003356'01 200 01 0 00 000002 move t1, t2 ;[193] Load the device designator 37197 003357'01 104 00 0 00 000117 DVCHR% ;[193] Get its characteristics 37198 003360'01 320 14 0 00 003362' %jsker (,xxwait) ;[193] STDEV% just handed it to us... 37199 003361'01 254 00 0 00 003365' 37200 003362'01 265 01 0 00 003353* 37201 003363'01 000000 000000 37202 003364'01 254 00 0 00 002567' 37203 003365'01 135 03 0 00 005471' ldb t3, [pointr t2, dv%typ] ;[193] Pick up the device type 37204 003366'01 306 03 0 00 000015 cain t3, .dvnul ;[193] Want's to do absolutely nothing? 37205 003367'01 254 00 0 00 003425' jrst xgcwdz ;[193] Fine, then don't do anything 37206 dmove t1, [ .fhslf ;[193] Get ready to complain about ourself 37207 003370'01 120 01 0 00 005730' RCDIX3 ] ;[193] Force "Invalid structure name" 37208 003371'01 104 00 0 00 000336 SETER% ;[193] Set last error for this process 37209 003372'01 320 12 0 00 003373' erjmpr .+1 ;[193] Catch and ignore error 37210 003373'01 254 00 0 00 003375' %erker (,xxwait) ;[193] Go blat and leave 37211 003374'01 254 00 0 00 003400' 37212 003375'01 265 01 0 00 003362* 37213 003376'01 000000000000# 37214 003377'01 254 00 0 00 002567' 37215 000724'04 116 157 164 040 141 37216 37217 ; Access the directory. ** Maybe should also mount structure if necessary? 37218 37219 003400'01 200 01 0 00 005547' xgcwd4: move t1, [ac%con!<3>] ; Function is Connect, arg block has 2 words. 37220 003401'01 201 02 0 00 000005 movei t2, q1 ; Address of argument block. 37221 003402'01 474 07 0 00 000000 seto q3, ; Own job. 37222 003403'01 104 00 0 00 000552 ACCES 37223 003404'01 320 14 0 00 003406' %jsker (,xxwait) ; Send any error message in error packet. 37224 003405'01 254 00 0 00 003411' 37225 003406'01 265 01 0 00 003375* 37226 003407'01 000000 000000 37227 003410'01 254 00 0 00 002567' 37228 003411'01 254 00 0 00 003425' jrst xgcwdz ; Done connecting, go send ACK. k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 53 K20SRV MAC 9-Jun-23 23:24 Get Argument 37229 37230 ;...XGCWD, cont'd 37231 37232 37233 ; Come here to connect to own directory. 37234 37235 003412'01 200 05 0 00 000000# xgcwd5: move q1, .jilno+jobtab ;[220] Logged-in directory number. 37236 003413'01 400 06 0 00 000000 setz q2, ; No password needed 37237 003414'01 474 07 0 00 000000 seto q3, ; Own job. 37238 003415'01 201 02 0 00 000005 movei t2, q1 ; Address of arg block. 37239 003416'01 200 01 0 00 005547' move t1, [ac%con!<3>] ; Function is connect. 37240 003417'01 104 00 0 00 000552 ACCES ; Connect to own directory. 37241 003420'01 320 14 0 00 003422' %jsker (,xxwait) 37242 003421'01 254 00 0 00 003425' 37243 003422'01 265 01 0 00 003406* 37244 003423'01 000000 000000 37245 003424'01 254 00 0 00 002567' 37246 ;... k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 54 K20SRV MAC 9-Jun-23 23:24 Get Argument 37247 37248 ;...XGCWD, cont'd 37249 37250 37251 ; Done, send back ACK with directory string in it. 37252 37253 003425'01 104 00 0 00 000013 xgcwdz: GJINF 37254 003426'01 200 01 0 00 005600' move t1, [point 7, strbuf] 37255 003427'01 202 01 0 00 003265* movem t1, strptr 37256 003430'01 104 00 0 00 000041 DIRST 37257 003431'01 320 14 0 00 003433' %jsker (,xxwait) 37258 003432'01 254 00 0 00 003436' 37259 003433'01 265 01 0 00 003422* 37260 003434'01 000000 000000 37261 003435'01 254 00 0 00 002567' 37262 37263 003436'01 201 01 0 00 003236' movei t1, gtsch ; Indicate routine to be used for getting 37264 003437'01 202 01 0 00 002576* movem t1, source ; characters. 37265 003440'01 476 00 0 00 003243* setom next ; Set initial condition. 37266 003441'01 200 01 0 00 000000* move t1, maxdat ; Get a buffer full of data. 37267 003442'01 260 17 0 00 000000* call getbuf ; ... 37268 003443'01 326 01 0 00 002567' jumpn t1, xxwait ; 37269 003444'01 402 00 0 00 003437* setzm source ; Put GETCH back to normal. 37270 003445'01 200 03 0 00 000001 move t3, t1 ; Length 37271 003446'01 201 01 0 00 000131 movei t1, "Y" ; Y for Yes (ACK) 37272 003447'01 400 02 0 00 000000 setz t2, ; Packet number 0. 37273 003450'01 200 04 0 00 005724' move t4, [point 8, datbuf] ;[190] Point to string built by getbuf. 37274 003451'01 260 17 0 00 003233* call spack ; Send the ACK. 37275 003452'01 600 00 0 00 000000 nop ; Nothing much we can do here... 37276 003453'01 254 00 0 00 002567' jrst xxwait ; Done. k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 55 K20SRV MAC 9-Jun-23 23:24 Get Argument 37277 37278 ;[56] Disk USAGE server query added in edit 56. 37279 ; 37280 ; Assumes reply will fit in data field of ACK packet; does not use 37281 ; text header ("X") protocol. Sends as much of reply as will fit. 37282 ; 37283 003454'01 474 01 0 00 000000 xgdisk: seto t1, ; Get disk usage of connected directory. 37284 003455'01 104 00 0 00 000305 GTDAL% 37285 003456'01 320 14 0 00 003460' %jsker ,r 37286 003457'01 254 00 0 00 003463' 37287 003460'01 265 01 0 00 003433* 37288 003461'01 000000000000# 37289 003462'01 254 00 0 00 003163* 37290 000731'04 103 141 156 047 164 37291 003463'01 120 05 0 00 000001 dmove q1, t1 ; Save the numbers in q1,q2. 37292 37293 003464'01 200 01 0 00 005600' move t1, [point 7, strbuf] ;[188] String pointer to data field. 37294 003465'01 202 01 0 00 003427* movem t1, strptr ;[103] 37295 003466'01 120 02 0 00 000000# smsg () ;[188] Inital part of response 37296 003467'01 260 17 0 00 001535* 37297 000253'02 000000000000# 37298 000254'02 777777 777771 37299 000736'04 121 165 157 164 141 37300 37301 003470'01 200 02 0 00 000005 move t2, q1 ; Quota, or "+Inf" 37302 003471'01 305 02 0 00 005700' caige t2, [^d100000000] ;[194] Big? 37303 003472'01 254 00 0 00 003476' ifskp. ;[194] Yep, really big 37304 003473'01 120 02 0 00 000000# smsg (<+Inf>) ;[194] So say that differently 37305 003474'01 260 17 0 00 003467* 37306 000255'02 000000000000# 37307 000256'02 777777 777774 37308 000740'04 053 111 156 146 000 37309 003475'01 254 00 0 00 003501' else. ;[194] Otherwise, comprehensible limit 37310 003476'01 201 03 0 00 000012 movei t3, ^d10 ; in decimal 37311 003477'01 104 00 0 00 000224 NOUT% 37312 003500'01 320 14 0 00 003511' erjmps xgdis2 ;[194] Catch and suppress errpr 37313 003501'01 endif. ;[194] 37314 37315 003501'01 120 02 0 00 000000# smsg (<, used: >) ;[194] How much we're using of it 37316 003502'01 260 17 0 00 003474* 37317 000257'02 000000000000# 37318 000260'02 777777 777770 37319 000741'04 054 040 165 163 145 37320 37321 003503'01 200 02 0 00 000006 move t2, q2 ; Pages used, 37322 003504'01 201 03 0 00 000012 movei t3, ^d10 ; in decimal 37323 003505'01 104 00 0 00 000224 NOUT% 37324 003506'01 320 14 0 00 003511' erjmps xgdis2 ;[194] Catch and suppress error 37325 37326 003507'01 120 02 0 00 000000# smsg (< (pages)>) ; Specify units 37327 003510'01 260 17 0 00 003502* 37328 000261'02 000000000000# 37329 000262'02 777777 777770 37330 000743'04 040 050 160 141 147 37331 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 55-1 K20SRV MAC 9-Jun-23 23:24 Get Argument 37332 003511'01 200 02 0 00 003465* xgdis2: move t2, strptr ;[103] Check length 37333 003512'01 250 01 0 00 000002 exch t1, t2 37334 003513'01 260 17 0 00 000000* call subbp 37335 003514'01 334 00 0 00 000000 kermsg (,r) ;[188] 37336 003515'01 254 00 0 00 003522' 37337 003516'01 265 01 0 00 003316* 37338 003517'01 000000 000027 37339 003520'01 000000000000# 37340 003521'01 254 00 0 00 003462* 37341 000745'04 163 165 142 142 160 37342 003522'01 400 04 0 00 000000 setz t4, ;[188] Cons up a .CHNUL 37343 003523'01 136 04 0 00 000002 idpb t4, t2 ; Done constructing string, make it asciz 37344 003524'01 200 05 0 00 000000* move q1, spsiz ; Is the string bigger than max size to send? 37345 003525'01 275 05 0 00 000005 subi q1, 5 37346 003526'01 307 05 0 03 000000 caig q1, (t3) ; (it should always fit). 37347 003527'01 200 03 0 00 000005 move t3, q1 ; Yes, so cut it off at the limit. 37348 ;.. k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 56 K20SRV MAC 9-Jun-23 23:24 Get Argument 37349 37350 ;...XGDISK, cont'd 37351 37352 37353 ;[103] Begin Change: Use standard packet filling technique to send this. 37354 37355 003530'01 201 01 0 00 003236' movei t1, gtsch ; Indicate routine to be used for getting 37356 003531'01 202 01 0 00 003444* movem t1, source ; characters. 37357 003532'01 476 00 0 00 003440* setom next ; Set initial condition. 37358 003533'01 200 01 0 00 003441* move t1, maxdat ; Get a buffer full of data. 37359 003534'01 260 17 0 00 003442* call getbuf ; ... 37360 003535'01 326 01 0 00 002567' jumpn t1, xxwait ; 37361 003536'01 200 03 0 00 000001 move t3, t1 ; Set up length. 37362 003537'01 402 00 0 00 003531* setzm source ; Put GETCH back to normal. 37363 37364 ;[103] End Change. Now send the packet. 37365 37366 003540'01 201 01 0 00 000131 xgdisz: movei t1, "Y" ; Formulate the ACK 37367 003541'01 400 02 0 00 000000 setz t2, ; (Packet number should be 0, right?) 37368 003542'01 200 04 0 00 005724' move t4, [point 8, datbuf] ;[190] The data itself 37369 003543'01 260 17 0 00 003451* call spack ; Send it off. 37370 003544'01 600 00 0 00 000000 nop ;* What if it fails? 37371 003545'01 254 00 0 00 002567' jrst xxwait k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 57 K20SRV MAC 9-Jun-23 23:24 Get Argument 37372 37373 ; 37374 ;[188] PWD server query; prints working directory. 37375 ; 37376 ; Assumes reply will fit in data field of ACK packet; does not use 37377 ; text header ("X") protocol. Sends as much of reply as will fit. 37378 ; 37379 ; N.B., For Unix fans and Windows heros, be aware that the so-called 37380 ; working directory is NOT the same thing on Tops-20! It is the 37381 ; connected directory, which changes your access rights to that 37382 ; directory and possible group memberships. A connected directory 37383 ; is also job wide, not process wide. 37384 ; 37385 ; Looks remarkably like xgdisk... 37386 37387 003546'01 104 00 0 00 000013 xgpwd: GJINF% ; Get current job information. 37388 003547'01 320 14 0 00 003551' %jsker ,r 37389 003550'01 254 00 0 00 003554' 37390 003551'01 265 01 0 00 003460* 37391 003552'01 000000000000# 37392 003553'01 254 00 0 00 003521* 37393 000750'04 103 141 156 047 164 37394 003554'01 200 01 0 00 005600' move t1, [point 7, strbuf] ; String pointer to data field. 37395 003555'01 202 01 0 00 003511* movem t1, strptr ; Also for packetizer 37396 remark t2, ; Already has the connected directory 37397 003556'01 104 00 0 00 000041 DIRST% ; Translate into a string 37398 003557'01 320 14 0 00 003561' %jsker ,r 37399 003560'01 254 00 0 00 003564' 37400 003561'01 265 01 0 00 003551* 37401 003562'01 000000000000# 37402 003563'01 254 00 0 00 003553* 37403 000757'04 103 157 165 154 144 37404 37405 remark ^D<6+1+1+39+1=48> ;Maximum directory string length 37406 37407 003564'01 200 02 0 00 003555* move t2, strptr ; Check the length in case of 'micropacket' 37408 003565'01 250 01 0 00 000002 exch t1, t2 ; Beginning pointer in t1, final in t2 37409 003566'01 260 17 0 00 003513* call subbp ; Subtract to get length 37410 003567'01 334 00 0 00 000000 kermsg (,r) ;Really unlikely, see above 37411 003570'01 254 00 0 00 003575' 37412 003571'01 265 01 0 00 003516* 37413 003572'01 000000 000027 37414 003573'01 000000000000# 37415 003574'01 254 00 0 00 003563* 37416 000772'04 163 165 142 142 160 37417 37418 003575'01 400 04 0 00 000000 setz t4, ; Cons up a .CHNUL 37419 003576'01 136 04 0 00 000002 idpb t4, t2 ; Tie off the string 37420 003577'01 200 05 0 00 003524* move q1, spsiz ; Is the string bigger than max size to send? 37421 003600'01 275 05 0 00 000005 subi q1, 5 37422 003601'01 307 05 0 03 000000 caig q1, (t3) ; (it should always fit). 37423 003602'01 200 03 0 00 000005 move t3, q1 ; Yes, so cut it off at the limit. 37424 37425 003603'01 201 01 0 00 003236' movei t1, gtsch ; Indicate routine to be used for getting 37426 003604'01 202 01 0 00 003537* movem t1, source ; characters. k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 57-1 K20SRV MAC 9-Jun-23 23:24 Get Argument 37427 003605'01 476 00 0 00 003532* setom next ; Set initial condition. 37428 003606'01 200 01 0 00 003533* move t1, maxdat ; Get a buffer full of data. 37429 003607'01 260 17 0 00 003534* call getbuf ; ... 37430 003610'01 326 01 0 00 002567' jumpn t1, xxwait ; 37431 003611'01 200 03 0 00 000001 move t3, t1 ; Set up length. 37432 003612'01 402 00 0 00 003604* setzm source ; Put GETCH back to normal. 37433 ; Now send the packet. 37434 003613'01 201 01 0 00 000131 movei t1, "Y" ; Formulate the ACK 37435 003614'01 400 02 0 00 000000 setz t2, ; (Packet number should be 0, right?) 37436 003615'01 200 04 0 00 005724' move t4, [point 8, datbuf] ;[190] The data itself 37437 003616'01 260 17 0 00 003543* call spack ; Send it off. 37438 003617'01 600 00 0 00 000000 nop ;* What if it fails? 37439 003620'01 254 00 0 00 002567' jrst xxwait 37440 37441 ;[188] End Code Insertion k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 58 K20SRV MAC 9-Jun-23 23:24 Get Argument 37442 37443 ; Define 30 bit one word global ASCII pointer to another section 37444 37445 extern hlpntr ;[194] One word global ASCII pointer 37446 extern srvhlp ;[194] In k20hlp in section one 37447 37448 000000000000# xhlptr==hlpntr!srvhlp ;[194] Forces LINK to do a polish fix up 37449 37450 003621'01 336 00 0 00 003201* xgstat:ifmn. tlgjfn ;[233] Doing transaction logging? 37451 003622'01 254 00 0 00 003634' 37452 003623'01 415 16 0 00 003634' block. ;[233] Get a stack frame 37453 003624'01 261 17 0 00 000016 37454 003625'01 265 16 0 00 005507' saveac ;[233] Save even the temporaries 37455 003626'01 476 00 0 00 003174* setom scrlft ;[233] Suppress the trailing carriage return 37456 003627'01 265 01 0 00 003175* wtlog(,) ;[233] 37457 003630'01 000000000000# 37458 003631'01 777777 777735 37459 003632'01 000000 000000 37460 000775'04 123 145 156 144 151 37461 003633'01 263 17 0 00 000000 endbk. ;[233] Release stack frame, restoring AC's 37462 003634'01 endif. ;[233] 37463 37464 003634'01 260 17 0 00 002156* call $srvt ;[189] Build the text in a buffer 37465 003635'01 400 02 0 00 000000 setz t2, ;[189] Cons up a .chnul 37466 003636'01 136 02 0 00 000001 idpb t2,t1 ;[189] Tied off the 'string' 37467 003637'01 136 02 0 00 000001 idpb t2,t1 ;[189] Tie it off some more ... 37468 003640'01 200 01 0 00 005732' move t1,[point 7,statxt];[233] Load pointer to constructed text 37469 003641'01 254 00 0 00 003656' jrst xghel1 ;[233] Join common code 37470 37471 003642'01 336 00 0 00 003621* xghelp: ifmn. tlgjfn ;[233] Doing transaction logging? 37472 003643'01 254 00 0 00 003655' 37473 003644'01 415 16 0 00 003655' block. ;[233] Get a stack frame 37474 003645'01 261 17 0 00 000016 37475 003646'01 265 16 0 00 005507' saveac ;[233] Save even the temporaries 37476 003647'01 476 00 0 00 003626* setom scrlft ;[233] Suppress the trailing carriage return 37477 003650'01 265 01 0 00 003627* wtlog(,) ;[233] 37478 003651'01 000000000000# 37479 003652'01 777777 777744 37480 003653'01 000000 000000 37481 001005'04 123 145 156 144 151 37482 003654'01 263 17 0 00 000000 endbk. ;[233] Release stack frame, restoring AC's 37483 003655'01 endif. ;[233] 37484 003655'01 200 01 0 00 005733' move t1, [ xhlptr ] ;[194] Load pointer to general remote help text 37485 37486 003656'01 xghel1: remark ;[233] Common link 37487 003656'01 202 01 0 00 003564* movem t1, strptr ; Put pointer here, where 37488 003657'01 201 01 0 00 003236' movei t1, gtsch ; routine for getting chars from a string 37489 003660'01 202 01 0 00 003612* movem t1, source ; can find it. 37490 003661'01 476 00 0 00 003605* setom next ; Init char lookahead 37491 003662'01 476 00 0 00 003165* setom xflg ; Send with X rather than F header. 37492 003663'01 260 17 0 00 002760* call $sends ; Go send the text like a file 37493 003664'01 600 00 0 00 000000 nop 37494 003665'01 402 00 0 00 003660* setzm source ;[121] Put send source back to normal. 37495 003666'01 254 00 0 00 002567' jrst xxwait k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 59 K20SRV MAC 9-Jun-23 23:24 Get Argument 37496 37497 ;[116] DIRECTORY server command. 37498 37499 ; DIRCH 37500 ; 37501 ; Alternate GETCH routine for getting characters from a directory listing 37502 ; in a memory buffer, and for refilling the buffer when it gets empty. 37503 ; 37504 003667'01 dirch: entry dirch ;[186] 37505 003667'01 134 01 0 00 000000# ildb t1, getptr ; Get character. 37506 003670'01 332 00 0 00 000001 skipe t1 ; Null? 37507 003671'01 254 00 0 00 003701' jrst dirchx ; No, return the character. 37508 37509 ; No characters in buffer, try to refill. 37510 37511 003672'01 260 17 0 00 005337' dirch2: call dmpbuf ; If so, reset the buffer pointers, etc. 37512 003673'01 260 17 0 00 001417' call dirlst ; And try to fill the listing buffer again. 37513 003674'01 322 01 0 00 003703' jumpe t1, dirchz ; No more, done. 37514 003675'01 200 01 0 00 005734' move t1, [point 7, srvbuf] ; Get new listing buffer pointer. 37515 003676'01 202 01 0 00 000000# movem t1, getptr ; Save it for getting characters. 37516 003677'01 134 01 0 00 000000# ildb t1, getptr ; Get first character of new buffer. 37517 003700'01 322 01 0 00 003703' jumpe t1, dirchz ; This shouldn't happen... 37518 37519 ; Return with character like GETCH. 37520 37521 003701'01 202 01 0 00 003661* dirchx: movem t1, next 37522 003702'01 254 00 0 00 003256* retskp 37523 37524 ; "EOF" return, like GETCH. 37525 37526 003703'01 400 01 0 00 000000 dirchz: setz t1, 37527 003704'01 476 00 0 00 003701* setom next 37528 003705'01 263 17 0 00 000000 ret 37529 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 60 K20SRV MAC 9-Jun-23 23:24 XGDIR - Server provides directory listing. 37530 subttl XGDIR - Server provides directory listing. 37531 37532 003706'01 100100 777775 sdirb2: gj%old!gj%ifg!.gjall ;[191] Flags,,All generations. 37533 003707'01 377777 377777 .nulio,,.nulio ;[191] No i/o. 37534 repeat <^d8>,<0> ;[191] No defaults; nothing 37535 003710'01 000000 000000 37536 003711'01 000000 000000 37537 003712'01 000000 000000 37538 003713'01 000000 000000 37539 003714'01 000000 000000 37540 003715'01 000000 000000 37541 003716'01 000000 000000 37542 003717'01 000000 000000 37543 37544 ;[190] Prologue rewritten to not store in (write-protected!) code .psect 37545 37546 003720'01 260 17 0 00 003257' xgdir: call getarg ; Get the first (& only) argument 37547 003721'01 327 03 0 00 003743' jumpg t3, xgdir2 ; Got something, go do it. 37548 003722'01 326 03 0 00 003735' ife. t3 ;[190] Got nothing, default the directory 37549 003723'01 265 16 0 00 002351* anstkv(t4,^d4) ;[190] Create an anonymous stkvar 37550 003724'01 000000 000004 37551 003725'01 415 04 0 17 777773 37552 003726'01 120 01 0 00 005735' dmove t1,[ exp ascii "*.*.*", 0 ] ;[190] Load default file spec 37553 003727'01 124 01 0 04 000000 dmovem t1,0(t4) ;[190] Stomp into buffer 37554 003730'01 403 01 0 00 000002 setzb t1,t2 ;[190] Cons up ten .CHNUL's 37555 003731'01 124 01 0 04 000002 dmovem t1,2(t4) ;[190] Stomp rest of buffer 37556 003732'01 201 03 0 00 000005 movei t3,^d5 ;[190] Five characters long 37557 003733'01 505 04 0 00 440700 hrli t4,(point 7,) ;[190] Now have an ASCII pointer 37558 003734'01 254 00 0 00 003743' jrst xgdir2 ;[190] Go get a file specification 37559 003735'01 endif. ;[190] End case defaulting directory 37560 37561 003735'01 334 00 0 00 000000 kermsg (,xxwait) ; Got junk. 37562 003736'01 254 00 0 00 003743' 37563 003737'01 265 01 0 00 003571* 37564 003740'01 000000 000060 37565 003741'01 000000000000# 37566 003742'01 254 00 0 00 002567' 37567 001013'04 102 141 144 040 154 37568 37569 ; Get JFN on the string we got, supply normal defaults like Exec does. 37570 37571 003743'01 200 02 0 00 000004 xgdir2: move t2, t4 ; Point to filespec 37572 003744'01 133 03 0 00 000004 adjbp t3, t4 ; Make it asciz 37573 003745'01 400 04 0 00 000000 setz t4, 37574 003746'01 136 04 0 00 000003 idpb t4, t3 37575 003747'01 200 04 0 00 000002 move t4, t2 ;[191] Save the string pointer 37576 003750'01 201 01 0 00 004025' movei t1, sdirbk ; JFN block containing flags & defaults. 37577 003751'01 104 00 0 00 000020 GTJFN ; Do long form GTJFN. 37578 003752'01 320 12 0 00 003754' ifje. r ;[191] Catch error 37579 003753'01 254 00 0 00 003772' 37580 003754'01 302 01 0 00 600114 caie t1, GJFX32 ;[191] No files matched? 37581 003755'01 254 00 0 00 003757' %erker (,xxwait) ;[191] No, just send the error 37582 003756'01 254 00 0 00 003762' 37583 003757'01 265 01 0 00 003561* 37584 003760'01 000000 000000 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 60-1 K20SRV MAC 9-Jun-23 23:24 XGDIR - Server provides directory listing. 37585 003761'01 254 00 0 00 002567' 37586 003762'01 201 01 0 00 003706' movei t1, sdirb2 ;[191] Try not defaulting anything 37587 003763'01 200 02 0 00 000004 move t2, t4 ;[191] Restore the string pointer 37588 003764'01 104 00 0 00 000020 GTJFN% ;[191] Attempt another long form GTJFN. 37589 003765'01 320 14 0 00 003767' %jsker (,xxwait) ;[191] No such luck, just give up 37590 003766'01 254 00 0 00 003772' 37591 003767'01 265 01 0 00 003757* 37592 003770'01 000000 000000 37593 003771'01 254 00 0 00 002567' 37594 003772'01 endif. ;[191] End GTJFN% recovery 37595 003772'01 260 17 0 00 002752* call isnulj ;[191] Gave us NUL:? 37596 003773'01 600 00 0 00 000000 nop ;[191] Didn't, that's fine. 37597 remark t1, .nulio ;[191] Did, that's fine, too. 37598 37599 003774'01 336 00 0 00 003642* ifmn. tlgjfn ;[233] Doing transaction logging? 37600 003775'01 254 00 0 00 004011' 37601 003776'01 415 16 0 00 004011' block. ;[233] Get a stack frame 37602 003777'01 261 17 0 00 000016 37603 004000'01 265 16 0 00 005507' saveac ;[233] Save even the temporaries 37604 004001'01 552 01 0 00 000000# hrrzm t1,tmpjfn ;[233] Give it how %wtlog wants it .. 37605 004002'01 476 00 0 00 003647* setom scrlft ;[233] Suppress the trailing carriage return 37606 004003'01 265 01 0 00 003650* wtlog(,tmpjfn) ;[233] Sigh... 37607 004004'01 000000000000# 37608 004005'01 777777 777736 37609 004006'01 000000000000# 37610 001023'04 123 145 156 144 151 37611 004007'01 402 00 0 00 000000# setzm tmpjfn ;[233] Stomp it, done. 37612 004010'01 263 17 0 00 000000 endbk. ;[233] Release stack frame, restoring AC's 37613 004011'01 endif. ;[233] 37614 37615 004011'01 200 02 0 00 000001 move t2, t1 ; Construct heading in string buffer. 37616 004012'01 402 00 0 00 002600* setzm ffunc ; Function is "directory". 37617 004013'01 260 17 0 00 001365' call dirhdr 37618 004014'01 200 01 0 00 005737' move t1, [point 7, srvbuf] ; Point to beginning of text buffer. 37619 004015'01 202 01 0 00 000000# movem t1, getptr ; This is where we'll get characters from. 37620 004016'01 201 01 0 00 003667' movei t1, dirch ; And this routine will do the getting. 37621 004017'01 202 01 0 00 003665* movem t1, source ; ... 37622 004020'01 476 00 0 00 003704* setom next ; Initialize character lookahead. 37623 004021'01 476 00 0 00 003662* setom xflg ; This produces some desired effects... 37624 004022'01 260 17 0 00 003663* call $sends ; Go send the listing like it's a file. 37625 004023'01 600 00 0 00 000000 nop ; Ignore any skipping... 37626 004024'01 254 00 0 00 002567' jrst xxwait 37627 37628 004025'01 100100 777775 sdirbk: gj%old!gj%ifg!.gjall ; Flags,,All generations. 37629 004026'01 377777 377777 .nulio,,.nulio ; No i/o. 37630 repeat <2>,<0> ; Default device and directory. 37631 004027'01 000000 000000 37632 004030'01 000000 000000 37633 repeat <2>,)> ;Default name is "*.*" 37634 004031'01 000000000000# 37635 001032'04 052 000 000 000 000 37636 004032'01 000000000000# 37637 001033'04 052 000 000 000 000 37638 37639 repeat <4>,<0> ; Nothing special for the rest. k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 60-2 K20SRV MAC 9-Jun-23 23:24 XGDIR - Server provides directory listing. 37640 004033'01 000000 000000 37641 004034'01 000000 000000 37642 004035'01 000000 000000 37643 004036'01 000000 000000 37644 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 61 K20SRV MAC 9-Jun-23 23:24 XGDEL - Server provides file deletion [118] 37645 subttl XGDEL - Server provides file deletion [118] 37646 37647 004037'01 100100 777775 sdelbk: gj%old!gj%ifg!.gjall ; Flags,,All generations. 37648 004040'01 377777 377777 .nulio,,.nulio ; No i/o. 37649 repeat <^d8>,<0> ; No other defaults. 37650 004041'01 000000 000000 37651 004042'01 000000 000000 37652 004043'01 000000 000000 37653 004044'01 000000 000000 37654 004045'01 000000 000000 37655 004046'01 000000 000000 37656 004047'01 000000 000000 37657 004050'01 000000 000000 37658 37659 37660 004051'01 260 17 0 00 003257' xgdel: call getarg ; Get the first (& only) argument 37661 004052'01 327 03 0 00 004061' jumpg t3, xgdel2 ; Got something, go do it. 37662 37663 004053'01 334 00 0 00 000000 kermsg (,xxwait) 37664 004054'01 254 00 0 00 004061' 37665 004055'01 265 01 0 00 003737* 37666 004056'01 000000 000051 37667 004057'01 000000000000# 37668 004060'01 254 00 0 00 002567' 37669 001034'04 116 157 040 146 151 37670 37671 ; Get JFN on the string we got, supply normal defaults like Exec does. 37672 37673 004061'01 200 02 0 00 000004 xgdel2: move t2, t4 ; Point to filespec 37674 004062'01 133 03 0 00 000004 adjbp t3, t4 ; Make it asciz 37675 004063'01 400 04 0 00 000000 setz t4, 37676 004064'01 136 04 0 00 000003 idpb t4, t3 37677 004065'01 201 01 0 00 004037' movei t1, sdelbk ; JFN block containing flags & defaults. 37678 004066'01 104 00 0 00 000020 GTJFN ; Do long form GTJFN. 37679 004067'01 320 14 0 00 004071' %jsker (,xxwait) ; Send error packet if we can't. 37680 004070'01 254 00 0 00 004074' 37681 004071'01 265 01 0 00 003767* 37682 004072'01 000000 000000 37683 004073'01 254 00 0 00 002567' 37684 004074'01 260 17 0 00 003772* call isnulj ;[191] Gave us NUL: 37685 004075'01 600 00 0 00 000000 nop ;[191] Didn't, that's fine. 37686 37687 004076'01 336 00 0 00 003774* ifmn. tlgjfn ;[233] Doing transaction logging? 37688 004077'01 254 00 0 00 004113' 37689 004100'01 415 16 0 00 004113' block. ;[233] Get a stack frame 37690 004101'01 261 17 0 00 000016 37691 004102'01 265 16 0 00 005507' saveac ;[233] Save even the temporaries 37692 004103'01 552 01 0 00 000000# hrrzm t1,tmpjfn ;[233] Give it how %wtlog wants it .. 37693 004104'01 476 00 0 00 004002* setom scrlft ;[233] Suppress the trailing carriage return 37694 004105'01 265 01 0 00 004003* wtlog(,tmpjfn) ;[233] Sigh... 37695 004106'01 000000000000# 37696 004107'01 777777 777767 37697 004110'01 000000000000# 37698 001043'04 104 145 154 145 164 37699 004111'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 15:19 11-Jun-23 Page 61-1 K20SRV MAC 9-Jun-23 23:24 XGDEL - Server provides file deletion [118] 37700 004112'01 263 17 0 00 000000 endbk. ;[233] Release stack frame, restoring AC's 37701 004113'01 endif. ;[233] 37702 37703 remark t1, .nulio ;[191] Is, that's fine, too. 37704 004113'01 200 02 0 00 000001 move t2, t1 ; Construct heading in string buffer. 37705 004114'01 201 01 0 00 005177' movei t1, delfil ;[194] ; Routine for deleting a file. 37706 004115'01 202 01 0 00 004012* movem t1, ffunc ; Make it the file function. 37707 004116'01 260 17 0 00 001365' call dirhdr ; Start things off. 37708 004117'01 200 01 0 00 005740' move t1, [point 7, srvbuf] ; Point to beginning of text buffer. 37709 004120'01 202 01 0 00 000000# movem t1, getptr ; This is where we'll get characters from. 37710 004121'01 201 01 0 00 003667' movei t1, dirch ; And this routine will do the getting. 37711 004122'01 202 01 0 00 004017* movem t1, source ; ... 37712 004123'01 476 00 0 00 004020* setom next ; Initialize character lookahead. 37713 004124'01 476 00 0 00 004021* setom xflg ; This produces some desired effects... 37714 004125'01 260 17 0 00 004022* call $sends ; Go send the listing like it's a file. 37715 004126'01 600 00 0 00 000000 nop ; Ignore any skipping... 37716 004127'01 254 00 0 00 002567' jrst xxwait 37717 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 62 K20SRV MAC 9-Jun-23 23:24 LOCAL RUN command parsing 37718 subttl LOCAL RUN command parsing 37719 37720 ; JFN block for RUN command. 37721 37722 chgsec(code,const) ;;Tables and chained fdb's go in const 37723 000263'02 100120 000000 runbk: gj%old!gj%ifg!gj%flg ; Flag bits,,most recent generation. 37724 000264'02 000100 000101 .priin,,.priou ; COMND i/o. 37725 repeat 3,<0> ; No defaults, except 37726 000265'02 000000 000000 37727 000266'02 000000 000000 37728 000267'02 000000 000000 37729 000270'02 000000000000# cascii() ; file type. 37730 001045'04 105 130 105 000 000 37731 repeat 2,<0> ; No defaults, except 37732 000271'02 000000 000000 37733 000272'02 000000 000000 37734 000010 runbkl==<.-runbk> ; Length of this GTJFN argument block. 37735 37736 000273'02 006000 000000 yrufdb: flddb. .cmfil 37737 000274'02 000000 000000 37738 000275'02 006004 000300' yrrfdb: flddb. .cmfil,,,,,yrrfd1 37739 000276'02 000000 000000 37740 000277'02 44 07 0 00 000463' 37741 000300'02 010004 000000 yrrfd1: flddb. .cmcfm,,,,, 37742 000301'02 000000 000000 37743 000302'02 44 07 0 00 000470' 37744 retsec 37745 cleans() 37746 37747 ; Parse local RUN command. 37748 37749 004130'01 .yrun: entry .yrun ; Can be invoked as top-level by k20par 37750 004130'01 200 01 0 00 005605' movx t1, cz%ncl!.fhslf ; Close any nonopen JFNs. 37751 004131'01 104 00 0 00 000034 CLZFF 37752 004132'01 200 16 0 00 000000# guide ; Issue guide word. 37753 004133'01 260 17 0 00 002210* 37754 000303'02 000000000000# 37755 001046'04 146 151 154 145 000 37756 004134'01 200 01 0 00 005741' move t1, [runbk,,cjfnbk] ; Insert our file parsing defaults. 37757 004135'01 251 01 0 00 000000# blt t1, cjfnbk+runbkl ; Same as for DELETE. 37758 004136'01 201 01 0 00 000000# movei t1, yrufdb 37759 004137'01 332 00 0 00 000000# skipe rufork ; Already have a fork? 37760 004140'01 201 01 0 00 000000# movei t1, yrrfdb ; Yes, let them rerun it. 37761 004141'01 260 17 0 00 002214* call rfield ; Parse an existing file specification. 37762 004142'01 135 03 0 00 005470' ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ; Get function code. 37763 004143'01 302 03 0 00 000010 caie t3, .cmcfm ;[194] Confirmation? 37764 004144'01 254 00 0 00 004147' ifskp. ;[194] It is 37765 004145'01 476 00 0 00 002326* setom pars3 ; Yes, set "jfn" to -1. 37766 004146'01 263 17 0 00 000000 ret 37767 004147'01 endif. ;[194] 37768 37769 004147'01 265 16 0 00 005552' saveac ;[220] Will need some extra registers 37770 004150'01 550 05 0 00 000002 hrrz q1, t2 ;[220] Save the JFN 37771 004151'01 510 06 0 00 000002 hllz q2, t2 ;[220] Save the flags 37772 004152'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 15:19 11-Jun-23 Page 62-1 K20SRV MAC 9-Jun-23 23:24 LOCAL RUN command parsing 37773 004153'01 260 17 0 00 004667' call isdird ;[220] Only run files from structures 37774 004154'01 254 00 0 00 004165' ifskp. ;[220] It is 37775 004155'01 120 07 0 00 000001 dmove q3, t1 ;[220] Save device information 37776 004156'01 260 17 0 00 002323* confrm ; Get confirmation 37777 004157'01 135 03 0 00 005471' ldb t3,[pointr(t2,dv%typ)] ;[220] Pick up device type 37778 004160'01 306 03 0 00 000015 cain t3, .dvnul ;[220] NUL:? 37779 004161'01 201 05 0 00 377777 movei q1, .nulio ;[220] Yes, JFN has already been tossed 37780 004162'01 202 05 0 00 004145* movem q1, pars3 ;[220] Save some kind of JFN 37781 004163'01 124 07 0 00 001007* dmovem q3, pars4 ;[220] Also device information, if useful 37782 004164'01 263 17 0 00 000000 ret ;[220] Done 37783 004165'01 endif. ;[220] 37784 ;[220] Otherwise, start whining 37785 004165'01 200 01 0 00 000000# emsg 37786 004166'01 104 00 0 00 000313 37787 000304'02 000000000000# 37788 001047'04 103 141 156 047 164 37789 004167'01 201 01 0 00 000101 movei t1, .priou ;[220] Contine on terminal 37790 004170'01 200 02 0 00 000005 move t2, q1 ;[220] Load the JFN, no flags 37791 004171'01 403 03 0 00 000004 setzb t3, t4 ;[220] Standard formating, no goofy prefix 37792 004172'01 104 00 0 00 000030 JFNS% ;[220] Type it 37793 004173'01 320 12 0 00 004175' %jserr(,) ;[220] Odd, but carry on 37794 004174'01 254 00 0 00 004200' 37795 004175'01 265 01 0 00 003132* 37796 004176'01 000000000000# 37797 004177'01 254 00 0 00 004200' 37798 001054'04 125 156 141 142 154 37799 004200'01 200 01 0 00 000005 move t1, q1 ;[220] Get the JFN 37800 004201'01 104 00 0 00 000023 RLJFN% ;[220] Toss it 37801 004202'01 320 12 0 00 004204' %jserr(,) ;[220] Odd, but carry on 37802 004203'01 254 00 0 00 004207' 37803 004204'01 265 01 0 00 004175* 37804 004205'01 000000000000# 37805 004206'01 254 00 0 00 004207' 37806 001063'04 125 156 141 142 154 37807 004207'01 254 00 0 00 002322* callret cmder1 ;[220] Allow a reparse (^H) 37808 37809 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 63 K20SRV MAC 9-Jun-23 23:24 LOCAL RUN command executon 37810 subttl LOCAL RUN command executon 37811 37812 ; Execute local RUN command. 37813 37814 ;[220] Begin code insertion 37815 chgsec(code,const) ; Code to run from registers 37816 000305'02 nulprg: remark ; Pretend we did a GET% into just the AC's 37817 000000 phase 0 ; Runs in accumulators 37818 000000 000000 601405 LSTRX1 ;ac0 No last error 37819 000001 000000 000000 0 ;t1 Argument to PSOUT% 37820 000002 000000 000000 0 ;t2 Argument to SETER% 37821 000003 104 00 0 00 000147 nulent: RESET% ;t3 Reset the world 37822 000004 320 12 0 00 000014 erjmpr nulend ;t4 It *CAN* fail, actually.. 37823 000005 201 01 0 00 400000 movei t1,.fhslf ;q1 This process 37824 000006 200 02 0 00 000000 move t2, f ;q2 No last error (RESET% leaves it in an odd way) 37825 000007 104 00 0 00 000336 SETER% ;q3 Set it 37826 000010 320 12 0 00 000014 erjmpr nulend ;p1 Or not 37827 000011 561 01 0 00 000016 hrroi t1,nulmsg ;p2 Load Tops-20 pointer to text message 37828 000012 104 00 0 00 000076 PSOUT% ;p3 Type it 37829 000013 320 12 0 00 000014 erjmpr nulend ;p4 Or not 37830 000014 104 00 0 00 000170 nulend: HALTF% ;p5 Stop 37831 000015 254 00 0 00 000003 jrst nulent ;p6 Or do it again 37832 000016 472531 435100 nulmsg: BYTE (7) "N","U","L",":",.chspc ;cx 37833 000017 476261 505000 BYTE (7) "O","K",.chcrt,.chlfd,.chnul ;p 37834 000325'02 dephase ; Done with our little NUL: program 37835 retsec ; Restore .psect's 37836 ;[220] End code insertion 37837 37838 004210'01 $yrun: entry $yrun ;[194] 37839 004210'01 337 00 0 00 004162* skipg pars3 ; Re-run current fork? 37840 004211'01 254 00 0 00 004303' jrst $yrun2 ; Yes, do do that. 37841 37842 004212'01 333 01 0 00 000000# skiple t1, rufork ; No, do we have a current fork to kill? 37843 004213'01 104 00 0 00 000153 KFORK ; Yes, try to kill it. 37844 004214'01 320 12 0 00 004216' %jserr (,r) ;[194] 37845 004215'01 254 00 0 00 004221' 37846 004216'01 265 01 0 00 004204* 37847 004217'01 000000000000# 37848 004220'01 254 00 0 00 003574* 37849 001073'04 103 141 156 047 164 37850 004221'01 403 01 0 00 000002 setzb t1, t2 ; Take care of capabilities below. 37851 004222'01 104 00 0 00 000152 CFORK ; Make a fork. 37852 004223'01 320 12 0 00 004225' %jserr (,r); 37853 004224'01 254 00 0 00 004230' 37854 004225'01 265 01 0 00 004216* 37855 004226'01 000000000000# 37856 004227'01 254 00 0 00 004220* 37857 001102'04 103 141 156 047 164 37858 004230'01 202 01 0 00 000000# movem t1, rufork ; Remember the fork handle. 37859 004231'01 200 04 0 00 000001 move t4, t1 ;[220] Keep the handle handy 37860 004232'01 336 02 0 00 000000* skipn t2, capas ;[169] Get our capabilities. 37861 004233'01 200 02 0 00 000000# move t2, mycaps+1 ;[187] Use start up enabled caps, instead 37862 004234'01 630 02 0 00 005742' andx t2,badmsk ;[186] Don't turn on unsafe bits 37863 004235'01 621 02 0 00 040000 txz t2, sc%log ;[169] Do not allow inferior to log us out 37864 004236'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 15:19 11-Jun-23 Page 63-1 K20SRV MAC 9-Jun-23 23:24 LOCAL RUN command executon 37865 004237'01 200 03 0 00 000002 move t3, t2 ;[169] Enable what we've set 37866 004240'01 104 00 0 00 000151 EPCAP ;[169] ... 37867 004241'01 320 14 0 00 004242' erjmps .+1 ;[194] ... 37868 004242'01 517 00 0 00 000001 hrlzs t1 ; Move handle into left half. 37869 004243'01 540 01 0 00 004210* hrr t1, pars3 ; JFN in right half. 37870 004244'01 550 03 0 00 000001 hrrz t3, t1 ;[220] Save a copy of the JFN 37871 004245'01 400 02 0 00 000000 setz t2, ;[220] Nothing special. 37872 004246'01 302 03 0 00 377777 caie t3, .nulio ;[220] NUL:? 37873 004247'01 254 00 0 00 004272' ifskp. ;[220] Just give up here 37874 004250'01 200 01 0 00 000004 move t1, t4 ;[220] Inferior fork handle 37875 004251'01 201 02 0 00 000000# movei t2, nulprg ;[220] NUL: program 37876 004252'01 104 00 0 00 000160 SFACS% ;[220] Set the registers 37877 004253'01 320 12 0 00 004255' %jserr (,r) ;[220] ?? 37878 004254'01 254 00 0 00 004260' 37879 004255'01 265 01 0 00 004225* 37880 004256'01 000000000000# 37881 004257'01 254 00 0 00 004227* 37882 001107'04 103 157 165 154 144 37883 004260'01 200 02 0 00 005743' move t2, [1,,nulent] ;[220] Load NUL:'s 'start address' 37884 004261'01 104 00 0 00 000204 SEVEC% ;[220] Set the entry vector 37885 004262'01 477 02 0 00 000003 setob t2, t3 ;[220] Don't fault in PA1050 37886 004263'01 104 00 0 00 000301 SCVEC% ;[220] Shut off UUO simulation 37887 004264'01 320 12 0 00 004266' %jserr (,) ;[220] Odd, but continue 37888 004265'01 254 00 0 00 004271' 37889 004266'01 265 01 0 00 004255* 37890 004267'01 000000000000# 37891 004270'01 254 00 0 00 004271' 37892 001116'04 103 157 165 154 144 37893 remark ;[220] Fall through to $yrun2 37894 004271'01 254 00 0 00 004303' else. ;[220] Otherwise, it's a real file 37895 004272'01 104 00 0 00 000200 GET ; Get the file to run. 37896 004273'01 320 12 0 00 004275' %jserr (,r) 37897 004274'01 254 00 0 00 004300' 37898 004275'01 265 01 0 00 004266* 37899 004276'01 000000000000# 37900 004277'01 254 00 0 00 004257* 37901 001125'04 103 141 156 047 164 37902 004300'01 550 01 0 00 004243* hrrz t1, pars3 ; Got the file, now can release its JFN. 37903 004301'01 104 00 0 00 000023 RLJFN 37904 004302'01 320 12 0 00 004303' erjmpr .+1 ;[220] Catch and ignore error 37905 004303'01 endif. ;[220] 37906 37907 ; Can come straight here to re-run current fork. 37908 37909 004303'01 337 01 0 00 000000# $yrun2: skipg t1, rufork ; Get fork handle. 37910 004304'01 334 01 0 00 000000# ermsg% (,r) ; Make sure it's ok. 37911 004305'01 254 00 0 00 004311' 37912 004306'01 202 01 0 00 002021* 37913 004307'01 104 00 0 00 000313 37914 004310'01 254 00 0 00 004277* 37915 000325'02 000000000000# 37916 001132'04 113 105 122 115 111 37917 37918 004311'01 400 02 0 00 000000 setz t2, ; Primary start address. 37919 004312'01 104 00 0 00 000201 SFRKV ; Start it up. k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 63-2 K20SRV MAC 9-Jun-23 23:24 LOCAL RUN command executon 37920 004313'01 320 12 0 00 004315' %jserr (,r) 37921 004314'01 254 00 0 00 004320' 37922 004315'01 265 01 0 00 004275* 37923 004316'01 000000000000# 37924 004317'01 254 00 0 00 004310* 37925 001140'04 103 141 156 047 164 37926 004320'01 104 00 0 00 000163 WFORK ; wait for the fork to halt. 37927 004321'01 320 12 0 00 004323' %jserr (,r) 37928 004322'01 254 00 0 00 004326' 37929 004323'01 265 01 0 00 004315* 37930 004324'01 000000000000# 37931 004325'01 254 00 0 00 004317* 37932 001145'04 103 141 156 047 164 37933 37934 004326'01 263 17 0 00 000000 ret 37935 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 64 K20SRV MAC 9-Jun-23 23:24 SRVCMD - Routine to send a command to a server. 37936 subttl SRVCMD - Routine to send a command to a server. 37937 ; 37938 ; Call with: 37939 ; 37940 ; t1/ Byte pointer to string. 37941 ; First character is Generic Command, subsequent chars are arguments. 37942 ; t2/ Packet type, e.g. "G" for Generic, "C" for Host Command. 37943 ; 37944 ; Returns: 37945 ; 37946 ; +1 if reply was not received successfully. 37947 ; +2 If we got a good response, with 37948 ; t1/ packet type of response, "Y", "X", or "S". 37949 ; PKTACS/ Block of 4 words containing the data returned by RPACK. 37950 ; 37951 ; If packet was ACK containing data, this routine prints it. 37952 37953 004327'01 332 00 0 00 002013* srvcmd: skipe takdep ;[176] Allow commands to servers from TAKE file 37954 004330'01 254 00 0 00 004331' jrst srvxx 37955 004331'01 265 16 0 00 005460' srvxx: saveac ; Preserve these work registers. 37956 004332'01 120 05 0 00 000001 dmove q1, t1 ; Copy arguments into them. 37957 004333'01 336 00 0 00 003247* skipn local ;[177] Local Kermit? 37958 004334'01 260 17 0 00 002560* call inilin ;[177] No, set TTY: up for packets. 37959 004335'01 402 00 0 00 003226* setzm numtry ; Reset retry counter. 37960 004336'01 402 00 0 00 000000* setzm nnak ; Init some statistics counters 37961 004337'01 402 00 0 00 000000* setzm ntimou ; ... 37962 004340'01 476 00 0 00 002603* setom bctone ; Force 1-char checksum. 37963 004341'01 260 17 0 00 000043* call clrbuf ;[194] Clear out any stacked-up NAKs 37964 004342'01 600 00 0 00 000000 nop ;[186] Ignore any errors 37965 004343'01 260 17 0 00 002556* call statim ; Start timing (so k20pdc works) 37966 004344'01 260 17 0 00 002561* call ccon ; Let them ^C out gracefully 37967 004345'01 254 00 0 00 004462' jrst srvcmx ; and go here if they do. 37968 37969 004346'01 260 17 0 00 000000* call setlog ; Set up any debugging log. 37970 004347'01 600 00 0 00 000000 nop 37971 37972 ; Put the command into the data field of the packet, using the normal 37973 ; packet-filling technique, prefixing, etc. 37974 37975 004350'01 402 00 0 00 000000* setzm datbuf ;[190] ; Zero the buffer. 37976 37977 004351'01 201 01 0 00 003236' srvcma: movei t1, gtsch ; Indicate routine to be used for getting 37978 004352'01 202 01 0 00 004122* movem t1, source ; characters. 37979 004353'01 202 05 0 00 003656* movem q1, strptr ; And where it should get them from. 37980 004354'01 476 00 0 00 004123* setom next ; Set initial condition. 37981 004355'01 200 01 0 00 003606* move t1, maxdat ; Get a buffer full of data. 37982 004356'01 260 17 0 00 003607* call getbuf ; ... 37983 004357'01 326 01 0 00 004462' jumpn t1, srvcmx ; Clean up if this fails. 37984 004360'01 402 00 0 00 004352* setzm source ; Got it, so put GETCH back to normal. 37985 37986 004361'01 202 01 0 00 000000# movem t1, gclen ; Save length. 37987 004362'01 326 01 0 00 004370' jumpn t1, srvcm2 ; Proceed if we got any. 37988 37989 004363'01 334 01 0 00 000000# ermsg% (, srvcmx) ; Do this otherwise. 37990 004364'01 254 00 0 00 004370' k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 64-1 K20SRV MAC 9-Jun-23 23:24 SRVCMD - Routine to send a command to a server. 37991 004365'01 202 01 0 00 004306* 37992 004366'01 104 00 0 00 000313 37993 004367'01 254 00 0 00 004462' 37994 000326'02 000000000000# 37995 001152'04 113 105 122 115 111 37996 37997 37998 ; Top of try-again loop. 37999 38000 004370'01 200 05 0 00 004335* srvcm2: move q1, numtry ; Too many tries? 38001 004371'01 311 05 0 00 000000* caml q1, maxtry 38002 004372'01 334 01 0 00 000000# ermsg% (,srvcmx) 38003 004373'01 254 00 0 00 004377' 38004 004374'01 202 01 0 00 004365* 38005 004375'01 104 00 0 00 000313 38006 004376'01 254 00 0 00 004462' 38007 000327'02 000000000000# 38008 001163'04 113 105 122 115 111 38009 38010 004377'01 350 00 0 00 004370* aos numtry ; Not too many, count this try. 38011 004400'01 200 01 0 00 000006 move t1, q2 ; Packet type. 38012 004401'01 400 02 0 00 000000 setz t2, ; Make the packet number zero. 38013 004402'01 200 03 0 00 000000# move t3, gclen ; Length of data. 38014 004403'01 200 04 0 00 005724' move t4, [point 8, datbuf] ;[190] Point to data buffer. 38015 004404'01 260 17 0 00 003616* call spack ; Send it off. 38016 004405'01 254 00 1 01 005744' jrst @[exp srvcm2, srvcmx](t1) ; Handle nonfatal & fatal failures. 38017 004406'01 402 00 0 00 000000* setzm gotx ; Assume it'll be an ACK. 38018 004407'01 260 17 0 00 002605* call rpack ; Look for response. 38019 004410'01 334 01 0 00 000000# ermsg% (,srvcm2) 38020 004411'01 254 00 0 00 004415' 38021 004412'01 202 01 0 00 004374* 38022 004413'01 104 00 0 00 000313 38023 004414'01 254 00 0 00 004370' 38024 000330'02 000000000000# 38025 001177'04 113 105 122 115 111 38026 38027 38028 004415'01 302 01 0 00 000130 caie t1, "X" ; X or Y? 38029 004416'01 306 01 0 00 000131 cain t1, "Y" 38030 004417'01 254 00 0 00 004502' jrst srvcmz ; Good. 38031 38032 004420'01 302 01 0 00 000123 caie t1, "S" ; S or I? 38033 004421'01 306 01 0 00 000111 cain t1, "I" 38034 004422'01 254 00 0 00 004502' jrst srvcmz ; That's ok too. 38035 38036 004423'01 302 01 0 00 000105 caie t1, "E" ; Error packet? 38037 004424'01 254 00 0 00 004434' ifskp. ;[186] Yes, let's see about squawking 38038 004425'01 336 00 0 00 004333* skipn local ;[186] Local? 38039 004426'01 254 00 0 00 004462' jrst srvcmx ;[186] No, this will always mess up 38040 004427'01 200 01 0 00 000000# emsg ;[186] Yes, print it. 38041 004430'01 104 00 0 00 000313 38042 000331'02 000000000000# 38043 001205'04 122 145 155 157 164 38044 004431'01 200 01 0 00 000004 move t1, t4 ; Get pointer to it, 38045 004432'01 104 00 0 00 000076 PSOUT% ; and print it. k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 64-2 K20SRV MAC 9-Jun-23 23:24 SRVCMD - Routine to send a command to a server. 38046 004433'01 254 00 0 00 004462' jrst srvcmx ;[70] 38047 004434'01 endif. ;[186] End error pack 38048 38049 004434'01 302 01 0 00 000116 caie t1, "N" ; NAK? 38050 004435'01 306 01 0 00 000124 cain t1, "T" ; Or Timeout? 38051 004436'01 254 00 0 00 004370' jrst srvcm2 ; One of those, go try again. 38052 38053 004437'01 336 00 0 00 004425* skipn local ;[233] Local? 38054 004440'01 254 00 0 00 004462' jrst srvcmx ;[235] Nothing to display on 38055 remark ;[235] Tell us the offending packet and punt 38056 004441'01 200 02 0 00 000001 move t2,t1 ;[235] Save the offending character 38057 004442'01 561 01 0 00 005746' hrroi t1,[ asciz /Invalid response from server: '/] ;[235] 38058 004443'01 104 00 0 00 000313 ESOUT% ;[235] Begin blat 38059 004444'01 320 12 0 00 004445' erjmpr .+1 ;[235] Catch and ignore any error 38060 004445'01 200 01 0 00 000002 move t1,t2 ;[235] Get the character back 38061 004446'01 104 00 0 00 000074 PBOUT% ;[235] Type it 38062 004447'01 320 12 0 00 004450' erjmpr .+1 ;[235] Catch and ignore any error 38063 004450'01 561 01 0 00 005755' hrroi t1,[asciz /' (/] ;[235] And seperate the rest 38064 004451'01 104 00 0 00 000076 PSOUT% ;[235] Type that 38065 004452'01 320 12 0 00 004453' erjmpr .+1 ;[235] Catch and ignore any error 38066 004453'01 201 01 0 00 000101 movei t1,.priou ;[235] Still going to primary output 38067 004454'01 201 03 0 00 000010 movei t3,^d8 ;[235] ASCII characters are base 8 here 38068 004455'01 104 00 0 00 000224 NOUT% ;[235] Type it 38069 004456'01 320 12 0 00 004457' erjmpr .+1 ;[235] Catch and ignore any error 38070 hrroi t1,[asciz /) 38071 004457'01 561 01 0 00 005756' /] ;[235] Close off the line 38072 004460'01 104 00 0 00 000076 PSOUT% ;[235] Type that 38073 004461'01 320 12 0 00 004462' erjmpr .+1 ;[235] Catch and ignore any error 38074 remark srvcmx ;[235] Falls through 38075 38076 ; Exit point for any kind of error, failure, or interruption 38077 38078 004462'01 260 17 0 00 002455* srvcmx: call ccoff ; Turn off ^C trap. 38079 004463'01 260 17 0 00 000000* call caxzof ; Turn these interrupts off too. 38080 004464'01 260 17 0 00 003007* call endtim ;[189] Stop timing 38081 004465'01 260 17 0 00 003010* call elptim ;[189] Compute elapsed time 38082 004466'01 337 01 0 00 002347* skipg t1, filjfn ;[193] Any file left open? 38083 004467'01 254 00 0 00 004475' ifskp. ;[193] Apparently, try to close it. 38084 004470'01 621 01 0 00 777777 tlz t1,-1 ;[193] Ditch any flags 38085 004471'01 302 01 0 00 377777 caie t1, .nulio ;[193] No need to close since never opened 38086 004472'01 104 00 0 00 000022 CLOSF 38087 004473'01 320 12 0 00 004474' erjmpr .+1 ;[193] Catch and ignore error 38088 004474'01 402 00 0 00 004466* setzm filjfn ;[193] Whatever it was, it's closed now! 38089 004475'01 endif. ;[193](end) 38090 004475'01 336 00 0 00 004437* skipn local ;[177] Put controlling TTY back to normal 38091 004476'01 260 17 0 00 000000* call rrsl2 ;[177] ... (entry point to reslin) 38092 004477'01 402 00 0 00 004360* setzm source ; Put things back to normal. 38093 004500'01 474 01 0 00 000000 seto t1, ; Indicate no good response was received. 38094 004501'01 263 17 0 00 000000 ret ; Return +1. 38095 38096 38097 ; Exit here when response received successfully. 38098 38099 004502'01 124 01 0 00 000000* srvcmz: dmovem t1, pktacs ;[112] Save the ACs returned in RPACK 38100 004503'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 15:19 11-Jun-23 Page 64-3 K20SRV MAC 9-Jun-23 23:24 SRVCMD - Routine to send a command to a server. 38101 004504'01 202 02 0 00 003232* movem t2, pktnum ; Synchronize packet numbers. 38102 004505'01 302 01 0 00 000131 caie t1, "Y" ;[194] Was the reply an ACK? 38103 004506'01 254 00 0 00 004517' ifskp. ;[194] It was 38104 004507'01 337 02 0 00 000003 skipg t2, t3 ;[144] Yes, any characters? 38105 004510'01 254 00 0 00 004517' anskp. ;[194] No. 38106 004511'01 201 01 0 00 003247' movei t1, puttch ;[144] Routine to display decoded characters. 38107 004512'01 202 01 0 00 003274* movem t1, dest ;[144] ... 38108 004513'01 200 01 0 00 000004 move t1, t4 ;[144] Pointer to data buffer. 38109 004514'01 260 17 0 00 003270* call putbuf ;[144] Go decode it. 38110 004515'01 600 00 0 00 000000 nop ;[144] 38111 004516'01 402 00 0 00 004512* setzm dest ;[144] 38112 004517'01 endif. ;[194] 38113 004517'01 200 01 0 00 004502* move t1, pktacs ;[112] Get packet type back. 38114 004520'01 260 17 0 00 004462* call ccoff ; Turn off ^C trap. 38115 004521'01 336 00 0 00 004475* skipn local ;[177] Put controlling TTY back to normal 38116 004522'01 260 17 0 00 004476* call rrsl2 ;[177] ... (entry point to reslin) 38117 004523'01 254 00 0 00 003702* retskp ; Done. 38118 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 65 K20SRV MAC 9-Jun-23 23:24 SINFO Sends Iniatialization Packet 38119 subttl SINFO Sends Iniatialization Packet 38120 38121 ;[58] SINFO added as part of edit 58. 38122 ; 38123 ; Call this routine before sending any server command which has a 38124 ; nontrivial response. For instance, it should be called before 38125 ; requesting a remote directory listing, but need not be called before 38126 ; sending a CWD command, which normally responds with a simple ACK. 38127 ; 38128 ; Action: Sends an info packet with our own parameters, waits for 38129 ; ACK with other side's. Uses packet number 0, does not increment the 38130 ; packet number. If other side doesn't know about I packets, this 38131 ; routine returns as if a an ACK was received containing all default 38132 ; values. 38133 ; 38134 ; Returns: 38135 ; +1 on failure, maximum tries exceeded. 38136 ; +2 on "success" getting a reply, even if it was an error packet, 38137 ; with other sides parameters set. 38138 38139 004524'01 sinfo: entry sinfo 38140 004524'01 265 16 0 00 005757' saveac ;[128] Save these. 38141 004525'01 402 00 0 00 004377* setzm numtry ; Give it a try, 38142 004526'01 402 00 0 00 004504* setzm pktnum ; starting out with a clean slate. 38143 004527'01 476 00 0 00 004340* setom bctone ;[98] Use 1-char checksum. 38144 38145 004530'01 260 17 0 00 004341* call clrbuf ;[194] Clear out any piled up NAKs. 38146 004531'01 600 00 0 00 000000 nop ;[186] Ignore any errors 38147 004532'01 260 17 0 00 004346* call setlog ; Set up any debugging log. 38148 004533'01 600 00 0 00 000000 nop 38149 004534'01 201 11 0 00 000123 movei state, "S" ;[133] This will be a little state switcher. 38150 38151 004535'01 201 01 0 00 000111 sinfo2: movei t1, "I" ;[100][133] Packet type. 38152 004536'01 476 00 0 00 000000* setom iflg ;[100] Say we're doing I, not S. 38153 004537'01 260 17 0 00 000000* call sinit ;[100] Let SINIT send it & get reply. 38154 004540'01 302 01 0 00 000105 caie t1, "E" ;[194] Other side doesn't know I packet? 38155 004541'01 254 00 0 00 004545' ifskp. ;[194] Strangely, no 38156 004542'01 403 03 0 00 000004 setzb t3, t4 ;[133] Then set defaults this way. 38157 004543'01 260 17 0 00 003225* call spar ;[133] Sets our parameters 38158 004544'01 254 00 0 00 004553' jrst sinfoz ;[133] And return successfully. 38159 004545'01 endif. ;[194] 38160 38161 ;[133] Keep going if it doesn't get thru the first time. 38162 38163 004545'01 306 11 0 00 000106 cain state, "F" ; Switched into F state? 38164 004546'01 254 00 0 00 004553' jrst sinfoz ; Yes, so I was ACK'd, done. 38165 004547'01 306 11 0 00 000123 cain state, "S" ; Still in S state? 38166 004550'01 254 00 0 00 004535' jrst sinfo2 ; So go round again. 38167 38168 004551'01 402 00 0 00 004536* sinfox: setzm iflg ; Must have exceeded retry limit. 38169 004552'01 263 17 0 00 000000 ret ; Fail. 38170 38171 004553'01 402 00 0 00 004551* sinfoz: setzm iflg ;[100] Done with sending I packet. 38172 004554'01 254 00 0 00 004523* retskp 38173 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 65-1 K20SRV MAC 9-Jun-23 23:24 SINFO Sends Iniatialization Packet 38174 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 66 K20SRV MAC 9-Jun-23 23:24 SRVFIL 38175 subttl SRVFIL 38176 ; 38177 ; Common code to construct a generic one-field command. 38178 ; Generic command is single character in t4. Argument is in ATMBUF. 38179 ; Puts a 1-character length field at the beginning. 38180 ; 38181 004555'01 260 17 0 00 004524' srvfil: call sinfo ;[128] Exchange parameters with I packet. 38182 004556'01 263 17 0 00 000000 ret ;[133] Failed, give up. 38183 38184 004557'01 402 00 0 00 000000# setzm srvbuf ;[194] Zero out old stuff 38185 004560'01 200 01 0 00 005767' move t1, [srvbuf,,srvbuf+1] ;[194] The whole buffer 38186 004561'01 251 01 0 00 000000# blt t1, srvbzz ;[194] Not just two words ... 38187 dmove t1, [ point 7, atmbuf ;[194] Copy directory name from here 38188 004562'01 120 01 0 00 005673' point 7, strbuf ] ;[194] to there 38189 38190 004563'01 136 04 0 00 000002 idpb t4, t2 ; Deposit generic command. 38191 004564'01 133 00 0 00 000002 ibp t2 ; Leave a space 38192 004565'01 400 03 0 00 000000 setz t3, ; Initialize counter 38193 38194 004566'01 do. ;[194] Enter loop context 38195 004566'01 134 04 0 00 000001 ildb t4, t1 ; Get next one. 38196 004567'01 136 04 0 00 000002 idpb t4, t2 ; Deposit this one. 38197 004570'01 322 04 0 00 004572' jumpe t4, endlp. ;[194] Stop on a .chnul 38198 004571'01 344 03 0 00 004566' aoja t3, top. ;[194] Otherwise, count it & loop. 38199 004572'01 enddo. ;[194] Exit loop context 38200 38201 ;* jumpe t3, [ ; Make sure there was at least one character. 38202 ;* txmsg 38203 ;* ret ] 38204 38205 004572'01 200 01 0 00 000003 srvfi3: move t1, t3 ; Length 38206 004573'01 271 01 0 00 000040 addi t1, 40 ; CHAR of that. 38207 004574'01 200 02 0 00 005602' move t2, [point 7, strbuf, 13] ; Deposit count at head of field. 38208 004575'01 137 01 0 00 000002 dpb t1, t2 38209 004576'01 200 01 0 00 005600' move t1, [point 7, strbuf] ; Point to generic command. 38210 004577'01 201 02 0 00 000107 movei t2, "G" ; Packet type is G. 38211 004600'01 254 00 0 00 004601' jrst dosrv ; Go do it. 38212 38213 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 67 K20SRV MAC 9-Jun-23 23:24 DOSRV - Wrapper for SRVCMD 38214 subttl DOSRV - Wrapper for SRVCMD 38215 38216 ; Call this exactly like SRVCMD. 38217 ; 38218 ; Send a command to a server and dispatch appropriately depending on the reply. 38219 ; 38220 004601'01 dosrv: entry dosrv ;[220] 38221 004601'01 402 00 0 00 004406* setzm gotx ; Clear flags: "got X packet", 38222 004602'01 402 00 0 00 000000* setzm gots ; "got S packet". 38223 004603'01 260 17 0 00 004327' call srvcmd ; Send a generic command. 38224 004604'01 263 17 0 00 000000 ret ; Didn't get good response. 38225 004605'01 306 01 0 00 000131 cain t1, "Y" ; Was it an ACK? 38226 004606'01 263 17 0 00 000000 ret ; Yes, so we're done. 38227 38228 ; Come here if we're about to receive a multipacket reply. 38229 38230 004607'01 302 01 0 00 000130 caie t1, "X" ; Text header? 38231 004610'01 254 00 0 00 004655' jrst dosrv3 ; No 38232 38233 004611'01 476 00 0 00 004601* setom gotx ; Yup, flag that we already got it. 38234 004612'01 201 11 0 00 000106 movei state, "F" ; State state to file receive. 38235 004613'01 336 00 0 00 000003 skipn t3 ;[173](begin) Any contents? 38236 004614'01 254 00 0 00 000000* jrst $recvb ; No. 38237 38238 remark ;[220] Squeeze out leading and trailing CRLF's 38239 004615'01 415 16 0 00 004654' block. ;[220] Yes, create a frame to print them 38240 004616'01 261 17 0 00 000016 38241 004617'01 265 16 0 00 005507' saveac ;[220] Save in flight temporaries (particularly t1) 38242 004620'01 200 04 0 00 000000# move t4, pktacs+3 ;[220] Load pointer text 38243 004621'01 200 03 0 00 000004 move t3, t4 ;[220] Keep a copy handy 38244 38245 004622'01 134 01 0 00 000004 ildb t1, t4 ;[220] Pick up a character 38246 004623'01 302 01 0 00 000015 caie t1, .chcrt ;[220] A carriage return? 38247 004624'01 254 00 0 00 004631' ifskp. ;[220] It is, let's see if followed by a line feed 38248 004625'01 134 01 0 00 000004 ildb t1, t4 ;[220] Pick up another character 38249 004626'01 302 01 0 00 000012 caie t1, .chlfd ;[220] A line feed?? 38250 004627'01 254 00 0 00 004631' anskp. ;[220] No, so must advance the carriage 38251 remark ;[220] Fall out and skip the crlf 38252 004630'01 254 00 0 00 004634' else. ;[220] Need to get to a clean line 38253 004631'01 561 01 0 00 002404* hrroi t1, crlf 38254 004632'01 104 00 0 00 000076 PSOUT% 38255 004633'01 320 12 0 00 004325* erjmpr r ;[220] If fails, break out of the block, +1 38256 004634'01 endif. ;[220] Either way, ready to see something 38257 38258 004634'01 200 01 0 00 000003 move t1, t3 ;[220] Load original pointer 38259 004635'01 104 00 0 00 000076 PSOUT% ;[220] Type whatever we got handed 38260 004636'01 320 12 0 00 004633* erjmpr r ;[220] Or not... 38261 38262 004637'01 211 04 0 00 777776 movni t4, -2 ;[220] Done printing, so back the 38263 004640'01 133 04 0 00 000001 adjbp t4, t1 ;[220] pointer up so we can have a look 38264 004641'01 134 01 0 00 000004 ildb t1, t4 ;[220] Pick up a character 38265 004642'01 302 01 0 00 000015 caie t1, .chcrt ;[220] A carriage return? 38266 004643'01 254 00 0 00 004650' ifskp. ;[220] It is, let's see if followed by a line feed 38267 004644'01 134 01 0 00 000004 ildb t1, t4 ;[220] Pick up another character 38268 004645'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 15:19 11-Jun-23 Page 67-1 K20SRV MAC 9-Jun-23 23:24 DOSRV - Wrapper for SRVCMD 38269 004646'01 254 00 0 00 004650' anskp. ;[220] No, so must advance the carriage 38270 remark ;[220] Fall out and skip the crlf 38271 004647'01 254 00 0 00 004653' else. ;[220] Need to get to a clean line 38272 004650'01 561 01 0 00 004631* hrroi t1, crlf 38273 004651'01 104 00 0 00 000076 PSOUT% 38274 004652'01 320 12 0 00 004636* erjmpr r ;[220] If fails, break out of the block, +1 38275 004653'01 endif. ;[220] Either way, ready to see something 38276 remark ;[220] Fall out of the block 38277 004653'01 263 17 0 00 000000 endbk. ;[220] End block context 38278 004654'01 254 00 0 00 004614* jrst $recvb ; Go receive whatever is coming. 38279 38280 004655'01 302 01 0 00 000123 dosrv3: caie t1, "S" ;[194] Or Send-Init? 38281 004656'01 254 00 0 00 004662' ifskp. ;[194] Got it 38282 004657'01 476 00 0 00 004602* setom gots ; Yes, flag that we already got it. 38283 004660'01 201 11 0 00 000122 movei state, "R" ; Set state to receive init. 38284 004661'01 254 00 0 00 004654* jrst $recvb ; Go receive what's coming. 38285 004662'01 endif. ;[194] 38286 38287 004662'01 334 01 0 00 000000# ermsg% (,r) 38288 004663'01 254 00 0 00 004667' 38289 004664'01 202 01 0 00 004412* 38290 004665'01 104 00 0 00 000313 38291 004666'01 254 00 0 00 004652* 38292 000332'02 000000000000# 38293 001211'04 113 105 122 115 111 38294 38295 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 68 K20SRV MAC 9-Jun-23 23:24 Is this a directory device? 38296 subttl Is this a directory device? 38297 38298 ;[193] Begin code insertion 38299 ; 38300 ; Call: 38301 ; 38302 ; t1/ JFN to test, NO FLAGS! 38303 ; 38304 ; Returns: 38305 ; 38306 ; +1, Not a directory based device 38307 ; N.B., t1 and t2 may be invalid if DVCHR% failed! 38308 ; 38309 ; +2, Something we can use as a directory 38310 ; 38311 ; t1/ device designator 38312 ; t2/ device characteristics word 38313 ; 38314 ; All other accumulators are preserved 38315 ; 38316 ; NUL: and .nulio directories are expected to be simulated by calling routine 38317 38318 004667'01 isdird: entry isdird ; Called by k20par and maybe k20dsp 38319 004667'01 260 17 0 00 004074* call isnulj ; Is this some kind of NUL: or .nulio? 38320 004670'01 254 00 0 00 004673' ifskp. ; It is, so just say yes 38321 dmove t1, [ .dvdes!.dvnul,,-1 ; NUL: has no units 38322 004671'01 120 01 0 00 005770' dv%out!dv%in!dv%av!fld(.dvnul,dv%typ)!dv%psd!fld(-1,dv%mod) ] 38323 004672'01 254 00 0 00 004554* retskp ; Insist that it is a directory device 38324 004673'01 endif. ; Done with the easy case 38325 ; Have to do some work... 38326 004673'01 265 16 0 00 005757' saveac ; Don't touch the other accumulators 38327 004674'01 104 00 0 00 000117 DVCHR% ; Get device characteristics 38328 004675'01 320 12 0 00 004677' ifje. r ; Fail and retrieve error 38329 004676'01 254 00 0 00 004703' 38330 004677'01 200 04 0 00 000001 move t4, t1 ; Store the error 38331 004700'01 477 01 0 00 000002 setob t1, t2 ; Cons up some real junk 38332 004701'01 400 03 0 00 000000 setz t3, ; This value should never happen 38333 004702'01 254 00 0 00 004704' else. ; Otherwise, worked 38334 004703'01 400 04 0 00 000000 setz t4, ; Flag that DVCHR% worked 38335 004704'01 endif. ; End case DVCHR% failure recovery 38336 ; Finally pick up the device type 38337 004704'01 135 03 0 00 005471' ldb t3,[pointr(t2,dv%typ)] 38338 004705'01 306 03 0 00 000015 cain t3, .dvnul ; NUL:? 38339 004706'01 254 00 0 00 004672* retskp ; Can always delete or list that (simulated) 38340 004707'01 306 03 0 00 000000 cain t3, .dvdsk ; Structure? 38341 004710'01 254 00 0 00 004706* retskp ; Yes, that has directories and files 38342 004711'01 306 03 0 00 000003 cain t3, .dvdta ; Eh? DECtape?? 38343 004712'01 254 00 0 00 004710* retskp ; Who put that back in? 38344 ; None of the above, try general case 38345 004713'01 326 04 0 00 004717' ife. t4 ; Did the DVCHR% work? 38346 004714'01 607 02 0 00 100000 txnn t2, dv%dir ; It did, so does the device have directories? 38347 004715'01 254 00 0 00 004717' anskp. ; No, so can't return true 38348 004716'01 254 00 0 00 004712* retskp ; Something new with a directory should work 38349 004717'01 endif. ; Otherwise, they are out of luck 38350 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 68-1 K20SRV MAC 9-Jun-23 23:24 Is this a directory device? 38351 004717'01 263 17 0 00 000000 ret ; Return doesn't have directories 38352 38353 ;[194] End code insertion 38354 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 69 K20SRV MAC 9-Jun-23 23:24 GTNFIL - Get next file from wild file specification. 38355 subttl GTNFIL - Get next file from wild file specification. 38356 38357 ; Call: 38358 ; 38359 ; filjfn/ Current JFN, possibly one of many 38360 ; nxtjfn/ Next JFN in sequence (1-file lookahead) 38361 ; ndxjfn/ Flags associated with stepping to next specification 38362 ; 38363 ; Returns: 38364 ; 38365 ; +1 t1/ 0 (indicating no more) 38366 ; +2 t1/ JFN of next file 38367 ; 38368 ;[111] Rewritten to do 1-file lookahead as part of edit 111. 38369 ; 38370 ;[194] Partial rewrite to simulate NUL: stepping and also to always 38371 ; return zero on plus 1 return, as per specification 38372 38373 004720'01 gtnfil: entry gtnfil ; Also used by k20mit 38374 004720'01 337 01 0 00 004474* skipg t1, filjfn ;[193] Release the JFN of the previous file. 38375 004721'01 254 00 0 00 004726' ifskp. ;[193] If we have one ... 38376 004722'01 306 01 0 00 377777 cain t1, .nulio ;[193] But!! Is this the sink? 38377 004723'01 254 00 0 00 004726' anskp. ;[193] Yes, no need to release it 38378 004724'01 104 00 0 00 000023 RLJFN 38379 004725'01 320 12 0 00 004726' erjmpr .+1 ;[193] Catch and ignore error 38380 004726'01 endif. ;[193] End case releasing JFN 38381 004726'01 402 00 0 00 004720* setzm filjfn 38382 38383 ; Check to see if we really want to or can get the next file. 38384 38385 004727'01 400 01 0 00 000000 setz t1, ; Assume no more files. 38386 004730'01 336 00 0 00 000000* skipn czseen ;[59] If CTRL-Z seen, then get no more files. 38387 004731'01 336 01 0 00 002754* skipn t1, nxtjfn ; No CTRL-Z. Get next JFN. 38388 004732'01 263 17 0 00 000000 ret ; None, so we're done. 38389 38390 ; Make a separate JFN for the file so that wildcard stepping won't be 38391 ; wiped out by anything we do to it, like deleting it, renaming it, etc. 38392 38393 004733'01 550 02 0 00 000001 hrrz t2, t1 ; Get the filename string. 38394 004734'01 561 01 0 00 003261* hrroi t1, strbuf 38395 004735'01 306 02 0 00 377777 cain t2, .nulio ;[193] Data sink? 38396 004736'01 254 00 0 00 004747' ifskp. ;[193] No, do it the regular way 38397 004737'01 400 03 0 00 000004 setz t3, t4 ;[193] No idiotic prefix 38398 004740'01 104 00 0 00 000030 JFNS 38399 004741'01 320 12 0 00 004776' erjmpr gtnerr ;[194] Bag the whole thing if failed 38400 004742'01 205 01 0 00 100001 movx t1, gj%old!gj%sht ;Get a new JFN on it. 38401 004743'01 561 02 0 00 004734* hrroi t2, strbuf 38402 004744'01 104 00 0 00 000020 GTJFN 38403 004745'01 320 12 0 00 004776' erjmpr gtnerr ;[194] Bag the whole thing if failed 38404 004746'01 254 00 0 00 004753' else. ;[193] Otherwise, NUL: 38405 dmove t2 , [ BYTE (7) "N","U","L",":", 0 38406 004747'01 120 02 0 00 005772' 0 ] ;[193] 38407 004750'01 124 02 0 00 004743* dmovem t2, strbuf ;[193] Put the file name into the buffer 38408 004751'01 400 04 0 00 000000 setz t4, ;[193] Keep t4 whacked like JFNS 38409 004752'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 15:19 11-Jun-23 Page 69-1 K20SRV MAC 9-Jun-23 23:24 GTNFIL - Get next file from wild file specification. 38410 004753'01 endif. ;[193] End special case NUL: 38411 38412 004753'01 552 01 0 00 004726* hrrzm t1, filjfn ; Save it here, sans flags, if any 38413 004754'01 402 00 0 00 004750* setzm strbuf ; Scrub the buffer 38414 004755'01 402 00 0 00 000000# setzm strbuf+1 ; Give it a little more scrubby, just in case 38415 38416 ; Get new next JFN. 38417 38418 004756'01 550 01 0 00 004731* hrrz t1, nxtjfn ;[193] Get the JFN again. 38419 004757'01 302 01 0 00 377777 caie t1, .nulio ;[193] Data sink? 38420 004760'01 254 00 0 00 004764' ifskp. ;[193] Yes, so nothing to step 38421 004761'01 402 00 0 00 004756* setzm nxtjfn ;[193] So flag nothing left 38422 004762'01 402 00 0 00 002755* setzm ndxjfn ;[193] Nothing to step to 38423 remark t1, .nulio ;[193] Fall through with .nulio as JFN 38424 004763'01 254 00 0 00 004774' else. ;[193] Otherwise, have something to sep 38425 004764'01 500 01 0 00 004762* hll t1, ndxjfn ; Get wildcard flags into left half. 38426 004765'01 104 00 0 00 000017 GNJFN ; Get the next JFN. 38427 004766'01 320 12 0 00 004770' ifje. r ;[194] Failed 38428 004767'01 254 00 0 00 004773' 38429 004770'01 200 04 0 00 000001 move t4, t1 ;[194] Save error for interested parties 38430 004771'01 400 01 0 00 000000 setz t1, ; If no more, then no JFN 38431 004772'01 402 00 0 00 004764* setzm ndxjfn ;[194] Nothing more to step 38432 004773'01 endif. ;[193] End GNJFN% failure handling 38433 004773'01 202 01 0 00 004761* movem t1, nxtjfn ; Save result for next time. 38434 004774'01 endif. ;[193] End .nulio special case 38435 38436 ; Return with current JFN 38437 38438 004774'01 200 01 0 00 004753* move t1, filjfn ; Return JFN of current file in t1. 38439 004775'01 254 00 0 00 004716* retskp ; Return +2 indicating another file was found. 38440 38441 004776'01 200 04 0 00 000001 gtnerr: move t4, t1 ;[194] Save error for debuggers 38442 38443 004777'01 336 00 0 00 004774* ifmn. filjfn ;[194] Any file? 38444 005000'01 254 00 0 00 005005' 38445 005001'01 550 01 0 00 004777* hrrz t1, filjfn ;[194] Load JFN, sans flags 38446 005002'01 260 17 0 00 002462* call frclos ;[194] Force it to close 38447 005003'01 600 00 0 00 000000 nop ;[194] Ignore any error 38448 005004'01 402 00 0 00 005001* setzm filjfn ;[194] Whack the remnants 38449 005005'01 endif. ;[194] 38450 38451 005005'01 336 00 0 00 004773* ifmn. nxtjfn ;[194] Any 'next' JFN left? 38452 005006'01 254 00 0 00 005013' 38453 005007'01 550 01 0 00 005005* hrrz t1, nxtjfn ;[194] Yes, load JFN, sans flags 38454 005010'01 260 17 0 00 005002* call frclos ;[194] Force it to close 38455 005011'01 600 00 0 00 000000 nop ;[194] Ignore any error 38456 005012'01 402 00 0 00 005007* setzm nxtjfn ;[194] Whack the remnants 38457 005013'01 endif. ;[194] 38458 38459 005013'01 336 00 0 00 004772* ifmn. ndxjfn ;[194] Any stepping JFN? 38460 005014'01 254 00 0 00 005021' 38461 005015'01 550 01 0 00 005013* hrrz t1, ndxjfn ;[194] Yes, load the JFN, sans flags 38462 005016'01 260 17 0 00 005010* call frclos ;[194] Force it to close 38463 005017'01 600 00 0 00 000000 nop ;[194] Ignore any error 38464 005020'01 402 00 0 00 005015* setzm ndxjfn ;[194] Nothing to step any more k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 69-2 K20SRV MAC 9-Jun-23 23:24 GTNFIL - Get next file from wild file specification. 38465 005021'01 endif. ;[194] 38466 38467 005021'01 400 01 0 00 000000 setz t1, ;[194] No JFN anywhere, anyhow 38468 005022'01 263 17 0 00 000000 ret ;[194] Returns plus one 38469 38470 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 70 K20SRV MAC 9-Jun-23 23:24 Fetch File Information 38471 subttl Fetch File Information 38472 38473 ;[200] Begin Code Insertion 38474 ; 38475 ; Call: 38476 ; 38477 ; t2/ JFN of file to get information for 38478 ; 38479 ; Returns: 38480 ; 38481 ; +1/ Failure, the below are not dependable 38482 ; +2/ Succeed, the below contain 'reasonable' values 38483 ; 38484 ; pagcnt/ Number of pages (or blocks) in the file 38485 ; bytcnt/ Count of bytes in the file and byte size 38486 ; crdate/ Creation date and time 38487 ; 38488 ; N.B., Assumes both that the above variables are contiguous 38489 ; and that they are in the above order! 38490 ; 38491 ; To Do: See if can be coupled with isdird 38492 38493 005023'01 000700 000000 nulfdb: fld(^d7,fb%bsz) ; Pretend ASCII file with no pages 38494 005024'01 000000 000000 0 ; And no bytes 38495 38496 005025'01 filinf: extern pagcnt,crdate ; Size and date storage 38497 005025'01 265 16 0 00 005507' saveac ; Don't destroy calling context 38498 005026'01 553 04 0 00 000002 hrrzs t4, t2 ; Save and strip and flags 38499 005027'01 306 04 0 00 377777 cain t4, .nulio ; OK, is this going to be easy? 38500 005030'01 254 00 0 00 005113' jrst nulinf ; Special cased NUL: is trivial 38501 38502 005031'01 200 01 0 00 000004 move t1, t4 ; Load the JFN 38503 005032'01 104 00 0 00 000117 DVCHR% ; Get the device characteristics 38504 005033'01 320 12 0 00 005035' %jsErr (,r) 38505 005034'01 254 00 0 00 005040' 38506 005035'01 265 01 0 00 004323* 38507 005036'01 000000000000# 38508 005037'01 254 00 0 00 004666* 38509 001224'04 106 151 154 145 040 38510 38511 005040'01 135 03 0 00 005471' ldb t3,[pointr(t2,dv%typ)] ; Load the device type 38512 005041'01 306 03 0 00 000015 cain t3, .dvnul ; An unconverted NUL: device? 38513 005042'01 254 00 0 00 005113' jrst nulinf ; Odd, but handle it 38514 005043'01 302 03 0 00 000000 caie t3, .dvdsk ; Structure? 38515 005044'01 254 00 0 00 005053' ifskp. ; Of course it is 38516 005045'01 200 01 0 00 000004 move t1, t4 ; Restore the JFN 38517 dmove t2, [3,,.fbbyv ; Get size info from FDB (3 words) 38518 005046'01 120 02 0 00 005774' pagcnt] ; Put info in PAGCNT,BYTCNT,CRDATE 38519 005047'01 104 00 0 00 000063 GTFDB% ; which are adjacent in the data area. 38520 005050'01 320 16 0 00 005053' annje. ; Failed, try alternate way 38521 005051'01 254 00 0 00 004775* retskp ; Succeeded 38522 005052'01 254 00 0 00 005113' else. ; Otherwise, use older slower mechanisms 38523 005053'01 200 01 0 00 000004 move t1, t4 ; Restore the JFN 38524 005054'01 104 00 0 00 000036 SIZEF% ; Will work on any directory device 38525 005055'01 320 12 0 00 005057' %jsErr (,r) k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 70-1 K20SRV MAC 9-Jun-23 23:24 Fetch File Information 38526 005056'01 254 00 0 00 005062' 38527 005057'01 265 01 0 00 005035* 38528 005060'01 000000000000# 38529 005061'01 254 00 0 00 005037* 38530 001235'04 106 151 154 145 040 38531 005062'01 250 02 0 00 000003 exch t2,t3 ; Reorder as per above 38532 005063'01 124 02 0 00 001604* dmovem t2, pagcnt ; Store as per GTFDB% 38533 005064'01 265 16 0 00 003723* anstkv (t4,<.rsfet+1>) ;Allocate an anonymous stack variable 38534 005065'01 000000 000007 38535 005066'01 415 04 0 17 777770 38536 005067'01 200 02 0 00 000004 move t2, t4 ; Point to block 38537 005070'01 201 03 0 00 000007 movx t3, <.rsfet+1> ; Length of same 38538 005071'01 104 00 0 00 000533 RFTAD% ; Try it this way 38539 005072'01 320 12 0 00 005074' %jsErr (,r) 38540 005073'01 254 00 0 00 005077' 38541 005074'01 265 01 0 00 005057* 38542 005075'01 000000000000# 38543 005076'01 254 00 0 00 005061* 38544 001247'04 106 151 154 145 040 38545 005077'01 415 16 0 00 005110' block. ; Enter block context for better control flow 38546 005100'01 261 17 0 00 000016 38547 005101'01 332 03 0 04 000001 skipe t3,.rscrv(t4) ; Can we use the obvious file creation date? 38548 005102'01 254 00 0 00 005051* retskp ; Yes, go with that 38549 005103'01 332 03 0 04 000000 skipe t3,.rswrt(t4) ; OK, maybe the last time it was written? 38550 005104'01 254 00 0 00 005102* retskp ; Good enough... 38551 005105'01 332 03 0 04 000003 skipe t3,.rscre(t4) ; No, how about this odd word? 38552 005106'01 254 00 0 00 005104* retskp ; About as good as the previous 38553 remark ; Fall through, +1 38554 005107'01 263 17 0 00 000000 endbk. ; End of block context 38555 005110'01 263 17 0 00 000000 ret ; Failed 38556 005111'01 202 03 0 00 001640* movem t3, crdate ; Store what we decided to use 38557 005112'01 254 00 0 00 005106* retskp ; Return success 38558 005113'01 endif. 38559 38560 remark ; Special case .nulio (and NUL:) 38561 38562 005113'01 120 01 0 00 005023' nulinf: dmove t1,nulfdb ; Phoney up some FDB entries 38563 005114'01 124 01 0 00 005063* dmovem t1, pagcnt ; Store like GTFDB% would 38564 005115'01 104 00 0 00 000227 GTAD% ; Get current time of day 38565 005116'01 202 01 0 00 005111* movem t1, crdate ; NUL: is always created right now 38566 005117'01 254 00 0 00 005112* retskp ; Succeed 38567 38568 ;[200] End Code Insertion 38569 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 71 K20SRV MAC 9-Jun-23 23:24 Fix up a file JFN for fast generational delete 38570 subttl Fix up a file JFN for fast generational delete 38571 38572 ;[199] Begin code insertion 38573 38574 ; The following is necessary to leverage the DELNF% JSYS, which will 38575 ; result in far faster deletion of a file with multiple generations. 38576 ; Otherwise, each and every generation must be handled seperately in a 38577 ; loop doing GTJFN%, GNJFN% and DELF%'s 38578 ; 38579 ; Call: 38580 ; 38581 ; t1/ flags,,JFN as returned by .cmfil 38582 ; 38583 ; Assumes the following are true: 38584 ; 38585 ; 1) That the NUL: device has already been special cased to .nulio 38586 ; 2) That we are not being called with resulting .nulio 38587 ; 3) That the device in question supports directories 38588 ; 38589 ; To do: Was this necessary? If doing highest generation, does a 38590 ; negative value for generations to keep work? 38591 38592 111100 000001 fjfnsf==> ; Want everything but the generation 38593 38594 005120'01 607 01 0 00 010000 ffjfgd: jxe t1, gj%ver, r ; Nothing to do if didn't wildcard the version 38595 005121'01 254 00 0 00 005076* 38596 005122'01 607 01 0 00 004000 ifxn. t1, gj%uhv ; Already doing highest generation? 38597 005123'01 254 00 0 00 005126' 38598 005124'01 621 01 0 00 010000 txz t1, gj%ver ; Don't step generations 38599 005125'01 254 00 0 00 005117* retskp ; Succeed 38600 005126'01 endif. 38601 38602 005126'01 265 16 0 00 005460' saveac ; Candidate JFN and storage for file name 38603 005127'01 200 05 0 00 000001 move q1, t1 ; Save the JFN and flags 38604 005130'01 265 16 0 00 005064* anstkv (q2,mxfilw) ; Storage to build a new name 38605 005131'01 000000 000034 38606 005132'01 415 06 0 17 777743 38607 38608 005133'01 560 01 0 00 000006 hrro t1, q2 ; Construct Tops-20 ASCII pointer to stack 38609 005134'01 550 02 0 00 000005 hrrz t2, q1 ; Load JFN, sans flags 38610 005135'01 120 03 0 00 005776' dmove t3, [exp fjfnsf,0] ;Fast delete JFNS Flags and no prefix 38611 005136'01 104 00 0 00 000030 JFNS% ; Reconstruct on the stack 38612 005137'01 320 12 0 00 005141' %jsErr (,r) 38613 005140'01 254 00 0 00 005144' 38614 005141'01 265 01 0 00 005074* 38615 005142'01 000000000000# 38616 005143'01 254 00 0 00 005121* 38617 001261'04 125 156 141 142 154 38618 005144'01 120 02 0 00 006000' dmove t2, [exp ".","0"] ; Highest generation and punctuation 38619 005145'01 136 02 0 00 000001 idpb t2, t1 ; Append the generation punctionation 38620 005146'01 136 03 0 00 000001 idpb t3, t1 ; Append the highest generation moniker 38621 005147'01 136 04 0 00 000001 idpb t4, t1 ; Tie off the string 38622 ; Load GTJFN% flag bits,,generation number. 38623 005150'01 205 01 0 00 100120 movx t1, gj%old!gj%ifg!gj%flg!fld(.rhalf,.gjdef) 38624 005151'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 15:19 11-Jun-23 Page 71-1 K20SRV MAC 9-Jun-23 23:24 Fix up a file JFN for fast generational delete 38625 005152'01 104 00 0 00 000020 GTJFN% ; Get a brand new JFN on file group 38626 005153'01 320 12 0 00 005155' %jsErr (,r) 38627 005154'01 254 00 0 00 005160' 38628 005155'01 265 01 0 00 005141* 38629 005156'01 000000000000# 38630 005157'01 254 00 0 00 005143* 38631 001271'04 125 156 141 142 154 38632 38633 005160'01 500 01 0 00 000005 hll t1, q1 ; Load just the calling flags 38634 005161'01 621 01 0 00 013000 txz t1, gj%ver!gj%nhv!gj%ulv ; Shut off wildcarded lowest and next highest 38635 005162'01 661 01 0 00 004000 txo t1, gj%uhv ; Force highest generation, always 38636 005163'01 250 01 0 00 000005 exch t1, q1 ; Swap with old flags,,JFN 38637 38638 005164'01 621 01 0 00 777777 tlz t1, -1 ; Toss its flags 38639 005165'01 104 00 0 00 000023 RLJFN% ; Toss the JFN 38640 005166'01 320 12 0 00 005170' ifje. r ; Failed?? 38641 005167'01 254 00 0 00 005174' 38642 005170'01 306 01 0 00 600152 cain t1, desx3 ; Wait, did it disappear?? 38643 005171'01 254 00 0 00 005174' anskp. ; Odd, but that's really fine 38644 005172'01 200 02 0 00 000001 move t2, t1 ; Otherwise, save the error carry on 38645 005173'01 254 00 0 00 005175' else. ; Otherwise, worked!! 38646 005174'01 400 02 0 00 000000 setz t2, ; Signal no error 38647 005175'01 endif. ; Worst case, we drag an extra JFN around 38648 38649 005175'01 200 01 0 00 000005 move t1, q1 ; Load updated flags and new JFN 38650 005176'01 254 00 0 00 005125* retskp ; Finally return success 38651 38652 ;[199] End code insertion 38653 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 72 K20SRV MAC 9-Jun-23 23:24 Routine to delete a file [118] 38654 subttl Routine to delete a file [118] 38655 38656 extern expung ; Auto expunge flag 38657 38658 ; [199] Partially adapted from EFTPST. 38659 38660 ; Call: 38661 ; 38662 ; t2/ flags,,JFN 38663 ; 38664 ; The flags are the stepping flags for a wildcarded JFN and may 38665 ; NOT be associated with the JFN in question. gj%uhv is checked 38666 ; to see if the original file specification wildcarded the 38667 ; version number. If this is the case and expunge is not on, 38668 ; then DELNF% will be used for a substantial performance increase. 38669 ; 38670 ; Returns: +1, always 38671 ; 38672 ; The JFN is not released (see below) in order to allow the driving 38673 ; loop to release it. Otherwise, in a multi-forking environment, you 38674 ; can get into the situation that the JFN is released here and another 38675 ; fork is then picked to run which issues a GTJFN%. If the same JFN 38676 ; is given, then when driver code resumes, it may wind up releasing 38677 ; somebody else's JFN!! 38678 ; 38679 ; N.B., The "remark t1, df%nrj" is used to acknowledge a documentation 38680 ; 'bug' that claims that the DELNF% JSYS will release the JFN unless 38681 ; this bit is set. No, it doesn't. 38682 ; 38683 ; DELNF% does not handle the bit: it NEVER releases JFNs because 38684 ; there is no code to do this. So, we pretend to set it even though 38685 ; DELNF% does not look at it, never has looked at it and never will 38686 ; look at it. 38687 ; 38688 ; This behavior has been consistent from TENEX days. The problem is 38689 ; a Tops-20 Monitor Calls Manual documentation defect which has 38690 ; existed since version 3A. 38691 38692 005177'01 550 01 0 00 000002 delfil: hrrz t1, t2 ;[193] Load the JFN, sans flags 38693 38694 005200'01 302 01 0 00 377777 caie t1, .nulio ;[193] Data sink? 38695 005201'01 254 00 0 00 005204' ifskp. ;[193] Yep, that's pretty easy 38696 005202'01 474 04 0 00 000000 seto t4, ;[199] Flag a phoney delete 38697 005203'01 254 00 0 00 005224' jrst delepi ;[199] And hit the epilogue 38698 005204'01 endif. ;[199] End .nulio special case 38699 38700 remark ;[199] Otherwise, deleting something for real 38701 005204'01 332 00 0 00 001045* ifme. expung ;[143] Not expunging automatically? 38702 005205'01 254 00 0 00 005220' 38703 005206'01 607 02 0 00 004000 txnn t2, gj%uhv ;[199] Yes. Doing all of them? 38704 005207'01 254 00 0 00 005220' anskp. ;[199] No, then don't whack all of them 38705 remark t1, df%nrj ;[199] No flags being used (see above) 38706 005210'01 400 02 0 00 000000 setz t2, ;[199] Don't keep ANY generations 38707 005211'01 104 00 0 00 000317 DELNF% ;[199] Chuck all of them; boom! 38708 005212'01 320 12 0 00 005262' erjmpr delerr ;[199] But didn't ... k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 72-1 K20SRV MAC 9-Jun-23 23:24 Routine to delete a file [118] 38709 005213'01 553 04 0 00 000002 hrrzs t4, t2 ;[199] Remember number deleted 38710 005214'01 275 02 0 00 000001 subi t2, ^d1 ;[199] Account for assumed single file 38711 005215'01 323 02 0 00 005217' ifg. t2 ;[199] Two or more? 38712 005216'01 272 02 0 00 000000# addm t2, filcnt ;[199] Bump the file count with remainder 38713 005217'01 endif. ;[199] 38714 005217'01 254 00 0 00 005224' else. ;[199] Otherwise, just do this single file 38715 005220'01 505 01 0 00 600000 hrli t1, (df%nrj!df%exp) ;[143] Yes, set the bit 38716 005221'01 104 00 0 00 000026 DELF ; Try to delete it. 38717 005222'01 320 12 0 00 005262' erjmpr delerr ;[199] But couldn't 38718 005223'01 400 04 0 00 000000 setz t4, ;[199] Flag special singular case 38719 005224'01 endif. ;[199] End case expunge optimization 38720 remark t4, delepi ;[199] Falls through to epilogue with t4 set 38721 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 73 K20SRV MAC 9-Jun-23 23:24 Delete epilogue code comments on file operation 38722 subttl Delete epilogue code comments on file operation 38723 38724 ; Expects t4 to have a file count or a negative talisman 38725 38726 005224'01 200 01 0 00 000000# delepi: move t1, srvptr ;[199] Build confirmation message. 38727 005225'01 303 04 0 00 000001 caile t4, ^d1 ;[193] A single file or something odd 38728 005226'01 254 00 0 00 005242' ifskp. ;[193] Yes, that's easy enough 38729 005227'01 200 02 0 00 000000# move t2, delfa ;[199] Load singular file delete acknowledge 38730 005230'01 136 02 0 00 000001 idpb t2, t1 ;[199] Append first character 38731 repeat ^d4, < ;[199] And the other four 38732 lsh t2, -^d7 ;[199] Shift next character into place 38733 idpb t2, t1 ;[199] Append it 38734 > ;[199] End loop unroll 38735 005231'01 242 02 0 00 777771 38736 005232'01 136 02 0 00 000001 38737 005233'01 242 02 0 00 777771 38738 005234'01 136 02 0 00 000001 38739 005235'01 242 02 0 00 777771 38740 005236'01 136 02 0 00 000001 38741 005237'01 242 02 0 00 777771 38742 005240'01 136 02 0 00 000001 38743 38744 005241'01 254 00 0 00 005256' else. ;[199] Otherwise, DELNF% cleaned up a bunch 38745 005242'01 120 02 0 00 006002' dmove t2, [ exp ",", .chspc ] ;[199] Comma space over 38746 005243'01 136 02 0 00 000001 idpb t2, t1 ;[199] append the comma 38747 005244'01 136 03 0 00 000001 idpb t3, t1 ;[199] and the space 38748 005245'01 200 02 0 00 000004 move t2, t4 ;[199] Pick up the number done 38749 005246'01 201 03 0 00 000012 movei t3, ^d10 ;[199] Generations are base 10 38750 005247'01 104 00 0 00 000224 NOUT% ;[199] Convert and append 38751 005250'01 320 12 0 00 005252' %jsErr (,) ;[199] 38752 005251'01 254 00 0 00 005255' 38753 005252'01 265 01 0 00 005155* 38754 005253'01 000000000000# 38755 005254'01 254 00 0 00 005255' 38756 001304'04 103 157 165 154 144 38757 005255'01 260 17 0 00 005306' call apptxt ;[199] Append clarifying text 38758 005256'01 endif. ;[199] 38759 38760 005256'01 202 01 0 00 000000# movem t1, srvptr ; Update the string pointer. 38761 005257'01 400 02 0 00 000000 setz t2, ;[199] Cons up a .chnul 38762 005260'01 136 02 0 00 000001 idpb t2, t1 ;[199] Keep it ASCIZ 38763 005261'01 263 17 0 00 000000 ret ; Done 38764 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 74 K20SRV MAC 9-Jun-23 23:24 Handle some kind of delete error 38765 subttl Handle some kind of delete error 38766 38767 ; Expects to be called with an erjmpr or similar (NOT ercalr or pushj!) 38768 38769 005262'01 370 00 0 00 000000# delerr: sos filcnt ; "Uncount" this file, it wasn't deleted. 38770 005263'01 200 04 0 00 000001 move t4, t1 ;[199] Pass error back, if wanted 38771 005264'01 661 04 0 00 777777 tlo t4, -1 ;[199] And flag it was an error 38772 005265'01 200 01 0 00 000000# move t1, srvptr ;[199] Error, record the message 38773 005266'01 120 02 0 00 006004' dmove t2, [ exp ":", .chspc] ;[199] Load punctuation 38774 005267'01 136 02 0 00 000001 idpb t2, t1 ;[199] Append it 38775 005270'01 136 03 0 00 000001 idpb t3, t1 ;[199] 38776 005271'01 505 02 0 00 400000 hrli t2,.fhslf ;[199] This fork (LH) 38777 005272'01 540 02 0 00 000004 hrr t2, t4 ;[199] Load 'calling' error 38778 005273'01 400 03 0 00 000000 setz t3, ;[199] No limit (maybe bad idea?) 38779 005274'01 104 00 0 00 000011 ERSTR 38780 005275'01 320 14 0 00 005277' erjmps .+2 ;[199] Ignore strange return 38781 005276'01 320 14 0 00 005277' erjmps .+1 ;[199] Ignore stranger return 38782 005277'01 120 02 0 00 005635' dmove t2, [ exp .chcrt, .chlfd ] ;[199] Load line terminators 38783 005300'01 136 02 0 00 000001 idpb t2, t1 ;[199] Tie off 38784 005301'01 136 03 0 00 000001 idpb t3, t1 ;[199] the line ... 38785 005302'01 202 01 0 00 000000# movem t1, srvptr ;[199] Update the pointer 38786 005303'01 400 02 0 00 000000 setz t2, ;[199] Cons up a .chnul 38787 005304'01 136 02 0 00 000001 idpb t2, t1 ;[199] Keep it ASCIZ 38788 005305'01 263 17 0 00 000000 ret ;[199] Done with blat 38789 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 75 K20SRV MAC 9-Jun-23 23:24 ASCII text to efficiently append in arcane ways 38790 subttl ASCII text to efficiently append in arcane ways 38791 38792 ;[199] Begin code insertion 38793 38794 chgsec(code,text) ;;Text goes in section zero text 38795 000123'03 delfa: remark " [OK] " ; delete file acknowlege 38796 000123'03 273134 766640 byte (1) 0 (7) "]", "K", "O", "[", .chspc 38797 38798 000124'03 gentxt: remark " generations" ; Inflection will always be plural 38799 000124'03 313566 271640 byte (1) 0 (7) "e", "n", "e", "g", .chspc 38800 000125'03 337517 230362 byte (1) 0 (7) "o", "i", "t", "a", "r" 38801 000126'03 000000 034756 byte (1) 0 (7) .chnul, .chnul, .chnul, "s", "n" 38802 retsec ;;Back to generating code 38803 38804 ; To do: The unrolled right justified ASCIZ ", generations" text can 38805 ; be stored with 24 instructions. At what point would the MOVSLJ 38806 ; begin to outperform this? I dislike using SOUT% to shuttle 38807 ; characters. Ditto NOUT% for numbers... 38808 38809 005306'01 apptxt: remark t1, ; Expects a valid pointer in t1 38810 005306'01 200 02 0 00 000000# move t2, gentxt ; Load first part of explanatory text 38811 005307'01 136 02 0 00 000001 idpb t2, t1 ; Append first character 38812 repeat ^d4, < ; And the other four 38813 lsh t2, -^d7 ; Shift the next character into place 38814 idpb t2, t1 ; Append it 38815 > ; End loop unroll 38816 005310'01 242 02 0 00 777771 38817 005311'01 136 02 0 00 000001 38818 005312'01 242 02 0 00 777771 38819 005313'01 136 02 0 00 000001 38820 005314'01 242 02 0 00 777771 38821 005315'01 136 02 0 00 000001 38822 005316'01 242 02 0 00 777771 38823 005317'01 136 02 0 00 000001 38824 38825 005320'01 200 02 0 00 000000# move t2, gentxt+1 ; Load next part of explanatory text 38826 005321'01 136 02 0 00 000001 idpb t2, t1 ; Append first character 38827 repeat ^d4, < ; And the other four 38828 lsh t2, -^d7 ; Shift next next character into place 38829 idpb t2, t1 ; Append it 38830 > ; End loop unroll 38831 005322'01 242 02 0 00 777771 38832 005323'01 136 02 0 00 000001 38833 005324'01 242 02 0 00 777771 38834 005325'01 136 02 0 00 000001 38835 005326'01 242 02 0 00 777771 38836 005327'01 136 02 0 00 000001 38837 005330'01 242 02 0 00 777771 38838 005331'01 136 02 0 00 000001 38839 38840 005332'01 200 02 0 00 000000# move t2, gentxt+2 ; Load final part of explanatory text 38841 005333'01 136 02 0 00 000001 idpb t2, t1 ; Append first character 38842 005334'01 242 02 0 00 777771 lsh t2, -^d7 ; Shift the final character into place 38843 005335'01 136 02 0 00 000001 idpb t2, t1 ; Append it 38844 005336'01 263 17 0 00 000000 ret ; Done k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 75-1 K20SRV MAC 9-Jun-23 23:24 ASCII text to efficiently append in arcane ways 38845 38846 ;[199] End code insertion 38847 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 76 K20SRV MAC 9-Jun-23 23:24 DMPBUF - Dump the buffer [115] 38848 subttl DMPBUF - Dump the buffer [115] 38849 38850 ;[215] Begin code insertion (moved from k20mit) 38851 ; 38852 ; 38853 ; Call with SRVPTR/ current pointer (to end of string to be dumped) 38854 ; Returns +1 with t1/ new pointer. Uses t2. 38855 ; 38856 ; Dumps the buffer starting from SRVBUF thru present position, 38857 ; resets pointer SRVPTR to beginning of SRVBUF. 38858 ; 38859 ; Certain headers are hardcoded and need no termination. These are all 38860 ; up in section 1 and are referenced by one word global ASCII pointers. 38861 38862 005337'01 dmpbuf: entry dmpbuf ;[194] Also used from k20dsp 38863 005337'01 200 01 0 00 000000# move t1, srvptr ; Get current pointer. 38864 005340'01 200 03 0 00 000001 move t3, t1 ;[215] Save a copy here, just in case 38865 005341'01 200 04 0 00 000001 move t4, t1 ;[215] And another copy over here 38866 38867 005342'01 474 02 0 00 000000 seto t2, ;[215] Just in case first fetch fails 38868 005343'01 135 02 0 00 000004 ldb t2, t4 ;[215] Pick up current byte 38869 005344'01 320 12 0 00 005371' erjmpr dmpbfe ;[215] Handle an addressing error 38870 005345'01 322 02 0 00 005355' jumpe t2, dmpbf2 ;[215] Already tied off, nothing to do 38871 005346'01 474 02 0 00 000000 seto t2, ;[215] Just in case 2nd fetch fails 38872 005347'01 134 02 0 00 000004 ildb t2, t4 ;[215] No, how about the NEXT byte, then? 38873 005350'01 320 12 0 00 005371' erjmpr dmpbfe ;[215] Handle an addressing error 38874 005351'01 322 02 0 00 005355' jumpe t2, dmpbf2 ;[215] Already tied off, nothing to do 38875 38876 005352'01 403 02 0 00 000004 dmpbf1: setzb t2, t4 ;[215] Have to tie it off, then 38877 005353'01 136 04 0 00 000003 idpb t4, t3 ;[215] Make sure string is asciz. 38878 005354'01 320 12 0 00 005371' erjmpr dmpbfe ;[215] Failed?? 38879 38880 005355'01 200 01 0 00 006006' dmpbf2: move t1, [point 7, srvbuf] ; Point to buffer 38881 005356'01 202 01 0 00 000000# movem t1, srvptr ; Save new pointer. 38882 38883 005357'01 332 00 0 00 003146* ifme. srvflg ;[194] Am I not a server? 38884 005360'01 254 00 0 00 005364' 38885 005361'01 336 00 0 00 000000# skipn srvbuf ;[194] No, but is there anything to type? 38886 005362'01 254 00 0 00 005364' anskp. ;[194] No, so bum the JSYS 38887 005363'01 104 00 0 00 000076 PSOUT ; If not, print it. 38888 005364'01 endif. ;[194] 38889 38890 005364'01 402 00 0 00 000000# dmpbf3: setzm srvbuf ; Clear it. 38891 005365'01 200 01 0 00 006007' move t1, [srvbuf,,srvbuf+1] 38892 005366'01 251 01 0 00 000000# blt t1, srvbzz 38893 005367'01 200 01 0 00 000000# move t1, srvptr ; Return pointer in t1. 38894 005370'01 263 17 0 00 000000 ret 38895 38896 ; Here on some addressing error. If t2 is negative, then we failed 38897 ; on the read. If it is zero, then we failed on the write. 38898 38899 005371'01 dmpbfe: remark ;[215] Here if an addressing error 38900 005371'01 305 02 0 00 000000 caige t2, 0 ;[215] Failed the read? 38901 005372'01 334 00 0 00 000000 %ermsg (,dmpbe3) ;[215] 38902 005373'01 254 00 0 00 005377' k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 76-1 K20SRV MAC 9-Jun-23 23:24 DMPBUF - Dump the buffer [115] 38903 005374'01 265 01 0 00 005252* 38904 005375'01 000000000000# 38905 005376'01 254 00 0 00 005444' 38906 001315'04 144 155 160 142 165 38907 38908 005377'01 200 04 0 00 000001 move t4, t1 ;[215] Get error number out of the way 38909 005400'01 302 04 0 00 601775 caie t4, ILLX02 ;[215] Write-protected page, then? 38910 005401'01 334 00 0 00 000000 %ermsg (,dmpbe3) ;[215] 38911 005402'01 254 00 0 00 005406' 38912 005403'01 265 01 0 00 005374* 38913 005404'01 000000000000# 38914 005405'01 254 00 0 00 005444' 38915 001330'04 144 155 160 142 165 38916 005406'01 554 01 0 00 000003 hlrz t1, t3 ;[215] Pick up the pointer position portion 38917 005407'01 200 02 0 00 000001 move t2, t1 ;[215] Make a copy so can examine both parts 38918 005410'01 405 01 0 00 770000 andi t1, 770000 ;[215] Shut off the section 38919 005411'01 405 02 0 00 007777 andi t2, 007777 ;[215] Keep just the section 38920 ;[215] First check just the pointer 38921 remark ;[215] There will be only six possible positions 38922 005412'01 306 01 0 00 610000 cain t1, (.p0736) ;[215] Starting position? 38923 005413'01 254 00 0 00 005433' jrst dmpbe1 ;[215] Yep, OK 38924 005414'01 306 01 0 00 620000 cain t1, (.p0706) ;[215] First byte? 38925 005415'01 254 00 0 00 005433' jrst dmpbe1 ;[215] Yep, OK 38926 005416'01 306 01 0 00 630000 cain t1, (.p0713) ;[215] Second byte? 38927 005417'01 254 00 0 00 005433' jrst dmpbe1 ;[215] Yep, OK 38928 005420'01 306 01 0 00 640000 cain t1, (.p0720) ;[215] Third byte? 38929 005421'01 254 00 0 00 005433' jrst dmpbe1 ;[215] Yep, OK 38930 005422'01 306 01 0 00 650000 cain t1, (.p0727) ;[215] Fourth byte? 38931 005423'01 254 00 0 00 005433' jrst dmpbe1 ;[215] Yep, OK 38932 005424'01 306 01 0 00 660000 cain t1, (.p0734) ;[215] Fifth byte? 38933 005425'01 254 00 0 00 005433' jrst dmpbe1 ;[215] Yep, OK 38934 38935 005426'01 334 00 0 00 000000 %ermsg (,dmpbe3) ;[215] 38936 005427'01 254 00 0 00 005433' 38937 005430'01 265 01 0 00 005403* 38938 005431'01 000000000000# 38939 005432'01 254 00 0 00 005444' 38940 001342'04 144 155 160 142 165 38941 38942 005433'01 dmpbe1: remark ;[215] Here if thought to be a valid OWG ASCII ptr 38943 005433'01 302 02 0 00 000001 caie t2, extsec ;[215] In extended text psect? 38944 005434'01 334 00 0 00 000000 %ermsg (,dmpbe3) ;[215] 38945 005435'01 254 00 0 00 005441' 38946 005436'01 265 01 0 00 005430* 38947 005437'01 000000000000# 38948 005440'01 254 00 0 00 005444' 38949 001353'04 144 155 160 142 165 38950 38951 005441'01 dmpbe2: remark ;[215] Terminated string or a write error we can handle 38952 005441'01 200 01 0 00 000003 move t1, t3 ;[215] Reload original pointer 38953 005442'01 133 00 0 00 000001 ibp t1 ;[215] Pretend the idpb worked 38954 005443'01 254 00 0 00 005355' jrst dmpbf2 ;[215] Carry on 38955 38956 005444'01 dmpbe3: remark ;[215] Here on error recovery failure 38957 005444'01 200 01 0 00 006010' move t1, [point 7, srvbuf] ;[215] Just reset k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 76-2 K20SRV MAC 9-Jun-23 23:24 DMPBUF - Dump the buffer [115] 38958 005445'01 202 01 0 00 000000# movem t1, srvptr ;[215] the bufer pointer 38959 005446'01 254 00 0 00 005364' jrst dmpbf3 ;[215] And stomp the buffer 38960 38961 38962 ;[215] End code insertion 38963 38964 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 77 K20SRV MAC 9-Jun-23 23:24 Close out Code 38965 subttl Close out Code 38966 38967 xlist ; Shut off the listing 38968 list ; Turn the listing back on 38969 38970 .endps code 38971 k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page 78 K20SRV MAC 9-Jun-23 23:24 Impure data area 38972 subttl Impure data area 38973 38974 .psect data 38975 38976 000000'05 tmpjfn: block 1 ;[233] Used for directory/name logging 38977 000001'05 dirbuf: block fdrmxw ;[220] Maximum size foreign directory 38978 000142'05 pasbuf: block fpwmxw ;[220] Maximum size foreign password 38979 000303'05 44 07 0 00 000000* filptr: point 7, filbuf ; Pointer to file buffer text 38980 38981 000304'05 000000 000000 filcnt: 0 ;[194] ; File counter for directory listings. 38982 000305'05 000000 000000 dirfin: 0 ;[194] ; Flag for directory listing finished. 38983 38984 000306'05 000000 000000 gclen: 0 ; Generic command data field length. 38985 000307'05 000000 000000 rufork: 0 ; Fork number for LOCAL RUN program fork. 38986 38987 ;[220] These all get the "x" overwritten 38988 38989 ;To do, they get the X overwritten sometimes... 38990 38991 000310'05 042 170 042 040 055 xxbmsg: asciz/"x" - Not valid as server command/ ; Another. 38992 000041 xxblen==^d33 ;[220] ; Number of characters in xxbmsg. 38993 000317'05 042 170 042 040 055 xxgnms: asciz/"x" - Unimplemented generic command/ 38994 000043 xxgnln==^d35 ;[220] 38995 000327'05 042 170 042 040 055 xxgums: asciz/"x" - Undefined generic command/ 38996 000037 xxguln==^d31 ;[220] 38997 000336'05 042 170 042 040 055 xxumsg: asciz/"x" - Unknown server command/ ; Server message (fill in the x) 38998 000034 xxulen==^d28 ;[220] ; Number of characters in xxumsg. 38999 39000 remark Buffer space 39001 39002 000344'05 000000 000000 getptr: 0 ;[220] ; Pointer for emptying... 39003 000345'05 000000 000000 srvptr: 0 ;[194] ; And pointer for filling... 39004 000346'05 srvbuf: xlist ;[194] ;[187] Save the trees!! 39005 list ;[187] 39006 39007 001346'05 srvbz: xlist ;[194] ;[187] 39008 list ;[187] 39009 001446'05 000000 000000 srvbzz: 0 ;[220] ;[215] Where the padding ends. 39010 39011 .endps data 39012 39013 end NO ERRORS DETECTED PROGRAM BREAK IS 000000 PSECT 1 BREAK IS 006011 FOR CODE PSECT 2 BREAK IS 000501 FOR CONST PSECT 3 BREAK IS 000127 FOR TEXT PSECT 4 BREAK IS 001366 FOR ETEXT PSECT 5 BREAK IS 001447 FOR DATA CPU TIME USED 00:01.621 127P CORE USED k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page S-1 K20SRV MAC 9-Jun-23 23:24 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 15:19 11-Jun-23 Page S-2 K20SRV MAC 9-Jun-23 23:24 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 15:19 11-Jun-23 Page S-3 K20SRV MAC 9-Jun-23 23:24 SYMBOL TABLE FOR PSECT CODE ACABL 000003 spd FFJFGD 005120' NULIST 001553' STATIM 004343' ext APPTXT 005306' FFUNC 004115' ext NUMTRY 004525' ext STATXT 005732' ext ATMBLN 000000 ext FILBFZ 000000 ext NXTJFN 005012' ext STIMOU 003145' ext ATMBUF 005673' ext FILBUF 005642' ext ODELAY 003142' ext STRBUF 005674' ext BADEVC 001111' FILINF 005025' OTIMOU 003144' ext STRBZ 003263' ext BCTONE 004527' ext FILIST 001570' PAGCNT 005114' ext STRPTR 004353' ext BIGSOU 003214' ext FILJFN 005004' ext PARS3 004300' ext SUBBP 003566' ext BYTCNT 001611' ext FJFNSF 111100 000001 spd PARS4 004163' ext SYSNAM 002545' ext CAPAS 004232' ext FRCLOS 005016' ext PARS5 000537' ext TAKDEP 004327' ext CARIER 002570' ext GETARG 003257' PKTACS 004517' ext TAKJFN 000323' ext CAXZOF 004463' ext GETBUF 004356' ext PKTNUM 004526' ext TIMEIT 003121' ext CCOFF 004520' ext GETCM2 002555' PTYFLG 003124' ext TIMOFF 003140' ext CCON 004344' ext GETCMM 002552' PTYTTY 003126' ext TLGJFN 004076' ext CFIELD 002011' ext GETCOM 002512' ent PUTBUF 004514' ext TTXON 005720' ext CFMRTN 004156' ext GETPAS 000301' PUTSCH 003245' ent TTYJFN 003123' ext CJFNBK 005741' ext GOTS 004657' ext PUTTCH 003247' ent TTYNUM 002522' ext CLENUP 003153' ext GOTX 004611' ext PWCONP 000642' TYPFIL 002441' ext CLRBUF 004530' ext GTNERR 004776' R 005157' ext TYPNAM 002410' ext CLRCNO 002403' ext GTNFIL 004720' ent RFIELD 004141' ext UDJINF 000274' ent CLREAD 000014' ext GTSCH 003236' ent RPACK 004407' ext VCHRCN 000021' ext CMDER1 004207' ext GTSCHX 003240' RPAR 003230' ext WHAKFP 002456' ext CRDATE 005116' ext GTSCHZ 003242' RPTOT 002574' ext XFLG 004124' ext CRLF 005611' ext HDRPTR 001360' RRINIT 002722' ext XGCWD 003311' CWDEVE 000624' HDRTXT 001343' RRSL2 004522' ext XGCWD2 003322' CZSEEN 004730' ext HLPNTR 000000 ext RRSLIN 003141' ext XGCWD3 003335' DATBUF 005724' ext IFLG 004553' ext RSKP 005176' ext XGCWD4 003400' DECODF 002731' ext INILIN 004334' ext SCRLFT 004104' ext XGCWD5 003412' DEFDIR 000163' ISDIRD 004667' ent SCRUBP 000467' XGCWDZ 003425' DELAY 003143' ext ISNULJ 004667' ext SDELBK 004037' XGDEL 004051' DELEPI 005224' JOBTAB 000000 ext SDIRB2 003706' XGDEL2 004061' DELERR 005262' LOCAL 004521' ext SDIRBK 004025' XGDIR 003720' DELFIL 005177' LOGJFN 003112' ext SEOLCH 002032' ext XGDIR2 003743' DEST 004516' ext MAXDAT 004355' ext SETLOG 004532' ext XGDIS2 003511' DIRCH 003667' ent MAXTRY 004371' ext SINFO 004524' ent XGDISK 003454' DIRCH2 003672' MDMLIN 002567' ext SINFO2 004535' XGDISZ 003540' DIRCHX 003701' MOVASC 001501' ext SINFOX 004551' XGEN 002771' DIRCHZ 003703' MOVCHR 001551' int SINFOZ 004553' XGFIN 003053' DIRHDR 001365' MXASCZ 000000 ext SINIT 004537' ext XGFIN2 003101' DIRLST 001417' MYCAPS 000000 ext SOURCE 004477' ext XGHEL1 003656' DIRLSZ 001520' NAK 002624' ext SPACK 004404' ext XGHELP 003642' DMPBE1 005433' NDXJFN 005020' ext SPAR 004543' ext XGLOG1 003141' DMPBE2 005441' NETJFN 003122' ext SPEED 002526' ext XGLOGO 003114' DMPBE3 005444' NEXT 004354' ext SPSIZ 003577' ext XGNYI 003050' DMPBF1 005352' NNAK 004336' ext SPTOT 002573' ext XGPWD 003546' DMPBF2 005355' NOIRTN 004133' ext SRVCM2 004370' XGSTAT 003621' DMPBF3 005364' NSICI 000017' ext SRVCMA 004351' XGTYPE 003164' DMPBFE 005371' NSIMX 000024' ext SRVCMD 004327' XGUNDF 003045' DMPBUF 005337' ent NSITC 000022' ext SRVCMX 004462' XHLPTR 000000000000# pol DOSRV 004601' ent NTIMOU 004337' ext SRVCMZ 004502' XHOST 002763' DOSRV3 004655' NUL4 001363' int SRVFI3 004572' XINFO 003224' ELPTIM 004465' ext NULDEV 001362' SRVFIL 004555' XRECV 002727' ENDTIM 004464' ext NULDIR 001541' SRVFLG 005357' ext XRECV2 002741' ERRPTR 004664' ext NULFDB 005023' SRVHLP 000000 ext XSEND 002711' EXPUNG 005204' ext NULFIL 001547' SRVTIM 002601' ext XXCMD 002640' F$EXIT 003154' ext NULINF 005113' SRVXX 004331' XXGCMD 003012' k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page S-4 K20SRV MAC 9-Jun-23 23:24 SYMBOL TABLE FOR PSECT CODE XXINV 002676' ..0205 000241' spd ..0625 001310' spd ..1202 002310' spd XXMSG 002700' ..0206 000240' spd ..0626 001313' spd ..1210 002315' spd XXUNK 002673' ..0224 000242' spd ..0627 001317' spd ..1220 002342' spd XXWAIT 002567' ..0225 000247' spd ..0637 001337' spd ..1221 002376' spd $BYE 000004' ent ..0231 000272' spd ..0640 001342' spd ..1226 002351' spd $BYEZ 000050' ..0241 000307' spd ..0641 001413' spd ..1227 002376' spd $FINIS 001755' ent ..0252 000316' spd ..0646 001414' spd ..1234 002365' spd $RECVB 004661' ext ..0260 000351' spd ..0653 001404' spd ..1235 002370' spd $RECVS 002724' ext ..0303 000402' spd ..0654 001410' spd ..1246 002400' spd $SENDS 004125' ext ..0304 000424' spd ..0661 001445' spd ..1247 002455' spd $SRVT 003634' ext ..0314 000441' spd ..0662 001452' spd ..1254 002417' spd $XCWD 000751' ..0320 000465' spd ..0663 001466' spd ..1255 002441' spd $XDELE 001121' ..0335 000477' spd ..0675 001464' spd ..1262 002424' spd $XDIRE 001646' ..0346 000526' spd ..0676 001466' spd ..1263 002427' spd $XDISK 002147' ent ..0350 000550' spd ..0700 001505' spd ..1273 002463' spd $XERR 001705' ..0365 000611' spd ..0705 001511' spd ..1301 002507' spd $XHELP 001767' ent ..0366 000614' spd ..0713 001517' spd ..1310 002507' spd $XHOST 002013' ent ..0401 000662' spd ..0721 001534' spd ..1313 002542' spd $XPWD 002072' ent ..0402 000665' spd ..0722 001536' spd ..1327 002541' spd $XSTAT 002167' ..0403 000666' spd ..0735 001601' spd ..1350 002603' spd $XTYPE 002464' ent ..0406 000712' spd ..0736 001604' spd ..1351 002627' spd $YCWD 000507' ent ..0414 000733' spd ..0737 001627' spd ..1356 002623' spd $YCWDX 000557' ..0426 000772' spd ..0744 001632' spd ..1357 002627' spd $YCWDY 000564' ..0427 000773' spd ..0751 001636' spd ..1375 002756' spd $YCWDZ 000574' ..0435 000773' spd ..0752 001640' spd ..1405 003075' spd $YDELE 001040' ent ..0436 000777' spd ..0757 001645' spd ..1412 003077' spd $YDIR1 001334' ..0437 001017' spd ..0761 001671' spd ..1416 003136' spd $YDIRE 001272' ent ..0452 001010' spd ..0770 001671' spd ..1423 003140' spd $YDISK 002101' ent ..0453 001014' spd ..0777 001720' spd ..1434 003222' spd $YPWD 002051' ent ..0462 001037' spd ..1000 001726' spd ..1443 003222' spd $YRUN 004210' ent ..0470 001055' spd ..1006 001735' spd ..1452 003221' spd $YRUN2 004303' ..0471 001111' spd ..1007 001741' spd ..1457 003274' spd $YSRVT 002156' ent ..0472 001053' spd ..1014 002001' spd ..1460 003303' spd $YTYPE 002326' ent ..0504 001065' spd ..1023 002001' spd ..1473 003343' spd $YTYPY 002455' ..0505 001070' spd ..1030 002024' spd ..1474 003345' spd $YTYPZ 002460' ..0506 001074' spd ..1036 002024' spd ..1532 003476' spd %%JSER 005436' ext ..0513 001144' spd ..1054 002026' spd ..1533 003501' spd %%KRMS 004071' ext ..0522 001144' spd ..1055 002032' spd ..1561 003634' spd %%SMSG 003510' ext ..0535 001215' spd ..1100 002122' spd ..1570 003634' spd %KERMS 004055' ext ..0536 001216' spd ..1101 002127' spd ..1573 003655' spd %WTLOG 004105' ext ..0543 001175' spd ..1116 002201' spd ..1602 003655' spd ..0103 000014' spd ..0544 001200' spd ..1125 002201' spd ..1605 003735' spd ..0104 000040' spd ..0545 001214' spd ..1136 002251' spd ..1622 003754' spd ..0105 000034' spd ..0552 001210' spd ..1137 002252' spd ..1623 003772' spd ..0126 000070' spd ..0553 001213' spd ..1144 002231' spd ..1633 004011' spd ..0134 000103' spd ..0554 001214' spd ..1145 002234' spd ..1642 004011' spd ..0135 000136' spd ..0561 001225' spd ..1146 002250' spd ..1655 004113' spd ..0142 000114' spd ..0562 001267' spd ..1153 002244' spd ..1664 004113' spd ..0143 000133' spd ..0567 001232' spd ..1154 002247' spd ..1676 004147' spd ..0152 000124' spd ..0570 001233' spd ..1155 002250' spd ..1704 004165' spd ..0153 000126' spd ..0600 001252' spd ..1162 002261' spd ..1730 004272' spd ..0154 000130' spd ..0601 001254' spd ..1163 002323' spd ..1731 004303' spd ..0161 000145' spd ..0607 001261' spd ..1170 002266' spd ..1771 004434' spd ..0167 000155' spd ..0617 001300' spd ..1171 002267' spd ..2001 004475' spd ..0204 000227' spd ..0620 001334' spd ..1201 002306' spd ..2007 004517' spd k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page S-5 K20SRV MAC 9-Jun-23 23:24 SYMBOL TABLE FOR PSECT CODE ..2015 004545' spd .XSTAT 002163' ent ..2024 004566' spd .XSTKS 005130' ext ..2025 004572' spd .YCWD 000052' ent ..2027 004654' spd .YDELE 001021' ent ..2034 004631' spd .YDIRE 001147' ent ..2035 004634' spd .YDISK 002075' ent ..2042 004650' spd .YPWD 002045' ent ..2043 004653' spd .YRUN 004130' ent ..2050 004662' spd .YTYPE 002204' ent ..2061 004673' spd ..2067 004677' spd ..2070 004703' spd ..2071 004704' spd ..2072 004717' spd ..2104 004726' spd ..2112 004747' spd ..2113 004753' spd ..2120 004764' spd ..2121 004774' spd ..2126 004770' spd ..2127 004773' spd ..2131 005005' spd ..2137 005013' spd ..2145 005021' spd ..2162 005053' spd ..2163 005113' spd ..2173 005110' spd ..2174 005126' spd ..2214 005170' spd ..2215 005174' spd ..2216 005175' spd ..2223 005204' spd ..2225 005220' spd ..2232 005224' spd ..2233 005217' spd ..2245 005242' spd ..2246 005256' spd ..2252 005364' 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 001751' ent .RMFIL 001114' .STAT 002152' ent .XCWD 000670' ent .XCWD1 000743' .XDISK 002143' ent .XERR 001674' .XHELP 001763' ent .XHOST 002006' .XPWD 002066' ent k20srv - Kermit-20 High Level Server and Associated Local Commands MACRO %53B(1254)-4 15:19 11-Jun-23 Page S-6 K20SRV MAC 9-Jun-23 23:24 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 15:19 11-Jun-23 Page S-7 K20SRV MAC 9-Jun-23 23:24 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 15:19 11-Jun-23 Page S-8 K20SRV MAC 9-Jun-23 23:24 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 15:19 11-Jun-23 Page 1 K20SUB MAC 9-Jun-23 22:13 Preliminaries 39014 title k20sub - Kermit-20 Semantic Action and Support Subroutines 39015 remark Moved to seperate module as part of 194 to address MCRNEC 39016 39017 subttl Preliminaries 39018 39019 search monsym,macsym,k20unv 39020 cmdacs ^ ;Clean up p1-p4 definitions 39021 .xcmsy ^ ;Ditch MACSYM nonsense 39022 39023 sall ; Tidy listing 39024 .directive flblst ; We don't need to see all the ASCIZ bytes... 39025 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 2 K20SUB MAC 9-Jun-23 22:13 common parsing external data 39026 subttl common parsing external data 39027 39028 extern pars1 ; Data from first parse. 39029 extern pars2 ; Data from second parse. 39030 extern pars3 ; Data from third parse. 39031 extern pars4 ; Data from fourth parse. 39032 extern pars5 ;[41] ... 39033 39034 remark cmd storage 39035 39036 extern cjfnbk ; Actually in CMD.MAC 39037 extern atmbuf ; Atom buffer, in CMD.MAC 39038 extern sbk ; State Block 39039 39040 remark file related storage 39041 39042 extern filjfn ; Current file 39043 extern nxtjfn ; Next file in sequence 39044 extern ndxjfn ; Stepping JFN (with flags) 39045 extern strbuf ; String buffer (to build things in, Etc.) 39046 39047 remark Terminal and other JFN's 39048 39049 extern ttyjfn ; JFN on local terminal 39050 extern $PRIOU ;[220] Whatever we think primary output should be 39051 extern udjinf ;[220] Updates jobtab for use by this routine 39052 extern tlgjfn ; Transaction log JFN 39053 39054 remark other stuff 39055 39056 extern czseen ; ^Z seen (typed) 39057 extern crlf ; Carriage Return, Linefeed string 39058 extern nul4 ; Pointer to NUL: string and length 39059 extern scrlft ;[233] ; Set to -1 to suppress trailing CRLF in transaction log 39060 extern jobtab ; My job information 39061 39062 extern errptr ; Error message pointer 39063 extern pktnum ;[234] ; Packet number 39064 extern spack ;[234] ; Send a packet 39065 extern spsiz ;[234] ; Sending packet size 39066 extern subbp ;[234] ; 'Subtract' two byte pointers 39067 extern %%krbf ;[234] ; Buffer to construct an error pack 39068 39069 .psect code/ronly ;[190] Don't allow stores 39070 39071 ; To do: Needs a double float (dfltr) 39072 ; 39073 ; Could do the fltr, then extract the exponent and use it to do 39074 ; an ashc on the double word. 39075 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 3 K20SUB MAC 9-Jun-23 22:13 Support routines for error handling macros. 39076 subttl Support routines for error handling macros. 39077 39078 ;[234] Moved here from K20MIT.MAC 39079 39080 ; KERMSG -- Send an error message to the KERMIT on the other side in an 39081 ; error packet. Invoked from %JSKER, with T1 pointing at the user-provided 39082 ; prefix (if any), to which the JSYS error message is appended. 39083 ; 39084 ; As part of [194], rewritten to offload most the macro expansion and 39085 ; do more of the work here. Saves some memory by not always duplicating 39086 ; the KERMIT-20: prefix 39087 ; 39088 ; Called 39089 ; 39090 ; jsp t1,%%krms 39091 ; 39092 ; t1 offsets: 39093 ; 39094 ; +0: Address of ASCII text or zero 39095 ; +1: Jump address or zero 39096 ; +2: Return address (implied) 39097 39098 000000'01 blanks: xlist ; We don't need to see all the .chspc's... 39099 list 39100 000030 blankl==<.-blanks> ; Length of blank array 39101 39102 000030'01 000000 000000' krxblt: blanks ; Source block of memory 39103 000031'01 000000000000# %%krbf ; Destination block 39104 000032'01 44 07 0 00 000000* krxptr: point 7, %%krbf ; Pointer to (scrubbed) buffer 39105 39106 000033'01 44 07 0 00 000254' k20ptr: point 7, k20hdr ; Point to header text 39107 000034'01 000000 000013 ^d11 ; Length of header 39108 39109 000035'01 %%krms: entry %%krms ;[213] Declare for the world 39110 000035'01 415 16 0 00 000130' block. ; Enter block context for a stack frame 39111 000036'01 261 17 0 00 000016 39112 000037'01 265 16 0 00 003737' saveac ;Get some registers to enjoy ourselves with 39113 000040'01 200 05 0 00 000001 move q1, t1 ; Save argument/return pointer 39114 39115 000041'01 201 01 0 00 000030 movei t1, blankl ; Set up XBLT block 39116 000042'01 120 02 0 00 000030' dmove t2, krxblt 39117 000043'01 123 01 0 00 003753' xblt. t1 ; Scrub the buffer with blanks 39118 39119 000044'01 200 01 0 00 000032' move t1, krxptr ; Load pointer to scrubbed buffer 39120 000045'01 120 03 0 00 000033' dmove t3,k20ptr ; Load pointer to header text 39121 remark t4,count ; Length of same 39122 000046'01 200 06 0 00 000004 move q2, t4 ; Begin length of message 39123 39124 000047'01 do. ; Enter loop lexical context 39125 000047'01 134 02 0 00 000003 ildb t2, t3 ; Pick up a byte 39126 000050'01 136 02 0 00 000001 idpb t2, t1 ; Deposit it 39127 000051'01 367 04 0 00 000047' sojg t4, top. ; Do all of them 39128 000052'01 enddo. ; Fall out of loop lexical context 39129 39130 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 15:19 11-Jun-23 Page 3-1 K20SUB MAC 9-Jun-23 22:13 Support routines for error handling macros. 39131 000053'01 254 00 0 00 000065' ifskp. ; Got passed something 39132 000054'01 do. ; and copy the characters over 39133 000054'01 134 02 0 00 000003 ildb t2, t3 ; Get the byte. 39134 000055'01 322 02 0 00 000060' jumpe t2, endlp. ; Exit if a null 39135 000056'01 136 02 0 00 000001 idpb t2, t1 ; Deposit the byte. 39136 000057'01 344 06 0 00 000054' aoja q2, top. ; Loop and increment tally 39137 000060'01 enddo. ; Never falls out; explicit exit 39138 ; Tack on " - " 39139 000060'01 120 02 0 00 003754' dmove t2, [exp .chspc, .chdas] 39140 000061'01 136 02 0 00 000001 idpb t2, t1 ; Append the space 39141 000062'01 136 03 0 00 000001 idpb t3, t1 ; Append the dash 39142 000063'01 136 02 0 00 000001 idpb t2, t1 ; Append the space after that 39143 000064'01 271 06 0 00 000003 addi q2, ^d3 ; Account for three more characters 39144 000065'01 endif. 39145 39146 remark t1, ; Put the Tops-20 error string into the buffer. 39147 000065'01 525 02 0 00 400000 hrloi t2, .fhslf ; Say: this fork ,, last error. 39148 000066'01 210 03 0 00 000000* movn t3, spsiz ; Specify the maximum to send as a negative 39149 000067'01 270 03 0 00 000006 add t3, q2 ; number (don't overflow the buffer) 39150 000070'01 517 00 0 00 000003 hrlzs t3 ;[74] (ERSTR wants -n,,0) 39151 000071'01 325 03 0 00 000102' ifl. t3 ;[50] (don't bother if not negative). 39152 000072'01 104 00 0 00 000011 ERSTR% 39153 000073'01 320 14 0 00 000075' erjmps .+2 ; Ignore its strange return 39154 000074'01 320 14 0 00 000075' erjmps .+1 ; Ignore its stranger return 39155 000075'01 200 02 0 00 000001 move t2, t1 ; Set up to get the new length. 39156 000076'01 200 01 0 00 000032' move t1, krxptr ; Load pointer to partially filled buffer 39157 000077'01 260 17 0 00 000000* call subbp ; Subtract byte pointers. 39158 000100'01 254 00 0 00 000102' anskp. ;[40] If there is an error assume this count. 39159 remark ; Worked, so don't hit the else. 39160 000101'01 254 00 0 00 000103' else. ; Otherwise... 39161 000102'01 200 03 0 00 000006 move t3, q2 ; Don't trust ERSTR% 39162 000103'01 endif. ; End case fence post checking 39163 39164 000103'01 313 03 0 00 000066* camle t3, spsiz ;[40] Longer than we're supposed to send? 39165 000104'01 200 03 0 00 000103* move t3, spsiz ;[40] If so, truncate it. 39166 000105'01 200 06 0 00 000003 move q2, t3 ; Save whatever the length is 39167 000106'01 201 01 0 00 000105 movei t1, "E" ; An error packet. 39168 000107'01 200 02 0 00 000000* move t2, pktnum ; Packet number. 39169 000110'01 200 04 0 00 000032' move t4, krxptr ; Load pointer to finished buffer 39170 000111'01 260 17 0 00 000000* call spack ; Send the error packet. 39171 000112'01 600 00 0 00 000000 nop 39172 39173 000113'01 332 00 0 00 000000* ifme. srvflg ;[234] ; If a server, NOT safe to type 39174 000114'01 254 00 0 00 000126' 39175 000115'01 200 01 0 00 000032' move t1, krxptr ; Load pointer to finished buffer 39176 000116'01 200 02 0 00 000006 move t2, q2 ; Load final character count 39177 000117'01 133 02 0 00 000001 adjbp t2, t1 ; Go to end of character string 39178 000120'01 120 03 0 00 003756' dmove t3, [ exp .chcrt, .chlfd ] 39179 000121'01 136 03 0 00 000002 idpb t3, t2 ; Drop in a CR-LF 39180 000122'01 136 04 0 00 000002 idpb t4, t2 39181 000123'01 400 03 0 00 000000 setz t3, ; Cons up a NUL 39182 000124'01 136 03 0 00 000002 idpb t3, t2 ; Tie off the string 39183 000125'01 104 00 0 00 000313 ESOUT% ; Finally whine about our problems 39184 000126'01 endif. ;[234] ; End case local output 39185 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 15:19 11-Jun-23 Page 3-2 K20SUB MAC 9-Jun-23 22:13 Support routines for error handling macros. 39186 000127'01 263 17 0 00 000000 endbk. ; Restore registers, tear down the stack 39187 39188 000130'01 326 01 0 01 000000 jumpn t1, (t1) ; Go somewhere, if told to 39189 000131'01 104 00 0 00 000170 HALTF% ; Cease execution 39190 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 15:19 11-Jun-23 Page 4 K20SUB MAC 9-Jun-23 22:13 Support routines for error handling macros. 39191 39192 ; Support for kermsg. Written for maximum reduction of kermsg() macro 39193 ; 39194 ; All part of [194] 39195 39196 000133'01 %kerms: entry %kerms ; Globally available 39197 000133'01 261 17 0 00 000012 push p, p2 ; Save p2 (not aliased) 39198 000134'01 200 12 0 00 000001 move p2, t1 ; Save return and argument address 39199 000135'01 201 01 0 00 000105 movei t1, "E" ; Send an error packet to the other side. 39200 000136'01 200 02 0 00 000107* move t2, pktnum ; Packet number. 39201 000137'01 120 03 0 12 000000 dmove t3, (p2) ; Pick up count and text address 39202 000140'01 202 04 0 00 000000* movem t4, errptr ; Save pointer to error msg for status. 39203 000141'01 260 17 0 00 000111* call spack ; Send the error packet. 39204 000142'01 600 00 0 00 000000 nop 39205 000143'01 336 00 0 00 000113* ifmn. srvflg ;[234] ; If local, safe to type 39206 000144'01 254 00 0 00 000153' 39207 000145'01 561 01 0 00 000254' hrroi t1, k20hdr ; Load start of message 39208 000146'01 104 00 0 00 000313 ESOUT% ;[187] ; Begin whining 39209 000147'01 200 01 0 12 000001 move t1, 1(p2);[202] ; Same message 39210 000150'01 104 00 0 00 000076 PSOUT% ; Type that, too 39211 000151'01 561 01 0 00 000000* hrroi t1, crlf ; Tie off the line 39212 000152'01 104 00 0 00 000076 PSOUT% 39213 000153'01 endif. ;[234] ; End case local output 39214 000153'01 200 01 0 00 000012 move t1, p2 ; Restore calling t1 39215 000154'01 262 17 0 00 000012 pop p, p2 ; Restore p2 39216 000155'01 271 01 0 00 000002 addi t1,^d2 ; Skip past both arguments 39217 000156'01 254 00 0 01 000000 jrst (t1) ; Finally done 39218 39219 ;[234] End move from K20MIT.MAC 39220 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 5 K20SUB MAC 9-Jun-23 22:13 Macro support routines 39221 subttl Macro support routines 39222 39223 ; JSERR0 synchronizes with terminal i/o in progress before typing the 39224 ; JSYS error message. 39225 ; 39226 ; JSMSG0 just types the JSYS error message. 39227 ; 39228 ; These names where changed in order to not conflict with routines of the 39229 ; same name in MACSYM (MACREL). Also removed CFIBF% and DOBE% as part of 39230 ; edit 187 as ESOUT% does this. 39231 ; 39232 ; No macro should EVER invoke these directly 39233 39234 000157'01 561 01 0 00 003760' kserr0: tmsg < - > ; Type a dash. 39235 000160'01 104 00 0 00 000076 39236 39237 000161'01 ksmsg0: remark ; Alternate entry 39238 000161'01 201 01 0 00 000101 movei t1,.priou 39239 000162'01 525 02 0 00 400000 hrloi t2,.fhslf ; This fork ,, last error. 39240 000163'01 400 03 0 00 000000 setz t3, 39241 000164'01 104 00 0 00 000011 ERSTR% 39242 000165'01 320 12 0 00 000167' erjmpr .+2 39243 000166'01 320 12 0 00 000167' erjmpr .+1 39244 000167'01 263 17 0 00 000000 ret 39245 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 6 K20SUB MAC 9-Jun-23 22:13 Support for wtlog 39246 subttl Support for wtlog 39247 39248 ;[194] Begin Code Insertion 39249 39250 ; Rewritten for maximum reduction of expansion wtlog() macro 39251 39252 000170'01 %wtlog: entry %wtlog ; Globally available 39253 000170'01 260 17 0 00 000173' call %wtlgf ; Set up a logging frame 39254 000171'01 271 01 0 00 000003 addi t1, ^d3 ; Skip past the three arguments 39255 000172'01 254 00 0 01 000000 jrst (t1) ; Finally done 39256 ;[233] Needs plenty registers for intersection transfers 39257 000173'01 265 16 0 00 003761' %wtlgf: saveac ;[233] 39258 000174'01 621 01 0 00 777700 txz t1, klflgs ; Don't mess up addressing 39259 000175'01 200 05 0 00 000001 move q1, t1 ;[233] Save arguments accumulator 39260 000176'01 337 01 0 00 000000* skipg t1, tlgjfn ; Is the transaction log open? 39261 000177'01 263 17 0 00 000000 ret ; Nope, so nothing to do 39262 39263 ;;;; 39264 ;;;; cain t1, .nulio ;[193] Not really going to do anything? 39265 ;;;; ret ;[193] Fine, then don't really do anything 39266 39267 000200'01 474 02 0 00 000000 seto t2, ; Start with time stamp, current date/time. 39268 000201'01 205 03 0 00 400000 movx t3, ot%nda ; No date in stream 39269 000202'01 104 00 0 00 000220 ODTIM% 39270 000203'01 320 14 0 00 000204' erjmps .+1 ; Catch and suppress errors 39271 000204'01 201 02 0 00 000072 movei t2, ":" 39272 000205'01 104 00 0 00 000051 BOUT% 39273 000206'01 320 14 0 00 000207' erjmps .+1 39274 000207'01 201 02 0 00 000040 movei t2, .chspc 39275 000210'01 104 00 0 00 000051 BOUT% 39276 000211'01 320 14 0 00 000212' erjmps .+1 39277 39278 000212'01 120 02 0 05 000000 dmove t2, 0(t5) ; Load string pointer and length 39279 000213'01 322 02 0 00 000225' ifn. t2 ;[216] Load string and (negative) count 39280 000214'01 301 03 0 00 000000 cail t3,0 ;[216] Better be a negative number 39281 000215'01 254 00 0 00 000225' anskp. ;[216] But wasn't 39282 000216'01 254 14 0 00 000007 xsfm q3 ;[233] Get and store current processor flags 39283 000217'01 200 10 0 00 000000# move q4, bigsou ;[233] Load up inter-section transfer address 39284 000220'01 201 11 0 00 000222' movei q5, .+2 ;[233] And the inter-section return adress 39285 000221'01 254 05 0 00 000007 xjrstf q3 ;[233] and take a giant step! 39286 000222'01 201 02 0 00 000040 movei t2, .chspc 39287 000223'01 104 00 0 00 000051 BOUT% 39288 000224'01 320 14 0 00 000225' erjmps .+1 39289 000225'01 endif. 39290 39291 000225'01 337 03 0 05 000002 skipg t3, 2(t5) ;[216] Load a JFN, maybe 39292 000226'01 254 00 0 00 000245' ifskp. ; Some kind of an address 39293 000227'01 337 02 0 03 000000 skipg t2, (t3) ; Pick up the actual JFN 39294 000230'01 254 00 0 00 000245' anskp. ; Unless not holding one 39295 000231'01 302 02 0 00 377777 caie t2, .nulio ; Dumping it? 39296 000232'01 254 00 0 00 000237' ifskp. ; That's easy! 39297 000233'01 120 02 0 00 000000* dmove t2, nul4 ; Constant string and length 39298 000234'01 104 00 0 00 000053 SOUT% 39299 000235'01 320 14 0 00 000236' erjmps .+1 39300 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 15:19 11-Jun-23 Page 6-1 K20SUB MAC 9-Jun-23 22:13 Support for wtlog 39301 000237'01 120 03 0 00 004001' dmove t3, [exp <111110,,js%paf>, 0] 39302 000240'01 104 00 0 00 000030 JFNS% 39303 000241'01 320 14 0 00 000242' erjmps .+1 ; Catch and suppress error 39304 000242'01 endif. ; End NUL: special case 39305 000242'01 201 02 0 00 000040 movei t2, .chspc ;[233] 39306 000243'01 104 00 0 00 000051 BOUT% ;[233] 39307 000244'01 320 14 0 00 000245' erjmps .+1 ;[233] 39308 000245'01 endif. ; End case JFN handling 39309 39310 000245'01 356 00 0 00 000000* aosn scrlft ;[233] ; Wants to suppress trailing CRLF in transaction log? 39311 000246'01 263 17 0 00 000000 ret ;[233] ; Yes, so we're done 39312 39313 000247'01 561 02 0 00 000151* hrroi t2, crlf 39314 000250'01 120 03 0 00 004003' dmove t3,[ exp -2, 0] 39315 000251'01 104 00 0 00 000053 SOUT% 39316 000252'01 320 14 0 00 000253' erjmps .+1 39317 000253'01 263 17 0 00 000000 ret 39318 39319 ;[194] End Code Insertion 39320 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 7 K20SUB MAC 9-Jun-23 22:13 Support for %jserr. 39321 subttl Support for %jserr. 39322 39323 ;[194] Begin Code Insertion 39324 39325 ; Rewritten for maximum reduction of %jserr() macro 39326 ; 39327 ; N.B., If not given a label, the previous version of the macro would 39328 ; do a HALTF% allowing a continue. However, no code existed any 39329 ; longer which leveraged this functionality. It has been 39330 ; removed an replaced with returning +1 if no label is given as 39331 ; passing a +1 to the current macro will do the wrong thing 39332 39333 000254'01 k20hdr: intern k20hdr ; Used by other error routines in k20mit 39334 000254'01 113 105 122 115 111 asciz |KERMIT-20: | ; Start of any error message 39335 39336 000257'01 %%jser: entry %%jser ; Used in other parts of Kermit Planet 39337 000257'01 415 16 0 00 000310' block. ; Enter block context (build stack frame) 39338 000260'01 261 17 0 00 000016 39339 000261'01 265 16 0 00 004005' saveac ; Save a bunch of accumulators 39340 000262'01 621 01 0 00 777700 txz t1, klflgs ; Don't mess up addressing 39341 000263'01 200 12 0 00 000001 move p2,t1 ; Save return accumulator 39342 000264'01 561 01 0 00 000254' hrroi t1, k20hdr ; Load pointer to first part of error 39343 000265'01 104 00 0 00 000313 ESOUT% ;[187] Begin whining, compliantly 39344 000266'01 320 12 0 00 000267' erjmpr .+1 ; Catch and ignore error 39345 000267'01 336 01 0 12 000000 skipn t1, 0(p2) ; Pick up the text pointer 39346 000270'01 254 00 0 00 000275' ifskp. ; That is, if there is one 39347 000271'01 104 00 0 00 000076 PSOUT% ; Give us that bit of news... 39348 000272'01 320 12 0 00 000273' erjmpr .+1 ; Catch and ignore error 39349 000273'01 260 17 0 00 000157' call kserr0 ; Put JSYS error after dash, 39350 000274'01 254 00 0 00 000276' else. ; Otherwise, no need for the dash 39351 000275'01 260 17 0 00 000161' call ksmsg0 ; so right after "?KERMIT-20: " 39352 000276'01 endif. ; End case, auxiliary message 39353 000276'01 561 01 0 00 004021' tmsg < at: > ; Say where it happened. 39354 000277'01 104 00 0 00 000076 39355 000300'01 201 01 0 12 777775 movei t1, -3(p2) ; Calculate address of failing JSYS 39356 000301'01 621 01 0 00 777700 txz t1, klflgs ; Flags aren't part of the address 39357 000302'01 260 17 0 00 003677' call symout ; Type it symbolically 39358 000303'01 561 01 0 00 000247* hrroi t1,crlf ; And a trailing CR-LF. 39359 000304'01 104 00 0 00 000076 PSOUT% 39360 000305'01 320 12 0 00 000306' erjmpr .+1 ; Catch and ignore error 39361 000306'01 200 01 0 12 000001 move t1, 1(p2) ; Load a jump (or return) address 39362 000307'01 263 17 0 00 000000 endbk. ; Exit block context 39363 ; Tears down the stack frame 39364 000310'01 254 00 0 01 000000 jrst (t1) ; Go someplace and do something 39365 39366 .endps code ; Get out of section zero 39367 39368 ;[194] End Code Insertion 39369 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 8 K20SUB MAC 9-Jun-23 22:13 %%smsg documentation and extended section code 39370 subttl %%smsg documentation and extended section code 39371 39372 ;[216] Begin code insertion 39373 ; 39374 ; SOUT% has a bug in certain cases when being passed OWGP's. Like other 39375 ; JSYi, OWGP's work fine for I/O. However, if you use SOUT% to move a 39376 ; string, then SOUT% will occasionally do the wrong thing. Fix by 39377 ; checking here if we have a JFN and, if so, doing the I/O. Otherwise 39378 ; we use MOVSLJ (which is faster than using SOUT% to move data, 39379 ; anyway) 39380 ; 39381 ; Read that last sentence again: incredibly, ALL of the hair with an 39382 ; inter-section call to do the MOVSLJ is FAR faster than the SOUT%! 39383 ; Read it again, it's whaaay faster. 39384 ; 39385 ; Of course, MOVSLJ has its own quirks... You would think that you 39386 ; could use a OWGP that references section zero while executing in any 39387 ; section (such as section zero). I mean it works for IPB, ADJBP, 39388 ; ILDB and IDPB, so what's the problem? MOVSLJ will *NOT* honor a 39389 ; section zero OWGP when executed in section zero! The non-section 39390 ; OWGP increments just fine and both counts decrement, but the section 39391 ; zero pointer is untouched... 39392 ; 39393 ; So we stick with local section zero pointers as the destination, 39394 ; always, hand cast to double pointers and then do an inter-section 39395 ; transfer so that the MOVSLJ will execute in a non-zero section. 39396 ; This is necessary because double word pointers are not honored by 39397 ; ANY code executing in section zero. 39398 ; 39399 ; Actually, SOUT% only works with non-section OWGP's when the output is 39400 ; the terminal. Output to the disk is garbled, but not consistently. 39401 ; So it has to do an inter-section call, too. Bug appears to be BYTBLT 39402 ; in the monitor that is not considering OWGP's from section zero. 39403 ; 39404 ; And, of course, BOUT% doesn't honor *ANY* kind of a OWGP in section 39405 ; zero. EVER... 39406 ; 39407 ; Entry: 39408 ; 39409 ; t1/ String pointer or I/O designator 39410 ; Any string pointer in t1 is expected to be a 39411 ; LOCAL string pointer in section zero space. 39412 ; t2/ ASCII OWGP to Extended Text .PSECT, always 39413 ; t3/ Negative length of string for faster SOUT%'s 39414 ; (If used) 39415 ; 39416 ; Returns: 39417 ; 39418 ; +1 always 39419 ; 39420 ; t1/ Updated, if local pointer 39421 ; t2/ Updated 39422 ; t3/ 0 39423 ; 39424 ; Strings are NUL terminated and ready for append k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 8-1 K20SUB MAC 9-Jun-23 22:13 %%smsg documentation and extended section code 39425 39426 .psect ecode/ronly,ecdorg ;movslj MUST be executed in a non-zero section!!! 39427 000000'02 016 00 0 00 000000 movmsg: movslj 0,0 ; Extended opcode 39428 000001'02 000000 000000 .chnul ; Fill character (never used) 39429 39430 000002'02 123 01 0 00 000000' extmov: extend t1, movmsg ; Copy the data 39431 000003'02 600 00 0 00 000000 nop ; Ignore non-skip (should never happen) 39432 000004'02 200 10 0 00 000011 move q4, q5 ; Load return address 39433 000005'02 254 05 0 00 000007 xjrstf q3 ; Return back downstairs, restore flags 39434 39435 000006'02 104 00 0 00 000053 extsou: SOUT% ; SOUT% from section 1 39436 000007'02 320 14 0 00 000010' erjmps .+1 ; Catch and suppress error 39437 000010'02 200 10 0 00 000011 move q4, q5 ; Load return address 39438 000011'02 254 05 0 00 000007 xjrstf q3 ; Return back downstairs, restoring flags 39439 .endps ecode ; Out of extended code 39440 39441 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 9 K20SUB MAC 9-Jun-23 22:13 %%smsg documentation and extended section code 39442 subttl %%smsg documentation and extended section code 39443 39444 ; See above; arguments are expected to be suitable for a counted SOUT% 39445 39446 .psect const ; Constant pointers go in const 39447 000000'03 000001 000000# giant: extsec,,extmov ; 30 bit address of movslj 39448 000001'03 bigsou: entry bigsou ;[233] Allows k20mit to use 39449 000001'03 000001 000000# extsec,,extsou ; 30 bit address of SOUT% 39450 .endps const ; Close off constants 39451 39452 .psect code ; Back in section zero code 39453 39454 000311'01 %%smsg: entry %%smsg ; World callable 39455 39456 remark ; A minor efficiency hack 39457 000311'01 312 03 0 00 004023' came t3, [-1] ; Is this one dinky byte? 39458 000312'01 254 00 0 00 000321' ifskp. ; Then don't need all the baloney below 39459 000313'01 200 03 0 00 000002 move t3, t2 ; Get a copy of the source pointer 39460 000314'01 134 02 0 00 000003 ildb t2, t3 ; Load that single byte for BOUT% 39461 000315'01 260 17 0 00 000357' call BOUTI% ; Go put it somewhere 39462 000316'01 200 02 0 00 000003 move t2, t3 ; Restore updated source pointer 39463 000317'01 400 03 0 00 000000 setz t3, ; Stomp so looks like a return from SOUT% 39464 000320'01 263 17 0 00 000000 ret ; We're done 39465 000321'01 endif. 39466 39467 remark ; Otherwise, a multi-byte call 39468 000321'01 603 01 0 00 777777 tlne t1, -1 ; JFN will never have any flags 39469 000322'01 254 00 0 00 000331' ifskp. ; It's a JFN 39470 000323'01 265 16 0 00 004024' saveac ; Save linkage registers 39471 000324'01 254 14 0 00 000007 xsfm q3 ; Get and store the flags 39472 000325'01 200 10 0 00 000000# move q4, bigsou ; Load up inter-section transfer address 39473 000326'01 201 11 0 00 000330' movei q5, .+2 ; And the inter-section return adress 39474 000327'01 254 05 0 00 000007 xjrstf q3 ; Take a giant step 39475 000330'01 263 17 0 00 000000 ret ; Return, restoring registers 39476 000331'01 endif. ; End I/O case 39477 39478 remark ; See above; all this hair is faster than a SOUT% 39479 000331'01 265 16 0 00 004036' saveac ; Needs oinky registers 39480 000332'01 210 04 0 00 000003 movn t4, t3 ; movslj wants a positive length 39481 remark ; Cast local section zero to global long 39482 000333'01 510 05 0 00 000001 hllz q1, t1 ; Load destination pointer portion 39483 000334'01 661 05 0 00 000040 txo q1, GP%2WB ; Set the double word pointer bit 39484 000335'01 550 06 0 00 000001 hrrz q2, t1 ; Load address portion (section zero!!!) 39485 000336'01 200 01 0 00 000004 move t1, t4 ; Source length is the same 39486 remark t2, 0 ; Load source pointer (already there) 39487 000337'01 400 03 0 00 000000 setz t3, ; Single word source (OWGP) 39488 39489 000340'01 254 14 0 00 000007 xsfm q3 ; Get and store the flags 39490 000341'01 200 10 0 00 000000# move q4, giant ; Load up inter-section transfer address 39491 000342'01 201 11 0 00 000344' movei q5, %%sms1 ; And the inter-section return adress 39492 000343'01 254 05 0 00 000007 xjrstf q3 ; Take a giant step 39493 39494 000344'01 %%sms1: remark ; Our return address 39495 000344'01 260 17 0 00 003514' call d2sgpc ; Convert double source to single 39496 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 15:19 11-Jun-23 Page 9-1 K20SUB MAC 9-Jun-23 22:13 %%smsg documentation and extended section code 39497 000346'01 200 10 0 00 000001 move q4, t1 ; Store source single pointer 39498 remark ; Hand cast destination to section zero local 39499 000347'01 510 01 0 00 000005 hllz t1, q1 ; Pick up source pointer portion 39500 000350'01 621 01 0 00 000040 txz t1, GP%2WB ; Stomp the source double word pointer bit 39501 000351'01 540 01 0 00 000006 hrr t1, q2 ; Put in the section zero address and that's that 39502 000352'01 200 02 0 00 000010 move t2, q4 ; Load single source pointer 39503 39504 000353'01 200 04 0 00 000001 move t4, t1 ; Load a copy of the final destination 39505 000354'01 400 03 0 00 000000 setz t3, ; Return a zero count 39506 000355'01 136 03 0 00 000004 idpb t3, t4 ; Tie off the string, allow append 39507 39508 000356'01 263 17 0 00 000000 ret ; Phew!! Finally done 39509 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 10 K20SUB MAC 9-Jun-23 22:13 BOUT Internal 39510 subttl BOUT Internal 39511 39512 ; Just like BOUT% except doesn't die on a OWGP to a non-zero section. 39513 ; Doing the ildb bums a JSYS, anyway, so that's not the end of the world 39514 ; 39515 ; t1/ Destination designator 39516 ; t2/ Byte to be output, right-justified 39517 39518 000357'01 BOUTI%: entry BOUTI% ; World callible 39519 000357'01 603 01 0 00 777777 tlne t1, -1 ; Writing to a JFN, per chance? 39520 000360'01 254 00 0 00 000364' ifskp. ; Yes, BOUT% is safe 39521 000361'01 104 00 0 00 000051 BOUT% ; So do it 39522 000362'01 320 14 0 00 000000* erjmps r ; Failed?? Catch and suppress error 39523 000363'01 254 00 0 00 000375' else. ; Otherwise, assume some kind of pointer 39524 000364'01 136 02 0 00 000001 idpb t2, t1 ; So just deposit it 39525 000365'01 320 14 0 00 000366' erjmps .+1 ; Failed?? Catch and suppress error 39526 000366'01 261 17 0 00 000001 push p, t1 ; Save the byte pointer 39527 000367'01 261 17 0 00 000002 push p, t2 ; Save the byte 39528 000370'01 400 02 0 00 000000 setz t2, ; Cons up a NUL 39529 000371'01 136 02 0 00 000001 idpb t2, t1 ; Tie off string, allowing append 39530 000372'01 320 12 0 00 000373' erjmpr .+1 ; Failed?? Catch and ignore error (for debugging) 39531 000373'01 262 17 0 00 000002 pop p, t2 ; Restore the byte 39532 000374'01 262 17 0 00 000001 pop p, t1 ; Restore the byte pointer 39533 000375'01 endif. ; End JSYS/ilpb decision 39534 000375'01 263 17 0 00 000000 ret 39535 39536 ;[216] End code insertion 39537 39538 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 11 K20SUB MAC 9-Jun-23 22:13 Is this a JFN on NUL: or its equivalent? 39539 subttl Is this a JFN on NUL: or its equivalent? 39540 39541 ; Determines whether JFN is actually NUL:, and, if so replaces it 39542 ; with .NULIO, a special pseudo-JFN that is both recognized by 39543 ; Tops-20 and used internally as a talisman. 39544 ; 39545 ; Call: 39546 ; 39547 ; t1/ Candidate JFN (or device) 39548 ; 39549 ; Returns, 39550 ; 39551 ; +1/ t1 unmodified 39552 ; +2/ t1 contains .nulio, JFN released 39553 39554 000376'01 isnulj: entry isnulj ; Keep LINK informed of our location 39555 39556 000376'01 312 01 0 00 004052' came t1, [.dvdes!.dvnul,,-1] ; Typed device directly? 39557 000377'01 254 00 0 00 000403' ifskp. ; We did, so just go with that 39558 000400'01 201 01 0 00 377777 movei t1, .nulio ; Stomp into .nulio, no flags 39559 000401'01 254 00 0 00 000000* retskp ; We're done 39560 000402'01 254 00 0 00 000405' else. ; Otherwise, have to figure it out 39561 000403'01 265 16 0 00 003737' saveac ; Don't trash anything except maybe t1 39562 000404'01 200 05 0 00 000001 move q1, t1 ; Save the JFN with any flags 39563 000405'01 endif. ; .nulio might have flags, actually 39564 39565 000405'01 550 02 0 00 000001 hrrz t2, t1 ; Let's just look at the JFN alone 39566 000406'01 322 02 0 00 000522' jumpe t2, notnul ; Ignore any gubbish 39567 000407'01 306 02 0 00 377777 cain t2, .nulio ; Is some joker trying to get cute? 39568 000410'01 254 00 0 00 000517' jrst yesnul ; It's already NUL: ... 39569 ; Try to weed out some wise guys... 39570 000411'01 306 01 0 00 000100 cain t1, .priin ; Primary Input? 39571 000412'01 254 00 0 00 000522' jrst notnul ; It isn't the NUL: device 39572 000413'01 306 01 0 00 000101 cain t1, .priou ; Primary Output? 39573 000414'01 254 00 0 00 000522' jrst notnul ; It isn't the NUL: device 39574 000415'01 306 01 0 00 777777 cain t1, .cttrm ; Controlling terminal? 39575 000416'01 254 00 0 00 000522' jrst notnul ; It isn't the NUL: device 39576 000417'01 306 01 0 00 677777 cain t1, .sigio ; Signal JFN? 39577 000420'01 254 00 0 00 000522' jrst notnul ; It isn't the NUL: device 39578 ; First see if the argument is a device 39579 000421'01 104 00 0 00 000117 DVCHR% ; Get the characteristics of device 39580 000422'01 320 12 0 00 000424' ifje. r ; Broke on JFN with flags 39581 000423'01 254 00 0 00 000427' 39582 000424'01 200 04 0 00 000001 move t4, t1 ; Save for the curious 39583 000425'01 474 06 0 00 000000 seto q2, ; Flag failed (bogus characteristics) 39584 000426'01 254 00 0 00 000430' else. ; Otherwise, it did work 39585 000427'01 200 06 0 00 000002 move q2, t2 ; Save device characteristics word 39586 000430'01 endif. 39587 ; Now see if a file 39588 000430'01 550 01 0 00 000005 hrrz t1, q1 ; Load JFN, sans flags 39589 000431'01 104 00 0 00 000024 GTSTS% ; Get JFN status 39590 000432'01 320 12 0 00 000434' ifje. r ; Failed?? 39591 000433'01 254 00 0 00 000436' 39592 000434'01 474 04 0 00 000000 seto t4, ; Say it sure isn't a JFN 39593 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 15:19 11-Jun-23 Page 11-1 K20SUB MAC 9-Jun-23 22:13 Is this a JFN on NUL: or its equivalent? 39594 000436'01 200 04 0 00 000002 move t4, t2 ; Save the status bits for the moment 39595 000437'01 endif. 39596 39597 000437'01 415 16 0 00 000446' block. ; Enter block context for better control flow 39598 000440'01 261 17 0 00 000016 39599 000441'01 316 04 0 00 004023' camn t4, [-1] ; GTSTS% blow up? 39600 000442'01 254 00 0 00 000401* retskp ; It did, so no JFN 39601 000443'01 607 04 0 00 000200 txnn t4, gs%nam ; Is this bound to anything? 39602 000444'01 254 00 0 00 000442* retskp ; No, so no JFN 39603 000445'01 263 17 0 00 000000 endbk. ; Fall out of block context 39604 000446'01 254 00 0 00 000455' ifskp. ; Skips if no apparent JFN 39605 000447'01 316 06 0 00 004023' camn q2,[-1] ; Did DVCHR% not work, either? 39606 000450'01 254 00 0 00 000522' jrst notnul ; Didn't, so assume not NUL: 39607 000451'01 135 03 0 00 004053' ldb t3, [pointr q2, dv%typ] ; Pick up the device type 39608 000452'01 302 03 0 00 000015 caie t3, .dvnul ; Wants to just lose data? 39609 000453'01 254 00 0 00 000522' jrst notnul ; Not NUL:, so don't touch it 39610 000454'01 254 00 0 00 000517' jrst yesnul ; It is the NUL: device, but not a JFN 39611 000455'01 endif. 39612 ; Looks like a live JFN 39613 000455'01 550 01 0 00 000005 hrrz t1, q1 ; Try looking at it 39614 000456'01 104 00 0 00 000117 DVCHR% ; Get the characteristics of device 39615 000457'01 320 12 0 00 000522' erjmpr notnul ; GTSTS% just told us it was good... 39616 ; Now see if a file 39617 000460'01 135 03 0 00 004054' ldb t3, [pointr t2, dv%typ] ; Pick up the device type 39618 000461'01 316 06 0 00 004023' camn q2, [-1] ; Did the first DVCHR% fail? 39619 000462'01 254 00 0 00 000470' ifskp. ; No, it worked 39620 000463'01 135 01 0 00 004054' ldb t1, [pointr t2, dv%typ] ; Pick up the device type 39621 000464'01 316 01 0 00 000003 camn t1, t3 ; Are these NOT the same? 39622 000465'01 254 00 0 00 000470' anskp. ; They are, proceed 39623 000466'01 200 03 0 00 000001 move t3, t1 ; They aren't, prefer device 39624 000467'01 400 04 0 00 000000 setz t4, ; Say not open nor bound 39625 000470'01 endif. 39626 39627 000470'01 302 03 0 00 000015 caie t3, .dvnul ; Wants to just lose data? 39628 000471'01 254 00 0 00 000522' jrst notnul ; Not NUL:, so don't touch it 39629 ; It is, so replace the JFN 39630 000472'01 325 04 0 00 000512' ifxn. t4, gs%opn ; Is this thing open? 39631 000473'01 550 01 0 00 000005 hrrz t1, q1 ; Reload JFN, sans flags 39632 000474'01 400 02 0 00 000000 setz t2, ; Let's assume this works... 39633 000475'01 104 00 0 00 000022 CLOSF% ; Politely try to close it 39634 000476'01 320 12 0 00 000500' ifje. r ; Catch and ignore JSYS error 39635 000477'01 254 00 0 00 000501' 39636 000500'01 474 02 0 00 000000 seto t2, ; Flag it didn't want to go away 39637 000501'01 endif. ; End case trying a normal close 39638 000501'01 322 02 0 00 000517' jumpe t2, yesnul ; If it worked, then it's time to leave 39639 000502'01 550 01 0 00 000005 hrrz t1, q1 ; Reload JFN, sans flags 39640 000503'01 661 01 0 00 004000 txo t1, cz%abt ; In this case, try to clobber it 39641 000504'01 400 02 0 00 000000 setz t2, ; Let's assume that works... 39642 000505'01 104 00 0 00 000022 CLOSF% ; Try to close it, rudely 39643 000506'01 320 12 0 00 000510' ifje. r ; Catch and ignore JSYS error 39644 000507'01 254 00 0 00 000511' 39645 000510'01 474 02 0 00 000000 seto t2, ; I guess we must have sticky JFN syndrome 39646 000511'01 endif. ; End case trying a normal close 39647 000511'01 322 02 0 00 000517' jumpe t2, yesnul ; If it worked, then it's time to leave 39648 000512'01 endif. ; Otherwise, fall through and try something else k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 11-2 K20SUB MAC 9-Jun-23 22:13 Is this a JFN on NUL: or its equivalent? 39649 ; Here if not open or we are desperate 39650 000512'01 607 04 0 00 000200 ifxn. t4, gs%nam ; Was it ever bound? 39651 000513'01 254 00 0 00 000517' 39652 000514'01 550 01 0 00 000005 hrrz t1, q1 ; Reload JFN, sans flags 39653 000515'01 104 00 0 00 000023 RLJFN% ; Just toss it 39654 000516'01 320 12 0 00 000517' erjmpr .+1 ; Retrieve and ignore the error 39655 remark yesnul ; Falls through 39656 000517'01 endif. 39657 39658 000517'01 yesnul: remark ; Here if NUL; (JFN already released) 39659 000517'01 201 01 0 00 377777 movei t1, .nulio ; Load our talisman 39660 000520'01 500 01 0 00 000005 hll t1, q1 ; Load any flags, although now phoney 39661 000521'01 254 00 0 00 000444* retskp ; Won!! 39662 39663 000522'01 notnul: remark ; Here if not NUL: or some kooky error 39664 000522'01 200 01 0 00 000005 move t1, q1 ; Restore the calling argument 39665 000523'01 263 17 0 00 000000 ret ; Return +1 39666 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 12 K20SUB MAC 9-Jun-23 22:13 Set up Command State Block to parse from JFN in t1. 39667 subttl Set up Command State Block to parse from JFN in t1. 39668 39669 000524'01 setcsb: entry setcsb 39670 000524'01 337 00 0 00 000001 skipg t1 ; Make sure there's a real JFN. 39671 000525'01 201 01 0 00 000100 movei t1, .priin ; If not, revert. 39672 000526'01 506 01 0 00 000000# hrlm t1, sbk+.cmioj ; Put the input JFN into the CSB. 39673 000527'01 201 02 0 00 000101 movei t2, .priou ; Assume JFN is primary input. 39674 000530'01 302 01 0 00 000100 caie t1, .priin ; Is it? 39675 000531'01 201 02 0 00 377777 movx t2, .nulio ; No, it's a file, so nullify COMND output. 39676 000532'01 542 02 0 00 000000# hrrm t2, sbk+.cmioj ; Put output JFN in CSB. 39677 000533'01 263 17 0 00 000000 ret 39678 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 13 K20SUB MAC 9-Jun-23 22:13 Initialize Fork Capability vector 39679 subttl Initialize Fork Capability vector 39680 39681 ; Can't just blanket enable capabilities, an ACJ might get grumpy... 39682 ; 39683 ; Adapted from SETND2 (SETNOD rewrite) 39684 ; 39685 ; Note: checking for SC%GTB is almost certainly unnecessary as it is 39686 ; unheard of for it NOT to be on and we don't even have to enable it 39687 ; as merely having it is enough. That's good because the EXEC does 39688 ; not enable it. 39689 ; 39690 ; However, the code was fun to write and you never know when you're 39691 ; going to get hit with some fascist system manager's idea of security. 39692 ; 39693 ; Trashes t1-t4 39694 39695 000534'01 inicap: entry inicap ; Inform Link of our location 39696 extern mycaps,capas,bigboy ;and of our necessaries 39697 000534'01 403 02 0 00 000003 setzb t2, t3 ; Cons up a null capability vector 39698 000535'01 124 02 0 00 000000* dmovem t2, mycaps ; Assume we have nothing and that we are nobody 39699 000536'01 124 02 0 00 000000* dmovem t2, capas ; special (also intentionally whacks BIGBOY) 39700 000537'01 201 01 0 00 400000 movei t1, .fhslf ; This fork 39701 000540'01 104 00 0 00 000150 RPCAP% ; Get our capabilities 39702 000541'01 320 12 0 00 000362* erjmpr r ; Give up right now; can't do anything more 39703 39704 remark t2, capas ;[187] Let other code handle this 39705 000542'01 200 04 0 00 000003 move t4, t3 ; Save a copy of what's on 39706 remark t2, badmsk ; t2 is ignored by EPCAP% for .fhslf 39707 000543'01 630 03 0 00 004055' andx t3, badmsk ; Shut off some things that get us into trouble 39708 000544'01 602 02 0 00 600000 txne t2, sc%whl!sc%opr ; Could we hurt anybody? 39709 000545'01 476 00 0 00 000000* setom bigboy ; Yep, flag that we are one of the BIG BOYS 39710 ; Turn on a few things 39711 000546'01 602 02 0 00 001000 txne t2, sc%dna ; Do we have DECnet access? 39712 000547'01 660 03 0 00 001000 txo t3, sc%dna ; Yes, turn it on in case ACJ desires it 39713 000550'01 603 02 0 00 200000 txne t2, sc%gtb ; Do we have GETAB%? 39714 000551'01 661 03 0 00 200000 txo t3, sc%gtb ; Yes, flag other code 39715 000552'01 603 02 0 00 400000 txne t2, sc%ctc ; Do we have ^C? 39716 000553'01 661 03 0 00 400000 txo t3, sc%ctc ; Yes, flag other code 39717 000554'01 124 02 0 00 000535* dmovem t2, mycaps ; Store current capability vector 39718 000555'01 316 03 0 00 000004 camn t3, t4 ; Anything to change, actually? 39719 000556'01 263 17 0 00 000000 ret ; Nope, bum a few JSYi 39720 39721 000557'01 104 00 0 00 000151 EPCAP% ; Diddle the capabiliy vector 39722 000560'01 320 12 0 00 000562' ifje. r ; Failed?? 39723 000561'01 254 00 0 00 000564' 39724 000562'01 200 04 0 00 000001 move t4, t1 ; Save error code for debuggers, otherwise ignore 39725 000563'01 201 01 0 00 400000 movei t1, .fhslf ; Reload fork handle 39726 000564'01 endif. ; End case error handling 39727 ; See if fascist ACJ changed anything 39728 000564'01 104 00 0 00 000150 RPCAP% ; Get the resulting capability vector 39729 000565'01 320 12 0 00 000541* erjmpr r ; Sigh... 39730 000566'01 202 03 0 00 000000# movem t3, mycaps+1 ; Update final capability vector 39731 000567'01 263 17 0 00 000000 ret ; Finally done 39732 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 14 K20SUB MAC 9-Jun-23 22:13 Determine what kind of argument we have 39733 subttl Determine what kind of argument we have 39734 39735 ; Call: 39736 ; 39737 ; t1/ The handle we're trying to puzzle out 39738 ; 39739 ; Return: 39740 ; 39741 ; +1, Couldn't fathom it 39742 ; +2, Figured it out 39743 ; 39744 ; t1/ Appropriate flag set 39745 39746 000570'01 302 01 0 00 777777 argtyp: caie t1, .cttrm ; Called with controlling terminal? 39747 000571'01 254 00 0 00 000574' ifskp. ; That's easy enough 39748 000572'01 205 01 0 00 200000 movx t1, ts%ctm ; Set the controlling terminal flag 39749 000573'01 254 00 0 00 000521* retskp ; Success 39750 000574'01 endif. 39751 39752 000574'01 302 01 0 00 000101 caie t1, .priou ; Called with primary output? 39753 000575'01 254 00 0 00 000600' ifskp. ; That's easy enough 39754 000576'01 205 01 0 00 100000 movx t1, ts%pro ; Set the primary output flag 39755 000577'01 254 00 0 00 000573* retskp ; Success 39756 000600'01 endif. 39757 39758 000600'01 265 16 0 00 004056' saveac ; For calling argument and stack variable 39759 000601'01 200 05 0 00 000001 move q1, t1 ; Save the calling argument 39760 39761 000602'01 620 01 0 00 200000 txz t1, fh%epn ; Shut off extended page number flag 39762 000603'01 302 01 0 00 400000 caie t1, .fhslf ; Called with this fork? 39763 000604'01 254 00 0 00 000607' ifskp. ; That's easy, too 39764 000605'01 205 01 0 00 042000 movx t1, ts%frk!ts%efh ;Set the fork handle flag, explicitly supplied 39765 000606'01 254 00 0 00 000577* retskp ; Success 39766 000607'01 endif. 39767 ; Let's try a little harder 39768 000607'01 265 16 0 00 000000* anstkv (q2, <.rfsfl+1>) ; Allocate stack space for call 39769 000610'01 000000 000005 39770 000611'01 415 06 0 17 777772 39771 000612'01 201 03 0 00 000005 movx t3, <.rfsfl+1> ; Length of RFSTS% block 39772 000613'01 202 03 0 06 000000 movem t3, .rfcnt(q2) ; Store it in block 39773 39774 000614'01 515 01 0 00 400000 hrlzi t1, (rf%lng) ; Using long form 39775 000615'01 540 01 0 00 000005 hrr t1, q1 ; Load original argument (whatever it was) 39776 000616'01 200 02 0 00 000006 move t2, q2 ; Load pointer to block 39777 000617'01 200 03 0 00 000001 move t3, t1 ; Save a copy of JSYS argument 39778 000620'01 104 00 0 00 000156 RFSTS% ; Try to find out status 39779 000621'01 320 12 0 00 000622' erjmpr .+1 ; Side effect t1 with error code 39780 000622'01 312 01 0 00 000003 came t1, t3 ; But!! Did t1 change?? 39781 000623'01 254 00 0 00 000626' ifskp. ; No, so the call succeeded 39782 000624'01 205 01 0 00 042000 movx t1, ts%frk!ts%efh ;Set the fork handle flag, explicitly supplied 39783 000625'01 254 00 0 00 000606* retskp ; Success 39784 000626'01 endif. 39785 39786 000626'01 550 01 0 00 000005 hrrz t1, q1 ; Reload the calling argument 39787 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 15:19 11-Jun-23 Page 14-1 K20SUB MAC 9-Jun-23 22:13 Determine what kind of argument we have 39788 000630'01 320 12 0 00 000632' ifje. r ; If it was a JFN... 39789 000631'01 254 00 0 00 000635' 39790 000632'01 200 03 0 00 000001 move t3, t1 ; Save error for debuggers 39791 000633'01 400 02 0 00 000000 setz t2, ; Clear gs%nam 39792 remark ; Fall out to try device 39793 000634'01 254 00 0 00 000641' else. ; Otherwise, worked 39794 000635'01 607 02 0 00 000200 ifxn. t2, gs%nam ; A bound JFN? 39795 000636'01 254 00 0 00 000641' 39796 000637'01 205 01 0 00 020000 movx t1, ts%jfn ; Yes, set the JFN flag 39797 000640'01 254 00 0 00 000625* retskp ; Success 39798 000641'01 endif. ; End case a real JFN 39799 remark ; Otherwise, fall through to try device 39800 000641'01 endif. 39801 39802 000641'01 200 01 0 00 000005 move t1, q1 ; Reload the calling argument 39803 000642'01 104 00 0 00 000117 DVCHR% ; See if we got a device handle, maybe 39804 000643'01 320 12 0 00 000645' ifje. r ; Failed?? 39805 000644'01 254 00 0 00 000650' 39806 000645'01 200 02 0 00 000001 move t2, t1 ; Save error code for debuggers 39807 000646'01 400 01 0 00 000000 setz t1, ; Return no flags at all 39808 remark ; Fall out to try something else (like what??) 39809 000647'01 254 00 0 00 000652' else. ; Otherwise, worked 39810 000650'01 205 01 0 00 010000 movx t1, ts%dev ; Set the device handle flag 39811 000651'01 254 00 0 00 000640* retskp ; Success 39812 000652'01 endif. 39813 39814 000652'01 263 17 0 00 000000 ret ; Can't figure out what else to try, so fail 39815 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 15 K20SUB MAC 9-Jun-23 22:13 set and unset terminal for binary output 39816 subttl set and unset terminal for binary output 39817 39818 ; Put TTY in binary mode for output only. Still allows normal input, 39819 ; ^C trapping, etc. 39820 39821 000653'01 ttyob: entry ttyob ; Used by k20ioc 39822 000653'01 201 01 0 00 000101 movei t1, .priou ; Get CCOC words 39823 000654'01 104 00 0 00 000112 RFCOC 39824 000655'01 124 02 0 00 000000# dmovem t2, myccoc ; Save em. 39825 dmove t2,[525252525252 ;[194] Make all characters output 39826 000656'01 120 02 0 00 004066' 525252525000] ;[194] with no translation. 39827 000657'01 104 00 0 00 000113 SFCOC 39828 000660'01 201 02 0 00 000044 movei t2, .morxo ; Get tty pause-end-of-page status. 39829 000661'01 104 00 0 00 000077 MTOPR% 39830 000662'01 320 12 0 00 000664' %jserr (,) 39831 000663'01 254 00 0 00 000667' 39832 000664'01 265 01 0 00 000257' 39833 000665'01 000000 000000 39834 000666'01 254 00 0 00 000667' 39835 000667'01 202 03 0 00 000000# movem t3, ttpau ; Save it. 39836 dmove t2, [ .moxof ; Set the terminal pause on command 39837 000670'01 120 02 0 00 004070' .mooff ] ; to no pause on command 39838 000671'01 104 00 0 00 000077 MTOPR% 39839 000672'01 320 12 0 00 000674' %jserr (,) 39840 000673'01 254 00 0 00 000677' 39841 000674'01 265 01 0 00 000257' 39842 000675'01 000000 000000 39843 000676'01 254 00 0 00 000677' 39844 000677'01 263 17 0 00 000000 ret 39845 39846 39847 ; Restore TTY output to condition before TTYOB was called. 39848 39849 000700'01 ttyou: entry ttyou ; Used by k20ioc 39850 000700'01 201 01 0 00 000101 movei t1, .priou ; Restore normal tty output. 39851 000701'01 120 02 0 00 000000# dmove t2, myccoc 39852 000702'01 104 00 0 00 000113 SFCOC 39853 000703'01 320 12 0 00 000705' %jserr (,) 39854 000704'01 254 00 0 00 000710' 39855 000705'01 265 01 0 00 000257' 39856 000706'01 000000 000000 39857 000707'01 254 00 0 00 000710' 39858 000710'01 201 02 0 00 000043 movei t2, .moxof ; Set terminal pause on command 39859 000711'01 200 03 0 00 000000# move t3, ttpau ; to what it used to be. 39860 000712'01 104 00 0 00 000077 MTOPR% 39861 000713'01 320 12 0 00 000715' %jserr (,) 39862 000714'01 254 00 0 00 000720' 39863 000715'01 265 01 0 00 000257' 39864 000716'01 000000 000000 39865 000717'01 254 00 0 00 000720' 39866 000720'01 263 17 0 00 000000 ret 39867 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 16 K20SUB MAC 9-Jun-23 22:13 Save Terminal Characteristics (see following) 39868 subttl Save Terminal Characteristics (see following) 39869 39870 ; Call: 39871 ; 39872 ; t1/ JFN or device or fork handle 39873 ; t2/ Pointer to storage area 39874 ; 39875 ; Return: 39876 ; 39877 ; +1, Not a terminal device or some other significant error 39878 ; +2, Complete Success 39879 ; t3/ Interesting discovery flags 39880 ; 39881 ; Storage will contain as much terminal information as could be 39882 ; reasonably captured. 39883 ; 39884 ; Partially inspired by routines in PA1050 (PAT) which handle setting 39885 ; 'free' CRLF. Called at program startup and also when using another 39886 ; terminal line when running in 'local' mode. 39887 ; 39888 ; 39889 ; N.B., *MUST* be called after INICAP so we can see if we have SC%CTC!! 39890 ; 39891 ; To Do: Maybe check if .priou is .dvpip and don't do this? 39892 39893 000721'01 savtty: entry savtty ; Called from k20mit 39894 000721'01 265 16 0 00 004072' saveac ; Used for loop control and terminal references 39895 000722'01 120 07 0 00 000001 dmove q3, t1 ; Save calling arguments 39896 39897 000723'01 205 03 0 00 400000 movx t3, ts%err ; Assume some kind of failure 39898 000724'01 202 03 0 10 000000 movem t3, $tsflg(q4) ; Store in block 39899 000725'01 202 01 0 10 000001 movem t1, $tsarg(q4) ; Saving calling argument 39900 000726'01 201 03 0 00 601405 movx t3, lstrx1 ; However, we don't have any errors, YET 39901 000727'01 202 03 0 10 000002 movem t3, $tserr(q4) ; So don't assume 39902 000730'01 260 17 0 00 000570' call argtyp ; Determine argument type 39903 000731'01 263 17 0 00 000000 ret ; Failed, don't know what it is 39904 39905 000732'01 437 01 0 10 000000 orb t1, $tsflg(q4) ; Save and use the determined type 39906 000733'01 200 05 0 00 000001 move q1, t1 ; Also keep current flags in a fast place 39907 39908 000734'01 607 05 0 00 100000 ifxn. q1, ts%pro ; Was this primary output? 39909 000735'01 254 00 0 00 000740' 39910 000736'01 661 05 0 00 040000 txo q1, ts%frk ; Yes, so turn it into a fork handle 39911 000737'01 201 07 0 00 400000 movei q3, .fhslf ; Stomp argument to this process 39912 000740'01 endif. 39913 39914 000740'01 607 05 0 00 040000 ifxn. q1, ts%frk ; Fork (or implied fork)? 39915 000741'01 254 00 0 00 000754' 39916 000742'01 200 01 0 00 000007 move t1, q3 ; Yes, load it 39917 000743'01 104 00 0 00 000206 GPJFN% ; Find out primary JFN's 39918 000744'01 320 12 0 00 000746' ifje. r ; Failed?? 39919 000745'01 254 00 0 00 000752' 39920 000746'01 202 01 0 10 000002 movem t1, $tserr(q4) ;Store the error number 39921 000747'01 474 02 0 00 000000 seto t2, ; Force .cttrm 39922 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 15:19 11-Jun-23 Page 16-1 K20SUB MAC 9-Jun-23 22:13 Save Terminal Characteristics (see following) 39923 000751'01 254 00 0 00 000753' else. ; Otherwise, there is no error 39924 000752'01 400 03 0 00 000000 setz t3, ; So state as much 39925 000753'01 endif. ; and carry on 39926 000753'01 254 00 0 00 000756' else. ; Otherwise, not using .priou 39927 000754'01 200 02 0 00 000007 move t2, q3 ; Pretend this is .priou 39928 000755'01 201 03 0 00 601405 movx t3, lstrx1 ; And flag no error differently 39929 000756'01 endif. 39930 000756'01 124 02 0 10 000003 dmovem t2, $gpjfn(q4) ; Store appropriately 39931 39932 000757'01 607 05 0 00 010000 ifxn. q1, ts%dev ; Already had a device designator 39933 000760'01 254 00 0 00 000763' 39934 000761'01 200 01 0 00 000007 move t1, q3 ; Yes, use it 39935 000762'01 254 00 0 00 000764' else. ; Otherwise, maybe GPJFN% got something 39936 000763'01 550 01 0 00 000002 hrrz t1, t2 ; Have a look at whatever the primary is 39937 000764'01 endif. 39938 000764'01 104 00 0 00 000117 DVCHR% ; Get the device characteristics 39939 000765'01 320 12 0 00 000767' ifje. r ; Failed?? 39940 000766'01 254 00 0 00 000774' 39941 000767'01 202 01 0 10 000002 movem t1, $tserr(q4) ; Store the error number 39942 000770'01 200 04 0 00 000001 move t4, t1 ; And also for failure specifics 39943 000771'01 400 01 0 00 000000 setz t1, ; Phoney up an impossible designator 39944 000772'01 477 02 0 00 000003 setob t2, t3 ; Yield impossible results 39945 000773'01 254 00 0 00 000775' else. ; Otherwise, worked 39946 000774'01 400 04 0 00 000000 setz t4, ; Therefore, flag this 39947 000775'01 endif. 39948 000775'01 124 01 0 10 000005 dmovem t1, $dvchr(q4) ; Save results 39949 000776'01 124 03 0 10 000007 dmovem t3, $dvchr+2(q4) ; All of them and error (if any) 39950 000777'01 326 04 0 00 000565* jumpn t4, r ; Can't go any further if failed 39951 ; Otherwise, investigate results 39952 001000'01 135 04 0 00 004054' ldb t4,[pointr t2, dv%typ] ; Pick up the device type 39953 001001'01 302 04 0 00 000012 caie t4, .dvtty ; Ok, is this a terminal? 39954 001002'01 263 17 0 00 000000 ret ; No, the rest makes no sense 39955 001003'01 302 01 0 00 777777 caie t1, .cttrm ; Controlling terminal? 39956 001004'01 254 00 0 00 001010' ifskp. ; Yes, let's fix that up 39957 001005'01 200 01 0 00 000003 move t1, t3 ; Load the device type and line number 39958 001006'01 661 01 0 00 600000 txo t1, (.dvdes) ; Turn on the designator bit 39959 001007'01 202 01 0 10 000005 movem t1, $dvchr(q4) ; Replace saved device designator 39960 001010'01 endif. 39961 001010'01 200 06 0 00 000001 move q2, t1 ; Save device in a fast place 39962 39963 remark t1, ; Finally has terminal device 39964 001011'01 104 00 0 00 000112 RFCOC% ; Get the control word 39965 001012'01 320 12 0 00 001014' ifje. r ; Catch and ignore error 39966 001013'01 254 00 0 00 001021' 39967 001014'01 202 01 0 10 000013 movem t1, $ctcoc+2(q4) ;Save the error 39968 001015'01 202 01 0 10 000002 movem t1, $tserr(q4) ; Store the error here, too 39969 001016'01 477 02 0 00 000003 setob t2, t3 ; Fine, no control character output control 39970 001017'01 200 01 0 00 000006 move t1, q2 ; Reload designator 39971 001020'01 254 00 0 00 001022' else. ; Otherwise worked, which is good 39972 001021'01 402 00 0 10 000013 setzm $ctcoc+2(q4) ; Flag no error 39973 001022'01 endif. 39974 001022'01 124 02 0 10 000011 dmovem t2, $ctcoc(q4) ; Store controlling terminal's COC's 39975 39976 001023'01 104 00 0 00 000107 RFMOD% ; Get the JFN mode word 39977 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 15:19 11-Jun-23 Page 16-2 K20SUB MAC 9-Jun-23 22:13 Save Terminal Characteristics (see following) 39978 001025'01 254 00 0 00 001033' 39979 001026'01 202 01 0 10 000002 movem t1, $tserr(q4) ; Store the error number 39980 001027'01 474 02 0 00 000000 seto t2, ; Fine, no mode word 39981 001030'01 200 03 0 00 000001 move t3, t1 ; Reposition error 39982 001031'01 200 01 0 00 000006 move t1, q2 ; Reload designator 39983 001032'01 254 00 0 00 001035' else. ; Otherwise, worked 39984 001033'01 621 02 0 00 400000 txz t2, tt%osp ; Clear Control-O 39985 001034'01 400 03 0 00 000000 setz t3, ; Flag no error 39986 001035'01 endif. 39987 001035'01 124 02 0 10 000014 dmovem t2, $ctmod(q4) ; Store controlling terminal's mode word and error 39988 39989 001036'01 201 05 0 00 000006 movei q1, mtoprl ; Load MTOPR% table length 39990 39991 001037'01 do. ; Enter loop context 39992 001037'01 554 02 0 05 001160' hlrz t2, mtoprt(q1) ; Load function to perform 39993 001040'01 104 00 0 00 000077 MTOPR% ; Read the value 39994 001041'01 320 12 0 00 001043' ifje. r ; Catch and ignore error 39995 001042'01 254 00 0 00 001050' 39996 001043'01 202 01 0 10 000002 movem t1, $tserr(q4) ;Store the error number 39997 001044'01 474 03 0 00 000000 seto t3, ; Fine, no value 39998 001045'01 200 04 0 00 000001 move t4, t1 ; Save for debugger 39999 001046'01 200 01 0 00 000006 move t1, q2 ; Reload designator 40000 001047'01 254 00 0 00 001051' else. ; Otherwise, worked 40001 001050'01 400 04 0 00 000000 setz t4, ; Flag no error 40002 001051'01 endif. 40003 001051'01 550 02 0 05 001160' hrrz t2, mtoprt(q1) ; Load location to store 40004 001052'01 270 02 0 00 000010 add t2, q4 ; Calculate correct address in structure 40005 001053'01 124 03 0 02 000000 dmovem t3, (t2) ; store it somewhere 40006 001054'01 365 05 0 00 001037' sojge q1, top. ; Get the next one 40007 001055'01 enddo. ; Exit loop context 40008 40009 001055'01 201 04 0 00 000004 movx t4, <0,,4> ; Load block header word 40010 001056'01 202 04 0 10 000034 movem t4, $morbm(q4) ; Initialize block 40011 remark t1, ; Still has correct designator 40012 001057'01 201 02 0 00 000037 movx t2, .morbm ; Function is to read break mask 40013 001060'01 201 03 0 10 000034 movei t3, $morbm(q4) ; Resolve address of break mask block 40014 001061'01 104 00 0 00 000077 MTOPR% ; Read the value 40015 001062'01 320 12 0 00 001064' ifje. r ; Catch and ignore error 40016 001063'01 254 00 0 00 001074' 40017 001064'01 200 04 0 00 000001 move t4, t1 ; Save for debugger 40018 001065'01 202 01 0 10 000002 movem t1, $tserr(q4) ; Store the error number 40019 001066'01 477 02 0 00 000003 setob t2, t3 ; Fine, no break mask.. 40020 001067'01 124 02 0 10 000034 dmovem t2, $morbm(q4) ; Stomp header and first break word 40021 001070'01 124 02 0 10 000036 dmovem t2, $morbm+2(q4) ;Stomp second and third break word 40022 001071'01 124 03 0 10 000040 dmovem t3, $morbm+4(q4) ;Stomp fourth break word, store error 40023 001072'01 200 01 0 00 000006 move t1, q2 ; Reload designator 40024 001073'01 254 00 0 00 001075' else. ; Otherwise, worked 40025 001074'01 402 00 0 10 000041 setzm $morbm+5(q4) ; Flag no error 40026 001075'01 endif. 40027 ; Finally set large dimension flags 40028 001075'01 120 02 0 10 000016 dmove t2, $morlw(q4) ; Load the terminal width 40029 001076'01 326 03 0 00 001103' ife. t3 ; Was there any error? 40030 001077'01 307 02 0 00 000177 caig t2, ^d127 ; Exceeded seven bits? 40031 001100'01 254 00 0 00 001103' anskp. ; No, STPAR% will work 40032 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 15:19 11-Jun-23 Page 16-3 K20SUB MAC 9-Jun-23 22:13 Save Terminal Characteristics (see following) 40033 001102'01 436 03 0 10 000000 orm t3, $tsflg(q4) ; Record in the flags word 40034 001103'01 endif. 40035 40036 001103'01 120 02 0 10 000020 dmove t2, $morll(q4) ; Load terminal length 40037 001104'01 326 03 0 00 001111' ife. t3 ; Was there any error? 40038 001105'01 307 02 0 00 000177 caig t2, ^d127 ; Exceeded seven bits? 40039 001106'01 254 00 0 00 001111' anskp. ; No, STPAR% will work 40040 001107'01 205 03 0 00 000200 movx t3, ts%lgl ; Load large length flag 40041 001110'01 436 03 0 10 000000 orm t3, $tsflg(q4) ; Record in the flags word 40042 001111'01 endif. 40043 40044 001111'01 200 04 0 10 000000 move t4, $tsflg(q4) ; Load the current flags so far 40045 001112'01 607 04 0 00 002000 ifxn. t4, ts%efh ; Did we have an explicit fork handle? 40046 001113'01 254 00 0 00 001116' 40047 001114'01 200 05 0 10 000001 move q1, $tsarg(q4) ; Yes, let's use it 40048 001115'01 254 00 0 00 001117' else. ; Otherwise, assume job wide teriminal interrupts 40049 001116'01 201 05 0 00 777773 movei q1, .fhjob ; And use this magic handle 40050 001117'01 endif. 40051 40052 001117'01 200 03 0 00 000000# move t3, mycaps+1 ; Load ENABLED capabilities 40053 001120'01 325 03 0 00 001124' ifxn. t3, sc%ctc ; Did we have ^C? 40054 001121'01 205 03 0 00 001000 movx t3, ts%ctc ; Load that we had sc%ctc 40055 001122'01 437 03 0 10 000000 orb t3, $tsflg(q4) ; Record in the flags word and keep handy 40056 001123'01 254 00 0 00 001125' else. ; Otherwise, don't have it 40057 001124'01 200 03 0 10 000000 move t3, $tsflg(q4) ; So load what we do have 40058 001125'01 endif. 40059 40060 001125'01 302 05 0 00 777773 caie q1, .fhjob ; Are we doing job wide? 40061 001126'01 254 00 0 00 001132' ifskp. ; Yes, so let's see if that is possible 40062 001127'01 603 03 0 00 001000 txne t3, ts%ctc ; Did we have ^C? 40063 001130'01 254 00 0 00 001132' anskp. ; Yes, so STIW% on this will work 40064 001131'01 201 05 0 00 400000 movei q1, .fhslf ; No; just this fork's terminal interrupt word 40065 001132'01 endif. ; End case .fhjob specified (or assumed) 40066 40067 001132'01 200 01 0 00 000005 move t1, q1 ; Load terminal interrupt word context 40068 001133'01 202 01 0 10 000042 movem t1, $tif(q4) ; Store what we are using 40069 001134'01 302 01 0 00 777773 caie t1, .fhjob ; Entire job? 40070 001135'01 254 00 0 00 001140' ifskp. ; It is, so won't be getting differed word 40071 001136'01 400 03 0 00 000000 setz t3, ; So stomp it 40072 001137'01 254 00 0 00 001141' else. ; Otherwise, this is a specific process 40073 001140'01 661 01 0 00 400000 txo t1, rt%dim ; So get differed word, just for fun 40074 001141'01 endif. 40075 40076 001141'01 104 00 0 00 000173 RTIW% ; Finally read the terminal interrupt word 40077 001142'01 320 12 0 00 001144' ifje. r ; Catch and handle the error 40078 001143'01 254 00 0 00 001150' 40079 001144'01 202 01 0 10 000045 movem t1, $tiw+2(q4) ; Save the error 40080 001145'01 202 01 0 10 000002 movem t1, $tserr(q4) ; Store the error here, too 40081 001146'01 403 02 0 00 000003 setzb t2, t3 ; Let's say nothing is set 40082 001147'01 254 00 0 00 001151' else. ; Otherwise worked, which is good 40083 001150'01 402 00 0 10 000045 setzm $tiw+2(q4) ; Flag no error 40084 001151'01 endif. 40085 001151'01 124 02 0 10 000043 dmovem t2, $tiw(q4) ; Store terminal interrupt word (and maybe diferred) 40086 40087 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 15:19 11-Jun-23 Page 16-4 K20SUB MAC 9-Jun-23 22:13 Save Terminal Characteristics (see following) 40088 001153'01 302 01 0 00 601405 caie t1, lstrx1 ; Never had any? 40089 001154'01 263 17 0 00 000000 ret ; Fail the call 40090 40091 001155'01 525 03 0 00 377777 movx t3, ^-ts%err ; Load failure bit complement 40092 001156'01 407 03 0 10 000000 andb t3, $tsflg(q4) ; Shut off in flag word 40093 001157'01 254 00 0 00 000651* retskp ; Complete success 40094 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 17 K20SUB MAC 9-Jun-23 22:13 MTOPR% index to structure offset mapping tables 40095 subttl MTOPR% index to structure offset mapping tables 40096 40097 ; Be aware that each pointer is pointing to a double word which 40098 ; holds the value and any error. This is to keep us from restoring 40099 ; a value which was never properly read in the first place and 40100 ; really messing up a possibly already ill terminal. 40101 ; 40102 ; As these are offsets, they are added to an address, which means 40103 ; that the structure can be in any section. 40104 40105 001160'01 000030 000016 mtoprt: .morlw,,$morlw ; Read line width 40106 001161'01 000032 000020 .morll,,$morll ; Read line length 40107 001162'01 000035 000022 .mornt,,$mornt ; Receive system blat 40108 001163'01 000044 000024 .morxo,,$morxo ; Pause end of page 40109 001164'01 000053 000026 .mopcr,,$mopcr ; Read terminal pause and unpause 40110 001165'01 000054 000030 .mortf,,$mortf ; Read other kinds of blat 40111 001166'01 400001 000032 panda < .morlt,,$morlt > ;;Read TVT bits 40112 000006 mtoprl==.-mtoprt-1 ; Calculate table length 40113 40114 001167'01 000031 000016 mtopst: .moslw,,$morlw ; Set line width 40115 001170'01 000033 000020 .mosll,,$morll ; Set line length 40116 001171'01 000034 000022 .mosnt,,$mornt ; Set system blat acceptance 40117 001172'01 000043 000024 .moxof,,$morxo ; Set pause end of page 40118 001173'01 000052 000026 .mopcs,,$mopcr ; Set terminal pause and unpause 40119 001174'01 000055 000030 .mostf,,$mortf ; Set other kinds of blat 40120 001175'01 400002 000032 panda < .moslt,,$morlt > ;;Set TVT bits 40121 000006 mtopsl==.-mtopst-1 ; Calculate table length 40122 40123 ifn , 40124 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 18 K20SUB MAC 9-Jun-23 22:13 Restore Terminal Characteristics 40125 subttl Restore Terminal Characteristics 40126 40127 ; Call: 40128 ; 40129 ; t1/ Takes a pointer to a storage area that was set up by SAVTTY. 40130 ; 40131 ; Restores every parameter that was successfully saved, ignores 40132 ; those that weren't. 40133 ; 40134 ; Return: 40135 ; 40136 ; +1, always 40137 ; 40138 ; t3 has last error, zero if everything restored 40139 ; 40140 ; Terminal characteristics restored or restored mostly. 40141 ; 40142 ; Trashes t1, t2, t3 and t4 40143 ; 40144 ; See above. Do NOT change order of restore because SFMOD%/STPAR% 40145 ; will overwrite the length and width with the wrong things 40146 40147 001176'01 restty: entry restty ; Called from k20mit 40148 001176'01 265 16 0 00 004104' saveac ; Uses plenty more registers... 40149 40150 001177'01 200 05 0 00 000001 move q1, t1 ; Save structure base 40151 001200'01 474 03 0 00 000000 seto t3, ; Assume complete junk 40152 001201'01 332 00 0 05 000010 skipe $dvchr+3(q1) ; Did we ever get a device? 40153 001202'01 263 17 0 00 000000 ret ; No, no way we can restore anything 40154 001203'01 200 06 0 05 000005 move q2, $dvchr(q1) ; Yes, use the device for everything 40155 001204'01 200 01 0 00 000006 move t1, q2 ; Load for JSYi 40156 001205'01 400 07 0 00 000000 setz q3, ; Let's assume everything works 40157 40158 001206'01 332 00 0 05 000013 ifme. $ctcoc+2(q1) ; Did the RFCOC% work 40159 001207'01 254 00 0 00 001216' 40160 001210'01 120 02 0 05 000011 dmove t2, $ctcoc(q1) ; Yes, load controlling terminal's COC's 40161 001211'01 104 00 0 00 000113 SFCOC% ; Put them back 40162 001212'01 320 12 0 00 001214' ifje. r ; Failed?? 40163 001213'01 254 00 0 00 001216' 40164 001214'01 200 07 0 00 000001 move q3, t1 ; Remember that something failed 40165 001215'01 200 01 0 00 000006 move t1, q2 ; Reload designator 40166 001216'01 endif. ; End case SFCOC% failure handling 40167 001216'01 endif. ; End case SFCOC% restore decision 40168 40169 001216'01 332 00 0 05 000015 ifme. $ctmod+1(q1) ; Did RFMOD% work? 40170 001217'01 254 00 0 00 001233' 40171 001220'01 200 02 0 05 000014 move t2, $ctmod(q1) ; Yes, load those bits 40172 001221'01 104 00 0 00 000110 SFMOD% ; Set 'program related' bits 40173 001222'01 320 12 0 00 001224' ifje. r ; Failed?? 40174 001223'01 254 00 0 00 001226' 40175 001224'01 200 07 0 00 000001 move q3, t1 ; Remember that something failed 40176 001225'01 200 01 0 00 000006 move t1, q2 ; Reload designator 40177 001226'01 endif. ; End SFMOD% error handling 40178 001226'01 104 00 0 00 000217 STPAR% ; Set 'mechanical' bits 40179 001227'01 320 12 0 00 001231' ifje. r ; Failed?? k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 18-1 K20SUB MAC 9-Jun-23 22:13 Restore Terminal Characteristics 40180 001230'01 254 00 0 00 001233' 40181 001231'01 200 07 0 00 000001 move q3, t1 ; Remember that something failed 40182 001232'01 200 01 0 00 000006 move t1, q2 ; Reload designator 40183 001233'01 endif. ; End STPAR% error handling 40184 001233'01 endif. ; End mode word restore decision 40185 40186 001233'01 201 10 0 00 000006 movei q4, mtopsl ; Load MTOPR% table length 40187 40188 001234'01 do. ; Enter loop context 40189 001234'01 550 11 0 10 001167' hrrz p1, mtopst(q4) ; Load pointer to stored value offset 40190 001235'01 270 11 0 00 000005 add p1, q1 ; Add in base of table 40191 001236'01 120 03 0 11 000000 dmove t3, (p1) ; Load value and error condition 40192 001237'01 326 04 0 00 001246' ife. t4 ; If no error, then try setting 40193 001240'01 554 02 0 10 001167' hlrz t2, mtopst(q4) ; Load this value's MTOPR% set index 40194 001241'01 104 00 0 00 000077 MTOPR% ; Try setting the value 40195 001242'01 320 12 0 00 001244' ifje. r ; Failed?? 40196 001243'01 254 00 0 00 001246' 40197 001244'01 200 07 0 00 000001 move q3, t1 ; Remember that something failed 40198 001245'01 200 01 0 00 000006 move t1, q2 ; Reload designator 40199 001246'01 endif. ; End MTOPR% error handling 40200 001246'01 endif. ; End MTOPR% restore decision 40201 001246'01 365 10 0 00 001234' sojge q4, top. ; Get the next one 40202 001247'01 enddo. ; Exit loop context 40203 40204 001247'01 332 00 0 05 000041 ifme. $morbm+5(q1) ; Did the read mask work? 40205 001250'01 254 00 0 00 001260' 40206 001251'01 201 02 0 00 000040 movx t2, .mosbm ; Function to set break mask 40207 001252'01 201 03 0 05 000034 movei t3, $morbm(q1) ; Address of four word block to load from 40208 001253'01 104 00 0 00 000077 MTOPR% ; Set the value 40209 001254'01 320 12 0 00 001256' ifje. r ; Failed?? 40210 001255'01 254 00 0 00 001260' 40211 001256'01 200 07 0 00 000001 move q3, t1 ; Remember that something failed 40212 001257'01 200 01 0 00 000006 move t1, q2 ; Reload designator 40213 001260'01 endif. ; End case MTOPR% failure handling 40214 001260'01 endif. ; End case break mask restore decision 40215 40216 001260'01 332 00 0 05 000045 ifme. $tiw+2(q1) ; Were we able to get the terminal interrupt word? 40217 001261'01 254 00 0 00 001270' 40218 001262'01 120 01 0 05 000042 dmove t1, $tif(q1) ; Yes, load context and mask 40219 001263'01 104 00 0 00 000174 STIW% ; Restore somebody's terminal interrupt word 40220 001264'01 320 12 0 00 001266' ifje. r ; Failed?? 40221 001265'01 254 00 0 00 001270' 40222 001266'01 200 07 0 00 000001 move q3, t1 ; Remember that something failed 40223 001267'01 200 01 0 00 000006 move t1, q2 ; Reload designator 40224 001270'01 endif. ; End case STIW% failure handling 40225 001270'01 endif. ; End case STIW% decision 40226 40227 001270'01 200 03 0 00 000007 move t3, q3 ; Has any errors 40228 001271'01 263 17 0 00 000000 ret ; Finally get out of here 40229 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 19 K20SUB MAC 9-Jun-23 22:13 Set Up Local Terminal for Kermit usage 40230 subttl Set Up Local Terminal for Kermit usage 40231 40232 001272'01 setty: entry setty ;[220] Invoked by k20mit 40233 001272'01 260 17 0 00 000000* call udjinf ;[220] Get and update current job information 40234 001273'01 335 04 0 00 000000# skipge t4,jobtab+.jitno ;[220] Load and check current terminal number 40235 001274'01 334 01 0 00 000000# ermsg% (,halt) ;[220] 40236 001275'01 254 00 0 00 001301' 40237 001276'01 202 01 0 00 000140* 40238 001277'01 104 00 0 00 000313 40239 001300'01 254 00 0 00 000000* 40240 000002'03 000000000000# 40241 000000'04 113 105 122 115 111 40242 40243 001301'01 202 04 0 00 000000* movem t4, mytty ;[184] stomp in a possible new line 40244 40245 001302'01 200 01 0 00 000004 move t1, t4 ;[186] Pass in possible new terminal line 40246 001303'01 505 01 0 00 600012 hrli t1,.dvdes!.dvtty ;[186] Turn into a device designator 40247 001304'01 201 02 0 00 000000* movei t2, svstt ;[186] Point to saved start up terminal area 40248 001305'01 260 17 0 00 000721' call savtty ;[186] Save terminal characteristics again 40249 001306'01 334 01 0 00 000000# ermsg% (,halt) ;[186] 40250 001307'01 254 00 0 00 001313' 40251 001310'01 202 01 0 00 001276* 40252 001311'01 104 00 0 00 000313 40253 001312'01 254 00 0 00 001300* 40254 000003'03 000000000000# 40255 000016'04 113 105 122 115 111 40256 40257 40258 001313'01 201 02 0 00 001304* movei t2, svstt ;[194] Point to populated structure 40259 001314'01 332 00 0 02 000010 ifme. $dvchr+3(t2) ;[194] Any error? 40260 001315'01 254 00 0 00 001320' 40261 001316'01 200 03 0 02 000005 move t3, $dvchr(t2) ;[194] None, use what DVCHR% got 40262 001317'01 254 00 0 00 001321' else. ;[194] Otherwise, have to use something 40263 001320'01 201 03 0 00 000101 movei t3, .priou ;[194] Maybe old reliable will work 40264 001321'01 endif. ;[194] End case determining controlling device 40265 001321'01 202 03 0 00 000000* movem t3, $PRIOU ;[194] Store and hope for the best 40266 40267 001322'01 260 17 0 00 001332' call lcltty ;[194] Get a JFN on local terminal 40268 001323'01 334 00 0 00 000000 %ermsg (,halt) ;[186] 40269 001324'01 254 00 0 00 001330' 40270 001325'01 265 01 0 00 000257' 40271 001326'01 000000000000# 40272 001327'01 254 00 0 00 001312* 40273 000032'04 125 156 141 142 154 40274 001330'01 202 01 0 00 000000* movem t1, ttyjfn ;[194] Store for downstream use 40275 001331'01 263 17 0 00 000000 ret 40276 40277 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 20 K20SUB MAC 9-Jun-23 22:13 Acquire JFN on local terminal 40278 subttl Acquire JFN on local terminal 40279 40280 ; Although has a +1/+2 return, it always returns 40281 ; something, even if it is only .priou or .cttrm 40282 ; 40283 ; t1/ JFN open and ready to use 40284 ; 40285 ; To do: if a pipe, maybe change this and just use it? 40286 ; 40287 ; Also: if we are running as local, then we should close the 40288 ; ttyjfn and replace it with .sigio because we shouldn't 40289 ; be diddling the local terminal. 40290 40291 001332'01 lcltty: extern ttyjfn ; In k20mit 40292 001332'01 265 16 0 00 004120' saveac ; Copy of possible open JFN 40293 40294 001333'01 476 00 0 00 000000# setom lcltte ; Whack the error block to detached job 40295 001334'01 200 01 0 00 004126' move t1, [lcltte,,lcltte+1] 40296 001335'01 251 01 0 00 000000# blt t1, lcltef ; The entire block 40297 40298 001336'01 337 05 0 00 001330* skipg q1, ttyjfn ; First, is there something already available? 40299 001337'01 254 00 0 00 001370' jrst getlcl ; Evidently not; let's get a JFN 40300 40301 001340'01 200 01 0 00 000005 move t1, q1 ; Load it for the JSYS to investigate 40302 001341'01 104 00 0 00 000024 GTSTS% ; Let's have a look see 40303 001342'01 320 12 0 00 001344' ifje. r ; Looks like it's defunct, somehow 40304 001343'01 254 00 0 00 001347' 40305 001344'01 202 01 0 00 000000# movem t1, lcltte ; Store the error 40306 001345'01 200 01 0 00 000005 move t1, q1 ; Reload the JFN (or whatever it was) 40307 001346'01 400 02 0 00 000000 setz t2, ; Whack the status 40308 001347'01 endif. 40309 40310 001347'01 641 02 0 00 400200 txc t2,gs%nam!gs%opn ; Complement the required bits 40311 001350'01 643 02 0 00 400200 txce t2,gs%nam!gs%opn ; Is it any good at and is it open? 40312 001351'01 254 00 0 00 001370' jrst getlcl ; No, then go get a JFN 40313 001352'01 607 02 0 00 000400 ifxn. t2,gs%err ; Any kind of error? 40314 001353'01 254 00 0 00 001367' 40315 001354'01 505 01 0 00 004000 hrli t1, (cz%abt) ; Abort the JFN 40316 001355'01 104 00 0 00 000022 CLOSF% ; Try to junk it 40317 001356'01 320 12 0 00 001360' ifje. r ; Failied?? 40318 001357'01 254 00 0 00 001366' 40319 001360'01 202 01 0 00 000000# movem t1, lcltte+1 ; Store the error 40320 001361'01 200 01 0 00 000005 move t1, q1 ; Reload the JFN (or whatever it was) 40321 001362'01 104 00 0 00 000023 RLJFN% ; Just try to let go of it 40322 001363'01 320 12 0 00 001365' ifje. r ; Failied?? 40323 001364'01 254 00 0 00 001366' 40324 001365'01 202 01 0 00 000000# movem t1, lcltte+2 ;Store the error 40325 001366'01 endif. 40326 001366'01 endif. 40327 001366'01 254 00 0 00 001370' jrst getlcl ; Go get a new JFN 40328 001367'01 endif. 40329 001367'01 254 00 0 00 001157* retskp ; Otherwise, get out of here with a JFN 40330 40331 001370'01 getlcl: extern mytty ; Here to get a JFN on the local line 40332 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 15:19 11-Jun-23 Page 20-1 K20SUB MAC 9-Jun-23 22:13 Acquire JFN on local terminal 40333 001371'01 200 03 0 00 001301* move t3, mytty ; Load my terminal number 40334 001372'01 316 03 0 00 004023' camn t3, [-1] ; Detached?? 40335 001373'01 254 00 0 00 001451' jrst lclerr ; Yes, that will never do.. 40336 001374'01 620 03 0 00 400000 txz t3, .ttdes ; Stomp in case somebody left it on 40337 dmove t1, [-1,,lclnam ; HRROI pointer to place to build name 40338 001375'01 120 01 0 00 004127' .dvdes!.dvtty,,0 ] ; Device designator prototype 40339 001376'01 540 02 0 00 000003 hrr t2, t3 ; My current attached terminal 40340 001377'01 202 02 0 00 000000# movem t2, lcldev ; Store it for later 40341 001400'01 104 00 0 00 000121 DEVST% ; Build the device string 40342 001401'01 320 12 0 00 001403' ifje. r ; Failed?? 40343 001402'01 254 00 0 00 001406' 40344 001403'01 202 01 0 00 000000# movem t1, lcltte+3 ; Save the error 40345 001404'01 254 00 0 00 001451' jrst lclerr ; And give error return 40346 001405'01 254 00 0 00 001411' else. ; Otherwise, worked 40347 001406'01 120 02 0 00 004131' dmove t2, [ exp ":", 0] ; Load final characters 40348 001407'01 136 02 0 00 000001 idpb t2, t1 ; Punctuate the device 40349 001410'01 136 03 0 00 000001 idpb t3, t1 ; Tie off the device string 40350 001411'01 endif. 40351 40352 dmove t1, [ gj%sht!gj%flg ; Want flags 40353 001411'01 120 01 0 00 004133' -1,,lclnam ] ; Point to constructed device name 40354 001412'01 104 00 0 00 000020 GTJFN% ; Try to get a handle 40355 001413'01 320 12 0 00 001415' ifje. r ; Can't on our own silly TTY?? 40356 001414'01 254 00 0 00 001426' 40357 001415'01 202 01 0 00 000000# movem t1, lcltte+4 ; Sigh ... 40358 dmove t1, [ASCIZ /TTY:/ ; Try generic case 40359 001416'01 120 01 0 00 004135' 0 ] ; Certainly null terminated 40360 001417'01 124 01 0 00 000000# dmovem t1, lclnam ; Drop that in 40361 dmove t1, [ gj%sht!gj%flg ; Want flags 40362 001420'01 120 01 0 00 004137' -1,,lclnam ] ; Point to constructed device name 40363 001421'01 104 00 0 00 000020 GTJFN% ; Try to get a handle 40364 001422'01 320 12 0 00 001424' ifje. r ; Failed?? 40365 001423'01 254 00 0 00 001426' 40366 001424'01 202 01 0 00 000000# movem t1, lcltte+5 ; Sigh ... 40367 001425'01 254 00 0 00 001451' jrst lclerr ; Go do general error exit 40368 001426'01 endif. ; End failure recovery failing .. 40369 001426'01 endif. ; End GTJFN% failure analysis and recovery 40370 40371 001426'01 552 01 0 00 000000# hrrzm t1, lcljfn ; Store the JFN 40372 001427'01 512 01 0 00 000000# hllzm t1, lclflg ; And the flags 40373 001430'01 621 01 0 00 777777 tlz t1, -1 ; Don't confuse foolish OPENF% with our flags 40374 remark ; See what fld(.gsimg,of%mod) does here 40375 ; movx t2, fld(8,of%bsz)!of%wr!of%rd ; 8-bit bytes, read & write access. 40376 001431'01 200 02 0 00 004141' movx t2, fld(8,of%bsz)!fld(.gsimg,of%mod)!of%wr!of%rd 40377 001432'01 104 00 0 00 000021 OPENF% ; Finally try to open the silly thing 40378 001433'01 320 12 0 00 001435' ifje. r ; Failed?? 40379 001434'01 254 00 0 00 001446' 40380 001435'01 306 01 0 00 600120 cain t1, opnx1 ; But!! Was error "File already open"? 40381 001436'01 254 00 0 00 001446' anskp. ; That's fine, we can live with that 40382 001437'01 202 01 0 00 000000# movem t1, lcltte+6 ; Otherwise, store the error 40383 001440'01 550 01 0 00 000000# hrrz t1, lcljfn ; Load the JFN 40384 001441'01 104 00 0 00 000023 RLJFN% ; Let go of it 40385 001442'01 320 12 0 00 001444' ifje. r ; Failed?? We just got it! 40386 001443'01 254 00 0 00 001445' 40387 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 15:19 11-Jun-23 Page 20-2 K20SUB MAC 9-Jun-23 22:13 Acquire JFN on local terminal 40388 001445'01 endif. ; And carry on with OPENF% error 40389 001445'01 254 00 0 00 001451' jrst lclerr ; And give error return 40390 001446'01 endif. ; End OPENF% failure handling 40391 40392 001446'01 260 17 0 00 001454' call gdswrp ;[223] Call Get Device Status Wrapper 40393 001447'01 550 01 0 00 000000# hrrz t1, lcljfn ;[223] Load the JFN 40394 001450'01 254 00 0 00 001367* retskp ; Won!! 40395 40396 001451'01 lclerr: remark ; Here if something broke 40397 001451'01 403 01 0 00 000000# setzb t1, lcljfn ; No JFN 40398 001452'01 402 00 0 00 000000# setzm lclflg ; No flags 40399 001453'01 263 17 0 00 000000 ret ; Nothing further we can do... 40400 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 21 K20SUB MAC 9-Jun-23 22:13 Wrapper for Get Device Status 40401 subttl Wrapper for Get Device Status 40402 40403 ;[223] Begin code insertion 40404 40405 ; Assumes lcljfn is set 40406 40407 remark ; These externals are in k20net and k20ioc 40408 extern gndpar ; Get Network Device Parity 40409 extern none ; No parity being done 40410 extern even ; Doing even parity 40411 extern parpko ; Doing parity only on packets 40412 extern parrck ; Checking parity on receive 40413 40414 001454'01 550 01 0 00 000000# gdswrp: hrrz t1, lcljfn ; Load local terminal JFN in t1 40415 001455'01 500 01 0 00 000000# hll t1, lclflg ; and its flags 40416 001456'01 260 17 0 00 000000* call gndpar ; Get 'Network' Device Status 40417 001457'01 400 02 0 00 000000 setz t2, ; Falled, assume refuses parity, then 40418 001460'01 606 02 0 00 000001 ifxn. t2, gd%par ; 'Tolerates' parity? 40419 001461'01 254 00 0 00 001471' 40420 001462'01 476 00 0 00 000000# setom lclpar ; Yes, normalize that 40421 001463'01 606 02 0 00 000010 ifxn. t2, mo%par ; Was the thing doing parity anyway 40422 001464'01 254 00 0 00 001467' 40423 001465'01 201 03 0 00 000000* movei t3, even ; Tops-20 itself only generates even parity 40424 001466'01 254 00 0 00 001470' else. ; Otherwise, we're not doing parity 40425 001467'01 201 03 0 00 000000* movei t3, none ; so set it to 'none' 40426 001470'01 endif. ; End case propagating parity 40427 001470'01 254 00 0 00 001473' else. ; Otherwise, doesn't do parity 40428 001471'01 402 00 0 00 000000# setzm lclpar ; So whack the variable 40429 001472'01 201 03 0 00 001467* movei t3, none ; And flag elsewhere to 'none' 40430 001473'01 endif. 40431 40432 001473'01 202 03 0 00 000000* movem t3, parity ; So make sure we're following local terminal parity 40433 001474'01 402 00 0 00 000000* setzm parpko ; Doing parity for terminal and packets 40434 001475'01 402 00 0 00 000000* setzm parrck ; But we're not checking it on receive 40435 40436 001476'01 263 17 0 00 000000 ret ; Done 40437 40438 ;[223] End code insertion 40439 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 22 K20SUB MAC 9-Jun-23 22:13 Restore start up terminal parameters 40440 subttl Restore start up terminal parameters 40441 40442 ; Assumes correct terminal parameters to restore are the start up ones 40443 40444 001477'01 fixtty: entry fixtty ; World callable 40445 extern svstt, tiword ; Found in K20MIT 40446 40447 001477'01 201 01 0 00 001313* movei t1, svstt ; Load pointer to start up terminal parameter block 40448 001500'01 260 17 0 00 001176' call restty ; Restore the whole kit and kaboodle 40449 001501'01 322 03 0 00 001506' ifn. t3 ; Anything not restore properly? 40450 001502'01 334 01 0 00 000000# ermsg% 40451 001503'01 254 00 0 00 001506' 40452 001504'01 202 01 0 00 001310* 40453 001505'01 104 00 0 00 000313 40454 000004'03 000000000000# 40455 000042'04 113 105 122 115 111 40456 40457 001506'01 endif. ; End case double checking 40458 001506'01 200 03 0 00 000000# move t3, mycaps+1 ; Load enabled capabilities 40459 001507'01 325 03 0 00 001512' ifxn. t3, sc%ctc ; Do we have control-C capapbility? 40460 001510'01 201 01 0 00 777773 movx t1, .fhjob ; Yes, then can grab ^C job wide 40461 001511'01 254 00 0 00 001513' else. ; Otherwise, can only do it for our fork 40462 001512'01 201 01 0 00 400000 movei t1, .fhslf ; So make it process wide, instead 40463 001513'01 endif. ; What about the inferior? 40464 40465 001513'01 200 02 0 00 000000* move t2, tiword ; Load the terminal interrupt word 40466 001514'01 104 00 0 00 000174 STIW ; and set it 40467 001515'01 320 12 0 00 001517' %jserr (,) 40468 001516'01 254 00 0 00 001522' 40469 001517'01 265 01 0 00 000257' 40470 001520'01 000000000000# 40471 001521'01 254 00 0 00 001522' 40472 000060'04 146 151 170 164 164 40473 001522'01 263 17 0 00 000000 ret 40474 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 23 K20SUB MAC 9-Jun-23 22:13 Condition local terminal for use as remote 40475 subttl Condition local terminal for use as remote 40476 40477 ;[151] Set up TTY for linking, and open any logging file. 40478 ; 40479 ;[129] Add TT%DUM 40480 40481 000000 $modof==0 ;[194] Bits we want off 40482 004000 $modof==$modof!tt%eco ;[194] Shutting off echoing 40483 004300 $modof==$modof!tt%dam ;[194] Force binary data mode (whacks field flags) 40484 004314 $modof==$modof!tt%dum ;[194] Force full duplex (whacks field flags) 40485 004334 $modof==$modof!tt%lic ;[194] Do not raise lower case on input 40486 104334 $modof==$modof!tt%wkf ;[194] Don't wakeup on formating control chars 40487 144334 $modof==$modof!tt%wkn ;[194] Don't wakeup on non-formatting control chars 40488 164334 $modof==$modof!tt%wkp ;[194] Don't wakeup on punctuation 40489 174334 $modof==$modof!tt%wka ;[194] Don't wakeup on alphanumerics 40490 000177 174334 $modof==$modof!tt%wid ;[194] Infinite width (0) 40491 037777 174334 $modof==$modof!tt%len ;[194] Infinite length (0) 40492 037777 174374 $modof==$modof!tt%uoc ;[194] Do not indicate upper case 40493 40494 001523'01 037777 174374 modoff: $modof ;[194] Store in code psect 40495 .xcref $modof ;[194] Don't need in cross reference 40496 40497 remark ;[194] Don't translate certain control characters 40498 000000 $modon==0 ;[194] Bits we want on 40499 200000 000000 $modon==$modon!tt%mff ;[194] Mechanical formfeed present 40500 300000 000000 $modon==$modon!tt%tab ;[194] Mechanical tab present 40501 340000 000000 $modon==$modon!tt%lca ;[194] Lower case capabilities present 40502 340000 000002 $modon==$modon!tt%pgm ;[194] Assume doing ^S/^Q 40503 40504 001524'01 340000 000002 modon: $modon ;[194] Store in code psect 40505 .xcref $modon ;[194] Don't need in cross reference 40506 40507 001525'01 ttyini: entry ttyini ;[194] Called from main 40508 extern handsh, flow, halt ;[186] Defined in k20mit 40509 001525'01 336 01 0 00 001370* skipn t1, ttyjfn ;[186] If have a terminal JFN, use it 40510 001526'01 334 00 0 00 000000 %ermsg (,halt) ;[186] 40511 001527'01 254 00 0 00 001533' 40512 001530'01 265 01 0 00 000257' 40513 001531'01 000000000000# 40514 001532'01 254 00 0 00 001327* 40515 000072'04 164 164 171 151 156 40516 001533'01 201 04 0 00 001477* movei t4, svstt ;[186] Point to start up terminal parameter block 40517 001534'01 120 02 0 04 000014 dmove t2, $ctmod(t4) ;[186] Load controlling terminal's mode word and error 40518 001535'01 326 03 0 00 001546' ife. t3 ;[186] Don't have it? 40519 001536'01 104 00 0 00 000107 RFMOD% ;[186] See if we can get it now 40520 001537'01 320 12 0 00 001541' %jserr (,r) ;[186] 40521 001540'01 254 00 0 00 001544' 40522 001541'01 265 01 0 00 000257' 40523 001542'01 000000000000# 40524 001543'01 254 00 0 00 000777* 40525 000104'04 164 164 171 151 156 40526 001544'01 400 03 0 00 000000 setz t3, ;[186] Worked?? Oh well, that's strange, but OK 40527 001545'01 124 02 0 04 000014 dmovem t2, $ctmod(t4) ;[186] Store what SAVTTY should have done 40528 001546'01 endif. ;[186] End case loading mode word 40529 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 23-1 K20SUB MAC 9-Jun-23 22:13 Condition local terminal for use as remote 40530 001546'01 420 02 0 00 001523' andcm t2, modoff ;[194] Shut off what we don't want 40531 001547'01 434 02 0 00 001524' or t2, modon ;[194] Or in what we want on 40532 001550'01 336 00 0 00 000000* skipn handsh ;[155] Doing handshake? 40533 001551'01 336 00 0 00 000000* skipn flow ;[155] Doing flow control? 40534 001552'01 620 02 0 00 000002 txz t2, tt%pgm ; Handshake, or no flow - don't do XON/XOFF. 40535 40536 001553'01 104 00 0 00 000110 SFMOD ; Set the bits 40537 001554'01 320 12 0 00 001556' %jserr (,r) 40538 001555'01 254 00 0 00 001561' 40539 001556'01 265 01 0 00 000257' 40540 001557'01 000000000000# 40541 001560'01 254 00 0 00 001543* 40542 000114'04 164 164 171 151 156 40543 001561'01 104 00 0 00 000217 STPAR ; ...and the other bits... 40544 001562'01 320 12 0 00 001564' %jserr (,r) 40545 001563'01 254 00 0 00 001567' 40546 001564'01 265 01 0 00 000257' 40547 001565'01 000000000000# 40548 001566'01 254 00 0 00 001560* 40549 000124'04 164 164 171 151 156 40550 40551 001567'01 201 01 0 00 777773 movx t1, .fhjob ; Turn off ^C, ^O, ^T interrupts for whole job. 40552 001570'01 200 03 0 00 000000# move t3, mycaps+1 ;[185] Load enabled capabilities 40553 001571'01 607 03 0 00 400000 txnn t3, sc%ctc ; Can only do job wide STIW if we do... 40554 001572'01 201 01 0 00 400000 movei t1, .fhslf ;[185] We don't, so process wide 40555 001573'01 104 00 0 00 000173 RTIW 40556 001574'01 320 12 0 00 001576' %jserr (,r) 40557 001575'01 254 00 0 00 001601' 40558 001576'01 265 01 0 00 000257' 40559 001577'01 000000000000# 40560 001600'01 254 00 0 00 001566* 40561 000135'04 164 164 171 151 156 40562 001601'01 202 02 0 00 001513* movem t2, tiword 40563 40564 001602'01 200 04 0 00 004142' movx t4, <1b<.ticcc>!1b<.ticco>!1b<.ticct>> 40565 001603'01 607 03 0 00 400000 txnn t3, sc%ctc 40566 001604'01 200 04 0 00 004143' movx t4, <1b<.ticco>!1b<.ticct>> 40567 001605'01 630 02 0 00 000004 tdz t2, t4 40568 001606'01 104 00 0 00 000174 STIW 40569 001607'01 320 12 0 00 001611' %jserr (,r) 40570 001610'01 254 00 0 00 001614' 40571 001611'01 265 01 0 00 000257' 40572 001612'01 000000000000# 40573 001613'01 254 00 0 00 001600* 40574 000147'04 164 164 171 151 156 40575 001614'01 263 17 0 00 000000 ret 40576 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 24 K20SUB MAC 9-Jun-23 22:13 Force a JFN to close (or try real hard to) 40577 subttl Force a JFN to close (or try real hard to) 40578 40579 ; Call: 40580 ; 40581 ; t1/ JFN to get rid of 40582 ; 40583 ; +1, JFN could not be released 40584 ; t1, t2, t3 have various errors 40585 ; 40586 ; +2, JFN no longer valid 40587 ; 40588 ; This will force just about any kind of JFN to be gotten rid 40589 ; of except for the case of a file that is still mapped. 40590 40591 extern delayf, delay ; Whether we are waiting for anything 40592 40593 001615'01 frclos: entry frclos ; Called from everywhere 40594 001615'01 265 16 0 00 004120' saveac ; Used for a copy of the JFN 40595 001616'01 553 05 0 00 000001 hrrzs q1, t1 ; Save a copy without flags 40596 001617'01 403 02 0 00 000003 setzb t2, t3 ; Let's assume everything is dandy 40597 ; Let's check a few silly cases 40598 001620'01 322 01 0 00 001450* jumpe t1, rskp ; If no JFN, then nothing to do, anyhow 40599 001621'01 306 01 0 00 377777 cain t1, .nulio ; BUT!! Never opened? 40600 001622'01 254 00 0 00 001620* retskp ; That's fine, we're done already 40601 001623'01 306 01 0 00 000101 cain t1, .priou ; How about primary output? 40602 001624'01 254 00 0 00 001622* retskp ; Don't bother closing it as it was never opened 40603 001625'01 306 01 0 00 000100 cain t1, .priin ; Somebody get mixed up? 40604 001626'01 254 00 0 00 001624* retskp ; That's OK, same deal as .priou 40605 001627'01 306 01 0 00 777777 cain t1, .cttrm ; Controlling terminal? 40606 001630'01 254 00 0 00 001626* retskp ; That won't work, either, but it's fine 40607 ; At this point, have to assume a real JFN 40608 001631'01 336 00 0 00 000000* ifmn. delayf ; Use basic delay (if we have one) 40609 001632'01 254 00 0 00 001640' 40610 001633'01 337 02 0 00 000000* skipg t2, delay ; Load and double check milliseconds 40611 001634'01 254 00 0 00 001640' anskp. ; Some kind of gubbish, don't risk it 40612 001635'01 201 01 0 00 001655' movei t1, frclo1 ; If time out, then hit the abort code 40613 001636'01 260 17 0 00 002303' call timeon ; Set the timer 40614 001637'01 550 01 0 00 000005 hrrz t1, q1 ; And reload the JFN 40615 001640'01 endif. ; Either way, hit the CLOSF% 40616 40617 001640'01 104 00 0 00 000022 CLOSF% ; Politely try to close it 40618 001641'01 320 12 0 00 001643' ifje. r ; Catch and store the error 40619 001642'01 254 00 0 00 001651' 40620 001643'01 306 01 0 00 600150 cain t1, desx1 ; Trying to close complete junk? 40621 001644'01 254 00 0 00 001651' anskp. ; Fine, pretend it's closed .. 40622 001645'01 306 01 0 00 600152 cain t1, desx3 ; No JFN anyway? 40623 001646'01 254 00 0 00 001651' anskp. ; That's fine, too; never had anything to do 40624 001647'01 200 02 0 00 000001 move t2, t1 ; Save the error for downstream processing 40625 001650'01 254 00 0 00 001653' else. ; Otherwise it worked 40626 001651'01 260 17 0 00 001673' call frclot ; Clean up any extent timers 40627 001652'01 254 00 0 00 001630* retskp ; and get out of here 40628 001653'01 endif. ; End CLOSF% interpretation 40629 40630 001653'01 306 03 0 00 600160 cain t3, clsx1 ; If error is NOT "File is not open" 40631 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 15:19 11-Jun-23 Page 24-1 K20SUB MAC 9-Jun-23 22:13 Force a JFN to close (or try real hard to) 40632 001655'01 550 01 0 00 000005 frclo1: hrrz t1, q1 ; Reload the JFN 40633 001656'01 505 01 0 00 004000 hrli t1,(cz%abt) ; Set the abort bit, clear others 40634 001657'01 104 00 0 00 000022 CLOSF% ; Try to close it, and be rude about it 40635 001660'01 320 12 0 00 001662' ifje. r ; Catch and store error 40636 001661'01 254 00 0 00 001664' 40637 001662'01 200 03 0 00 000001 move t3, t1 ; Move error to 2nd attempt AC 40638 001663'01 254 00 0 00 001666' else. ; Otherwise, being distictly rude about it worked 40639 001664'01 260 17 0 00 001673' call frclot ; Clean up any extent timers 40640 001665'01 254 00 0 00 001652* retskp ; and give a good return 40641 001666'01 endif. ; End case cz%abt analysis 40642 001666'01 endif. ; End case, other than "File is not open" 40643 40644 remark t3, clsx1 ; Might just need to release it 40645 001666'01 550 01 0 00 000005 hrrz t1, q1 ; Load the JFN 40646 001667'01 104 00 0 00 000023 RLJFN% ; So try that 40647 001670'01 320 12 0 00 001673' erjmpr frclot ; Catch error in t1, return +1 from frclot 40648 40649 001671'01 260 17 0 00 001673' call frclot ; Clean up any extent timers 40650 001672'01 254 00 0 00 001665* retskp ; Otherwise, finally won 40651 40652 001673'01 frclot: remark ; Force close timer clean up 40653 001673'01 336 00 0 00 001631* ifmn. delayf ; Did we set a timer? 40654 001674'01 254 00 0 00 001700' 40655 001675'01 337 00 0 00 001633* skipg delay ; Did we *REALLY* set a timer? 40656 001676'01 254 00 0 00 001700' anskp. ; Nope, so that's easy 40657 001677'01 260 17 0 00 002341' call timdel ; Otherwise, whack the timer 40658 001700'01 endif. ; End timer removal decisioning 40659 001700'01 263 17 0 00 000000 ret ; Returns +1, always 40660 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 25 K20SUB MAC 9-Jun-23 22:13 file transfer error post processing 40661 subttl file transfer error post processing 40662 40663 ; Come here to close a partially received file. It will be discarded 40664 ; or kept, depending on setting of ABTFIL, i.e. SET INCOMPLETE (FILE 40665 ; DISPOSTION). 40666 40667 001701'01 giveup: entry giveup ;[213] Moved from K20MIT to fix 40668 extern abtfil ;[213] Whether to discard a partial file 40669 extern local ;[213] Set if talking to a Kermit server 40670 40671 001701'01 336 00 0 00 000000* ifmn. abtfil ;[134] Do we discard or keep? ;[194] 40672 001702'01 254 00 0 00 001717' 40673 001703'01 265 01 0 00 000170' wtlog (, filjfn) ;[233] Keep. 40674 001704'01 000000000000# 40675 001705'01 777777 777753 40676 001706'01 000000000000# 40677 000160'04 111 156 143 157 155 40678 001707'01 336 00 0 00 000000* ifmn. local ;[194] If local, safe to type 40679 001710'01 254 00 0 00 001714' 40680 001711'01 200 01 0 00 000000# txmsg <[keeping partial file]> ;[194] 40681 001712'01 104 00 0 00 000076 40682 001713'01 320 12 0 00 001714' 40683 000005'03 000000000000# 40684 000165'04 133 153 145 145 160 40685 001714'01 endif. 40686 001714'01 260 17 0 00 001750' call rdclos ; Go close as much of it as we have. 40687 ; fails through to wtlog, below 40688 001715'01 254 00 0 00 001717' anskp. ;[194] Discard it if we have some problem. 40689 001716'01 263 17 0 00 000000 ret ; Closed partial file OK. 40690 001717'01 endif. ;[194] 40691 40692 001717'01 265 01 0 00 000170' wtlog (,filjfn) ;[233] Discard. 40693 001720'01 000000000000# 40694 001721'01 777777 777746 40695 001722'01 000000000000# 40696 000172'04 111 156 143 157 155 40697 001723'01 336 00 0 00 001707* ifmn. local ;[194] If local, safe to type 40698 001724'01 254 00 0 00 001730' 40699 001725'01 200 01 0 00 000000# txmsg <[discarding]> ;[194] Say what we're up to. 40700 001726'01 104 00 0 00 000076 40701 001727'01 320 12 0 00 001730' 40702 000006'03 000000000000# 40703 000200'04 133 144 151 163 143 40704 001730'01 endif. ;[194] 40705 001730'01 337 00 0 00 000000* ifmg. filjfn ; Real file? 40706 001731'01 254 00 0 00 001746' 40707 001732'01 260 17 0 00 002062' call unmapo ; Go unmap the file 40708 001733'01 600 00 0 00 000000 nop ; Don't worry if we can't. 40709 001734'01 550 01 0 00 001730* hrrz t1, filjfn ; Clear out any junk from left half. 40710 001735'01 306 01 0 00 377777 cain t1, .nulio ;[193] Just tossing it anyway? 40711 001736'01 254 00 0 00 001746' anskp. ;[193] Yes, so nothing to ditch 40712 001737'01 661 01 0 00 004000 txo t1, cz%abt ; Discarding, so cancel the file. 40713 001740'01 104 00 0 00 000022 CLOSF% ; Close it. 40714 001741'01 320 12 0 00 001743' ifje. r ;[194] 40715 001742'01 254 00 0 00 001746' k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 25-1 K20SUB MAC 9-Jun-23 22:13 file transfer error post processing 40716 001743'01 550 01 0 00 001734* hrrz t1, filjfn ;[194] On any error, 40717 001744'01 104 00 0 00 000023 RLJFN ; at least try to release the JFN. 40718 001745'01 320 12 0 00 001746' erjmpr .+1 ;[194] Catch and ignore error 40719 001746'01 endif. ;[194] End case CLOSF% recovery (we hope) 40720 001746'01 endif. ;[193] End case actual JFN to close 40721 40722 001746'01 402 00 0 00 001743* setzm filjfn ; Say we have no file. 40723 001747'01 263 17 0 00 000000 ret 40724 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 26 K20SUB MAC 9-Jun-23 22:13 Close the output file, update the FDB, etc... 40725 subttl Close the output file, update the FDB, etc... 40726 40727 ; Return +1 on error, +2 on success. 40728 40729 001750'01 rdclos: entry rdclos ;[213] Moved from k20mit 40730 001750'01 265 16 0 00 004056' saveac ;[232] Needs a few extra registers 40731 extern ebtflg ;[213] Set if doing an 8 bit file 40732 extern tbtflg ;[232] Set if forcing a 36 bit file 40733 extern itsfil ;[213] ITS binary format file 40734 40735 001751'01 337 00 0 00 001746* skipg filjfn ;[103] Output was to a real file? 40736 001752'01 254 00 0 00 002060' jrst rdclsz ;[103] No, skip all this. 40737 001753'01 260 17 0 00 002062' call unmapo ; First, clean out the PMAPing page. 40738 001754'01 263 17 0 00 000000 ret ; Oops, failed, pass it along... 40739 40740 ;[232] Calculate values FIRST 40741 40742 001755'01 120 05 0 00 004144' rdclsv: dmove q1,[exp ^d7,^d5] ;[232] Assume ASCII and its packing factor 40743 001756'01 336 00 0 00 000000* skipn itsfil ;[75] ITS binary file? 40744 001757'01 332 00 0 00 000000* skipe ebtflg ; Or eight-bit mode? 40745 001760'01 120 05 0 00 004146' dmove q1,[exp ^d8,^d4];[232] Then load that value 40746 001761'01 332 00 0 00 000000* skipe tbtflg ;[232] Forcing 36 bit mode? 40747 001762'01 120 05 0 00 004150' dmove q1,[exp ^d36,^d5];[232] Assume words and decode factor 40748 40749 001763'01 302 05 0 00 000044 caie q1, ^d36 ;[232] Forcing 36 bit bytes? 40750 001764'01 254 00 0 00 001774' ifskp. ;[232] Yes, tweak that 40751 001765'01 200 03 0 00 000012 move t3, rchr ;[232] Load number of file bytes 40752 001766'01 400 02 0 00 000000 setz t2, ;[232] No high order!!! 40753 001767'01 234 02 0 00 000006 div t2, q2 ;[232] Compute WORDS used 40754 001770'01 302 03 0 00 000000 caie t3, 0 ;[232] Evenly divided? 40755 001771'01 354 06 0 00 000002 aosa q2, t2 ;[232] No, so bump up a word, store and skip 40756 001772'01 200 06 0 00 000002 move q2, t2 ;[232] Otherwise, just store words 40757 001773'01 254 00 0 00 001775' else. ;[232] Otherwise, no calculations needed 40758 001774'01 200 06 0 00 000012 move q2, rchr ;[232] Just load the number of file bytes 40759 001775'01 endif. ;[232] End case 36 bit fix up 40760 40761 ; Now close the file. 40762 40763 001775'01 550 01 0 00 001751* rdclsa: hrrz t1, filjfn ;[193] Get the JFN. 40764 001776'01 306 01 0 00 377777 cain t1, .nulio ;[193] Tossing? 40765 001777'01 254 00 0 00 002025' jrst rdclsc ;[232] Skip all this fdb stuff 40766 002000'01 661 01 0 00 400000 txo t1, co%nrj ;[193] Set flag for not releasing JFN. 40767 002001'01 104 00 0 00 000022 CLOSF% ; Close it. 40768 002002'01 320 14 0 00 002004' %jsker ,r ; Return error. 40769 002003'01 254 00 0 00 002007' 40770 002004'01 265 01 0 00 000035' 40771 002005'01 000000000000# 40772 002006'01 254 00 0 00 001613* 40773 000203'04 103 141 156 047 164 40774 40775 ; Update FDB information with correct byte size and (word) count 40776 40777 002007'01 505 01 0 00 000011 hrli t1, .fbbyv ;[232] Set the byte size, first. 40778 002010'01 540 01 0 00 001775* hrr t1, filjfn 40779 002011'01 660 00 0 00 000001 txo, t1, k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 26-1 K20SUB MAC 9-Jun-23 22:13 Close the output file, update the FDB, etc... 40780 002012'01 400000 000000 cf%nud ;[232] Don't update disk yet. 40781 002013'01 205 02 0 00 007700 movx t2, fb%bsz ; Byte size field mask. 40782 002014'01 137 05 0 00 004152' dpb q1,[pointr(t3,fb%bsz)] ;[232] Put in proper place 40783 002015'01 104 00 0 00 000064 CHFDB% 40784 002016'01 320 14 0 00 002017' erjmps .+1 ; Keep going if we get an error. 40785 40786 002017'01 505 01 0 00 000012 hrli t1, .fbsiz ; OK, now fix FDB. Set the number of bytes 40787 002020'01 540 01 0 00 002010* hrr t1, filjfn ; Move in the JFN. 40788 002021'01 474 02 0 00 000000 seto t2, ; Change all bits in the word. 40789 002022'01 200 03 0 00 000006 move t3, q2 ;[232] The number of bytes (or words) in the file. 40790 002023'01 104 00 0 00 000064 CHFDB% ;[232] This time, update the FDB 40791 002024'01 320 14 0 00 002025' erjmps .+1 ; Keep going if we get an error. 40792 40793 ;[126] Take care of any transaction logging. 40794 40795 002025'01 333 00 0 00 002020* rdclsc: skiple filjfn ;[193] Real file? 40796 002026'01 337 01 0 00 000176* skipg t1, tlgjfn ; Transaction log? 40797 002027'01 254 00 0 00 002046' jrst rdclsd ;[232] No, skip this. 40798 40799 002030'01 120 02 0 00 000000# smsg (< Written: >) ; Yes, log this info. 40800 002031'01 260 17 0 00 000311' 40801 000007'03 000000000000# 40802 000010'03 777777 777764 40803 000207'04 040 040 040 127 162 40804 002032'01 200 02 0 00 000006 move t2, q2 ;[232] Load the byte count 40805 002033'01 201 03 0 00 000012 movei t3, ^d10 40806 002034'01 104 00 0 00 000224 NOUT 40807 002035'01 320 14 0 00 002036' erjmps .+1 40808 002036'01 201 02 0 00 000040 movei t2, .chspc ;[194] A space 40809 002037'01 104 00 0 00 000051 BOUT 40810 002040'01 320 14 0 00 002041' erjmps .+1 40811 002041'01 200 02 0 00 000005 move t2, q1 ;[232] Load byte size 40812 002042'01 104 00 0 00 000224 NOUT 40813 002043'01 320 14 0 00 002044' erjmps .+1 40814 smsg (<-bit bytes 40815 002044'01 120 02 0 00 000000# >) 40816 002045'01 260 17 0 00 000311' 40817 000011'03 000000000000# 40818 000012'03 777777 777764 40819 000212'04 055 142 151 164 040 40820 40821 40822 ; Finish closing the output file by releasing its JFN. 40823 40824 002046'01 337 00 0 00 002025* rdclsd: skipg filjfn ;[126] ;[194] 40825 002047'01 254 00 0 00 002054' ifskp. ;[194] File was open 40826 002050'01 265 01 0 00 000170' wtlog (,filjfn) ;[233] Transaction log message. 40827 002051'01 000000000000# 40828 002052'01 777777 777771 40829 002053'01 000000000000# 40830 000215'04 103 154 157 163 145 40831 002054'01 endif. ;[194] 40832 002054'01 550 01 0 00 002046* hrrz t1, filjfn ; Release the JFN. 40833 002055'01 302 01 0 00 377777 caie t1, .nulio ;[193] Nothing to release 40834 002056'01 104 00 0 00 000023 RLJFN% k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 26-2 K20SUB MAC 9-Jun-23 22:13 Close the output file, update the FDB, etc... 40835 002057'01 600 00 0 00 000000 nop 40836 40837 002060'01 402 00 0 00 002054* rdclsz: setzm filjfn ; Say we have no more file. 40838 002061'01 254 00 0 00 001672* retskp 40839 40840 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 27 K20SUB MAC 9-Jun-23 22:13 Clean up the file mapping page for an output file. 40841 subttl Clean up the file mapping page for an output file. 40842 40843 ; Returns +1 on failure, +2 on success. 40844 ; On failure, an error packet is sent, which cancels the transfer. 40845 ; 40846 ; Uses t1,t2,t3. 40847 ; 40848 ; Note that unmapping the memory page also makes it disappear. The 40849 ; next write to the page will create a fresh page with all 0's. 40850 ; 40851 ; The trick at the beginning catches the case where the page has 40852 ; already been unmapped because we just filled in the last byte. 40853 ; Since this routine is called both by the page filler (PUTCH) and by 40854 ; the file closer (RDCLOS, to catch a final partial page), we must 40855 ; worry about files that end on a page boundary. 40856 ; 40857 ; Putting an ERJMP after any instruction that references memory will 40858 ; catch "illegal memory read" errors, and will thus prevent us from 40859 ; attempting to unmap a page that has already been unmapped and still 40860 ; has not been written into. 40861 40862 002062'01 unmapo: entry unmapo ;[213] Moved from k20mit 40863 extern pagno ;[213] Present page number in file 40864 40865 002062'01 200 01 0 00 007000 move t1, maporg ;[190] Has the page been used at all? 40866 002063'01 320 14 0 00 002061* erjmps rskp ;[213] No, done. 40867 40868 002064'01 200 01 0 00 004153' movx t1, <.fhslf,,mappag> ; Yes, map them out, our fork,,mapping page 40869 002065'01 514 02 0 00 002060* hrlz t2, filjfn ;[193] file JFN,,... 40870 002066'01 312 02 0 00 004154' came t2,[ (.nulio) ] ;[193] Just dumping it? 40871 002067'01 254 00 0 00 002072' ifskp. ;[193] Yes, so just pitch the memory 40872 002070'01 260 17 0 00 002112' call unmapa ;[213] Unmap and abort 40873 002071'01 254 00 0 00 002063* retskp ;[193] Nothing further to do 40874 002072'01 endif. ;[193] End case cleaning up a NUL: transfer 40875 40876 remark ;[193] Otherwise, had a real file mapped 40877 002072'01 326 12 0 00 002075' ife. rchr ;[213] But!! Did we ever get any data? 40878 002073'01 260 17 0 00 002112' call unmapa ;[213] Unmap and abort 40879 002074'01 254 00 0 00 002071* retskp ;[213] That was easy enough; we're done 40880 002075'01 endif. ;[213] Otherwise, non-zero file 40881 40882 002075'01 540 02 0 00 000000* hrr t2, pagno ; ...page file page number. 40883 002076'01 205 03 0 00 140000 movx t3, pm%rd!pm%wr ; Read and write access. 40884 002077'01 104 00 0 00 000056 PMAP% ; Map it out. 40885 002100'01 320 14 0 00 002102' %jsker (,r) ; Can't - fail. 40886 002101'01 254 00 0 00 002105' 40887 002102'01 265 01 0 00 000035' 40888 002103'01 000000 000000 40889 002104'01 254 00 0 00 002006* 40890 40891 remark ;[193] This isn't really necessary, but.. 40892 002105'01 550 01 0 00 002065* hrrz t1,filjfn ;[193] Load file JFN 40893 002106'01 200 02 0 00 000012 move t2, rchr ;[193] Load current character count 40894 002107'01 104 00 0 00 000027 SFPTR% ;[193] Show for nosey people on SYSDPY 40895 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 15:19 11-Jun-23 Page 27-1 K20SUB MAC 9-Jun-23 22:13 Clean up the file mapping page for an output file. 40896 002111'01 254 00 0 00 002074* retskp 40897 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 28 K20SUB MAC 9-Jun-23 22:13 Abort an output page 40898 subttl Abort an output page 40899 40900 ; Used to punt a page instead mapping out to disk 40901 ; 40902 ; t1/ fork handle,,page number 40903 ; 40904 ; Typically .fhslf,,file mapping page 40905 ; 40906 ; Returns +1, always 40907 40908 002112'01 unmapa: remark t1, <.fhslf,,mappag> ;[213] Our expectations 40909 002112'01 200 02 0 00 000001 move t2, t1 ;[213] For Case IV, destination is process memory 40910 002113'01 474 01 0 00 000000 seto t1, ;[213] Which we will be whacking 40911 002114'01 400 03 0 00 000000 setz t3, ;[213] No flags, no count 40912 002115'01 104 00 0 00 000056 PMAP% ;[213] Kick the page into oblivion 40913 002116'01 320 14 0 00 002120' %jsker (,r) ;[193] Not promising, but ignore 40914 002117'01 254 00 0 00 002123' 40915 002120'01 265 01 0 00 000035' 40916 002121'01 000000000000# 40917 002122'01 254 00 0 00 002104* 40918 000217'04 103 157 165 154 144 40919 002123'01 263 17 0 00 000000 ret ;[213] And return 40920 40921 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 29 K20SUB MAC 9-Jun-23 22:13 Save and restore terminal lengths (a.k.a., heights) and widths. 40922 subttl Save and restore terminal lengths (a.k.a., heights) and widths. 40923 40924 ;[185] Begin code insertion 40925 ;[185] 40926 ;[185] This is necessary because linear dimensions in excess of seven 40927 ;[185] bits (127) can not be stored in the JFN mode word as saved by 40928 ;[185] SFMOD% and restored by STPAR% 40929 ;[185] 40930 ;[185] As these are stored in halfwords, this allows for a maximum of 40931 ;[185] 262,143 for either a width or a length. As this is two decimal 40932 ;[185] orders of magnitude larger than the highest resolution graphics 40933 ;[185] cards (4096 in 2006), we probably don't have to worry about 40934 ;[185] overflowing the field for the next decade or so. None the 40935 ;[185] less, the MTOPR% does return a FULL 36 bit word; so if we ever 40936 ;[185] overflow 18 bits, then we should change this code. 40937 ;[185] 40938 ;[185] Assumes: 40939 ;[185] 40940 ;[185] t1/ Valid terminal JFN (possibly .PRIOU) 40941 ;[185] t2/ Pointer to block to save length and width 40942 ;[185] 40943 ;[185] Preserves the register file and is completely silent about errors. 40944 40945 002124'01 savlnw: entry savlnw ;[183] Globally available 40946 002124'01 265 16 0 00 004155' saveac ;[185] Do not side-effect the register file! 40947 002125'01 120 04 0 00 000001 dmove t4, t1 ;[185] Preserve JFN, dimension block address 40948 ;[185] 40949 002126'01 104 00 0 00 000117 DVCHR% ;[185] What kind of device is this? 40950 002127'01 320 12 0 00 002122* erjmpr r ;[185] it's a bogus device! 40951 002130'01 135 03 0 00 004054' load t3, dv%typ, t2 ;[185] Get device type field 40952 002131'01 302 03 0 00 000012 caie t3, .dvtty ;[185] Is this a terminal? 40953 002132'01 263 17 0 00 000000 ret ;[185] No, better leave it alone 40954 002133'01 200 01 0 00 000004 move t1, t4 ;[185] Restore the JFN 40955 ;[185] Assume infinite (and therefore useless) 40956 002134'01 403 03 0 05 000000 setzb t3, (q1) ;[185] defaults for width and length 40957 002135'01 201 02 0 00 000032 movx t2, .morll ;[185] Return the terminal page length 40958 002136'01 104 00 0 00 000077 MTOPR% ;[185] Which may be over 127 ... 40959 002137'01 320 14 0 00 002141' erjmps .+2 ;[185] Must be a bogus JFN 40960 002140'01 506 03 0 05 000000 hrlm t3, (q1) ;[185] Save length 40961 002141'01 120 02 0 00 004171' dmove t2,[exp .morlw,0] ;[185] Return the terminal page width. 40962 002142'01 104 00 0 00 000077 MTOPR% ;[185] Which may be over 127 ... 40963 002143'01 320 14 0 00 002145' erjmps .+2 ;[185] Must be a bogus JFN 40964 002144'01 542 03 0 05 000000 hrrm t3, (q1) ;[185] Save length 40965 002145'01 263 17 0 00 000000 ret ;[185] Done, restore register file 40966 40967 002146'01 rstlnw: entry rstlnw ;[194] Globally available 40968 002146'01 265 16 0 00 004155' saveac ;[185] Do not side-effect the register file! 40969 002147'01 120 04 0 00 000001 dmove t4, t1 ;[185] Preserve JFN, dimension block address 40970 ;[185] 40971 002150'01 104 00 0 00 000117 DVCHR% ;[185] What kind of device is this? 40972 002151'01 320 12 0 00 002127* erjmpr r ;[185] it's a bogus device! 40973 002152'01 135 03 0 00 004054' load t3, dv%typ, t2 ;[185] Get device type field 40974 002153'01 302 03 0 00 000012 caie t3, .dvtty ;[185] Is this a terminal? 40975 002154'01 263 17 0 00 000000 ret ;[185] No, better leave it alone 40976 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 15:19 11-Jun-23 Page 29-1 K20SUB MAC 9-Jun-23 22:13 Save and restore terminal lengths (a.k.a., heights) and widths. 40977 ;[185] 40978 002156'01 201 02 0 00 000033 movx t2, .mosll ;[185] Set the terminal page length. 40979 002157'01 554 03 0 05 000000 hlrz t3, (q1) ;[185] Load old width 40980 002160'01 302 03 0 00 000000 caie t3, 0 ;[185] Ever get anything? If not, leave 40981 002161'01 104 00 0 00 000077 MTOPR% ;[185] it alone; otherwise restore it 40982 002162'01 320 14 0 00 002163' erjmps .+1 ;[185] Ignore errors, preserve JFN 40983 002163'01 201 02 0 00 000031 movx t2, .moslw ;[185] Set the terminal page width. 40984 002164'01 550 03 0 05 000000 hrrz t3, (q1) ;[185] Load old width 40985 002165'01 302 03 0 00 000000 caie t3, 0 ;[185] Ever get anything? If not, leave 40986 002166'01 104 00 0 00 000077 MTOPR% ;[185] it alone; otherwise restore it 40987 002167'01 320 14 0 00 002170' erjmps .+1 ;[185] Ignore errors, preserve JFN 40988 002170'01 263 17 0 00 000000 ret ;[185] Done, restore register file 40989 40990 ;[185] End code insertion 40991 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 30 K20SUB MAC 9-Jun-23 22:13 interrupt storage (pure) 40992 subttl interrupt storage (pure) 40993 40994 extern frtrap ;[186] Is in K20NET 40995 emacro < 40996 extern sitrap ;[203] .sigio check is in K20MAC 40997 > 40998 40999 002171'01 000000000000# levtab: pc1 41000 002172'01 000000000000# pc2 41001 002173'01 000000000000# pc3 41002 41003 000000 chntab: phase 0 41004 000000 000001 002357' tmchan: 1,,tmtrap ;[194] ; Timer trap on channel 0, priority 1. 41005 000001 000001 002724' ccchan: 1,,cctrap ; ^C trap on channel 1, same priority. 41006 000002 000002 002741' cachan: 2,,catrap ; ^A trap on channel 2, lower priority. 41007 000003 000002 003173' cxchan: 2,,cxtrap ; ^X trap on channel 3... 41008 000004 000002 003207' czchan: 2,,cztrap ; ^Z trap .... 4 41009 000005 000002 003220' cmchan: 2,,cmtrap ; ^M trap .... 5 41010 000006 block 1 ; .ICAOV==:6, not trapping arithmetic overflow 41011 000007 block 1 ; .ICFOV==:7, not trapping floating overflow 41012 000010 block 1 ; ^d8, Reserved for Digital 41013 000011 block 1 ; .ICPOV==:9, not trapping PDL overflow 41014 000012 block 1 ; .ICEOF==:10, not trapping End-of-File 41015 000013 block 1 ; .ICDAE==:11, not trapping, Data Error 41016 000014 block 1 ; .ICQTA==:12, not trapping Quota/Disk Exceeded 41017 000015 block 1 ; ^d13, Reserved for Digital 41018 000016 block 1 ; .ICTOD==:14, not trapping Time of Day (not implemented) 41019 000017 block 1 ; .ICILI==:15, not trapping Illegal Instruction 41020 000020 block 1 ; .ICIRD==:16, not trapping Illegal Read 41021 000021 block 1 ; .ICIWR==:17, not trapping Illegal Write 41022 000022 block 1 ; .ICIEX==:18, not trapping Illegal Execute (TENEX only) 41023 emacro < 41024 sigchn: 3,,sitrap ;[203] .ICIFT==:19, multiplexed with .SIGIO 41025 >;;emacro 41026 nmacro < block 1 ; .ICIFT==:19, Inferior Fork Termination 41027 000023 >;;nmacro 41028 000024 block 1 ; .ICMSE==:20, not trapping machine resources exhausted 41029 000025 block 1 ; .ICTRU==:21, not trapping to user (?) 41030 000026 block 1 ; .ICNXP==:22, not trapping nonexistent page referenced 41031 000027 000002 003230' cpchan: 2,,cptrap ; ^P trap on channel 23 41032 000030 000003 000000* frkchn: 3,,frtrap ;[186] Fork interrupt on channel 24 41033 000031 000003 003244' cychan: 3,,cytrap ;[187] ^Y trap on channel 25, level 3 41034 000032 000003 000000* dnchan: 3,,dntrap ;[218] For DECnet connection trap 41035 000033 block ^d36-. 41036 002240'01 dephase 41037 41038 ifn <<.-^d36>-chntab>,< ;;Did we get this right? 41039 printx Channel definitions are wrong 41040 end ;;Just stop and get this fixed 41041 > 41042 intern frkchn ;[186] Used by K20NET 41043 41044 remark bits for certain channels 41045 41046 004000 frkchb==:1b ;[186] Bit for fork channel k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 30-1 K20SUB MAC 9-Jun-23 22:13 interrupt storage (pure) 41047 400000 000000 timchb==:1b ;[186] Bit for TIMER% channel 41048 emacro < 41049 sigchb==:1b ;[203] Bit for macro reparse issues channel 41050 >;;emacro 41051 41052 001000 dnchb==:1b ;[218] Bit for DECnet connection channel 41053 extern dntrap ;[218] DECnet connection handler is in k20net 41054 41055 ;[218] DECnet connect interrupt field (ALL OTHERS MUST BE OFF!!!) 41056 032776 776000 dncfld==:fld(dnchan,mo%cdn)!fld(.mocia,mo%ina)!fld(.mocia,mo%dav) 41057 41058 ;[218] DECnet disconnect interrupt field (EVERYTHING MUST BE OFF!!!) 41059 776776 776000 dndfld==:fld(.mocia,mo%cdn)!fld(.mocia,mo%ina)!fld(.mocia,mo%dav) 41060 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 31 K20SUB MAC 9-Jun-23 22:13 timeit -- Creates a TIMER% to pop after an elapsed time 41061 subttl timeit -- Creates a TIMER% to pop after an elapsed time 41062 41063 ; Set a timer. Call with t1/ Address of where to go upon timout. 41064 ; 41065 ;[212] All timeouts are pre-computed to milliseconds; bums the imuli 41066 ; and allows more granular control which is good for testing 41067 ; 41068 ;[218] Can not pass .infin in t2 (with a hrloi t2, 377777, for 41069 ; example) because the math in .TIMBF (just after TIMDL2: in 41070 ; TIMER.MAC) doesn't come out correctly. Use .TIMAL, instead as 41071 ; this will remove all timers. 41072 ; 41073 ; The fact that it removes a job run time limit need not bother 41074 ; Kermit as Kermit never sets this, it is fork unique and is set 41075 ; directly by BATCON on job creation before Kermit is anywhere 41076 ; near in user memory. 41077 ; 41078 ; N.B., Note the order of the TIMER% and AIC% calls 41079 41080 002240'01 400000 000005 alltim: xwd .fhslf, .timal ;[218] Remove ALL timers for this fork 41081 002241'01 000000 000000 0 ;[219] Just in case it wants this 41082 41083 extern adjtim, ldav ; Moved to K20TIM 41084 41085 002242'01 timeit: entry timeit ; Inform LINK of our location and necessaries 41086 extern stimou, intstk, intpc, timerx, curtim 41087 002242'01 337 00 0 00 000000* skipg stimou ;[43] Doing timeouts? 41088 002243'01 263 17 0 00 000000 ret ;[43] No, skip this. 41089 002244'01 262 17 0 00 000002 pop p, t2 ; Get the return address off the stack. 41090 002245'01 202 17 0 00 000000* movem p, intstk ; Save the stack pointer 41091 002246'01 261 17 0 00 000002 push p, t2 ; Put the return address back 41092 002247'01 540 02 0 00 000001 hrr t2, t1 ; Make interrupt PC point to time out addr. 41093 002250'01 202 02 0 00 000000* movem t2, intpc ; Save the PC. 41094 002251'01 120 01 0 00 002240' dmove t1, alltim ;[218] Remove any previous TIMER%'s, FIRST 41095 002252'01 104 00 0 00 000522 TIMER 41096 002253'01 320 12 0 00 002255' ifje. r ;[194] Catch and ignore error 41097 002254'01 254 00 0 00 002257' 41098 002255'01 202 01 0 00 000000# movem t1, ltimde ;[194] Store last timer delete error 41099 002256'01 350 00 0 00 000000* aos timerx ; Count any error. 41100 002257'01 endif. ;[194] 41101 41102 remark ;[218] THEN set the new timer 41103 002257'01 400 01 0 00 000000 setz t1, ;[130] Get 1-minute load average. 41104 002260'01 260 17 0 00 000000* call ldav ;[130] 41105 002261'01 200 02 0 00 002242* move t2, stimou ;[130] Minimum acceptable. 41106 002262'01 260 17 0 00 000000* call adjtim ;[128] Adjust based on load average. 41107 002263'01 202 02 0 00 000000* movem t2, curtim ;[131] Remember this for reporting. 41108 002264'01 200 01 0 00 004173' move t1, [ .fhslf,,.timel ] ; Our process and time from now. 41109 002265'01 201 03 0 00 000000 movx t3, tmchan ;[218] Load timer channel 41110 002266'01 104 00 0 00 000522 TIMER 41111 002267'01 320 12 0 00 002271' ifje. r ;[194] Catch and ignore error 41112 002270'01 254 00 0 00 002274' 41113 002271'01 202 01 0 00 000000# movem t1, ltimcr ;[194] Store last timer creation error 41114 002272'01 350 00 0 00 002256* aos timerx ; If we get an error, count it. 41115 002273'01 254 00 0 00 002302' else. ;[218] Otherwise, worked k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 31-1 K20SUB MAC 9-Jun-23 22:13 timeit -- Creates a TIMER% to pop after an elapsed time 41116 remark ;[218] So safe to turn on the channel 41117 dmove t1, [ .fhslf ;[218] This fork 41118 002274'01 120 01 0 00 004174' timchb ] ;[218] TIMER% channel 41119 002275'01 104 00 0 00 000131 AIC ; Turn the channel on 41120 002276'01 320 12 0 00 002300' ifje. r ;[194] Catch and ignore error 41121 002277'01 254 00 0 00 002302' 41122 002300'01 202 01 0 00 000000# movem t1, laicer ;[194] However, remember it 41123 002301'01 350 00 0 00 000000# aos aicx ;[194] and count it 41124 002302'01 endif. ;[218] 41125 002302'01 endif. ;[194] 41126 41127 002302'01 263 17 0 00 000000 ret 41128 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 32 K20SUB MAC 9-Jun-23 22:13 timeon - Create a TIMER% to pop after an elapsed time 41129 subttl timeon - Create a TIMER% to pop after an elapsed time 41130 41131 ; Set a timer based in input parameter 41132 ; 41133 ; Call: 41134 ; 41135 ; t1/ Address of where to go upon timout. 41136 ; t2/ Time in milliseconds to wait 41137 ; 41138 ; N.B., All timeouts are pre-computed to milliseconds and these are 41139 ; not load average adjusted because that is the responsibility of 41140 ; the caller. The reason for this is, if you are waiting on a 41141 ; network interupt, then the remote system is the major source of 41142 ; delay, not the local one. 41143 ; 41144 ; Note the order of the TIMER% and AIC% calls 41145 41146 002303'01 timeon: entry timeon ; Inform LINK of our location and necessaries 41147 002303'01 200 04 0 00 000002 move t4, t2 ;[218] Let's just get the wait out of the way 41148 002304'01 262 17 0 00 000002 pop p, t2 ; Get the return address off the stack. 41149 002305'01 202 17 0 00 002245* movem p, intstk ; Save the stack pointer 41150 002306'01 261 17 0 00 000002 push p, t2 ; Put the return address back 41151 002307'01 540 02 0 00 000001 hrr t2, t1 ; Make interrupt PC point to time out addr. 41152 002310'01 202 02 0 00 002250* movem t2, intpc ; Save the PC. 41153 002311'01 120 01 0 00 002240' dmove t1, alltim ;[218] Remove any pending timers, FIRST 41154 002312'01 104 00 0 00 000522 TIMER 41155 002313'01 320 12 0 00 002315' ifje. r ;[194] Catch and ignore error 41156 002314'01 254 00 0 00 002317' 41157 002315'01 202 01 0 00 000000# movem t1, ltimde ;[194] Store last timer delete error 41158 002316'01 350 00 0 00 002272* aos timerx ; Count any error. 41159 002317'01 endif. ;[194] 41160 41161 remark ;[218] THEN set the new timer 41162 002317'01 200 01 0 00 004173' move t1, [.fhslf,,.timel] ; Our process and time from now. 41163 002320'01 200 02 0 00 000004 move t2, t4 ;[218] Load hard wall time 41164 002321'01 201 03 0 00 000000 movx t3, tmchan ;[218] Load timer channel 41165 002322'01 104 00 0 00 000522 TIMER% 41166 002323'01 320 12 0 00 002325' ifje. r ;[194] Catch and ignore error 41167 002324'01 254 00 0 00 002330' 41168 002325'01 202 01 0 00 000000# movem t1, ltimcr ;[194] Store last timer creation error 41169 002326'01 350 00 0 00 002316* aos timerx ; If we get an error, count it. 41170 002327'01 254 00 0 00 002336' else. ;[218] Otherwise, worked 41171 remark ;[218] So safe to turn on the channel 41172 dmove t1, [ .fhslf ;[218] This fork 41173 002330'01 120 01 0 00 004174' timchb ] ;[218] TIMER% channel 41174 002331'01 104 00 0 00 000131 AIC% ; Turn the channel on 41175 002332'01 320 12 0 00 002334' ifje. r ;[194] Catch and ignore error 41176 002333'01 254 00 0 00 002336' 41177 002334'01 202 01 0 00 000000# movem t1, laicer ;[194] However, remember it 41178 002335'01 350 00 0 00 000000# aos aicx ;[194] and count it 41179 002336'01 endif. ;[194] 41180 002336'01 endif. ;[194] 41181 41182 002336'01 263 17 0 00 000000 ret 41183 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 33 K20SUB MAC 9-Jun-23 22:13 TIMOFF - Shut off TIMER channel, clear all timers 41184 subttl TIMOFF - Shut off TIMER channel, clear all timers 41185 41186 ; N.B., Note order of DIC% and TIMER%!! 41187 41188 002337'01 timoff: entry timoff ;[194] Identify our location to LINK 41189 002337'01 337 00 0 00 002261* skipg stimou ;[43] Doing timeouts? 41190 002340'01 263 17 0 00 000000 ret ;[43] No, skip this. 41191 41192 002341'01 timdel: entry timdel ;[218] Force a timer delete 41193 002341'01 265 16 0 00 004176' saveac ; Yes, save these ACs. 41194 dmove t1, [ .fhslf ;[218] This fork 41195 002342'01 120 01 0 00 004174' timchb ] ;[218] TIMER% channel 41196 002343'01 104 00 0 00 000133 DIC% ;[194] Shut off before timer can pop! 41197 002344'01 320 12 0 00 002346' ifje. r ;[194] Catch and ignore error 41198 002345'01 254 00 0 00 002350' 41199 002346'01 202 01 0 00 000000# movem t1, ldicer ;[194] However, remember it 41200 002347'01 350 00 0 00 000000# aos dicx ;[194] and count it 41201 002350'01 endif. ;[194] 41202 002350'01 120 01 0 00 002240' dmove t1, alltim ;[218] Whack any and all pending timers 41203 002351'01 104 00 0 00 000522 TIMER 41204 002352'01 320 12 0 00 002354' ifje. r ;[194] Catch and ignore error 41205 002353'01 254 00 0 00 002356' 41206 002354'01 202 01 0 00 000000# movem t1, ltimde ;[194] Store last timer delete error 41207 002355'01 350 00 0 00 002326* aos timerx ; Count any error. 41208 002356'01 endif. ;[194] 41209 41210 002356'01 263 17 0 00 000000 ret 41211 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 34 K20SUB MAC 9-Jun-23 22:13 caltcb -- Calculate TIMER% channel bit 41212 subttl caltcb -- Calculate TIMER% channel bit 41213 41214 repeat 0,< ;[218] 41215 41216 ; Returns the right bit for the timer channel based on the channel 41217 ; number (which is filled in by LINK) in t2, ready for AIC%/DIC% 41218 41219 Replaced: 41220 41221 skipn t2, tmcbit ; Load the TIMER channel bit 41222 call caltcb ; Unless we don't know it, yet 41223 41224 With: 41225 dmove t1, [ .fhslf ;[218] This fork 41226 timchb ] ;[218] TIMER% channel 41227 41228 caltcb: skipe t2, tmcbit ; Did we already do this? 41229 ret ; Yes, get out of here 41230 41231 saveac ; Save any fork handle 41232 move t1, tmcnum ; Pick up TIMER% channel number 41233 move t2, bitnum(t1) ; Convert to a bit, quickly 41234 movem t2, tmcbit ; Save for later reuse 41235 ret ; Finally done 41236 41237 tmcnum: tmchan ; Timer channel number 41238 41239 thisbt==1b0 ; Start out at bit zero for channel 0 41240 41241 bitnum: intern bitnum ; Also used in k20net 41242 xlist ; No need to see all that blat 41243 repeat ^d36, < ;;Iterate through every possible channel 41244 thisbt ;;Drop in this channel's bit 41245 thisbt== ;;Shift over a bit position 41246 > 41247 list ; Turn listing back on 41248 >;[218] 41249 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 35 K20SUB MAC 9-Jun-23 22:13 TMTRAP -- Timer interrupt handler. 41250 subttl TMTRAP -- Timer interrupt handler. 41251 41252 ; N.B., Using a hrli to break out of a JSYS may not a good idea as it 41253 ; blows away all the flags which somebody might want 41254 41255 002357'01 tmtrap: entry tmtrap ; Identify our location for LINK 41256 extern ntimou ; And our additional necessaries 41257 002357'01 261 17 0 00 000001 push p, t1 ; Get a work AC. 41258 002360'01 200 01 0 00 002310* move t1, intpc ; Get the PC we want. 41259 002361'01 661 01 0 00 010000 txo t1, pc%usr ;[194] ;[132] Set user mode to escape from any jsys. 41260 002362'01 202 01 0 00 000000# movem t1, pc1 ; Restore as if we came from there. 41261 002363'01 262 17 0 00 000001 pop p, t1 41262 002364'01 200 17 0 00 002305* move p, intstk ; Pop any junk off the stack. 41263 002365'01 350 00 0 00 000000* aos ntimou ; Count the timeout. 41264 002366'01 104 00 0 00 000136 DEBRK 41265 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 36 K20SUB MAC 9-Jun-23 22:13 Initialize the Priority Interrupt system. 41266 subttl Initialize the Priority Interrupt system. 41267 41268 002367'01 pinit: entry pinit ;[186] Called at start up 41269 dmove t1, [ .fhslf ; This fork. 41270 002367'01 120 01 0 00 004206' levtab,,chntab] ; Say where our tables are. 41271 002370'01 104 00 0 00 000125 SIR% ;[186] Set Interrupt routines 41272 002371'01 320 12 0 00 002373' %jserr(,) ;[186] Or not 41273 002372'01 254 00 0 00 002376' 41274 002373'01 265 01 0 00 000257' 41275 002374'01 000000 000000 41276 002375'01 254 00 0 00 002376' 41277 002376'01 104 00 0 00 000126 EIR% ; Enable the interrupt system. 41278 002377'01 320 12 0 00 002401' %jserr(,) ;[186] Or not 41279 002400'01 254 00 0 00 002404' 41280 002401'01 265 01 0 00 000257' 41281 002402'01 000000 000000 41282 002403'01 254 00 0 00 002404' 41283 002404'01 263 17 0 00 000000 ret 41284 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 37 K20SUB MAC 9-Jun-23 22:13 Enable for Control-C trapping 41285 subttl Enable for Control-C trapping 41286 41287 ; Turn Control-C trap on. Sets things up so that ^C will return control 41288 ; to the instruction FOLLOWING the the call to this routine, with the 41289 ; stack fixed up appropriately, e.g. 41290 ; 41291 ; call ccon ; Turn on ^C trap 41292 ; jrst foo ; What to do if ^C is typed. 41293 ; move x, y ; Execute this after the call to CCON. 41294 ; 41295 ; Returns +2 always. 41296 ; 41297 ;[187] Rewritten to work under batch and not do so many RPCAP%'s and EPCAP%'s 41298 41299 000002 $ccn==2 ; Number of ^C's to get out of ^C trap. 41300 41301 002405'01 ccon: entry ccon 41302 extern ccfail ;[187] 41303 41304 002405'01 335 00 0 00 000000* ifmge. ccfail ;[187] Ever tried this? 41305 002406'01 254 00 0 00 002411' 41306 002407'01 200 03 0 00 000536* move t3, capas ;[187] We have, so load what we got 41307 002410'01 254 00 0 00 002450' jrst ccon2 ;[187] And just go use it 41308 002411'01 endif. ;[187] End case first time through 41309 41310 002411'01 332 03 0 00 002407* skipe t3, capas ;[187] Did we ever look? 41311 002412'01 254 00 0 00 002450' jrst ccon2 ;[187] We did, use what we got 41312 41313 002413'01 201 01 0 00 400000 movei t1, .fhslf ; Read current process capabilities. 41314 002414'01 104 00 0 00 000150 RPCAP% ;[187] Let's have a peek at what we have 41315 002415'01 320 14 0 00 002417' ifje. s ;[187] Catch and suppress error 41316 002416'01 254 00 0 00 002420' 41317 002417'01 120 02 0 00 000554* dmove t2, mycaps ;[187] Use what we first got 41318 002420'01 endif. ;[187] And carry on! 41319 41320 002420'01 336 00 0 00 000000# ifmn. ;[187] Batch frob? 41321 002421'01 254 00 0 00 002427' 41322 002422'01 621 03 0 00 400000 txz t3, sc%ctc ;[187] Say we don't have ^C turned on 41323 002423'01 621 02 0 00 400000 txz t2, sc%ctc ;[187] And that we can't get it, either 41324 002424'01 350 00 0 00 002405* aos ccfail ;[187] Flag other code to not try again 41325 002425'01 202 03 0 00 002411* movem t3, capas ;[187] Stomp the process enabled capas 41326 002426'01 254 00 0 00 002450' jrst ccon2 ;[187] Skip the rest of this cruft 41327 002427'01 endif. ;[187] End batch job case 41328 ;[187] Normal timesharing job from here 41329 002427'01 325 02 0 00 002441' ifxn. t2, sc%ctc ;[187] OK, so can we turn it on? 41330 002430'01 321 03 0 00 002441' andxe. t3, sc%ctc ;[187] And is it currently *NOT* on? 41331 002431'01 661 03 0 00 400000 txo t3, sc%ctc ;[187] So try to turn it on 41332 002432'01 104 00 0 00 000151 EPCAP% ;[187] and do the request 41333 002433'01 320 14 0 00 002434' erjmps .+1 ;[187] Catch and suppress error 41334 002434'01 104 00 0 00 000150 RPCAP% ;[187] Read back; monitor may silently ignore 41335 002435'01 320 14 0 00 002437' ifje. s ;[187] Catch and suppress error 41336 002436'01 254 00 0 00 002441' 41337 002437'01 120 02 0 00 002417* dmove t2, mycaps ;[187] Use what we first got 41338 002440'01 621 03 0 00 400000 txz t3, sc%ctc ;[187] Don't chance it being on 41339 002441'01 endif. ;[187] And get on with it k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 37-1 K20SUB MAC 9-Jun-23 22:13 Enable for Control-C trapping 41340 002441'01 endif. ;[187] End case possible enabling attempt 41341 41342 002441'01 202 03 0 00 002425* movem t3, capas ; Save them. 41343 002442'01 321 03 0 00 002450' ifxe. t3, sc%ctc ;[187] Did it NOT come on?? 41344 002443'01 352 00 0 00 002424* aose ccfail ;[187] Only complain one single time 41345 002444'01 254 00 0 00 002450' anskp. ;[187] Already tried 41346 txmsg <% Kermit-20: Can't enable ^C capability--use ^G instead 41347 002445'01 200 01 0 00 000000# > ;[187] Complain and advise 41348 002446'01 104 00 0 00 000076 41349 002447'01 320 12 0 00 002450' 41350 000013'03 000000000000# 41351 000225'04 045 040 113 145 162 41352 41353 002450'01 endif. ;[187] End case post enable analysis 41354 41355 002450'01 201 01 0 00 000002 ccon2: movei t1, $ccn ; Initialize ^C count to this. 41356 002451'01 202 01 0 00 000000# movem t1, ccn 41357 002452'01 202 17 0 00 000000# movem p, psave ;[27] Save stack pointer. 41358 002453'01 200 01 0 17 000000 move t1, (p) ;[27] And what it points to... 41359 002454'01 202 01 0 00 000000# movem t1, psave2 ;[27] 41360 dmove t1, [ .fhslf ;[187] Now, for this fork, 41361 002455'01 120 01 0 00 004210' 1b ] ;[187] activate channel 1 (^C channel) 41362 002456'01 104 00 0 00 000131 AIC ; ... 41363 002457'01 320 12 0 00 002461' %jserr (,) ;[187] 41364 002460'01 254 00 0 00 002464' 41365 002461'01 265 01 0 00 000257' 41366 002462'01 000000000000# 41367 002463'01 254 00 0 00 002464' 41368 000241'04 125 156 141 142 154 41369 002464'01 200 01 0 00 004212' move t1, [.ticcc,,1] ;[187] Let's assume we have ^C. 41370 002465'01 607 03 0 00 400000 txnn t3, sc%ctc ;[187] Unless we don't... 41371 002466'01 505 01 0 00 000007 hrli t1,.ticcg ;[187] Something familiar, ding! 41372 002467'01 556 01 0 00 000000# hlrzm t1, ccichr ;[219] Store whatever we picked 41373 002470'01 104 00 0 00 000137 ATI 41374 002471'01 320 12 0 00 002473' %jserr (,) ;[187] 41375 002472'01 254 00 0 00 002476' 41376 002473'01 265 01 0 00 000257' 41377 002474'01 000000000000# 41378 002475'01 254 00 0 00 002476' 41379 000253'04 125 156 141 142 154 41380 002476'01 254 00 0 00 002111* retskp 41381 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 38 K20SUB MAC 9-Jun-23 22:13 Turn Control-C trap off 41382 subttl Turn Control-C trap off 41383 41384 002477'01 ccoff: entry ccoff ;[186] 41385 extern srvflg ;[186] 41386 41387 002477'01 332 00 0 00 000143* skipe srvflg ;[81] Being a server? 41388 002500'01 263 17 0 00 000000 ret ;[81] Yes, so don't turn off the ^C trap. 41389 41390 ; Entry point for REALLY turning it off, even if server. 41391 41392 002501'01 ccoff2: entry ccoff2 ;[186] 41393 002501'01 265 16 0 00 004213' saveac ; Save these. 41394 002502'01 402 00 0 00 000000# setzm ccn ; Put ^C count back to 0. 41395 dmove t1, [ .fhslf ;[186] This fork. 41396 002503'01 120 01 0 00 004210' 1b ] ;[186] Deactivate channel 1. 41397 002504'01 104 00 0 00 000133 DIC 41398 002505'01 320 12 0 00 002507' %jserr (,) ;[187] 41399 002506'01 254 00 0 00 002512' 41400 002507'01 265 01 0 00 000257' 41401 002510'01 000000000000# 41402 002511'01 254 00 0 00 002512' 41403 000265'04 125 156 141 142 154 41404 41405 remark ;[219] Take the character off the channel 41406 002512'01 200 01 0 00 000000# move t1, ccichr ;[219] Load the interrupt character we used 41407 002513'01 104 00 0 00 000140 DTI ;[219] Pull it 41408 002514'01 320 12 0 00 002516' %jserr (,) ;[187] 41409 002515'01 254 00 0 00 002521' 41410 002516'01 265 01 0 00 000257' 41411 002517'01 000000000000# 41412 002520'01 254 00 0 00 002521' 41413 000277'04 125 156 141 142 154 41414 41415 002521'01 200 04 0 00 002441* ccoff3: move t4, capas ; Get capabilities. 41416 002522'01 200 01 0 00 004225' move t1, [rt%dim!.fhjob] ;[219] This job, both masks 41417 002523'01 607 04 0 00 400000 txnn t4, sc%ctc ;[219] But!! Could we have set job wide? 41418 002524'01 200 01 0 00 004226' move t1, [rt%dim!.fhslf] ;[219] This process, both masks 41419 002525'01 104 00 0 00 000173 RTIW% ;[187] Get the current interrupt mask 41420 002526'01 320 12 0 00 002530' %jserr (, r) ;[187] 41421 002527'01 254 00 0 00 002533' 41422 002530'01 265 01 0 00 000257' 41423 002531'01 000000000000# 41424 002532'01 254 00 0 00 002151* 41425 000311'04 125 156 141 142 154 41426 41427 002533'01 325 04 0 00 002537' ifxn. t4, sc%ctc ;[187] Did we have ^C? 41428 002534'01 621 02 0 00 040000 txz t2, 1b<.chcnc> ; for ^C... (^C = ASCII 3 = bit 3) 41429 002535'01 621 03 0 00 040000 txz t3, 1b<.chcnc> ;[219] Differed ^C 41430 002536'01 254 00 0 00 002541' else. ;[187] No, so must be on ^G 41431 002537'01 621 02 0 00 002000 txz t2, 1b<.chbel> ;[187] for ^G... (^G = ASCII 7 = bit 7) 41432 002540'01 621 03 0 00 002000 txz t3, 1b<.chbel> ;[219] Differed ^G 41433 002541'01 endif. ;[187] Finally have something to set 41434 002541'01 104 00 0 00 000174 STIW% ;[187] Finally fix up the interrupt mask 41435 002542'01 320 12 0 00 002544' %jserr (, r) ;[187] 41436 002543'01 254 00 0 00 002547' k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 38-1 K20SUB MAC 9-Jun-23 22:13 Turn Control-C trap off 41437 002544'01 265 01 0 00 000257' 41438 002545'01 000000000000# 41439 002546'01 254 00 0 00 002532* 41440 000322'04 125 156 141 142 154 41441 002547'01 263 17 0 00 000000 ret 41442 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 39 K20SUB MAC 9-Jun-23 22:13 Turn on ^A, ^X, and ^Z interrupts 41443 subttl Turn on ^A, ^X, and ^Z interrupts 41444 41445 ;[59] ^A, ^X, and ^Z interrupt control added as part of edit 59. 41446 41447 002550'01 caxzon: entry caxzon ;[186] 41448 extern caseen, cxseen ;[186] 41449 41450 002550'01 402 00 0 00 000000* setzm cxseen ; Say we haven't seen a ^X yet, 41451 002551'01 402 00 0 00 000000* setzm czseen ; nor a ^Z. 41452 002552'01 402 00 0 00 000000* setzm caseen ; ... 41453 002553'01 336 00 0 00 001723* skipn local ; Only do this if local! 41454 002554'01 263 17 0 00 000000 ret 41455 dmove t1, [ .fhslf ;[194] This fork. 41456 002555'01 120 01 0 00 004227' 1b!1b!1b] ;[194] Turn on the channels. 41457 002556'01 104 00 0 00 000131 AIC% 41458 002557'01 200 01 0 00 004231' move t1, [.ticca,,cachan] ; Put ^A on its channel. 41459 002560'01 104 00 0 00 000137 ATI% 41460 002561'01 200 01 0 00 004232' move t1, [.ticcx,,cxchan] ; Put ^X on its channel. 41461 002562'01 104 00 0 00 000137 ATI% 41462 002563'01 200 01 0 00 004233' move t1, [.ticcz,,czchan] ; And ^Z on its. 41463 002564'01 104 00 0 00 000137 ATI% 41464 002565'01 263 17 0 00 000000 ret 41465 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 40 K20SUB MAC 9-Jun-23 22:13 Turn ^M, ^P interrupts on 41466 subttl Turn ^M, ^P interrupts on 41467 41468 002566'01 cmpon: entry cmpon ;[186] 41469 extern cmseen ;[186] 41470 extern cpseen ;[186] 41471 41472 dmove t1, [ .fhslf ;[194] This fork. 41473 002566'01 120 01 0 00 004234' 1b!1b ] ;[194] These channels. 41474 002567'01 104 00 0 00 000131 AIC ; Activate interrupt system. 41475 002570'01 200 01 0 00 004236' move t1, [.ticcm,,cmchan] ; Assign ^M to this channel. 41476 002571'01 104 00 0 00 000137 ATI 41477 002572'01 402 00 0 00 000000* setzm cmseen 41478 002573'01 200 01 0 00 004237' move t1, [.ticcp,,cpchan] ; Assign ^P to this one. 41479 002574'01 104 00 0 00 000137 ATI 41480 002575'01 402 00 0 00 000000* setzm cpseen 41481 002576'01 263 17 0 00 000000 ret 41482 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 41 K20SUB MAC 9-Jun-23 22:13 Turn ^Y interrupts on 41483 subttl Turn ^Y interrupts on 41484 41485 ;[211] All clrbuf enhancements 41486 41487 002577'01 cyon: entry cyon ; World callable 41488 41489 002577'01 402 00 0 00 000000# setzm cyseen ; Haven't seen a Control-Y, yet 41490 dmove t1, [ .fhslf ; This fork and 41491 002600'01 120 01 0 00 004240' 1b ] ; this channel 41492 002601'01 104 00 0 00 000131 AIC% ; Activate interrupt channel 41493 002602'01 320 12 0 00 002604' %jserr (,r) ; Failed it 41494 002603'01 254 00 0 00 002607' 41495 002604'01 265 01 0 00 000257' 41496 002605'01 000000 000000 41497 002606'01 254 00 0 00 002546* 41498 002607'01 200 01 0 00 004242' move t1, [.ticcy,,cychan] 41499 002610'01 104 00 0 00 000137 ATI% ; Assign ^Y to this channel. 41500 002611'01 320 12 0 00 002613' %jserr (,r) ; Failed that 41501 002612'01 254 00 0 00 002616' 41502 002613'01 265 01 0 00 000257' 41503 002614'01 000000 000000 41504 002615'01 254 00 0 00 002606* 41505 41506 002616'01 254 00 0 00 002476* retskp ; Return success 41507 41508 ;[211] End clrbuf enhancement 41509 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 42 K20SUB MAC 9-Jun-23 22:13 Turn off ^A,^X,^Z interrupts 41510 subttl Turn off ^A,^X,^Z interrupts 41511 41512 002617'01 caxzof: entry caxzof ;[186] 41513 41514 002617'01 402 00 0 00 002550* setzm cxseen ; Turn off the flags 41515 002620'01 402 00 0 00 002551* setzm czseen ; ... 41516 002621'01 402 00 0 00 002552* setzm caseen ; ... 41517 002622'01 336 00 0 00 002553* skipn local ; Nothing to do if remote, the interrupts 41518 002623'01 263 17 0 00 000000 ret ; weren't on anyway. 41519 41520 dmove t1, [ .fhslf ;[186] Turn off ^A,^X,^Z traps. 41521 002624'01 120 01 0 00 004227' 1b!1b!1b ] ;[186] Turn off these channels. 41522 002625'01 104 00 0 00 000133 DIC% ; ... 41523 41524 002626'01 201 01 0 00 000001 movx t1, .ticca ;[219] Pull ^A 41525 002627'01 104 00 0 00 000140 DTI% 41526 002630'01 201 01 0 00 000030 movx t1, .ticcx ;[219] Pull ^X 41527 002631'01 104 00 0 00 000140 DTI% 41528 002632'01 201 01 0 00 000032 movx t1, .ticcz ;[219] Pull ^Z 41529 002633'01 104 00 0 00 000140 DTI% 41530 41531 002634'01 200 01 0 00 004226' move t1, [rt%dim!.fhslf] ;[219] This process, both masks 41532 002635'01 104 00 0 00 000173 RTIW% ; Fix up the interrupt mask for ^A,^X,^Z 41533 002636'01 630 02 0 00 004243' txz t2, <1b<.chcna>!1b<.chcnx>!1b<.chcnz>> ;[194] 41534 002637'01 630 03 0 00 004243' txz t3, <1b<.chcna>!1b<.chcnx>!1b<.chcnz>> ;[194] 41535 002640'01 104 00 0 00 000174 STIW% ; ... 41536 002641'01 320 12 0 00 002643' %jserr (,) 41537 002642'01 254 00 0 00 002646' 41538 002643'01 265 01 0 00 000257' 41539 002644'01 000000 000000 41540 002645'01 254 00 0 00 002646' 41541 002646'01 263 17 0 00 000000 ret 41542 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 43 K20SUB MAC 9-Jun-23 22:13 Turn ^M, ^P interrupts off 41543 subttl Turn ^M, ^P interrupts off 41544 41545 002647'01 cmpoff: entry cmpoff ;[186] 41546 41547 dmove t1, [ .fhslf ; Turn off ^M trap. 41548 002647'01 120 01 0 00 004234' 1b!1b ] ; Turn off channels. 41549 002650'01 104 00 0 00 000133 DIC ; ... 41550 41551 002651'01 402 00 0 00 002572* setzm cmseen ;[219] Indicate that there will 41552 002652'01 402 00 0 00 002575* setzm cpseen ;[219] be no more of these 41553 41554 002653'01 201 01 0 00 000015 movx t1, .ticcm ;[219] Pull ^M 41555 002654'01 104 00 0 00 000140 DTI 41556 002655'01 201 01 0 00 000020 movx t1, .ticcp ;[219] Pull ^P 41557 002656'01 104 00 0 00 000140 DTI 41558 41559 002657'01 200 01 0 00 004226' move t1, [rt%dim!.fhslf] ;[219] This process, both masks 41560 002660'01 104 00 0 00 000173 RTIW ; Fix up the terminal interrupt mask 41561 002661'01 621 02 0 00 000022 txz t2, <1b<.chcrt>!1b<.chcnp>> ;[194] for ^M, ^P 41562 002662'01 621 03 0 00 000022 txz t3, <1b<.chcrt>!1b<.chcnp>> ;[219] Differed ^M, ^P 41563 002663'01 104 00 0 00 000174 STIW 41564 002664'01 320 12 0 00 002666' %jserr (,) 41565 002665'01 254 00 0 00 002671' 41566 002666'01 265 01 0 00 000257' 41567 002667'01 000000 000000 41568 002670'01 254 00 0 00 002671' 41569 002671'01 263 17 0 00 000000 ret 41570 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 44 K20SUB MAC 9-Jun-23 22:13 Turn ^Y interrupt off 41571 subttl Turn ^Y interrupt off 41572 41573 ;[211] Begin clrbuf enhancement 41574 41575 002672'01 cyoff: entry cyoff ; Make globally available (to k20par) 41576 41577 dmove t1, [ .fhslf ; This process 41578 002672'01 120 01 0 00 004240' 1b ] ; The Control-Y channel 41579 002673'01 104 00 0 00 000133 DIC% ; Disable its interrupt channel 41580 002674'01 320 12 0 00 002676' %jserr(,) ; Or not, but carry on 41581 002675'01 254 00 0 00 002701' 41582 002676'01 265 01 0 00 000257' 41583 002677'01 000000 000000 41584 002700'01 254 00 0 00 002701' 41585 41586 002701'01 402 00 0 00 000000# setzm cyseen ; Indicate that there will be no more ^Y's 41587 41588 002702'01 201 01 0 00 000031 movx t1, .ticcy ;[219] Pull ^Y 41589 002703'01 104 00 0 00 000140 DTI% ;[219] Deactivate Terminal Interrupt 41590 41591 002704'01 200 01 0 00 004226' move t1, [rt%dim!.fhslf] ;This process, both masks 41592 002705'01 104 00 0 00 000173 RTIW% ; Read our entire terminal interrupt word 41593 002706'01 320 12 0 00 002710' %jserr(,r) ; Or not... Go no further 41594 002707'01 254 00 0 00 002713' 41595 002710'01 265 01 0 00 000257' 41596 002711'01 000000 000000 41597 002712'01 254 00 0 00 002615* 41598 002713'01 620 02 0 00 002000 txz t2, 1b<.chcny> ; Turn off control-Y from immediate mask 41599 002714'01 620 03 0 00 002000 txz t3, 1b<.chcny> ; Turn off control-Y from differred mask 41600 41601 002715'01 104 00 0 00 000174 STIW% ; Finally get the mask cleared up 41602 002716'01 320 12 0 00 002720' %jserr (,) ; Or not... 41603 002717'01 254 00 0 00 002723' 41604 002720'01 265 01 0 00 000257' 41605 002721'01 000000 000000 41606 002722'01 254 00 0 00 002723' 41607 002723'01 263 17 0 00 000000 ret 41608 41609 ;[211] End clrbuf enhancement 41610 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 45 K20SUB MAC 9-Jun-23 22:13 Control-C trap handler 41611 subttl Control-C trap handler 41612 41613 002724'01 373 00 0 00 000000# cctrap: sosle ccn ; Count the ^C's. 41614 002725'01 104 00 0 00 000136 DEBRK% ; If they haven't typed enough, just resume. 41615 002726'01 260 17 0 00 002337' call timoff ; Turn off any timer. 41616 txmsg <^C 41617 002727'01 200 01 0 00 000000# > ;[186] 41618 002730'01 104 00 0 00 000076 41619 002731'01 320 12 0 00 002732' 41620 000014'03 000000000000# 41621 000333'04 136 103 015 012 000 41622 002732'01 200 17 0 00 000000# move p, psave ;[27] Make sure stack pointer is right. 41623 002733'01 200 01 0 00 000000# move t1, psave2 ;[27] And stack top. 41624 002734'01 202 01 0 17 000000 movem t1, (p) ;[27] 41625 002735'01 661 01 0 00 010000 txo t1, pc%usr ;[187] Don't whack the other flags 41626 002736'01 202 01 0 00 000000# movem t1, pc1 ; Put this place into our PC. 41627 002737'01 262 17 0 00 000001 pop p, t1 ;[80] Don't need it on the stack any more. 41628 002740'01 104 00 0 00 000136 DEBRK% ; Resume where stack pointer points. 41629 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 46 K20SUB MAC 9-Jun-23 22:13 Control-A trap handler 41630 subttl Control-A trap handler 41631 41632 ;[61] Give brief progress report at terminal. 41633 41634 002741'01 catrap: remark ;[186] Lots of status variables in k20mit 41635 extern bctu, bytsiz, rcving, ebqflg 41636 extern rptflg, rptot, rtchr, sptot, stchr 41637 extern pagcnt, files, nnak 41638 41639 002741'01 261 17 0 00 000001 push p, t1 ; Save all ACs we might use. 41640 002742'01 261 17 0 00 000002 push p, t2 41641 002743'01 261 17 0 00 000003 push p, t3 41642 002744'01 336 00 0 00 000000* skipn rcving ; Sending or receiving a file? 41643 002745'01 254 00 0 00 003077' jrst catrp1 ; No. 41644 002746'01 201 01 0 00 000101 movei t1, .priou ; Say the filename 41645 002747'01 337 00 0 00 002744* ifmg. rcving 41646 002750'01 254 00 0 00 002754' 41647 smsg (<^A 41648 002751'01 120 02 0 00 000000# Sending >) ; Yes, one... 41649 002752'01 260 17 0 00 000311' 41650 000015'03 000000000000# 41651 000016'03 777777 777763 41652 000334'04 136 101 015 012 040 41653 002753'01 254 00 0 00 002756' else. 41654 smsg (<^A 41655 002754'01 120 02 0 00 000000# Receiving >) ; ...or the other. 41656 002755'01 260 17 0 00 000311' 41657 000017'03 000000000000# 41658 000020'03 777777 777761 41659 000337'04 136 101 015 012 040 41660 002756'01 endif. 41661 002756'01 201 01 0 00 000101 movei t1, .priou ; Say the filename 41662 002757'01 337 02 0 00 002105* skipg t2, filjfn ;[193] Have file JFN? 41663 002760'01 254 00 0 00 002772' ifskp. ;[193] Yeah, try to say something about it 41664 002761'01 302 02 0 00 377777 caie t2, .nulio ;[193] Dumping it? 41665 002762'01 254 00 0 00 002767' ifskp. ;[193] That's easy! 41666 002763'01 120 02 0 00 000000# dxtext (t2,) ;[193] Always same name 41667 000021'03 000000000000# 41668 000022'03 777777 777774 41669 000343'04 116 125 114 072 000 41670 002764'01 104 00 0 00 000053 SOUT% ;[193] Counted SOUT% is faster 41671 002765'01 320 14 0 00 002766' erjmps .+1 ;[193] 41672 002766'01 254 00 0 00 002772' else. ;[193] Otherwise, do it for real 41673 002767'01 400 03 0 00 000004 setz t3, t4 ;[194] 41674 002770'01 104 00 0 00 000030 JFNS% 41675 002771'01 320 14 0 00 002772' erjmps .+1 ;[193] 41676 002772'01 endif. ;[193] End NUL: special case 41677 002772'01 endif. ;[193] End case file JFN handling 41678 002772'01 200 01 0 00 000000# txmsg <, file bytesize > ; File bytesize 41679 002773'01 104 00 0 00 000076 41680 002774'01 320 12 0 00 002775' 41681 000023'03 000000000000# 41682 000344'04 054 040 146 151 154 41683 002775'01 201 01 0 00 000101 numout bytsiz ;[194] Sets t1 to .priou 41684 002776'01 200 02 0 00 000000* k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 46-1 K20SUB MAC 9-Jun-23 22:13 Control-A trap handler 41685 002777'01 201 03 0 00 000012 41686 003000'01 104 00 0 00 000224 41687 003001'01 320 14 0 00 003002' 41688 003002'01 335 00 0 00 002747* ifmge. rcving ; I/O bytesize, only if sending 41689 003003'01 254 00 0 00 003016' 41690 003004'01 120 02 0 00 000000# dxtext (t2,<, i/o bytesize >) ;[194] 41691 000024'03 000000000000# 41692 000025'03 777777 777761 41693 000350'04 054 040 151 057 157 41694 003005'01 104 00 0 00 000053 SOUT% ;[193] Counted SOUT% is faster 41695 003006'01 320 14 0 00 003007' erjmps .+1 ;[193] 41696 003007'01 201 02 0 00 000007 movei t2, ^d7 ;[194] 41697 003010'01 336 00 0 00 001756* skipn itsfil ;[75] 41698 003011'01 332 00 0 00 001757* skipe ebtflg 41699 003012'01 201 02 0 00 000010 movei t2, ^d8 ;[194] (!!) 41700 003013'01 201 03 0 00 000012 movei t3, ^d10 ;[194] 41701 003014'01 104 00 0 00 000224 NOUT% ;[194] 41702 003015'01 320 14 0 00 003016' erjmps .+1 ;[194] 41703 003016'01 endif. ;[194] 41704 003016'01 561 01 0 00 000303* hrroi t1,crlf ;[194] 41705 003017'01 104 00 0 00 000076 PSOUT% ;[194] 41706 003020'01 336 00 0 00 003010* ifmn. itsfil ;[75] 41707 003021'01 254 00 0 00 003025' 41708 003022'01 200 01 0 00 000000# txmsg < (ITS binary)> ;[75] 41709 003023'01 104 00 0 00 000076 41710 003024'01 320 12 0 00 003025' 41711 000026'03 000000000000# 41712 000354'04 040 050 111 124 123 41713 003025'01 endif. 41714 003025'01 336 00 0 00 000000* ifmn. ebqflg ;[88] 41715 003026'01 254 00 0 00 003032' 41716 003027'01 200 01 0 00 000000# txmsg < (8th-bit prefixing)> ;[88] 41717 003030'01 104 00 0 00 000076 41718 003031'01 320 12 0 00 003032' 41719 000027'03 000000000000# 41720 000357'04 040 050 070 164 150 41721 003032'01 endif. 41722 003032'01 336 00 0 00 000000* ifmn. rptflg ;[92] 41723 003033'01 254 00 0 00 003037' 41724 003034'01 200 01 0 00 000000# txmsg < (compression)> ;[92] 41725 003035'01 104 00 0 00 000076 41726 003036'01 320 12 0 00 003037' 41727 000030'03 000000000000# 41728 000364'04 040 050 143 157 155 41729 003037'01 endif. 41730 41731 003037'01 200 01 0 00 000000# txmsg < (block check type > ;[98] 41732 003040'01 104 00 0 00 000076 41733 003041'01 320 12 0 00 003042' 41734 000031'03 000000000000# 41735 000367'04 040 050 142 154 157 41736 003042'01 201 01 0 00 000101 numout bctu ;[98] 41737 003043'01 200 02 0 00 000000* 41738 003044'01 201 03 0 00 000012 41739 003045'01 104 00 0 00 000224 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 46-2 K20SUB MAC 9-Jun-23 22:13 Control-A trap handler 41740 003046'01 320 14 0 00 003047' 41741 003047'01 201 01 0 00 000051 movei t1, ")" ;[98] 41742 003050'01 104 00 0 00 000074 PBOUT ;[98] 41743 003051'01 337 02 0 00 002757* skipg t2, filjfn ;[193] Have file JFN? 41744 003052'01 254 00 0 00 003077' ifskp. ;[193] Yeah, don't lets say something silly 41745 003053'01 306 02 0 00 377777 cain t2, .nulio ;[193] Are we dumping it? 41746 003054'01 254 00 0 00 003077' anskp. ;[193] We are, so bag this because not PMAP%ing anything 41747 txmsg < 41748 003055'01 200 01 0 00 000000# At page > ; What page we're at. 41749 003056'01 104 00 0 00 000076 41750 003057'01 320 12 0 00 003060' 41751 000032'03 000000000000# 41752 000373'04 015 012 040 101 164 41753 003060'01 200 02 0 00 002075* move t2, pagno 41754 003061'01 350 00 0 00 000002 aos t2 41755 003062'01 201 01 0 00 000101 movei t1, .priou ;[194] 41756 003063'01 201 03 0 00 000012 movei T3, ^d10 ;[194] 41757 003064'01 104 00 0 00 000224 NOUT% 41758 003065'01 335 00 0 00 003002* ifmge. rcving ;[194] Out of how many 41759 003066'01 254 00 0 00 003077' 41760 003067'01 200 01 0 00 000000# txmsg < of > ; (which we know only if we're sending) 41761 003070'01 104 00 0 00 000076 41762 003071'01 320 12 0 00 003072' 41763 000033'03 000000000000# 41764 000376'04 040 157 146 040 000 41765 003072'01 201 01 0 00 000101 numout pagcnt 41766 003073'01 200 02 0 00 000000* 41767 003074'01 201 03 0 00 000012 41768 003075'01 104 00 0 00 000224 41769 003076'01 320 14 0 00 003077' 41770 003077'01 endif. ;[194] 41771 003077'01 endif. ;[194] End case of a file that isn't NUL: 41772 41773 catrp1: txmsg < 41774 003077'01 200 01 0 00 000000# Files: > ; Say how many files, 41775 003100'01 104 00 0 00 000076 41776 003101'01 320 12 0 00 003102' 41777 000034'03 000000000000# 41778 000377'04 015 012 040 106 151 41779 003102'01 201 01 0 00 000101 numout files 41780 003103'01 200 02 0 00 000000* 41781 003104'01 201 03 0 00 000012 41782 003105'01 104 00 0 00 000224 41783 003106'01 320 14 0 00 003107' 41784 003107'01 200 01 0 00 000000# txmsg <, packets: > ; packets, 41785 003110'01 104 00 0 00 000076 41786 003111'01 320 12 0 00 003112' 41787 000035'03 000000000000# 41788 000402'04 054 040 160 141 143 41789 003112'01 337 00 0 00 003065* ifmg. rcving ;[194] Positive means sending ... 41790 003113'01 254 00 0 00 003122' 41791 003114'01 201 01 0 00 000101 numout sptot ;[194] 41792 003115'01 200 02 0 00 000000* 41793 003116'01 201 03 0 00 000012 41794 003117'01 104 00 0 00 000224 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 46-3 K20SUB MAC 9-Jun-23 22:13 Control-A trap handler 41795 003120'01 320 14 0 00 003121' 41796 003121'01 254 00 0 00 003127' else. ;[194] 41797 003122'01 201 01 0 00 000101 numout rptot ;[194] 41798 003123'01 200 02 0 00 000000* 41799 003124'01 201 03 0 00 000012 41800 003125'01 104 00 0 00 000224 41801 003126'01 320 14 0 00 003127' 41802 003127'01 endif. ;[194] 41803 003127'01 200 01 0 00 000000# txmsg <, chars: > ; characters, 41804 003130'01 104 00 0 00 000076 41805 003131'01 320 12 0 00 003132' 41806 000036'03 000000000000# 41807 000405'04 054 040 143 150 141 41808 41809 003132'01 337 00 0 00 003112* ifmg. rcving ;[194] Positive means sending .... 41810 003133'01 254 00 0 00 003137' 41811 003134'01 200 02 0 00 000000* move t2, stchr 41812 003135'01 270 02 0 00 000013 add t2, schr 41813 003136'01 254 00 0 00 003141' else. ;[194] Otherwise, receiving 41814 003137'01 200 02 0 00 000000* move t2, rtchr 41815 003140'01 270 02 0 00 000012 add t2, rchr 41816 003141'01 endif. ;[194] 41817 003141'01 201 01 0 00 000101 movei t1, .priou ;[194] 41818 003142'01 201 03 0 00 000012 movei t3, ^d10 ;[194] 41819 003143'01 104 00 0 00 000224 NOUT% ;[194] 41820 txmsg < 41821 003144'01 200 01 0 00 000000# NAKs: > ; NAKS & timeouts. 41822 003145'01 104 00 0 00 000076 41823 003146'01 320 12 0 00 003147' 41824 000037'03 000000000000# 41825 000407'04 015 012 040 116 101 41826 003147'01 201 01 0 00 000101 numout nnak 41827 003150'01 200 02 0 00 000000* 41828 003151'01 201 03 0 00 000012 41829 003152'01 104 00 0 00 000224 41830 003153'01 320 14 0 00 003154' 41831 003154'01 200 01 0 00 000000# txmsg <, timeouts: > 41832 003155'01 104 00 0 00 000076 41833 003156'01 320 12 0 00 003157' 41834 000040'03 000000000000# 41835 000411'04 054 040 164 151 155 41836 003157'01 201 01 0 00 000101 numout ntimou 41837 003160'01 200 02 0 00 002365* 41838 003161'01 201 03 0 00 000012 41839 003162'01 104 00 0 00 000224 41840 003163'01 320 14 0 00 003164' 41841 txmsg < 41842 003164'01 200 01 0 00 000000# > ; End up with a CRLF 41843 003165'01 104 00 0 00 000076 41844 003166'01 320 12 0 00 003167' 41845 000041'03 000000000000# 41846 000414'04 015 012 000 000 000 41847 41848 003167'01 262 17 0 00 000003 pop p, t3 ; Restore ACs. 41849 003170'01 262 17 0 00 000002 pop p, t2 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 46-4 K20SUB MAC 9-Jun-23 22:13 Control-A trap handler 41850 003171'01 262 17 0 00 000001 pop p, t1 41851 41852 003172'01 104 00 0 00 000136 DEBRK% ; Resume. 41853 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 47 K20SUB MAC 9-Jun-23 22:13 Control-X trap handler 41854 subttl Control-X trap handler 41855 41856 ;[59] 41857 41858 003173'01 cxtrap: extern source, dirch ;[186] 41859 41860 003173'01 476 00 0 00 002617* setom cxseen ; Just set the flag & echo the character. 41861 003174'01 261 17 0 00 000001 push p, t1 41862 003175'01 261 17 0 00 000002 push p, t2 41863 003176'01 200 01 0 00 000000* move t1, source ;[140] What's the source of our data? 41864 003177'01 306 01 0 00 000000* cain t1, dirch ;[140] Is it a directory listing? 41865 003200'01 476 00 0 00 002620* setom czseen ;[140] If so, set C-Z flag, too. 41866 003201'01 200 01 0 00 000000# txmsg <^X// > 41867 003202'01 104 00 0 00 000076 41868 003203'01 320 12 0 00 003204' 41869 000042'03 000000000000# 41870 000415'04 136 130 057 057 040 41871 003204'01 262 17 0 00 000002 pop p, t2 41872 003205'01 262 17 0 00 000001 pop p, t1 41873 003206'01 104 00 0 00 000136 DEBRK% 41874 41875 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 48 K20SUB MAC 9-Jun-23 22:13 Control-Z trap handler 41876 subttl Control-Z trap handler 41877 41878 ;[59] 41879 41880 003207'01 476 00 0 00 003200* cztrap: setom czseen ; Just set the flag & echo the character. 41881 003210'01 261 17 0 00 000001 push p, t1 41882 003211'01 261 17 0 00 000002 push p, t2 41883 003212'01 200 01 0 00 000000# txmsg <^Z// > 41884 003213'01 104 00 0 00 000076 41885 003214'01 320 12 0 00 003215' 41886 000043'03 000000000000# 41887 000417'04 136 132 057 057 040 41888 003215'01 262 17 0 00 000002 pop p, t2 41889 003216'01 262 17 0 00 000001 pop p, t1 41890 003217'01 104 00 0 00 000136 DEBRK 41891 41892 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 49 K20SUB MAC 9-Jun-23 22:13 Control-M and -P trap handlers 41893 subttl Control-M and -P trap handlers 41894 41895 ;[165] 41896 41897 003220'01 cmtrap: extern cmseen, cmloc ;[186] 41898 41899 003220'01 476 00 0 00 002651* setom cmseen ; Set ^M flag 41900 003221'01 261 17 0 00 000001 push p, t1 ; Echo CRLF 41901 003222'01 261 17 0 00 000002 push p, t2 41902 txmsg < 41903 003223'01 200 01 0 00 000000# > 41904 003224'01 104 00 0 00 000076 41905 003225'01 320 12 0 00 003226' 41906 000044'03 000000000000# 41907 000421'04 015 012 000 000 000 41908 003226'01 200 01 0 00 000000* move t1, cmloc ; Get place to resume. 41909 003227'01 254 00 0 00 003237' jrst cmptr2 41910 41911 41912 003230'01 cptrap: extern cpseen ;[186] 41913 extern cploc 41914 41915 003230'01 476 00 0 00 002652* setom cpseen ; Set ^P flag 41916 003231'01 261 17 0 00 000001 push p, t1 ; Echo ^P 41917 003232'01 261 17 0 00 000002 push p, t2 41918 txmsg < 41919 003233'01 200 01 0 00 000000# ^P> 41920 003234'01 104 00 0 00 000076 41921 003235'01 320 12 0 00 003236' 41922 000045'03 000000000000# 41923 000422'04 015 012 136 120 000 41924 003236'01 200 01 0 00 000000* move t1, cploc ; Get place to resume. 41925 41926 003237'01 661 01 0 00 010000 cmptr2: txo t1, pc%usr ;[187] Get into user mode 41927 003240'01 202 01 0 00 000000# movem t1, pc2 ; Resume at desired PC. 41928 003241'01 262 17 0 00 000002 pop p, t2 41929 003242'01 262 17 0 00 000001 pop p, t1 41930 003243'01 104 00 0 00 000136 DEBRK 41931 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 50 K20SUB MAC 9-Jun-23 22:13 Control-Y interrupt handler 41932 subttl Control-Y interrupt handler 41933 41934 ;[211] All part of clrbuf changes 41935 ;[218] Not anymore!! 41936 41937 chgsec(code,data) ; Need some storage 41938 000000'05 cyseen: intern cyseen ; Global for k20par and k20net 41939 retsec ; Back to generating code 41940 41941 extern $clrbs ; Reported location of loop sleep (DISMS%) 41942 extern $waitj ;[218] Reported location of DECnet connection wait 41943 41944 003244'01 261 17 0 00 000001 cytrap: push p, t1 ; Save an accumulator 41945 003245'01 261 17 0 00 000016 push p, cx ; Save for frame building 41946 003246'01 550 01 0 00 000000# hrrz t1, pc3 ; Pick up our interrupted location (no flags) 41947 41948 003247'01 415 16 0 00 003256' block. ; Enter block context for better control flow 41949 003250'01 261 17 0 00 000016 41950 003251'01 306 01 0 00 000000* cain t1, $clrbs ; In the buffer clear sleep? 41951 003252'01 254 00 0 00 002616* retskp ; Yes, go dink his PC 41952 003253'01 306 01 0 00 000000* cain t1, $waitj ;[218] In the DECnet connection wait? 41953 003254'01 254 00 0 00 003252* retskp ;[218] Yes, dink that PC, too 41954 003255'01 263 17 0 00 000000 endbk. ; End of block context 41955 003256'01 254 00 0 00 003262' ifskp. ;[218] A known break location!! 41956 003257'01 500 01 0 00 000000# hll t1, pc3 ; Pick up interrupted flags 41957 003260'01 661 01 0 00 010000 txo t1, pc%usr ; Get into user mode 41958 003261'01 202 01 0 00 000000# movem t1, pc3 ; Change DEBRK% action 41959 003262'01 endif. ; That's all, really 41960 41961 003262'01 262 17 0 00 000016 pop p, cx ; Restore frame pointer 41962 003263'01 262 17 0 00 000001 pop p, t1 ; Restore temporary 41963 003264'01 350 00 0 00 000000# aos cyseen ; Set ^Y flag 41964 003265'01 104 00 0 00 000136 DEBRK% 41965 41966 ;[211] End clrbuf changes 41967 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 51 K20SUB MAC 9-Jun-23 22:13 String convert from eight bit to controlified 7 bit 41968 subttl String convert from eight bit to controlified 7 bit 41969 41970 ;[209] Begin code insertion 41971 41972 ; Like echo, except uses VASTLY less JSYS calls and CPU time. 41973 ; However, because we're doing eight bit bytes, the table driven MOVST 41974 ; approach uses vastly more memory. That's fine for modern usage, 41975 ; which has over 30 times the memory for a few hobbiest users. 41976 ; 41977 ; Parity bits are completely stripped, if you want parity, you must 41978 ; check this, beforehand. 41979 41980 ; Define a macro to do random character substitutions 41981 41982 define cncsub(chr1,sub1,chr2,sub2,tab,%org) < 41983 ifb ,< ;;Don't put things in bad places 41984 printx ?Must have a table to store character pair 41985 end ;;Switch to pass 2 41986 > 41987 %org==. ;;Remember where we are 41988 .xcref %org ;;Don't want in CREF, yuck! 41989 suppress %org ;;Generate symbol value largely useless 41990 reloc tab+<<&177>_-1> ;;Gets us to the correct halfword pair 41991 xwd sub1,sub2 ;;Emit the appropriate pair 41992 reloc %org ;;Get back to where we were 41993 .xcref %org ;;Stay out of my cross reference! 41994 if2 < purge %org > ;;Don't need after pass two, either 41995 >;;cncsub 41996 41997 chgsec(code,const) ; Put translate table in the constants psect 41998 41999 remark ; And on to define our piggy tables 42000 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 52 K20SUB MAC 9-Jun-23 22:13 String convert from eight bit to controlified 7 bit 42001 remark Control Character stop table, first half 42002 42003 000000 %cncha==.chnul ; Control character; starts out at .CHNUL 42004 suppress %cncha ; Don't need in symbol table listing 42005 .xcref %cncha ; Nor in cross reference 42006 42007 000046'03 cnrtab: remark ; Appropriately trigger on control chars 42008 000046' %tborg==. ; Mark beginning of table 42009 suppress %tborg ; Don't need in symbol table listing 42010 .xcref %tborg ; Nor in cross reference 42011 42012 xlist ; Don't need to see this blat 42013 list ; Restart the blather 42014 42015 000146' %eocnr==. ; Remember end of control table 42016 suppress %eocnr ; Don't need in symbol table listing 42017 .xcref %eocnr ; Nor in cross reference 42018 42019 000046'03 reloc %tborg ; Get back to the beginning of the table 42020 .xcref %tborg ; Keep off cross reference 42021 42022 xlist ; Any control character will stop us 42023 list ; Restart the blather 42024 42025 remark ; Have to special case rubout 42026 000145'03 000176 500177 cncsub("~","~",.chdel,,cnrtab) 42027 42028 000146'03 reloc %eocnr ; Get to end of first part 42029 .xcref %eocnr ; Nor in cross reference 42030 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 53 K20SUB MAC 9-Jun-23 22:13 String convert from eight bit to controlified 7 bit 42031 remark Control Character stop table, second half 42032 42033 000146'03 cnrt2:! remark ; Have to repeat for the eight bit part... 42034 .xcref cnrt2 ; Not used, so don't cross reference it 42035 suppress cnrt2 ; Surely not needed on the symbol table 42036 000146' %tborg==. ; Mark beginning of table 42037 .xcref %tborg ; Nor in cross reference 42038 42039 xlist ; Don't need to see this blat 42040 list ; Restart the blather 42041 42042 000246' %eocnr==. ; Remember end of second part of control table 42043 .xcref %eocnr ; Nor in cross reference 42044 42045 000146'03 reloc %tborg ; Get back to the beginning of the table 42046 xlist ; Save the trees!!! 42047 list ;;Turn listing back on 42048 42049 remark ; Have to special case rubout 42050 000245'03 000176 500177 cncsub("~","~",.chdel,,cnrt2) 42051 42052 000246'03 reloc %eocnr ; Get to back to end of table 42053 .xcref %eocnr ; Keep temporary off the cross-reference 42054 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 54 K20SUB MAC 9-Jun-23 22:13 String convert from eight bit to controlified 7 bit 42055 remark Control Character substitution table, first half 42056 42057 ; The translate table assumes that exactly a SINGLE character is 42058 ; to be translated and that this is only a control character. 42059 42060 000246'03 crsubt: remark ; Control character substitution table 42061 000246' %tborg==. ; Mark beginning of table 42062 .xcref %tborg ; Keep off cross reference 42063 42064 xlist ; Don't need to see this blat 42065 list ; Restart the blather 42066 42067 000346' %eocnr==. ; Remember end of control table 42068 .xcref %eocnr ; Nor in cross reference 42069 000246'03 reloc %tborg ; Get back to the beginning of the table 42070 .xcref %eocnr ; Keep off cross reference 42071 42072 000246'03 000100 000101 xwd "@","A" ; .chnul goes to ^@, .chcna goes to ^A 42073 xlist ; End of string on .CHNUL, expand others 42074 list 42075 42076 remark ; A few conventions 42077 000263'03 000132 000044 cncsub(.chcnz,"Z",.chesc,"$",crsubt) 42078 000345'03 500176 000077 cncsub("~",,.chdel,"?",crsubt) 42079 42080 000346'03 reloc %eocnr ; Get to end of first part 42081 .xcref %eocnr ; Nor in cross reference 42082 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 55 K20SUB MAC 9-Jun-23 22:13 String convert from eight bit to controlified 7 bit 42083 remark Control Character expansion table, second half 42084 42085 000346'03 crsu2:! remark ; Used for eight bits, ignores parity 42086 .xcref crsu2 ; Not used, so don't cross reference it 42087 suppress crsu2 ; Surely not needed on the symbol table 42088 000346' %tborg==. ; Mark beginning of table 42089 .xcref %tborg ; Nor in cross reference 42090 42091 xlist ; Don't need to see this blat 42092 list ; Restart the blather 42093 42094 000446' %eocnr==. ; Remember end of control table 42095 .xcref %eocnr ; Nor in cross reference 42096 000346'03 reloc %tborg ; Get back to the beginning of the table 42097 .xcref %eocnr ; Keep off cross reference 42098 42099 000346'03 000100 000101 xwd "@","A" ; .chnul goes to ^@, .chcna goes to ^A 42100 xlist ; End of string on .CHNUL, expand others 42101 list 42102 42103 remark ; A few conventions 42104 000363'03 000132 000044 cncsub(.chcnz,"Z",.chesc,"$",crsu2) 42105 000445'03 500176 000077 cncsub("~",,.chdel,"?",crsu2) 42106 42107 000446'03 reloc %eocnr ; Get to back to end of table 42108 .xcref %eocnr ; Keep temporary off the cross-reference 42109 42110 remark After 2nd pass, purge tempories 42111 if2 < purge %cncha,%eocnr, %tborg 42112 purge cnrt2, crsu2> 42113 retsec ; Get out of the constants section 42114 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 56 K20SUB MAC 9-Jun-23 22:13 String convert from eight bit to controlified 7 bit 42115 remark Actual code to convert the string 42116 42117 ; Call: 42118 ; 42119 ; t1/ length of string to convert 42120 ; t2/ point 8, somewhere ; String of eight bit characters to convert 42121 ; 42122 ; Return: 42123 ; 42124 ; +1/ Something got ill 42125 ; +2/ Success! String completely converted (or as much of it as we could) 42126 ; 42127 ; t1/ Remaining length ; How much is left of source string 42128 ; t2/ point 7, somewhere else ; Converted controlified string 42129 ; t3/ negative length ; Ready for SOUT% 42130 ; t4/ point 8, updated ; Where we stopped in the source string 42131 42132 000454 trnchr==^d300 ; Can handle this many characters at once 42133 42134 chgsec(code,data) ; Need some storage for buffers, etc. 42135 000000'05 trnbuf: intern trnbuf ;[221] Let k20pdc see it, too 42136 000000'05 block +1 ; Space for 7 bit characters 42137 retsec ; Re-open executable code 42138 42139 003266'01 015 00 0 00 000000# c87mov: movst 0,cnrtab ; Actual extend instruction being executed 42140 003267'01 000000 000000 .chnul ; Fill character is end of string 42141 42142 003270'01 s8ccv7: entry s8ccv7 ; String eight controlified convert to seven 42143 003270'01 327 01 0 00 003274' ifle. t1 ; Gubbish? 42144 003271'01 200 04 0 00 000002 move t4 ,t2 ; Return whatever they gave us 42145 003272'01 403 02 0 00 000003 setzb t2, t3 ; Then say there is nothing to SOUT% 42146 003273'01 263 17 0 00 000000 ret ; Fail the call 42147 003274'01 endif. 42148 42149 003274'01 265 16 0 00 004056' saveac ; Save more piggy registers 42150 remark q2 aliases t5 ; So t5 must be saved 42151 42152 remark t1, t2 ; Already have source length and pointer 42153 dmove t4, [ trnchr ; Load maximum length of destination 42154 003275'01 120 04 0 00 004244' point 7, trnbuf ] ; Point to destination 42155 003276'01 403 03 0 00 000006 setzb t3, q2 ; Force section local pointers 42156 003277'01 621 01 0 00 700000 txz t1, S!N!M ; Whack translation flags 42157 42158 003300'01 do. ; Enter loop context 42159 003300'01 661 01 0 00 400000 txo t1, S ; Set significance flag (start translating) 42160 003301'01 123 01 0 00 003266' extend t1, c87mov ; Move the string, testing for control chars 42161 003302'01 320 12 0 00 003304' %jserr (, r) ; Pass any machine error back up 42162 003303'01 254 00 0 00 003307' 42163 003304'01 265 01 0 00 000257' 42164 003305'01 000000000000# 42165 003306'01 254 00 0 00 002712* 42166 000423'04 115 117 126 123 124 42167 003307'01 623 01 0 00 200000 txze t1, N ; Bumped into a control character? 42168 003310'01 254 00 0 00 003320' ifskp. ; We did not; exhausted source? 42169 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 15:19 11-Jun-23 Page 56-1 K20SUB MAC 9-Jun-23 22:13 String convert from eight bit to controlified 7 bit 42170 003312'01 323 01 0 00 003326' jumple t1, endlp. ; No more source? We're done 42171 003313'01 334 00 0 00 000000 %ermsg (,r) 42172 003314'01 254 00 0 00 003320' 42173 003315'01 265 01 0 00 000257' 42174 003316'01 000000000000# 42175 003317'01 254 00 0 00 003306* 42176 000426'04 103 157 156 164 162 42177 003320'01 endif. ; Otherwise, we DID hit a control character 42178 003320'01 323 04 0 00 003326' jumple t4, endlp. ; Done if no more destination 42179 003321'01 621 01 0 00 700000 txz t1, S!N!M ; Clear all the flags 42180 003322'01 260 17 0 00 003335' call cnchar ; Otherwise, process a control character 42181 003323'01 263 17 0 00 000000 ret ; Failed, just stop right now 42182 003324'01 323 04 0 00 003326' jumple t4, endlp. ; Done if no more destination space 42183 003325'01 327 01 0 00 003300' jumpg t1, top. ; Keep translating characters until no more 42184 003326'01 enddo. ; Exit loop lexical context 42185 42186 remark t1, ; Still has remaining source length 42187 003326'01 200 03 0 00 000004 move t3, t4 ; Load remaining destination 42188 003327'01 275 03 0 00 000454 subi t3, trnchr ; Calculate negative destination length 42189 003330'01 200 04 0 00 000002 move t4, t2 ; Updated source pointer is here 42190 003331'01 200 02 0 00 004246' move t2, [ point 7, trnbuf ] ; Point to destination 42191 003332'01 254 00 0 00 003254* retskp ; Successful return 42192 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 57 K20SUB MAC 9-Jun-23 22:13 String convert from eight bit to controlified 7 bit 42193 remark Convert control character to ASCII equivalent 42194 42195 ; Assumes s8ccv7 register context and is intmately linked with it 42196 ; 42197 ; t1/ Remaining length of source string 42198 ; t2/ point 8, to current location in source string 42199 ; t3/ Address portion of 30 double word pointer, MUST be zero 42200 ; t4/ Remaining length of destination string 42201 ; q1/ point 7, to current location in destination string 42202 ; q2/ Address portion of 30 double word pointer, MUST be zero 42203 ; 42204 ; Note a subtle difference between this and the escchr routine, which 42205 ; is used to implement C backslash expansion and translation. In that 42206 ; case, the backslash is skipped and the character afterwards is 42207 ; translated (or converted into a number). 42208 ; 42209 ; The enclosing MOVST is now pointing AFTER the control character and 42210 ; has updated the source remaining total to account for the fact that 42211 ; it has been consumed. However, no such thing happens to the 42212 ; destination pointer and count because nothing was ever deposited. 42213 ; 42214 ; Thus some fix-up is necessary prior to excuting the MOVST below so 42215 ; that the correct character is fetched. Similarly, the source 42216 ; counter should NOT be fixed while the destination counter MUST be 42217 ; fixed. 42218 ; 42219 ; It's the kind of edge case that you really have to single step 42220 ; through to see what the machine is actually doing... 42221 ; 42222 ; For the two cases which involve an expansion, no fix up is 42223 ; necessary, because we're skipping the control character and 42224 ; depositing fixed strings. 42225 42226 003333'01 015 00 0 00 000000# chngch: movst 0,crsubt ; Actual extend instruction being executed 42227 003334'01 000000 000000 .chnul ; Fill character is end of string 42228 42229 003335'01 265 16 0 00 004247' cnchar: saveac ; Some extra scratch for calculations 42230 003336'01 135 07 0 00 000002 ldb q3, t2 ; Load character that stopped us 42231 003337'01 306 07 0 00 000015 cain q3, .chcrt ; Carriage return? 42232 003340'01 254 00 0 00 003413' callret schcrt ; Hit special carriage return expansion 42233 003341'01 306 07 0 00 000012 cain q3, .chlfd ; Line feed? 42234 003342'01 254 00 0 00 003450' callret schlfd ; Hit special line feed expansion 42235 42236 003343'01 201 07 0 00 000136 movei q3, "^" ; Load circumflex character 42237 003344'01 136 07 0 00 000005 idpb q3, q1 ; Deposit in destination 42238 003345'01 363 04 0 00 003317* sojle t4, r ; Account for it and return if full 42239 42240 003346'01 621 01 0 00 700000 txz t1, N!M!S ; Stomp flags so math and EXTEND work 42241 003347'01 200 07 0 00 000001 move q3, t1 ; Save source length over extend 42242 003350'01 200 10 0 00 000004 move q4, t4 ; Ditto destination length 42243 42244 003351'01 474 01 0 00 000000 seto t1, ; Have to back up the source pointer to 42245 003352'01 133 01 0 00 000002 adjbp t1, t2 ; BEFORE the offending control character 42246 003353'01 200 02 0 00 000001 move t2, t1 ; Use updated pointer as new source pointer 42247 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 57-1 K20SUB MAC 9-Jun-23 22:13 String convert from eight bit to controlified 7 bit 42248 003354'01 200 01 0 00 004173' move t1,[ S!<^d1> ] ; Only looking at a SINGLE character of source 42249 003355'01 201 04 0 00 000001 movei t4,^d1 ; Don't allow any foolish filling... 42250 003356'01 123 01 0 00 003333' extend t1, chngch ; Change this SINGLE character 42251 003357'01 320 12 0 00 003361' %jserr (, r) ; Pass error up 42252 003360'01 254 00 0 00 003364' 42253 003361'01 265 01 0 00 000257' 42254 003362'01 000000000000# 42255 003363'01 254 00 0 00 003345* 42256 000441'04 103 157 156 164 162 42257 42258 003364'01 607 01 0 00 200000 ifxn. t1, N ; Invalid control character?? 42259 003365'01 254 00 0 00 003377' 42260 003366'01 200 01 0 00 000000# emsg 42261 003367'01 104 00 0 00 000313 42262 000446'03 000000000000# 42263 000450'04 111 154 154 145 147 42264 003370'01 135 01 0 00 000002 ldb t1, t2 ; Pick up what didn't work 42265 003371'01 104 00 0 00 000074 PBOUT% ; Show us 42266 003372'01 561 01 0 00 003016* hrroi t1, crlf ; Load end of line 42267 003373'01 104 00 0 00 000076 PSOUT% ; Print it 42268 003374'01 200 01 0 00 000007 move t1, q3 ; Restore unaltered source length 42269 003375'01 200 04 0 00 000010 move t4, q4 ; Restore unaltered destination length 42270 003376'01 263 17 0 00 000000 ret ; Failure return 42271 003377'01 endif. 42272 42273 003377'01 200 01 0 00 000007 move t1, q3 ; Restore source count, which is already correct 42274 003400'01 375 04 0 00 000010 sosge t4, q4 ; Fix destination count for character deposited 42275 003401'01 263 17 0 00 000000 ret ; Ran out of buffer space 42276 003402'01 254 00 0 00 003332* retskp ; Won!! 42277 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 58 K20SUB MAC 9-Jun-23 22:13 Special Control Character logic 42278 subttl Special Control Character logic 42279 42280 ; Expands carriage return and line feed so we 42281 ; don't overprint or get yucky wrap arounds 42282 ; 42283 ; Both assume: 42284 ; 42285 ; cnchar working context 42286 ; 42287 ; t1/ Remaining length of source string 42288 ; t2/ point 8, to current location in source string 42289 ; t3/ Address portion of 30 double word pointer, MUST be zero 42290 ; t4/ Remaining length of destination string 42291 ; q1/ point 7, to current location in destination string 42292 ; q2/ Address portion of 30 double word pointer, MUST be zero 42293 ; 42294 ; The idea is that the user sees something like ^M 42295 ; ^J splitting lines. Repeated Control-J's are not 42296 ; as graceful, but this is just for buffer review 42297 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 59 K20SUB MAC 9-Jun-23 22:13 Carriage expansion 42298 subttl Carriage expansion 42299 42300 ; Carriage Return puts the control character at END of expansion 42301 42302 003403'01 572321 500000 crtexp: byte (7) "^", "M", .chcrt, .chnul, .chnul 42303 003404'01 572321 505000 byte (7) "^", "M", .chcrt, .chlfd, .chnul 42304 42305 003405'01 000000 000003 crtptr: ^d3 ; String is three bytes long 42306 003406'01 44 07 0 00 003403' point 7, crtexp ; Point to expansion text 42307 003407'01 000000 000004 crtptl: ^d4 ; String is four bytes long 42308 003410'01 44 07 0 00 003404' point 7, crtexp+1 ; Point to text with line feed 42309 42310 003411'01 016 00 0 00 000000 movcrt: movslj 0, 0 ; No accumulator; E1 unused 42311 003412'01 000000 000000 .chnul ; Fill with nul's 42312 42313 003413'01 schcrt: remark q3, q4 ; Already saved by cnchar 42314 003413'01 265 16 0 00 004257' saveac ; Needs another register 42315 42316 003414'01 120 07 0 00 000001 dmove q3, t1 ; Save current source 42317 003415'01 323 07 0 00 003425' ifg. q3 ; Any remaining input? 42318 003416'01 134 01 0 00 000002 ildb t1, t2 ; Yes, pick up the next character 42319 003417'01 302 01 0 00 000012 caie t1, .chlfd ; A line feed?? 42320 003420'01 254 00 0 00 003423' ifskp. ; It is, so will be handled by schlfd 42321 003421'01 120 01 0 00 003405' dmove t1, crtptr ; Load expansion length and pointer 42322 003422'01 254 00 0 00 003424' else. ; Otherwise, drop in a line feed, too 42323 003423'01 120 01 0 00 003407' dmove t1, crtptl ; Load expansion length and pointer 42324 003424'01 endif. ; End case overwrite checking 42325 003424'01 254 00 0 00 003426' else. ; Otherwise, Carriage Return was last character 42326 003425'01 120 01 0 00 003407' dmove t1, crtptl ; So assume no line feed 42327 003426'01 endif. ; End case input buffer checking 42328 42329 003426'01 274 04 0 00 000001 sub t4, t1 ; Subtract from remaining 42330 003427'01 323 04 0 00 003363* jumple t4, r ; Fail if overflowed the beffer 42331 ; Otherwise, safe to move 42332 003430'01 200 11 0 00 000004 move q5, t4 ; Preserve the new length 42333 003431'01 200 04 0 00 000001 move t4, t1 ; Same as source, so no fill 42334 003432'01 123 01 0 00 003411' extend t1, movcrt ; Copy it all over, wee!! 42335 003433'01 320 12 0 00 003435' %jserr (,r) ;?? 42336 003434'01 254 00 0 00 003440' 42337 003435'01 265 01 0 00 000257' 42338 003436'01 000000000000# 42339 003437'01 254 00 0 00 003427* 42340 000456'04 125 156 141 142 154 42341 003440'01 120 01 0 00 000007 dmove t1, q3 ; Restore source 42342 003441'01 200 04 0 00 000011 move t4, q5 ; Restore fixed length 42343 003442'01 254 00 0 00 003402* retskp ; Return, successfully expanded 42344 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 60 K20SUB MAC 9-Jun-23 22:13 Line feed expansion 42345 subttl Line feed expansion 42346 42347 ; Line feed expansion puts the control character BEFORE expansion 42348 42349 003443'01 052751 200000 lfdexp: byte (7) .chlfd, "^", "J", .chnul, .chnul 42350 003444'01 000000 000003 lfdptr: ^d3 ; String is three bytes long 42351 003445'01 44 07 0 00 003443' point 7, lfdexp ; Point to expansion text 42352 003446'01 016 00 0 00 000000 movlfd: movslj 0, 0 ; No accumulator; E1 unused 42353 003447'01 000000 000040 .chspc ; Fill with spaces 42354 42355 003450'01 schlfd: remark q3, q4 ; Already saved by cnchar 42356 003450'01 265 16 0 00 004257' saveac ; Needs another register 42357 42358 003451'01 120 07 0 00 000001 dmove q3, t1 ; Save current source 42359 003452'01 120 01 0 00 003444' dmove t1, lfdptr ; Load expansion length and pointer 42360 003453'01 274 04 0 00 000001 sub t4, t1 ; Subtract from remaining 42361 003454'01 323 04 0 00 003437* jumple t4, r ; Fail if overflowed the beffer 42362 ; Otherwise, safe to move 42363 003455'01 200 11 0 00 000004 move q5, t4 ; Preserve the new length 42364 003456'01 200 04 0 00 000001 move t4, t1 ; Same as source, so no fill 42365 003457'01 123 01 0 00 003446' extend t1, movlfd ; Copy it all over, wee!! 42366 003460'01 320 12 0 00 003462' %jserr (,r) ;?? 42367 003461'01 254 00 0 00 003465' 42368 003462'01 265 01 0 00 000257' 42369 003463'01 000000000000# 42370 003464'01 254 00 0 00 003454* 42371 000465'04 125 156 141 142 154 42372 003465'01 120 01 0 00 000007 dmove t1, q3 ; Restore source 42373 003466'01 200 04 0 00 000011 move t4, q5 ; Restore fixed length 42374 003467'01 254 00 0 00 003442* retskp ; Success 42375 42376 ;[209] End code insertion 42377 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 61 K20SUB MAC 9-Jun-23 22:13 String copy measurement, 9:10pm Thursday, 21 July 2022 42378 subttl String copy measurement, 9:10pm Thursday, 21 July 2022 42379 42380 remark Delimma: What is the fastest way to copy strings? 42381 42382 ; A question had sometimes come up for debate as to whether the string 42383 ; instructions gave any real speed up, the concern being whether the 42384 ; set up cost of conditioning the register file and restoring it was 42385 ; worth using them. 42386 ; 42387 ; Three cases were set up, the first being a typical ildb/idpb loop 42388 ; with the second being a use of movst to move the string until a nul 42389 ; was detected. The third was a mixture; the keywords being moved 42390 ; with a loop and the macro expansions being moved with the movst. 42391 ; This was expected to be have the best performance as macro names 42392 ; (I.E., keywords) are typically not very long. 42393 ; 42394 ; 11 macros were defined, using a total of 80 characters of macro name 42395 ; space and 1365 characters of macro text space. The results are 42396 ; suprising: 42397 ; 42398 ; Case Elapsed CPU All 42399 ; 1 1.360 1.320 times 42400 ; *2 .340 .320 are in 42401 ; 3 1.020 .980 milliseconds 42402 ; 42403 ; By a considerable margin, using solely the movst won. This is why 42404 ; it is used exclusively in the macro garbage collector. Going 42405 ; forward, other cases may be identified in Kermit where it can be 42406 ; used. 42407 ; 42408 ; Older programs which use SOUT% to transfer strings would no doubt 42409 ; benefit substantially. 42410 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 62 K20SUB MAC 9-Jun-23 22:13 Table to move an ASCIZ string 42411 subttl Table to move an ASCIZ string 42412 42413 chgsec(code,const) ; Get into the constants segment 42414 42415 000002 %azchr==.chcnb ; Table starts at Control-B 42416 suppress %azchr ; Don't need in symbol table listing 42417 .xcref %azchr ; Nor in cross reference 42418 42419 000447'03 100000 000001 asztab: xwd eoscod!.chnul, .chcna ; Only stops on a NUL 42420 xlist ; Don't need to see this blat 42421 list ; Restart the blather 42422 42423 if2 < purge %azchr > ; Temporary not needed after 2nd pass 42424 retsec ; Get out of the constants section, into code 42425 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 63 K20SUB MAC 9-Jun-23 22:13 Move an ASCIZ string 42426 subttl Move an ASCIZ string 42427 42428 ; Call: 42429 ; 42430 ; t1/ Source BP (assumed section local) 42431 ; t2/ Destination BP (assumed section local) 42432 ; 42433 ; Return: 42434 ; 42435 ; +1/ Always, but may complain 42436 ; 42437 ; t1/ Updated source pointer 42438 ; t2/ Updated destination pointer 42439 ; t3/ Length of string 42440 ; 42441 ; CAUTION: 42442 ; 42443 ; Like an ildb/idpb loop, this will overwrite all memory if you let it. 42444 ; Make CERTAIN that your strings are NUL terminated!!! 42445 42446 003470'01 movasc: intern movasc ; Also used by k20srv 42447 003470'01 015 00 0 00 000000# movst 0,asztab ; Move characters until hit a NUL 42448 003471'01 000000 000000 .chnul ; Fill character 42449 42450 303240 mxascz==:^d100000 ; A bizarre length (or ... ?) 42451 42452 003472'01 asczcp: entry asczcp ; Called by everybody 42453 remark ; Assumes can use these 42454 003472'01 261 17 0 00 000005 push p, q1 ; Piggy MOVST gorges on registers 42455 003473'01 261 17 0 00 000006 push p, q2 42456 42457 003474'01 200 05 0 00 000002 move q1, t2 ; Reposition destination for movst 42458 003475'01 200 02 0 00 000001 move t2, t1 ; Reposition source for movst 42459 003476'01 403 03 0 00 000006 setzb t3, q2 ; Force section local pointers 42460 003477'01 200 01 0 00 004265' movx t1, ; Limit source length, start significance 42461 003500'01 201 04 0 00 303240 movx t4, mxascz ; Limit destination length 42462 003501'01 123 01 0 00 003470' extend t1, movasc ; Move characters, doing useless translating 42463 003502'01 600 00 0 00 000000 nop ; Will never +1 because t1 and t4 are equal 42464 003503'01 133 00 0 00 000002 ibp t2 ; Account for .CHNUL in source 42465 003504'01 200 01 0 00 000002 move t1, t2 ; Return updated source pointer 42466 003505'01 136 06 0 00 000005 idpb q2, q1 ; Deposit a NUL at the end 42467 003506'01 200 02 0 00 000005 move t2, q1 ; Return updated destination pointer 42468 003507'01 201 03 0 00 303241 movx t3, ; Account for extra NUL byte 42469 003510'01 274 03 0 00 000004 sub t3, t4 ; Calculate length 42470 42471 003511'01 262 17 0 00 000006 pop p, q2 ; Restore registers and beat it 42472 003512'01 262 17 0 00 000005 pop p, q1 42473 003513'01 263 17 0 00 000000 ret 42474 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 64 K20SUB MAC 9-Jun-23 22:13 Various extended addressing bits 42475 SUBTTL Various extended addressing bits 42476 42477 ;[216] This is all lifted from the Extended Mode FTP Server I wrote --Tom 42478 42479 REMARK Some other stuff which perhaps should have it into MACSYM? 42480 42481 777700 000000 GP%2PF==MASKB(0,11) ; Double word pointer field 42482 770000 000000 GP%2PB==MASKB(0,5) ; Double word pointer position of byte 42483 007700 000000 GP%2SB==MASKB(6,11) ; Double word pointer size of byte 42484 000040 000000 GP%2WB==1B12 ; Double word pointer signal bit 42485 000037 777777 GP%2RS==MASKB(13,35) ; Double word reserved field 42486 377777 777777 GP%2AD==MASKB(1,35) ; Double word 30 bit address, including 42487 ; Indirect bit, index fields 42488 770000 000000 GP%1PF==MASKB(0,5) ; Single word pointer field 42489 007777 777777 GP%1AD==MASKB(6,35) ; Single word FLAT 30 bit address 42490 42491 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 65 K20SUB MAC 9-Jun-23 22:13 Double word to single word routine 42492 subttl Double word to single word routine 42493 42494 ; T2/ Double word pointer to convert 42495 ; T3/ 42496 ; 42497 ; +1 Bogus double word P&S fields 42498 ; +2 Success, coverted single word pointer in T1 42499 ; 42500 ; To do: What happends to the XMOVEI if the address pointer is bogus? 42501 ; (Bits 1 and 2 not [1|0] or [0|1] or non-zero data in reserved 42502 ; bits 2 through 12 in local indirect words) 42503 ; Is there a faster way to do this translation? 42504 42505 003514'01 627 02 0 00 000040 D2SGPC: TXZN T2,GP%2WB ; First things first, check and stomp 42506 003515'01 263 17 0 00 000000 RET ; the double word pointer bit. 42507 003516'01 630 02 0 00 004266' ANDX T2,GP%2PF ; Mask off any reserved or user sillyness 42508 003517'01 201 01 0 00 000031 MOVX T1,%OWMAX-1 ; Start at the end of the table 42509 003520'01 DO. ; Check to see if these are valid P&S 42510 003520'01 316 02 0 01 000000# CAMN T2,OW2DW(T1) ; fields for a one word global pointer 42511 003521'01 254 00 0 00 003523' EXIT. ; Found it! 42512 003522'01 365 01 0 00 003520' SOJGE T1,TOP. ; Get to next table entry 42513 003523'01 ENDDO. ; Until checked beginning 42514 003523'01 305 01 0 00 000000 CAIGE T1,0 ; Did we find a valid entry? 42515 003524'01 263 17 0 00 000000 RET ; Nope, can't do the conversion 42516 003525'01 271 01 0 00 000045 ADDI T1,^D37 ; Offset into proper single word P&S field 42517 003526'01 241 01 0 00 000036 ROT T1,<^D35-POS(GP%1PF)> ;Position to single word P&S field, saving 42518 003527'01 612 01 0 00 004267' TXNE T1,GP%1AD ; possible field overflow. And any junk? 42519 003530'01 263 17 0 00 000000 RET ; Yes, probably a bogus table offset 42520 remark ; Resolve any local or global indirection (impossible) 42521 003531'01 434 01 0 00 000003 IOR T1,T3 ; Load the 30 bit address into the one word 42522 003532'01 254 00 0 00 003467* RETSKP ; global pointer 42523 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 66 K20SUB MAC 9-Jun-23 22:13 One Word to Double word byte pointer translation table 42524 SUBTTL One Word to Double word byte pointer translation table 42525 42526 ; The table is copied from Page 2-85 in the User Operations section of 42527 ; the PDP-10 1982 Processor Reference Manual. Note that there is a 42528 ; documentation error for entry 40; it is listed as 28 and should be 18. 42529 42530 chgsec(code,const) ; Pointer table is considered constant data 42531 42532 000547'03 440600 000000 OW2DW: ; 37 Legal P&S ; 6 Bit Pointers 42533 000550'03 360600 000000 ; 38 Legal P&S 42534 000551'03 300600 000000 ; 39 Legal P&S 42535 000552'03 220600 000000 ; 40 Legal P&S 42536 000553'03 140600 000000 ; 41 Legal P&S 42537 000554'03 060600 000000 ; 42 Legal P&S 42538 000555'03 000600 000000 ; 43 Legal P&S 42539 000556'03 441000 000000 ; 44 Legal P&S ; 8 Bit Pointers 42540 000557'03 341000 000000 ; 45 Legal P&S 42541 000560'03 241000 000000 ; 46 Legal P&S 42542 000561'03 141000 000000 ; 47 Legal P&S 42543 000562'03 041000 000000 ; 48 Legal P&S 42544 000563'03 440700 000000 ; 49 Legal P&S ; 7 Bit Pointers 42545 000564'03 350700 000000 ; 50 Legal P&S 42546 000565'03 260700 000000 ; 51 Legal P&S 42547 000566'03 170700 000000 ; 52 Legal P&S 42548 000567'03 100700 000000 ; 53 Legal P&S 42549 000570'03 010700 000000 ; 54 Legal P&S 42550 000571'03 441100 000000 ; 55 Legal P&S ; 9 Bit Pointers 42551 000572'03 331100 000000 ; 56 Legal P&S 42552 000573'03 221100 000000 ; 57 Legal P&S 42553 000574'03 111100 000000 ; 58 Legal P&S 42554 000575'03 001100 000000 ; 59 Legal P&S 42555 000576'03 442200 000000 ; 60 Legal P&S ; 18 Bit Pointers 42556 000577'03 222200 000000 ; 61 Legal P&S 42557 000600'03 002200 000000 ; 62 Legal P&S 42558 000032 %OWMAX==.-OW2DW ; One Word Maximum byte pointer magic number 42559 .xcref %OWMAX ; Don't need this temporary in the cross reference 42560 suppress %OWMAX ; Don't need this temporary in the symbol listing 42561 42562 IFN <%OWMAX-<^D62-^D37+1>>,^_ 42563 <.fatal Illegal number of one word to double word pointer fields> 42564 42565 if2 < purge %OWMAX > ; Not needed after pass two 42566 retsec ; Restore .psect's 42567 42568 ;[216] End code insertion 42569 42570 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 67 K20SUB MAC 9-Jun-23 22:13 CRC Routines 42571 subttl CRC Routines 42572 42573 ;[66] CRC calculation 42574 ; 42575 ; This routine will calculate the CRC for a string, using the 42576 ; CRC-CCITT polynomial. 42577 ; 42578 ; The string should be the fields of the packet between but not including 42579 ; the and the block check, which is treated as a string of bits with 42580 ; the low order bit of the first character first and the high order bit of the 42581 ; last character last -- this is how the bits arrive on the transmission line. 42582 ; The bit string is divided by the polynomial 42583 ; 42584 ; x^16+x^12+x^5+1 42585 ; 42586 ; The initial value of the CRC is 0. The result is the remainder of this 42587 ; division, used as-is (i.e. not complemented). 42588 ; 42589 ; Contributed by Nick Bush, Stevens Institute of Technology. 42590 ; 42591 ; Call with 42592 ; t1/ length of string 42593 ; t2/ 8-bit byte pointer to string 42594 ; Returns +1 always, with t1/ 16-bit CRC, t2 unchanged. 42595 ; 42596 ; AC usage: 42597 ; t1/ Accumulated CRC 42598 ; q4/ Remaining length 42599 ; q3/ Byte pointer to string 42600 ; q2/ temp 42601 ; q1/ temp 42602 42603 003533'01 crcclc: entry crcclc ; Identify our location for LINK 42604 extern parity,none ; Inform of our necessary 42605 003533'01 265 16 0 00 004270' saveac ; Save q1-q4, and t2. 42606 003534'01 120 07 0 00 000001 dmove q3,t1 ; Get arguments. 42607 003535'01 400 01 0 00 000000 setz t1, ; Initial CRC is 0. 42608 003536'01 200 02 0 00 001473* move t2, parity ;[136] Get parity. 42609 42610 003537'01 do. ;[194] Enter loop context 42611 003537'01 134 05 0 00 000010 ildb q1, q4 ; Get a character. 42612 003540'01 302 02 0 00 001472* caie t2, none ;[136] Parity = NONE? 42613 003541'01 405 05 0 00 000177 andi q1, ^o177 ;[136] No, doing parity, strip parity bit. 42614 003542'01 431 05 0 01 000000 xori q1, (t1) ; Add in with current CRC. 42615 003543'01 135 06 0 00 004304' ldb q2, [point 4,q1,31] ;Get high 4 bits. 42616 003544'01 405 05 0 00 000017 andi q1, ^o17 ; AND low 4 bits. 42617 003545'01 200 05 0 05 000000# move q1, crctb2(q1) ; Get low portion of CRC factor. 42618 003546'01 430 05 0 06 000000# xor q1, crctab(q2) ; Plus high portion. 42619 003547'01 242 01 0 00 777770 lsh t1, -^d8 ; Shift off a byte from previous CRC. 42620 003550'01 430 01 0 00 000005 xor t1, q1 ; Add in new value. 42621 003551'01 367 07 0 00 003537' sojg q3, top. ; Loop for all characters. 42622 003552'01 enddo. ;[194] Fall out of loop context 42623 42624 003552'01 263 17 0 00 000000 ret ; Done, return +1 with CRC in t1. 42625 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 68 K20SUB MAC 9-Jun-23 22:13 Data tables for CRC-CCITT generation 42626 subttl Data tables for CRC-CCITT generation 42627 42628 chgsec(code,const) ;[208] Table goes in constants section 42629 42630 000601'03 000000 000000 crctab: oct 0 42631 000602'03 000000 010201 oct 10201 42632 000603'03 000000 020402 oct 20402 42633 000604'03 000000 030603 oct 30603 42634 000605'03 000000 041004 oct 41004 42635 000606'03 000000 051205 oct 51205 42636 000607'03 000000 061406 oct 61406 42637 000610'03 000000 071607 oct 71607 42638 000611'03 000000 102010 oct 102010 42639 000612'03 000000 112211 oct 112211 42640 000613'03 000000 122412 oct 122412 42641 000614'03 000000 132613 oct 132613 42642 000615'03 000000 143014 oct 143014 42643 000616'03 000000 153215 oct 153215 42644 000617'03 000000 163416 oct 163416 42645 000620'03 000000 173617 oct 173617 42646 42647 000621'03 000000 000000 crctb2: oct 0 42648 000622'03 000000 010611 oct 10611 42649 000623'03 000000 021422 oct 21422 42650 000624'03 000000 031233 oct 31233 42651 000625'03 000000 043044 oct 43044 42652 000626'03 000000 053655 oct 53655 42653 000627'03 000000 062466 oct 62466 42654 000630'03 000000 072277 oct 72277 42655 000631'03 000000 106110 oct 106110 42656 000632'03 000000 116701 oct 116701 42657 000633'03 000000 127532 oct 127532 42658 000634'03 000000 137323 oct 137323 42659 000635'03 000000 145154 oct 145154 42660 000636'03 000000 155745 oct 155745 42661 000637'03 000000 164576 oct 164576 42662 000640'03 000000 174367 oct 174367 42663 retsec ;[208] Re-open executable code 42664 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 69 K20SUB MAC 9-Jun-23 22:13 setgrd - set up guard pages for stacks, etc. 42665 subttl setgrd - set up guard pages for stacks, etc. 42666 42667 ; Lifted from Extended Mode FTP server I wrote, EFTPSA. 42668 ; 42669 ; A guard page is a no-access page, call it 'explode-on-use'. 42670 42671 .endps code ; End code psect 42672 .psect data ; Need some local storage 42673 42674 000075'05 000000 000000 myccoc: 0 ;[161] CCOC words for my tty. 42675 000076'05 000000 000000 0 ;[161] (two of them) 42676 000077'05 000000 000000 ttpau: 0 ;[161] Controlling TTY's pause chars. 42677 42678 000100'05 000000 000000 grdpg2: 0 ; Guard page in memory 42679 000101'05 000000 000000 grdadr: 0 ; Address of same 42680 000102'05 000000 000000 grdhan: 0 ; File handle of guard page 42681 000103'05 000000 000000 grdmap: 0 ; Process handle of guard page 42682 .endps data ; Done with writable storage 42683 42684 .psect datend/ronly,110000 ; Mark the end of the data .psect 42685 000000'06 datgrd: block ^d512 ; So we can drop in a guard page 42686 .endps datend ; Yet doesn't store anything 42687 42688 .psect const ; Table of addresses goes in constants 42689 000641'03 000000 006000 guardp: macgp1 ; Macro guard page 1 (before mapping window) 42690 000642'03 000000 010000 macgp2 ; Second guard page is after file mapping window 42691 000643'03 000000 020000 macgp3 ; Third guard page is after macro storage 42692 000644'03 000000 030000 macgp4 ; Fourth guard page is after garbage collection 42693 emacro < ; Only if I've finished the macro editor ... 42694 macgp5 ; Fifth guard page is after macro editing 42695 >;;emacro 42696 000645'03 000000000000# datgrd ; Put a guard page here, too 42697 000646'03 777777 777777 -1 ; Note list MUST end in -1!! 42698 .endps const ; End of constants 42699 .psect code ; Reopen code psect 42700 42701 003553'01 setgrd: entry setgrd ; Called at start up 42702 003553'01 265 16 0 00 004056' saveac ; Save some scratch registers 42703 003554'01 260 17 0 00 003575' call fepage ; Go find an illegal page 42704 003555'01 263 17 0 00 000000 ret ; But couldn't ... 42705 003556'01 124 01 0 00 000000# dmovem t1, grdpg2 ; Record as guard page double word 42706 003557'01 202 03 0 00 000000# movem t3, grdhan ; Save the file page handle, also 42707 003560'01 550 05 0 00 000001 hrrz q1, t1 ; Load the in-memory guard page 42708 003561'01 505 05 0 00 600000 hrli q1, .fhslf!fh%epn ; Convert to extended page handle in this fork 42709 003562'01 202 05 0 00 000000# movem q1, grdmap ; Save as a guard page mapping 42710 003563'01 415 06 0 00 000000# xmovei q2, guardp ; Load the address of guard page list 42711 42712 003564'01 do. ; Loop, setting up guard pages 42713 003564'01 335 02 0 06 000000 skipge t2, (q2) ; Pick up the guard page address 42714 003565'01 263 17 0 00 000000 ret ; Done, leave 42715 remark Case III: ; Mapping One Process's Pages to Another Process 42716 003566'01 242 02 0 00 777767 adr2pg t2, ; Convert address to page 42717 003567'01 505 02 0 00 600000 hrli t2, .fhslf!fh%epn ; page handle for this process 42718 003570'01 200 01 0 00 000005 move t1, q1 ; Load our base guard page handle 42719 003571'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 15:19 11-Jun-23 Page 69-1 K20SUB MAC 9-Jun-23 22:13 setgrd - set up guard pages for stacks, etc. 42720 003572'01 104 00 0 00 000056 PMAP% ; Finally map in a bogus page 42721 003573'01 320 12 0 00 003574' erjmpr .+1 ; Catch and ignore error 42722 003574'01 344 06 0 00 003564' aoja q2, top. ; Loop for another guard page 42723 003575'01 enddo. ; End of loop lexical context 42724 42725 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 70 K20SUB MAC 9-Jun-23 22:13 FEPAGE - Find an illegal page to map 42726 SUBTTL FEPAGE - Find an illegal page to map 42727 42728 ; Original code lifted from Tops-20 Extended Mode FTP server. 42729 ; 42730 ; Creates a page in the page map that is illegal to reference in *ANY* 42731 ; way, including reading. Does this by first finding a page in our 42732 ; address space that contains a page from our executable and then 42733 ; mapping in a page that file that is known not to exist and cannot be 42734 ; created. 42735 ; 42736 ; I call it an 'Explode-on-Use' page. 42737 ; 42738 42739 ; A guard page is created by mapping in a non-existant page that is 42740 ; past the end of our executable file. The executable file has the 42741 ; following properties: it is not extendable while mapped nor is it 42742 ; copy-on-write. Thus, a write to this file page will fail because 42743 ; the .EXE is locked. A read will fail because the page must be 42744 ; created in order to be read. Since it isn't writable to begin with, 42745 ; it can't be created. 42746 ; 42747 ; See R.E. Gorin, "Introduction to DECSYSTEM-20 Assembly Language 42748 ; Programming", page 443, footnote 3 for further details. Thanks to 42749 ; MRC for suggesting this approach. 42750 ; 42751 ; Returns: 42752 ; 42753 ; T1/ Page number of guard page 42754 ; T2/ 30 bit address of guard page 42755 ; T3/ File window handle of guard page (JFN,,Page number) 42756 ; 42757 ; Note: Maybe I ought to use XRMAP% below in case I have to shuttle 42758 ; through a lot of pages. In practice, however, I rarely have to 42759 ; process more than one page, so it didn't seem worth it and therefore 42760 ; I used a simple RMAP% instead. 42761 ; 42762 ; To do: MRC said that for certain size executable, this code won't 42763 ; work. Check for that size here and do something intelligent 42764 ; if so. Or gronk. 42765 42766 003575'01 265 16 0 00 004305' fepage: saveac ; Needs some registers 42767 003576'01 201 14 0 00 000031 movx p4, ^d25 ; Don't look through more than this many pages 42768 003577'01 415 13 0 00 003577' xmovei p3, . ; Load current executable address 42769 003600'01 242 13 0 00 777767 adr2pg p3, ; Convert address to page which we don't 42770 ; look at because DDT is probably there 42771 003601'01 fndpag: do. ; Now find a page with our JFN in it 42772 003601'01 363 14 0 00 003464* sojle p4, R ; Did this too many times? Return +1 42773 003602'01 350 01 0 00 000013 aos t1, p3 ; Increment and load page number 42774 003603'01 505 01 0 00 600000 hrli t1,.fhslf!fh%epn ; Looking at this fork 42775 003604'01 104 00 0 00 000057 RPACS% ; Find out the access 42776 003605'01 320 12 0 00 003601' erjmpr top. ; Couldn't, go to next page 42777 003606'01 607 02 0 00 010000 txnn t2, pa%pex ; Does the page exist? 42778 003607'01 254 00 0 00 003601' loop. ; No, go look for another one 42779 003610'01 603 02 0 00 000200 txne t2, pa%prv ; Is the page private? 42780 003611'01 254 00 0 00 003601' loop. ; Yes, we need one with a JFN in it k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 70-1 K20SUB MAC 9-Jun-23 22:13 FEPAGE - Find an illegal page to map 42781 003612'01 104 00 0 00 000061 rmap% ; Get a handle on the page 42782 003613'01 320 12 0 00 003601' erjmpr top. ; Gronked, go on to next page 42783 003614'01 607 02 0 00 010000 txnn t2, pa%pex ; Sanity Check: does the page still exist? 42784 003615'01 254 00 0 00 003601' loop. ; No, go look for another one 42785 003616'01 554 01 0 00 000001 hlrz t1, t1 ; Load just the process/file designator 42786 003617'01 306 01 0 00 400000 cain t1, .fhslf ; Quick check, this isn't our own process, is it? 42787 003620'01 254 00 0 00 003601' loop. ; Yah, it is, so worthless; bum the GTSTS% 42788 003621'01 104 00 0 00 000024 GTSTS% ; Otherwise, see if we can use this? 42789 003622'01 320 12 0 00 003601' erjmpr top. ; No JFN, so just go to the next page 42790 003623'01 607 02 0 00 000200 txnn t2, gs%nam ; Is anything in there a JFN? 42791 003624'01 254 00 0 00 003601' loop. ; No, not safe to use 42792 003625'01 607 02 0 00 400000 txnn t2, gs%opn ; Is the file open? 42793 003626'01 254 00 0 00 003601' loop. ; No, won't be able to PMAP% it 42794 003627'01 603 02 0 00 100000 txne t2, gs%wrf ; Better not be for write 42795 003630'01 254 00 0 00 003601' loop. ; It is, will self-create, then 42796 003631'01 607 02 0 00 020000 txnn t2, gs%rnd ; Open for non-append access? 42797 003632'01 254 00 0 00 003601' loop. ; No, will extend then 42798 remark ; If we get here, we fall out of the loop 42799 003633'01 enddo. ; End of loop context 42800 ; Otherwise, we have a safe page to use 42801 003633'01 553 13 0 00 000001 hrrzs p3, t1 ; Save a nice JFN 42802 003634'01 104 00 0 00 000036 SIZEF% ; Get the number of pages in the file 42803 003635'01 320 12 0 00 003601' erjmpr fndpag ; Can't, so keep looking 42804 003636'01 540 01 0 00 000013 hrr t1, p3 ; Load our executable JFN 42805 003637'01 504 01 0 00 000003 hrl t1, t3 ; Start REAL NEAR the end of the file 42806 003640'01 104 00 0 00 000031 FFFFP% ; Find the first unused (free) file page 42807 003641'01 320 12 0 00 003601' erjmpr fndpag ; Can't, so keep looking 42808 003642'01 316 01 0 00 004023' camn t1, [-1] ; None?? 42809 003643'01 254 00 0 00 003601' jrst fndpag ; No, continue the journey 42810 42811 remark ; Otherwise, have a guard page from the file!! 42812 003644'01 200 12 0 00 000001 move p2, t1 ; Save as source designator 42813 42814 remark Case I: ; Mapping File Pages to a Process 42815 003645'01 514 01 0 00 000013 hrlz t1, p3 ; JFN of executable file in the left half 42816 003646'01 540 01 0 00 000012 hrr t1, p2 ; Page number of executable file 42817 dmove t2,[.fhslf!fh%epn,,grdpag ; Fork and page handle 42818 003647'01 120 02 0 00 004317' pm%epn] ; going into any section 42819 003650'01 104 00 0 00 000056 PMAP% ; Finally map in a bogus page 42820 003651'01 320 12 0 00 003601' erjmpr fndpag ; Gronked, try the old way 42821 003652'01 550 04 0 00 000002 hrrz t4, t2 ; Load the page we mapped 42822 003653'01 242 04 0 00 000011 pg2adr t4, ; Convert to address 42823 003654'01 200 01 1 00 000004 move t1, @t4 ; The moment of truth, this should fail 42824 003655'01 320 12 0 00 003657' ifje. r ; Well, did it? 42825 003656'01 254 00 0 00 003665' 42826 remark ; All is well, return the data 42827 003657'01 514 03 0 00 000013 hrlz t3, p3 ; Load executable file JFN 42828 003660'01 540 03 0 00 000012 hrr t3, p2 ; Load the file page number of the guard page 42829 003661'01 550 01 0 00 000002 hrrz t1, t2 ; Load page number of guard page in memory 42830 003662'01 200 02 0 00 000004 move t2, t4 ; Load the address of the guard page in memory 42831 003663'01 254 00 0 00 003532* retskp ; And return success 42832 003664'01 254 00 0 00 003666' else. ; ?? 42833 003665'01 254 00 0 00 003601' jrst fndpag ; Try some more 42834 003666'01 endif. 42835 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 71 K20SUB MAC 9-Jun-23 22:13 fndvec Find and record the symbol table vector 42836 subttl fndvec Find and record the symbol table vector 42837 42838 ; The EXEC shouldn't need this for things like ^T, yet it does... 42839 ; 42840 ; We don't need to do a PDVOP% to find our program data vector 42841 ; address because we are giving it its own .PSECT and therefore 42842 ; are setting the address ourselves 42843 ; 42844 ; We can't have LINK do this because LINK won't write .JBSYM when 42845 ; doing PDV's. 42846 ; 42847 ; Adapted from SETNOD rewrite (SETND2) 42848 ; 42849 ; N.B., While the code will properly find a symbol table in any 42850 ; section, it won't work unless it is run in a non-zero section. 42851 ; Since Kermit is effectively a section zero program with some ASCII 42852 ; data being accessed via one word global pointers, the symbol table 42853 ; and the symbol table vector must also be in section zero. 42854 42855 remark [233] 11:47am Saturday, 31 December 2022 42856 42857 ; The above isn't true, of course, we could use two 18 one word global 42858 ; pointers to fetch and OR two half words or jump into a non-zero 42859 ; section to get the data (see fetch and efetch, below). The problem 42860 ; is that this would have involved some non-obvious modifications to 42861 ; the below and the symbol table lookup routine which I didn't see 42862 ; the value of doing as opposed to finishing the NRT functionality. 42863 ; 42864 ; At the time, I didn't realize that although LINK isn't going to do 42865 ; what we want, there is nothing stopping us from using MACRO itself 42866 ; to deposit values in fixed locations in the 'low segement' area. 42867 ; See the end of this module for a bunch of loc statements, not all of 42868 ; which may be absolutely necessary, strictly speaking. 42869 ; 42870 ; The point was to maintain reverse compatibility with any PA1050 42871 ; based programs or other archaic Tops-20 oddities that hadn't been 42872 ; been upgraded to PDV's (as in, just about all of them), one in 42873 ; particular being the EXEC. 42874 ; 42875 ; The EXEC was modified in edit [T255] to the EXECP.MAC module to 42876 ; handle a 'modern' symbol table vector, which could be in a non-zero 42877 ; section. 42878 42879 ; See commentary below for new version of EXEC [T255] which can handle 42880 ; a modern symbol table vector. This gets the parts of it we want for 42881 ; later. 42882 42883 ifndef .jbsym, <.jbsym==116> ; Low segment symbol table pointer (old style) 42884 ifndef .jbsa , <.jbsa==120> ; Program start address 42885 ifndef .jbff , <.jbff==121> ; Program first free location 42886 ifndef .jbren, <.jbren==124> ; Low segment reenter word 42887 ifndef .jbver, <.jbver==137> ; Low segment version word 42888 42889 003666'01 fndvec: entry fndvec ; Called on start up 42890 remark ; Expects full run of temporaries k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 71-1 K20SUB MAC 9-Jun-23 22:13 fndvec Find and record the symbol table vector 42891 003666'01 265 16 0 00 004056' saveac ; But follow the rules, anyway 42892 003667'01 402 00 0 00 000000# setzm glbsym ; Clear global symbol table flag 42893 003670'01 403 01 0 00 000002 setzb t1, t2 ; Cons up some more zeros 42894 003671'01 124 01 0 00 000000# dmovem t1, symvec ; Stomp symbol vector and defined symbol table 42895 42896 remark ; N.B., DEPENDs on 'low segment' hand crafting, below 42897 003672'01 336 05 0 00 000116 skipn q1,.jbsym ; Nothing there? 42898 003673'01 263 17 0 00 000000 ret ; Nope, that's easy! (but useless) 42899 42900 003674'01 254 05 0 00 003675' xjrstf .+1 ; Go 'upstairs' to grab the value 42901 003675'01 010000 000000 pc%usr ; Don't try to break out of user mode 42902 003676'01 000001 000000# extsec,,fndve1 ; 'long jump' to extended mode operation 42903 .endps code ; Finish execution of section zero code 42904 42905 .psect ecode ; Resuming execution in extended code section 42906 42907 remark Caution ; The stack is ONLY valid in section zero!! 42908 42909 000012'02 fndve1: remark ; N.B., All the indirect addressing is a little slower 42910 000012'02 476 00 1 00 000130' setom @[0,,glbsym] ; Let's assume it's global (which it should be) 42911 000013'02 627 05 0 00 400000 txzn q1, 1b0 ; Just check if it's local (which it shouldn't be) 42912 000014'02 254 00 0 00 000016' ifskp. ; That's strange, but we can fix that up 42913 000015'02 501 05 0 00 000015' xhlli q1,. ; Stomp in the section number 42914 remark @[0,,glbsym] ; So it's still global (heh...) 42915 000016'02 endif. ; 42916 000016'02 202 05 1 00 000131' movem q1, @[0,,symvec] ; Store as symbol table VECTOR 42917 42918 000017'02 336 06 1 00 000005 skipn q2, @q1 ; Pull the vector length (first location) 42919 000020'02 254 00 0 00 000050' jrst fndver ; If we have one... 42920 42921 remark ; Otherwise, there is SOMETHING in there 42922 000021'02 325 06 0 00 000026' ifl. q2 ; Old style symbol table? (shouldn't be up here..) 42923 000022'02 202 06 1 00 000132' movem q2, @[0,,kjbsym] ;That's easy; just use it 42924 000023'02 254 05 0 00 000024' xjrstf .+1 ; And go 'downstairs' to return to caller 42925 000024'02 010000 000000 pc%usr ; Don't try to break out of user mode 42926 000025'02 000000000000# rskp ; Give +2 return 42927 000026'02 endif. ; End case old symbol table pointer in a strange place 42928 42929 remark ; New style symbol table vector! Grovel through it 42930 000026'02 363 06 0 00 000050' sojle q2, fndver ; But!! If nothing is in there, it's all over 42931 000027'02 415 05 0 05 000001 xmovei q1, 1(q1) ; Load address of first subtable 42932 000030'02 do. ; Enter loop context 42933 000030'02 120 01 0 05 000000 dmove t1, .stdat(q1) ; Load ST%TYP and ST%LEN and .STPTR 42934 000031'02 135 03 0 00 000133' ldb t3,[pointr (t1,st%typ)] ; Load table type 42935 000032'02 135 04 0 00 000134' ldb t4,[pointr (t1,st%len)] ; Load table length 42936 000033'02 302 03 0 00 000001 caie t3, .r50d ; Is the type a defined symbol table?? 42937 000034'02 254 00 0 00 000045' ifskp. ; Yes! It is!! 42938 000035'02 323 04 0 00 000045' andg. t4 ; But!! Does it contain any symbols? 42939 000036'02 210 03 0 00 000004 movn t3, t4 ; Load negative of length 42940 000037'02 514 01 0 00 000003 hrlz t1, t3 ; Assumes table is not greater than a section 42941 000040'02 540 01 0 00 000002 hrr t1, t2 ; Now have base of subtable 42942 000041'02 202 01 1 00 000135' movem t1,@[0,,kjbsym] ;Save for symbol table routine 42943 000042'02 254 05 0 00 000043' xjrstf .+1 ; And go 'downstairs' to return to caller 42944 000043'02 010000 000000 pc%usr ; Don't try to break out of user mode 42945 000044'02 000000000000# rskp ; Give +2 return k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 71-2 K20SUB MAC 9-Jun-23 22:13 fndvec Find and record the symbol table vector 42946 000045'02 endif. ; End case defined symbol table 42947 000045'02 415 05 0 05 000003 xmovei q1, .stsiz(q1) ; Load address of next subtable 42948 000046'02 275 06 0 00 000003 subi q2, .stsiz ; Account for words used in symbol block 42949 000047'02 327 06 0 00 000030' jumpg q2, top. ; Look some more, if anything left 42950 000050'02 enddo. ; End of loop context 42951 42952 remark ; If fell through, then never found symbol table 42953 ; Which is an error 42954 42955 000050'02 fndver: remark ; Here on any kind of error 42956 000050'02 402 00 1 00 000136' setzm @[0,,.jbsym] ; .jbsym is gubbish, so stop paying attention 42957 000051'02 402 00 1 00 000137' setzm @[0,,symvec] ; Stomp the symbol table vector too, it's bogus 42958 000052'02 254 05 0 00 000053' xjrstf .+1 ; And go 'downstairs' to return to caller 42959 000053'02 010000 000000 pc%usr ; Don't try to break out of user mode 42960 000054'02 000000000000# r ; Give +1 return 42961 42962 .endps ecode ; Get out of extended code 42963 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 72 K20SUB MAC 9-Jun-23 22:13 Magical symbol table lookup routine 42964 SUBTTL Magical symbol table lookup routine 42965 42966 ; For details, read "Introduction to DECSYSTEM-20 Assembly Language 42967 ; Programming", by Ralph Gorin, published by Digital Press, 1981. 42968 ; 42969 ; Called with desired symbol in T1 42970 42971 .psect code ; Starts out in section zero 42972 42973 003677'01 symout: entry symout ; Declare to the world 42974 003677'01 265 16 0 00 004321' saveac 42975 42976 003700'01 200 06 0 00 000001 move q2, t1 ; Save the desired symbol 42977 003701'01 403 03 0 00 000005 setzb t3 ,q1 ; no current program name or best symbol 42978 003702'01 200 04 0 00 000000# move t4, kjbsym ; Load (fixed to old style symbol table pointer 42979 003703'01 254 05 0 00 003704' xjrstf .+1 ; Go 'upstairs' to symbolically print the value 42980 003704'01 010000 000000 pc%usr ; Don't try to break out of user mode 42981 003705'01 000001 000000# extsec,,symou1 ; 'long jump' to extended mode operation 42982 .endps code ; Finish execution of section zero code 42983 42984 .psect ecode ; Resuming execution in extended code section 42985 42986 remark Caution ; The stack is ONLY valid in section zero!! 42987 42988 000055'02 322 04 0 00 000120' symou1: jumpe t4, plsoff ; Unless we don't have a symbol table 42989 000056'02 574 01 0 00 000004 hlre t1, t4 ; Convert halfword length to fullword 42990 000057'02 274 04 0 00 000001 sub t4, t1 ; -count,,ending address +1 42991 ; And hit search loop 42992 000060'02 do. ; Load this symbol's type 42993 000060'02 135 01 0 00 000140' ldb t1,[point 4,-2(t4),3] 42994 000061'02 322 01 0 00 000076' ifn. t1 ; program names are not relevant 42995 000062'02 303 01 0 00 000002 caile t1, ^o2 ; 0=prog name, 1=global, 2=local 42996 000063'02 254 00 0 00 000076' anskp. ; So skip this symbol 42997 000064'02 200 01 0 04 777777 move t1, -1(t4) ; Load value associated with the symbol 42998 000065'02 312 01 0 00 000006 came t1, q2 ; Is this an exact match, per chance? 42999 000066'02 254 00 0 00 000071' ifskp. ; It is, so no need for an offset 43000 000067'02 200 05 0 00 000004 move q1, t4 ; Just select it 43001 000070'02 254 00 0 00 000100' exit. ; And get out of the loop 43002 000071'02 endif. 43003 000071'02 311 01 0 00 000006 caml t1, q2 ; Is the value before the value sought? 43004 000072'02 254 00 0 00 000076' anskp. ; No, so can't use (would be a negative offset) 43005 000073'02 332 02 0 00 000005 skipe t2, q1 ; Otherwise get the best one so far (if there is one) 43006 000074'02 311 01 0 02 777777 caml t1, -1(t2) ; compare to previous best 43007 000075'02 200 05 0 00 000004 move q1, t4 ; current symbol is best match so far 43008 000076'02 endif. ; End case symbol selection 43009 000076'02 270 04 0 00 000141' add t4, [2000000-2] ; Add 2 in the left, sub 2 in the right 43010 000077'02 321 04 0 00 000060' jumpl t4,top. ; Loop unless control count is exhausted 43011 000100'02 enddo. 43012 43013 000100'02 322 05 0 00 000120' ifn. q1 ; Did we have anything that could help? 43014 000101'02 200 02 0 00 000006 move t2, q2 ; Yes, get desired value 43015 000102'02 274 02 0 05 777777 sub t2, -1(q1) ; Less symbol's value = offset 43016 000103'02 301 02 0 00 000200 cail t2, 200 ; Is the offset small enough to be conceptually useful? 43017 000104'02 254 00 0 00 000120' anskp. ; No, we can't count that high in our head 43018 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 15:19 11-Jun-23 Page 72-1 K20SUB MAC 9-Jun-23 22:13 Magical symbol table lookup routine 43019 000106'02 621 01 0 00 740000 txz t1, ; Clear the symbols' flags 43020 000107'02 do. ; Build us a return address 43021 000107'02 254 14 0 00 000007 xsfm q3 ; Save processor flags 43022 000110'02 415 10 0 00 000114' xmovei q4,endlp. ; Load end of this pseudo-loop (return address) 43023 000111'02 254 05 0 00 000112' xjrstf .+1 ; Go 'downstairs' to use the stack 43024 000112'02 010000 000000 pc%usr ; Don't try to break out of user mode 43025 000113'02 000000 000000# 0,,sqztyo ; 'long jump' to section zero to print symbol name 43026 000114'02 enddo. ; End of this strange call linkage 43027 000114'02 274 06 0 05 777777 sub q2, -1(q1) ; Value we wanted less this symbol's value 43028 000115'02 322 06 0 00 000125' jumpe q2, plsof1 ; If no offset, don't print "+0" 43029 000116'02 201 01 0 00 000053 movei t1, "+" ; Append a plus sign to the output line 43030 000117'02 104 00 0 00 000074 pbout% 43031 000120'02 endif. 43032 43033 000120'02 201 01 0 00 000101 plsoff: movei t1, .priou ; and copy numeric offset to output 43034 000121'02 200 02 0 00 000006 move t2, Q2 ; Load offset from symbol 43035 000122'02 201 03 0 00 000010 movei t3, ^d8 ; Addresses are in octal... 43036 000123'02 104 00 0 00 000224 NOUT% 43037 000124'02 320 12 0 00 000125' erjmpr plsof1 ; Catch and ignore error 43038 000125'02 254 05 0 00 000126' plsof1: xjrstf .+1 ; And go 'downstairs' to return to caller 43039 000126'02 010000 000000 pc%usr ; Don't try to break out of user mode 43040 000127'02 000000000000# r ; Give +1 return 43041 43042 .endps ecode ; Done with non-zero section execution 43043 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 73 K20SUB MAC 9-Jun-23 22:13 recursively convert a 32-bit quantity in T1 from squoze to ASCII 43044 subttl recursively convert a 32-bit quantity in T1 from squoze to ASCII 43045 43046 .psect code ; Needs to be in section zero to use the stack 43047 43048 remark Caution ; Called with inter-section hand crafted JSP-type linkage 43049 43050 ; Call: 43051 ; 43052 ; t1/ SQUOZE word 43053 ; q3/ Processor flags to restore 43054 ; q4/ 30 bit return address 43055 43056 003706'01 261 17 0 00 003721' sqztyo: push p,sqztyr ; Push inter-section return address 43057 003707'01 265 16 0 00 004337' saveac ; Save t2, just in case 43058 43059 003710'01 231 01 0 00 000050 sqzty1: idivi t1, 50 ; divide by 50 to extract a Radix-50 'digit' 43060 003711'01 261 17 0 00 000002 push p, t2 ; save remainder, a Radix-50 character 43061 003712'01 332 00 0 00 000001 skipe t1 ; if T1 is now zero, unwind the stack 43062 003713'01 260 17 0 00 003710' call sqzty1 ; call self again, reducing t1 by an another 'digit' 43063 43064 remark ; If we fall through, then it's type to unwind 43065 003714'01 262 17 0 00 000001 pop p, t1 ; Get characters back in reverse order 43066 003715'01 133 01 0 00 003723' adjbp t1, rdx50c ; Index to the correct character 43067 003716'01 135 01 0 00 000001 ldb t1, t1 ; convert squoze code to ASCII 43068 003717'01 104 00 0 00 000074 pbout% ; Type it 43069 003720'01 263 17 0 00 000000 ret ; Continue unwinding, finally 'returning' below 43070 43071 003721'01 254 00 0 00 003722' sqztyr: jrst .+1 ; This pushed jrst goes to the xjrstf 43072 003722'01 254 05 0 00 000007 xjrstf q3 ; Transfer back to non-section zero caller 43073 43074 003723'01 35 07 0 00 003724' rdx50c: point 7,.+1,6 ; Points to the first character in the string (the space) 43075 003724'01 040 060 061 062 063 ascii " 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ.$%" 43076 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 74 K20SUB MAC 9-Jun-23 22:13 fetch a word from extended address space 43077 subttl fetch a word from extended address space 43078 43079 ;[223] Begin code insertion 43080 43081 ; Call: 43082 ; 43083 ; t1/ Extended address to fetch 43084 ; 43085 ; Return: 43086 ; 43087 ; t1/ Updated in all cases 43088 ; 43089 ; +1/ Possible error code 43090 ; +2/ Value at specified location 43091 43092 repeat 0,< ; Actually turned out to be unnecessary ... 43093 fetch: saveac ; Save a scratch register 43094 xjrstf .+1 ; Go 'upstairs' to grab the value 43095 pc%usr ; Don't try to break out of user mode 43096 extsec,,efetch ; 'long jump' to extended mode operation 43097 43098 .endps code ; Get out of section zero 43099 .psect ecode ; and into non-zero section 43100 43101 efetch: move t2, @t1 ; Grab whatever we've been pointed at 43102 erjmpr fetche ; Unless it was gubbish 43103 43104 move t1, t2 ; Return value in t1 43105 xjrstf .+1 ; Go 'downstairs' to return to caller 43106 pc%usr ; Don't try to break out of user mode 43107 rskp ; Give +2 return 43108 43109 fetche: remark ; Here on addressing error from move 43110 xjrstf .+1 ; Go 'downstairs' to return to caller 43111 pc%usr ; Don't try to break out of user mode 43112 r ; Give +1 return 43113 43114 .endps ecode ; Get out of extended code 43115 .psect code ; And back into section zero code 43116 >;repeat 0 ; End removal 43117 43118 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 75 K20SUB MAC 9-Jun-23 22:13 Kermit Entry Vector and Version 43119 subttl Kermit Entry Vector and Version 43120 43121 ;[197] Moved here to support symbol table fix up, yet some still in k20mit 43122 43123 ; Used to help LINK build version word 43124 43125 extern $verno ; Major version number. 43126 extern $mnver ; Minor version number (minimum: 1). 43127 extern $edno ; Edit number increases independent of version. 43128 extern $who ; Who edited, 0=Columbia. 43129 43130 ; Used to help LINK to build entry vector 43131 43132 extern start ; Regular entry 43133 extern reen ; 'Re-enter' address 43134 43135 ; 'Modern' Tops-20 entry vector 43136 43137 003734'01 254 00 0 00 000000* kermit: jrst start ; Start entry. 43138 003735'01 254 00 0 00 000000* jrst reen ; Re-entry. 43139 k20ver==:FLD($who,VI%WHO)!FLD($verno,VI%MAJ)!FLD($mnver,VI%MIN)!^_ 43140 000000000000# FLD($edno,VI%EDN)!VI%DEC ;;[184] Want decimal version numbers 43141 003736'01 000000000000# k20ver ;[190] 43142 000003 evlen==.-kermit ; Mark for k20mit end statement 43143 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 76 K20SUB MAC 9-Jun-23 22:13 Closing Code particulars 43144 subttl Closing Code particulars 43145 43146 xlist ; Save the trees!! 43147 list ; Resume listing 43148 43149 .endps code ; Close the code .psect 43150 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 77 K20SUB MAC 9-Jun-23 22:13 Data storage, not in global scope 43151 subttl Data storage, not in global scope 43152 43153 .psect data ; Writable 43154 repeat 0,< ;[218] 43155 tmcbit: 0 ;[194] Time channel bit 43156 > ;[218] 43157 000104'05 000000 000000 ccichr: 0 ;[219] Control-C Interrupt Character (we used) 43158 43159 000105'05 000000 000000 aicx: 0 ;[194] Count of AIC% failures 43160 000106'05 000000 601405 laicer: lstrx1 ;[194] Last AIC% error (no error) 43161 000107'05 000000 601405 ltimcr: lstrx1 ;[194] Last TIMER% creation (.timel) error 43162 000110'05 000000 000000 dicx: 0 ;[194] Count of DIC% errors 43163 000111'05 000000 601405 ldicer: lstrx1 ;[194] Last DIC% error (no error) 43164 000112'05 000000 601405 ltimde: lstrx1 ;[194] Last .TIMBF (delete) error 43165 43166 000113'05 000000 000000 glbsym: 0 ;[197] If global (should never be) 43167 000114'05 000000 000000 symvec: 0 ;[197] Address of symbol table vector 43168 000115'05 000000 000000 kjbsym: 0 ;[197] Kermit's defined symbol table 43169 43170 000116'05 000000 000000 ddtf:: 0 ;[197] Debugger present flag 43171 000117'05 lcltte: block 10 ; Last errors encounter by LCLTTY 43172 000127'05 lcltef: remark ; Final location to whack 43173 000127'05 lcldev: block 1 ; Device we're going to try 43174 000130'05 lclnam: block 4 ; Space for constructed terminal 43175 000134'05 lcljfn: block 1 ; JFN we got 43176 000135'05 lclflg: block 1 ; Associated flags (which we don't use) 43177 000136'05 lclpar::block 1 ;[223] Local terminal parity 'toleration' 43178 43179 000137'05 000000 000000 ccn: 0 ;[187] Number of ^C's typed. 43180 000140'05 000000 000000 psave: 0 ; Stack pointer for ^C interrupt. 43181 000141'05 000000 000000 psave2: 0 ; Stack top for ^C interrupt. 43182 000142'05 000000 000000 tsave: 0 ;[132] Same as above, but for timer interrupts. 43183 000143'05 000000 000000 tsave2: 0 ;[132] ... 43184 000144'05 000000 000000 pc1: 0 ;[196] Interrupt PC storage, levels 1, 43185 000145'05 000000 000000 pc2: 0 ; 2, 43186 000146'05 000000 000000 pc3:: 0 ; and 3. 43187 43188 000147'05 605457 664562 'plover' ; Talsiman to see if stomped 43189 .endps data 43190 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 78 K20SUB MAC 9-Jun-23 22:13 Misc. utility .PSECT's 43191 subttl Misc. utility .PSECT's 43192 43193 remark File Mapping Page 43194 .psect filepg,maporg ; File mapping window 43195 000000'07 block maplen ; Reserves a page 43196 .endps ; Allows LINK time checking 43197 43198 remark Guard pages for files and macros 43199 43200 .psect guard/ronly,grdorg ; Declare detonate-on-use page 43201 .endps ; Nothing in it until runtime 43202 43203 .psect guard1/ronly,macgp1 43204 000000'11 007071 727271 'xyzzy' ; Force a magic page... 43205 000001'11 block ^d511 ; Keep LINK up to date on size 43206 .endps guard1 43207 43208 .psect guard2/ronly,macgp2 43209 000000'12 006054 654750 'plugh' ; Force another magic page... 43210 000001'12 block ^d511 ; Keep LINK up to date on size 43211 .endps guard2 43212 43213 .psect guard3/ronly,macgp3 43214 000000'13 605457 664562 'plover' ; Force another magic page... 43215 000001'13 block ^d511 ; Keep LINK up to date on size 43216 .endps guard3 43217 43218 .psect guard4/ronly,macgp4 43219 000000'14 005465 555763 'lumos' ; Force another magic page... 43220 000001'14 block ^d511 ; Keep LINK up to date on size 43221 .endps guard4 43222 43223 emacro < 43224 .psect guard5/ronly,macgp5 43225 'nox' ; Force another magic page... 43226 block ^d511 ; Keep LINK up to date on size 43227 .endps guard5 43228 >;;emacro 43229 43230 remark Symbol table .PSECT 43231 .text "/symseg:psect:symbol" ; Tell LINK where to put the goodies 43232 .psect symbol/ronly,symorg ; Write-Protected symbols 43233 .endps symbol ; Close out the PSECT 43234 43235 remark Seperate patch area .PSECT, otherwise it will be read-only 43236 .text "/patchsize:0" ; Tell LINK not to allocate a patch area 43237 .psect patch,patorg ; Patch area 43238 000000'16 PAT..:: block patlen ; Override LINK 43239 .endps patch ; Close out the PSECT 43240 43241 remark Reserve pages for in-section DDT so code doesn't bump into it 43242 .psect ddt/ronly,700000 ; If DDT is in section 0 43243 000000'17 block 777777-700000+1 ; Reserve last 64 pages 43244 .endps 43245 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 79 K20SUB MAC 9-Jun-23 22:13 PDV setup and location 43246 subttl PDV setup and location 43247 43248 ; This is the Program Data Vector .PSECT. We don't write anything 43249 ; directly in there; we pass switchs to have LINK fill it in for us 43250 43251 .text "/pvblock:psect:pdv" ; Put program PDV's in the PDV .PSECT 43252 .psect pdv/ronly,pdvorg ; Write-Protected PDV! 43253 .endps pdv ; Close out the PSECT 43254 43255 ; Macro to resolve symbols into values for stupid LINK. 43256 ; Note, this must be last or the macro will produce X errors 43257 ; because the symbols haven't been seen yet. Maybe see 43258 ; what IF2 would do if we want to move this around. 43259 43260 define defpdv (name,data) < 43261 .text "/pvdata:'name':#'data" 43262 >;define defpdv 43263 43264 ; Note, although the monitor knows about the reenter address 43265 ; (the PDV offset is .PVREE), LINK doesn't. Sigh... 43266 43267 .text '/pvdata:name:"K20MIT"' ;;Different from save name 43268 defpdv start,\kermit ; Kermit start address 43269 ; defpdv reentr,\reen ; Kermit reenter address (obsolete) 43270 ; remark ; Have to set this in LINK 43271 ; defpdv version,\k20ver ; Kermit version word 43272 k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page 80 K20SUB MAC 9-Jun-23 22:13 'Low segment' fix ups 43273 SUBTTL 'Low segment' fix ups 43274 43275 ;[227] Begin code insertion 43276 43277 ;[T255] Build page zero by hand since EXEC can now handle a symbol 43278 ; table in a non-zero section, but LINK doesn't quite set everything 43279 ; up correctly. 43280 ; 43281 ; A multi-section program can get complicated enough so that LINK 43282 ; can't fill in values in the 'low segment' with the 'appropriate' 43283 ; values. The problem is certain programs which don't use PDV's to 43284 ; find this stuff out, the first being an enhanced GLXLIB and the 43285 ; other being the EXEC, which may not be able to tell which PDV to 43286 ; use. 43287 ; 43288 ; Therefore, we issue the /NOINITIAL /NOJOBDAT switches *first* to 43289 ; keep LINK from getting it wrong and poke the values in ourselves, 43290 ; here. See JOBDAT for additional information. 43291 43292 033000 kjbffl== ; Kermit's first free location is after the patch area 43293 43294 ; N.B., This LOC/RELOC Hackery *MUST* take place in the outer-most .PSECT!!!! 43295 43296 000116 loc .jbsym ; Get to symbol table pointer 43297 000116 000001 400000 symorg ; The EXEC can now handle a symbol table vector!! 43298 000120 loc .jbsa ; Get to job start address 43299 000120 033000 000000# xwd kjbffl,kermit ; Note, odd left half 43300 000121 loc .jbff ; Get to first free location 43301 000121 000000 033000 kjbffl ; End defined writable storage 43302 000124 loc .jbren ; The Reenter address 43303 000124 000000000000# reen ; This is all in Kermit's entry vector, actually... 43304 000137 loc .jbver ; Get to the version word 43305 000137 000000000000# k20ver ; Drop Kermit's version in 43306 43307 000000'00 reloc ; Get back ... someplace ... 43308 43309 ;[227] End code insertion 43310 43311 000003 003734' end evlen,,kermit ;[197] Had to get moved here, sigh... NO ERRORS DETECTED PROGRAM BREAK IS 000000 PSECT 1 BREAK IS 004350 FOR CODE PSECT 2 BREAK IS 000142 FOR ECODE PSECT 3 BREAK IS 000647 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 15:19 11-Jun-23 Page 80-1 K20SUB MAC 9-Jun-23 22:13 '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:01.657 123P CORE USED k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page S-1 K20SUB MAC 9-Jun-23 22:13 SYMBOL TABLE AIC 104000 000131 int GJ%SHT 000001 000000 sin P1 000011 spd SC%DNA 001000 sin AIC% 104000 000131 int GPJFN% 104000 000206 int P2 000012 spd SC%GTB 200000 000000 sin ATI 104000 000137 int GRDORG 033000 spd P3 000013 spd SC%OPR 200000 sin ATI% 104000 000137 int GRDPAG 000033 spd P4 000014 spd SC%WHL 400000 sin ATMBUF 000000 ext GS%ERR 000400 000000 sin P5 000015 spd SCHR 000013 spd BADMSK 113777 176377 spd GS%NAM 000200 000000 sin PA%PEX 010000 000000 sin SCRLFT 000000 ext BOUT 104000 000051 int GS%OPN 400000 000000 sin PA%PRV 000200 000000 sin SFCOC 104000 000113 int BOUT% 104000 000051 int GS%RND 020000 000000 sin PANDAS 000001 sin SFCOC% 104000 000113 int CALL 260740 000000 GS%WRF 100000 000000 sin PARS1 000000 ext SFMOD 104000 000110 int CALLRE 254000 000000 spd GTJFN% 104000 000020 int PARS2 000000 ext SFMOD% 104000 000110 int CF%NUD 400000 000000 sin GTSTS% 104000 000024 int PARS3 000000 ext SFPTR% 104000 000027 int CHFDB% 104000 000064 int GUARD 000000 ext PARS4 000000 ext SIR% 104000 000125 int CJFNBK 000000 ext GUARD1 000000 ext PARS5 000000 ext SIZEF% 104000 000036 int CLOSF% 104000 000022 int GUARD2 000000 ext PATCH 000000 ext SOUT% 104000 000053 int CLSX1 600160 int GUARD3 000000 ext PATLEN 002000 spd SPACK 000000 ext CO%NRJ 400000 000000 sin GUARD4 000000 ext PATORG 031000 spd SPSIZ 000000 ext CODE 000000 ext HALTF% 104000 000170 int PBOUT 104000 000074 int ST%LEN 007777 777777 spd CONST 000000 ext JFNS% 104000 000030 int PBOUT% 104000 000074 int ST%TYP 770000 000000 spd CRLF 000000 ext JOBTAB 000000 ext PC%USR 010000 000000 sin STIW 104000 000174 int CX 000016 JS%PAF 000001 sin PDV 000000 ext STIW% 104000 000174 int CZ%ABT 004000 000000 sin KJBFFL 033000 spd PDVORG 600000 spd STPAR 104000 000217 int CZSEEN 000000 ext KLFLGS 777700 000000 spd PGSHFT 000011 sin STPAR% 104000 000217 int DATA 000000 ext LSTRX1 601405 int PKTNUM 000000 ext STRBUF 000000 ext DATEND 000000 ext M 100000 000000 spd PM%EPN 000200 000000 sin SUBBP 000000 ext DDT 000000 ext MACGP1 006000 spd PM%RD 100000 000000 sin SYMBOL 000000 ext DEBRK 104000 000136 int MACGP2 010000 spd PM%WR 040000 000000 sin SYMORG 000001 400000 spd DEBRK% 104000 000136 int MACGP3 020000 spd PMAP% 104000 000056 int T1 000001 spd DESX1 600150 int MACGP4 030000 spd PSOUT 104000 000076 int T2 000002 spd DESX3 600152 int MAPLEN 001000 spd PSOUT% 104000 000076 int T3 000003 spd DEVST% 104000 000121 int MAPORG 007000 spd Q1 000005 spd T4 000004 spd DIC 104000 000133 int MAPPAG 000007 spd Q2 000006 spd T5 000005 spd DIC% 104000 000133 int MAXPKT 000140 spd Q3 000007 spd TIMER 104000 000522 int DTI 104000 000140 int MO%CDN 777000 000000 sin Q4 000010 spd TIMER% 104000 000522 int DTI% 104000 000140 int MO%DAV 777000 sin Q5 000011 spd TLGJFN 000000 ext DV%TYP 000777 000000 sin MO%INA 000777 000000 sin R 000000 ext TRMCOD 500000 spd DVCHR% 104000 000117 int MO%PAR 000010 sin RCHR 000012 spd TS%CTC 001000 000000 spd ECDORG 000001 600000 spd MOVSLJ 016000 000000 REEN 000000 ext TS%CTM 200000 000000 spd ECODE 000000 ext MOVST 015000 000000 RET 263740 000000 TS%DEV 010000 000000 spd EIR% 104000 000126 int MTOPR% 104000 000077 int RF%LNG 400000 000000 sin TS%EFH 002000 000000 spd EOSCOD 100000 spd N 200000 000000 spd RFCOC 104000 000112 int TS%ERR 400000 000000 spd EPCAP% 104000 000151 int NDXJFN 000000 ext RFCOC% 104000 000112 int TS%FRK 040000 000000 spd ERJMPR 320500 000000 int NOP 600000 000000 sin RFMOD% 104000 000107 int TS%JFN 020000 000000 spd ERJMPS 320600 000000 int NOUT 104000 000224 int RFSTS% 104000 000156 int TS%LGL 000200 000000 spd ERRPTR 000000 ext NOUT% 104000 000224 int RLJFN 104000 000023 int TS%LGW 000400 000000 spd ERSTR% 104000 000011 int NUL4 000000 ext RLJFN% 104000 000023 int TS%PRO 100000 000000 spd ESOUT% 104000 000313 int NXTJFN 000000 ext RMAP% 104000 000061 int TT%DAM 000300 sin ETEXT 000000 ext ODTIM% 104000 000220 int RPACS% 104000 000057 int TT%DUM 000014 sin EXTSEC 000001 spd OF%BSZ 770000 000000 sin RPCAP% 104000 000150 int TT%ECO 004000 sin FB%BSZ 007700 000000 sin OF%MOD 007400 000000 sin RSKP 000000 ext TT%LCA 040000 000000 sin FFFFP% 104000 000031 int OF%RD 200000 sin RT%DIM 400000 000000 sin TT%LEN 037600 000000 sin FH%EPN 200000 sin OF%WR 100000 sin RTIW 104000 000173 int TT%LIC 000020 sin FILEPG 000000 ext OPENF% 104000 000021 int RTIW% 104000 000173 int TT%MFF 200000 000000 sin FILJFN 000000 ext OPNX1 600120 int S 400000 000000 spd TT%OSP 400000 000000 sin GD%PAR 000001 sin OT%NDA 400000 000000 sin SBK 000000 ext TT%PGM 000002 sin GJ%FLG 000020 000000 sin P 000017 SC%CTC 400000 000000 sin TT%TAB 100000 000000 sin k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page S-2 K20SUB MAC 9-Jun-23 22:13 SYMBOL TABLE TT%UOC 000040 sin .DVDES 600000 sin .TIMEL 000001 sin TT%WID 000177 000000 sin .DVNUL 000015 sin .TTDES 400000 sin TT%WKA 010000 sin .DVTTY 000012 sin .XSTKS 000000 ext TT%WKF 100000 sin .FBBYV 000011 sin TT%WKN 040000 sin .FBSIZ 000012 sin TT%WKP 020000 sin .FHJOB 777773 sin TTYJFN 000000 ext .FHSLF 400000 sin UDJINF 000000 ext .FP 000015 spd VI%DEC 400000 sin .FPAC 000005 spd VI%EDN 377777 sin .GSIMG 000010 sin VI%MAJ 077700 000000 sin .JIBAT 000011 sin VI%MIN 000077 000000 sin .JITNO 000001 sin VI%WHO 700000 000000 sin .MOCIA 000776 sin XHLLI 501000 000000 int .MOOFF 000000 sin XJRSTF 254240 000000 int .MOPCR 000053 sin XMOVEI 415000 000000 int .MOPCS 000052 sin XSFM 254600 000000 int .MORBM 000037 sin $CTCOC 000011 .MORLL 000032 sin $CTMOD 000014 .MORLT 400001 sin $DVCHR 000005 .MORLW 000030 sin $GPJFN 000003 .MORNT 000035 sin $MOPCR 000026 .MORTF 000054 sin $MORBM 000034 .MORXO 000044 sin $MORLL 000020 .MOSBM 000040 sin $MORLT 000032 .MOSLL 000033 sin $MORLW 000016 .MOSLT 400002 sin $MORNT 000022 .MOSLW 000031 sin $MORTF 000030 .MOSNT 000034 sin $MORXO 000024 .MOSTF 000055 sin $PRIOU 000000 ext .MOXOF 000043 sin $TIF 000042 .NULIO 377777 sin $TIW 000043 .PRIIN 000100 sin $TSARG 000001 .PRIOU 000101 sin $TSERR 000002 .PX7 610001 000000 spd $TSFLG 000000 .R50D 000001 spd %%KRBF 000000 ext .RFCNT 000000 sin ..MSK 777777 777777 spd .RFSFL 000004 sin .A16 000016 spd .SAC 000016 .AC1 000001 spd .SAV1 000000 ext .CHBEL 000007 sin .SAV2 000000 ext .CHCNA 000001 sin .SAV3 000000 ext .CHCNB 000002 sin .SIGIO 677777 sin .CHCNC 000003 sin .STDAT 000000 spd .CHCNP 000020 sin .STSIZ 000003 spd .CHCNX 000030 sin .TICCA 000001 sin .CHCNY 000031 sin .TICCC 000003 sin .CHCNZ 000032 sin .TICCG 000007 sin .CHCRT 000015 sin .TICCM 000015 sin .CHDAS 000055 sin .TICCO 000017 sin .CHDEL 000177 sin .TICCP 000020 sin .CHLFD 000012 sin .TICCT 000024 sin .CHNUL 000000 sin .TICCX 000030 sin .CHSPC 000040 sin .TICCY 000031 sin .CMIOJ 000001 sin .TICCZ 000032 sin .CTTRM 777777 sin .TIMAL 000005 sin k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page S-3 K20SUB MAC 9-Jun-23 22:13 SYMBOL TABLE FOR PSECT CODE ABTFIL 001701' ext CZSEEN 003207' ext KSERR0 000157' SCRLFT 000245' ext ADJTIM 002262' ext CZTRAP 003207' KSMSG0 000161' SETCSB 000524' ent ALLTIM 002240' D2SGPC 003514' LCLERR 001451' SETGRD 003553' ent ARGTYP 000570' DELAY 001675' ext LCLTTY 001332' SETTY 001272' ent ASCZCP 003472' ent DELAYF 001673' ext LDAV 002260' ext SOURCE 003176' ext BCTU 003043' ext DIRCH 003177' ext LEVTAB 002171' SPACK 000141' ext BIGBOY 000545' ext DNCFLD 032776 776000 sin LFDEXP 003443' SPSIZ 000104' ext BLANKL 000030 spd DNCHAN 000032 LFDPTR 003444' SPTOT 003115' ext BLANKS 000000' DNCHB 001000 sin LOCAL 002622' ext SQZTY1 003710' BOUTI% 000357' ent DNDFLD 776776 776000 sin MODOFF 001523' SQZTYO 003706' BYTSIZ 002776' ext DNTRAP 002226' ext MODON 001524' SQZTYR 003721' C87MOV 003266' EBQFLG 003025' ext MOVASC 003470' int SRVFLG 002477' ext CACHAN 000002 EBTFLG 003011' ext MOVCRT 003411' START 003734' ext CAPAS 002521' ext ERRPTR 001504' ext MOVLFD 003446' STCHR 003134' ext CASEEN 002621' ext EVEN 001465' ext MTOPRL 000006 spd STIMOU 002337' ext CATRAP 002741' EVLEN 000003 spd MTOPRT 001160' SUBBP 000077' ext CATRP1 003077' FEPAGE 003575' MTOPSL 000006 spd SVSTT 001533' ext CAXZOF 002617' ent FILES 003103' ext MTOPST 001167' SYMOUT 003677' ent CAXZON 002550' ent FILJFN 003051' ext MXASCZ 303240 sin TBTFLG 001761' ext CCCHAN 000001 FIXTTY 001477' ent MYCAPS 002437' ext TIMCHB 400000 000000 sin CCFAIL 002443' ext FLOW 001551' ext MYTTY 001371' ext TIMDEL 002341' ent CCOFF 002477' ent FNDPAG 003601' NNAK 003150' ext TIMEIT 002242' ent CCOFF2 002501' ent FNDVEC 003666' ent NONE 003540' ext TIMEON 002303' ent CCOFF3 002521' FRCLO1 001655' NOTNUL 000522' TIMERX 002355' ext CCON 002405' ent FRCLOS 001615' ent NTIMOU 003160' ext TIMOFF 002337' ent CCON2 002450' FRCLOT 001673' NUL4 000233' ext TIWORD 001601' ext CCTRAP 002724' FRKCHB 004000 sin PAGCNT 003073' ext TLGJFN 002026' ext CHNGCH 003333' FRKCHN 000030 int PAGNO 003060' ext TMCHAN 000000 CHNTAB 002174' FRTRAP 002224' ext PARITY 003536' ext TMTRAP 002357' ent CMCHAN 000005 GDSWRP 001454' PARPKO 001474' ext TRNCHR 000454 spd CMLOC 003226' ext GETLCL 001370' PARRCK 001475' ext TTYINI 001525' ent CMPOFF 002647' ent GIVEUP 001701' ent PINIT 002367' ent TTYJFN 001525' ext CMPON 002566' ent GNDPAR 001456' ext PKTNUM 000136' ext TTYOB 000653' ent CMPTR2 003237' GP%1AD 007777 777777 spd R 003601' ext TTYOU 000700' ent CMSEEN 003220' ext GP%1PF 770000 000000 spd RCVING 003132' ext UDJINF 001272' ext CMTRAP 003220' GP%2AD 377777 777777 spd RDCLOS 001750' ent UNMAPA 002112' CNCHAR 003335' GP%2PB 770000 000000 spd RDCLSA 001775' UNMAPO 002062' ent CPCHAN 000027 GP%2PF 777700 000000 spd RDCLSC 002025' YESNUL 000517' CPLOC 003236' ext GP%2RS 000037 777777 spd RDCLSD 002046' $CCN 000002 spd CPSEEN 003230' ext GP%2SB 007700 000000 spd RDCLSV 001755' $CLRBS 003251' ext CPTRAP 003230' GP%2WB 000040 000000 spd RDCLSZ 002060' $EDNO 000000 ext CRCCLC 003533' ent HALT 001532' ext RDX50C 003723' $MNVER 000000 ext CRLF 003372' ext HANDSH 001550' ext REEN 003735' ext $MODOF 037777 174374 spd CRTEXP 003403' INICAP 000534' ent RESTTY 001176' ent $MODON 340000 000002 spd CRTPTL 003407' INTPC 002360' ext RPTFLG 003032' ext $PRIOU 001321' ext CRTPTR 003405' INTSTK 002364' ext RPTOT 003123' ext $VERNO 000000 ext CURTIM 002263' ext ISNULJ 000376' ent RSKP 003663' ext $WAITJ 003253' ext CXCHAN 000003 ITSFIL 003020' ext RSTLNW 002146' ent $WHO 000000 ext CXSEEN 003173' ext JOBTAB 000000 ext RTCHR 003137' ext %%JSER 000257' ent CXTRAP 003173' K20HDR 000254' int S8CCV7 003270' ent %%KRBF 000032' ext CYCHAN 000031 K20PTR 000033' SAVLNW 002124' ent %%KRMS 000035' ent CYOFF 002672' ent K20VER 000000000000# pol SAVTTY 000721' ent %%SMS1 000344' CYON 002577' ent KERMIT 003734' SBK 000000 ext %%SMSG 000311' ent CYTRAP 003244' KRXBLT 000030' SCHCRT 003413' %KERMS 000133' ent CZCHAN 000004 KRXPTR 000032' SCHLFD 003450' %WTLGF 000173' k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page S-4 K20SUB MAC 9-Jun-23 22:13 SYMBOL TABLE FOR PSECT CODE %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 ..1721 003520' spd ..0266 000641' spd ..0567 001246' spd ..1210 002255' spd ..1722 003523' spd ..0267 000641' spd ..0571 001260' spd ..1211 002257' spd ..1730 003537' spd ..0301 000645' spd ..0603 001256' spd ..1217 002271' spd ..1731 003552' spd ..0302 000650' spd ..0604 001260' spd ..1220 002274' spd ..1737 003564' spd ..0303 000652' spd ..0606 001270' spd ..1221 002302' spd ..1740 003575' spd ..0320 000740' spd ..0620 001266' spd ..1226 002300' spd ..1746 003601' spd ..0326 000754' spd ..0621 001270' spd ..1227 002302' spd ..1747 003633' spd ..0333 000756' spd ..0631 001320' spd ..1235 002315' spd ..1754 003657' spd k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page S-5 K20SUB MAC 9-Jun-23 22:13 SYMBOL TABLE FOR PSECT CODE ..1755 003665' spd ..1756 003666' 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 15:19 11-Jun-23 Page S-6 K20SUB MAC 9-Jun-23 22:13 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' ..1763 000016' spd ..1765 000026' spd ..2000 000030' spd ..2001 000050' spd ..2006 000045' spd ..2015 000060' spd ..2016 000100' spd ..2017 000076' spd ..2031 000071' spd ..2033 000120' spd ..2046 000107' spd ..2047 000114' spd ..TX1 740000 000000 spd ..TX2 000001 spd k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page S-7 K20SUB MAC 9-Jun-23 22:13 SYMBOL TABLE FOR PSECT CONST ASZTAB 000447' BIGSOU 000001' ent CNRTAB 000046' CRCTAB 000601' CRCTB2 000621' CRSUBT 000246' GIANT 000000' GUARDP 000641' OW2DW 000547' k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page S-8 K20SUB MAC 9-Jun-23 22:13 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 15:19 11-Jun-23 Page S-9 K20SUB MAC 9-Jun-23 22:13 SYMBOL TABLE FOR PSECT DATEND DATGRD 000000' k20sub - Kermit-20 Semantic Action and Support Subroutines MACRO %53B(1254)-4 15:19 11-Jun-23 Page S-10 K20SUB MAC 9-Jun-23 22:13 SYMBOL TABLE FOR PSECT PATCH PAT.. 000000' int k20hlp - Kermit-20 Help Text MACRO %53B(1254)-4 15:18 11-Jun-23 Page 1 K20HLP MAC 11-Jun-23 12:11 Help Text. ;[18] Lengthy help messages added in edit [18]. 43312 title k20hlp - Kermit-20 Help Text 43313 subttl Help Text. ;[18] Lengthy help messages added in edit [18]. 43314 43315 search monsym,k20unv ; Wants parsing and Kermit .PSECT definitions 43316 cmdacs ^ ; Clean up p1-p4 definitions 43317 43318 sall ; Tidy listing 43319 .directive flblst ; We don't need to see all the ASCIZ bytes... 43320 k20hlp - Kermit-20 Help Text MACRO %53B(1254)-4 15:18 11-Jun-23 Page 2 K20HLP MAC 11-Jun-23 12:11 Notes and Cautions 43321 subttl Notes and Cautions 43322 43323 remark Virtual address space decisions 43324 43325 ; The vast majority of the help text (over 32 pages of ASCII data) has 43326 ; been moved out of section 0 into section 1. This is to free up some 43327 ; virtual address space in section 0. 43328 ; 43329 ; However, it also has the benefit of a smaller working set size as 43330 ; the help text is typically seldom referenced. This will make Kermit 43331 ; more likely to be selected to run and cause less impact to Tops-20. 43332 ; 43333 ; Perhaps more significant is the fact that such a layout uses less 43334 ; cache space. This will result in faster performance on both the 43335 ; MCA25 and other implementations with cache memories, including the 43336 ; cache on systems hosting simulators. 43337 43338 remark Virtual address space cautions 43339 43340 ; Be aware that the help semantic action routine ($help in k20par) 43341 ; uses an address calculation to determine whether the result of the 43342 ; parse is either a macro whose text needs displaying or a simple text 43343 ; to just type. 43344 ; 43345 ; This is almost a hack in a single section program where there can be 43346 ; no issue of in-section address aliasing. It can get you into real 43347 ; trouble if you are using multiple sections. Thus, care must be 43348 ; taken to ensure that the in-section addresses of the macro table and 43349 ; help text do NOT conflict. 43350 ; 43351 ; See the calculations for hlporg in k20unv.mac for further details. 43352 k20hlp - Kermit-20 Help Text MACRO %53B(1254)-4 15:18 11-Jun-23 Page 3 K20HLP MAC 11-Jun-23 12:11 Table of help commands 43353 subttl Table of help commands 43354 43355 .psect code/ronly ; %key macros will put text in the text .psect 43356 43357 000000'02 000000 000000 %table(hlptab,G) ;[194] ;[18] 43358 000001'02 000000# 000000# %key2 <36-bit-bytes>,h36bb ;[232] 43359 000000'03 063 066 055 142 151 43360 000002'02 000000# 000000# %key2 ,hbye 43361 000003'03 142 171 145 000 000 43362 000003'02 000000# 000000# %key2 ,hcescp 43363 000004'03 103 055 145 163 143 43364 000004'02 000000# 000000# %key2 ,hcaptu ;[230] 43365 000010'03 143 141 160 164 165 43366 000005'02 000000# 000000# %key2 ,hclear 43367 000012'03 143 154 145 141 162 43368 000006'02 000000# 000000# %key2 ,hclose 43369 000014'03 143 154 157 163 145 43370 000007'02 000000# 000000# %key2 ,hconne 43371 000016'03 143 157 156 156 145 43372 000010'02 000000# 000000# %key2 ,hcchar 43373 000020'03 143 157 156 164 162 43374 000011'02 000000# 000000# %key2 ,hcwd 43375 000024'03 143 167 144 000 000 43376 000012'02 000000# 000000# %key2 ,hdefin 43377 000025'03 144 145 146 151 156 43378 000013'02 000000# 000000# %key2 ,hdele 43379 000027'03 144 145 154 145 164 43380 000014'02 000000# 000000# %key2 ,hdire 43381 000031'03 144 151 162 145 143 43382 000015'02 000000# 000000# %key2 ,hecho 43383 000033'03 145 143 150 157 000 43384 000016'02 000000# 000000# %key2 ,hexit 43385 000034'03 145 170 151 164 000 43386 000017'02 000000# 000000# %key2 ,hfinis 43387 000035'03 146 151 156 151 163 43388 000020'02 000000# 000000# %key2 ,hget 43389 000037'03 147 145 164 000 000 43390 000021'02 000000# 000000# %key2 ,hhelp 43391 000040'03 150 145 154 160 000 43392 000022'02 000000# 000000# %key2 ,hinput 43393 000041'03 151 156 160 165 164 43394 000023'02 000000# 000000# %key2 ,hkermi 43395 000043'03 153 145 162 155 151 43396 000024'02 000000# 000000# %key2 ,hline 43397 000045'03 154 151 156 145 000 43398 000025'02 000000# 000000# %key2 ,hlocal 43399 000046'03 154 157 143 141 154 43400 000026'02 000000# 000000# %key2 ,hlog 43401 000050'03 154 157 147 000 000 43402 000027'02 000000# 000000# %key2 ,houtpu 43403 000051'03 157 165 164 160 165 43404 000030'02 000000# 000000# %key2 ,hpause 43405 000053'03 160 141 165 163 145 43406 000031'02 000000# 000000# %key2 ,hpromp 43407 000055'03 160 162 157 155 160 k20hlp - Kermit-20 Help Text MACRO %53B(1254)-4 15:18 11-Jun-23 Page 3-1 K20HLP MAC 11-Jun-23 12:11 Table of help commands 43408 000032'02 000000# 000000# %key2 ,hpush 43409 000057'03 160 165 163 150 000 43410 000033'02 000000# 000000# %key2 ,hpwd 43411 000060'03 160 167 144 000 000 43412 000034'02 000000# 000000# %key2 ,hquit 43413 000061'03 161 165 151 164 000 43414 000035'02 000000# 000000# %key2 , hsquo 43415 000062'03 161 165 157 164 145 43416 000036'02 000000# 000000# %key2 ,hrecei 43417 000066'03 162 145 143 145 151 43418 000037'02 000000# 000000# %key2 ,hremot 43419 000070'03 162 145 155 157 164 43420 000040'02 000000# 000000# %key2 ,hrun 43421 000072'03 162 165 156 000 000 43422 000041'02 000000# 000000# %key2 ,hsend 43423 000073'03 163 145 156 144 000 43424 000042'02 000000# 000000# %key2 ,hserve 43425 000074'03 163 145 162 166 145 43426 000043'02 000000# 000000# %key2 ,hset 43427 000076'03 163 145 164 000 000 43428 000044'02 000000# 000000# %key2 ,hshow 43429 000077'03 163 150 157 167 000 43430 000045'02 000000# 000000# %key2 ,hspace 43431 000100'03 163 160 141 143 145 43432 000046'02 000000# 000000# %key2 ,hstatu 43433 000102'03 163 164 141 164 151 43434 000047'02 000000# 000000# %key2 ,hstatl 43435 000105'03 163 164 141 164 165 43436 000050'02 000000# 000000# %key2 ,htake 43437 000107'03 164 141 153 145 000 43438 000051'02 000000# 000000# %key2