The ModulaTor logo 7KB

The ModulaTor

Oberon-2 and Modula-2 Technical Publication


The ModulaTor
Erlangen's First Independent Modula-2 Journal! Nr. 3/Nov-1990 
_____________________________________________________________

Modula-2 Beats C even in System Programming 

A Programming Example in Modula-2 and C on VAX/VMS 

by Guenter Dotzel, ModulaWare 

This article lists two programs Get_rev and Set_rev, each written in Modula-2 and in C. 
The Modula-2 programs are compiled with ModulaWare's Modula-2 Compiler MVR 
V2.13; the C programs can be compiled with DEC's C-Compiler, both running under 
VMS, generating VAX-11 machine code. The Modula-2 programs use a common, 
separately compiled utility module Uti_rev. It's interface is the definition module in file 
Uti_rev.def, whereas it's implementation is Uti_rev.mod. Both files are listed below. All 
other modules are standard library modules. 

The Modula-2 and C versions of the programs have identical functionality. The purpose 
of the programs is described in module Get_rev below. For space reasons, all unsafe 
declarations and statements are printed in italics in the C sources, but aren't further 
discussed. The worst hacks are printed in bold italics. Readers who do not agree with 
my judgement on C's unsafetyness, may contact me at the address given above or by 
phone. I'm able to give them friendly explanations. 

Get_rev.MOD

__________________________________________________________________________________________________ 

MODULE Get_rev;
(* 
VAX/VMS Utility 

Changing the Revision Date of Files Using the RMS.XABRDT data structure 

Modula-2 version written by Guenter Dotzel, ModulaWare, Email
100023.2527@compuserve.com 

Started 17-Oct-1990, revised 24-Jan-1992 (correct setting fab.FNS). 

Purpose: Sometimes it is desired to restore the original revision date of a
file after implicitely having modified it for example by the  DCL command $SET
file/prot=... *.*, which sets the revision date to the current date. 

Two programs Get_rev and Set_rev and one command file Prot_change.com are
needed to perform a protection change to a list of  files and set the revision
date back to the original date and time. The required steps are: 

1. First the list of files has to be generated, e.g.: $
DIRectory/out=files./col=1 *.* 

2. Then the file "Files." is edited to remove the header and trailer
information generated by the directory command above. 

3. Run the program Get_rev.EXE which reads "Files." and produces a file
"Files.rev". 

4. Edit/customize and then run the command procedure in file Prot_Change.com
by $ Prot_change 

This command procedure reads the list of files from "Files." and performs a
$SET file/... action by executing the self-generated file  "do_it.com". 

5. Run the program Set_rev.EXE to restore the original revision date from the
data files generated by step 3. 

If any step from 3, ..., 5 fails to execute without error, it may be
re-executed again after fixing the problem (a possible error may be:  file
currently locked by an other user). 

6. The files "File.;*" and "Files.rev;*" may be deleted now. 

Notes: The utility Set_rev changes the revision date of files. You must have
appropriate privs. Use at your own risk! 

This program directly or indirectly imports the following library modules
which are part of the MVR distribution kit (MVR is  ModulaWare's Modula-2
VAX/VMS Compiler kit): 

FileSystem, RMS, Storage, FileDataType, Terminal, ModulaMessages and ASCII. 

Other modules imported are either compiler build-in modules (SYSTEM) or
foreign definition modules (declarations only) which  have no corresponding
implementation module (i.e. no object file). 

Remarks on the distribution found in CompuServe's VAXForum library: Please
feel free to re-write this program in your favorite  programming language if
you don't have access to a Modula-2 Compiler under VMS. The set of object code
(.OBJ) files required to be  able to link both utilities is also contained in
the text-library (SETREV.TLB). 

PS.: The kind support from Digital Service Center, Munich is herewith
acknowledged. 

*)
IMPORT FileSystem, VMS, SYSTEM;
FROM Uti_rev IMPORT Fopen, openMode, f, fr, filename, fnlen, fnlength, eosc, 
  Exec, WLN, W, nop, fab, xabrdt, Rnormal, Snormal, revdate, rdlen;
BEGIN
  WLN("get revision date from 'files.' stored in 'files.rev' ... "); WLN("");
  f := Fopen ("files.", read); 
  fr := Fopen ("files.rev",write); 
  WHILE NOT FileSystem.Eof(f) DO
    fnlen:=fnlength;
    FileSystem.ReadRecord(f, filename, fnlen);
    IF fnlen # 0 THEN filename[fnlen]:=eosc; 
      fab.FNS := SYSTEM.CAST(SYSTEM.BYTE,fnlen);
      Exec(VMS.SYS$OPEN(SYSTEM.ADR(fab),nop, nop), Rnormal);
      Exec(VMS.SYS$CLOSE(SYSTEM.ADR(fab),nop, nop), Rnormal);
      (* Retrieving the revision date *)
      revdate :="31-DEC-1999 23:59:59.99";
      Exec(VMS.SYS$ASCTIM(rdlen,revdate,SYSTEM.ADR(xabrdt.RDT),0), Snormal);
      W("file: "); W(filename); W(" revision date is : "); W(revdate); WLN("");
      FileSystem.WriteRecord(fr, revdate, LENGTH(revdate));
    END;
  END;
  FileSystem.Close(f);
  FileSystem.Close(fr);
END Get_rev.

Set_rev.MOD

__________________________________________________________________________________________________ 

MODULE Set_rev;
(* Set File Revision Date Using RMS.XABRDT. See description in file Get_rev.MOD *)

IMPORT FileSystem, VMS, SYSTEM;
FROM Uti_rev IMPORT Fopen, openMode, f, fr, filename, fnlen, fnlength, eosc, 
  Exec, WLN, W, nop, fab, xabrdt, Rnormal, Snormal, revdate,  rdlen, rdlength;

VAR current_revdate: ARRAY [0..rdlength-1] OF CHAR; dlen: CARDINAL;
BEGIN
  WLN("Revision date playback ....");WLN("");
  f := Fopen ("files.", read); 
  fr := Fopen ("files.rev", read); 
  WHILE NOT (FileSystem.Eof(f) OR FileSystem.Eof(fr)) DO
    fnlen:=fnlength;
    FileSystem.ReadRecord(f, filename, fnlen);
    IF fnlen # 0 THEN filename[fnlen]:=eosc; dlen:=rdlength;
      FileSystem.ReadRecord(fr, revdate, dlen);
      WLN(" Processing File : "); W(filename);
      fab.FNS := SYSTEM.CAST(SYSTEM.BYTE,fnlen);
      (* Retrieving the revision date *)
      Exec(VMS.SYS$OPEN(SYSTEM.ADR(fab),nop, nop), Rnormal);
      Exec(VMS.SYS$CLOSE(SYSTEM.ADR(fab),nop, nop), Rnormal);
      current_revdate :="31-DEC-1999 23:59:59.99";
      Exec(VMS.SYS$ASCTIM(rdlen,current_revdate,SYSTEM.ADR(xabrdt.RDT),0), Snormal);
      WLN("  file revision date : "); W(current_revdate);
      (* Changing the revision date to the date given by revdate *)
      Exec(VMS.SYS$OPEN(SYSTEM.ADR(fab),nop, nop), Rnormal);
      Exec(VMS.SYS$BINTIM(revdate,SYSTEM.ADR(xabrdt.RDT)), Snormal);
      Exec(VMS.SYS$CLOSE(SYSTEM.ADR(fab),nop, nop), Rnormal);
      WLN("   new revision date : "); W(revdate);
    END;
  END; WLN("");
  FileSystem.Close(f);
  FileSystem.Close(fr);
END Set_rev.

Uti_rev.DEF

__________________________________________________________________________________________________ 

DEFINITION MODULE Uti_rev;
(* Common definitions, declarations and procedures for modules Get_rev, Set_rev *)
IMPORT FileSystem, RMS, RMSDefinitions, SSDefinitions, ASCII, SYSTEM;

CONST fnlength=255; rdlength=24; nop = SYSTEM.NOP; eosc=ASCII.NUL;
  Snormal=SSDefinitions.SS$_NORMAL; Rnormal=RMSDefinitions.RMS$_NORMAL;

VAR fab: RMS.FAB; (* Define a File Access Block *)
  xabrdt: RMS.XABRDT; (* Define a Revision Date and Time eXtended Attribute Block *)
  filename: ARRAY [0..fnlength-1] OF CHAR;
  revdate: ARRAY [0..rdlength-1] OF CHAR;
  fnlen: CARDINAL; rdlen : SYSTEM.SHORTWORD;
  f, fr: FileSystem.File;
TYPE openMode = (read,write);
  PROCEDURE W(s: ARRAY OF CHAR);
  PROCEDURE WLN(s: ARRAY OF CHAR);
  PROCEDURE Exec(status, condition: INTEGER);
  PROCEDURE Fopen (name: ARRAY OF CHAR; k: openMode): FileSystem.File;
END Uti_rev.

Uti_rev.MOD

__________________________________________________________________________________________________ 

IMPLEMENTATION MODULE Uti_rev;
  IMPORT FileSystem, RMS, SYSTEM, ConditionHandlingProcedures, Terminal;

  PROCEDURE W(s: ARRAY OF CHAR); BEGIN Terminal.WriteString(s); END W;
  PROCEDURE WLN(s: ARRAY OF CHAR); BEGIN Terminal.WriteLn; W(s); END WLN;
  PROCEDURE Exec(status, condition: INTEGER);
  BEGIN
    IF status # condition THEN 
      IF condition=Rnormal THEN WLN(filename); WLN(""); END;
      ConditionHandlingProcedures.LIB$STOP(status);
    END;
  END Exec;
  PROCEDURE Fopen (name: ARRAY OF CHAR; k: openMode): FileSystem.File;
  VAR f: FileSystem.File;
  BEGIN
    CASE k OF
      read: FileSystem.Open (f,name,FALSE); 
    | write: FileSystem.Create (f, name,TRUE,TRUE); 
    END;
    IF NOT FileSystem.Done() THEN FileSystem.ShowStatus; END; RETURN f;
  END Fopen;
BEGIN (* module's initialization part *)
  RMS.InitFab(fab);
  RMS.InitXabRdt(xabrdt);
  fab.FAC := RMS.FACset{RMS.FAC$PUT};(*access to the file for PUT operation*)
  fab.FNA := SYSTEM.ADR(filename);(*fab.FNS := varying length*)
  fab.XAB := SYSTEM.ADR(xabrdt);
END Uti_rev.

Prot_change.COM

__________________________________________________________________________________________________ 

$! This command procedure to be used in combination with Get_, Set_Rev:
$! 
$! Command file to change protection on all files found in the file "Files.",
$! which is generated by the program Get_rev.MOD. See description
$! in file Get_rev.MOD for information.
$!
$ SET NOVERi
$ on error then goto fertig
$ on warning then goto fertig
$ open help   files. /read
$ open action do_it.com /write
$ nochmal:
$ read / END_OF_FILE= fertig help dateiname
$ write action     "$ set file /prot=(w:rwe) ", dateiname
$ write sys$output "$ set file /prot=(w:rwe) ", dateiname
$ goto nochmal
$ fertig:
$ close action
$ close help
$ SET VERi
$ @do_it

Get_rev.C

__________________________________________________________________________________________________ 

/* Retrieving File Revision Date Using XABRDT */
#include rms
#include stdio
#include descrip
#include ssdef
main()
{
int status , sys$create() , sys$open() , sys$close() ;
unsigned long int sys$asctim() , sys$bintim() , lib$stop() ;

struct FAB fab ;        /* Define a File Access Block */
struct XABRDT xabrdt ;  /* Define a Revision Date and Time eXtended Attribute Block */
char filename[200] ;
static $DESCRIPTOR ( timbuf, "                       " ); /* 23 characters */
static $DESCRIPTOR ( timbuf2, "31-DEC-1999 23:59:59.99" );
unsigned short int timlen;                                                 
FILE *f,*fr;
int rc;
/* reading revision date of files given in the file "files." */
printf("\nget revision date from 'files.' stored in 'files.rev' ... ") ;printf("\n") ;
f =fopen("files.","r");
fr=fopen("files.rev","w");
while ( fgets(filename,200,f)!= NULL) {
  rc=strlen(filename)-1;
  fab = cc$rms_fab ;
  xabrdt = cc$rms_xabrdt ;
  fab.fab$b_fac = FAB$M_PUT ;     /*  access to the file for PUT operation */
  fab.fab$l_fna = filename ;
  fab.fab$b_fns = rc ;
  fab.fab$l_xab = &xabrdt ;
  if ((status = sys$open(&fab)) !=RMS$_NORMAL) lib$stop(status) ;
  if ((status = sys$close(&fab)) !=RMS$_NORMAL) lib$stop(status) ;
  /* Retrieving the revision date */
  if ((status = sys$asctim(&timlen,&timbuf,&xabrdt.xab$q_rdt,0)) != SS$_NORMAL) lib$stop(status) ;
  printf("file: %s revision date is : %s" ,filename, timbuf.dsc$a_pointer) ;printf("\n") ;
  fprintf(fr,"%s\n",timbuf.dsc$a_pointer);
  }
fclose(f);
fclose(fr);
}

Set_rev.C

__________________________________________________________________________________________________ 

/* Set Revision Date */
#include rms
#include stdio
#include descrip
#include ssdef
main()
{
int status , sys$create() , sys$open() , sys$close() ;
unsigned long int sys$asctim() , sys$bintim() , lib$stop() ;

struct FAB fab ;        /* Define a File Access Block */
struct XABRDT xabrdt ;  /* Define a Revision Date and Time eXtended Attribute Block */
char filename[200],rev_date[100] ;
static $DESCRIPTOR ( timbuf, "                       " ); /* 23 characters */
static $DESCRIPTOR ( timbuf2, "31-DEC-1999 23:59:59.99" );
unsigned short int timlen;                                                 
FILE *f,*fr;
char *x;

f = fopen("files.","r");
fr = fopen("files.rev","r");
x = timbuf2.dsc$a_pointer;
printf("\nRevision date playback ....\n");
while
  (fgets(filename,200,f)!=NULL) {  
  fgets(rev_date,100,fr);
  strncpy(x,rev_date,23);
  printf("processing File : %s",filename) ;printf("\n") ;
  fab = cc$rms_fab ;
  xabrdt = cc$rms_xabrdt ;
  fab.fab$b_fac = FAB$M_PUT ;
  fab.fab$l_fna = &filename ;
  fab.fab$b_fns = strlen(filename)-1 ;  
  fab.fab$l_xab = &xabrdt ;
  if ((status = sys$open(&fab)) !=RMS$_NORMAL) lib$stop(status) ;
  if ((status = sys$close(&fab)) !=RMS$_NORMAL) lib$stop(status) ;
  /* Retrieving the revision date */
  if ((status = sys$asctim(&timlen,&timbuf,&xabrdt.xab$q_rdt,0)) != SS$_NORMAL) lib$stop(status) ;
  printf("\nFile revision date : -%s-" , timbuf.dsc$a_pointer) ;printf("\n") ;
  /* Changing the revision date to the date given by timbuf2 */
  if ((status = sys$open(&fab)) !=RMS$_NORMAL) lib$stop(status) ;
  if ((status = sys$bintim(&timbuf2,&xabrdt.xab$q_rdt)) != SS$_NORMAL) lib$stop(status) ;
  if ((status = sys$close(&fab)) !=RMS$_NORMAL) lib$stop(status) ;
  /* Retrieving the new revision date */
  if ((status = sys$asctim(&timlen,&timbuf,&xabrdt.xab$q_rdt,0)) != SS$_NORMAL) lib$stop(status) ;
  printf("New revision date : %s\n" , timbuf.dsc$a_pointer) ;
  }
close(f);
close(fr);
}

__________________________________________________________________________________________________ 

IMPRESSUM: The ModulaTor is an unrefereed journal. Technical papers are to be taken as working papers and personal rather than organizational statements. Items are printed at the discretion of the Editor based upon his judgement on the interest and relevancy to the readership. Letters, announcements, and other items of professional interest are selected on the same basis. Office of publication: The Editor of The ModulaTor is Guenter Dotzel; he can be reached by tel/fax: [removed due to abuse] or by mailto:[email deleted due to spam]
  ModulaWare home page   The ModulaTor download    [Any browser]

Webdesign by www.otolo.com/webworx, 14-Jul-1998