MODULE SDNUMBS (LANGUAGE (BLISS32), IDENT = 'X0001') = BEGIN ! ! revision history: ! 19-jul-1981 wsk changed defdir to sys$login ! 14-jan-1982 wsk changed addressing modes to LONG_relative ! LIBRARY 'SYS$LIBRARY:STARLET'; MACRO MAK_PSECT(FILE) = PSECT GLOBAL = %NAME('$',FILE,'A$') (READ,WRITE,EXECUTE,NOSHARE,PIC,CONCATENATE, LOCAL,ALIGN(2),ADDRESSING_MODE(LONG_RELATIVE)); PSECT OWN = %NAME('$',FILE,'B$') (READ,WRITE,NOEXECUTE,NOSHARE,PIC,CONCATENATE, LOCAL,ALIGN(2),ADDRESSING_MODE(LONG_RELATIVE)); PSECT PLIT = %NAME('$',FILE,'C$') (READ,EXECUTE,SHARE,PIC,CONCATENATE, LOCAL,ALIGN(2),ADDRESSING_MODE(LONG_RELATIVE)); PSECT CODE = %NAME('$',FILE,'D$') (READ,NOWRITE,EXECUTE,SHARE,PIC,CONCATENATE, LOCAL,ALIGN(2),ADDRESSING_MODE(LONG_RELATIVE)); %; MAK_PSECT (SDNUMBS); MACRO DESC(STRING)= UPLIT(%CHARCOUNT(STRING),UPLIT BYTE(STRING))%; MACRO FNM(NAM)= FNA=UPLIT(%STRING(NAM)), FNS=%CHARCOUNT(NAM)%; LITERAL FAO_SIZE = 120, MAX_RECORD = 80; OWN FILE_FAB: $FAB (FNM('SYS$LOGIN:SDXXX.DAT'),RFM=FIX, ORG=REL,RAT=CR,MRS=MAX_RECORD), FILE_RAB: $RAB (FAB=FILE_FAB), DESCRIPTOR: BLOCK [8,BYTE], FILE_BUFFER: VECTOR [MAX_RECORD,BYTE], RECORD_DESC: VECTOR [2,LONG] INITIAL (MAX_RECORD,FILE_BUFFER), FAO_BUFFER: VECTOR [FAO_SIZE,BYTE], FAO_BUFF: VECTOR [2,LONG] INITIAL (FAO_SIZE,FAO_BUFFER); LINKAGE ERR = JSB (REGISTER=10); EXTERNAL ROUTINE SET_DEFAULT, REPORT_ERR : ERR, REPORT_ERROR, LIB$PUT_OUTPUT : ADDRESSING_MODE(GENERAL), LIB$GET_INPUT : ADDRESSING_MODE(GENERAL); ! ! this is the routine to add device-directory specifications to the database ! GLOBAL ROUTINE SET_UP_NUMBERS = BEGIN FILE_FAB [FAB$V_CIF] = 1; FILE_FAB [FAB$B_FAC] = FAB$M_PUT OR FAB$M_GET; $CREATE (FAB=FILE_FAB,ERR=REPORT_ERROR); $CONNECT (RAB=FILE_RAB,ERR=REPORT_ERROR); ! ! have to use this crummy way of getting to the eof ! FILE_RAB [RAB$W_USZ] = MAX_RECORD; FILE_RAB [RAB$L_UBF] = FILE_BUFFER; WHILE 1 DO BEGIN LOCAL RMS_STATUS; RMS_STATUS = $GET (RAB=FILE_RAB); IF .RMS_STATUS EQL RMS$_EOF THEN EXITLOOP; IF NOT .RMS_STATUS THEN REPORT_ERR (FILE_RAB); END; FILE_RAB [RAB$W_RSZ] = MAX_RECORD; FILE_RAB [RAB$L_RBF] = FILE_BUFFER; WHILE 1 DO BEGIN DESCRIPTOR = 0; DESCRIPTOR+4 = 0; DESCRIPTOR [DSC$B_CLASS] = DSC$K_CLASS_D; LIB$GET_INPUT (DESCRIPTOR, DESC ('Input Device-Directory String:')); IF .DESCRIPTOR [DSC$W_LENGTH] EQL 0 THEN EXITLOOP; CH$MOVE (.DESCRIPTOR [DSC$W_LENGTH], .DESCRIPTOR [DSC$A_POINTER], FILE_BUFFER); $PUT (RAB=FILE_RAB,ERR=REPORT_ERROR); CH$FILL (0,MAX_RECORD,FILE_BUFFER); END; $CLOSE (FAB=FILE_FAB,ERR=REPORT_ERROR); RETURN 1 END; ! end of global routine set_up_numbers ! ! this is the routine to set up one number to represent a directory ! GLOBAL ROUTINE SET_UP_NUMBER = BEGIN BUILTIN AP; MAP AP : REF BLOCK [,BYTE]; FILE_FAB [FAB$B_FAC] = FAB$M_PUT OR FAB$M_UPD; $OPEN (FAB=FILE_FAB,ERR=REPORT_ERROR); FILE_RAB [RAB$B_RAC] = RAB$C_KEY; $CONNECT (RAB=FILE_RAB,ERR=REPORT_ERROR); FILE_RAB [RAB$W_RSZ] = MAX_RECORD; FILE_RAB [RAB$L_RBF] = FILE_BUFFER; FILE_RAB [RAB$L_KBF] = AP [TPA$L_NUMBER]; FILE_RAB [RAB$B_KSZ] = 4; DESCRIPTOR = 0; DESCRIPTOR+4 = 0; DESCRIPTOR [DSC$B_CLASS] = DSC$K_CLASS_D; LIB$GET_INPUT (DESCRIPTOR, DESC ('Input Device-Directory String:')); IF .DESCRIPTOR [DSC$W_LENGTH] EQL 0 THEN RETURN 1; CH$MOVE (.DESCRIPTOR [DSC$W_LENGTH], .DESCRIPTOR [DSC$A_POINTER], FILE_BUFFER); FILE_RAB [RAB$V_UIF] = 1; $PUT (RAB=FILE_RAB,ERR=REPORT_ERROR); $CLOSE (FAB=FILE_FAB,ERR=REPORT_ERROR); RETURN 1 END; ! end of global routine set_up_number ! ! this is the routine to clear a number which was representing a directory ! GLOBAL ROUTINE CLR_NUMBER = BEGIN BUILTIN AP; MAP AP : REF BLOCK [,BYTE]; FILE_FAB [FAB$B_FAC] = FAB$M_DEL OR FAB$M_GET; $OPEN (FAB=FILE_FAB,ERR=REPORT_ERROR); $CONNECT (RAB=FILE_RAB,ERR=REPORT_ERROR); FILE_RAB [RAB$W_USZ] = MAX_RECORD; FILE_RAB [RAB$L_UBF] = FILE_BUFFER; FILE_RAB [RAB$L_KBF] = AP [TPA$L_NUMBER]; FILE_RAB [RAB$B_KSZ] = 4; FILE_RAB [RAB$B_RAC] = RAB$C_KEY; $GET (RAB=FILE_RAB,ERR=REPORT_ERROR); $DELETE (RAB=FILE_RAB,ERR=REPORT_ERROR); $CLOSE (FAB=FILE_FAB,ERR=REPORT_ERROR); RETURN 1 END; ! end of global routine clr_number ! ! this is a routine to show all the numbers that are currently defined ! GLOBAL ROUTINE SHOW_NUMBERS = BEGIN LOCAL COUNTER; LOCAL RMS_STATUS; FILE_FAB [FAB$B_FAC] = FAB$M_GET; RMS_STATUS = $OPEN (FAB=FILE_FAB); IF .RMS_STATUS EQL RMS$_FNF THEN (LIB$PUT_OUTPUT (DESC( 'There are no numbers associated with directory strings')); RETURN 1); $CONNECT (RAB=FILE_RAB,ERR=REPORT_ERROR); FILE_RAB [RAB$L_UBF] = FILE_BUFFER; FILE_RAB [RAB$W_USZ] = MAX_RECORD; FILE_RAB [RAB$L_KBF] = COUNTER; FILE_RAB [RAB$B_KSZ] = 4; FILE_RAB [RAB$B_RAC] = RAB$C_KEY; FILE_RAB [RAB$V_NXR] = 1; COUNTER = 1; WHILE 1 DO BEGIN LOCAL RMS_STATUS; RMS_STATUS = $GET (RAB=FILE_RAB); IF .RMS_STATUS EQL RMS$_EOF THEN EXITLOOP; IF .RMS_STATUS EQL RMS$_OK_RNF THEN EXITLOOP; IF .RMS_STATUS NEQ RMS$_OK_DEL THEN BEGIN IF NOT .RMS_STATUS THEN REPORT_ERR (FILE_RAB); $FAO (DESC ('Number !UL = !AS '), FAO_BUFF,FAO_BUFF,.COUNTER,RECORD_DESC); LIB$PUT_OUTPUT (FAO_BUFF); FAO_BUFF[0] = FAO_SIZE; END; COUNTER = .COUNTER + 1; END; $CLOSE (FAB=FILE_FAB,ERR=REPORT_ERROR); RETURN 1; END; ! end of routine show_numbers ! ! routine to change the default to the string corresponding to the input number ! GLOBAL ROUTINE SET_NUMBER = BEGIN BUILTIN AP; BUILTIN CALLG; MAP AP : REF BLOCK [,BYTE]; LOCAL RMS_STATUS; FILE_FAB [FAB$B_FAC] = FAB$M_GET; RMS_STATUS = $OPEN (FAB=FILE_FAB); IF .RMS_STATUS EQL RMS$_FNF THEN (LIB$PUT_OUTPUT (DESC('There are no numbers set up to represent directories')); RETURN 1); IF NOT .RMS_STATUS THEN REPORT_ERR(FILE_FAB); FILE_RAB [RAB$B_RAC] = RAB$C_KEY; $CONNECT (RAB=FILE_RAB,ERR=REPORT_ERROR); FILE_RAB [RAB$L_KBF] = AP [TPA$L_NUMBER]; FILE_RAB [RAB$B_KSZ] = 4; FILE_RAB [RAB$L_UBF] = FILE_BUFFER; FILE_RAB [RAB$W_USZ] = MAX_RECORD; RMS_STATUS = $GET (RAB=FILE_RAB); ! IF .RMS_STATUS EQL RMS$_RNF THEN ! (LIB$PUT_OUTPUT ! (DESC ('There is no directory string associated with this number')); ! RETURN 1); ! IF NOT .RMS_STATUS THEN REPORT_ERR(FILE_RAB); ! ! if we get an error trying to get the specification associated with this ! key, then maybe the key isn't valid. in that case try to set default to ! the directory itself ! IF NOT .RMS_STATUS THEN RETURN .RMS_STATUS; ! $CLOSE (FAB=FILE_FAB,ERR=REPORT_ERROR); AP [TPA$L_STRINGCNT] = CH$FIND_CH (MAX_RECORD,.FILE_RAB[RAB$L_RBF],0) - .FILE_RAB [RAB$L_RBF]; AP [TPA$L_STRINGPTR] = .FILE_RAB [RAB$L_RBF]; CALLG (.AP,SET_DEFAULT); RETURN 1 END; ! end of routine set_number END ELUDOM