.title k11m41 kermit i/o for RSX11M/M+ v4.1 and 2.1 .ident /4.1.02/ .psect $code ,ro,i,lcl,rel,con ; define macros and things we want for KERMIT-11 .include /IN:K11MAC.MAC/ .iif ndf, k11inc, .error ; INCLUDE for IN:K11MAC.MAC failed r$rsts = 0 ; <> for debugging under RSTS ; Copyright (C) 1983 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. ; ; ; binread( %val channel_number, %val timeout ) ; binwrit( %loc buffer, %val buffer_length, %val channel_number ) ; cantyp ( %val channel_number ) ; drpprv ( ) ; echo ( ) ; exit ( ) ; getprv ( ) ; getuic ( ) ; gttnam ( %loc buffer ) ; noecho ( ) ; read ( %loc buffer, %val buffer_length, %val channel_number, ; %val block_number ) ; setdlm ( %val channel_number ) ; suspen ( %val sleep_time ) ; ttyini ( %loc device_name ,%val channel_number , %val ccflag ) ; write ( %loc buffer, %val buffer_length, %val channel_number, ; %val block_number ) .sbttl edits ; 20-Jan-84 09:50:18 BDN Test and fix TTSPEED, SETSPD and BINREAD .sbttl macros .macro clrfqb call $clrfq .endm clrfqb .macro clrxrb call $clrxr .endm clrxrb .macro moverr val,dst movb val ,-(sp) call $mover movb (sp)+ ,dst .endm moverr .psect $code ef.tt = 20 ef.tmo = 21 er.tmo == 176 ; for now, timeout er.nod == 177 ; pseudo error for no data nodata == er.nod .mcall alun$s ,qiow$s xinit:: alun$s #lun.tt,#"TI,#tiunit ; assign the terminal please ;- qiow$s #io.ata,#lun.tt,#ef.tt,#50,#kbiost,,<,#0,#ttast> qiow$s #io.att,#lun.tt,#ef.tt,#50,#kbiost return global .sbttl terminal initialization .psect $code ; T T Y I N I ; ; ttyini( %loc device_name ,%val channel_number ,%val ccflag ) ; ; ; input: @r5 .asciz string of device name ; 2(r5) channel number ; 4(r5) bitfield for ter$cc and ter$bi ; ; if 4(r5) and ter$bi then use binary open ; else use multiple delimiters ; if 4(r5) and ter$cc then set control c as delimiter ; if 4(r5) and ter$xo then allow binary mode with XON ; ; output: r0 error codes ; ; ; Ttyini sets the appropiate terminal characteristics for ; the device name passsed and returns the device open (or ; attached) on the passed logical unit. 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::call ttpars ; parse the device name to get unit bcs 100$ ; oops alun$s 2(r5),#"TT,r0 ; try to assign the device qiow$s #io.att,2(r5),#ef.tt,#50,#kbiost cmpb kbiost ,#ie.daa ; if already attached then ignore it bne 10$ ; no clrb kbiost ; yes, say it was successful 10$: moverr kbiost ,r0 ; get the result of this operation br 110$ ; make it > 0 for error text print 100$: moverr @#$DSW ,r0 ; exit 110$: return ttyfin::qiow$s #io.det,2(r5),#ef.tt,#50,#kbiost clr r0 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 .mcall glun$s gttnam::save ; save temps please mov @r5 ,r3 ; point to output buffer please sub #20 ,sp ; allocate a buffer for GLUN$S mov sp ,r2 ; point to it please glun$s #lun.tt ,r2 ; try it cmpb @#$DSW ,#is.suc ; did it work ? bne 90$ ; no, return the error code please movb g.luna+0(r2),(r3)+ ; get the device name next movb g.luna+1(r2),(r3)+ ; both bytes of it please clr r1 ; get the unit number next please bisb g.lunu(r2),r1 ; simple clr r0 ; now compute the ascii name div #10 ,r0 ; simple (in octal please for RSX) mov r1 ,-(sp) ; save the low order unit number cmp r0 ,#7 ; unit number > 77 octal ? blos 10$ ; no mov r0 ,r1 ; yes, do it again please clr r0 ; simple div #10 ,r0 ; and so on add #'0 ,r0 ; convert to ascii please movb r0 ,(r3)+ ; get the high part copied mov r1 ,r0 ; and now put the next digit back 10$: mov (sp)+ ,r1 ; get the low digit back now add #'0 ,r0 ; convert to ascii add #'0 ,r1 ; likewise movb r0 ,(r3)+ ; move the unit number in now movb r1 ,(r3)+ ; at last .... movb #': ,(r3)+ ; please insert a colon: clrb @r3 ; make it .asciz clr r0 ; no errors br 100$ ; exit 90$: moverr @#$dsw ,r0 ; get the directive error code 100$: add #20 ,sp ; pop glun$s buffer unsave 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 ; save a temp register please clr -(sp) ; a buffer for sf.smc clr r0 ; assume our terminal mov @r5 ,r1 ; passed value of zero ? beq 10$ ; yes, assume TI: tstb @r1 ; well, what about a null string? beq 10$ ; yes, again assume TI: call ttpars ; a real name, try to parse it bcs 90$ ; oops 10$: mov sp ,r1 ; point to the local buffer alun$s #lun.co,#"TT,r0 ; assign the terminal please qiow$s #io.att,#lun.co,#ef.tt,#50,#kbiost movb #tc.nec ,@r1 ; say we want no echoing qiow$s #sf.smc,#lun.co,#ef.tt,#50,#kbiost,, movb kbiost ,-(sp) ; save the error code if any qiow$s #io.det,#lun.co,#ef.tt,#50,#kbiost cmpb (sp)+ ,#ie.pri ; priv violation here ? bne 20$ ; no call 200$ ; yes, try to spawn MCR command br 100$ 20$: clr r0 ; asuume no error and exit br 100$ ; bye 90$: movb @#$DSW ,r0 ; return TTPARS error code 100$: tst (sp)+ ; pop local buffer unsave ; pop saved register return 200$: sub #100 ,sp ; use mcr set /noecho=ttnn: mov sp ,r1 ; point to it please copyz #300$ ,r1 ; copy the 'SET /NOECHO=' strlen r1 ; get the current string length add r0 ,r1 ; point to the end of the line mov @r5 ,r0 ; get the string address tstb @r0 ; anything there at all ? beq 210$ ; no, just exit please copyz @r5 ,r1 ; simple mov sp ,r1 ; point back to the buffer calls runmcr ,<#1,r1> ; simple, call mcr to do it 210$: add #100 ,sp ; pop the local buffer and exit return 300$: .asciz #SET /NOECHO=# .even ; E C H O ; ; input: nothing ; output: nothing echo:: clr r0 return kbread::qiow$s #io.rvb,#5,#ef.tt,#50,#kbiost,,<@r5,#80.> clr r0 ; assume no errors mov kbiost+2,r1 ; return bytecount in r1 cmpb kbiost ,#is.suc ; successful read ? beq 100$ ; yes clr r1 ; no data please moverr kbiost ,r0 ; return the error 100$: print #200$ return 200$: .byte lf,0 .sbttl terminal read/write binary mode ; B I N R E A ; ; binread( %val channel_number, %val timeout ) ; ; ; input: @r5 channel number ; 2(r5) timeout (if -1, then no wait) (do this for RSX??) ; ; output: r0 error ; r1 character read ; binrea::save ; save a register for a friend clr -(sp) ; allocate a buffer please mov sp ,r2 ; and point to it now clr -(sp) ; allocate a buffer for SF.GMC mov sp ,r3 ; and point to it please cmp 2(r5) ,#-1 ; get without any wait today ? bne 20$ ; no, check for timeouts now movb #tc.tbf ,@r3 ; create a .byte tc.tbf,0 qiow$s #sf.gmc,@r5,#ef.tt,#50,#kbiost,, cmpb kbiost ,#is.suc ; did the read terminal thing work? bne 90$ ; no tstb 1(r3) ; any data in the typeahead buffer? bne 20$ ; yes movb #nodata ,r0 ; fake a psuedo no data error br 100$ ; and exit 20$: clr r0 ; get timeout in seconds into mov 2(r5) ,r1 ; ten second chunks (better than ble 30$ ; -1 timeout or no timeout div #10. ,r0 ; nothing, i suppose) tst r0 ; anything left ? if not, make it bne 30$ ; 10 seconds please inc r0 ; 1 --> 10 seconds 30$: .iif ne, r$rsts,emt 22 ; if testing under RSTS disable echo qiow$s #io.ral!tf.rne!tf.tmo,@r5,#ef.tt,#50,#kbiost,, .iif ne, r$rsts,emt 20 ; if testing under RSTS enable echo clr r1 ; get the character now please bisb @r2 ,r1 ; copy it with sign extension! clr r0 ; assume no errors cmpb #is.suc ,kbiost ; did it work ? beq 100$ ; yes, exit cmpb #is.tmo ,kbiost ; timeout bne 90$ ; no movb #er.tmo ,r0 ; yes br 100$ ; bye 90$: moverr kbiost ,r0 ; no, return the error 100$: cmp (sp)+ ,(sp)+ ; pop the 2 buffers please unsave ; from DIRECTIVE errors return ; bye ; B I N W R I ; ; write( %loc buffer, %val buffer_length, %val channel_number ) ; ; input: @r5 buffer address ; 2(r5) buffer size ; 4(r5) channel number ; output: r0 error code binwri::qiow$s #io.wal,4(r5),#ef.tt,#50,#kbiost,,<@r5,2(r5)> clr r0 return .sbttl normal i/o to the terminal ; S T T Y O U ; ; input: 2(sp) buffer address ; 4(sp) buffer length ; output: 'c' set on error ; 'c' clear on no error ; ; ; L $ T T Y O ; ; l$ttyou( %loc buffer, %val string_length ) ; ; input: @r5 buffer address ; 2(r5) buffer length l$ttyo::save ; save temps here please movb kbiost ,-(sp) ; save old io status mov 2(r5) ,r0 ; string length bne 20$ ; length was passed mov @r5 ,r0 ; no length, assume .asciz 10$: tstb (r0)+ ; move along looking for a null bne 10$ ; none yet so far sub @r5 ,r0 ; get the length dec r0 ; off by one 20$: qiow$s #io.wvb,#5,#ef.tt,#50,#kbiost,,<@r5,r0> cmpb kbiost ,#is.suc ; did it work ? bne 90$ ; no, exit with carry set clc ; yes, it worked br 100$ ; exit 90$: sec ; write failed, set error flag and exit 100$: movb (sp)+ ,kbiost unsave ; pop registers that we used return ; and exit sttyou::mov r5 ,-(sp) mov sp ,r5 add #4 ,r5 call l$ttyo mov (sp)+ ,r5 return l$pcrl::.print #100$ return 100$: .byte cr,lf,0,0 .sbttl exit kermit and logout .mcall exit$s logout:: exit:: exit$s quochk::clr r0 ; try to see if the logout will work return dskuse::mov @r5 ,r0 copyz #120$ ,r0 return 120$: .asciz /Can't do space enquiry for RSX/ .even .sbttl cantyp cancel typeahead ; C A N T Y P ; ; cantyp(%val channel_number) ; ; input: @r5 device name ; 2(r5) lun ; ; ; Cantyp tries to dump all pending input on a given terminal ; line. cantyp::save ; use r0 to point into xrb clr -(sp) ; allocate buffer for SF.SMC mov sp ,r1 ; point to it please movb #tc.tbf ,@r1 ; cancel all typeahead please mov 2(r5) ,r0 ; get the channel number please bne 10$ ; ok mov #5 ,r0 10$: qiow$s #sf.smc,r0,#ef.tt,#50,#kbiost,, 100$: tst (sp)+ unsave ; all done return ; bye .sbttl get uic ; G E T U I C ; ; input: nothing ; output: r0 current UIC/PPN of the user .mcall gtsk$s getuic::sub #40 ,sp ; allocate gtsk buffer mov sp ,r0 ; point to the buffer please gtsk$s r0 ; simple mov g.tspc(r0),r0 ; return the uic add #40 ,sp ; pop the buffer and exit return drpprv::return getprv::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 .mcall mrkt$s ,wtse$s suspen::tst @r5 ; nonzero seconds call ? bne 10$ ; yes mrkt$s #ef.tt,2(r5),#1 ; no, sleep passed # of ticks br 20$ ; and now wait for the timeout 10$: mrkt$s #ef.tt,@r5,#2 ; sleep integral # of seconds 20$: wtse$s #ef.tt return .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 ttypar::call ttpars ; get the terminal unit number bcs 100$ ; oops 100$: movb @#$DSW ,r0 ; get any errors return .sbttl hangup a terminal, set dtr on a terminal ; T T Y H A N ; ; ttyhan( %loc terminalname ) ; ; input: @r5 address of the terminal name ; output: r0 error code ttyhan::call ttpars ; the usual, parse the device name bcs 100$ ; oops alun$s #lun.co,#"TT,r0 ; assign the terminal please qiow$s #io.att,#lun.co,#ef.tt,#50,#kbiost qiow$s #io.hng,#lun.co,#ef.tt,#50,#kbiost moverr kbiost ,r0 qiow$s #io.det,#lun.co,#ef.tt,#50,#kbiost br 100$ ; bye 90$: moverr @#$DSW ,r0 ; return TTPARS error code 100$: return ; raise DTR on a terminal line ; ; T T Y D T R ; ; ttydtr( %loc terminalname ) ; ; input: @r5 address of the terminal name ; output: r0 error code ttydtr::call ttpars ; the usual, parse the device name bcs 100$ ; oops 100$: movb @#$DSW ,r0 ; return error code and exit return ; bye .sbttl ttspeed get speed for line ; T T S P E E D ; ; input: @r5 name of terminal or address of null for current ; output: r0 current speed ; .psect $pdata splst: .word 0 ,50. ,75. ,110. ,134. ,150. ,200. .word 300. ,600. ,1200. ,1800. ,2000. ,2400. ,3600. .word 4800. ,7200. ,9600. ,-1 setlst: .word s.0 ,s.50 ,s.75 ,s.110 ,s.134 ,s.150 ,s.200 .word s.300 ,s.600 ,s.1200 ,s.1800 ,s.2000 ,s.2400 ,s.3600 .word s.4800. ,s.7200 ,s.9600 ,-1 .psect $code ttspee::save clr -(sp) ; allocate buffer for SF.GMC clr -(sp) call ttpars ; parse the terminal device name bcs 90$ ; error in device name ? alun$s #lun.co,#"TT,r0 ; assign the terminal please qiow$s #io.att,#lun.co,#ef.tt,#50,#kbiost mov sp ,r2 movb #tc.xsp ,@r2 movb #tc.rsp ,2(r2) qiow$s #sf.gmc,#lun.co,#ef.tt,#50,#kbiost,, movb kbiost ,-(sp) qiow$s #io.det,#lun.co,#ef.tt,#50,#kbiost movb (sp)+ ,kbiost clr r0 ; assume zero speed cmpb kbiost ,#is.suc ; did the read speed thing work ? bne 90$ ; not really movb 1(r2) ,r2 ; get the speed setting please clr r1 ; find the index into speed table 10$: cmp setlst(r1),#-1 ; reached the end of table yet ? beq 90$ ; yes, exit cmpb setlst(r1),r2 ; a match yet beq 20$ ; yes tst (r1)+ ; no, index := index + 2 br 10$ ; next please 20$: mov splst(r1),r0 ; return decimal of the speed br 100$ ; bye 90$: 100$: cmp (sp)+ ,(sp)+ unsave return .sbttl set the speed of a terminal line ; S E T S P D ; ; setspd(%loc devicename, %val speed) ; ; input: @r5 device name ; 2(r5) speed ; output: r0 error code, 255 if invalid speed setspd::save call ttpars ; parse the terminal name bcs 90$ ; oops clr r1 ; match the passed speed to the 10$: cmp splst(r1),#-1 ; speed desired to get the index beq 80$ ; end of the table, invalid speed cmp splst(r1),2(r5) ; a match yet ? beq 20$ ; yes tst (r1)+ ; no, look again please br 10$ ; next 20$: clr -(sp) ; we have the index into speedtable clr -(sp) ; allocate a SF.SMC buffer now mov sp ,r2 ; point to a buffer for SF.SMC movb #tc.xsp ,(r2)+ ; stuff xmitter change code in movb setlst(r1),(r2)+ ; and the desired speed now movb #tc.rsp ,(r2)+ ; stuff receiver change code in movb setlst(r1),(r2)+ ; and the desired speed now mov sp ,r2 ; point back to the buffer now alun$s #lun.co,#"TT,r0 ; assign the terminal please qiow$s #io.att,#lun.co,#ef.tt,#50,#kbiost qiow$s #sf.smc,#lun.co,#ef.tt,#50,#kbiost,, movb kbiost ,-(sp) qiow$s #io.det,#lun.co,#ef.tt,#50,#kbiost movb (sp)+ ,kbiost cmp (sp)+ ,(sp)+ ; pop the buffer we used clr r0 ; assume success cmpb kbiost ,#is.suc ; did it work ? beq 100$ ; yes, exit without error cmpb kbiost ,#ie.pri ; protection violatian here ? bne 70$ ; no call spwnbd ; yes, try to spawn MCR SET /SPEED= br 100$ ; and exit 70$: moverr kbiost ,r0 ; no, return the error and exit br 100$ ; and exit with the error code 80$: mov #377 ,r0 ; unknown speed br 100$ ; exit 90$: moverr @#$dsw ,r0 ; error from parse br 100$ 100$: unsave ; bye return .sbttl SPWNBD set the line speed via a spawn if SF.SMC fails ; input: ; @r5 address of terminal name, asciz ; 2(r5) speed to do it to ; output: ; r0 error code from spawn spwnbd: sub #70 ,sp ; allocate some buffers please mov sp ,r1 ; pointer to the MCR command line sub #10 ,sp ; pointer to decimal conversion buffer mov sp ,r2 ; simple copyz #200$ ,r1 ; copy over MCR SET/SPEED= strlen r1 ; get over to the end of it now add r0 ,r1 ; simple copyz @r5 ,r1 ; copy the device name over now strlen r1 ; point to the end of it please add r0 ,r1 ; simple deccvt 2(r5) ,r2 ; convert speed to decimal now calls cvt$$ , ; remove any spaces please add r0 ,r2 ; point to the end of the line clrb @r2 ; make it .asciz please mov sp ,r2 ; point back to the start of buffer copyz r2 ,r1 ; stuff the speed data into the mcr add r0 ,r1 ; command buffer movb #': ,(r1)+ ; simple copyz r2 ,r1 ; again add r0 ,r1 ; point to the end of it clrb @r1 ; insure .asciz please add #10 ,sp ; pop the conversion buffer mov sp ,r1 ; point back to the mcre command calls runmcr ,<#1,r1> ; buffer and try the spawn add #70 ,sp ; pop the mcr command buffer return ; and exit 200$: .asciz #SET /SPEED=# ; part of the mcr command line .even .sbttl save/restore terminal setting ; ttysav( %loc ttname) ; ttyrst() ; ; output: r0 error code ttysav::save ; save registers please call ttpars ; and now parse the device name bcs 90$ ; oops 90$: movb @#$DSW ,r0 ; error, return it in r0 100$: unsave ; pop registers and exit return ttyrst::save ; save registers please unsave ; pop registers and exit return ttyset::save call ttpars ; set terminal up for KERMIT bcs 90$ ; oops, bad device name 90$: movb @#$DSW ,r0 ; return possible errors unsave return global .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 ; parse a device name clrb @#$DSW ; set no error as of yet mov #377 ,r0 ; presume no device name mov @r5 ,r3 ; get the string address tstb @r3 ; anything there ? beq 90$ ; no, error cmpb @r3 ,#'T&137 ; must be of the format TTnnn: beq 10$ ; ok so far cmpb @r3 ,#'T!40 ; must be of the format TTnnn: bne 90$ ; no 10$: inc r3 cmpb @r3 ,#'T&137 ; must be of the format TTnnn: beq 20$ ; ok so far cmpb @r3 ,#'T!40 ; must be of the format TTnnn: bne 90$ ; no 20$: inc r3 clr r0 ; could use .parse but this is 30$: movb (r3)+ ,r1 ; get the next digit in the string beq 90$ ; hit end of string cmpb r1 ,#': ; end of the device name ? beq 100$ ; yes, exit please cmpb r1 ,#'0 ; in the range '0'..'7' ? blo 90$ ; oops cmpb r1 ,#'7 ; keep checking please bhi 90$ ; bad device name asl r0 ; r0 = r0 * 8 asl r0 ; ditto asl r0 ; and so forth sub #'0 ,r1 ; convert to binary add r1 ,r0 ; and sum the digit in please br 30$ ; next 90$: movb #ie.idu ,@#$dsw ; fake a bad device name and exit sec ; ok br 110$ ; bye 100$: tst r0 ; did we get a real value here ? bne 105$ ; yes mov #377 ,r0 ; no, return psuedo unit for self 105$: clr @#$dsw ; no errors clc ; success 110$: unsave ; bye return .sbttl assign device ; Fake a device assignment by attaching to a dummy lun. Also ; check for someone else having it via issueing a mark time. ; Thanks to Bob Denny for that one. .mcall alun$s ,astx$s ,cmkt$s ,mrkt$s ,qiow$s ,wtse$s assdev::save call ttpars bcs 100$ clr r1 ; flag if we timed out mrkt$s #ef.tmo,#2,#2,#asstmo ; give 2 seconds to do this alun$s #lun.as,#"TT,r0 ; assign the terminal please qiow$s #io.att,#lun.as,#ef.tt,#50,#kbiost mov r1 ,r0 ; did we ever time out bne 110$ ; yes, return busy device cmkt$s #ef.tmo,#asstmo clr r0 cmpb kbiost ,#is.suc ; did it work beq 110$ ; yes, return error zero moverr kbiost ,r0 ; no, get the error code br 110$ ; and exit 100$: moverr @#$DSW ,r0 110$: unsave return asstmo: tst (sp)+ ; remove the event flag number qiow$s #io.kil,#lun.as,#ef.tt,#50,#kbiost moverr #ie.daa ,r1 ; get the error code and exit astx$s ; exit from this timeout ast .sbttl namcvt remove everything but the filename.type ; N A M C V T ; ; input: @r5 source filespec ; 2(r5) address of where to return FILENAME.TYPE .mcall fdop$r ,csi$1 ,csi$2 ,nmblk$ ,csi$ .psect rsxdat ,rw,d,lcl,rel,con csi$ defnam: nmblk$ ,,0,SY,0 .even fdbsiz = 150. .psect $code namcvt::save sub #fdbsiz ,sp ; allocate fdb on the stack mov sp ,r4 ; use r5 to point to it mov #fdbsiz ,r0 ; and clear the new fdb out 5$: clrb (r4)+ ; to avoid strange side effects sob r0 ,5$ ; next, please mov sp ,r4 ; restore pointer to the fbd sub #c.size+2,sp ; allocate a csi buffer mov sp ,r3 ; and a pointer to it. add #c.dsds ,r3 ; setup for fdop$ call fdop$r r4,#lun.sr,r3,#defnam,<#fa.rd!fa.shr> mov sp ,r3 ; restore pointer to the csi block strlen @r5 ; get the string length now mov r0 ,r1 ; anything there at all ? csi$1 r3,@r5,r1 ; now do the first scan. bcs 180$ ; oops csi$2 r3,OUTPUT ; finish up the scan please bcs 180$ ; oops save ; now parse the filename mov r4 ,r0 ; setup for call to .parse mov r4 ,r1 ; setup a pointer to the add #f.fnb ,r1 ; filename block mov f.dspt(r4),r2 ; where to get the filespec mov #defnam ,r3 ; defaults to be filled in. call .parse ; parse it to get the rad50 unsave ; and other stuff for the file bcs 190$ ; oops add #f.fnb+n.fnam,r4 ; point to file filename block mov 2(r5) ,r3 ; point to the resultant string calls rdtoa , ; and convert to ascii add #3 ,r3 ; next three please calls rdtoa , ; and convert to ascii add #3 ,r3 ; next three please calls rdtoa , ; and convert to ascii add #3 ,r3 ; next three please movb #'. ,(r3)+ ; insert a dot please calls rdtoa , ; and convert to ascii add #3 ,r3 ; next three please clrb @r3 ; .asciz calls cvt$$ ,<2(r5),#15,#377>; remove junk like imbedded spaces add 2(r5) ,r0 ; and make it .asciz clrb @r0 ; simple clr r0 ; no errors br 200$ ; bye 180$: moverr @#$DSW ,r0 ; error from CSI ? br 200$ ; bye 190$: moverr f.err(r4),r0 ; error from .parse ? 200$: add #c.size+2,sp add #fdbsiz ,sp unsave return .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 mov @r5 ,r0 clrb @r0 unsave ; pop temps and exit return ; A S C T I M ; ; input: @r5 buffer address ; 2(r5) time in system internal format asctim::save mov @r5 ,r0 clrb @r0 unsave ; pop temps and exit return .sbttl systat get list of users logged in systat::moverr #-1 ,r0 return .sbttl dodir get a reasonable directory printed ; D O D I R ; ; input: @r5 wildcarded filespec ; 2(r5) channel to do the i/o on, 0 implies TI: ; ; output: r0 error code ; ; note: a value of zero will direct output to the terminal ; ; Unfortunately, RMS does not seem to return all the nice things ; like dates and sizes and protection. While I have written the ; same using FCS (CSI and .PARSE and qio's) for MINITAB and TED ; I would rather not have to do it that way since we are using ; RMS for everything else. dodir:: save ; save these just for kicks sub #140 ,sp ; allocate a buffer for filenames mov sp ,r2 ; and a pointer to the buffer clr -(sp) ; flag to get lookup to do a $parse mov sp ,r4 ; and point to it please mov @r5 ,r1 ; get the filespec address tstb @r1 ; anything passed at all ? bne 10$ ; yes mov #300$ ,r1 ; no, use *.*;* 10$: call 250$ ; print a header out please clr r3 ; filecount := 0 20$: calls lookup ,<#3,r1,r4,r2> ; do the $search via RMS11 now tst r0 ; did it work at all ? bne 90$ ; no, it failed call 200$ ; it worked, decide where to put it inc r3 ; filecount := succ( filecount ) br 20$ ; next please 90$: cmp r0 ,#ER$NMF ; no more files error ? bne 100$ ; no, just exit then tst r3 ; yes, did we ever find anything ? beq 95$ ; no, change error to ER$FNF clr r0 ; found at least one and we got br 100$ ; no more files error from RMS 95$: mov #ER$FNF ,r0 ; no files found 100$: tst (sp)+ add #140 ,sp ; pop resultant filename buffer unsave ; pop registers we used and exit return ; bye 200$: tst 2(r5) ; i/o to TI: or to a disk file ? bne 210$ ; disk print r2 ; terminal print #320$ ; cr/lf br 220$ ; exit 210$: strlen r2 ; to disk, get the string length calls putrec , ; simple 220$: return 250$: copyz #310$ ,r2 ; yes, copy a header over strlen r2 ; get the current length add r2 ,r0 ; point to the null in it calls fparse , ; build the filename string tst r0 ; did that work ok ? bne 260$ ; no, just exit then strlen r2 ; get the current length again add r2 ,r0 ; and point to the end again movb #cr ,(r0)+ ; and stuff a cr/lf/null movb #lf ,(r0)+ ; simple clrb @r0 ; ok call 200$ ; print it and exit 260$: return 300$: .asciz /*.*;*/ ; everything please 310$: .asciz /Directory of / ; a simple header 320$: .byte cr,lf,0 ; the lonely crlf .even .sbttl fix up error codes setcc:: return $mover: tstb 2(sp) bmi 10$ clr 2(sp) return 10$: neg 2(sp) return .sbttl rsxsys sys command for RSX11M/M+ ; 21-Aug-83 16:12:37 Brian Nelson ; 12-Jan-84 09:54:02 Created from MINITAB v82 source .enabl gbl .mcall spwn$s ,wtse$s ,r50$ runjob::mov #cli... ,r0 call rsxsys return runmcr::mov #mcr... ,r0 call rsxsys return rsxsys::save qiow$s #io.det,#lun.tt,#ef.tt,#50,#kbiost mov r0 ,r4 ; save the CLI we want to use sub #12*2 ,sp ; need eight word exit block BDN mov sp ,r2 ; Get address of exit block BDN clr @r2 ; to be safe ? mov 2(r5) ,r1 ; the command buffer address mov r1 ,r3 ; save it strlen r1 ; get the command string length add r0 ,r3 ; point to the end cmpb -(r3) ,#cr ; trailing carriage return ? bne 5$ ; no dec r0 ; yes, fix the length up 5$: mov r0 ,r3 ; save the length clr r0 ; assume no error please spwn$s r4,,,,,#6,,r2,r1,r3 ; do it bcc 10$ ; Ignore error for now moverr @#$DSW ,r0 ; get the error code please qiow$s #io.att,#lun.tt,#ef.tt,#50,#kbiost print #100$ br 20$ 10$: wtse$s #6 ; Wait for task to exit 20$: add #12*2 ,sp ; pop exit status block qiow$s #io.att,#lun.tt,#ef.tt,#50,#kbiost unsave ; pop registers and exit return 100$: .asciz <15><12>/Spawn failure for SYS command/<15><12> .even mcr...: r50$ MCR... cli...: r50$ CLI... .sbttl error message text syserp::save mov @r5 ,r0 call rmserp .print #200$ unsave return 200$: .byte cr,lf,0,0 syserr::save ; 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 direrr ,<#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 return global .end