.title KRTST0 SET command overlay zero .ident "V04.64" ; /E64/ 05-May-96 John Santos ; ; Conditionalize for RSTS/E ; Moved set$line here for RSTS, since KRTDSP is O/S specific ; /63/ 23-Dec-94 Billy Youdelman ; ; add SET CONTROL-CHARACTER ; consolidate local data.. ; add file name to when logging to LP so later OS versions are happy ; /62/ 27-Jul-93 Billy Youdelman V03.62 ; ; add support for call back modems, SET DIAL/PHONE [NO]ANSWER ; ; report file size (blocks free) when opening a log file ; simply set binary flag instead of close/reopen file for raw I/O debug ; fix typo causing a new logfile of same name not to get opened ; combine FILE, STATE and PACKET into one DEBUG mode (ON) ; redo SET DIAL ECHO and INIT-ONCE as [NO]ECHO and [NO]INIT-ONCE ; SET SETTLE-TIME is now SET DIAL SETTLE-TIME ; drop SET HAND XON, as RT-11 and TSX eat same.. ; drop SET DIAL INFO, as any undefined message defaults to it ; ; rename SET DIAL PROMPT to WAKE-ACK, add BLIND, PULSE, TONE, DIAL-ACK, ; INITIATE-PROMPT, CONFIRM-ACK, [NO]BINARY-RESPONSE (were missing).. ; /BBS/ 1-Dec-91 Billy Youdelman V03.61 ; ; set$pa - fixed display bug with "?" arg ; enhanced set$speed error handling ; added SET PHONE XMODE for Hayes extended response modes ; cleaned up all debug code, allowing debug to TT w/o a disk file ; moved set$line to KRTDSP, so it can call c$idle in adjacent overlay ; make SET DEBUG NONE off ALL debugging, including TT ; add separate parameter for retrying initial-connection ala VMS Kermit ; add SET INCOMPLETE-FILE-DISPOSITION ; add SET SL ; move [SET] LOGFILE here, integrate with SET DEBUG.. ; make logfile default type .LOG ; allow LP as the log file, please SPOOL this in the op system! ; ; added SET DIAL RINGING, CONnnnn for supported speeds, ABORT, ; COMMENT, IDLE, PROMPT and INIT.ONCE for user-defined modem ; Copyright 1984 Change Software, Inc. ; ; 31-Jan-84 15:13:45 Brian Nelson .include "IN:KRTMAC.MAC" .iif ndf KRTINC .error <; .include for IN:KRTMAC.MAC failed> .include "IN:KRTCDF.MAC" .iif ndf KRTCDF .error <; .include for IN:KRTCDF.MAC failed> .if df RT11 ; /E64/ .mcall .PURGE ,.SPFUN ; /63/ .endc ;RT11 ; /E64/ .macro malloc size ; /62/ moved this here mov size ,r0 call malloc .endm malloc .sbttl Local data .psect $rwdata ,rw,d,lcl,rel,con savpnt: .word 0 ; save pointer to next arg here .psect $pdata ; /63/ consolidate all data here.. log2lp: .asciz "KRTLOG.OUT" ; /63/ need a name for later os vers logext: .asciz ".LOG" prefix: .asciz "Logfile " closit: .asciz " is open - Close it? " ovrwrt: .asciz " exists - Overwrite? " st0.01: .asciz "Number: " st0.02: .asciz "Seconds: " st0.03: .asciz "Abort dialing string: " st0.04: .asciz "Enable auto-answer string: " st0.05: .asciz "Blind dialing string: " st0.06: .asciz "Modem description: " st0.07: .asciz "Connect at 300 message: " st0.08: .asciz "Connect at 1200 message: " st0.09: .asciz "Connect at 2400 message: " st0.10: .asciz "Connect at 4800 message: " st0.11: .asciz "Connect at 9600 message: " st0.12: .asciz "Connect at 19.2k message: " st0.13: .asciz "Connect at 38.4k message: " st0.14: .asciz "String: " st0.15: .asciz "Character(s): " st0.16: .asciz "Ticks: " st0.17: .asciz "Failed call message: " st0.18: .asciz "Dial format string: " st0.19: .asciz "Modem reset string: " st0.20: .asciz "Initiate dialing string: " st0.21: .asciz "Initiate dialing prompt string: " st0.22: .asciz "Disable auto-answer string: " st0.23: .asciz "Pulse dial string: " st0.24: .asciz "Ringing message: " st0.25: .asciz "Connect (speed locked) message: " st0.26: .asciz "Seconds: " st0.27: .asciz "Tone dial string: " st0.28: .asciz "Response to wake-up: " st0.29: .asciz "Init modem to dial string: " st0.30: .asciz "Name Phone-Number: " st0.31: .asciz "Extended Mode: " st0.32: .asciz "Numbers or ALL: " st0.33: .asciz "No LOGFILE is open" st0.34: .asciz " opened, " st0.35: .asciz " block" st0.36: .asciz "s" st0.37: .asciz "BINARY-MODE (fixed 512, no carriage control) enabled" st0.38: .asciz " closed" st0.39: .asciz " is already open" st0.40: .asciz "?SET$DEBUG-W-Bad option" st0.41: .asciz "You must SET DEBUG as desired to write to this file" st0.42: .asciz "Caution: Binary files will require 8-bit prefixing" st0.43: .asciz " requires hardware flow control" st0.44: .asciz " must always be quoted" st0.45: .asciz " is not a control character" .if df RSTS ; /E64/ st0.46: .asciz "Error from device assignment " st0.47: .asciz "Kermit-11 no longer running in LOCAL mode" st0.48: .asciz "Link device: " st0.49: .asciz " Speed not settable" st0.50: .asciz " Speed: " st0.51: .asciz " DTR/CD not currently present" st0.52: .asciz " DTR/CD present" st0.53: .asciz "Parity is set, forcing 7bit mode" .endc ;RSTS ; /E64/ .even .psect $code .sbttl LOGFILE, SET LOGFILE ; /BBS/ heavily modified.. .enabl lsb CVTARG = C.CRLF ! C.LSPA ! C.SSPA ! C.LCUC ! C.TSPA ; arg processing c$logf::call set$log ; try to open the logfile tst r0 ; did that work? beq 10$ ; ya direrr r0 ; no, display any error call incsts ; set global error flag 10$: return set$lo::tstb @argbuf ; any arg(s) supplied? bne 40$ ; ya bit #log$op ,trace ; no, is there a logfile open? bne 20$ ; no wrtall #st0.33 ; /63/ "No LOGFILE is open" clr r0 ; return no error br 30$ 20$: call sd$off ; ya, close the current logfile 30$: return 40$: bit #log$op ,trace ; is there a logfile open? beq 90$ ; no ; /BBS/ if a logfile is already open, query before closing it wrtall #prefix ; ya, build prompt, "Logfile " first wrtall #logfil ; append the file name, say it's open wrtall #closit ; and ask if it can be closed calls kbread ,<#spare1> ; get the answer, sans SL processing tst r0 ; successful terminal read? beq 50$ ; ya .newline ; no, after ^C, ensure a new line.. br 60$ 50$: calls cvt$$ ,<#spare1,r1,#cvtarg> ; remove garbage, upper case tst r0 ; anything left? beq 70$ ; no, exit please cmpb spare1 ,#'Y&137 ; does string begin with a "Y" ? beq 80$ ; ya, it does, meaning zap this file 60$: clr r0 ; success, either way a file is open 70$: return 80$: call sd$off ; close the current logfile 90$: clr savpnt ; init to say no second arg parsed yet mov argbuf ,r0 ; set to recover next arg in buffer 100$: tstb (r0) ; find EOS yet? beq 110$ ; yes, exit without changing anything cmpb (r0)+ ,#space ; found a delimiter yet? bne 100$ ; no, keep looking clrb -1(r0) ; replace space delimiter with a null mov r0 ,savpnt ; save address of second argument 110$: call L1$ ; call shared open the logfile code bcs 70$ ; /63/ file open failed, error's in r0 mov savpnt ,argpnt ; pass debug mode argument to set$deb beq 120$ ; nothing there, so skip the call.. call set$debug ; process next arg as debug mode tst r0 ; /62/ did it work? beq 120$ ; /62/ ya wrtall #st0.40 ; /63/ "SET$DEBUG-W-Bad option" call incsts ; /62/ flag error 120$: clr savpnt ; re-init this right away.. mov trace ,r0 ; copy of log status word bic #,r0 ; /62/ hose non-relevant bits bne 60$ ; /63/ some disk mode is already set wrtall #st0.41 ; /63/ "You must SET DEBUG .." br 60$ ; /63/ done ; /BBS/ shared code, so set$debug can call this much of it too.. L1$: bic #log$al!log$io,trace ; /62/ clear all disk debug bits now upcase argpnt ; ensure file name is upper case calls fparse , ; /63/ parse the file name please tst r0 ; did the $parse work? beq 130$ ; /63/ ya jmp 190$ ; /63/ no, return error in r0 130$: mov #spare1 ,r2 ; pointer to possible "LP:" cmpb #'L&137 ,(r2)+ ; is first byte an "L" ? bne 140$ ; nope.. cmpb #'P&137 ,(r2)+ ; is second byte a "P" ? bne 140$ ; nope.. cmpb #': ,(r2)+ ; is "LP" followed by a colon? bne 140$ ; no tstb (r2) ; ya, but is that null terminated? bne 200$ ; /63/ no, user supplied a file name strcat #spare1 ,#log2lp ; /63/ ya, a name is required here br 200$ ; /63/ go do the file open 140$: scan #'. ,#spare1 ; look for a dot in the name tst r0 ; find one? bne 160$ ; ya.. clrb errtxt ; /63/ init buffer for possible [size] scan #'[ ,#spare1 ; /63/ did the user specify a size? tst r0 ; /63/ well? beq 150$ ; /63/ no add #spare1 ,r0 ; /63/ ya, get pointer to the "[" dec r0 ; /63/ it's really here copyz r0 ,#errtxt ; /63/ now save a copy of size data clrb @r0 ; /63/ then mark end of file name 150$: strcat #spare1 ,#logext ; add .LOG to it tstb errtxt ; /63/ need to restore the size? beq 160$ ; /63/ no strcat #spare1 ,#errtxt ; /63/ ya, put it back after extent 160$: calls iswild ,<#spare1> ; wildcarded file spec?? tst r0 ; no support for it yet here.. bne 190$ ; disallow wildcarded file name ; /BBS/ if logfile already exists, query before overwriting it clr index ; /62/ clear lookup's file counter calls lookup,<#spare1,#errtxt> ; /62/ does file already exist? tst r0 ; /62/ find it? bne 200$ ; /62/ no .if df RT11 ; /E64/ .purge #lun.sr ; /62/ ya, hose dir search channel .endc ;RT11 ; /E64/ wrtall #spare1 ; ya, build prompt, file name first wrtall #ovrwrt ; append some informative text calls kbread , ; get the answer, sans SL processing tst r0 ; successful terminal read? beq 170$ ; ya .newline ; no, after ^C, ensure a new line.. bne 180$ ; go set carry and exit 170$: calls cvt$$ , ; remove garbage, upper case tst r0 ; anything left? beq 190$ ; no, exit please cmpb @argbuf ,#'Y&137 ; does string begin with a "Y" ? beq 200$ ; /62/ ya, all is well 180$: clr r0 ; no, don't pass back this error 190$: sec ; flag in case called by set$debug return ; error is in r0 200$: calls create ,<#spare1,#lun.lo,#text> ; open the file tst r0 ; did it work? bne 190$ ; /BBS/ no bis #log$op ,trace ; yes, say it's open please copyz #spare1 ,#logfil ,#26 ; save the debug file name for show tst infomsg ; /41/ verbose today? beq 220$ ; /BBS/ no wrtall #prefix ; /BBS/ a prefix, "Logfile " wrtall #logfil ; confirm the logfile name wrtall #st0.34 ; /62/ " opened, " mov #lun.lo ,r0 ; /62/ logfile lun asl r0 ; /62/ word indexing mov sizof(r0),r0 ; /62/ recover size mov r0 ,r1 ; /62/ copy to test for plurality call L10266 ; /62/ dump it to TT wrtall #st0.35 ; /62/ say it's block(s) dec r1 ; /62/ just one? beq 210$ ; /62/ ya, don't make it plural wrtall #st0.36 ; /63/ no, toss in an "s" 210$: .newline ; /62/ 220$: clr r0 ; success, also clears carry return .dsabl lsb .sbttl SET DEBUG .enabl lsb ; /63/ set$de::upcase argpnt ; /BBS/ upper case all args calls getcm0 , ; find out which option was given tst r0 ; find one? bmi 30$ ; /63/ no tst wasnul ; /BBS/ were commands listed via "?" bne 30$ ; /63/ ya jmp @r1 ; /63/ dispatch now command dbglst ,ALL ,1 ,sd$on command dbglst ,CONNECT,2 ,sd$con command dbglst ,CONSOLE,2 ,sd$con command dbglst ,NONE ,3 ,sd$none command dbglst ,NORPACK,3 ,sd$nrp command dbglst ,NOTERMINAL,3 ,sd$not command dbglst ,NOTT: ,3 ,sd$not command dbglst ,OFF ,2 ,sd$off command dbglst ,ON ,2 ,sd$on command dbglst ,PACKET ,1 ,sd$pak command dbglst ,RAW ,2 ,sd$raw command dbglst ,RPACK ,2 ,sd$rpa command dbglst ,TERMINAL,2 ,sd$ter command dbglst ,TT: ,2 ,sd$ter command dbglst sd$con: call sdopen ; logfile open? bcs 30$ ; no call rawchk ; disallow other logging bcs 30$ ; if raw is on bic #log$al ,trace ; /BBS/ clear all disk debug bits now bis #log$co ,trace ; enable connect mode logging br 20$ ; /63/ success sd$none:call sd$off ; /BBS/ do this first clr trace ; /BBS/ dump everything br 20$ ; /63/ success sd$not: bic #log$de ,trace ; /62/ turn off terminal debugging br 20$ ; /63/ success sd$nrp: bic #log$rp ,trace ; /BBS/ off just RPACK debugging br 20$ ; /63/ success sd$off::bit #log$op ,trace ; is there a logfile open? beq 10$ ; no calls close ,<#lun.lo> ; close it bic #log$op ,trace ; say it's closed please tst infomsg ; /41/ inform the user? beq 10$ ; /41/ no wrtall #prefix ; /41/ call it Logfile now wrtall #logfil ; /BBS/ include the actual file name wrtall #st0.38 ; /63/ " closed" 10$: bic #log$al!log$io,trace ; /BBS/ clear all disk debug bits now 20$: clr r0 ; success 30$: return sd$on: call rawchk ; disallow other logging bcs 30$ ; if raw is on call sdopen ; a debug file already open? bcs 30$ ; no bis #log$al ,trace ; set debug on turns on the world br 20$ ; /63/ success sd$pak: call sdopen ; logfile open? bcs 30$ ; no call rawchk ; disallow other logging bcs 30$ ; if raw is on bic #log$al ,trace ; /BBS/ clear all disk debug bits now bis #log$pa ,trace ; enable packet logging br 20$ ; /63/ success sd$rpa: bis #log$rp ,trace ; enable RPACK debugging br 20$ ; /63/ success sd$ter: bis #log$de ,trace ; /62/ I/O to the local terminal br 20$ ; /63/ success sdopen: bit #log$op ,trace ; a logfile open? beq 50$ ; no tst savpnt ; /BBS/ come here from file opener? bne 40$ ; /BBS/ ya, skip this message.. wrtall #prefix ; /BBS/ no, say it's already there wrtall #logfil ; /BBS/ including what it is wrtall #st0.39 ; /63/ " is already open" 40$: br 20$ ; /63/ no error, clr r0 clears carry 50$: mov argbuf ,r0 ; /BBS/ bump argpnt to the next arg.. 60$: tstb @r0 ; /63/ find EOS yet? beq 70$ ; /BBS/ yes, exit with an error cmpb (r0)+ ,#space ; /BBS/ found a delimiter yet? bne 60$ ; /63/ no, keep looking mov r0 ,argpnt ; /BBS/ pass name to logfile opener call L1$ ; /BBS/ jump in at appropriate place bcc 30$ ; /BBS/ carry clear = logfile open 70$: mov #er$lgf ,r0 ; /BBS/ please opn a LOGFILE first 80$: sec ; /63/ error exit return rawchk: bit #log$io ,trace ; raw I/O debugging? (clears carry) beq 30$ ; /63/ no mov #er$rax ,r0 ; /BBS/ can't with raw I/O logging on br 80$ ; /63/ failure sd$raw: call sdopen ; logfile open? bcs 30$ ; no mov trace ,r0 ; copy of debugging status word bic #,r0 ; hose RPACK and disk file open bits beq 90$ ; no other disk_based option is on mov #er$raw ,r0 ; /BBS/ can't do raw I/O w/other opts br 30$ 90$: bis #log$io ,trace ; enable raw I/O logging mov #lun.lo ,r0 ; /62/ copy of lun asl r0 ; /62/ word indexing mov sp ,filtyp(r0) ; /62/ flag to use binary mode tst infomsg ; SET TT QUIET? beq 20$ ; /63/ ya, skip info message wrtall #prefix ; /62/ "Logfile " wrtall #st0.37 ; /62/ say binary mode is enabled br 20$ ; /63/ success .dsabl lsb .sbttl set a line for dialing out and speed .if df RSTS ; /E64/ set$li::mov sp ,doallo ; /58/ Assume exclusive owner mov #ttname ,r1 ; /58/ Destination mov argbuf ,r0 ; /58/ Source 10$: cmpb (r0) ,#'/ ; /58/ Included /[NO]ALLOCATE beq 20$ ; /58/ Yes, exit movb (r0)+ ,(r1)+ ; /58/ No, just copy bne 10$ ; /58/ Next please br 40$ ; /58/ Skip qualifier processing 20$: clrb (r1) ; /58/ Insure .asciz inc r0 ; /58/ Skip past the '/' cmpb (r0) ,#'N&137 ; /58/ Was it /N bne 30$ ; /58/ No clr doallo ; /58/ Yes, say so then br 40$ ; /58/ Continue on 30$: cmpb (r0) ,#'A&137 ; /58/ Try /A bne 110$ ; /58/ Error 40$: tst doallo ; /58/ Should we take the device? beq 50$ ; /58/ No calls assdev ,<#ttname> ; try to get the exec to allocate it tst r0 ; did the allocation work ? beq 60$ ; no wrtall #st0.46 ; /E64/ direrr r0 ; print out the directive error return ; and exit 50$: calls noecho ,<#ttname> ; try to disable echoing 60$: clr remote ; no longer are we remote calls ttpars ,<#ttname> ; see if the terminal is KB: or TI: cmpb r0 ,#377 ; well ? bne 100$ ; no mov sp ,remote ; yes, we are now the remote system calls gttname ,<#ttname> ; get our local terminal number wrtall #st0.47 ; /E64/ 100$: call linsts clr r0 110$: return linsts: tst infomsg ; /41/ Print this info today? beq 100$ ; /41/ No wrtall #st0.48 ; /E64/ format info about link status wrtall #ttname ; /E64/ name call ttspeed ; /40/ current speed tst r0 ; /40/ Is speed settable? bne 10$ ; /40/ yes wrtall #st0.49 ; /E64/ no br 20$ ; /40/ next please 10$: wrtall #st0.50 ; /E64/ dump it decout r0 ; /40/ 20$: calls inqdtr ,<#ttname> ; /40/ see if dtr or cd is up tst r0 ; /40/ if < 0 , then not supported bmi 40$ ; /40/ no good bgt 30$ ; /40/ Dtr's up wrtall #st0.51 ; /E64/ a message br 40$ ; /40/ next 30$: wrtall #st0.52 ; /E64/ it's there 40$: .newline ; /40/ all done calls inqpar ,<#ttname> ; /53/ Check for parity tst r0 ; /53/ Set? beq 100$ ; /53/ NO movb #PAR$SPACE,parity ; /53/ Force 7bit mode wrtall #st0.53 100$: return ; /40/ exit .endc ;RSTS ; /E64/ .sbttl SET PARITY .enabl lsb ; /63/ set$pa::upcase argbuf ; /BBS/ upper case all args calls getcm0 , ; find out which option was given tst r0 ; did we find one bmi 30$ ; no tst wasnul ; /BBS/ were commands listed via "?" bne 20$ ; /BBS/ ya jmp @r1 ; /63/ dispatch command parlst ,EVEN ,1 ,spa$ev command parlst ,MARK ,1 ,spa$ma command parlst ,NONE ,1 ,spa$no command parlst ,ODD ,1 ,spa$od command parlst ,SPACE ,1 ,spa$sp command parlst spa$ev: mov #par$ev ,r0 ; even br 10$ ; /63/ spa$od: mov #par$od ,r0 ; odd br 10$ ; /63/ spa$ma: mov #par$ma ,r0 ; mark br 10$ ; /63/ spa$sp: mov #par$sp ,r0 ; space br 10$ ; /63/ spa$no: clr r0 ; /BBS/ none 10$: mov r0 ,parity ; /63/ save returned value beq 20$ ; /BBS/ skip msg if parity is set none tst infomsg ; SET TT QUIET? beq 20$ ; ya wrtall #st0.42 ; /63/ "Binary files will be prefixed" 20$: clr r0 ; no error 30$: return .dsabl lsb .sbttl SET HANDSHAKE .enabl lsb ; /63/ SQUOTE = 47 ; ' DQUOTE = 42 ; " set$ha::upcase argbuf ; /BBS/ leaves r0 pointing to argbuf cmpb @r0 ,#squote ; a literal ' quoted character? beq 10$ ; yes, use next char as the handshake cmpb @r0 ,#dquote ; look for " also bne 20$ ; not there 10$: movb 1(r0) ,r0 ; get the handshake character please br 30$ ; and copy it please 20$: calls getcm0 , ; which option was given? tst r0 ; find one? bmi 50$ ; no tst wasnul ; /BBS/ were commands listed via "?" bne 40$ ; /BBS/ ya jmp @r1 ; /63/ dispatch now command hanlst ,CR ,1 ,sha$cr command hanlst ,NONE ,1 ,sha$no command hanlst sha$no: clrb r0 ; no handshake (the default) br 30$ ; /63/ sha$cr: movb #cr ,r0 ; wait for a carriage return 30$: movb r0 ,handch ; save the result 40$: clr r0 ; success 50$: return .dsabl lsb .sbttl SET DUPLEX, SET LOCAL-ECHO ; /BBS/ add _ECHO to LOCAL .enabl lsb ; /63/ ; Provide both SET DUPLEX FULL/HALF and SET LOCAL-ECHO ON/OFF ; to provide users with compatibility with the different ways ; other Kermits do this. set$lc::mov #lcelst ,r5 ; load pointer to LOCAL commands br dulc ; share common code set$du::mov #duplst ,r5 ; load pointer to DUPLEX commands dulc: upcase argbuf ; /BBS/ upper case all args calls getcm0 , ; find out which option was given tst r0 ; did we find one bmi 20$ ; no tst wasnul ; /BBS/ were commands listed via "?" bne 10$ ; /BBS/ ya jmp @r1 ; /63/ dispatch command duplst ,FULL ,1 ,sdu$fu command duplst ,HALF ,1 ,sdu$ha command duplst command lcelst ,OFF ,2 ,sdu$fu command lcelst ,ON ,2 ,sdu$ha command lcelst sdu$ha: mov sp ,duplex ; force local echo on br 10$ ; /63/ sdu$fu: clr duplex ; no local echo, the default 10$: clr r0 ; no error 20$: return .dsabl lsb .sbttl SET UPDATE set$nu::clr blip ; SET NOUPDATE clr r0 ; no error return set$up::calls l$val , ; get the interval into decimal tst r0 ; ok? bne 10$ ; /63/ er$bad stuffed in r0 by l$val mov r1 ,blip ; yes, set it up please (r0 is clear) 10$: return .sbttl SET RETRY ; /BBS/ enhanced.. .enabl lsb ; /63/ set$re::upcase argbuf ; /BBS/ upper case argument buffer calls getcm0 , ; try to parse the first arg tst r0 ; did it work? bmi 20$ ; /63/ nope tst wasnul ; were commands listed via "?" bne 20$ ; /63/ ya calls getcm1 , ; /63/ check for possible arg tst r0 ; /63/ well? bmi 20$ ; /63/ bad arg.. jmp @r1 ; /63/ dispatch command trylst ,INITIAL-CONNECTION,1 ,stry$i ,st0.01 command trylst ,PACKET ,1 ,stry$p ,st0.01 command trylst stry$i: call stry$$ ; initial-connection retries tst r0 ; did it work? bne 20$ ; /63/ no mov r1 ,initry ; ya, save value return stry$p: call stry$$ ; data packet retries tst r0 ; did it work? bne 20$ ; /63/ no mov r1 ,maxtry ; ya, save value return stry$$: call nextarg ; get the next argument tstb @r1 ; well? beq 10$ ; not there calls l$val , ; SET RETRY decimal-number tst r0 ; well? bne 10$ ; no, bad value cmp r1 ,#3. ; a reasonable minimum? blo 10$ ; nope.. cmp r1 ,#30. ; a reasonable maximum? blos 20$ ; ya 10$: mov #er$try ,r0 ; no, must be between 3. and 30. 20$: return .dsabl lsb ; /63/ .sbttl SET SERVER .enabl lsb ; /63/ set$sv::upcase argbuf ; /BBS/ upper case all args calls getcm0 , ; find out which option was given tst r0 ; did we find the option? bmi 20$ ; /63/ no tst wasnul ; /BBS/ were commands listed via "?" bne 20$ ; /63/ ya calls getcm1 , ; yes, look for value clause now tst r0 ; find it (or read it?) bmi 20$ ; /63/ no jmp @r1 ; /63/ getcm1 always returns in argbuf command svlst ,NOTIME-OUT ,1 ,srv$nt command svlst ,TIME-OUT ,1 ,srv$ti ,st0.02 command svlst srv$ti: calls l$val , ; convert ascii number to integer tst r0 ; did it work? bne 20$ ; /63/ no, l$val loads er$bad into r0 cmp r1 ,#1092. ; /62/ too big? note r0 is clear here bhi 10$ ; /62/ ya, don't set it mov r1 ,serwait ; it's ok, save desired time out br 20$ 10$: mov #er$bad ,r0 ; error, a bad value was given 20$: return srv$nt: mov #1092. ,serwait ; /62/ wait the max, 18.2 mins @ 60Hz clr r0 ; no error possible here return .dsabl lsb .sbttl SET EOF [NO]EXIT .enabl lsb ; /63/ set$ef::upcase argbuf ; /BBS/ upper case all args calls getcm0 , ; parse the first arg tst r0 ; did it work? bmi 20$ ; no tst wasnul ; /BBS/ were commands listed via "?" bne 20$ ; /BBS/ ya jmp @r1 ; /63/ dispatch command eflist ,EXIT ,1 ,sef$ex command eflist ,NOEXIT ,1 ,sef$ne command eflist sef$ne: clr exieof ; don't exit at end of TAKE file br 10$ ; /63/ sef$ex: mov sp ,exieof ; exit to monitor at end of TAKE file 10$: clr r0 ; no error 20$: return .dsabl lsb .sbttl SET INCOMPLETE-FILE-DISPOSITION ; /BBS/ all new.. .enabl lsb ; /63/ set$in::upcase argbuf ; upper case all args calls getcm0 , ; try to parse the first arg tst r0 ; well? bmi 20$ ; didn't work tst wasnul ; was arg a question mark? bne 20$ ; ya, don't dispatch on that jmp @r1 ; /63/ dispatch the command command inclist ,DISCARD,1 ,sin$ds command inclist ,KEEP ,1 ,sin$kp command inclist sin$kp: clr incfile ; keep incomplete files br 10$ ; /63/ sin$ds: mov sp ,incfile ; dump incomplete files 10$: clr r0 ; no error 20$: return .dsabl lsb .sbttl SET DIAL ; /BBS/ substantially enhanced .enabl lsb ; /63/ set$di::mov #dialst ,r3 ; pointer to command dispatch table mov #spare1 ,r4 ; /63/ pointer to a temp buffer upone argbuf ; upcase just next arg only.. calls getcm0 , ; parse the first arg tst r0 ; did it work? bmi 60$ ; /63/ no, bad option tst wasnul ; were commands listed via "?" bne 60$ ; /63/ ya calls getcm1 , ; no, look for next arg tst r0 ; get one? bmi 60$ ; /63/ no jmp @r1 ; /63/ dispatch command dialst ,ABORT ,2 ,ss$abo ,st0.03 command dialst ,ANSWER ,2 ,ss$ans ,st0.04 command dialst ,BINARY-RESPONSE ,2 ,ss$bin command dialst ,BLIND ,2 ,ss$bli ,st0.05 command dialst ,COMMENT ,3 ,ss$com ,st0.06 command dialst ,CON300 ,5 ,ss$300 ,st0.06 command dialst ,CON1200 ,5 ,ss$120 ,st0.08 command dialst ,CON2400 ,4 ,ss$240 ,st0.09 command dialst ,CON4800 ,4 ,ss$480 ,st0.10 command dialst ,CON9600 ,4 ,ss$960 ,st0.11 command dialst ,CON19200 ,5 ,ss$192 ,st0.12 command dialst ,CON38400 ,5 ,ss$384 ,st0.13 command dialst ,CONFIRM ,4 ,ss$con ,st0.14 command dialst ,CONFIRM-ACKNOWLEDGE,8. ,ss$cak ,st0.14 command dialst ,DIAL-ACKNOWLEDGE,6 ,ss$dak ,st0.14 command dialst ,DIAL-PAUSE ,6 ,ss$pau ,st0.15 command dialst ,DIAL-RATE ,6 ,ss$dra ,st0.16 command dialst ,ECHO ,1 ,ss$eko command dialst ,FAILURE ,2 ,ss$fai ,st0.17 command dialst ,FORMAT ,2 ,ss$for ,st0.18 command dialst ,IDLE ,2 ,ss$idl ,st0.19 command dialst ,INITIATE ,5 ,ss$ini ,st0.20 command dialst ,INITIATE-PROMPT ,9. ,ss$inp ,st0.21 command dialst ,INIT-ONCE ,5 ,ss$one command dialst ,NOANSWER ,3 ,ss$anx ,st0.22 command dialst ,NOBINARY-RESPONSE,3 ,ss$bix command dialst ,NOECHO ,3 ,ss$ekx command dialst ,NOINIT-ONCE ,3 ,ss$onx command dialst ,PULSE ,1 ,ss$pul ,st0.23 command dialst ,RINGING ,1 ,ss$rin ,st0.24 command dialst ,SETTLE-TIME ,2 ,sst$st ,st0.16 command dialst ,SUCCESS ,2 ,ss$suc ,st0.25 command dialst ,TIME-OUT ,2 ,ss$tmo ,st0.26 command dialst ,TONE ,2 ,ss$ton ,st0.27 command dialst ,WAKE-ACKNOWLEDGE,6 ,ss$pro ,st0.28 command dialst ,WAKE-RATE ,6 ,ss$wra ,st0.16 command dialst ,WAKE-STRING ,6 ,ss$wak ,st0.29 command dialst ss$300: mov #300. ,r3 ; connect at 300 br sd.res ss$120: mov #1200. ,r3 ; 1200 br sd.res ss$240: mov #2400. ,r3 ; 2400 br sd.res ss$480: mov #4800. ,r3 ; 4800 br sd.res ss$960: mov #9600. ,r3 ; 9600 br sd.res ss$192: mov #19200. ,r3 ; 19.2k br sd.res ss$384: mov #38400. ,r3 ; /62/ 38.4k br sd.res ss$suc: mov #2 ,r3 ; connect without speed change br sd.res ss$rin: mov #1 ,r3 ; ring, or rring if Telebit modem br sd.res ss$fai: mov #-1 ,r3 ; call failed .br sd.res ; /63/ sd.res: prsbuf r4 ; expand and copy string to workbuffer tst r0 ; successful? bne 60$ ; no strlen r4 ; get the length of the result add #2 ,r0 ; plus one for the null terminator bic #1 ,r0 ; ensure on a word boundary add #4 ,r0 ; space for link and status mov #usermd ,r5 ; /BBS/ get base address of structure add #res.hea,r5 ; link to first entry 20$: tst (r5) ; end of the chain yet? beq 30$ ; yes mov (r5) ,r5 ; no, get the next one please br 20$ ; and recheck 30$: malloc r0 ; ask for an allocation mov r0 ,(r5) ; /63/ get it? beq 40$ ; no, exit mov (r5) ,r5 ; point directly to new area clr (r5)+ ; no link to next mov r3 ,(r5)+ ; message class type strcpy r5 ,r4 ; insert the string br 50$ 40$: mov #er$mal ,r0 ; /BBS/ no space left for string return 50$: clr r0 ; /BBS/ no error 60$: return ss$abo: mov #dial.xabort,r5 ; abort call from modem br sd.chk ss$ans: mov #ph.answer,r5 ; /62/ enable auto-answer mode br sd.chk ss$anx: mov #ph.noanswer,r5 ; /62/ disable auto-answer mode br sd.chk ss$com: mov #mod.comment,r5 ; brief modem description br sd.chk ss$dak: mov #dial.ack,r5 ; /62/ modem response to confirm br sd.chk ; /62/ number is dialing (optional) ss$idl: mov #dial.idle,r5 ; place modem in idle state br sd.chk ss$pau: mov #dial.wait,r5 ; pause string br sd.chk ss$wak: mov #wake.string,r5 ; init string br sd.chk ss$for: mov #dial.string,r5 ; formatting for dialing br sd.chk ss$pro: mov #wake.prompt,r5 ; string modem returns for wakeup br sd.chk ss$ini: mov #dmod.string,r5 ; SET DIAL INITIATE string br sd.chk ss$inp: mov #dmod.prompt,r5 ; /62/ possible prompt returned after br sd.chk ; /62/ INITIATE string is sent ss$con: mov #dial.confirm,r5 ; to confirm number is correct br sd.chk ss$cak: mov #dial.go,r5 ; /62/ to confirm the confirmation br sd.chk ; /62/ is correct (!) ss$bli: mov #dial.blind,r5 ; /62/ BLIND dialing string br sd.chk ; /62/ ss$pul: mov #dial.pulse,r5 ; /62/ PULSE dialing string br sd.chk ; /62/ ss$ton: mov #dial.nopulse,r5 ; /62/ TONE dialing string .br sd.chk ; /63/ sd.chk: prsbuf r4 ; expand and copy string to workbuffer tst r0 ; successful? bne 60$ ; no strlen r4 ; get the length of the result inc r0 ; plus one for the null terminator inc r0 ; ensure next allocation begins bic #1 ,r0 ; on an even address boundary malloc r0 ; ask for the allocation tst r0 ; /BBS/ did we get it? beq 40$ ; /BBS/ no, exit add #usermd ,r5 ; /BBS/ ya, point to next free address mov r0 ,(r5) ; insert the new buffer address strcpy (r5) ,r4 ; copy the string br 50$ ; /BBS/ share exit code ss$eko: mov #dial.echo,r5 br ss$$1 ; /63/ modem echoes dial commands ss$ekx: mov #dial.echo,r5 br ss$$0 ; /63/ modem doesn't echo commands ss$one: mov #init.once,r5 br ss$$1 ; /63/ modem stays init'd ss$onx: mov #init.once,r5 br ss$$0 ; /63/ modem does not stay init'd ss$bin: mov #res.bin,r5 ss$$1: movb #'1 ,r1 ; /62/ modem does single char response br ss$$$ ss$bix: mov #res.bin,r5 ss$$0: movb #'0 ,r1 ; /62/ modem responds normally .br ss$$$ ; /63/ ss$$$: mov argbuf ,r0 ; /62/ where to pass l$val's argument movb r1 ,(r0)+ ; /62/ do it clrb (r0) ; /62/ null terminate br sd.val ; /62/ and off to common code.. ss$dra: mov #dial.rate,r5 ; in ticks br sd.val ss$wra: mov #wake.rate,r5 ; in ticks .br sd.val ; /63/ sd.val: calls l$val , ; convert ascii number to integer tst r0 ; success? bne 80$ ; no 70$: mov r1 ,usermd(r5) ; yes, insert the value 80$: return ; /62/ done sst$st: calls l$val , ; /62/ convert to an integer tst r0 ; /62/ ok? bne 80$ ; /62/ nope mov r1 ,settle ; /62/ ya, save it mov #time.settle,r5 ; /62/ prep to stuff into USER-DEFINED br 70$ ; /62/ go do it ss$tmo: calls l$val , ; convert ascii number to integer tst r0 ; success? bne 80$ ; no mov r1 ,diatmo ; number is ok mov #dial.time,r5 ; /62/ prep to stuff into USER-DEFINED br 70$ ; /62/ go do it .dsabl lsb .sbttl SET PHONE ; /45/ added set$ph::upone argbuf ; /BBS/ upper case just next arg calls getcm0 , ; which option was given? tst r0 ; find one? bmi sph$zz ; /63/ no, bad option tst wasnul ; /BBS/ were commands listed via "?" bne sph$zz ; /63/ ya calls getcm1 , ; look for next argument tst r0 ; find one? bmi sph$zz ; /63/ no jmp @r1 ; /63/ ya, dispatch command pholst ,ANSWER ,1 ,sph$an command pholst ,BLIND ,1 ,sph$bl command pholst ,NOANSWER,2 ,sph$no command pholst ,NUMBER ,2 ,sph$nu ,st0.30 command pholst ,PULSE ,1 ,sph$pu command pholst ,TONE ,1 ,sph$to command pholst ,XMODE ,1 ,sph$xm ,st0.31 command pholst sph$an: mov sp ,answer ; /62/ modem not enabled until dialing br sph$xx ; /62/ thus nothing special here.. sph$no: clr answer ; /62/ don't enable next time dialing tst mready ; /62/ is a modem currently on-line? beq sph$xx ; /62/ no tst (sp)+ ; /62/ pop local dispatch return addr jmp set$dtr ; /62/ reinit modem so no answer works sph$to: mov #1 ,pulse ; make it tone dialing br sph$xx ; /62/ sph$pu: mov #-1 ,pulse ; make it pulse dialing br sph$xx ; /62/ sph$bl: mov #1 ,blind ; dial blindly br sph$xx ; /62/ sph$nu: mov #pnhead ,r5 ; get listhead for phone numbers 10$: tst (r5) ; found the last entry yet? beq 20$ ; yes, insert new element here mov (r5) ,r5 ; no, check the next one br 10$ ; keep looking 20$: call skipit ; /BBS/ ignore comma in argument strlen argbuf ; get total length of data add #4 ,r0 ; add in space for nulls and ensure bic #1 ,r0 ; even length, also link next field malloc r0 ; ask for the space please mov r0 ,(r5) ; insert the address bne 30$ ; space is available mov #er$mal ,r0 ; /BBS/ no space left for string return 30$: clr (r0)+ ; this is now the tail strcpy r0 ,argbuf ; stuff the data in sph$xx: clr r0 ; Indicate success sph$zz: return ; /63/ sph$xm::upcase argbuf ; /BBS/ global for SET CL LIN * calls getcm0 , ; check the table for type tst r0 ; did it work? bmi 40$ ; no tst wasnul ; were commands listed via "?" bne sph$xx ; /62/ ya jsr pc ,@r1 ; yes, dispatch on it please br sph$xx ; /62/ 40$: mov #er$bad ,r0 ; bad value or option error return command xmlist ,0 ,1 ,sxm$st command xmlist ,1 ,1 ,sxm$st command xmlist ,2 ,1 ,sxm$st command xmlist ,3 ,1 ,sxm$st command xmlist ,4 ,1 ,sxm$st command xmlist ,5 ,1 ,sxm$st command xmlist ,6 ,1 ,sxm$st command xmlist ,10 ,2 ,sxm$st command xmlist ,11 ,2 ,sxm$st command xmlist ,12 ,2 ,sxm$st command xmlist ,13 ,2 ,sxm$st command xmlist ,14 ,2 ,sxm$st command xmlist ,OFF ,1 ,sxm$of command xmlist sxm$of: clrb xresult ; the default, no xmode selected mov #-1 ,r1 ; /62/ update USER-DEFINED modem data br sxm$$$ ; /62/ common code sxm$st: strcpy #xresult,argbuf ; /62/ move argument into buffer calls l$val , ; /62/ convert ascii number to integer sxm$$$: mov #usermd ,r0 ; /62/ top of USER-DEFINED modem data mov r1 ,x.result(r0) ; /62/ update it too.. return .sbttl SET SL ; /BBS/ added.. .enabl lsb ; /63/ set$sl::upcase argbuf ; upper case all args calls getcm0 , ; which option was given? tst r0 ; well? bmi 20$ ; bad option tst wasnul ; were commands listed via "?" bne 20$ ; ya call kp.clr ; reset the keypad jmp @r1 ; /63/ dispatch command sl.lst ,KED ,1 ,ssl$ke command sl.lst ,NOKED ,1 ,ssl$no command sl.lst ,OFF ,2 ,ssl$of command sl.lst ,ON ,2 ,ssl$on command sl.lst ssl$ke: mov sp ,sl.ked ; put SL into KED mode br 10$ ; /63/ ssl$no: clr sl.ked ; put SL in normal mode br 10$ ; /63/ ssl$of: clr sl.on ; turn SL off br 10$ ; /63/ ssl$on: mov sp ,sl.on ; turn SL on 10$: clr r0 ; no error 20$: return .dsabl lsb .sbttl SET CONTROL-CHARACTER ; /63/ all new.. .enabl lsb ; Control character quoting may be disabled for each byte individually ; by making its corresponding flag byte in CLTFLGS <> 0. ; ; flags offset character controlled ; ------------ -------------------- ; CTLFLGS+ 0 = ascii 377 <200!DEL> ; + 1 = ascii 0 ; ... ; + 40 = ascii 37 ; + 41 = ascii 177 ; + 42 = ascii 200 <200!NUL> ; ... ; +101 = ascii 237 <200!US> ; r2 = buffer pointer for register indexing ; r3 = loop counter for sct$all ; r4 = command mode flag byte: 0 = unprefixed, 1 = prefixed ; r5 = error message text address CL.FLOW = 40 ; CLSTAT spfun flow control type bit CT.WID = 4 ; pad numbers in err msgs this wide set$ct::upcase argbuf ; upper case the whole argument buffer calls getcm0 , ; try to parse the first arg tst r0 ; did it work? bmi ct.done ; nope tst wasnul ; were commands listed via "?" bne ct.done ; ya calls getcm1 , ; get required second arg(s) tst r0 ; well? bmi ct.done ; bad arg.. jmp @r1 ; dispatch command ctset ,PREFIXED ,1 ,sct$pr ,st0.32 command ctset ,UNPREFIXED ,1 ,sct$un ,st0.32 command ctset sct$pr: mov #1 ,r4 ; command was PREFIXED br sct$$ sct$un: clr r4 ; or UNPREFIXED sct$$: calls getcm0 , ; look for "ALL" tst wasnul ; check this first here.. bne ct.exit ; commands were listed via "?" tst r0 ; did getcm0 work? bne 10$ ; no jsr pc ,@r1 ; yes, dispatch on it please br ct.loop ; then loop for more input 10$: cmp r0 ,#cmd$bad ; a ^C or ^Z abort? blos ct.num ; it may be a number ct.exit:clr r0 ; no error here is fatal ct.done:return ct.num: mov #spare1 ,r0 ; handy buffer for current arg mov argbuf ,r1 ; pointer to the arg to process 20$: movb (r1)+ ,(r0) ; is this char a null? beq 30$ ; ya, done cmpb (r0)+ ,#space ; no, but is it a delimiter? bne 20$ ; no, loop for more chars clrb -(r0) ; ya, null terminate copy in spare1 30$: calls l$val ,<#spare1> ; try to recover a number tst r0 ; well? bne ct.bad ; no, bad value bit #^c<377>,r1 ; if > 377 bne ct.bad ; it's a bad number incb r1 ; wrap 377 to 0, others ch=ch+1 cmp r1 ,#41 ; was char 37..0,377 (now 40..0)? blo ct.all ; yes, it's a control char sub #137 ,r1 ; bump 240..200 down to 101..41 cmp r1 ,#41 ; if now < 41 then it's blo ct.bad ; not a control char cmp r1 ,#101 ; if now <= 101 then blos ct.all ; it's a control char ct.bad: tst infomsg ; report the bad number? beq ct.loop ; no, info messages are disabled strlen #spare1 ; get length of the offending string sub #ct.wid ,r0 ; subtract total width allowed here neg r0 ; how much do we need to pad? ble 50$ ; it's already there or overflowed.. mov r0 ,r1 ; copy number of blanks needed mov #space ,r0 ; load a blank into the output reg 40$: call writ1char ; write it to the terminal sob r1 ,40$ ; repeat until done 50$: wrtall #spare1 ; now write the number itself to tt mov #st0.45 ,r5 ; load message tag text location br 110$ ; go print it ct.all: tst r4 ; allow anything bne 70$ ; to be set prefixed cmp r1 ,#1 ; unprefixing, is this a NULL? blo 70$ ; no but it is ascii 377 beq 90$ ; ya cmp r1 ,#22 ; an XON? beq 60$ ; ya cmp r1 ,#24 ; an XOFF? beq 60$ ; ya cmp r1 ,#63 ; maybe it's <200!XON> beq 60$ ; ya cmp r1 ,#65 ; how about <200!XOFF> .if df RSTS ; /E64/ beq 60$ ; /E64/ .endc ;RSTS ; /E64/ .if df RT11 ; /E64/ bne 70$ ; nope.. 60$: tst km.lock ; hardware flow control here is beq 80$ ; only supported on the KM handler clr -(sp) ; a one word buffer mov sp ,r2 ; pointer to it .spfun #rtwork,#xc.control,#clstat,r2,#0,#1 ; get the status bit #cl.flow,(sp)+ ; if <> it's done in hardware beq 80$ ; it's software flow control .endc ;RT11 ; /E64/ 70$: movb r4 ,ctlflgs(r1) ; set or clear as req'd .. ct.loop:call nextarg ; look for another arg tstb (r1) ; find one? beq ct.exit ; nothing left to do copyz r1 ,argbuf ,#ln$max-4 ; pull it up to top of argument buffer jmp sct$$ ; loop back and give it a go.. .if df RSTS ; /E64/ 60$: ; /E64/ always software for RSTS ; /E64/ unless it's a terminal server? .endc ;RSTS ; /E64/ 80$: mov #st0.43 ,r5 ; enter here for XOFF warning movb #1 ,ctlflgs(r1) ; ensure char gets quoted br ct.err 90$: mov #st0.44 ,r5 ; enter here for NULL warning ct.err: tst infomsg ; info messages on? beq ct.loop ; no, skip this stuff cmp r1 ,#41 ; is this a shifted down char? blo 100$ ; no add #137 ,r1 ; ya, bump 101..41 back to 240..200 100$: decb r1 ; now back to where we started mov #errtxt ,r2 ; a handy buffer deccvt r1 ,r2 ,#ct.wid ; integer > ascii, right justify clrb ct.wid(r2) ; null terminate the ascii string wrtall r2 ; display it then 110$: wrtall r5 ; add the appropriate tag line .newline br ct.loop command ctlst ,ALL ,1 ,sct$al command ctlst sct$al: clr r3 ; start off at offset = zero 120$: mov r3 ,r1 ; do this character position in table call ct.all ; ..one by one inc r3 ; next time do next char cmp r3 ,#101 ; there are 65. total control chars blos 120$ ; loop until they've all been done return .dsabl lsb .sbttl Get the next argument nextarg:mov argbuf ,r1 ; pointer to top of args buffer 10$: tstb @r1 ; is this char a null? beq 20$ ; ya, done cmpb (r1)+ ,#space ; no, but is it a delimiter? bne 10$ ; no, try the next char.. 20$: return .sbttl Memory allocation ; /62/ moved this here ; input: r0 Amount of memory needed malloc: inc r0 ; ensure r0 is pointing bic #1 ,r0 ; to an even word boundary mov r0 ,-(sp) ; save a copy of this address add @albuff ,(sp) ; add used part of buffer to it cmp (sp) ,#alsize ; is there any room left? bhis 10$ ; no mov albuff ,r0 ; ya, compute pointer to this add #2 ,r0 ; new allocation add @albuff ,r0 ; it begins here.. mov (sp)+ ,@albuff ; this is the new start of free memory return 10$: clr r0 ; indicate failure tst (sp)+ ; dump needed memory buffer return .end