MODULE HTRAN (LANGUAGE (BLISS32), IDENT = 'X0004') = BEGIN ! ! modification history: ! 13-jul-1981 wsk if logical name ends with a colon, remove it ! IDENT 2 ! 25-may-1982 wsk support for concealed devices ! IDENT 3 ! 27-dec-1983 wsk change way concealed devices work. use $trnlnm. ! established in the process directory table. ! IDENT 4 ! 19-jun-1984 wsk lnm$default_search changed to lnm$dcl_logical in call ! to $trnlnm ! 03-jan-1985 wsk add index optional parameter for search lists ! 03-Jan-1985 wsk treat a logical which is a search list as if it were ! concealed ! LIBRARY 'SYS$LIBRARY:STARLET'; MACRO MAK_PSECT(FILE) = PSECT GLOBAL = %NAME('$',FILE,'A$') (READ,WRITE,EXECUTE,NOSHARE,PIC,CONCATENATE, LOCAL,ALIGN(2),ADDRESSING_MODE(WORD_RELATIVE)); PSECT OWN = %NAME('$',FILE,'B$') (READ,WRITE,NOEXECUTE,NOSHARE,PIC,CONCATENATE, LOCAL,ALIGN(2),ADDRESSING_MODE(WORD_RELATIVE)); PSECT PLIT = %NAME('$',FILE,'C$') (READ,EXECUTE,SHARE,PIC,CONCATENATE, LOCAL,ALIGN(2),ADDRESSING_MODE(WORD_RELATIVE)); PSECT CODE = %NAME('$',FILE,'D$') (READ,NOWRITE,EXECUTE,SHARE,PIC,CONCATENATE, LOCAL,ALIGN(2),ADDRESSING_MODE(WORD_RELATIVE)); %; MAK_PSECT (HTRAN); MACRO RETURN_ON_ERROR (CALL) = BEGIN LOCAL STS; IF NOT (STS = CALL) THEN RETURN .STS; END%; MACRO DESC(STRING)= UPLIT(%CHARCOUNT(STRING),UPLIT BYTE(STRING))%; MACRO FNM(NAM)= FNA=UPLIT(%STRING(NAM)), FNS=%CHARCOUNT(NAM)%; LITERAL ESC = %X'1B', LOGNAM_SIZ = 64; GLOBAL ROUTINE TRAN_LOG (LOG_NAME_DESC,TRAN_NAME_DESC,CONCEALED_NAME,INDEX_PARAM) = ! ! this is a routine to translate logical names ! inputs: ! LOG_NAME_DESC ! descriptor describing the logical name ! TRAN_NAME_DESC ! descriptor describing the space allocated for the translated name ! CONCEALED_NAME ! descriptor describing the space allocated for the completely translated ! name...this is an optional parameter ! INDEX_PARAM ! as input is the index number to be used in the translation ! as output is the maximum index number for that logical name ! ! the name will be translated and the result passed back ! the translated name in tran_name_desc will honor concealed dev. ! the translated name in concealed_name will divulge that info ! status: ! result of the translation ! BEGIN OWN ATTRIBUTES : $BBLOCK[4], ORIGINAL_LEN, ORIGINAL_BUFFER : VECTOR [500,BYTE], SAVE_LEN, SAVE_BUFFER : VECTOR [500,BYTE], ITEM_LIST : VECTOR [24,WORD]; LOCAL LOCAL_INDEX, TMP, COLON_FLAG, HAD_COLON_FLAG, FLAG, L_NAME_DESC : VECTOR [2,LONG], FINAL_STATUS, STATUS; BIND INDEX = .INDEX_PARAM, TRANS_NAME = .TRAN_NAME_DESC : VECTOR [2,LONG], BUFFER = .TRANS_NAME[1] : VECTOR [500,BYTE], LOG_NAME = .LOG_NAME_DESC : VECTOR[2,LONG], ITEM_LIST_LONG = ITEM_LIST : VECTOR [12,LONG]; BUILTIN ACTUALCOUNT; L_NAME_DESC[0] = .LOG_NAME[0]; L_NAME_DESC[1] = .LOG_NAME[1]; CH$FILL (0,.SAVE_LEN,SAVE_BUFFER); CH$MOVE (.LOG_NAME[0],.LOG_NAME[1],ORIGINAL_BUFFER); ORIGINAL_LEN = .LOG_NAME[0]; HAD_COLON_FLAG = 0; ITEM_LIST[0] = .TRANS_NAME[0]; !size of item ITEM_LIST[1] = LNM$_STRING; !item type ITEM_LIST_LONG[1] = .TRANS_NAME[1]; !item address (item_list[2]) ITEM_LIST_LONG[2] = L_NAME_DESC; !return address size (item_list[4]) ! ITEM_LIST[6] = 4; !size of item ITEM_LIST[7] = LNM$_ATTRIBUTES; !item type ITEM_LIST_LONG[4] = ATTRIBUTES; !item address ITEM_LIST_LONG[5] = 0; ! ITEM_LIST[12] = 4; !size of item ITEM_LIST[13] = LNM$_MAX_INDEX; !item type ITEM_LIST_LONG[7] = LOCAL_INDEX; !item address ITEM_LIST_LONG[8] = 0; ITEM_LIST[18] = 4; !size of item ITEM_LIST[19] = LNM$_INDEX; !item type ITEM_LIST_LONG[10] = LOCAL_INDEX; !item address ITEM_LIST_LONG[11] = 0; ! ITEM_LIST_LONG[12] = 0; !end it all ! LOCAL_INDEX = 0; IF ACTUALCOUNT() GEQ 4 THEN LOCAL_INDEX = .INDEX; ! ! ! get translation ! FLAG = 1; DO BEGIN TMP = .L_NAME_DESC[1] + .L_NAME_DESC<0,16> - 1; COLON_FLAG = 0; IF .(.TMP)<0,8> EQL %C':' THEN COLON_FLAG = 1; ! STATUS = $TRNLOG (LOGNAM=L_NAME_DESC, ! RSLLEN=L_NAME_DESC, ! RSLBUF = TRANS_NAME); STATUS = $TRNLNM (LOGNAM=L_NAME_DESC, TABNAM=%ASCID'LNM$DCL_LOGICAL', ! TABNAM=%ASCID'SI$ALL_TABLES', ITMLST=ITEM_LIST); IF .STATUS EQL SS$_NOLOGNAM THEN STATUS = SS$_NOTRAN; IF .STATUS EQL SS$_NOTRAN THEN !trnlog moved input string BEGIN BIND X_DESC = L_NAME_DESC : VECTOR [4,WORD]; CH$MOVE(.X_DESC[0], !to output string in this case; .L_NAME_DESC[1], !trnlnm doesn't. do it ourselves. .TRANS_NAME[1]); END; IF .FLAG EQL 1 THEN FINAL_STATUS = .STATUS; FLAG = .FLAG + 1; L_NAME_DESC[1] = .TRANS_NAME[1]; IF (.BUFFER[0] EQLU ESC) AND (.BUFFER[1] EQLU 0) THEN BEGIN L_NAME_DESC[0] = .L_NAME_DESC[0] - 4; L_NAME_DESC[1] = .L_NAME_DESC[1] + 4; END; ! IF .BUFFER[0] NEQ %C'_' AND .BUFFER[1] NEQ %C'_' THEN IF (NOT .ATTRIBUTES [LNM$V_CONCEALED]) AND (.LOCAL_INDEX LEQ 0) THEN (CH$MOVE (.L_NAME_DESC[0],.L_NAME_DESC[1],SAVE_BUFFER); SAVE_LEN = .L_NAME_DESC[0]); IF .COLON_FLAG AND .STATUS EQLU SS$_NOTRAN THEN BEGIN L_NAME_DESC[0] = .L_NAME_DESC[0] - 1; STATUS = 1; COLON_FLAG = 0; HAD_COLON_FLAG = 1; END; END ! UNTIL NOT .STATUS OR (.STATUS EQLU SS$_NOTRAN) OR (.BUFFER[0] EQL %C'_'); UNTIL (NOT .STATUS ) OR (.STATUS EQLU SS$_NOTRAN) ! OR (.LOCAL_INDEX GTR 0) OR .ATTRIBUTES [LNM$V_CONCEALED]; TRANS_NAME[0] = .L_NAME_DESC[0]; IF .HAD_COLON_FLAG EQL 1 AND .STATUS EQLU SS$_NOTRAN THEN BEGIN TMP = .TRANS_NAME<0,16> + .TRANS_NAME[1]; IF .(.TMP)<0,8> EQL %C':' THEN TRANS_NAME[0] = .TRANS_NAME[0] + 1; END; IF ACTUALCOUNT() GEQ 3 THEN BEGIN BIND CONCEAL = .CONCEALED_NAME : VECTOR [2,LONG]; CH$MOVE (.TRANS_NAME[0],.TRANS_NAME[1],.CONCEAL[1]); CONCEAL[0] = .TRANS_NAME[0]; END; ! IF .BUFFER[0] EQL %C'_' AND .BUFFER[1] EQL %C'_' THEN IF .STATUS NEQ SS$_NOTRAN AND (.ATTRIBUTES [LNM$V_CONCEALED] OR .LOCAL_INDEX GTR 0) THEN BEGIN IF .SAVE_BUFFER[0] NEQ 0 THEN (CH$MOVE (.SAVE_LEN,SAVE_BUFFER,.TRANS_NAME[1]); TRANS_NAME[0] = .SAVE_LEN) ELSE BEGIN CH$MOVE (.ORIGINAL_LEN,ORIGINAL_BUFFER,.TRANS_NAME[1]); TRANS_NAME[0] = .LOG_NAME[0]; TMP = .TRANS_NAME<0,16> + .TRANS_NAME[1] - 1; IF .(.TMP)<0,8> NEQ %C':' THEN BEGIN TRANS_NAME[0] = .TRANS_NAME[0] + 1; TMP = .TMP + 1; (.TMP)<0,8> = %C':'; END; FINAL_STATUS = SS$_NOTRAN; END; END; IF ACTUALCOUNT() GEQ 4 THEN INDEX = .LOCAL_INDEX; RETURN .FINAL_STATUS; END; ! end of routine htran END ELUDOM