home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
kermit.columbia.edu
/
kermit.columbia.edu.tar
/
kermit.columbia.edu
/
test
/
pdp11
/
krte80.mac
< prev
next >
Wrap
Text File
|
1996-10-17
|
67KB
|
2,420 lines
.title krte80 kermit i/o for RSTS version 8
.ident /V04.64/
; /E64/ 05-May-96 John Santos
;
; From K11E80.MAC. Move messages to top.
; Channel # in ttyini, xbinre, and pakwri is now a constant.
; Add xbinr1 with channel # as argument.
; Fake DTR and CD testing.
; Make KBREAD return cmd$ex if ctrl/Z, cmd$ab if ctrl/C
; Init clkflg, break in xinit
; Add CANTIM (canonical time, not cancel timer for the VMS impaired)
; Change delimiter mask for packet mode to be only packet characters
; Change packet mode to be binary mode with xon (should be controlled
; by whether XON flow control is enabled...)
; l$ttyo, binmod are obsolete.
; new wrtcnt routine, like wrtall, but gets passed the length of
; the output string
; wrtall, wrtcnt, writ1ch all call dowrite, write to channel 0 if
; lun.tt is not open
.psect $code ,ro,i,lcl,rel,con
; define macros and things we want for KERMIT-11
.include /SY:[1,2]COMMON.MAC/
.iif ndf, xrb , .error ; INCULDE for [1,2]COMMON.MAC failed
.if ndf, KRTINC
.ift
.include /IN:KRTMAC.MAC/
.endc
.iif ndf, krtinc, .error ; INCLUDE for IN:KRTMAC.MAC failed
.title krte80 ; common.mac destroys our name
; Copyright (C) 1983,1984,1985 Change Software, Inc.
;
;
; This software is furnished under a license and may
; be used and copied only in accordance with the
; terms of such license and with the inclusion of
; the above copyright notice. This software or any
; other copies thereof may not be provided or other-
; wise made available to any other person. No title
; to and ownership of the software is hereby trans-
; ferred.
;
; The information in this software is subject to
; change without notice and should not be construed
; as a commitment by the author.
;
;
.sbttl the entry points
; In all cases, R0 will have the returned error code (zero for success)
; For KBREAD and READ, R1 will have the size of the read
; For BINREAD, R1 will have the character just read
;
; The use of %LOC and %VAL are from VMS Pascal and Fortran.
; %LOC means ADDRESS, whereas %VAL means literal. All call
; formats assume the first argument is at 0(r5), the next
; at 2(r5) and so on, as in:
;
; clr -(sp) ; today's date by default
; mov #datebf ,-(sp) ; where to put the converted string
; mov sp ,r5 ; call ASCDAT
; call ascdat ; simple
; cmp (sp)+ ,(sp)+ ; all done
;
; or by using the CALLS macro (defined in KRTMAC.MAC)
;
; calls ascdat ,<#datebf,#0>
;
;
; Any version of Kermit-11 which can not, due to the lack of
; executive support, implement a function should return an
; error of -1 in r0. For instance, RT11 does not have any
; executive primitives to do wildcarding directory lookup.
;
;
;
;
; ASCDAT ( %loc buffer, %val datevalue )
; ASCTIM ( %loc buffer, %val timevalue )
; ASSDEV ( %loc device_name )
; BINREA ( %val timeout )
; BINWRI ( %loc buffer, %val byte_count )
; CANTIM ( %loc buffer, %val datevalue, %val timevalue )
; CANTYP ( )
; CHKABO ( )
; DCDTST ( )
; DODIR ( %loc directory_string, %val lun )
; DRPPRV ( )
; DSKUSE ( %loc returned_string )
; ECHO ( %loc terminal_name )
; EXIT ( )
; GETPRV ( )
; GETUIC ( )
; GTTNAM ( %loc returned_ttname )
; KBREAD ( %loc buffer )
; L$PCRL ( )
; L$TTYO ( %loc buffer, %val bytecount )
; LOGOUT ( )
; NAMCVT ( %loc source_filename, %loc returned_normal_name )
; NOECHO ( %loc device_name )
; QUOCHK ( )
; READ ( %loc buffer, %val buffer_length, %val lun, %val block_number )
; SETCC ( )
; SETSPD ( %val speed )
; SUSPEN ( %val seconds, %val ticks )
; SYSERR ( %val error_number, %loc error_text_buffer )
; TTRFIN ( )
; TTRINI ( )
; TTSPEE ( )
; TTYDTR ( )
; TTYFIN ( )
; TTYHAN ( )
; TTYINI ( %val open_flags )
; TTYPAR ( %loc terminal_name, %val parity_code )
; TTYRST ( )
; TTYSAV ( %loc terminal_name )
; TTYSET ( %loc terminal_name )
; WRITE ( %loc buffer, %val buffer_length, %val lun, %val block_number )
; XINIT ( )
.sbttl Local data ; /63/ consolidated here..
lun.kb == 0 ; assume if channel 0 --> terminal
lun.in == 1 ; channel for input files
lun.ou == 2 ; channel for output files
lun.lo == 3 ; channel for packet and file logging
lun.tr == 3 ; same as lun.log
lun.ta == 4 ; for the TAKE command
lun.tt == 5 ; for RSX, the normal TI: channel
lun.sr == 6 ; channel for $search for RMSv2.0
lun.ti == 7 ; channel number for connected terminal
lun.xk == 7 ; Ditto, for clarity
lun.co == 10 ; used as is lin.ti for remote connect
lun.as == 11 ; used to attach to remote link device
; to fake a device assignment
.psect dirctx ,rw,d,lcl,rel,con
dirnam: .blkb 120
dirfir: .blkb 42
dirbuf: .blkb 100
diridx: .word 0
dirptr: .word dirbuf
dcrlf: .byte 15,12,0
.even
.psect buffer ,rw,d,lcl,rel,con
lunsize = 17
lokahd: .word 0 ; /44/
linit: .blkw 20
lpoint: .blkw 20
lsize: .blkw 20
lbuffer:.blkb MAXLNG+<MAXLNG/10> ; /42/ Bigger for LONG PACKETS
.even
ttsave: .blkb 40*15
bufqsav:.blkb 15
.even
ver9.x::.word 0
$xon: .byte 'Q&37
$off: .byte 'S&37
$albuf: .blkb ALSIZE
$phnum: .blkb 60
.globl albuff,phnum
.psect $pdata
.even
splst: .word dlalst,dclst,dlclst,dlelst,pklst,djlst,dhlst,dzlst,dhvlst
.word 10$,10$,10$,10$,10$,10$
10$: .word 0,0
dlalst: .word 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
dclst: .word -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
dlclst: .word 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-1
dlelst: .word 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-1
pklst: .word 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-1
djlst: .word 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,-1
dhlst: .word 0., 50.,75.,110.,134.,150.,200.,300., 600.
.word 1200.,1800.,2400.,4800.,9600.,0.,0,-1
dzlst: .word 0., 50.,75.,110.,134.,150.,300.,600.,1200.
.word 1800.,2000.,2400.,3600.,4800.,7200.,9600.,-1
dhvlst: .word 0, 75.,110.,134.,150.,300.,600.,1200.
.word 1800.,2000.,2400.,4800.,0 ,9600.,19200.,-1
sp.dev::.word 0
sp.mod::.word 0 ; use 4!40 for delete and noheader
fu$def::.word 177777 ; do we need a defdir for RMS11v2
;/E64/
; Useful delimiter masks
; Let's only make protocol characters delimiters for transfers
pakmsk:
.rept 2
.byte ^B00101010
.byte ^B00100100
.byte 0
.byte ^B00000100
.rept 14
.byte 0
.endr
.endr
;pakmsk: .byte ^B11110111
; .byte 377
; .byte 377
; .byte 377
; .rept 13
; .byte 0
; .endr
; .rept 21
; .byte 377
; .endr
dlmmsk::.byte ^B11110111 ; all chars except control C
.byte ^B11111111
.rept 36
.byte 377
.endr
.even
dlmcc: .rept 40
.byte 377
.endr
.even
;xzmask: .byte ^B00100010 ; control E and A (/56/)
; .byte 0
; .byte 0
; .byte ^B00000101 ; control X and control Z please
; .rept 34
; .byte 0
; .endr
hwcfg: .asciz "HWCFG"
kp.res: .byte 33 ,'> ,0 ; type this out to reset keypad
kb: .asciz "_KB:"
e80.01: .asciz "You lack the HWCFG privilege to assign a line"<cr><lf>
e80.02: .ascii "? This copy of RSTS is missing the multiple private"<cr><lf>
.ascii "delimiter SYSGEN option. Please include this option"<cr><lf>
.ascii "in RSTS for KERMIT to function"
crlf: .byte 15 ,12 ,0
crnolf: .byte 15 ,0
hndlst: .byte ttyhnd ,pkbhnd ,dmchnd ,dmphnd ,0
wild: .asciz "*.*"
trmtyp: .byte 6. ; /39/ vt100
.byte 13. ; /39/ vt101
.byte 14. ; /39/ vt102
.byte 15. ; /39/ vt125
.byte 16. ; /39/ vt131
.byte 17. ; /39/ vt132
.byte 18. ; /39/ vt220
.byte 19. ; /39/ vt240
.byte 20. ; /39/ vt241
.byte 21. ; /39/ vt105
.byte 22. ; /39/ vk100 (gigi)
.byte 23. ; /39/ rt02
.byte 48. ; /58/ VT330
.byte 49. ; /58/ VT430
.byte 0 ; /39/ end
ttdevl: .asciz "KLDCDLDEPKDJDHDZVH"
.even
.sbttl edits
; 05-Jan-84 14:34:01 BDN Added TT8BIT mode to line if no parity
; since the terminal driver always strips
; bit 7 even if the character is a delim.
.sbttl macros
.macro clrfqb
call $clrfq
.endm clrfqb
.macro clrxrb
call $clrxr
.endm clrxrb
nodata == 13. ; no data for terminal read
detkey == 27. ; i/o to detached tt line
.psect USERMD ,rw,d,gbl,rel,con
.psect $code
xinit:: save <r1>
call seconds ; /E64/ init clock
mov #17. ,break+2 ; /E64/ assume 60Hz for break length
cmp #60. ,clkflg ; /E64/ 60Hz clock?
beq 5$ ; /E64/ yup..
mov #14. ,break+2 ; /E64/ fix break length for 50Hz
5$: call rmsini ; /53/ Setup SST
mov #$phnum ,phnum ; /51/
mov #$albuf ,albuff ; /51/ Fill address in.
clrb @phnum ; /51/ Clear
clr @albuff ; /51/ Clear first word.
mov #$cmdbuf,cmdbuf ; /53/ $CMDBUF defined in KRTRMS
mov #$argbuf,argbuf ; /53/ $ARGBUF defined in KRTRMS
mov sp ,infomsg ; /41/ msg displaying
clr df$rat ; stream ascii please for RSTS?
movb #fb$stm ,df$rfm ; say so and exit
mov #ttsave ,r1 ; initialize the terminal char
mov #15 ,r0 ; save area now.
10$: movb #377 ,(r1)+ ; the ttysave area is set up for
add #40 ,r1 ; saving up to 15 (8) settings.
clrb bufqsav(r0) ; /40/ clear old buffer quotas
sob r0 ,10$ ; makes it easy to save via LUN
calls l$fss ,<#kb> ; open terminal on LUN.AS
movb #opnfq ,FIRQB+FQFUN ; to fix things up if using
movb #lun.tt ,FIRQB+FQFIL ; it's global please
aslb FIRQB+FQFIL ; times 2 please
CALFIP ; simple
movb FIRQB ,r0 ; it can't fail !!
beq 20$ ; ok
direrr r0 ; oops
20$: call inqv9 ; /40/ global flag for version 9.x
bcs 40$ ; /45/ Not version 9 or later
clrfqb ; /45/ V9, get the JOB type
movb #UU.SYS ,FIRQB+FQFUN ; /45/ Job stats, part 3
movb #2 ,FIRQB+5 ; /45/ Subfunction code
.UUO ; /45/ Do it please
mov #proctype,r0 ; /45/ Address of process_type
clr (r0) ; /45/ Word sized
movb FIRQB+20,(r0) ; /45/ Save our process type now
clr jobtype ; /45/ Assume interactive
cmpb (r0) ,#PRO$NET ; /45/ Is this a SET HOST job ?
beq 30$ ; /45/ Yes, let it be INTERACTIVE
cmpb (r0) ,#PRO$BAT ; /45/ Is this a BATCH job ?
bne 30$ ; /45/ No, assume INTERACTIVE for now
mov #JOB$BAT,jobtype ; /45/ Set BATCH access
30$: ; /45/ Maybe more kinds in the future
40$: call inqter ; /39/ get terminal type
movb r0 ,vttype ; /39/ same terminal type
cmp jobtype ,#JOB$BAT ; /59/ Batch?
bne 50$ ; /59/ No
clr vttype ; /59/ Yes, dumb terminal
clr blip ; /59/ No packet count updates
50$:
clr r0
unsave <r1>
return
.globl lastli
.globl df$rat,df$rfm,fb$stm,getuic,lun.tt,vttype
.globl infomsg,inqter
.globl jobtyp,procty ; /E64/
.globl ARGBUF,CMDBUF,$ARGBUF,$CMDBUF ; /53/
.globl RMSINI,BLIP ; /53/
.globl direr$ ; /E64/
.globl seconds,clkflg,break ; /E64/
.assume JOB$INT eq 0 ; /45/
.sbttl terminal initialization
.psect $code
; T T Y I N I
;
; ttyini( %val ccflag )
;
;
; input: @r5 bitfield for ter$cc and ter$bi
;
; if (r5) and ter$bi then use binary open
; else use multiple delimiters
; if (r5) and ter$cc then set control c as delimiter
; if (r5) and ter$xo then allow binary mode with XON
;
; output: r0 error codes
;
;
; Ttyini sets the appropiate terminal characteristics for
; the device name in #ttname and returns the device open (or
; attached) on logical unit lun.ti. Errors are returned
; in r0. For RSTS these could be the usual device not avail-
; able or missing monitor feature.
;
; useful things to add: device check for terminal
ttyini::save <r2>
clr lokahd ; /44/ Clear lookahead
call getprv ; will need for binary open
mov #lun.ti*2, r2 ; /E64/ set up channel #
clr lpoint(r2) ; clear offset into local buffer
clr linit(r2) ; we have not set fast packet mode
clr lsize(r2) ; we have not read anyting yet also
clrfqb ; insure FIRQB and xrb are cleared
clrxrb ; of undesirable defaults
mov #ttname ,r0 ; get address of device string
tstb @r0 ; anything there ?
bne 10$ ; yes
calls l$fss ,<#kb> ; no, use _KB:
br 20$
10$: calls l$fss ,<r0> ; do the usual .FSS to parse
20$: tst r0 ; the device name
bne 100$ ; oops
movb #opnfq ,FIRQB+FQFUN ; open the device up now
movb r2 ,FIRQB+FQFIL
bit #ter$bi ,(r5) ; use straight binary mode today ?
beq 30$ ; no
mov #100001 ,FIRQB+FQMODE ; yes
bit #ter$xo ,(r5) ; want xon/xoff to work normally ?
beq 30$ ; no
bis #40 ,FIRQB+FQMODE ; yes, add the mode in please
30$: bit #ter$pa ,(r5) ; /E64/ use packet mode?
beq 35$ ; /E64/ no
mov #100041 ,FIRQB+FQMODE ; /E64/ yes
35$: CALFIP ; get fip to do it
movb FIRQB ,r0 ; fail ?
bne 100$ ; /E64/ yes
bit #ter$bi ,(r5) ; use straight binary mode today ?
bne 50$ ; yes
clr r0 ; assume control c's are ok
bit #ter$cc ,(r5) ; did the caller want to allow ^C
beq 40$ ; yes
dec r0 ; no, make control C a delimiter
br 45$
40$: bit #ter$pa ,(r5)
beq 45$
inc r0
mov sp ,linit(r2)
45$: calls setdlm ,<#lun.ti,r0> ; no, try to set up delimiter
50$: tst r0 ; did it work also
bne 80$ ; no
call initer ; yes, set the tty's characteristics
br 100$ ; and exit (with errors in r0)
80$: cmpb r0 ,#102 ; "missing special feature?"
bne 100$ ; no
wrtall #e80.02 ; /E64/ yes, make it reasonable
100$: call drpprv ; no longer want privs please
tst r0 ; /E64/ any error?
beq 110$ ; /E64/ no
direrr r0 ; /E64/ report it
110$: unsave <r2>
return
.sbttl close up a terminal line
ttyfin::save <r1,r2,r3>
calls ttpars ,<#ttname> ; get unit number
mov r0 ,r3 ; save it
movb FIRQB ,r0 ; check for any errors from parse
bne 100$ ; oops
calls clrdlm ,<#lun.ti> ; clear private delimiters
mov #lun.ti*2, r0 ; channel # times 2
clr lsize(r0) ; nothing in packet buffer
clr linit(r0) ; not using packet buffering now
clrfqb ; close the terminal
movb #clsfq ,FIRQB+FQFUN ; fip subfunction for closing lun
movb #lun.ti*2,FIRQB+FQFIL ; channel number
CALFIP ; close it now
movb FIRQB ,r0 ; get any errors from close
bne 100$ ; oops, just exit then
mov #lun.ti ,r1 ; get the channel number
clrfqb ; /40/ insure no unpleasant effects
movb #UU.TRM ,FIRQB+FQFUN ; /40/ uuo code for terminals
incb FIRQB+4 ; /40/ subfunction one
movb r3 ,FIRQB+5 ; /40/ unit number or 377
movb bufqsav(r1),FIRQB+27 ; /40/ restore old buffer quotas
.UUO ; /40/ ignore errors
mul #40 ,r1 ; offset into the TTSAVE area
add #ttsave ,r1 ; finally, the address of saved stuff
cmpb @r1 ,#377 ; but is the saved stuff real ?
beq 100$ ; no
mov r1 ,-(sp) ; yes, try to set terminal chars
mov #FIRQB ,r2 ; where to put the parameters
mov #40 ,r0 ; number of bytes to copy
10$: movb (r1)+ ,(r2)+ ; do a byte please
sob r0 ,10$ ; next
clrb FIRQB+4 ; Version 9 fix here
bisb FIRQB+36,FIRQB+20 ; UU.TRM returns 8bit setting here
clr FIRQB+36 ; insure unused for future rsts/e?
movb #UU.TRM ,FIRQB+FQFUN ; uuo subfunction for terminals
movb r3 ,FIRQB+5 ; stuff the unit number in
.UUO ; try to do it
movb FIRQB ,r0 ; save any errors
mov (sp)+ ,r1 ; get the ttsave address back
movb #377 ,@r1 ; mark as being invalid
100$: unsave <r3,r2,r1> ; pop registers and exit
return
.sbttl get terminal name
; G T T N A M
;
; input: @r5 address of 8 character buffer for terminal name
; output: .asciz name of terminal
gttnam::save <r0,r1,r2> ; may as well save it
mov @r5 ,r2 ; now return the name
movb #'_ ,(r2)+ ; return _KBnn:
movb #'K ,(r2)+ ; return _KBnn:
movb #'B ,(r2)+ ; return _KBnn:
clrfqb ; assume defaults
movb #UU.SYS ,FIRQB+FQFUN ; for a systat part one
.UUO ; simple
movb FIRQB+5 ,r1 ; get the name
bmi 90$ ; detached ?
clr r0 ; now compute the ascii name
div #100. ,r0 ; /19/ lots of terminals on system?
tst r0 ; /19/ ge kb100: ?
beq 10$ ; /19/ no
add #'0 ,r0 ; /19/ convert the 100's part of unit
movb r0 ,(r2)+ ; /19/ and copy it please
10$: clr r0 ; /19/ get the low two digits please
div #10. ,r0 ; simple
add #'0 ,r0
add #'0 ,r1
movb r0 ,(r2)+
movb r1 ,(r2)+
90$: movb #': ,(r2)+
clrb @r2
unsave <r2,r1,r0>
return
.sbttl set delimiter bitmask up please
; S E T D L M
;
;! setdlm( %val channel_number, %val cc_flag )
;
; input: @r5 channel number to use
; 2(r5) control/c flag
;
; output: r0 error code (would be missing sysgen feature)
snoecho:mov #xrb ,r0 ; pointer to parameter block
mov #3 ,(r0)+ ; function to disable echo
clr (r0)+ ; unused
clr (r0)+ ; unused
movb 2(sp) ,@r0 ; channel number
aslb (r0)+ ; times 2
movb #ttyhnd ,(r0)+ ; driver index (ttdvr)
clr (r0)+ ; unused
clr (r0)+ ; unused
clr (r0)+ ; unused
.spec ; now do it
movb FIRQB ,r0 ; return any errors
mov (sp)+ ,(sp) ; pop arg list and exit
return ; exit
setdlm::mov @r5 ,-(sp)
call snoecho
mov #xrb ,r0 ; setup to set a private delim
mov #11 ,(r0)+ ; mask now. function code is 11
mov #40 ,(r0)+ ; for .spec, 40 byte to copy
mov #dlmmsk ,(r0)+ ; address of delimiter mask
tst 2(r5) ; allow control c's to come in
beq 10$
bmi 5$
mov #pakmsk ,-2(r0)
br 10$
5$: mov #dlmcc ,-2(r0)
10$: movb @r5 ,@r0 ; channel number
aslb (r0)+ ; times 2
movb #ttyhnd ,(r0)+ ; device driver index
clr (r0)+ ; default to console device
clr (r0)+ ; unused
mov #1 ,(r0)+ ; subfunction SET DELIMITER
.spec ; and do it please
movb FIRQB ,r0 ; did it work ?
return
clrdlm::
mov #xrb ,r0 ; point to it please
mov #11 ,(r0)+ ; subfunction
clr (r0)+ ; must be 0
clr (r0)+ ; also 0
movb @r5 ,@r0 ; channel number please
aslb (r0)+
movb #ttyhnd ,(r0)+ ; device driver to call
clr (r0)+ ; use channel number
clr (r0)+ ; must be zero
clr (r0)+ ; subfunction 0
.spec ; and call ttdvr
100$: return
.sbttl special init for receiving files
;/E64/ Nothing seems to call this stuff anymore.
; Due to what I would consider a RSTS terminal driver
; bug ( .ttddt isn't cleared if you do a read without
; wait and there was no data) we have to call this
; before we receive any files from a remote kermit.
;ttrini::mov #xrb ,r0 ; setup to set a private delim
; mov #11 ,(r0)+ ; mask now. function code is 11
; mov #40 ,(r0)+ ; for .spec, 40 byte to copy
; mov #xzmask ,(r0)+ ; address of delimiter mask
; movb #lun.tt ,@r0 ; channel number
; aslb (r0)+ ; times 2
; movb #ttyhnd ,(r0)+ ; device driver index
; clr (r0)+ ; default to console device
; clr (r0)+ ; unused
; mov #1 ,(r0)+ ; subfunction SET DELIMITER
; .spec ; and do it please
; return
;ttrfin::calls clrdlm ,<#lun.tt>
; return
.sbttl other things like echo off and on
; N O E C H O
;
;
; input: @r5 terminal name or null or 0 for current terminal
; output: r0 error code
noecho::save <r1> ; save a temp register
clr r0 ; assume our terminal
mov @r5 ,r1 ; passed address of 0 or a null string?
beq 10$ ; no address, assume _KB:
tstb @r1 ; null string passed ?
beq 10$ ; yes, assume the console terminal
call ttpars ; parse the terminal device name
bcs 90$ ; oops
cmpb r0 ,#377 ; own terminal ?
bne 10$ ; no
call myterm ; yes, get correct unit number then
10$: clrxrb ; insure no defaults
mov #xrb ,r1 ; point to the xrb now
mov #3 ,(r1)+ ; disable function for .SPEC
mov r0 ,(r1)+ ; terminal number or zero for _KB:
movb #ttyhnd ,xrb+7 ; and the device driver index please
.spec ; simple
90$: movb FIRQB ,r0 ; error, return it please
100$: unsave <r1> ; pop the register we saved
return
; E C H O
;
; input: @r5 terminal name or null or 0 for current terminal
; output: r0 error code
echo:: save <r1> ; save a temp register
clr r0 ; assume our terminal
mov @r5 ,r1 ; passed address of 0 or a null string?
beq 10$ ; no address, assume _KB:
tstb @r1 ; null string passed ?
beq 10$ ; yes, assume the console terminal
call ttpars ; parse the terminal device name
bcs 90$ ; oops
10$: clrxrb ; insure no defaults
mov #xrb ,r1 ; point to the xrb now
mov #2 ,(r1)+ ; enable echo function for .SPEC
mov r0 ,(r1)+ ; terminal number or zero for _KB:
movb #ttyhnd ,xrb+7 ; and the device driver index please
.spec ; simple
90$: movb FIRQB ,r0 ; error, return it please
100$: unsave <r1> ; pop the register we saved
return
.sbttl write and read
; W R I T E
;
;! write( %loc buffer, %val buffer_length, %val channel_number,
;! %val block_number )
;
;
; input: @r5 buffer address
; 2(r5) buffer length
; 4(r5) channel number
; 6(r5) block number
;
; output: r0 error code
write:: mov #xrb ,r0 ; address of xrb parameter block
mov 2(r5) ,(r0)+ ; buffer length
mov 2(r5) ,(r0)+ ; byte count for the i/o
mov @r5 ,(r0)+ ; address of the buffer
movb 4(r5) ,@r0 ; channel number
aslb (r0)+ ; times 2
clrb (r0)+ ; unused
clr (r0)+ ; unused
clr (r0)+ ; unused
clr (r0)+ ; unused
mov 6(r5) ,xrb+xrblk ; forgot to stuff this one in
.WRITE
movb FIRQB ,r0 ; return error code and exit
return
; R E A D
;
;! read( %loc buffer, %val buffer_length, %val channel_number,
;! %val block_number )
;
; input: @r5 buffer address
; 2(r5) buffer length
; 4(r5) channel number
; 6(r5) block number
;
; output: r0 error code
; r1 byte count for read
read:: mov #xrb ,r0 ; address of xrb parameter block
mov 2(r5) ,(r0)+ ; buffer length
clr (r0)+ ; must be zero
mov @r5 ,(r0)+ ; address of the buffer
movb 4(r5) ,@r0 ; channel number
bne 10$ ; /52/ Not Chan zero
.TTECH ; /52/ Chan zero, insure echo
10$: aslb (r0)+ ; times 2
clrb (r0)+ ; unused
clr (r0)+ ; unused
clr (r0)+ ; unused
clr (r0)+ ; unused
mov 6(r5) ,xrb+xrblk ; forgot to stuff this one in
.READ
clr r1 ; /36/ assume error
movb FIRQB ,r0 ; return error code and exit
bne 100$ ; /36/ insure zero bytecount on error
mov xrb+xrbc,r1
100$: return
kbread::.TTECH
calls read ,<@r5,#80.,#0,#0> ; do the actual read now
cmpb r0 ,#11. ; /E64/ ctrl/Z?
bne 10$ ; /E64/ no
mov #cmd$ex ,r0 ; /E64/ yes, so tell caller
10$: tst cccnt ; /E64/ ctrl/c typed?
beq 20$ ; /E64/ no
mov #cmd$ab ,r0 ; /E64/ yes, so tell caller
clr r1 ; /E64/ and signal no input
20$: mov r1 ,-(sp) ; /36/ save byte count
add @r5 ,r1 ; /36/ point to end to make it .asciz
clrb @r1 ; /36/ .asciz
mov (sp)+ ,r1 ; /36/ restore length
return
.globl cmd$ex ,cmd$ab ,cccnt ; /E64/
.sbttl terminal read/write binary mode
; B I N R E A
;
;! binread( %val timeout )
;
;
; input: @r5 timeout (if -1, then no wait)
;
; output: r0 error
; r1 character read
;
; assumptions: the terminal has all characters set up
; as private delimeters
;
;
; BINREAD is called ONLY for packet reading.
; XBINREA is called for general single character data reading
;
;
; /44/ If a packet reads gets ESC<letter>, where LETTER is in the
; range 100-137, then we can safely assume that the version
; 9 terminal driver did us the favor of converting a C1 char
; into the equivalent (?) escape sequence. What a hack!
pakrea::
binrea::tstb lokahd+1 ; /44/ Anything REALLY there?
bne 90$ ; /44/ Yes, use it
call doread ; /44/ Read next character
tst r0 ; /44/ Success?
bne 100$ ; /44/ No, just exit with error
cmpb r1 ,#33 ; /44/ Escape character?
bne 100$ ; /44/ No, use it as is
call doread ; /44/ Yes, look for char in 100..137
tst r0 ; /44/ Should always work
bne 95$ ; /44/ But if not, return( '\033' )
cmpb r1 ,#100 ; /44/ Is it in the range of \0100
blo 80$ ; /44/ to \0137 ?
cmpb r1 ,#137 ; /44/ Well ?
bhi 80$ ; /44/ Yes, we can't control it then
bisb #100 ,r1 ; /44/ In range, restore to CORRECT
br 100$ ; /44/ format of CTL+0100
80$: incb lokahd+1 ; /44/ Invalid, set lookahead flag
movb r1 ,lokahd+0 ; /44/ Save the data please
movb #33 ,r1 ; /44/ Return( '\033' )
br 100$ ; /44/ for next read and exit
90$: clr r1 ; /44/ Setup for lookahead data
bisb lokahd ,r1 ; /44/ Insert lookahead data
95$: clr lokahd ; /44/ No more lookhahead data
clr r0 ; /44/ No errors
100$: return ; /44/ Exit
.sbttl Really read next character in the buffer now
doread: save <r2> ; save temp register
5$: mov #lun.ti*2,r2 ; get the channel number * 2
tst linit(r2) ; has this lun ever been set
beq 20$ ; up for a partial delimiter mask?
tst lsize(r2) ; yes, is there any data waiting?
bgt 10$ ; yes, get whats already there
clr lpoint(r2) ; no, clear the pointer
clr lsize(r2) ; insure buffer size is zero
call rget ; and read a record if possible
tst r0 ; if it fails, revert to 1 char
bne 100$ ; i/o
10$: dec lsize(r2) ; one less character in buffer
bmi 5$ ; if < 0, nothig was read. do it again
mov lpoint(r2),r0 ; get the offset into the buffer
inc lpoint(r2) ; and prime this for next time
clr r1 ; avoid pdp-11 sign extension
bisb lbuffer(r0),r1 ; get the character from the buffer
clr r0 ; no errors
br 100$ ; and exit
20$: call xbinrea ;
100$: unsave <r2> ; pop temp register and exit
return ;
rget: mov #xrb ,r0 ; address of xrb parameter block
mov #MAXLNG ,(r0)+ ; /42/ buffer length
clr (r0)+ ; must be zero
mov #lbuffer,(r0)+
movb r2 ,(r0)+ ; channel number
bne 5$ ; /52/ Not zero
.TTECH ; /52/ Zero, insure echoing
5$: clrb (r0)+ ; unused
clr (r0)+ ; unused
cmp (r5) ,#-1 ; no wait ?
bne 10$ ; no
clr (r0)+ ; yes
mov #8192. ,(r0)+ ; stuff return without wait in
br 20$ ; and do it
10$: mov (r5) ,(r0)+ ; timeout
clr (r0)+ ; unused
20$: .READ
movb FIRQB ,r0 ; return error code and exit
beq 30$ ; /45/ No errors
cmpb r0 ,#DETKEY ; /45/ I/O to detached Keyboard ?
bne 100$ ; /45/ No
mov #1 ,XRB+0 ; /45/ Yes, sleep a moment
.SLEEP ; /45/ ...
br 100$ ; /45/ Exit
30$: mov xrb+xrbc,lsize(r2) ; Read size, save it
clr lpoint(r2)
add #1 ,rdrate+4 ; /56/ Stats
bcs 40$ ; /56/ Overflowed
add lsize(r2),rdrate+2 ; /56/ Count the data
adc rdrate+0 ; /56/ 32 bits worth
br 100$ ; /56/ And exit
40$: clr rdrate+0 ; /56/ Overflow, so reset
clr rdrate+2 ; /56/ Overflow, so reset
clr rdrate+4 ; /56/ Overflow, so reset
100$: return
.globl rdrate ; /56/
.enabl lsb
xbinr1::movb 2(r5) ,r1 ; /E64/ get channel #
br 1$ ; /E64/ skip setup
xbinre::movb #lun.ti ,r1 ; /E64/ always this lun
1$: mov #xrb ,r0 ; address of xrb parameter block
mov #1 ,(r0)+ ; buffer length
clr (r0)+ ; must be zero
clr -(sp) ; allocate buffer on the stack
mov sp ,(r0)+ ; address of the buffer
movb r1 ,@r0 ; channel number
bne 5$ ; /52/ Not zero
.TTECH ; /52/ Zero, insure echoing
5$: aslb (r0)+ ; times 2
clrb (r0)+ ; unused
clr (r0)+ ; unused
cmp (r5) ,#-1 ; no wait ?
bne 10$ ; no
clr (r0)+ ; yes
mov #8192. ,(r0)+ ; stuff return without wait in
br 20$ ; and do it
10$: mov (r5) ,(r0)+ ; timeout
clr (r0)+ ; unused
20$: .READ
movb FIRQB ,r0 ; return error code and exit
clr r1
bisb (sp)+ ,r1
return
.dsabl lsb
; Check for pending input on terminal (like ^X and ^Z)
; Note: .TTDDT should be cleared by TTDVR always. It's
; not, so for the time being lets forget about it and
; instead setup ^X and ^Z as delimiters. I would have
; preferred to use odt mode for this routine.
chkabo::tst jobtyp ; /45/ Can't do from batch
bne 110$ ; /45/ Exit then
calls xbinr1 ,<#-1,#lun.tt> ; simple read on console terminal
tst r0 ; did it work ok ?
bne 100$ ; no
mov r1 ,r0 ; yes, return ch in r0 please
return
100$: cmpb r0 ,#11. ; error EOFEOF?
bne 110$ ; no
movb #'Z&37 ,r0 ; yes, return ^Z as the character
return
110$: clr r0 ; it failed
return
.assume JOB$INT eq 0
.assume JOB$BAT eq 1
read1c::CLRXRB ; Insure XRB is zapped
.TTNCH ; No echo
.TTDDT ; One shot ODT mode
CLRXRB ; Insure XRB zapped
clr -(sp) ; Allocate a buffer
mov sp ,r1 ; A pointer
mov r1 ,XRB+XRLOC ; Buffer address
inc XRB+XRLEN ; One character size buffer
.READ ; Simple
clr r0 ; Return the character next
tstb FIRQB ; Errors?
bne 100$ ; Yes, return a NULL
tst XRB+XRBC ; No data?????
beq 100$ ; Should never happen.
bisb @r1 ,r0 ; No, return the data then.
100$: tst (sp)+ ; Pop the buffer and exit
return ; Bye
writ1ch::
SAVE <r2,r1,r0> ; /E64/ Save registers
mov sp ,r2 ; /E64/ point to character
mov #1 ,r0 ; /E64/ buffer length
call dowrite ; /E64/ do it
UNSAVE <r0,r1,r2> ; /E64/ Pop registers
return ; And exit
Wrtcnt::SAVE <r0,r1,r2> ; /E64/ Save registers
mov 2+6(sp) ,r2 ; /E64/ String address
mov 4+6(sp) ,r0 ; /E64/ get string length
call dowrite ; /E64/
UNSAVE <r2,r1,r0> ; /E64/ Pop registers
mov (sp)+ ,(sp) ; /E64/ Move return address up
mov (sp)+ ,(sp) ; /E64/ Move return address up
return ; /E64/ And exit
Wrtall::SAVE <r0,r1,r2> ; Save registers
mov 2+6(sp) ,r2 ; String address
STRLEN r2 ; Get the length
call dowrite ; /E64/
UNSAVE <r2,r1,r0> ; Pop registers
mov (sp)+ ,(sp) ; Move return address up
return ; And exit
; /E64/
;
; In dowrite, R0 is length of buffer
; R2 is address of buffer
;
dowrite:mov #xrb ,r1 ; address of xrb parameter block
mov r0 ,(r1)+ ; buffer length
mov r0 ,(r1)+ ; byte count for the i/o
mov r2 ,(r1)+ ; address of the buffer
mov #lun.tt*2,(r1)+ ; /E64/ always use non-zero chan to
; /E64/ avoid tromping on binary mode
clr (r1)+ ; unused
clr (r1)+ ; unused
mov #4096. ,(r1)+ ; /E64/ modifier (ie, binary output)
.WRITE ; Do the WRITE
cmpb FIRQB ,#11 ; /E64/ i/o channel not open ?
bne 10$ ; /E64/ no, exit please
; /E64/ try again on channel 0
mov #xrb ,r1 ; /E64/ address of xrb parameter block
mov r0 ,(r1)+ ; /E64/ buffer length
mov r0 ,(r1)+ ; /E64/ byte count for the i/o
mov r2 ,(r1)+ ; /E64/ address of the buffer
clr (r1)+ ; /E64/ channel 0
clr (r1)+ ; /E64/ unused
clr (r1)+ ; /E64/ unused
mov #40000 ,(r1)+ ; /E64/ xrmod (transparent controls)
.WRITE ; /E64/
10$: return ; And exit
.globl l$len
.sbttl write everything to the communications line
; P A K W R I
;
; input: @r5 buffer address
; 2(r5) buffer size
; output: r0 error code
;
; Pakwrite(buffer,size) attempts to write out the specified
; number of bytes in pass all mode to the line. Additionally,
; NOSTALL is specified the first time to allow us to detect the
; line being XOFF'ed. The side effect is that we may also get
; returned on a lack of small buffers, so thus we must be
; prepared to try again if that was the case. If we are XOFF'ed,
; which is indicated by the 'bytes not sent' value being equal to
; the requested write size, then we force an XON to the line.
; We also can get an XOFF via line noise in the middle of a packet
; thus we should also force an XOFF even for a partial write.
; This is messy, addtionally, it ALWAYS requires SYSIO priv even
; if you own the line. The code to do this always has to inquire
; about the unit number, which is currently only possible via an
; UU.FCB call. This is undesirable in the unlikely event that the
; first few words of the terminal DDB get changed by DIGITAL. We
; could, of course, save the unit number in TTYINI in a LUN
; indexed table, but that's conceptually unattractive. Even if it
; does change, the UU.FCB code is rarely called and not very dan-
; gerous if things change.
;
; Ideally, we need a .SPEC call to return XOFF'ed status and a
; .SPEC call to clear XOFF'ed status. The method used in the RSX
; based Kermit-11 uses a QIOW$S with a marktime in front of it,
; this if the mark time goes off we can issue an IO.KIL, clear
; the xoffed state with SF.SMC+IO.CTS, and redo the QIOW$S.
; Again, the usefulness of MARK TIME and the equiv of IO.KIL comes
; to mind for RSTS/E, as noted before in the case of having a CTRL
; C ast routine being able to kill io requests on lines other than
; one's console terminal, which a control C always does.
; Hopefully, a future release of RSTS/E will make these task
; simpler. At such time, we would have to consider the case of
; older version of RSTS/E; I would simply cut the current code
; out and let those user's not upgrading suffer; reverting to the
; old code in BINWRI (next page).
; Lately, I seem to be turning my comments into essays about the
; deficiences a given exec may have. RSTS developers, take heart,
; using the RSTS/E terminal driver is a LOT more predictable than
; than what you find on the various flavors of RSX. I simply have
; spent a lot of time in the last couple of years with RT11, RSX,
; P/OS, TSX+ and VMS; they all have strong points and weaknesses.
; What one likes in one is rarely found in the other.
.sbttl Now for the real packet writer (enough of the soapbox)
pakwri::save <r1,r2,r3> ; /45/ Save this please
mov @r5 ,r2 ; /45/ Address of the write
mov 2(r5) ,r3 ; /45/ Size of the write
mov #8192.!4096.,r1 ; /45/ First time modifier
10$: mov #XRB ,r0 ; /45/ Address of xrb parameter block
mov r3 ,(r0)+ ; /45/ Buffer length
mov r3 ,(r0)+ ; /45/ Byte count for the i/o
mov r2 ,(r0)+ ; /45/ Address of the buffer
movb #lun.ti*2,(r0)+ ; /E64/ hardwire channel #*2
clrb (r0)+ ; /45/ Unused
clr (r0)+ ; /45/ Unused
clr (r0)+ ; /45/ Unused
mov r1 ,(r0)+ ; /45/ Modifier (ie, io.wal+nostall)
.WRITE ; /45/ Really dump the data
movb FIRQB ,r0 ; /45/ return error code and exit
bne 100$ ; /45/ Error, exit NOW
tst XRB+XRBC ; /45/ Did EVERTHING get dumped ?
beq 100$ ; /45/ Yes, exit with SUCCESS
bic #8192. ,r1 ; /45/ No more 'NO STALL' modes
mov r3 ,r0 ; /45/ Get the old write size
sub XRB+XRBC,r0 ; /45/ And compute a new buffer addr
add r0 ,r2 ; /45/ buffer = buffer + (size-left)
mov XRB+XRBC,r3 ; /45/ New write size
; /45/ Now try to XON the line
clrfqb ; /45/ Try a UU.FCB to get the unit
movb #UU.FCB ,FIRQB+FQFUN ; /45/ number. While it's acknowledged
movb #lun.ti ,FIRQB+FQFIL ; /45/ that data strutures may change,
.UUO ; /45/ its unlikely that terminal DDB's
movb FIRQB ,r0 ; /45/ will change in the first few
bne 100$ ; /45/ words.
mov #XRB ,r0 ; /45/ Point to the XRB now
mov #5 ,(r0)+ ; /45/ Xoffed, try to clear the line
mov #1 ,(r0)+ ; /45/ One byte, an XON, to force.
mov #$xon ,(r0)+ ; /45/ XRLOC, address of the buffer.
mov #TTYHND*400,(r0)+ ; /45/ Low byte unused, high=driveridx
movb FIRQB+7 ,(r0)+ ; /45/ Unit number to force to
clrb (r0)+ ; /45/ Unused
clr (r0)+ ; /45/ Unused
clr (r0)+ ; /45/ Unused
.SPEC ; /45/ At last !
mov #4 ,XRB+0 ; /45/ Take a short nap and then retry
.SLEEP ; /45/ Wait a moment.
br 10$ ; /45/ Go back, stalled write this time
100$: unsave <r3,r2,r1>
return
; B I N W R I
;
; input: @r5 buffer address
; 2(r5) buffer size
; output: r0 error code
binwri::mov #xrb ,r0 ; address of xrb parameter block
mov 2(r5) ,(r0)+ ; buffer length
mov 2(r5) ,(r0)+ ; byte count for the i/o
mov @r5 ,(r0)+ ; address of the buffer
movb #lun.ti*2,(r0)+ ; channel number
clrb (r0)+ ; unused
clr (r0)+ ; unused
clr (r0)+ ; unused
mov #4096. ,(r0)+ ; modifier (ie, io.wal+nostall)
.WRITE
movb FIRQB ,r0 ; return error code and exit
return
.sbttl do a filename string scan
; L $ F S S
;
; input: @r5 .asciz string of the device or filename
; output: FIRQB the usual
; r0 error code if any
l$fss:: clrfqb
l$fssx::mov @r5 ,r0 ; get the filename address
10$: tstb (r0)+ ; and now get the length
bne 10$ ; no null, keep going
sub @r5 ,r0 ; now get the length
dec r0 ; which is off by one of course
mov r0 ,xrb+xrlen ; length of the string
mov r0 ,xrb+xrbc ; once again
mov #xrb+xrloc,r0 ; finish clearing out
mov @r5 ,(r0)+ ; starting address of string
clr (r0)+ ; unused
clr (r0)+ ; unused
clr (r0)+ ; unused
clr (r0)+ ; unused
.FSS ; now do it please
movb FIRQB ,r0 ; return error
return
.assume <xrb+xrlen+2> eq <xrb+xrbc>
.assume <xrb+xrbc+2> eq <xrb+xrloc>
.sbttl normal i/o to the terminal
l$nolf::
tst vttype ; unless it's a hard copy term
beq l$pcrl ; it is
wrtall #crnolf ; it isn't, just a CR, no line feed..
return
l$pcrl::wrtall #crlf
return
.sbttl other junk
$clrxr::save <r0>
mov #xrb ,r0
10$: clr (r0)+
cmp r0 ,#xrb+14
blos 10$
unsave <r0>
return
$clrfq::save <r0>
mov #FIRQB ,r0
10$: clr (r0)+
cmp r0 ,#FIRQB+36
blos 10$
unsave <r0>
return
.sbttl Reset the keypad ; /BBS/ added
kp.clr::wrtall #kp.res ; dump reset string to terminal
return
.sbttl exit kermit and logout
exit:: .newline
clrxrb ; /55/ ensure xrb is clear first
.TTECH ; /55/
clrxrb ; ensure xrb is clear first
clrfqb ; this must be cleared out
.RTS ; try to go to users KBM
.EXIT ; failed, go to the system's DEFKBM
; Logout moved to KRT80S /54/ 23-Aug-86 12:21:41
.sbttl cantyp cancel typeahead
; C A N T Y P
;
; cantyp( )
;
;
; Cantyp tries to dump all pending input on a given terminal
; line by using the normal .spec call.
hose::
cantyp::save <r1,r2> ; use r0 to point into xrb
mov #xrb ,r1 ; ok
mov #7 ,(r1)+ ; functioncode := cancel_typeahead
clr (r1)+ ; the kb number to use
clr (r1)+ ; not used
mov #lun.ti,r0 ; channel number
asl r0
movb r0,(r1)+ ; channel number
movb #TTYHND,(r1)+ ; driver index for terminals
clr (r1)+ ; not used
clr (r1)+ ; not used
clr (r1)+ ; not used
.spec ; do a driver special function now
clr lsize(r0)
movb FIRQB ,r0 ; return any errors please
100$: unsave <r2,r1> ; all done
return ; bye
clrcns::CLRXRB ; Insure XRB is cleared
mov #7 ,XRB+XRLEN ; Cancel typeahead call
movb #TTYHND ,XRB+XRBLKM ; Driver index
.SPEC ; Should be it
return ; Exit
.sbttl get uic
; G E T U I C
;
; input: nothing
; output: r0 current UIC/PPN of the user
getuic::mov #xrb ,r0 ; clear xrb out first
10$: clrb (r0)+ ; simple
cmp r0 ,#xrb+15
blos 10$
.stat
mov xrb+10 ,r0 ; return uic (ppn) in r0
return
drpprv::mov #jfsys ,xrb+0 ; drop temp privs
.clear ; simple
return
getprv::mov #jfsys ,xrb+0 ; get temp privs back please
.SET
return
.sbttl suspend the job for a while
; S U S P E N
;
; suspend(%val sleep_time)
;
; input: @r5 time to go away for
suspen::mov @r5 ,xrb+0
bne 10$
inc xrb+0
10$: .sleep
return
.sbttl error text
syserp::save <r0>
mov @r5 ,r0
call rmserp
.newline
unsave <r0>
return
syserr::save <r1> ; save a register
clr -(sp) ; allocate variable for error #
mov sp ,r1 ; and point to it
mov @r5 ,@r1 ; if errornumber > 0
bmi 10$ ; then
calls fiperr ,<#2,r1,2(r5)> ; call fiperr(num,text)
br 100$ ; else
10$: calls rmserr ,<#2,r1,2(r5)> ; call rmserr(num,text)
100$: tst (sp)+
unsave <r1>
return
.globl fiperr ,rmserp ,rmserr
.sbttl ttypar set parity stuff for kermit
; T T Y P A R
;
; ttypar( %loc terminal name, %val paritycode )
;
; input: @r5 address of terminal name
; 2(r5) parity code
; output: r0 error code
.if ne ,0 ; we don't need this anymore
.ift
ttypar::call ttpars ; get the terminal unit number
bcs 100$ ; oops
clrfqb ; clear FIRQB out for defaults
inc FIRQB+20 ; assume no parity
cmpb 2(r5) ,#par$no ; really no parity ?
beq 10$ ; yes
inc FIRQB+20 ; try next for even parity
cmpb 2(r5) ,#par$ev ; well ?
beq 10$ ; yes
inc FIRQB+20 ; not NONE or EVEN --> ODD
cmpb 2(r5) ,#par$od ; must be
beq 10$ ; yes
movb #18. ,FIRQB ; no, return illegal sys usage
br 100$
10$: movb r0 ,FIRQB+5 ; stuff the terminal unit number
movb #UU.TRM ,FIRQB+FQFUN ; terminal call today
.UUO ; simple
100$: movb FIRQB ,r0 ; get any errors
return
.endc ; don't need hardware parity control
chkpar::clr r0
return
.sbttl hangup a terminal, set dtr on a terminal
; T T Y H A N
;
; ttyhan( )
;
; output: r0 error code
ttyhan::calls ttpars ,<#ttname> ; the usual, parse the device name
bcs 100$ ; oops
clrfqb ; clear the FIRQB please
movb #UU.HNG ,FIRQB+FQFUN ; terminal call today
movb r0 ,FIRQB+4 ; unit number
movb #1 ,FIRQB+5 ; do it asap
.UUO ; simple
100$: movb FIRQB ,r0 ; return error code and exit
return ; bye
; raise DTR on a terminal line
;
; T T Y D T R
;
; ttydtr( )
;
; output: r0 error code
ttydtr::calls ttpars ,<#ttname> ; the usual, parse the device name
bcs 100$ ; oops
clrfqb ; clear the FIRQB please
movb #UU.HNG ,FIRQB+FQFUN ; terminal call today
movb r0 ,FIRQB+4 ; unit number
movb #377 ,FIRQB+5 ; set dtr function
.UUO ; simple
100$: movb FIRQB ,r0 ; return error code and exit
return ; bye
.sbttl inquire if DTR is up on a device
; INQDTR(ttname)
;
; Find out if DTR is up.
;
; On RSTS/E, DTR is up if (1) Carrier detect is up or (2) Ring is up
; Thus, to connect to a dialout modem, some means must be provided
; for the terminal driver to 'See' CD. This can be done from internal
; modem options, or one can cut CD and loop DTR to CD on the cpu side
; and use the Kermit-11 command SET DTR to get CD up. This routine is
; to return the current DTR status. For RSX, it would be more useful
; to return TRUE if TC.DLU==2 or TRUE if CD is up.
;
; Returns: 1 DTR is present
; 0 DTR is NOT present
; -1 Line is not modem controlled
;
; 18-Dec-85 09:16:08 BDN
.iif ndf, UU.CFG, UU.CFG = 42 ; So this builds on version 8 systems
.enabl lsb
inqdtr::tst ver9.x ; /40/ only works on 9.0 or later
beq 90$ ; /40/ if so, return(-1)
call ttpars ; /40/ get device unit number
tstb FIRQB ; /40/ Was parse successful?
bne 90$ ; /40/ No, return(-1)
clrfqb ; /40/ clear firqb out please
movb #UU.CFG ,FIRQB+FQFUN ; /40/ Find out if line has Modem ctl
mov #"KB ,FIRQB+FQDEV ; /40/ Always a KB: device please
movb r0 ,FIRQB+FQDEVN ; /40/ Unit number please
movb #377 ,FIRQB+FQDEVN+1 ; /40/ Unit number is 'real'
.UUO ; /40/ do it
tstb FIRQB ; /40/ If failure, return(nomodem)
bne 90$ ; /40/ Failed
bitb #4 ,FIRQB+7 ; /40/ If set, the line is modem ctl
beq 90$ ; /40/ No modem control, return(-1)
clrfqb ; /40/ We have modem control, what
movb #UU.TRM ,FIRQB+FQFUN ; /40/ about DTR being around ?
movb r0 ,FIRQB+5 ; /40/ Unit number here this time
.UUO ; /40/ get tt characteristics, part 1
tstb FIRQB ; /40/ Can't fail
bne 90$ ; /40/ But it did ?
bitb #200 ,FIRQB+4 ; /40/ At last, is DTR up ?
bne 80$ ; /40/ No, return(0)
mov #1 ,r0 ; /40/ Yes, return(1)
br 100$ ; /40/ Exit
80$: clr r0 ; /40/ Modem line and no DTR
br 100$ ; /40/ exit
inqcd:: ; /E64/
90$: mov #-1 ,r0 ; /40/ Not modem or pre 9.x system
100$: return
.dsabl lsb
dcdtst:: ; /E64/
clr r0 ; not available
return
inqbuf::mov #maxpak ,r0 ; /42/ Assume pre RSTS v9
tst ver9.x ; /42/ 9.X with huge buffer quotas?
beq 100$ ; /42/ No
mov #MAXLNG ,r0 ; /42/ Yes, return the MAX size
100$: return ; /42/ exit
inqpar::clr r0
return
.sbttl ttspeed get speed for line
; T T S P E E D
;
; output: r0 current speed
;
ttspee::save <r1>
calls ttpars ,<#ttname> ; parse the device name
bcs 90$ ; exit
clrfqb ; insure no changes to tty settings
movb #UU.TRM ,FIRQB+FQFUN ; uuo code to do it
movb r0 ,FIRQB+5 ; unit number
.UUO ; get terminal characteristics
tstb FIRQB ; did it work ?
bne 90$ ; no
movb FIRQB+24,r1 ; interface type
mov splst(r1),r0 ; /40/ is the speed settable?
tst 2(r0) ; /40/ second entry is always <> 0
beq 90$ ; /40/ not settable
movb FIRQB+17,r0 ; get the speed of it
dec r0
asl r0 ; times 2
add splst(r1),r0 ; and the actual speed now
mov @r0 ,r0 ; got it
br 100$ ; exit
90$: clr r0
100$: unsave <r1>
return
.sbttl set the speed of a terminal line
; S E T S P D
;
; setspd(%val speed)
;
; input: @r5 speed
; output: r0 error code, 255 if invalid speed
setspd::save <r1,r2>
calls ttpars ,<#ttname> ; parse the terminal name
bcs 90$ ; oops
clrfqb
movb #UU.TRM ,FIRQB+FQFUN ; uuo code to do it
movb r0 ,FIRQB+5 ; unit number
.UUO ; get terminal characteristics
tstb FIRQB ; did it work ?
bne 90$ ; no
movb FIRQB+24,r1 ; interface type
mov splst(r1),r1 ; point to the speed table for it
clr r2 ; current index
10$: cmp @r1 ,#-1 ; reached the end of the table
beq 80$ ; yes, can't set the speed
inc r2 ; speednum := succ( speednum )
cmp (r5) ,(r1)+ ; speed match ?
bne 10$ ; no
clrfqb ; clear FIRQB out please
movb #UU.TRM ,FIRQB+FQFUN ; uuo function for terminals
movb r0 ,FIRQB+5 ; unit number
movb r2 ,FIRQB+17 ; rec speed
movb r2 ,FIRQB+21 ; xmit speed
.UUO ; do it
tstb FIRQB ; error ?
bne 90$ ; yes
clr r0 ; no
br 100$ ; exit
80$: mov #377 ,r0 ; unknown speed or not settable
br 100$ ; exit
90$: movb FIRQB ,r0 ; uuo error, return it please
100$: unsave <r2,r1> ; bye
return
.sbttl INITER save and set the terminal characteristics
; ttysav( %loc ttname)
; ttyrst()
;
; output: r0 error code
ttysav::
ttyrst::
ttyset::clr r0
return
; INITER
;
; Passed: 0(r5) Address of terminal name
; Return: r0 error code
;
; INITER is called ONLY internally from TTYINI()
initer: save <r1,r2,r3>
calls ttpars ,<#ttname> ; set terminal up for KERMIT
bcs 90$ ; oops, bad device name
mov #lun.ti ,r1 ; /40/ get the channel number please
tst ver9.x ; /40/ version 9.x or later?
beq 4$ ; /40/ no
clrb bufqsav(r1) ; /40/ assume nothing saved for quota
clrfqb ; /40/ insure no unpleasant effects
movb #UU.TRM ,FIRQB+FQFUN ; /40/ uuo code for terminals
incb FIRQB+4 ; /40/ UU.TRM part two
movb r0 ,FIRQB+5 ; /40/ unit number or 377
.UUO ; /40/ get the current settings
tstb FIRQB ; /40/ did the set list work ?
bne 4$ ; /40/ should have
movb FIRQB+27,bufqsav(r1) ; /40/ save old buffer quotas
clrfqb ; /40/ insure no unpleasant effects
movb #UU.TRM ,FIRQB+FQFUN ; /40/ uuo code for terminals
incb FIRQB+4 ; /40/ subfunction one
movb r0 ,FIRQB+5 ; /40/ unit number or 377
..BUFQ == . + 2 ; /46/ Patchable
movb #40. ,FIRQB+27 ; /40/ raise buffer quotas now
.UUO ; /40/ ignore errors
4$: clrfqb ; insure no unpleasant effects
movb #UU.TRM ,FIRQB+FQFUN ; uuo code for terminals
movb r0 ,FIRQB+5 ; unit number or 377
.UUO ; get the current settings
tstb FIRQB ; did the set list work ?
bne 90$ ; no, die
mov #lun.ti ,r1 ; get the channel number please
mul #40 ,r1 ; get address of ttsave area for it
add #ttsave ,r1 ; at last
mov #FIRQB ,r2 ; get address of current settings
mov #40 ,r3 ; number of bytes to copy now
5$: movb (r2)+ ,(r1)+ ; copy a byte
sob r3 ,5$ ; next please
clr r1 ; get the parity/8bit setting
bisb FIRQB+20,r1 ; and check for parity being set
bic #^C3 ,r1 ; leave only parity bits here
cmpb r1 ,#1 ; parity set ?
bhi 7$ ; /36/ yes, can't set 8bit mode then
tstb parity ; /36/ If software parity enabled
beq 6$ ; /36/ then we must prevent TTDVR
cmpb parity ,#PAR$NO ; /36/ from changing characters in
bne 7$ ; /36/ range 201-237 into esc seqs.
6$: movb #30 ,r1 ; no parity so please set 8bit mode
br 10$ ; /36/
7$: bisb #20 ,r1 ; /36/ explicitly turn 8bit mode off
10$: clrfqb ; now actually set it
movb #UU.TRM ,FIRQB+FQFUN ; uuo code for terminals
movb r0 ,FIRQB+5 ; unit number or 377
movb #377 ,FIRQB+12 ; SET XON
movb #377 ,FIRQB+35 ; SET GAG
movb r1 ,FIRQB+20 ; SET 8BIT
movb #200 ,FIRQB+11 ; SET LC OUTPUT
movb #377 ,FIRQB+15 ; SET LC INPUT
movb #200 ,FIRQB+30 ; insure no delimiters are set now
cmpb handch ,#'Q&37 ; This is a pain. We have to use
beq 15$ ; multiple delims cause bin mode
cmpb handch ,#'S&37 ; perhaps XON also ?
bne 20$ ; no
15$: movb #200 ,FIRQB+22 ; timeouts don't work and xon's
; don't get thru unless stall is off
20$:
.UUO ; go get RSTS's attention
90$: movb FIRQB ,r0 ; return possible errors
unsave <r3,r2,r1>
return
.globl handch ,parity ,ttname
.sbttl ttpars get unit number from ttname
; T T P A R S
;
; ttpars( %loc ttname )
;
; output: r0 unit number or 377 for null string
ttpars::save <r1>
call myterm ; get attached console name
movb r0 ,r1 ; get the name
clrfqb ; no defaults
clrxrb
mov #377 ,-(sp) ; assume KB:
mov @r5 ,r0 ; address of terminal name
10$: tstb (r0)+ ; get the length of the name
bne 10$ ; until we find a NULL
sub @r5 ,r0 ; get the length
dec r0 ; if zero, then use 377 for unit
beq 20$ ; use zero
mov r0 ,xrb+xrlen ; length of string for .FSS
mov r0 ,xrb+xrbc ; again
mov @r5 ,xrb+xrloc ; address of the string to parse
.FSS ; and do it
tstb FIRQB ; did it work ?
bne 90$ ; no
bit #20000!40000,xrb+10 ; a device name was parsed ?
beq 80$ ; no
movb xrb+14, r0 ; get the driver index please
scan r0 ,#hndlst ; a reasonable device name?
tst r0 ; well ?
beq 80$ ; no
cmpb FIRQB+FQDEVN,r1 ; same device as controlling terminal?
beq 20$ ; yes
movb FIRQB+FQDEVN,@sp ; yes, save unit number
bne 20$
movb #377 ,@sp ; no unit, return 377 for self
20$: clc ; flag success
br 100$ ; and exit
80$: movb #6 ,FIRQB ; invlaid device name error
90$: sec ; flag failure
100$: mov (sp)+ ,r0
unsave <r1>
return
.globl scanch
myterm: clrfqb
movb #UU.SYS ,FIRQB+FQFUN ; for a systat part one
.UUO ; simple
movb FIRQB+5 ,r0 ; get the name
return
.sbttl assign device
.enabl lsb
; Assign the device for SET LINE. Device characteristics are
; set in TTYINI and reset in TTYFIN. For edit /41/, check to
; be sure that the JOB privilege mask includes HWCFG, which
; is needed to alter settings on other terminal lines (9.x).
.iif ndf , PRVIOL, PRVIOL = 12
assdev::mov r1 ,-(sp) ; /41/
call ttpars ; parse the terminal name
bcs 100$ ; oops
cmpb r0 ,#377 ; Return KB: ?
bne 10$ ; no
clr r0 ; Yes, simply return
br 110$ ; exit
10$: mov r0 ,r1 ; /41/ save unit number
tst ver9.x ; /45/ What if this is version 8?
beq 20$ ; /45/ If so, don't try this out.
mov #HWCFG ,-(sp) ; /41/ See if we have JOB privs
call jobprv ; /41/ Well?
tst r0 ; /41/ 1 == success
beq 90$ ; /41/ No
20$: clrfqb ; A Real LINE today
movb #UU.ASS ,FIRQB+FQFUN ; Assign the device please
mov #FIRQB+FQDEV,r0 ; Where to place the device name
movb #'K ,(r0)+ ; name
movb #'B ,(r0)+ ; ..name continued (Always KBnn:)
movb r1 ,(r0)+ ; unit
movb #377 ,@r0 ; Unit is 'real'
.UUO ; get RSTS/E to do the assignment
br 100$ ; exit with error in FIRQB+0
90$: wrtall #e80.01 ; /E64/
mov #PRVIOL ,FIRQB ; /41/
100$: movb FIRQB ,r0 ; Return the error code please
110$: mov (sp)+ ,r1 ; /41/ Restore register please
return ; exit
.dsabl lsb
.sbttl ascdat get the ascii string for the date
; A S C D A T
;
; input: @r5 buffer address
; 2(r5) date in system internal format
ascdat::save <r0,r1>
clrfqb ; clear the FIRQB out first
mov 2(r5) ,FIRQB+4 ; where to pass the date
movb #UU.CNV ,FIRQB+FQFUN ; simple
;/*60*/ inc FIRQB+6 ; KERMIT uses ISO date formats
.UUO ; get RSTS to convert the date
clrb FIRQB+22 ; insure .asciz
mov #FIRQB+10,r0 ; where RSTS put the date
mov @r5 ,r1 ; where we want to put it
10$: movb (r0)+ ,(r1)+ ; simple
bne 10$ ; copy until a null byte is found
unsave <r1,r0> ; pop temps and exit
return
; A S C T I M
;
; input: @r5 buffer address
; 2(r5) time in system internal format
asctim::save <r0,r1>
clrfqb ; clear the FIRQB out first
mov 2(r5) ,FIRQB+22 ; where to pass the time
movb #UU.CNV ,FIRQB+FQFUN ; simple
;/*60*/ inc FIRQB+24 ; KERMIT uses ISO time formats
.UUO ; get RSTS to convert the time
clrb FIRQB+36 ; insure .asciz
mov #FIRQB+26,r0 ; where RSTS put the time
mov @r5 ,r1 ; where we want to put it
10$: movb (r0)+ ,(r1)+ ; simple
bne 10$ ; copy until a null byte is found
unsave <r1,r0> ; pop temps and exit
return
.sbttl cantim Convert date and time to canonical form
; C A N T I M
;
; input: @r5 buffer address
; 2(r5) date in system internal format
; 4(r5) time in system internal format
; /E64/ new
cantim::save <r0,r1,r2>
clrfqb ; clear the FIRQB out first
mov 2(r5) ,FIRQB+4 ; where to pass the date
mov 4(r5) ,FIRQB+22 ; where to pass the time
movb #UU.CNV ,FIRQB+FQFUN ; simple
inc FIRQB+6 ; KERMIT uses ISO date formats
inc FIRQB+24 ; KERMIT uses ISO time formats
.UUO ; get RSTS to convert the date
mov #FIRQB+10,r0 ; where RSTS put the date
mov @r5 ,r1 ; where we want to put it
cmp #30000. ,2(r5) ; after year 2000?
blos 10$ ; yes
movb #'1 ,(r1)+ ; no, 19xx
movb #'9 ,(r1)+
br 20$
10$: movb #'2 ,(r1)+ ; year 20xx
movb #'0 ,(r1)+
20$: movb (r0)+ ,(r1)+ ; YY
movb (r0)+ ,(r1)+ ;
inc r0 ; skip .
movb (r0)+ ,(r1)+ ; MM
movb (r0)+ ,(r1)+ ;
inc r0 ; skip .
movb (r0)+ ,(r1)+ ; DD
movb (r0)+ ,(r1)+ ;
movb #40 ,(r1)+ ; a space delimiter
; the time's in the right format!
clrb FIRQB+36 ; insure .asciz
mov #FIRQB+26,r0 ; where RSTS put the time
mov #5 ,r2 ; 5 bytes of time
30$: movb (r0)+ ,(r1)+ ; simple
sob r2 ,30$ ; copy the time
movb #': ,(r1)+ ; seconds always 0
movb #'0 ,(r1)+ ;
movb #'0 ,(r1)+ ;
clrb (r1) ; and delimit as .asciz
unsave <r2,r1,r0> ; pop temps and exit
return
.sbttl dodir get a reasonable directory printed
; D O D I R
;
; input: @r5 wildcarded filespec
; output: r0 error code
;
; DODIR prints a directory listing at the local terminal.
;
;
; S D O D I R
;
; Passed: @r5 wildcarded name
; Return: r0 error code, zero for no errors
; r1 next character in the directory listing
;
; SDODIR is called by the server to respond to a remote directory
; command. Instead of the pre 2.38 method of dumping output to a
; disk file and then sending the disk file in an extended replay,
; SDODIR returns the next character so that BUFFIL can use it.
; The routine GETCR0 is actually a dispatch routine to call the
; currently selected GET_NEXT_CHARACTER routine.
dodir:: save <r1,r2,r3,r4>
strcpy #dirnam ,@r5
call dirini ; init things
bcs 100$ ; error in the .FSS parse
10$: call dirnex ; get the next file
bcs 100$ ; all done
wrtall #dirbuf
br 10$
100$: unsave <r4,r3,r2,r1>
clr diridx
return
.globl strcpy
sdirin::strcpy #dirnam ,@r5 ; copy name over
clr diridx ; ditto
call dirini ; init for calls to sdodir
bcs 100$
mov #dirbuf ,dirptr ; yes, init pointers please
clrb @dirptr ; yes, zap the buffer
call dirnex ; preload buffer
100$: return
sdodir::save <r2,r3,r4>
10$: movb @dirptr ,r1 ; get the next character please
bne 20$ ; something was there
mov #dirbuf ,dirptr ; reset the pointer
clrb @dirptr ; yes, zap the buffer
call dirnex ; empty buffer, load with next file
bcs 90$ ; no more, return ER$EOF
br 10$ ; and try again
20$: inc dirptr ; pointer++
clr r0 ; no errors
br 100$ ; exit
90$: mov #ER$EOF ,r0 ; failure, return(EOF)
95$: clr r1 ; return no data also
clr diridx ; init for next time through
100$: unsave <r4,r3,r2>
return
.globl er$eof
.sbttl init for the directory
dirini: clr diridx ; /38/
mov #dirnam ,r2 ; string address
tstb @r2 ; a null string ?
bne 10$ ; no
5$: mov #wild ,r2 ; yes, supply *.*
10$: calls l$fss ,<#defdir> ; stuff FIRQB with defaults
calls l$fssx ,<r2> ; parse the string with defaults
tst r0 ; did it work ?
bne 90$ ; no
bit #1 ,xrb+10 ; was some kind of filename passed?
bne 20$ ; yes
mov #134745 ,FIRQB+FQNAM1+0 ; no, insert *
mov #134745 ,FIRQB+FQNAM1+2 ; no, insert *
20$: bit #20 ,xrb+10 ; was a non-null extension passed ?
bne 40$ ; yes
bit #10 ,xrb+10 ; no extension, was the extension an
bne 40$ ; explicit null (ie, abcdef.) ?
mov #134745 ,FIRQB+FQNAM1+4 ; no, stuff .* into the filespec
40$: mov #dirfir ,r4 ; save the FIRQB save area pointer
mov #FIRQB ,r3 ; and a pointer to the FIRQB itself
mov #40 ,r0 ; number of bytes to copy
50$: movb (r3)+ ,(r4)+ ; simple
sob r0 ,50$ ; all done saving the FIRQB
clc ; success
br 100$ ; bye
90$: sec ; failure
100$: return ; bye
.globl defdir
.sbttl more routines for dodir
.globl rdtoa
dircvt: save <r0,r1,r2>
mov r3 ,-(sp) ; save the pointer please
mov #FIRQB+FQNAM1,r2 ; first three characters of filename
calls rdtoa ,<r3,(r2)+> ; convert it
add #3 ,r3 ; and fix the pointer up
calls rdtoa ,<r3,(r2)+> ; convert it
add #3 ,r3 ; and fix the pointer up
movb #'. ,(r3)+ ; stuff a dot in please
calls rdtoa ,<r3,(r2)+> ; convert it
add #3 ,r3 ; bump the pointer along please
movb #40 ,(r3)+ ; some spaces
movb #40 ,(r3)+ ; some spaces
mov FIRQB+16,r0 ; the file size
deccvt r0,r3,#6 ; convert it to ascii
add #6 ,r3 ; point past the number now
movb #40 ,(r3)+ ; some spaces
movb #40 ,(r3)+ ; some spaces
movb #'< ,(r3)+ ;/*60*/ give 'em prot. code, too
mov FIRQB+20,r0 ;/*60*/
bic #177400 ,r0 ;/*60*/
deccvt r0,r3,#3 ;/*60*/
add #3 ,r3 ;/*60*/
movb #'> ,(r3)+ ;/*60*/
movb #40 ,(r3)+ ;/*60*/
movb #40 ,(r3)+ ;/*60*/
mov FIRQB+26,r2 ; save the time of creation
calls ascdat ,<r3,FIRQB+24> ; convert the date
mov (sp) ,r3
strlen r3 ; get the current length
add r0 ,r3 ; and point to the new end of it
movb #40 ,(r3)+ ;/*60*/
movb #40 ,(r3)+ ;/*60*/
calls asctim ,<r3,r2> ; and get the time
strcat r3 ,#dcrlf ; append crlf
mov (sp)+ ,r3 ; point back to the string
unsave <r2,r1,r0>
return
.globl l$cvtnum, strcat
dirnex: mov #dirfir ,r4 ;
mov #FIRQB ,r3 ; and a pointer to the FIRQB itself
mov #40 ,r0 ; number of bytes to copy
20$: movb (r4)+ ,(r3)+ ; simple
sob r0 ,20$ ; all done loading the FIRQB
mov diridx ,FIRQB+4 ; store the index for the file
movb #lokfq ,FIRQB+3 ; directory lookup please
CALFIP ; get fip to do it please
movb FIRQB ,r0 ; did it work ?
bne 90$ ; no
mov #dirbuf ,r3 ; point to the string buffer
call dircvt ; yes, convert it please
inc diridx ; setup for the next time
clc ; success
return ; failure
90$: tst diridx ; error, did we already find a file?
beq 100$ ; no, retain error code
clr r0 ; yes, return zero and C set
100$: clr diridx ; clear for next time around
sec
return
.sbttl force a xon to the connect line
; T T X O N
;
; output: r0 error code
ttxon:: save <r1> ; save a temp register
calls ttpars ,<#ttname> ; parse the terminal device name
bcs 90$ ; oops
10$: clrxrb ; insure no defaults
mov #xrb ,r1 ; point to the xrb now
mov #5 ,(r1)+ ; force to kb: function for .SPEC
inc (r1)+ ; one byte to force please
mov #$xon ,(r1)+ ; address of the buffer for output
mov #ttyhnd*400,(r1)+ ; channel zero, device driver index
mov r0 ,(r1)+ ; terminal number
.spec ; simple
90$: movb FIRQB ,r0 ; error, return it please
100$: unsave <r1> ; pop the register we saved
return
.sbttl printer spooling for RSTS
.iif ndf, UU.SPL, UU.SPL = -28.
; Q S P O O L
;
; calls QSPOOL ,<address(filename)>
;
; returns: r0 := rsts error code (if any)
qspool::save <r1>
call l$fss ; do the .FSS now
tst r0 ; fail ?
bne 100$ ; yes, exit
mov #FIRQB+16,r1 ; stuff the rest of the params
mov #"LP ,(r1)+ ; LP of course
movb sp.dev ,(r1)+ ; assume LP0 for a moment
movb #377 ,(r1)+ ; unit is real for sure
clr (r1)+ ; must be zero
mov sp.mod ,(r1)+ ; /nodelete/header
movb #UU.SPL ,FIRQB+FQFUN ; uuo function code to do
.UUO ; simple to do
movb FIRQB ,r0 ; return any error codes
100$: unsave <r1> ; pop temps and exit
return
.sbttl inqterm get terminal type (v9.x only)
; Assume: Login.com did a $ SET TER/INQ
inqter: call inqv9 ; /39/ RSTS/E 9.x ?
bcs 90$ ; /39/ no
clrfqb ; /39/ clear out again
movb #UU.TRM ,FIRQB+FQFUN ; /39/ terminal char function
mov #1+<400*377>,FIRQB+4 ; /39/ subfunction 1, KB:
.UUO ; /39/ read chars
tstb FIRQB ; /39/ success?
bne 90$ ; /39/ no
mov #trmtyp ,r0 ; /39/ yes, look for VT type term
10$: tstb @r0 ; /39/ end of list yet?
beq 90$ ; /39/ yes, return( TTY )
cmpb (r0)+ ,FIRQB+6 ; /39/ no, check for a match
bne 10$ ; /39/ not yet
mov #VT100 ,r0 ; /39/ yes, return(VT100)
br 100$ ; /39/ exit
90$: mov #TTY ,r0 ; /39/ nothing
100$: return ; /39/ exit
.sbttl login
.iif ndf , UU.CHK, UU.CHK = 40
.iif ndf , UU.PRV, UU.PRV = 34
.iif ndf , NOSUCH, NOSUCH = 5
.iif ndf , NOTAVL, NOTAVL = 10
.iif ndf , PRVIOL, PRVIOL = 12
.iif ndf , QUOTA , QUOTA = 105
; LOGIN 24-Sep-85 10:01:33 Brian Nelson (V9.x and later only)
; Added on Edit 2.36
; Moved to KRT80S 11-Apr-86 12:27:18
.sbttl Check for given privilege (V9.x and later)
; SETPRV is intended to reset the CURRENT privilege mask to the
; user's AUTHORIZED mask. They could be different as a result of
; the REMOTE LOGIN command, moving from a high access account to
; once with lesser access.
setprv::sub #12 ,sp ; a buffer
mov #JFSYS ,XRB+0 ; drop all privs that are not mine
.CLEAR ; in case we inherited privilege
clrfqb ; now read the authorized priv mask
movb #UU.PRV ,FIRQB+FQFUN ; UUO function code
.UUO ; simple
mov #FIRQB+FQFIL,r0 ; and save them
mov sp ,r2 ; copy them onto stack save area
mov (r0)+ ,(r2)+ ; copy
mov (r0)+ ,(r2)+ ; ..copy
mov (r0)+ ,(r2)+ ; ....copy
mov (r0)+ ,(r2)+ ; ......copy
mov #JFSYS ,XRB+0 ; now get all we had back again
.SET ; simple
clrfqb ;
movb #UU.PRV ,FIRQB+FQFUN ; read current privilege
.UUO ; call RSTS to do so
mov #FIRQB+FQFIL,r0 ; now setup to copy current over
mov #FIRQB+FQNAM2,r1 ; the current mask to the 'clear'
mov #4 ,r2 ; mask
10$: mov @r0 ,(r1)+ ; copy the privilege mask
clr (r0)+ ; and clear this one out
sob r2 ,10$ ; next please
movb #UU.PRV ,FIRQB+FQFUN ; now drop ALL privileges we had
.UUO ; simple
clrfqb ; At last, make current privs the
mov sp ,r2 ; ones that the user is authorized
mov #FIRQB+FQFIL,r1 ; to have
mov (r2)+ ,(r1)+ ; insert these privileges
mov (r2)+ ,(r1)+ ; ..insert these privileges
mov (r2)+ ,(r1)+ ; ....insert these privileges
mov (r2)+ ,(r1)+ ; ......insert these privileges
movb #UU.PRV ,FIRQB+FQFUN ; at last, set the correct mask
.UUO ; simple
add #12 ,sp ; exit
mov #1 ,r0 ;
return
chkprv::mov 2(sp) ,r1 ; get address of priv to look for
clrfqb ; clear the FIRQB out
mov #FIRQB+FQFUN,r0 ; setup to get the bit value of WACNT
movb #UU.CHK ,(r0)+ ; UUO subfunction
inc (r0)+ ; UU.CHK subfunction
tst (r0)+ ; not used
10$: movb (r1)+ ,(r0)+ ; copy the desired priv to check
bne 10$ ; next please
.UUO ; try it out
movb FIRQB ,r0 ; if this fails its not verison 9.x
bne 90$ ; or later
movb FIRQB+4 ,r0 ; success, check if priv is present
bne 90$ ; no
mov #1 ,r0 ; yes, return(1)
br 100$ ; exit
90$: clr r0 ; no, return(0)
100$: mov (sp)+ ,(sp) ; pop stack and exit
return ; bye
inqv9:: clrfqb ; /39/ clear FIRQB out
clr ver9.x ; /40/ assume old RSTS/E
movb #UU.PRV ,FIRQB+FQFUN ; /39/ see if version 9 or later
.UUO ; /39/ always works (read priv mask)
tstb FIRQB ; /39/ success?
bne 90$ ; /39/ no
mov sp ,ver9.x ; /40/ flag for v9.x and later
clc ; /39/ v.9x
return ; /39/ exit
90$: sec ; /39/ not 9.x
return ; /39/ return
.sbttl check for current JOB priv , not PROGRAM priv.
; Added edit 2.41 to check if a user has HWCFG authorized to
; effect a SET LINE command. Note that this will not affect
; the current mask, it just checks to see if the JOB has this
; priv. This is different than UU.CHK in that here we look at
; current 'JOB' mask where the other (CHKPRV) looks at the
; CURRENT program priv mask. To find AUTHORIZED priv, you must
; call AUTHPR.
; Added cause the M+ v3 Kermit will get and drop privs for
; SET LINE.
;
; Passed: 2(sp) Address of priv name to check
; Return: r0 1 for success (or pre 9.x), zero for no priv
;
; Example:
;
; mov #HWCFG ,-(sp)
; call JOBPRV
; tst r0
; beq error
;
;
; hwcfg:.asciz /HWCFG/
; .even
jobprv::mov r1 ,-(sp) ; /41/ Save a register
mov r2 ,-(sp) ; /41/ ... save another one
sub #10 ,sp ; /41/ temp save area
mov #1 ,r2 ; /41/ Assume success
tst ver9.x ; /41/ version nine or later?
beq 100$ ; /41/ no, return( success )
clrfqb ; /41/
mov #FIRQB+3,r1 ; /41/ point to FQFUN offset
movb #UU.PRV ,(r1)+ ; /41/ read current priv mask.
.UUO ; /41/ Do it
tstb FIRQB ; /41/ Check status (has to work)
bne 90$ ; /41/ Return( failure )
mov sp ,r0 ; /41/ a pointer to mask save area
mov (r1)+ ,(r0)+ ; /41/ save current priv mask
mov (r1)+ ,(r0)+ ; /41/ .save current priv mask
mov (r1)+ ,(r0)+ ; /41/ ..save current priv mask
mov (r1)+ ,(r0)+ ; /41/ ...save current priv mask
mov #JFSYS ,XRB+0 ; /41/ what to do
.CLEAR ; /41/ Drop ALL privs now
clrfqb ; /41/ clear firqb out
mov #FIRQB+FQFUN,r0 ; /41
movb #UU.CHK ,(r0)+ ; /41/ Convert priv name to bitmask
inc (r0)+ ; /41/ Subfunbction code = 1
tst (r0)+ ; /41/ skip this field
mov 2+14(sp),r1 ; /41/ copy the priv over
10$: movb (r1)+ ,(r0)+ ; /41/ copy the asciz name over
bne 10$ ; /41/ simple
.UUO ; /41/ convert NAME to MASK
mov sp ,r1 ; /41/ point back to save area
mov #FIRQB+FQNAM1,r0 ; /41/ Where the bit pattern is
mov #4 ,r2 ; /41/ Four words to check
20$: bit (r0)+ ,(r1)+ ; /41/ Any bit(s) set here ?
bne 30$ ; /41/ Yes, we have it
sob r2 ,20$ ; /41/ No, keep looking
clr r2 ; /41/ Flag not found
br 40$ ; /41/ Restore old priv mask
30$: mov #1 ,r2 ; /41/ Flag we have it
40$: clrfqb ; /41/ Now restore JOB privs
mov #FIRQB+FQFUN,r0 ; /41/ point to FQFUN offset
movb #UU.PRV ,(r0)+ ; /41/ read current priv mask.
mov sp ,r1 ; /41/ Saved OLD priv mask
mov (r1)+ ,(r0)+ ; /41/ save current priv mask
mov (r1)+ ,(r0)+ ; /41/ .save current priv mask
mov (r1)+ ,(r0)+ ; /41/ ..save current priv mask
mov (r1)+ ,(r0)+ ; /41/ ...save current priv mask
.UUO ; /41/ Do it
br 100$ ; /41/ exit
90$: clr r2 ; /41/ failure
100$: mov r2 ,r0 ; /41/ Return the status now
add #10 ,sp ; /41/ Pop buffer
mov (sp)+ ,r2 ; /41/ ...Pop a register
mov (sp)+ ,r1 ; /41/ Pop a register
mov (sp)+ ,(sp) ; /41/ pop parameter
return ; /41/ At last
.sbttl setcc setup a control C trap
; SETCC arm the control C trap
; TTAST field the ast
;
; It would be REALLY nice if we had the equivalent of an IO.KIL
; so we could cancel a pending terminal read as I do in the RSX
; based Kermits. While it is true that control C will terminate
; a read on your console terminal, we need to be able to cancel
; a read that's waiting on another terminal, as is the case if
; Kermit is running LOCAL (set lin ttnn:). Hopefully, some day
; DIGITAL will provide that.
setcc:: mov #ttast ,@#24
.ttrst
.ttech
return
ttast: save <r0,r1>
call cctrap
mov #lunsize*2,r1
10$: tst linit(r1)
beq 20$
mov r1 ,-(sp)
asr (sp)
call snoecho
20$: sub #2 ,r1
bge 10$
unsave <r1,r0>
rti
.globl cctrap
; dummy epts and symbols for rsx11m/m+ compatibility
tidias::
tidiar::return
tmsdia::
setsla::clr r0
return
wtmask == 0 ; dummy definitions for event flags
ef.co == 0 ; used under RSX
ef.ti == 0
bit.co == 0
bit.ti == 0
sf.gmc == 2560
sf.smc == 2440
tc.fdx == 64
tf.ral == 10
tc.tbf == 71
tc.slv == 0
tc.abd == 0
tc.dlu == 0
tc.xsp == 0
tc.rsp == 0
tf.rne == 20
tf.wal == 10
xdorsx::call doconn
return
.globl doconn
rstsrv::clr r0
return
paksta:: ; packet timing stats
; dummy for now
return
ttrctl::
.ttrst ; cancel ctrl/o
return
.end