; .TITLE SDACT ; this is the module of action routines for the sd program ; revision: oct-31-1980 don't do cmexec to change disks if disks already match ; revision: jan-20-1981 fix problem with sd ^ when in top directory ; revision: jan-21-1981 fix problem with sd <% not stopping at a "y" ; revision: feb-5-1981 translate string before doing a sd "string" ; revision: feb-6-1981 ditto and add support for numbers representing dirs. ; revision: feb-9-1981 change db0:[utilities] to util: (logical name) ; and db0:[wendy.useful] ; revision: feb-16-1981 fix problem with show_default if the equivalence string ; for sys$disk includes a directory name ; revision: jun-25-1981 in set_default do tran_log instead of sys$trnlog - sys$disk ; used useful_dir in .library statement ; revision: jul-19-1981 in set_default if changing device but not directory ; still need to check for existence ; changed psects to match sd.mar ; changed defdir to sys$login ; Version 3 of VMS ; revision: jan-14-1982 changed references to rtl to be general addr. for v.3 ; revision: jan-16-1982 changed tstl (r1)+ to skip over . to tstb (r1)+ in ; go_to_string...this fixed problem with this example: ; sd [top]; sd [.t]; sd >>1; sd >b; where directory ; structure was [top.t.a] and [top.t.b]. ; revision: mar-10-1982 revision for ft2 of vms v3. on show_default when ; "putting colon back on", make sure it hasn't been ; overwritten. allow for logical names that include ; partial directory specifications also (show_default, ; set_default) ; revision: mar-23-1982 on set_default's $Open to check existence of the ; directory, all errors should be considered fatal ; not just the list i made up ; revision: mar-26-1982 on above change, then give actual error, not my msg ; revision: apr-7-1982 due to above change, numeric directories don't work ; fix them by converting n,m to xxxyyy in dir_to_rsa ; in addition, make code psect shareable ; revision: apr-8-1982 use lib$set_logical instead of $cmexec ; this will elimate need to install this with privilege ; revision: may-25-1982 support for concealed devices ; revision: jun-28-1982 add support for [-],etc. even i never knew we ; supported it before, it had fallen thru ; with the new tougher checks, it didn't fall ; thru anymore ; revision: sep-30-1982 add support for numeric directories, and still allow ; for numeric alternatives ; revision: jan-31-1983 add support for numeric directories, as ; pseudo-subdirectories of rooted directories ; revision: feb-10-1983 make size of dynamic resultant and expanded strings ; bigger (use nam$c_maxrss symbolic) instead of constant ; revision: mar-07-1983 get rid of util:su.com. set uic doesn't change ; the default directory anymore ; ; ; *********************************************************************** .LIBRARY /USEFUL_DIR:WENDY.MLB/ .LIBRARY /SYS$LIBRARY:LIB.MLB/ $PSLDEF $DSCDEF $JPIDEF $LBRDEF $LBRCTLTBL $NAMDEF .MACRO GET_DEF_DIR DESC MOVZWL #BUFFSZ,DESC MOVAL BUFFER,DESC+4 PUSHAL DESC PUSHAL DESC PUSHL #0 CALLS #3,@#SYS$SETDDIR CHECK .ENDM GET_DEF_DIR .MACRO GET_DEF_DIR1 DESC PUSHAL DESC PUSHAL DESC PUSHL #0 CALLS #3,@#SYS$SETDDIR CHECK .ENDM GET_DEF_DIR1 .MACRO SET_DEF_DIR DESC,?L PUSHL #0 PUSHL #0 PUSHAL DESC CALLS #3,@#SYS$SETDDIR BLBS R0,L PUSHAL BAD_DIR CALLS #1,G^LIB$PUT_OUTPUT RET L: .ENDM SET_DEF_DIR .MACRO CHECK BSBW CHECK .ENDM CHECK .MACRO ASK_IT YES_LABEL,NO_LABEL,STR BICL #REJECT_M_BIT,WRAP CLRQ NULL_DESC MOVB #DSC$K_CLASS_D,NULL_DESC+DSC$B_CLASS $FAO_S ASK,FAO_DESC,FAO_DESC,#STR LIB$GET_INPUT NULL_DESC,FAO_DESC MOVL #FAO_SIZE,FAO_DESC TSTL NULL_DESC+4 ;any response? BEQL NO_LABEL CMPB #^A/Y/,@NULL_DESC+4 ;is it ok? BEQL YES_LABEL ;if so, use it CMPB #^A/y/,@NULL_DESC+4 ;small y is ok too!! BEQL YES_LABEL BRB NO_LABEL .ENDM ASK_IT .MACRO LBR$INI_CONTROL LIBRARY_INDEX,FUNC PUSHAL FUNC PUSHAL LIBRARY_INDEX CALLS #2,G^LBR$INI_CONTROL .ENDM LBR$INI_CONTROL .MACRO LBR$OPEN LIBRARY_INDEX,FILE_NAME PUSHAL FILE_NAME PUSHAL LIBRARY_INDEX CALLS #2,G^LBR$OPEN .ENDM LBR$OPEN .MACRO LBR$GET_HELP INDEX,WIDTH=#0,ROUTINE=#0,DATA=#0,KEY,KEY1=#0 PUSHL KEY1 PUSHL KEY PUSHL DATA PUSHL ROUTINE PUSHL WIDTH PUSHAL LIBRARY_INDEX CALLS #6,G^LBR$GET_HELP .ENDM LBR$GET_HELP ; ; symbolic definitions ; PROMPT_BIT == 1 ASSUME PROMPT_BIT EQUAL 1 BUFFSZ = 256 DISK_SZ = 128 EXP_SIZ = NAM$C_MAXRSS FAO_SIZE = 200 NEW_SZ = 256 RES_SIZ = NAM$C_MAXRSS ; ; the data ; .PSECT SD_DATA RD,WRT,NOEXE,PIC FAB:: $FAB FNM=<*.DIR>,FOP=NAM,XAB=XAB XAB:: $XABPRO SAVE: .BLKB DISK_SZ PROMPT_MASK:: .LONG 0 WRAP: .LONG 0 ; two bits are defined for wrap ; the low bit which tells whether we should wrap around or not ; and is traded back and forth between go_to_all and go_to_next ; and the next bit which tells go_to_all if go_to_next got its ; suggestion rejected by the user WRAP_M_BIT = 1 WRAP_V_BIT = 0 ASSUME WRAP_M_BIT EQUAL 1 REJECT_M_BIT = 2 REJECT_V_BIT = 1 DISK:: .BLKB DISK_SZ ;this must be right before buffer BUFFER:: .BLKB BUFFSZ ASSUME BUFFER EQUAL DISK+DISK_SZ FAO_BUFF: .BLKB FAO_SIZE NEW_BUFFER:: .BLKB NEW_SZ RESULT: .BLKB RES_SIZ RESULT2: .BLKB RES_SIZ RESULT3: .BLKB RES_SIZ RESULT4: .BLKB RES_SIZ NUMERIC_DESC: .LONG 0,0 BUFF_DESC: .LONG BUFFSZ,BUFFER DISK_DESC: .LONG DISK_SZ,DISK DISK_DESC1: .LONG DISK_SZ,DISK NULL_DESC: .LONG 0,0 NEW_DESC:: .LONG NEW_SZ,NEW_BUFFER SAVE_DESC: .LONG DISK_SZ,SAVE DIR_DESC: .LONG 0,0 FAO_DESC: .LONG FAO_SIZE,FAO_BUFF RES_DESC: .LONG 0,0 STR_DESC: .LONG RES_SIZ,RESULT+1 CONCEAL_DESC: .LONG DISK_SZ,CONCEAL CONCEAL: .BLKB DISK_SZ DUMMY_DESC: .LONG DISK_SZ,DUMB DUMB: .BLKB DISK_SZ ASK: .ASCID $!AS (Y/N):$ BAD_LEVEL: .ASCID /Sorry - you cannot execute this command from a top-level directory/ BAD_DIR: .ASCID /Bad directory syntax/ DEF_DIR: .ASCID /SYS$LOGIN/ FAO_STR: .ASCID $ !AC!AS $ HEADER: .ASCID $Subdirectories for !AS !/ $ NO_DIR: .ASCID /No such directory exists/ NO_SET: .ASCID /Due to following error, your default directory was not changed/ NO_DOWN: .ASCID /Sorry -- you have no directories at that level/ NO_SUBDIR: .ASCID / No subdirectories/ SYS_DISK: .ASCID /SYS$DISK/ ;UIC_CMD: .ASCID /$@UTIL:SU !AS/ ;replaced 3/7/83 UIC_COMMAND: .ASCID /$SET UIC !AS/ ;with this dcl UIC_STR: .ASCID /UIC IS [!OW,!OW]/ UIC_DESC: .BLKL 2 ;added 3/7/83 UIC_BRACKET: .ASCII /[/ ;"" UIC_BUFFER: .BLKB 20 ;"" DDIR: .ASCII /.DIR/ ZEROS: .ASCII /000000/ ZEROZERO: .ASCII /[0,0]/ ZSIZE=.-ZEROZERO MSG_LEN = 132 MSG_BUFF: .LONG MSG_LEN,MSG MSG: .BLKB MSG_LEN EXP_SZ_ADDR: .LONG EXP_SIZ RES_SZ_ADDR: .LONG RES_SIZ NAMSZ: .LONG NAM$C_BLN PARAMETER:: .LONG 0 TABS: .BYTE 0 .ASCII / / JPI_LIST: .WORD 4 ;longword .WORD JPI$_GRP ;group part of uic .LONG GROUP ;addr of buffer .LONG 0 ;don't care about returned length .WORD 4 ;longword value .WORD JPI$_MEM ;member part of uic .LONG MEMBER ;addr of buffer .LONG 0 ;don't care about returned length GROUP: .LONG 0 ;member MUST follow group MEMBER: .LONG 0 PARTIAL_FLAG: .LONG 0 ;if set this is a partial dir ; ; data specifically for the help library ; LIBRARY_INDEX: .LONG 0 LIB_FUNC: .LONG LBR$C_READ LIB_NAME: .ASCID /SYS$HELP:HELPLIB.HLB/ KEY_DESC: .LONG 1,STAR STAR: .ASCII /*/ SD_DESC: .ASCID /SD/ ; ; the code ; .PSECT SD_CODE RD,NOWRT,EXE,PIC,SHR ; ; this is the action routine to handle "SD ." ; this routine sets the default back to the initial default ; directory of the user ; GO_BACK:: .WORD ^M PUSHAL BUFF_DESC PUSHAL DEF_DIR CALLS #2,TRAN_LOG CHECK MOVL BUFF_DESC+4,DISK_DESC+4 LOCC #^A/:/,DISK_DESC,@DISK_DESC+4 ;get size of disk part only SUBL2 R0,DISK_DESC INCL DISK_DESC PUSHAL DISK_DESC1 PUSHAL DISK_DESC CALLS #2,TRAN_LOG ;translate just the disk part CHECK ; ; don't want to do the cmexec to create the logical name if the disk ; is actually the same one ; so do a compare to check first to see if cmexec is necessary ; PUSHAL SAVE_DESC PUSHAL SYS_DISK CALLS #2,TRAN_LOG CHECK PUSHAL SAVE_DESC PUSHAL DISK_DESC1 CALLS #2,COMPARE_DISKS BLBS R0,20$ ; ; replace call to crelog with call to lib$set_logical ; PUSHAL DISK_DESC PUSHAL SYS_DISK CALLS #2,LIB$SET_LOGICAL CHECK 20$: LOCC #^A/:/,BUFF_DESC,@BUFF_DESC+4 ADDL3 #1,R1,BUFF_DESC+4 SUBL3 #1,R0,BUFF_DESC SET_DEF_DIR BUFF_DESC CALLS #0,SHOW_DEFAULT RET ; ; this is the action routine to handle "SD " ; it shows the current default disk and directory ; SHOW_DEFAULT:: .WORD ^M CLRL PARTIAL_FLAG MOVL #DISK_SZ,DISK_DESC MOVAL DISK,DISK_DESC+4 PUSHAL DISK_DESC PUSHAL SYS_DISK CALLS #2,TRAN_LOG CHECK ; ; see if the disk translate to "string": -- in which case we strip the ":" ; and translate again ; MOVZWL DISK_DESC,R0 ADDL2 DISK_DESC+4,R0 CMPB -(R0),#^A/:/ BNEQ 10$ MOVQ DISK_DESC,DISK_DESC1 DECW DISK_DESC1 ;get rid of ":" however MOVAL DISK,DISK_DESC+4 MOVZBL #DISK_SZ,DISK_DESC PUSHAL DISK_DESC PUSHAL DISK_DESC1 CALLS #2,TRAN_LOG CHECK CMPL R0,#SS$_NOTRAN BNEQ 10$ ; ; if no translation put colon back on, making sure it wasn't overwritten ; only if colon is not there 5-25-82 ; MOVZWL DISK_DESC,R0 ;3-10-82 ADDL2 DISK_DESC+4,R0 ;3-10-82 CMPB -(R0),#^A/:/ ;4-25-82 BEQL 10$ ;4-25-82 TSTB (R0)+ ;4-25-82 MOVB #^A/:/,(R0) ;3-10-82 INCW DISK_DESC ; ; see if we've done all we need to ; before vms3 we only needed to check the existence of a [ or ] ; now we need to see if that means we only have part of the directory ; 10$: LOCC #^A/]/,DISK_DESC,@DISK_DESC+4 BEQL 15$ CMPB -(R1),#^A/./ BNEQ 50$ ;if neq, got a complete directory DECW DISK_DESC ;remove last ] and append directory on MOVB #1,PARTIAL_FLAG ;mark as partial directory 15$: MOVZWL DISK_DESC,R0 ADDL3 DISK_DESC+4,R0,BUFF_DESC+4 MOVZWL #BUFFSZ,BUFF_DESC ; ; use alternate macro for descriptor which is already set up ; GET_DEF_DIR1 BUFF_DESC BLBC PARTIAL_FLAG,40$ ;3-10-82 MOVZWL BUFF_DESC,R0 ;if partial directory, get rid of MOVL BUFF_DESC+4,R1 ;unnecessary [ and move everything MOVC3 R0,1(R1),(R1) ;else up... DECW BUFF_DESC ;3-10-82 40$: ADDW2 BUFF_DESC,DISK_DESC 50$: LIB$PUT_OUTPUT DISK_DESC RET ; ; this is the action routine to handle "SD ;" ; it displays the current uic of the user ; SHOW_UIC:: .WORD ^M $GETJPI_S ITMLST=JPI_LIST CHECK $FAO_S UIC_STR,FAO_DESC,FAO_DESC,GROUP,MEMBER LIB$PUT_OUTPUT FAO_DESC MOVL #FAO_SIZE,FAO_DESC RET ; ; this is the action routine to handle "SD *" ; it displays all the subdirectories under this directory ; in a nicely formatted manner ; SHOW_ALL:: .WORD ^M GET_DEF_DIR BUFF_DESC $FAO_S HEADER,FAO_DESC,FAO_DESC,#BUFF_DESC LIB$PUT_OUTPUT FAO_DESC MOVL #FAO_SIZE,FAO_DESC BSBW SHOW_ALL1 RET SHOW_ALL1: BSBW GET_VM $PARSE FAB=FAB,ERR=REPORT_ERROR LOOP: $SEARCH FAB=FAB CMPL R0,#RMS$_NMF BNEQ 2$ 1$: BRW DONE 2$: CMPL R0,#RMS$_FNF BNEQ 5$ TSTL PARAMETER BNEQ 1$ LIB$PUT_OUTPUT NO_SUBDIR BRB 1$ 5$: BLBS R0,10$ MOVAL FAB,R10 BRW REPORT_ERR 10$: ; now display the directory name MOVAL RESULT,R10 BSBW RSA_TO_DIR MOVQ R7,DIR_DESC ;set up the descriptor MOVB PARAMETER,TABS $FAO_S FAO_STR,FAO_DESC,FAO_DESC,#TABS,#DIR_DESC LIB$PUT_OUTPUT FAO_DESC MOVL #FAO_SIZE,FAO_DESC ; ; recurse and try to do all subdirectories of this directory ; PUSHL FAB$L_NAM+FAB PUSHL FAB$L_DNA+FAB MOVZBL FAB$B_DNS+FAB,-(SP) MOVL R10,FAB$L_DNA+FAB SUBL2 R10,R8 ;get length of device part ADDB3 R8,DIR_DESC,FAB$B_DNS+FAB ;get total length of string into dns INCL PARAMETER BSBW SHOW_ALL1 DECL PARAMETER POPL R0 MOVB R0,FAB$B_DNS+FAB POPL FAB$L_DNA+FAB POPL FAB$L_NAM+FAB ; back to this directory ; BRW LOOP DONE: LIB$FREE_VM EXP_SZ_ADDR,NAM$L_ESA(R11) LIB$FREE_VM RES_SZ_ADDR,NAM$L_RSA(R11) LIB$FREE_VM NAMSZ,FAB+FAB$L_NAM RSB ; ; this is the action routine to handle "SD * {dev:}dir" ; see SHOW_ALL for a description ; SHOW_ALL_DIR:: .WORD ^M ; ; check for the brackets first and make sure they are there ; MOVQ TPA$L_STRINGCNT(AP),R10 CMPB (R11),#^A/ / ;leading space? BNEQ 5$ INCL R11 DECL R10 5$: LIB$GET_VM EXP_SZ_ADDR,FAB+FAB$L_DNA CHECK MOVL FAB+FAB$L_DNA,R9 LOCC #^A/:/,R10,(R11) ;any device? BEQL 10$ SUBL3 R0,R10,R2 ;get the len of the device INCL R2 PUSHL R11 ;need for movc3, but gets modified MOVQ R0,R10 ;update the ptrs past the dev DECL R10 INCL R11 MOVC3 R2,@(SP)+,(R9) ;move the device in MOVL R3,R9 10$: MOVB #^A/[/,(R9)+ ;move the [ in CMPB (R11),#^A/[/ ;was there already one? BNEQ 20$ INCL R11 DECL R10 ;if there was one, just skip it 20$: MOVC3 R10,(R11),(R9) ;move the rest of the string in CMPB -1(R3),#^A/]/ ;was there a ]? BEQL 30$ MOVB #^A/]/,(R3)+ ;if not, move it in 30$: SUBL2 FAB+FAB$L_DNA,R3 ;get the adjust length MOVB R3,FAB+FAB$B_DNS MOVL FAB+FAB$L_DNA,DIR_DESC+4 ;use dir_desc temporarily MOVZBL FAB+FAB$B_DNS,DIR_DESC $FAO_S HEADER,FAO_DESC,FAO_DESC,#DIR_DESC LIB$PUT_OUTPUT FAO_DESC MOVL #FAO_SIZE,FAO_DESC BSBW SHOW_ALL1 CLRL FAB+FAB$L_DNA CLRB FAB+FAB$B_DNS RET ; ; this is the same routine as go_to_all except that it also provides prompting ; the user can chose which directory to go to next ; the syntax for this is "SD <%" ; GO_TO_ALL_PMT:: .WORD ^M BISL #PROMPT_BIT,PROMPT_MASK CALLS #0,GO_TO_ALL RET ; ; this routine handles "SD <" ; it performs the function of stepping the user through all of the ; subdirectories of the main directory starting from the current ; default directory in the same order as "SHOW ALL" ; this order is: current directory first (already done) ; try to do a subdirectory if it exists ; if there are no subdirectories go across on the same level ; if the same level is exhausted go up one level and go across thru ; finally quit at the top level GO_TO_ALL:: .WORD ^M GET_DEF_DIR BUFF_DESC 20$: BSBW GET_VM $PARSE FAB=FAB,ERR=REPORT_ERROR $SEARCH FAB=FAB ;look for subdirectory CMPL R0,#RMS$_FNF ;are there any? BNEQ 30$ BRW 60$ 30$: ; ; found a subdirectory -- set the default to it ; MOVAL RESULT4,R10 BSBW RSA_TO_DIR MOVQ R7,BUFF_DESC BLBC PROMPT_MASK,40$ ;prompt indicated? ASK_IT YES_LABEL=40$,NO_LABEL=50$,STR=BUFF_DESC 40$: SET_DEF_DIR BUFF_DESC CALLS #0,SHOW_DEFAULT RET ; ; the caller rejected that subdirectory -- can we get more? ; 50$: MOVL BUFF_DESC+4,FAB+FAB$L_DNA MOVB BUFF_DESC,FAB+FAB$B_DNS BRW 20$ ; ; no subdirectories -- can we go across on the same level? ; 60$: MOVC3 BUFF_DESC,@BUFF_DESC+4,RESULT3 ;save context MOVL BUFF_DESC,RES_DESC ;save length too CALLS #0,GO_TO_NEXT1 BLBC WRAP,80$ ;did we go across already? ; ; if the user rejected that one, let's do it subdirectories and continue ; BBC #REJECT_V_BIT,WRAP,70$ MOVL BUFF_DESC+4,FAB+FAB$L_DNA MOVB BUFF_DESC,FAB+FAB$B_DNS BRW 20$ ; ; if go_to_next did all the work we're done and just return ; 70$: RET ; ; ran out of directories on this level -- let's go upwards again ; 80$: MOVL RES_DESC,BUFF_DESC ;restore string MOVC3 RES_DESC,RESULT3,@BUFF_DESC+4 ;ditto BSBW UP_ONE_SUB LOCC #^A/./,BUFF_DESC,@BUFF_DESC+4 ;are we at the top? BNEQ 60$ ;if we're not at the top, ;try to go across again ; ; last case -- we're back at the top -- just set the default to that ; BLBC PROMPT_MASK,100$ ;prompt indicated? ASK_IT YES_LABEL=100$,NO_LABEL=90$,STR=BUFF_DESC 90$: BRW 20$ ;dummy jump 100$: SET_DEF_DIR BUFF_DESC CALLS #0,SHOW_DEFAULT RET ; ; this routine is necessary for the exception case where tparse has ; already passed over the dot. so we must back up before the dot ; and then set the default. ; ; ; this is the action routine to handle "SD .dir" ; it sets the new default directory to current_dir.dir ; i.e., down one level to .dir ; SET_DEFAULT_DOT:: .WORD ^M INCL TPA$L_STRINGCNT(AP) DECL TPA$L_STRINGPTR(AP) BRW SET_DEFAULT1 RET ; ; this is the action routine to handle "SD {dev:}{dir}" ; it sets the new default to be {dev:}{dir} ; SET_DEFAULT:: .WORD ^M SET_DEFAULT1: ; ; get the current disk setting ; this has two reasons ; 1) so that on an error setting the directory we can set the disk back ; 2) so that we don't require cmexec priv to "change" disks ; if it isn't really being changed ; PUSHAL SAVE_DESC ;descriptor to store translation PUSHAL SYS_DISK ;descriptor of sys$disk CALLS #2,TRAN_LOG ; ; translate the string in case we're using a logical name ; PUSHAL STR_DESC ;descriptor for translation PUSHAL TPA$L_STRINGCNT(AP) ;actual string descriptor CALLS #2,TRAN_LOG AGAIN: MOVQ STR_DESC,R10 ;put it in registers LOCC #^A/:/,R10,(R11) ;separate the device and directory BNEQ 10$ BRW DID_DEVICE 10$: DECL R0 SUBL3 R0,R10,DISK_DESC MOVL R11,DISK_DESC+4 SUBL2 DISK_DESC,R10 ADDL2 DISK_DESC,R11 ; ; now translate just the disk -- in case that was also a logical nae ; PUSHAL DISK_DESC1 PUSHAL DISK_DESC CALLS #2,TRAN_LOG CMPL R0,#SS$_NOTRAN BNEQ 13$ ; ; see if the disk translate to "string": -- in which case we strip the ":" ; and translate again ; MOVZWL DISK_DESC,R0 ADDL2 DISK_DESC+4,R0 CMPB -(R0),#^A/:/ BEQL 15$ 13$: BRW OK 15$: MOVQ DISK_DESC,DISK_DESC1 DECW DISK_DESC1 ;get rid of ":" however MOVAL DISK,DISK_DESC+4 MOVZBL #DISK_SZ,DISK_DESC PUSHAL DISK_DESC PUSHAL DISK_DESC1 CALLS #2,TRAN_LOG CHECK MOVQ DISK_DESC,DISK_DESC1 ;real disk now descibed by this CMPL R0,#SS$_NOTRAN BEQL 20$ TSTL R10 BNEQ OK MOVQ DISK_DESC,STR_DESC BRW AGAIN ;got a new dev-dir string 20$: MOVZWL DISK_DESC1,R0 ;start of 5-27-82 ADDL2 DISK_DESC1+4,R0 CMPB -(R0),#^A/:/ BEQL OK TSTB (R0)+ CMPB (R0),#^A/:/ BNEQ OK ;end of 5-27-82 INCW DISK_DESC1 ;if no translation, put ":" back on OK: ; ; check to see if the disk logical name expanded to a partial directory ; if so, remove the partial directory from the disk and put it on the front ; of the directory part 3-10-82 ; MOVZWL DISK_DESC1,R0 ;start of 3-10-82 ADDL2 DISK_DESC1+4,R0 CMPB -(R0),#^A/]/ BNEQ DO_DEVICE CMPB -(R0),#^A/./ BNEQ DO_DEVICE MOVZWL DISK_DESC1,R0 LOCC #^A/:/,R0,@DISK_DESC1+4 DECL R0 ;don't count colon SUBL2 R0,DISK_DESC1 ;fix up disk descriptor MOVAB -1(R0),R0 ;don't count ] MOVAB 1(R1),R1 ;move past : SUBL2 R0,R11 ;set up to put in dir spec ADDL2 R0,R10 ;count it in INCL R11 ;2lines to account for overlap DECL R10 ;of [ in dir spec MOVC3 R0,(R1),(R11) ;end of 3-10-82 ; ; before doing the cmexec check to see if the new disk and old disk match ; if they do match, don't need to do the cmexec at all ; DO_DEVICE: PUSHAL SAVE_DESC PUSHAL DISK_DESC1 CALLS #2,COMPARE_DISKS BLBS R0,DID_DEVICE MOVQ DISK_DESC1,DISK_DESC ;crelog requires disk_desc ; ; replace call to crelog with call to lib$set_logical ; PUSHAL DISK_DESC PUSHAL SYS_DISK CALLS #2,LIB$SET_LOGICAL CHECK DID_DEVICE: TSTL R10 BNEQ 5$ ; ; if we're setting a device without a directory string, need to check ; to see if the old directory exists on the new device ; so let's get the default directory and proceed to check it out ; GET_DEF_DIR DIR_DESC BRW CHECK_EXISTENCE 5$: CMPB (R11),#^A/[/ BEQL GOT_BRACK MOVB #^A/[/,-(R11) INCL R10 GOT_BRACK: ADDL3 R11,R10,R1 CMPB -1(R1),#^A/]/ BEQL GOT_BRACK1 MOVB #^A/]/,(R1) INCL R10 GOT_BRACK1: MOVQ R10,DIR_DESC ;fill the whole descriptor CHECK_EXISTENCE: ; ; check to see if the directory exists before you do anything ; if the directory doesn't exist, set the device back to where it was before ; if this is a [-] we're changing to, don't do any further checking. ; let rms do the rest ; CMPB 1(R11),#^A/-/ ;6/28/82 BNEQ 5$ ;6/28/82 BRW SET ;6/28/82 5$: BSBW DIR_TO_RSA $OPEN FAB=FAB ; ; 3/23/82 any error from the open should be fatal ; BLBS R0,SET ;aded 3/23/82 CMPL R0,#RMS$_FNF BEQL 10$ CMPL R0,#RMS$_DNF BEQL 10$ BRB 20$ 10$: LIB$PUT_OUTPUT NO_DIR BRB 30$ 20$: $GETMSG_S MSGID=R0,MSGLEN=MSG_BUFF,BUFADR=MSG_BUFF LIB$PUT_OUTPUT NO_SET LIB$PUT_OUTPUT MSG_BUFF ;print the message 30$: MOVQ SAVE_DESC,DISK_DESC ;for the call ; ; replace call to crelog with call to lib$set_logical ; PUSHAL DISK_DESC PUSHAL SYS_DISK CALLS #2,LIB$SET_LOGICAL BRB SHOW SET: SET_DEF_DIR DIR_DESC SHOW: CALLS #0,SHOW_DEFAULT RET ; ; this routine runs in exec mode because it needs to be in supervisor ; mode...to create a logical name for sys$disk it is necessary to be ; in the same (or higher) mode than its current logical name. DCL runs ; in supervisor mode so we must too. Unfortunately there is no Change Mode ; to Supervisor so we must CMEXEC ; ; replace this routine with calls to lib$set_logical -- 4/7/82 (v3 of vms) ; ;CRELOG: ; .WORD 0 ; $CRELOG_S TBLFLG=#2,LOGNAM=SYS_DISK,EQLNAM=DISK_DESC,- ; ACMODE=#PSL$C_SUPER ; RET ; ; this is the action routine to handle "SD ^^" ; it sets the default to be the top level directory of the ; current directory ; UP_TO_TOP:: .WORD ^M GET_DEF_DIR BUFF_DESC LOCC #^A/./,BUFF_DESC,@BUFF_DESC+4 MOVB #^A/]/,(R1) DECL R0 SUBL2 R0,BUFF_DESC SET_DEF_DIR BUFF_DESC CALLS #0,SHOW_DEFAULT RET ; ; this is the action routine to handle "SD ^" ; it sets the default up one level ; UP_ONE:: .WORD ^M GET_DEF_DIR BUFF_DESC BSBW UP_ONE_SUB ;do all the work SET_DEF_DIR BUFF_DESC CALLS #0,SHOW_DEFAULT RET ; ; this is the routine that does all the work for UP_ONE ; separated it out so that other routines could use it also to go up one ; UP_ONE_SUB: MOVL BUFF_DESC+4,R1 MOVZWL BUFF_DESC,R0 LOCC #^A/./,R0,(R1) BEQL 50$ ;if first time and no . then just get out 10$: MOVQ R0,R6 ;move r0 and r1 in 1 instruction INCL R1 DECL R0 ;move past the current . LOCC #^A/./,R0,(R1) BNEQ 10$ 20$: MOVB #^A/]/,(R7) DECL R6 SUBL2 R6,BUFF_DESC 50$: RSB ; ; this is the action routine to handle "SD >dir" ; it goes across to dir on the same level as the current ; GO_TO_STRING:: .WORD ^M GET_DEF_DIR BUFF_DESC MOVL BUFF_DESC+4,R1 MOVZWL BUFF_DESC,R0 CLRQ R7 10$: LOCC #^A/./,R0,(R1) BEQL 20$ MOVQ R0,R6 ;move r0 and r1 in 1 instruction TSTB (R1)+ ;move past the current . DECL R0 ;ditto BRB 10$ 20$: TSTL R7 ;top-level directory? BNEQ 30$ BRW B_L 30$: INCL R7 MOVC3 TPA$L_TOKENCNT(AP),@TPA$L_TOKENPTR(AP),(R7) MOVB #^A/]/,(R3) SUBL3 BUFF_DESC+4,R3,BUFF_DESC ;get the new length INCL BUFF_DESC ; see if the directory exists before going to it ; MOVQ BUFF_DESC,DIR_DESC ;for the call BSBW DIR_TO_RSA $OPEN FAB=FAB CMPL R0,#RMS$_FNF BNEQ 15$ 5$: LIB$PUT_OUTPUT NO_DIR BRB 25$ 15$: CMPL R0,#RMS$_DNF BEQL 5$ SET_DEF_DIR BUFF_DESC 25$: CALLS #0,SHOW_DEFAULT RET B_L: LIB$PUT_OUTPUT BAD_LEVEL ;issue error message RET ; ; this is the action routine to handle "SD >%" ; it goes across on the same level, prompting the user and ; accepting whichever directory on this level that the user wants ; GO_TO_NEXT_PROMPT:: .WORD ^M BISL #PROMPT_BIT,PROMPT_MASK CALLS #0,GO_TO_NEXT RET ; ; this is the entry point to avoid the get_def_dir for internal routines ; GO_TO_NEXT1: .WORD ^M ; ; wrap is used by go_to_all to signal that it doesn't want to wrap around ; by setting the low bit ; then go_to_next will clear the same bit if it was not able to find a dir ; BISL #WRAP_M_BIT,WRAP ;double semaphore BRB GO_TO_NEXT2 ;automatically returns ; ; this is the action routine to handle "SD >>" ; it goes across on the same level to the next directory ; GO_TO_NEXT:: .WORD ^M GET_DEF_DIR BUFF_DESC GO_TO_NEXT2: MOVL BUFF_DESC+4,R1 MOVZWL BUFF_DESC,R0 CLRQ R7 10$: LOCC #^A/./,R0,(R1) BEQL 20$ MOVQ R0,R6 ;move r0 and r1 in 1 instruction INCL R1 DECL R0 ;move past the current . BRB 10$ 20$: ; ; store the "current" default in result ; and manufacture in place a wildcard spec (that goes in the dnm of the fab) ; TSTL R7 ;top-level dir? BEQL B_L ;if so, report error MOVC3 BUFF_DESC,@BUFF_DESC+4,RESULT ;store it for compares MOVL BUFF_DESC,R9 ;ditto MOVB #^A/]/,(R7) SUBL3 BUFF_DESC+4,R7,BUFF_DESC ;GET new length INCL BUFF_DESC ; ; now do the search for the next one ; MOVB BUFF_DESC,FAB+FAB$B_DNS ;set up dnm for the search MOVL BUFF_DESC+4,FAB+FAB$L_DNA BSBW GET_VM $PARSE FAB=FAB,ERR=REPORT_ERROR LOOP1: $SEARCH FAB=FAB CMPL R0,#RMS$_NMF ;handle the wrap-around BNEQ 35$ BLBS WRAP,30$ ;to wrap or not to wrap? $PARSE FAB=FAB,ERR=REPORT_ERROR ;force a new start $SEARCH FAB=FAB,ERR=REPORT_ERROR BRB 35$ ;wrap around this time 30$: BICL #WRAP_M_BIT,WRAP ;signal the end of the line RET 35$: BLBS R0,40$ MOVAL FAB,R10 BRW REPORT_ERR 40$: MOVAL RESULT2,R10 BSBW RSA_TO_DIR CMPC3 R9,(R8),RESULT BEQL 45$ BRW LOOP1 45$: $SEARCH FAB=FAB ;got a match, get the next one CMPL R0,#RMS$_NMF ;handle the wrap-around BNEQ 50$ BLBS WRAP,48$ ;do we want to wrap $PARSE FAB=FAB,ERR=REPORT_ERROR ;force a new start $SEARCH FAB=FAB,ERR=REPORT_ERROR BRB 50$ ;did the wrap 48$: BICL #WRAP_M_BIT,WRAP ;didn't want to wrap, signal end RET 50$: MOVAL RESULT2,R10 BSBW RSA_TO_DIR MOVQ R7,BUFF_DESC ;set up len and adddr in desc. BLBS PROMPT_MASK,55$ ;prompt indicated? BRW 70$ 55$: ASK_IT YES_LABEL=70$,NO_LABEL=60$,STR=BUFF_DESC 60$: BLBC WRAP,65$ ;is this a call from go_to_all? BISL #REJECT_M_BIT,WRAP ;signal rejected RET ;and return 65$: BRW 45$ ;if not, go on to next 70$: SET_DEF_DIR BUFF_DESC CALLS #0,SHOW_DEFAULT LIB$FREE_VM EXP_SZ_ADDR,NAM$L_ESA(R11) LIB$FREE_VM RES_SZ_ADDR,NAM$L_RSA(R11) LIB$FREE_VM NAMSZ,FAB+FAB$L_NAM RET ; ; this is the action routine to handle "SD >>%" ; it goes down one level and then prompts the user on that new ; level. it accepts which directory the user wants on the new level ; DOWN_ONE_PROMPT:: .WORD ^M BISL #PROMPT_BIT,PROMPT_MASK CALLS #0,DOWN_ONE RET ; ; this is the action routine to handle "SD >>1" ; it goes down one level and sets the default to the first available ; subdirectory at the new level ; DOWN_ONE:: .WORD ^M GET_DEF_DIR BUFF_DESC BSBW GET_VM MOVB BUFF_DESC,FAB+FAB$B_DNS MOVL BUFF_DESC+4,FAB+FAB$L_DNA $PARSE FAB=FAB,ERR=REPORT_ERROR $SEARCH FAB=FAB CMPL #RMS$_FNF,R0 BNEQ 20$ LIB$PUT_OUTPUT NO_DOWN RET 20$: BLBS R0,30$ MOVAL FAB,R10 BRW REPORT_ERR RET 30$: MOVAL RESULT2,R10 BSBW RSA_TO_DIR MOVQ R7,BUFF_DESC ;r7 and r8 (len and addr) SET_DEF_DIR BUFF_DESC BLBC PROMPT_MASK,40$ ;prompt indicated? ASK_IT YES_LABEL=40$,NO_LABEL=50$,STR=BUFF_DESC 40$: CALLS #0,SHOW_DEFAULT RET 50$: CALLS #0,GO_TO_NEXT RET ; ; this is a routine to issue help for sd ; HELP:: .WORD ^M LBR$INI_CONTROL LIBRARY_INDEX,LIB_FUNC CHECK LBR$OPEN LIBRARY_INDEX,LIB_NAME CHECK TSTL TPA$L_STRINGCNT(AP) ;any key specified? BEQL 10$ ;if not, use the * MOVQ TPA$L_STRINGCNT(AP),KEY_DESC 1$: CMPB @KEY_DESC+4,#^A/ / ;is there a blank? BNEQ 5$ INCL KEY_DESC+4 ;move past the blank DECL KEY_DESC BRB 1$ 5$: LBR$GET_HELP INDEX=LIBRARY_INDEX,KEY=#SD_DESC,KEY1=#KEY_DESC BRB 20$ 10$: LBR$GET_HELP INDEX=LIBRARY_INDEX,KEY=#SD_DESC ;,KEY1=#KEY_DESC 20$: CHECK RET ; ; this is the action routine to handle setting the uic ; it does it by executing a "set uic" dcl command upon exiting the program ; setting the uic does require kernel privilege ; SET_UIC:: .WORD ^M MOVAL TPA$L_STRINGCNT(AP),R0 ; ; make sure the string has brackets around it ; added 3/7/83 to get rid of util:su.com dependency ; MOVAL UIC_BUFFER,UIC_DESC+4 ;address of new string MOVL 4(R0),R1 ;address of old string MOVZWL (R0),R0 ;length of old string MOVL R0,UIC_DESC ;move into new desc MOVC3 R0,(R1),UIC_BUFFER ;store the string CMPB UIC_BUFFER,#^A/[/ ;begin with bracket? BEQL 50$ MOVAL UIC_BUFFER-1,UIC_DESC+4 ;if there isn't one, add it INCL UIC_DESC 50$: ADDL3 UIC_DESC,UIC_DESC+4,R0 ;end with bracket? CMPB -1(R0),#^A/]/ BEQL 100$ MOVB #^A/]/,(R0) ;if there isn't one, add it INCL UIC_DESC 100$: MOVAL UIC_DESC,R0 SET_U_1: ;alternate entry for set_to_current $FAO_S UIC_COMMAND,FAO_DESC,FAO_DESC,R0 ;construct the command line PUSHAL FAO_DESC CALLS #1,G^LIB$DO_COMMAND ;execute it RET ; ; this is the action routine that handles "SD ;;" ; it sets the users uic to that of the current directory ; obviously, this will only succeed if the user has the appropriate privilege ; SET_TO_CURRENT:: .WORD ^M ; get the uic of the current directory GET_DEF_DIR DIR_DESC BSBW DIR_TO_RSA $OPEN FAB=FAB,ERR=REPORT_ERROR $CLOSE FAB=FAB ;don't need this anymore ; convert the uic of the current directory to ascii and then use it MOVAL RESULT,R6 MOVB #^A/[/,(R6)+ MOVL #3,DIR_DESC MOVL R6,DIR_DESC+4 ;use dir_desc PUSHL #2 ;size of the input PUSHL #3 ;desired minimum for the out PUSHAL DIR_DESC ;desc of output PUSHAL XAB+XAB$W_GRP ;addr of input CALLS #4,G^OTS$CVT_L_TO CHECK ADDL2 #3,R6 MOVB #^A/,/,(R6)+ MOVL #3,DIR_DESC MOVL R6,DIR_DESC+4 ;use dir_desc temporarily PUSHL #2 ;size of input (bytes) PUSHL #3 ;descired minimum for the out PUSHAL DIR_DESC ;des of output PUSHAL XAB+XAB$W_MBM ;addr of input CALLS #4,G^OTS$CVT_L_TO CHECK ADDL2 #3,R6 MOVB #^A/]/,(R6)+ MOVAL RESULT,DIR_DESC+4 ;use dir_desc again SUBL3 #RESULT,R6,DIR_DESC MOVAL DIR_DESC,R0 BRW SET_U_1 ; ; this is a subroutine to change a string of the format ; "_db1:[xxxx]yyy.dir;1" to ; a string of the format [xxxx.yyy] ; ; input: R10 points to the buffer in which the modified string ; will be stored ; it destroys r0-r8 ; it ends with r8 pointing to the beginning of the string (after the device) ; and r7 is the length of the string ; RSA_TO_DIR: MOVL FAB+FAB$L_NAM,R6 MOVL NAM$L_RSA(R6),R8 MOVZBL NAM$B_RSL(R6),R7 MOVC3 R7,(R8),(R10) LOCC #^A/:/,R7,(R10) ;skip over device ADDL3 #1,R1,R8 ;get starting addr of string LOCC #^A/]/,R7,(R8) MOVB #^A/./,(R1) INCL R1 LOCC #^A/./,R0,(R1) MOVB #^A/]/,(R1) SUBL3 R8,R1,R7 ;get length of string INCL R7 ;really now!!! RSB ; ; this is a subroutine to check out errors that are returned ; in R0. if there is an error, it signals it and aborts ; if there isn't an error, it returns and the program continues ; CHECK: BLBS R0,10$ PUSHL R0 CALLS #1,G^LIB$SIGNAL RET 10$: RSB ; ; this routine gets the namblk, the expanded string space and the ; resultant string space dynamically ; this is especially necessary for the recursive routines ; but is also useful in general ; GET_VM: LIB$GET_VM NAMSZ,FAB+FAB$L_NAM CHECK MOVL FAB$L_NAM+FAB,R11 MOVB #NAM$C_BID,NAM$B_BID(R11) MOVB #NAM$C_BLN,NAM$B_BLN(R11) LIB$GET_VM EXP_SZ_ADDR,NAM$L_ESA(R11) CHECK LIB$GET_VM RES_SZ_ADDR,NAM$L_RSA(R11) CHECK MOVB #EXP_SIZ,NAM$B_ESS(R11) MOVB #RES_SIZ,NAM$B_RSS(R11) RSB ; ; this is a subroutine to take specs of the forms ; [xxx] or [.xxx] or [xxx.yyy] or [xxx.yyy.zzz] and turn them into ; [0,0]xxx.dir or xxx.dir or [xxx]yyy.dir or [xxx.yyy]zzz.dir respectively ; for the purpose of being able to look up the directory file each directory ; represents ; revised: 7-apr-1982 to change numeric directories n,m to xxxyyy types ; revised: 26-may-1982 to support rooted directories ; inputs: ; dir_desc is the descriptor of the input spec ; implicit input: ; sys$disk logical name is the "new" default disk ; outputs: ; fna,fns in the fab filled in with the directory name ; dna,dns in the fab filled in with the device if partial directory ; buffer is acquired dynamically DIR_TO_RSA: ; ; check to see if the disk logical name expanded to a partial directory ; if so, remove the partial directory from the disk and put it on the front ; of the directory part 5-26-82 ; MOVQ DIR_DESC,R10 ;now r10 is size, r11 is addr PUSHAL CONCEAL_DESC ;start of 5-26-82 PUSHAL DUMMY_DESC PUSHAL SYS_DISK CALLS #3,TRAN_LOG MOVZWL CONCEAL_DESC,R0 ADDL2 CONCEAL_DESC+4,R0 CMPB -(R0),#^A/]/ BNEQ NOT_PARTIAL CMPB -(R0),#^A/./ BNEQ NOT_PARTIAL CMPB 1(R11),#^A/./ ;only want to do this if not BEQL NOT_PARTIAL ;subdirectory setting MOVZWL DIR_DESC,R10 MOVC3 R10,@DIR_DESC+4,@DUMMY_DESC+4 MOVL DUMMY_DESC+4,R11 MOVZWL CONCEAL_DESC,R0 LOCC #^A/:/,R0,@CONCEAL_DESC+4 DECL R0 ;don't count colon SUBL2 R0,CONCEAL_DESC ;fix up disk descriptor MOVL CONCEAL_DESC+4,FAB+FAB$L_DNA ;set up default device correctly MOVB CONCEAL_DESC,FAB+FAB$B_DNS ;ditto MOVAB -1(R0),R0 ;don't count ] MOVAB 1(R1),R1 ;move past : SUBL2 R0,R11 ;set up to put in dir spec ADDL2 R0,R10 ;count it in INCL R11 ;2lines to account for overlap DECL R10 ;of [ in dir spec MOVC3 R0,(R1),(R11) NOT_PARTIAL: ;end of 5-26-82 ; ; r10,r11 now point to the directory specification ; PUSHL R9 ;get memory, store addr in r9 PUSHAL EXP_SZ_ADDR ;a little big, but who cares? CALLS #2,G^LIB$GET_VM ;go get memory CHECK MOVL R9,FAB+FAB$L_FNA ;store addr in fna MOVL R9,R8 ;and in r8 LOCC #^A/./,R10,(R11) ;which kind is this? BEQL 100$ ;do we need to look in mfd BRW SDIR ;no, this is a subdirectory 100$: ; this is the case where we are changing [xxx] to [0,0]xxx.dir ; MOVC3 #ZSIZE,ZEROZERO,(R9) ;move [0,0] in MOVL R3,R9 ;update r9 past it INCL R11 ;move r11 past "[" LOCC #^A/,/,R10,(R11) BNEQ NUMERIC ;if comma present, numeric dir LOCC #^A/]/,R10,(R11) ;isolate the xxx SUBL2 R11,R1 MOVC3 R1,(R11),(R9) ;move in the xxx MOVL DDIR,(R3)+ ;move in the .dir SUBL3 FAB+FAB$L_FNA,R3,R0 ;get the new length MOVB R0,FAB+FAB$B_FNS ;and set the fns RSB ; ; this is the case of changing [n,m] to [xxxyyy] ; NUMERIC: MOVQ R0,R6 ;save rest of string desc SUBL3 R11,R1,R4 ;number of digits in "n" MOVL ZEROS,(R3) ;move in four zeros MOVW ZEROS,4(R3) ;move in two zeros SUBL3 R4,#3,R0 ;number of zeros to skip over ADDL2 R0,R3 ;skip them MOVC3 R4,(R11),(R3) ;taken care of "xxx" INCL R7 ;skip over "," DECL R6 ;ditto LOCC #^A/]/,R6,(R7) ;find end of directory SUBL3 R7,R1,R4 ;number of digits in "m" SUBL3 R4,#3,R0 ;number of zeros to skip over ADDL2 R0,R3 ;skip them MOVC3 R4,(R7),(R3) ;move in "m" MOVL DDIR,(R3)+ ;move in ".dir" SUBL3 FAB+FAB$L_FNA,R3,R0 ;get the new length MOVB R0,FAB+FAB$B_FNS ;and set the fns RSB ; ; these are the cases when we have subdirectories ; and we want to look up the directory file in a user structure ; SDIR: CMPB 1(R11),#^A/./ ;is this the [.xxx] case? BNEQ 10$ MOVW (R11)+,(R8)+ ;move the [. to the output str BRB 15$ 10$: MOVB (R11)+,(R8)+ ;move the [ to the output str 15$: LOCC #^A/./,R10,(R11) ;any more dots? BNEQ MORE_DOTS MOVL R9,R8 ;don't want the [ or [. that ;already moved to the output str LOCC #^A/]/,R10,(R11) ;locate the xxx SUBL2 R11,R1 MOVC3 R1,(R11),(R8) ;move in xxx MOVL DDIR,(R3)+ ;move in .dir FINISH: SUBL3 FAB+FAB$L_FNA,R3,R0 MOVB R0,FAB+FAB$B_FNS ;store the new len in fns RSB ;and return ; this is the general case of [.xxx.yyy...] ; MORE_DOTS: MOVQ R10,R0 ; ; loop looking for the last . in the string ; 10$: LOCC #^A/./,R0,(R1) BEQL 20$ MOVQ R0,R6 INCL R1 DECL R0 BRB 10$ 20$: SUBL3 R6,R10,R7 ;get length of .xxx.yyy, etc. MOVC3 R7,(R11),(R8) ;move it in MOVB #^A/]/,(R3)+ ADDL2 R7,R11 ;get the name of the dir now CMPB (R11),#^A/./ BNEQ 40$ INCL R11 ;skip over any dot 40$: LOCC #^A/]/,R10,(R11) SUBL2 R0,R10 ; ; added 1/31/83 to handle numeric directories as subdirectories of rooted dirs ; a numeric directory can't have subdirectories, so if we have a numeric ; directory in this specification, it is at the bottom level ; so if we do have a numeric directory here, convert it to its real format ; MOVL R3,-(SP) ;save around locc's 1/31/83 LOCC #^A/,/,R10,(R11) ;is this a numeric directory? BEQL 50$ ;if equal, it isn't ; ; convert n,m to xxxyyy even if it is a subdirectory ; MOVL (SP)+,R3 ;restore r3 BRW NUMERIC ;join common numeric code 50$: MOVL (SP)+,R3 ;end of 1/31/83 MOVC3 R10,(R11),(R3) MOVL DDIR,(R3)+ ;move .dir in BRB FINISH ; *************************************************************************** ; ; set_numeric ; this routine takes a numeric directory and lets us set default to it ; ; *************************************************************************** SET_NUMERIC:: .WORD ^M MOVL NUMERIC_DESC+4,TPA$L_STRINGPTR(AP) ;beginning of string ; ; the length of the string is equal to the length of the current token, ; plus the length of the previous token, plus the length of the comma (1) ; ADDL3 TPA$L_TOKENCNT(AP),NUMERIC_DESC,TPA$L_STRINGCNT(AP) INCL TPA$L_STRINGCNT(AP) ;add in comma BRW SET_DEFAULT1 ;set the default ; ; routine to save the location of the first part of the token ; SAVE_NUMBER:: .WORD 0 MOVQ TPA$L_TOKENCNT(AP),NUMERIC_DESC RET .END