/* vi:set ts=8 sts=4 sw=4 noet: * * VIM - Vi IMproved by Bram Moolenaar * VMS port by Henk Elbers * VMS deport by Zoltan Arpadffy * * Do ":help uganda" in Vim to read copying and usage conditions. * Do ":help credits" in Vim to see a list of people who contributed. * See README.txt for an overview of the Vim source code. */ #include "vim.h" // define _generic_64 for use in time functions #if !defined(VAX) # include #else // based on Alpha's gen64def.h; the file is absent on VAX typedef struct _generic_64 { # pragma __nomember_alignment __union { // You can treat me as... // long long is not available on VAXen // unsigned __int64 gen64$q_quadword; ...a single 64-bit value, or unsigned int gen64$l_longword [2]; // ...two 32-bit values, or unsigned short int gen64$w_word [4]; // ...four 16-bit values } gen64$r_quad_overlay; } GENERIC_64; #endif typedef struct { char class; char type; short width; union { struct { char _basic[3]; char length; } y; int basic; } x; int extended; } TT_MODE; typedef struct { short buflen; short itemcode; char *bufadrs; int *retlen; } ITEM; typedef struct { ITEM equ; int nul; } ITMLST1; typedef struct { ITEM index; ITEM string; int nul; } ITMLST2; static TT_MODE orgmode; static short iochan; // TTY I/O channel static short iosb[4]; // IO status block static int vms_match_num = 0; static int vms_match_free = 0; static char_u **vms_fmatch = NULL; static char *Fspec_Rms; // rms file spec, passed implicitly between routines static TT_MODE get_tty(void); static void set_tty(int row, int col); #define EXPL_ALLOC_INC 64 #define EQN(S1,S2,LN) (strncmp(S1,S2,LN) == 0) #define SKIP_FOLLOWING_SLASHES(Str) do { while (Str[1] == '/') ++Str; } while (0) /* * vul_desc vult een descriptor met een string en de lengte * hier van. */ static void vul_desc(DESC *des, char *str) { des->dsc$b_dtype = DSC$K_DTYPE_T; des->dsc$b_class = DSC$K_CLASS_S; des->dsc$a_pointer = str; des->dsc$w_length = str ? strlen(str) : 0; } /* * vul_item vult een item met een aantal waarden */ static void vul_item(ITEM *itm, short len, short cod, char *adr, int *ret) { itm->buflen = len; itm->itemcode = cod; itm->bufadrs = adr; itm->retlen = ret; } void mch_settmode(tmode_T tmode) { int status; if ( tmode == TMODE_RAW ) set_tty(0, 0); else { switch (orgmode.width) { case 132: OUT_STR_NF((char_u *)"\033[?3h\033>"); break; case 80: OUT_STR_NF((char_u *)"\033[?3l\033>"); break; default: break; } out_flush(); status = sys$qiow(0, iochan, IO$_SETMODE, iosb, 0, 0, &orgmode, sizeof(TT_MODE), 0,0,0,0); if (status!=SS$_NORMAL || (iosb[0]&0xFFFF)!=SS$_NORMAL) return; (void)sys$dassgn(iochan); iochan = 0; } } static void set_tty(int row, int col) { int status; TT_MODE newmode; // New TTY mode bits static short first_time = TRUE; if (first_time) { orgmode = get_tty(); first_time = FALSE; } newmode = get_tty(); if (col) newmode.width = col; if (row) newmode.x.y.length = row; newmode.x.basic |= (TT$M_NOECHO | TT$M_HOSTSYNC); newmode.x.basic &= ~TT$M_TTSYNC; newmode.extended |= TT2$M_PASTHRU; status = sys$qiow(0, iochan, IO$_SETMODE, iosb, 0, 0, &newmode, sizeof(newmode), 0, 0, 0, 0); if (status!=SS$_NORMAL || (iosb[0]&0xFFFF)!=SS$_NORMAL) return; } static TT_MODE get_tty(void) { static $DESCRIPTOR(odsc,"SYS$OUTPUT"); // output descriptor int status; TT_MODE tt_mode; if (!iochan) status = sys$assign(&odsc,&iochan,0,0); status = sys$qiow(0, iochan, IO$_SENSEMODE, iosb, 0, 0, &tt_mode, sizeof(tt_mode), 0, 0, 0, 0); if (status != SS$_NORMAL || (iosb[0] & 0xFFFF) != SS$_NORMAL) { tt_mode.width = 0; tt_mode.type = 0; tt_mode.class = 0; tt_mode.x.basic = 0; tt_mode.x.y.length = 0; tt_mode.extended = 0; } return(tt_mode); } /* * Get the current window size in Rows and Columns. */ int mch_get_shellsize(void) { TT_MODE tmode; tmode = get_tty(); // get size from VMS Columns = tmode.width; Rows = tmode.x.y.length; return OK; } /* * Try to set the window size to Rows and new_Columns. */ void mch_set_shellsize(void) { set_tty(Rows, Columns); switch (Columns) { case 132: OUT_STR_NF((char_u *)"\033[?3h\033>"); break; case 80: OUT_STR_NF((char_u *)"\033[?3l\033>"); break; default: break; } out_flush(); screen_start(); } char_u * mch_getenv(char_u *lognam) { DESC d_file_dev, d_lognam ; static char buffer[LNM$C_NAMLENGTH+1]; char_u *cp = NULL; unsigned long attrib; int lengte = 0, dum = 0, idx = 0; ITMLST2 itmlst; char *sbuf = NULL; vul_desc(&d_lognam, (char *)lognam); vul_desc(&d_file_dev, "LNM$FILE_DEV"); attrib = LNM$M_CASE_BLIND; vul_item(&itmlst.index, sizeof(int), LNM$_INDEX, (char *)&idx, &dum); vul_item(&itmlst.string, LNM$C_NAMLENGTH, LNM$_STRING, buffer, &lengte); itmlst.nul = 0; if (sys$trnlnm(&attrib, &d_file_dev, &d_lognam, NULL,&itmlst) == SS$_NORMAL) { buffer[lengte] = '\0'; if (cp = alloc(lengte + 1)) strcpy((char *)cp, buffer); return(cp); } else if ((sbuf = getenv((char *)lognam))) { lengte = strlen(sbuf) + 1; cp = alloc(lengte); if (cp) strcpy((char *)cp, sbuf); return cp; } else return(NULL); } /* * mch_setenv VMS version of setenv() */ int mch_setenv(char *var, char *value, int x) { int res, dum; long attrib = 0L; char acmode = PSL$C_SUPER; // needs SYSNAM privilege DESC tabnam, lognam; ITMLST1 itmlst; vul_desc(&tabnam, "LNM$JOB"); vul_desc(&lognam, var); vul_item(&itmlst.equ, value ? strlen(value) : 0, value ? LNM$_STRING : 0, value, &dum); itmlst.nul = 0; res = sys$crelnm(&attrib, &tabnam, &lognam, &acmode, &itmlst); return((res == 1) ? 0 : -1); } int vms_sys(char *cmd, char *out, char *inp) { DESC cdsc, odsc, idsc; long status; if (cmd) vul_desc(&cdsc, cmd); if (out) vul_desc(&odsc, out); if (inp) vul_desc(&idsc, inp); lib$spawn(cmd ? &cdsc : NULL, // command string inp ? &idsc : NULL, // input file out ? &odsc : NULL, // output file 0, 0, 0, &status, 0, 0, 0, 0, 0, 0); return status; } /* * Convert string to lowercase - most often filename */ char * vms_tolower( char *name ) { int i,nlen = strlen(name); for (i = 0; i < nlen; i++) name[i] = TOLOWER_ASC(name[i]); return name; } /* * Convert VMS system() or lib$spawn() return code to Unix-like exit value. */ int vms_sys_status(int status) { if (status != SS$_NORMAL && (status & STS$M_SUCCESS) == 0) return status; // Command failed. return 0; } /* * vms_read() * function for low level char input * * Returns: input length */ int vms_read(char *inbuf, size_t nbytes) { int status, function, len; TT_MODE tt_mode; ITEM itmlst[2]; // terminates on everything static long trm_mask[8] = {-1, -1, -1, -1, -1, -1, -1, -1}; // whatever happened earlier we need an iochan here if (!iochan) tt_mode = get_tty(); // important: clean the inbuf memset(inbuf, 0, nbytes); // set up the itemlist for the first read vul_item(&itmlst[0], 0, TRM$_MODIFIERS, (char *)( TRM$M_TM_NOECHO | TRM$M_TM_NOEDIT | TRM$M_TM_NOFILTR | TRM$M_TM_TRMNOECHO | TRM$M_TM_NORECALL) , 0); vul_item(&itmlst[1], sizeof(trm_mask), TRM$_TERM, (char *)&trm_mask, 0); // wait forever for a char function = (IO$_READLBLK | IO$M_EXTEND); status = sys$qiow(0, iochan, function, &iosb, 0, 0, inbuf, nbytes-1, 0, 0, &itmlst, sizeof(itmlst)); len = strlen(inbuf); // how many chars we got? // read immediately the rest in the IO queue function = (IO$_READLBLK | IO$M_TIMED | IO$M_ESCAPE | IO$M_NOECHO | IO$M_NOFILTR); status = sys$qiow(0, iochan, function, &iosb, 0, 0, inbuf+len, nbytes-1-len, 0, 0, 0, 0); len = strlen(inbuf); // return the total length return len; } /* * vms_wproc() is called for each matching filename by decc$to_vms(). * We want to save each match for later retrieval. * * Returns: 1 - continue finding matches * 0 - stop trying to find any further matches */ static int vms_wproc(char *name, int val) { int i; static int vms_match_alloced = 0; if (val == DECC$K_FOREIGN ) // foreign non VMS files are not counting return 1; // accept all DECC$K_FILE and DECC$K_DIRECTORY if (vms_match_num == 0) { // first time through, setup some things if (NULL == vms_fmatch) { vms_fmatch = ALLOC_MULT(char_u *, EXPL_ALLOC_INC); if (!vms_fmatch) return 0; vms_match_alloced = EXPL_ALLOC_INC; vms_match_free = EXPL_ALLOC_INC; } else { // re-use existing space vms_match_free = vms_match_alloced; } } // make matches look uniform vms_remove_version(name); name=vms_tolower(name); // if name already exists, don't add it for (i = 0; i 0) cnt = vms_match_num; if (cnt < 1) continue; for (i = 0; i < cnt; i++) { // files should exist if expanding interactively if (!(flags & EW_NOTFOUND) && mch_getperm(vms_fmatch[i]) < 0) continue; // do not include directories dir = (mch_isdir(vms_fmatch[i])); if (( dir && !(flags & EW_DIR)) || (!dir && !(flags & EW_FILE))) continue; // Skip files that are not executable if we check for that. if (!dir && (flags & EW_EXEC) && !mch_can_exe(vms_fmatch[i], NULL, !(flags & EW_SHELLCMD))) continue; // allocate memory for pointers if (--files_free < 1) { char_u **old_file = *file; files_alloced += EXPL_ALLOC_INC; *file = vim_realloc(old_file, sizeof(char_u **) * files_alloced); if (*file == NULL) { vim_free(old_file); *file = (char_u **)""; *num_file = 0; return(FAIL); } files_free = EXPL_ALLOC_INC; } (*file)[*num_file++] = vms_fmatch[i]; } } return OK; } int mch_expandpath(garray_T *gap, char_u *path, int flags) { int i,cnt = 0; char *result; vms_match_num = 0; // the result from the decc$translate_vms needs to be handled // otherwise it might create ACCVIO error in decc$to_vms result = decc$translate_vms(vms_fixfilename(path)); if ( (int) result == 0 || (int) result == -1 ) { cnt = 0; } else { cnt = decc$to_vms(result, vms_wproc, 1 /*allow_wild*/, (flags & EW_DIR ? 0:1 ) /*allow directory*/); } if (cnt > 0) cnt = vms_match_num; for (i = 0; i < cnt; i++) { if (mch_getperm(vms_fmatch[i]) >= 0) // add existing file addfile(gap, vms_fmatch[i], flags); } return cnt; } /* * attempt to translate a mixed unix-vms file specification to pure vms */ static void vms_unix_mixed_filespec(char *in, char *out) { char *lastcolon; char *end_of_dir; char ch; int len; char *out_str=out; // copy vms filename portion up to last colon // (node and/or disk) lastcolon = strrchr(in, ':'); // find last colon if (lastcolon != NULL) { len = lastcolon - in + 1; strncpy(out, in, len); out += len; in += len; } end_of_dir = NULL; // default: no directory // start of directory portion ch = *in; if ((ch == '[') || (ch == '/') || (ch == '<')) // start of directory(s) ? { ch = '['; SKIP_FOLLOWING_SLASHES(in); } else if (EQN(in, "../", 3)) // Unix parent directory? { *out++ = '['; *out++ = '-'; end_of_dir = out; ch = '.'; in += 2; SKIP_FOLLOWING_SLASHES(in); } else { // not a special character while (EQN(in, "./", 2)) // Ignore Unix "current dir" { in += 2; SKIP_FOLLOWING_SLASHES(in); } if (strchr(in, '/') == NULL) // any more Unix directories ? { strcpy(out, in); // No - get rest of the spec return; } else { *out++ = '['; // Yes, denote a Vms subdirectory ch = '.'; --in; } } // if we get here, there is a directory part of the filename // initialize output file spec *out++ = ch; ++in; while (*in != '\0') { ch = *in; if ((ch == ']') || (ch == '/') || (ch == '>') ) // end of (sub)directory ? { end_of_dir = out; ch = '.'; SKIP_FOLLOWING_SLASHES(in); } else if (EQN(in, "../", 3)) // Unix parent directory? { *out++ = '-'; end_of_dir = out; ch = '.'; in += 2; SKIP_FOLLOWING_SLASHES(in); } else { while (EQN(in, "./", 2)) // Ignore Unix "current dir" { end_of_dir = out; in += 2; SKIP_FOLLOWING_SLASHES(in); ch = *in; } } // Place next character into output file spec *out++ = ch; ++in; } *out = '\0'; // Terminate output file spec if (end_of_dir != NULL) // Terminate directory portion *end_of_dir = ']'; } /* * for decc$to_vms in vms_fixfilename */ static int vms_fspec_proc(char *fil, int val) { strcpy(Fspec_Rms,fil); return(1); } /* * change unix and mixed filenames to VMS */ void * vms_fixfilename(void *instring) { static char *buf = NULL; static size_t buflen = 0; size_t len; // get a big-enough buffer len = strlen(instring) + 1; if (len > buflen) { buflen = len + 128; buf = vim_realloc(buf, buflen * sizeof(char)); } #ifdef DEBUG char *tmpbuf = NULL; tmpbuf = ALLOC_MULT(char, buflen); strcpy(tmpbuf, instring); #endif Fspec_Rms = buf; // for decc$to_vms if (strchr(instring,'/') == NULL) // It is already a VMS file spec strcpy(buf, instring); else if (strchr(instring,'"') == NULL) // password in the path? { // Seems it is a regular file, let guess that it is pure Unix fspec if ( (strchr(instring,'[') == NULL) && (strchr(instring,'<') == NULL) && (strchr(instring,']') == NULL) && (strchr(instring,'>') == NULL) && (strchr(instring,':') == NULL) ) { // It must be a truly unix fspec decc$to_vms(instring, vms_fspec_proc, 0, 0); } else { // It is a mixed fspec vms_unix_mixed_filespec(instring, buf); } } else // we have a password in the path // decc$ functions can not handle // this is our only hope to resolv vms_unix_mixed_filespec(instring, buf); return buf; } /* * Remove version number from file name * we need it in some special cases as: * creating swap file name and writing new file */ /* * 2025-05-13 SMS. * Using $PARSE would be simpler and more accurate, if all-VMS (not * mixed UNIX+VMS) path were ensured. Meanwhile, to improve (imperfect) * handling of extended name syntax: * o All characters (up to five (32767)) after semi-colon (or last * of multiple dots) must be numeric. * o Caret-escaped semi-colon (^;) or dot (^.) does not delimit * version. * Whether it makes sense to detect syntax errors here is not entirely * clear. Currently, many invalid version strings are not treated as * version strings. (More could be.) */ void vms_remove_version(void * fname) { char_u *dp; // Dot pointer char_u *rp; // Right pointer int done = 0; int vdigits = 0; rp = (char_u *)fname+ strlen( (char *)fname)- 1; // Rightmost char while ((done == 0) && (rp > (char_u *)fname)) // Count digits { if (isdigit( *rp)) { vdigits++; *rp--; } else { done = 1; // Quit at non-digit } } // while (Count digits) if (vdigits <= 5) // If likely version digits, check delimiter { // (Could check for <= 32767, not just five digits or fewer.) if (*rp == (char_u)';') { if ((rp >= (char_u *)fname) && (*(rp- 1) != (char_u)'^')) { // Unescaped ";" *rp = '\0'; // Trim off ";nnn" } } else if (*rp == (char_u)'.') // Last of multiple dots? { if ((rp >= (char_u *)fname) && (*(rp- 1) != '^')) { // Unescaped dot. Version requires previous one dp = rp- 1; // Scan chars before "." done = 0; while ((done == 0) && (dp >= (char_u *)fname)) { if ((*dp == ']') || (*dp == '>') || (*dp == ':') || (*dp == '/')) { // Possible VMS dev:[dir] delimiter (or UNIX "/") if ((dp >= (char_u *)fname) && (*(dp- 1) != '^')) { // Unescaped dev:[dir] (or /) delimiter done = 1; // No previous dot found in name } } else if (*dp == '.') { // Possible dot delimiter if ((dp >= (char_u *)fname) && (*(dp- 1) != '^')) { // Unescaped dot delimiter done = 1; // Previous dot found in name *rp = '\0'; // Trim off ".nnn" } } dp--; // Next char to right } // while } } // Else no version found to remove } // if (vdigits <= 5) return ; } struct typeahead_st { unsigned short numchars; unsigned char firstchar; unsigned char reserved0; unsigned long reserved1; } typeahead; /* * Wait "msec" msec until a character is available from file descriptor "fd". * "msec" == 0 will check for characters once. * "msec" == -1 will block until a character is available. */ int RealWaitForChar( int fd UNUSED, // always read from iochan long msec, int *check_for_gpm UNUSED, int *interrupted) { int status; struct _generic_64 time_curr; struct _generic_64 time_diff; struct _generic_64 time_out; unsigned int convert_operation = LIB$K_DELTA_SECONDS_F; float sec =(float) msec/1000; // make sure the iochan is set if (!iochan) get_tty(); if (sec > 0) { // time-out specified; convert it to absolute time // sec>0 requirement of lib$cvt[fs]_to_internal_time() // get current time (number of 100ns ticks since the VMS Epoch) status = sys$gettim(&time_curr); if (status != SS$_NORMAL) return 0; // error // construct the delta time /* On all non-VAX hardware architectures, the "CC /FLOAT=option" * determines the floating-point format. The default format on Alpha * is VAX; on IA64 and x86_64 it's IEEE. But, except on VAX, the user * can specify either. What matters here is the actual floating-point * format being used, not the hardware architecture. Choose the * appropriate time conversion function accordingly. */ #if __IEEE_FLOAT # define LIB_CVTX_TO_INTERNAL_TIME lib$cvts_to_internal_time // IEEE #else # define LIB_CVTX_TO_INTERNAL_TIME lib$cvtf_to_internal_time // VAX #endif // __IEEE_FLOAT CVTS status = LIB_CVTX_TO_INTERNAL_TIME( &convert_operation, &sec, &time_diff); if (status != LIB$_NORMAL) return 0; // error // add them up status = lib$add_times( &time_curr, &time_diff, &time_out); if (status != LIB$_NORMAL) return 0; // error } while (TRUE) { // select() status = sys$qiow(0, iochan, IO$_SENSEMODE | IO$M_TYPEAHDCNT, iosb, 0, 0, &typeahead, 8, 0, 0, 0, 0); if (status != SS$_NORMAL || (iosb[0] & 0xFFFF) != SS$_NORMAL) return 0; // error if (typeahead.numchars) return 1; // ready to read // there's nothing to read; what now? if (msec == 0) { // immediate time-out; return impatiently return 0; } else if (msec < 0) { // no time-out; wait on indefinitely return 1; // fakeout to force a wait in vms_read() } else { // time-out needs to be checked status = sys$gettim(&time_curr); if (status != SS$_NORMAL) return 0; // error status = lib$sub_times( &time_out, &time_curr, &time_diff); if (status != LIB$_NORMAL) return 0; // error, incl. time_diff < 0 (i.e. time-out) // otherwise wait some more } } } #if !defined( __VAX) && (__CRTL_VER >= 70301000) #include #include // Structure to hold a DECC$* feature name and its desired value typedef struct { char *name; int value; } decc_feat_t; int vms_init_done = -1; decc_feat_t decc_feat_array[] = { // Preserve command-line case with SET PROCESS/PARSE_STYLE=EXTENDED { "DECC$ARGV_PARSE_STYLE", 1 }, // Preserve case for file names on ODS5 disks { "DECC$EFS_CASE_PRESERVE", 1 }, // Enable multiple dots (and most characters) in ODS5 file names, // while preserving VMS-ness of ";version" { "DECC$EFS_CHARSET", 1 }, // List terminator { (char *)NULL, 0 } }; /* LIB$INITIALIZE initialization. * * On sufficiently recent non-VAX systems, set a collection of C RTL * features without using the DECC$* logical name method. * * Note: Old VAX VMS versions may suffer from a linker complaint like * this: * * %LINK-W-MULPSC, conflicting attributes for psect LIB$INITIALIZE * in module LIB$INITIALIZE file SYS$COMMON:[SYSLIB]STARLET.OLB;1 * * Using a LINK options file which includes a line like this one should * stop this complaint: * * PSECT_ATTR=LIB$INITIALIZE,NOPIC */ /* vms_init() * * Uses LIB$INITIALIZE to set a collection of C RTL features without * requiring the user to define the corresponding logical names. * * LIB$INITIALIZE initialization function */ static void vms_init(void) { // Set the global flag to indicate that LIB$INITIALIZE worked vms_init_done = 1; int feat_index; int feat_value; int feat_value_max; int feat_value_min; int i; int sts; // Loop through all items in the decc_feat_array[] for (i = 0; decc_feat_array[i].name != NULL; i++) { // Get the feature index feat_index = decc$feature_get_index(decc_feat_array[i].name); if (feat_index >= 0) { // Valid item. Collect its properties feat_value = decc$feature_get_value(feat_index, 1); feat_value_min = decc$feature_get_value(feat_index, 2); feat_value_max = decc$feature_get_value(feat_index, 3); if ((decc_feat_array[i].value >= feat_value_min) && (decc_feat_array[i].value <= feat_value_max)) // Valid value. Set it if necessary if (feat_value != decc_feat_array[i].value) sts = decc$feature_set_value(feat_index, 1, decc_feat_array[i].value); else // Invalid DECC feature value printf("INVALID DECC FEATURE VALUE, %d: %d <= %s <= %d.\n", feat_value, feat_value_min, decc_feat_array[i].name, feat_value_max); } else // Invalid DECC feature name printf("UNKNOWN DECC FEATURE: %s.\n", decc_feat_array[i].name); } } /* Get "vms_init()" into a valid, loaded LIB$INITIALIZE PSECT. */ #pragma nostandard /* Establish the LIB$INITIALIZE PSECTs, with proper alignment and * other attributes. Note that "nopic" is significant only on VAX. */ #pragma extern_model save #pragma extern_model strict_refdef "LIB$INITIALIZE" 2, nopic, nowrt void (*const x_vms_init)() = vms_init; #pragma extern_model strict_refdef "LIB$INITIALIZ" 2, nopic, nowrt const int spare[ 8] = { 0 }; #pragma extern_model restore // Fake reference to ensure loading the LIB$INITIALIZE PSECT #pragma extern_model save int LIB$INITIALIZE(void); #pragma extern_model strict_refdef int dmy_lib$initialize = (int) LIB$INITIALIZE; #pragma extern_model restore #pragma standard #endif // !defined( __VAX) && (__CRTL_VER >= 70301000)