home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
kermit11.tar.gz
/
kermit11.tar
/
k11rt4.mac
< prev
next >
Wrap
Text File
|
1989-06-13
|
28KB
|
1,117 lines
.title k11rt4 i/o for rt11 version 4 or 5 for Kermit-11
.ident /1.0.01/
; 08-Mar-84 09:18:25 Brian Nelson
;
; 6-May-85 Added a little more to the TSX message to
; indicate that the TSX version comes up in
; the remote mode. If a set line 0 is performed
; you are changed to a local kermit and send
; receive do not work. Going to server mode
; works fine. Purpose of the message is to alert
; user that the default is remote mode and no
; setting of the line is required.
;
; 20-May-86 09:03:30 Mods for .SETTOP in XM, also .SERR mods
;
; Copyright (C) 1984 1986 Change Software, Inc.
;
; This is the RT11 version of K11RMS.MAC. It simply tries
; to emulate, as much as is reasonable, what the RMS i/o
; routines do for RSX and RSTS. This strains a few things
; in as much that RT11 does not provide much of anything
; in the sense of file services as compared to that which
; RMS11 v2 provides. Since the whole of Kermit-11 is built
; around RMS11 for i/o we will even take the step to map
; RT11 error codes into RMS11 error codes, thus allowing
; the use of the RMS error routines and removing any need
; to modify Kermit-11 elsewhere.
; We won't really use the RMS error routines since they are
; much to comprehensive for the errors that RT can have.
;
; This routine MUST be in the root segment.
; The RT11 executive must have multiple terminal support.
;
;
; Disk i/o epts
;
; open ( %loc filename, %val channel_number ,%val type )
; create( %loc filename, %val channel_number ,%val type )
; getrec( %loc buffer , %val channel_number ) { returns RSZ in R1}
; putrec( %loc buffer , %val record_size ,%val channel_number )
; close ( %val channel_number )
; putc ( %val char , %val channel_number )
; getc ( %val channel_number )
.sbttl non disk i/o 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 K11MAC.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 lun, %val timeout )
; BINWRI ( %loc buffer, %val byte_count, %val lun )
; CANTYP ( %loc device_name, %val lun )
; CHKABO ( )
; 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, %val lun )
; QUOCHK ( )
; READ ( %loc buffer, %val buffer_length, %val lun, %val block_number )
; SETCC ( %loc control_c_ast_handler )
; SETSPD ( %loc device_name, %val speed )
; SUSPEN ( %val seconds, %val ticks )
; SYSERR ( %val error_number, %loc error_text_buffer )
; TTRFIN ( )
; TTRINI ( )
; TTSPEE ( %loc terminal_name )
; TTYDTR ( %loc terminal_name )
; TTYFIN ( %loc terminal_name, %val lun )
; TTYHAN ( %loc terminal_name )
; TTYINI ( %loc terminal_name, %val lun, %val open_flags )
; TTYPAR ( %loc terminal_name, %val parity_code )
; TTYRST ( %loc terminal_name )
; TTYSAV ( %loc terminal_name )
; TTYSET ( %loc terminal_name )
; WRITE ( %loc buffer, %val buffer_length, %val lun, %val block_number )
; XINIT ( )
.sbttl define macros and local i/o database
.if ndf, K11INC
.ift
.include /IN:K11MAC.MAC/
.endc
.iif ndf,k11inc ,.error ; missing INCLUDE for K11MAC.MAC
cr = 15
lf = 12
ff = 14
soh = 1
maxsiz = 1000
errbyt == 52
topmem = 50
JSW = 44
.enabl gbl
.psect $code ,ro,i,lcl,rel,con
.psect rtdir1 ,rw,d,gbl,rel,con
.psect rtioda ,rw,d,lcl,rel,con
; Note that for RT11, of course, all files are considered
; to be image files. If there was a RMS11/RT we would have
; had transportability from RSX and RSTS version of disk
; i/o.
buflst::.word ttbuf ,0 ,0 ,0 ,0
bufdef::.word ttbuf ,0 ,0 ,0 ,0
bufsiz::.word ttbsiz ,maxsiz ,maxsiz ,maxsiz ,maxsiz
filtyp: .word terminal,text ,text ,text ,text
bufp: .word 0 ,0 ,0 ,0 ,0
bufs: .word 0 ,0 ,0 ,0 ,0
mode: .word 1 ,0 ,0 ,0 ,0
blknum: .word 0 ,0 ,0 ,0 ,0
sizof: .word 0 ,0 ,0 ,0 ,0
filsiz == 100
defdir::.blkb filsiz+2 ; default directory for send and rec
srcnam::.blkb filsiz+2 ; original send filespec
filnam::.blkb filsiz+2 ; output from directory lookup routine
asname::.blkb filsiz+2 ; for SEND file [as] file
bintyp::.word 0
totp.s::.word 0,0
totp.r::.word 0,0
dkdev: .rad50 /DK /
$hbufs == 1
ie.its == 0
fb$stm == 0
fb$var == 0
fb$cr == 0
xdorsx == 0
df$rfm::.word 0
df$rat::.word 0
; /51/ The following buffers are allocated after the initial .SETTOP
; They can swap with the USR if need be.
ALSIZE == 600
SDBSIZ == 600
$$LBUF == < <MAXLNG/10>+MAXLNG > & 177776
$$BUFP == <<MAXSIZ+2>*4> + $$LBUF + ALSIZE
ttbsiz = 40
ttbuf: .blkb ttbsiz+2
$prtbu::.word ttbuf ; /51/ Altered at startup
tsxsav::.word 0
devidx::.word 0 ; /45/ From .dstat, device type
wtime: .word 0,60.
cancel:
mtsts: .word 0,0,0,0,0
timbuf: .word 0,0
timbf1: .word 0,0
clkflg::.word 0
tenth: .word 0,6
wasxc:: .word 0
jobsts::.blkw 10 ; /51/ From .GTJB
freept::.word 0 ; /51/ For the next general allocation
fetpt:: .word 0 ; /51/ For the next .FETCH
fetptm::.word 0 ; /51/ Max address for fetching
xmfetp::.word 0 ; /51/ Base of area for fetching, XM
maxtop::.word 0 ; /51/ Size after .settop
xklgbu::.word 0 ; /51/ Pointer to special XL buffer
montyp::.word 0 ; /51/ < 0 -> SJ, = 0 -> FB, > 0 -> XM
hilimi::.word 50 ; /51/ It's 50 for FB, $limit+2 for XM
$ttyou::.word 0 ; /51/ Filled in at startup
$$cbta::.word 0 ; /53/
$limit::.limit ; /51/ Enable XM .SETTOP .limit
lun1 = 1
lun2 = 2
lun3 = 3
lun4 = 4
maxlun = lun4
.sbttl error mapping, error codes defined in overlay K11RTE
.psect $pdata
cloerr::.word er$sy1 ,er$sy1 ,er$sys ,er$prv
csierr::.word er$fnm ,er$dev ,er$sy2
dsterr::.word er$dev
enterr::.word er$lby ,er$ful ,er$sy3 ,er$prv ,er$sy3
feterr::.word er$dev ,er$sy4
lokerr::.word er$lby ,er$fnf ,er$sys
reaerr::.word er$eof ,er$rer ,er$nop ,er$sys
wrierr::.word er$eof ,er$wer ,er$nop ,er$sys
twaerr::.word er$que
mrkerr::.word er$que
renerr::.word er$lby ,er$fnf ,er$iop ,er$prv
xcierr::.word er$lby ,er$xco
xcspfu::.word er$fun ,er$hrd ,er$nop ,er$sys
.word er$sup
faterr::.word fa$imp ,fa$nhd ,fa$dio ,fa$fet ,fa$ovr ,fa$dfl ,fa$adr
.word fa$lun ,fa$imp ,fa$imp ,fa$imp ,fa$idr ,fa$imp ,fa$imp
.word fa$imp ,fa$imp ,fa$imp ,fa$imp
mterr:: .word er$nin ,er$nat ,er$lun ,er$iop ,er$bsy ,er$buf ,er$sys
.word er$sup
.psect $rtque
nrtque == 20
rtque:: .blkw 10.*nrtque
.psect $code
.sbttl one shot init code for Kermit-11 RT11
CONFIG = 300
CONFG2 = 370
SYSGEN = 372
$USRLC = 266
SYSVER = 276
PRO350 = 20000
TSXPLU = 100000
SJSYS = 1
XMSYS = 10000
.MCALL .QSET,.TWAIT,.FETCH,.GVAL,.SETTOP,.SERR,.HERR,.GTIM
.MCALL .DSTAT,.MTSTAT,.EXIT
; 23-May-86 18:21:33 XINIT moved to K11RTI.MAC
GLOBAL <lun.in,lun.ou,proflg,rtvol,rtque,tsxflg>
GLOBAL <defdir,infomsg>
.sbttl open a file for rt11
.MCALL .CSISPC,.DSTATUS,.LOOKUP,.FETCH,.ENTER,.CLOSE
.MCALL .SERR ,.HERR ,.PURGE
.psect $code
; OPEN( &filename,channel,type )
;
; CREATE( &filename,channel,type )
.psect $pdata
defext: .word 0
.word 0
.word 0
.word 0
en$siz::.word 0 ; 1/2 largest free or 2nd largest
.psect $code
.enabl lsb
fcreat:: ; Create a file
append:: ; Alternate EP's
create::mov #1 ,r0 ; Say we want to create
br 10$ ; And off to common code
fopen:: ; Open a file for reading
open:: clr r0 ; .LOOKUP please
10$: Save <r1,r2,r3> ; Save these
mov r0 ,r2 ; .ENTER/.LOOKUP ?
mov (r5) ,r1 ; Filespec address, .Asciz
mov 2(r5) ,r0 ; LUN
mov 4(r5) ,r3 ; Binary/text
call mtb$op ; Call file opener
Unsave <r3,r2,r1> ; Pop em
return ; And exit
;
.dsabl lsb ;
; MTB$OP 20-Nov-86 14:56:59 BDN
;
; Input: R0 Lun
; R1 Filename, .asciz
; R2 Direction, zero --> read (.LOOKUP), else write (.ENTER)
; R3 Binary flag <> 0 --> binary
; Return: R0 Mapped error code
;
; This is the old open/create code from Kermit-11/RT rewritten for
; inclusion in another application. I have replaced the old code as
; this version is cleaner and 100 words shorter.
.iif ndf, BINARY, BINARY = 1
.iif ndf, RD$ONL, RD$ONL = 0
.iif ndf, RD$WRI, RD$WRI = 1
.ASSUME RD$ONL EQ 0
.ASSUME BINARY EQ 1
Mtb$op::Save <r4,r5> ; Save regs (r1,r2,r3 saved above)
sub #40.*2 ,sp ; Allocate a buffer for .CSISPC
mov r0 ,r4 ; Copy the LUN to use
.SERR ; Inhibit fatal aborts by RT
asl r4 ; Zero?
bne 10$ ; Non-zero
mov sp ,mode+0 ; Zero, implies terminal always
clr bufp+0 ; Clear this out also
clr r0 ; No errors
br 100$ ; Exit
10$: clr sizof(r4) ; Clear I/O subsystem tables
clr bufp(r4) ; Clear buffer pointer out
clr bufs(r4) ; Clear buffer size out
clr mode(r4) ; Assume reading
clr blknum(r4) ; To keep track of current VBN
mov r3 ,filtyp(r4) ; Text or binary?
mov bufdef(r4),r0 ; Insert default buffer addresses
mov r0 ,buflst(r4) ; Copy it
mov #MAXSIZ ,r5 ; Insert the buffer size
mov r5 ,bufsiz(r4) ; Do it
20$: clrb (r0)+ ; Clear it out
sob r5 ,20$ ; Next please
mov sp ,r5 ; Point to save area
30$: movb (r1)+ ,(r5)+ ; Copy the filename over now
bne 30$ ; Next please
dec r5 ; Back up to the null.
movb #'= ,(r5)+ ; Setup
clrb @r5 ; .Asciz
mov sp ,r5 ; Point back to save area
mov #csierr ,r1 ; Assume .CSI error mapping
.CSISPC r5,#defext,r5 ; Do it
mov r5 ,sp ; Restore the stack pointer
bcs 80$ ; Filename parse error
tst @r5 ; Device name present?
bne 40$ ; Yes
mov #^RDK ,@r5 ; No, insert one then
40$: CALL fetch ; Insure that handlers are loaded
tst r0 ; Well?
bne 100$ ; No, error codes already mapped.
mov r4 ,r3 ; Get channel number back
asr r3 ; Get correct channel number
tst r2 ; And check for .ENTER
bne 50$ ; .ENTER
;
mov #lokerr ,r1 ; Set up error mapping for .LOOKUP
.LOOKUP #rtwork,r3,r5 ; Do it
bcs 80$ ; It failed
mov r0 ,sizof(r4) ; Success, return the created size
mov #-1 ,bufp(r4) ; Force a disk read on first call.
clr r0 ; Success
br 100$ ; Exit
;
50$: tst 2(r5) ; Never allow NFS writes to a disk
bne 60$ ; Its ok
mov #^RNON ,2(r5) ; No name, stuff one in then
mov #^RNAM ,4(r5) ; ....
mov #^RTMP ,6(r5) ; ......
60$: mov #enterr ,r1 ; Assume .ENTER error code mapping
mov at$len ,r2 ; Is there a protocol passed size?
bne 70$ ; Yes
mov en$siz ,r2 ; No, use SET value or default.
70$: .ENTER #rtwork,r3,r5,r2 ; Try hard to create the file
bcs 80$ ; No way
mov sp ,mode(r4) ; Writing today
clr r0 ; Success
br 100$ ; Time to go now
;
80$: movb @#errbyt,r0 ; Get the error code
bpl 90$ ; Normal error
com r0 ; Hard error code
mov #faterr ,r1 ; Map into the hard errors
90$: asl r0 ; Word addressing
add r0 ,r1 ; Get the mapped (fake RMS) error
asr r4 ; Channel number
.PURGE r4 ; Insure the channel in cleared
mov (r1) ,r0 ; Copy and exit
100$: mov r0 ,-(sp) ; Save errors
.HERR ; Restore normal error handling
mov (sp)+ ,r0 ; Pop
add #40.*2 ,sp ; Pop stack
Unsave <r5,r4> ; Pop registers and exit
return
getsiz::mov @r5 ,r1 ; get opened filesize
asl r1 ; get the lun times 2
mov sizof(r1),r1 ; return the size
clr r0 ; no errors
return ; bye
.sbttl close a file
.MCALL .CLOSE
; C L O S E
;
; close (%val lun)
;
; input: @r5 channel number to close
; output: r0 mapped error code
;
; calls: flush(lun)
close:: save <r1> ; save registers we may have
call flush ; dump out any remaining buffer
mov @r5 ,r1 ; then disconnect the access stream
beq 10$ ; terminal
.CLOSE r1 ; do the rt close
bcc 10$ ; it worked
movb @#errbyt,r0 ; it failed, map the rt11 error
asl r0 ; to something more descriptive
mov cloerr(r0),r0 ; simple
br 20$ ; map the error please
10$: clr r0 ; no errors
20$: asl r1 ; channel number times 2
clr bufp(r1) ; buffer_pointer[lun] := 0
clr sizof(r1) ; no size please
unsave <r1> ; pop the saved r1
return ; and exit with error in r0
rewind::mov @r5 ,r0 ; get the channel number
beq 100$ ; for the terminal, a no-op
asl r0 ; times two please
mov #-1 ,bufp(r0) ; flag a buffer reload is needed
clr bufs(r0) ; nothing is in the buffer
clr blknum(r0) ; first block of the disk file
100$: clr r0 ; no errors are possible
return ; bye
.sbttl put a record to an rt11 sequential file
; P U T R E C
;
; putrec( %loc buffer, %val record_size, %val channel_number )
;
; input: @r5 address of user buffer
; 2(r5) record size
; 4(r5) channel number
;
; output: r0 rms sts
;
; Write the next record to a disk file.
;
; Assumption: The record to be written will have a cr/lf
; appended to it unless the filetype is not
; text. In other words, PUTREC provides the
; carriage control unless the file is a ter-
; minal.
putrec::save <r1,r2,r3> ; save registers we may need
mov 2(r5) ,r2 ; the size of the i/o
mov @r5 ,r3 ; the buffer address
mov 4(r5) ,r1 ; the channel number please
bne 10$ ; a real disk file
tst r2 ; faking output to a terminal
beq 100$ ; nothing at all to do ?
print r3 ,r2 ; do the terminal i/o
br 100$ ; bye
10$: tst r2 ; the size of the i/o to do
beq 30$ ; nothing to do, add carriage control
20$: clr r0
bisb (r3)+ ,r0 ; the character to write out
call putcr0 ; channel is passed in r1
tst r0 ; did the write fail ?
bne 100$ ; yes, exit asap
sob r2 ,20$ ; next ch please
30$: asl r1 ; get the channel number times 2
cmp filtyp(r1),#text ; is this a text file
bne 100$ ; no, don't add carriage control in
asr r1 ; get the channel number back
movb #cr ,r0 ; and add in a cr/lf
call putcr0 ; simple
movb #lf ,r0 ; and at last the line feed
call putcr0 ; do the line feed at the end
100$: unsave <r3,r2,r1> ; pop registers we saved
return ; bye
.sbttl getc get one character from an input file
.MCALL .READW
; G E T C
;
; getc(%val channel_number)
;
; input: @r5 channel_number
; output: r0 rms error status
; r1 the character just read
getc:: mov @r5 ,r0
call getcr0
return
fgetcr::save <r3> ; use for saving the channel#
10$: mov r0 ,r3 ; save the channel number please
call .getc ; get the next ch please
tst r0 ; did the read work ok ?
bne 100$ ; no, exit
asl r3 ; get the channel number times 2
cmp filtyp(r3),#text ; if filetype[lun] = text
bne 100$ ; then
tstb r1 ; if ch = NULL
bne 100$ ; then try-again
asr r3 ; get origional channel back
mov r3 ,r0 ; setup the correct call format
br 10$
100$: unsave <r3>
return
.getc: save <r2,r3> ; save temps
mov r0 ,r2 ; channel number please
mov r0 ,r1 ; for the .READW please
asl r2 ; times 2
tst bufs(r2) ; anything in the buffer ?
beq 10$ ; no, please load it
cmp bufp(r2),#-1 ; need to initialize the buffer?
bne 20$ ; no
10$: mov bufsiz(r2),r3 ; we need buffer size in words
asr r3 ; convert bytes to words
.READW #rtwork,r1,buflst(r2),r3,blknum(r2)
bcs 90$ ; it failed, bye
inc blknum(r2) ; next time read the next block
clr bufp(r2) ; it worked. clear current pointer
asl r0 ; convert words read to bytes
mov r0 ,bufs(r2) ; and save the record size
20$: mov buflst(r2),r3 ; get the address of the buffer
add bufp(r2),r3 ; and point to the next character
clr r1 ; to be returned in r1
bisb @r3 ,r1 ; simple
inc bufp(r2) ; buffer.pointer := succ(buffer.pointer)
dec bufs(r2) ; amountleft := pred( amountleft )
clr r0 ; no errors please
br 100$
90$: movb @#errbyt,r0 ; get the error code
asl r0 ; times two
mov reaerr(r0),r0 ; map it into a unique global error
100$: unsave <r3,r2>
return
.sbttl putc put a single character to an rms file
.MCALL .WRITW
; P U T C
;
; input: @r5 the character to put
; 2(r5) the channel number to use
;
; Buffer single character i/o to internal disk buffer.
; Buffer is dumped if internal buffer is full.
; The local buffers are allocated in CREATE and OPEN.
putc:: save <r1> ; simply save r1 and call putcr0
mov 2(r5) ,r1 ; to do it. putcr0 will be somewhat
clr r0 ; faster to call directly due to the
bisb @r5 ,r0 ; overhead involved in setting up an
call putcr0 ; argument list.
unsave <r1> ; pop saved r1 and exit
return ; bye
putcr0::save <r1,r2,r3,r4> ; save registers we use
mov r1 ,r2 ; channel number
asl r2 ; times 2 of course
cmp bufp(r2),bufsiz(r2) ; is the buffer full ?
blo 20$ ; no, store some more characters in it
movb r0 ,r3 ; yes, save the input character r0
mov bufsiz(r2),r4 ; and setup for a .WRITW
asr r4 ; rt11 needs word count not byte count
tst r1 ; channel zero is always terminal
beq 3$ ; simple
cmp filtyp(r2),#terminal ; check for being a terminal today?
bne 4$ ; not a terminal
3$: print buflst(r2),bufsiz(r2) ; a terminal, force it out please
br 5$ ; and reinit the buffer now
4$: .WRITW #rtwork,r1,buflst(r2),r4,blknum(r2); dump this block to disk
bcs 90$ ; it failed for some reason
5$: inc blknum(r2)
clr bufp(r2) ; pointer := 0
mov buflst(r2),r4 ; it worked. zero the buffer now
mov bufsiz(r2),r0 ; get the buffer address and size
10$: clrb (r4)+ ; for i := 1 to bufsiz
sob r0 ,10$ ; do buffer[i] := chr(0)
movb r3 ,r0 ; ok, restore the old character
20$: mov bufp(r2),r1 ; get the current buffer pointer
add buflst(r2),r1 ; and point to a new home for the
movb r0 ,@r1 ; the input character in r0
inc bufp(r2) ; pointer := succ( pointer )
clr r0 ; success
br 100$
90$: movb @#errbyt,r0 ; get the rt11 error code
asl r0 ; times two
mov wrierr(r0),r0 ; map it into a global error code
100$: unsave <r4,r3,r2,r1>
return
.sbttl flush
.MCALL .WRITW
flush: save <r1,r2>
mov @r5 ,r1 ; get the internal channel number
asl r1 ; times 2 for indexing
tst bufp(r1) ; anything in the buffer
beq 100$ ; no
tst mode(r1) ; writing today ?
beq 100$ ; no
tst r1 ; terminal today ?
beq 20$ ; yes
mov bufsiz(r1),r2 ; rt11 likes to have word counts
asr r2 ; simple
.WRITW #rtwork,@r5,buflst(r1),r2,blknum(r1)
br 100$
20$: print buflst(r1),bufp(r1)
br 100$
100$: unsave <r2,r1>
clr r0
return
.sbttl fparse parse filename and fill in with defaults
; F P A R S E
;
; input: @r5 input filename, .asciz
; defdir the default directory name string to use
;
; output: 2(r5) expanded filename, .asciz, maximum length 63 bytes
; r0 error codes
;
; For RT11, simply return the passed string. Perhaps later do
; something real.
fparse::save <r1>
mov #defdir ,r0
mov 2(r5) ,r1
10$: movb (r0)+ ,(r1)+
bne 10$
dec r1
copyz @r5 ,r1 ; simple
clr r0 ; no errors are possible today
unsave <r1>
return ; bye
global <defdir>
.sbttl l$ttyout
; Print a string to the console terminal
;
; Input: @r5 buffer address
; 2(r5) string length
;
; If 2(r5) is zero, then assume .asciz
.if eq ,0
.ift
l$ttyo::call @$ttyou
return
.iff
l$ttyo::save <r0,r1,r2,r3> ; save registers we may need
mov @r5 ,r1 ; get the string address
mov 2(r5) ,r2 ; get the string length
bne 20$ ; non-zero then
mov r1 ,r2 ; count until a null now
10$: tstb (r2)+ ; well ?
bne 10$ ; not yet, keep looking
sub r1 ,r2 ; get the length now
dec r2 ; all done
beq 100$ ; nothing to print at all?
20$: mov $prtbuf ,r0 ; now buffer the i/o to avoid
mov #36 ,r3 ; the printing of cr/lf at the
30$: tstb (r1)+ ; don't copy nulls please
beq 35$ ; ignore if null
movb -1(r1) ,(r0)+ ; copy a byte please
35$: dec r2 ; done yet ?
beq 40$ ; yes
sob r3 ,30$ ; no, next please
40$: movb #200 ,(r0)+ ; insure no carraige control !
clrb @r0 ; must be passed .asciz
mov $prtbuf ,r0 ; point back to the start of buffer
emt 351 ; do the .print kmon request
tst r2 ; any more data to buffer ?
bne 20$ ; yes, try again
100$: unsave <r3,r2,r1,r0>
return
.endc
l$pcrl::print #100$
return
100$: .byte cr,lf,0,0
; G E T S Y S
;
; output: r0 operating system
;
; sy$11m (1) for rsx11m
; sy$ias (3) for ias
; sy$rsts (4) for rsts
; sy$mpl (6) for m+
; sy$rt (7) for rt11 ????
getsys::mov #7 ,r0 ; this is rt11 folks
return ; bye
.sbttl misc routines
iswild::mov @r5 ,r0
10$: tstb @r0
beq 100$
cmpb @r0 ,#'%
beq 90$
cmpb (r0)+ ,#'*
bne 10$
90$: mov #1 ,r0
return
100$: clr r0
return
; E X I T
;
; exit to kmon
.MCALL .EXIT ,.HRESET,.CMKT ,.TWAIT
exit:: .CMKT #cancel,#0 ; /51/ Stop watchdogs please
call finrt ; /37/ clear lines out
clr r0
.EXIT ; should always work ok
halt ; huh ?
.MCALL .TWAIT ; mark time request
suspen::save <r1> ; save temps
mov @r5 ,r1 ; sleep time in seconds
beq 10$ ; nothing, must be fractional
mul #60. ,r1 ; sixty clock ticks in a second
clr r0 ; low order part
br 20$ ; ignore the fractional part
10$: mov 2(r5) ,r0 ; sleep < 1 second
20$: add r1 ,r0 ; total time to sleep
mov r0 ,-(sp) ; setup the timeout block
clr -(sp) ; two words please
mov sp ,r1 ; point to it
.TWAIT #rtwork,r1 ; suspend ourself for a while
bcs 30$ ; it worked ok
clr r0 ; return success
br 100$ ; bye
30$: movb @#errbyt,r0 ; it failed, map the error into
asl r0 ; a global error number
mov twaerr(r0),r0 ; simple
100$: cmp (sp)+ ,(sp)+ ; pop time buffer and exit
unsave <r1> ; pop registers
return ; bye
.sbttl Log out and Set control C
logout::tst tsxsav ; /45/ Does this make sense?
beq 100$ ; /45/ Not really
mov #510 ,r0 ; /45/ Address of chain command
mov #4 ,(r0)+ ; /45/ Setup to log out on TSX+
movb #'B&137 ,(r0)+ ; /45/ And insert BYE
movb #'Y&137 ,(r0)+ ; /45/ ...
movb #'E&137 ,(r0)+ ; /45/ ...
clrb (r0)+ ; /45/ Make it .asciz please
bis #4000 ,@#JSW ; /45/ Pass to KMON
clr r0 ; /45/ Must be zero
.EXIT ; /45/ Try to logout on TSX+
100$: clr r0 ; /45/ Exit
return
.MCALL .SCCA ,.MRKT ,.EXIT ,.CMKT ,.RCTRLO,.SPCPS ,.TTINR
.save ; /51/ Save current PSECT
.psect sccada ,rw,d,lcl,rel,con;/51/ Get out of APR1 mapping?
sccwork:.word 0,0,0,0 ; /51/ A work area for .SCCA
ccflag: .word 0 ; /51/ RT11's way of flagging ^C
mkw: .word 0,0,0,0 ; /51/ A Mark Time work area
mktime: .word 0,15. ; /51/ Check for ^C every 15 ticks
spcwork:.word 0,0 ; /51/ For the .SPCPS directive
spcarg: .word ccexit,0,0 ; /51/ Where to alter flow to.
.restore ; /51/ Pop old psect now.
.save ; /51/ Save current PSECT
.psect sccain ,ro,i,lcl,rel,con;/51/ Perhaps get this out of APR1
.enabl lsb ; /51/ mapping for XM?
setcc:: clr ccflag ; /51/ No control C's as of yet
.CMKT #mkw,#40 ; /51/ Clear previous Mark Time.
.SCCA #sccwork,#ccflag ; /51/ Set the address for flag word
.MRKT #mkw,#mktime,#ccast,#40 ; /51/ Schedule a checkup for ^C
return ; /51/ Exit
ccast: tst ccflag ; /51/ Was there a Control C typed?
beq 100$ ; /51/ No, just reschedule
clr ccflag ; /51/ Clear the flag
.TTINR ; /51/ In case control C's sitting
.TTINR ; /51/ around in the input buffer.
.RCTRLO ; /51/ Insure output enabled
inc cccnt ; /51/ Bump the global ^C count
cmp cccnt ,#CC$MAX ; /51/ Exit?
blos 100$ ; /51/ No
call finrt ; /51/ Yes, get set to exit
.SPCPS #spcwork,#spcarg ; /51/ Get RT11 to jump to .EXIT
bcc 110$ ; /51/ Success
10$: clr r0 ; /51/ Normal .EXIT
.EXIT ; /51/ Bye
100$: .MRKT #mkw,#mktime,#ccast,#40 ; /51/ Start a timer to watch
110$: return ; /51/ And exit
ccexit: .EXIT ; /51/ Bye
.dsabl lsb ; /51/
.restore
.sbttl Dummy EPTS for RSTS/RSX compatibility
putcdt::
getcdt::
tlog::
tmsdia::
getuic::
quochk::
qspool::
noecho::
echo::
chkpar::
fixwil::
putatr::
runjob::clr r0
getprv::
drpprv::
throtl::return
binfil::clr r0
calls chkext ,<@r5>
return
getatr::
detach::
systat::
login::
sercmd::mov #er$iop ,r0
return
okuser::mov (sp)+ ,@sp
return
dskuse::mov @r5 ,r0
clrb @r0
return
second::clr r0
clr r1
return
getpro::clr r0
return
getmcr::mov @r5 ,r0
clrb @r0
clr r0
return
.sbttl FETCH Load a handler if not already resident (BG only)
; FETCH( rad50(devicename) )
;
; Mostly rewritten Edit /51/
;
; /51/ Hard error recovery
; /51/ New buffer allocation scheme
; /51/ Checks on .FETCH when running in Foreground
;
; Example call: CALLS FETCH,<#^RDZ0>
; TST R0
; BNE ERROR
fetch:: .SERR ; Trap all errors please
.DSTAT #rtwork,r5 ; Get handler status
bcs 70$ ; No such handler present
movb rtwork ,devidx ; Save device index
tst rtwork+4 ; Is this handler resident ?
bne 50$ ; Yes
tst jobsts ; No, we MUST be job zero to be in
bne 55$ ; the background, else ERROR return.
mov fetptmax,-(sp) ; Check for space to load it
sub @fetpt ,@sp ; Simple to do
cmp rtwork+2,(sp)+ ; Is there sufficient space ?
bhi 60$ ; No, error and exit
.FETCH @fetpt ,r5 ; Try hard to load the thing
bcs 80$ ; No way, map the error code please
mov r0 ,@fetpt ; update the free pointer and exit
50$: clr r0 ; No errors
br 100$ ; Exit
;
55$: mov #ER$FGF ,r0 ; Can't fetch if running in FG
br 100$ ; Exit
60$: mov #ER$FET ,r0 ; Return NO ROOM for the handler
br 100$ ; and exit with error in R0.
;
70$: mov #DSTERR ,-(sp) ; Map a .dstat error
br 90$ ; And do it
80$: mov #FETERR ,-(sp) ; Map a .FETCH error
90$: movb @#ERRBYT,r0 ; Get the error code
bpl 95$ ; Normal error code here
com r0 ; Fatal error from .SERR
mov #FATERR ,(sp) ; Thus map to RT11 messages
95$: asl r0 ; Word offsets
add (sp)+ ,r0 ; The actual address
mov @r0 ,r0 ; Get it and exit
100$: mov r0 ,-(sp) ; Save this
.HERR ; Reset executive error trapping
mov (sp)+ ,r0 ; Restore error codes
return ; Bye
.sbttl things to do eis instructions
$cbta:: jsr pc ,@$$cbta
return
.if ne ,0
.ift
.psect
$mul:: mov r0 ,-(sp)
mov r1 ,-(sp)
mov 6(sp) ,r0
mov 10(sp) ,r1
mov r0,-(sp)
mov #21,-(sp)
clr r0
10$: ror r0
ror r1
bcc 20$
add 2(sp),r0
20$: dec (sp)
bgt 10$
cmp (sp)+ ,(sp)+
mov r1 ,10(sp)
mov (sp)+ ,r1
mov (sp)+ ,r0
mov (sp) ,2(sp)
tst (sp)+
return
$div:: mov r0 ,-(sp)
mov r1 ,-(sp)
mov 6(sp) ,r0
mov 10(sp) ,r1
mov #20,-(sp)
mov r1,-(sp)
clr r1
e00040: asl r0
rol r1
cmp r1,(sp)
bcs e00054
sub (sp),r1
inc r0
e00054: dec 2(sp)
bgt e00040
cmp (sp)+ ,(sp)+
mov r1 ,6(sp)
mov r0 ,10(sp)
mov (sp)+ ,r1
mov (sp)+ ,r0
return
.endc
.sbttl $CBTA Conversion called by $CDDMG from RSX SYSLIB
; 09-Jun-86 10:14:54 $CBTA moved to K11DSP.MAC for XM root cuts
.GLOBL $SAVRG ;Global reference
.GLOBL $CBTA
.GLOBL $SAVRG
$SAVRG: MOV R4,-(SP)
MOV R3,-(SP)
MOV R5,-(SP)
MOV 6(SP),R5
CALL @(SP)+
MOV (SP)+,R3
MOV (SP)+,R4
MOV (SP)+,R5
RETURN
.end