;+ ; ; File CNAME.MAC ; ;- .include /SY:[1,2]COMMON.MAC/ .title CNAME .ident /1.0.0/ .psect $CNAME ;+ ; ; Author: Paul F. Flaherty, Jr. ; DANIELS & CRONIN ; Three Center Plaza ; Penthouse Mezzanine ; Boston, Massachusetts 02108 USA ; (617) 227-5570 ; ; Date: June 29, 1987. ; ;- ;+ ; ; Program description ; ======= =========== ; ; This is a MACRO-11 subroutine written in conformance with the Digital ; Equipment Corporation document entitled "Writing MACRO Subroutines for ; RSTS/E DIBOL V5.1." It is used to change the program name of a running ; job, with .FSS used to load the FIRQB with the appropriate RAD-50 characters, ; and .NAME used to do the actual change. It is called from a DIBOL program in ; the format: ; ; | alpha record | ; XCALL CNAME (| alpha field |) ; | alpha literal | ; ; where the argument passed is the desired program name. ; ; Passing more or less than one argument will cause a fatal DIBOL error 6. ; Passing a null string will cause no change in the name. Only the first ; six characters of the passed argument are used. ; ;- ;+ ; ; Restrictions ; ============ ; ; Since we use .FSS to load the FIRQB, we cannot include things like ; dollar signs and periods in the name, e.g., a name like ...EDT won't ; work. The load of the FIRQB could, however, be recoded to handle such ; names. ; ;- ;+ ; ; N.B. The same functionality is available to DIBOL programs by using the ; Digital supplied (unsupported) subroutines FSS and EXEMT located in ; LB:UNSUPP.OLB in the form: ; ; | alpha record | ; XCALL FSS (| alpha field |,dfield) ; | alpha literal | ; ; XCALL EXEMT (dfield,104044) ; ; where the alpha argument is the desired program name, as above, dfield is ; a three character decimal field for the return of any possible error code, ; and 104044 is the Octal EMT for a .NAME directive. ; ;- ;+ ; ; Revision History ; ======== ======= ; ; When Who What ; ---------------------------------------------------------------------------- ; 29-June-1987 PFFJr Initial source ; 23-July-1987 PFFJr Added description of the use of XCALL FSS and ; XCALL EXEMT to achieve the same functionality ; ;- top9=177600 ;used to clear nine high order bits cname:: cmp (r4)+, #2 ;one argument? beq 10$ ;yes, continue trap 6.+200 ;no, trap to DIBOL with fatal error 6 10$: mov #2, r1 ;argument read only, for literals trap 0 ;pop it off the DIBOL stack cmp r0, #0 ;size gt 0? bgt 20$ ;yes, continue rts pc ;no, so just return to DIBOL 20$: clr r3 ;clear for use in 30$ mov r1, -(sp) ;save r1 cmp r0, #6 ;size le 6? blos 30$ ;yes, continue mov #6, r0 ;no, so make it 6 30$: inc r3 ;check for blanks (legal but useless) cmp r3, r0 ;beyond size of argument? bgt end ;yes, therefore it's all blanks movb (r1)+, r2 ;no, so check for space bic #top9, r2 ;clear all but 7 low order bits cmp r2, #40 ;is it a space? beq 30$ ;yes, check next mov (sp)+, r1 ;restore r1 (location pointer) mov #xrb, r3 ;now clear the xrb, first point to it 40$: clr (r3)+ ;clear a word cmp r3, #xrb+14 ;see if done blos 40$ ;not yet, try again mov r0, xrb+xrlen ;load string length into the xrb mov r0, xrb+xrbc ;ditto mov r1, xrb+xrloc ;load string location into the xrb mov #firqb, r0 ;now clear the firqb, first point to it 50$: clr (r0)+ ;clear a word cmp r0, #firqb+36 ;see if done blos 50$ ;not yet, try again .fss ;do the .fss (which loads the firqb) .name ;do the name change end: rts pc ;return to DIBOL .end