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 1644