{
DATE : 

AUTHOR : 
     Kenneth G. Tibesar
     3M Engineering Systems and Technology Labs
     3M Center, Bldg 518-1
     St. Paul, Minn. 55144

REVISION HISTORY :

DESCRIPTION :

ENVIROMENT :          
     DEC PDP-11 
     RSX-11M or RSX-11M+

}

PROGRAM PrmExample ;
CONST
  IdxLch	= 3 ;		{ of the first 6 UNITS } 
  RelLch	= 4 ;		{ ch. 3 & 4 avail. by default }
  SeqLch	= 7 ;		{ must spec. UNITS=n for units > 6 }

  
  NameSize	= 30 ;		{ size of the file name }
  ExaRecSize	= 28 ;		{ full record size }

  { example labels and sizes follow - user defines buffer sizes and labels }
  Key0Size	= 4 ;		{ user defines size of largest key }
  Key1Size	= 3 ;		{ user defines these labels and sizes }  

TYPE
  RecDef	= RECORD	{ user defined record type #1 }
    SecNum	: ARRAY [1..4] OF CHAR ;	{ section number }
    SecSup	: ARRAY [1..3] OF CHAR ;	{ sup initials }
    Fill	: char ;
    SecDesc	: ARRAY [1..20] OF CHAR 
    END ; { RECORD }

  TwoWord	= ARRAY [1..2] OF integer ;	{ record number size }
  KeyDef	= RECORD
    CASE integer OF	{ user defines keylabels and sizes, as many as req. }
      1 : ( Idx0 : ARRAY [1..Key0Size] OF CHAR) ; { index file prim. key 0 }
      2 : ( Idx1 : ARRAY [1..Key1Size] OF CHAR) ; { index file alt key 1 }
      3 : ( RecNum : TwoWord ) ;  { REL file rec. #, Org=REL, Search=REC }
    END ;


{***********************************************************************
                     BEGIN PRM CONST and TYPE
        FILE [300,47]PrmPrefix.Pas
          Refer to file [300,47]PrmCalls.Pas for Procedure Calls 
 *********************************************************************** 
}
  
CONST
  { * Error values returned in status word 1 and word 2 with each PRM call.
    * All errors set Status[1] to a negative value.

  PrINI	= -5001 ;   		{  file not properly initialized }
  PrRne	= -5002 ;  		{ file and user specified record not equal }
  PrRsz	= -5003 ;  		{ record size must be loaded before PRMRet }
  PrKY0	= -5004 ;   		{ specify key 0 first }
  PrKNS	= -5005 ;   		{ no key number specified }
  PrAsc	= -5006 ;   		{ keys specified in a non-ascending order }
  ErDup	= -544 ;		{ insert duplicate rec with no dups allowed }
  ErEof = -592 ;		{ record processing reached end-of-file }
  ErFac = -656 ;		{ record opr does not match declared access }
  ErFnf = -736 ;		{ file not found during open }
  ErRlk = -1440 ;		{ target record was locked by another task }
  ErRnf = -1472 ;		{ random get or find did not locate record }



TYPE
  RmsFileName	= ARRAY [1..NameSize] OF CHAR ;	{ file name, do not alter }
  RmsStatus	= ARRAY [1..2] OF integer ;	{ returned rms status codes }

  OrgTypes	= (SEQ,REL,IDX) ;	{ block i/o not supported }
  AllowTypes	= (Share,NoShare) ;      { what others can do }
  AccessTypes	= (PRead,PWrite,PBoth) ; { what you can do to the file }
  FormType = (FFIX,FVAR,FSTREAM) ;	{ record format type }

  RmsFileDesc	= RECORD
    Org		: OrgTypes ;	{ spec. file type, NO DEFAULT }
    FileName	: RmsFileName ;	{ full spec. of rms file, NO DEFAULT }
    LogChan	: integer ;	{ spec. ch. n, NO DEF., n<= TKB UNITS=n }
    Allow	: AllowTypes ;	{ what others may do with file, DEF Share }
    Access	: AccessTypes ;	{ what you may do to the file, DEFAULT Read }
    RecordSize  : INTEGER ;	{ MUST = max. file rec. size, NO DEFAULT }
    Windows	: INTEGER ;	{ no. of ret. windows, DEFAULT usually 7 }

    { enable the following options with a capital "Y", ANY OTHER = DEFAULT }
    DeferWrite	: CHAR ;	{ IDX, defer write, def. write each record }
    Unlock    	: CHAR ;  	{ REL & IDX, don't lock if abort, DEF. LOCK }
    ObeyFill	: CHAR ;	{ obey bucket fill numbers, DEF. FILL TO MAX }
    MassInsert	: CHAR ;	{ IDX, ref. rms-11 macro ref. man. rab rop }
    FileEnd	: CHAR ;	{ SEQ only, place file stream at end of file }

    { file creation fields }
    RecForm	: FormType ;	{ rec. format, FSTREAM for seq., Def.= FFix }
    Allocation  : TwoWord ;	{ no. blocks allocated to file, DEF. 0 BLKS }
    BucketSize	: integer ;	{ data bucket size, DEFAULT BUCKETSIZE = 1 }
    ExtQua	: integer ;	{ no. blks dynamic extend file, DEFAULT 1}
    { Enable following with capital "Y", if not loaded, default is selected }
    Contiguous	: CHAR ;	{ create a contiguous file, DEF. FRAGMENTED }
    Temporary	: char ;	{ delete the file when closed, DEF. NO DEL. }

    WorkSpace	: PACKED ARRAY [1..160] OF char ;
  END ;	{ RmsFileDesc Record }

  SearchTypes	= (EQ,GT,GE,RFA,NEX,REC) ; { for GET use KeyData(EQ'=',GT'>',
                    GE'>='), RFA, next seq. rec(NEX) or Rec. # (org=REL) }
  ThreeWord	= ARRAY [1..3] OF Integer ;	{ for RFA's, big file huh }
  RecOps	= (PGET,PFIND,PPUT,PUPDATE) ; { PRM record operations }
  RetRecord = RECORD
    { - USE with PRMRET, INPUT - to GET and FIND - INPUT/OUTPUT ref. to PRM }
    KeyNum	: Threeword ;	{ INPUT- IDX Key # or RFA, search defines }
    Search	: SearchTypes ;	{ INPUT - spec. search opr }
    RecSize	: integer ;	{ INPUT - sz rec. to PGET, (sz of rec. buffer)
                                  OUTPUT- sz rec. returned to user rec. buf }
    RFAout	: ThreeWord ;	{ OUTPUT- valid if search <> RFA }
    KeySize	: integer ;	{ INPUT - size of key data, <= full key size }
    KeyData	: KeyDef ;	{ INPUT - IDX or REL, key string or rec. # }
  END ;	{ RetRecord RECORD Definition }

  StoRecord = RECORD
      { USE with PRMSTO, Input to PUT and UPDATE - INPUT/OUTPUT ref. to PRM }
      RecSize	: integer ;	{ INPUT - spec. part or all or rec. buffer 
                                  data to be stored, <= full rec. sz }
      RFAOut	: ThreeWord ;	{ OUTPUT - rfa where record was stored }
      Cell	: KeyDef ;	{ INPUT - REL ONLY, spec. rec. # for store }
    END ;	{ StoRecord Record }

  KType = (StrKey,IntKey) ;	{ string or unsigned integer key type }
  { Use with MULTIPLE calls of PRMKEY to define ALL keys of an indexed file. 
    MUST be used at least once prior to PrmCre of an indexed file type }
  IdxKeyDesc = RECORD
      KeyNum	: Integer ;	{ key of ref. #, def. asc. order, start 0 }
      KeyPos	: Integer ;	{ byte position of key in rec., start byte 0 }
      KeySiz	: Integer ;	{ size of the key defining, max. = 255 }
      KeyTyp	: KType ;	{ string or unsigned integer, def.=string }
      KeyDup	: char ;	{ 'Y' to allow duplicate keys, def. no dup }
      KeyChg	: char ;	{ 'Y' for key changes, alt. only, def no chg }
      KeyNul	: char ;	{ null key value, alt. string keys only }
    END ;	{ IdxKeyDesc }


  {***********************************************************************
 *                   END PRM CONST and TYPE                            *
 *********************************************************************** }
  
 

VAR
  chtfile	: text ;
  Rlen		: integer ;
  i		: integer ;
  SeqRfas	: ARRAY [1..4] OF ThreeWord;	{ used to store rfa's }

  IdxFile	: RmsFileDesc ;	{ file parameters for idx file }
  IdxStoBuf	: StoRecord ;	{ store buffer, shared by rel file }

  RelFile	: RmsFileDesc ;	{ file parameters for rel file }

  SeqFile	: RmsFileDesc ;	{ file parameters for seq. file }
  SeqStoBuf	: StoRecord ;	{ store buffer for sequential file }

  RecBuf	: RecDef ;	{ same record buffer for all files }
  RetBuf	: RetRecord ;	{ retreival buffer, same for all file }
  RfaBuf	: Threeword ;	{ returned rfa from record ops }
  Status	: RmsStatus ;	{ returned rms status codes }



{ close the file }
PROCEDURE PRMClo ( VAR Filebuf : RmsFileDesc ;	{ ref. to file to close }
                   VAR Status  : RmsStatus ) ;	{ STS and STV }
                   EXTERNAL ;

{ Delete a record, must be preceded with successful GET or FIND (PRMRet) }
PROCEDURE PRMDel ( VAR FileBuf : RmsFileDesc ;	{ ref. to file to delete rec }
                   VAR Status  : RmsStatus ) ;	{ STS and STV }
                   EXTERNAL ;

{ Open an RMS Indexed file previously defined with RMSDEF }
PROCEDURE PRMOpe ( VAR FileBuf : RmsFileDesc ;   { load fields before open }
                   VAR Status  : RmsStatus ) ;	{ status of Sts and Stv }
                   EXTERNAL ;

{ Record retrieval from the specified file }
PROCEDURE PRMRet( Operation : RecOps ;		{ define GET or FIND }
                   VAR FileBuf : RmsFileDesc ;	{ ref. to file for access }
                   VAR RetData : RetRecord ;	{ load with type of opr }
                   VAR RecBuf  : RecDef  ;	{ rec. buf connected to use }
                   VAR Status  : RmsStatus ) ;	{ status of STS and STV }
                   EXTERNAL ;

{ Store a record in the specified file }
PROCEDURE PRMSto ( Operation   : RecOps ;	{ define PUT or UPDATE }
                   VAR FileBuf : RmsFileDesc ;	{ ref. to file for store }
                   VAR StoData : StoRecord ;	{ store variables }
                   VAR RecBuf  : RecDef ;	{ rec. buf connected to use }
                   VAR Status  : RmsStatus);	{ STS and STV }
                   EXTERNAL ;

{ Define a routine to GET and DISPOSE heap space, execute first in root seg }
PROCEDURE RmsIni ; EXTERNAL ;



PROCEDURE OpenFiles ;
BEGIN
{ open an rms indexed file }
WITH IdxFile DO
  BEGIN
    Org := IDX ;			{ file orgainization code }
    FileName :=   '[300,47]PrmExa.Idx            ' ; { file name }
    LogChan := IdxLch ;			{ file logical channel number }
    Access := PBoth ;			{ both read and write to the file }
    Allow := NoShare ;
    RecordSize := ExaRecSize ;		{ get full record }
  END ;
{ all fields not specified will take their default condition }
PrmOpe ( IdxFile, Status ) ;

{ The following checks are made for the IDX file only as an example. }
IF IdxFile.Org <> IDX
  THEN writeln ('File type <> designated file type' ) ;
IF Status[1] = PrRne	{ record size input <> to file record size }
   THEN 
     BEGIN
       writeln ( chr(7) ) ;	{ bell }
       writeln ( 'File record size does not match input record size.' ) ;
       writeln ( '    Input file record size = ', IdxFile.RecordSize ) ;
       writeln ( '    Actual file record size = ', Status[2] ) ;
    END ;

IF Status[1] < 1 
  THEN writeln('Idx Open error, code=',Status[1], Status[2] ) ;

{ open and rms relative file }
WITH RelFile DO
  BEGIN
    Org := REL ;
    FileName :=   '[300,47]PrmExa.Rel            ' ;
    LogChan := RelLch ;
    Access := PBoth ;			{ both read and write to the file }
    RecordSize := ExaRecSize ;
  END ;
PrmOpe ( RelFile, Status ) ;
IF Status[1] < 1 THEN writeln('Rel Open error, code=',Status[1], Status[2] ) ;

{ open an rms sequential file }
WITH SeqFile DO
  BEGIN
    Org := SEQ ;
    FileName := '[300,47]PrmExa.Seq            ' ;
    LogChan := SeqLch ;
    Access := PBoth ;			{ both read and write to the file }
    SeqFile.FileEnd := 'Y' ;		{ pointer to end of file for PrmSto }
    RecordSize := ExaRecSize ;
  END ;
PrmOpe ( SeqFile, Status ) ;
IF Status[1] < 1 THEN writeln('Seq Open error, code=',Status[1], Status[2] ) ;

END ;	{ PROCEDURE Openfiles }



PROCEDURE AddNewRec ( VAR TarFile : RmsFileDesc ; 
                      VAR TarRec : RecDef ;
                      VAR TarStoBuf : StoRecord ) ;
  PROCEDURE StoreIt ;
  BEGIN
    TarStoBuf.RecSize := ExaRecSize ;	{ specify each time }    
    PRMSto ( PPUT, TarFile, TarStoBuf, RecBuf, Status ) ;
    writeln('store ', status[1],status[2]);
  END ;

BEGIN
  TarStoBuf.RecSize := ExaRecSize ;	{ spec. record size to store }

  { load the record buffer }
  TarRec.SecNum := '86A ' ;
  TarRec.SecSup := 'AAC' ;
  TarRec.SecDesc := 'Optical Inspection  ' ;                   
  StoreIt ;

  TarRec.SecNum := '86C ' ;
  TarRec.SecSup := 'TMT' ; 
  TarRec.SecDesc := 'Ultrasonic Process  ' ;
  StoreIt ;

  TarRec.SecNum := '86B ' ;
  TarRec.SecSup := 'WHO' ;
  TarRec.SecDesc := 'Computer Nurds      ' ;                   
  StoreIt ;

END ;	{ PROCEDURE AddNewRec }

PROCEDURE XferToSeq ;
BEGIN
  { find the first record by retreiving with a search of GE and setting
    a key value < the first record key entry of the file }
  RetBuf.KeyNum[1] := 0 ;	{ load IDX key # for retreival of records }
  RetBuf.Search := GE ;		{ set search type }
  RetBuf.KeySize := 1 ;		{ size of key data to search for }
  RetBuf.KeyData.Idx0 := '    ' ;  { set the key to blanks }
  RetBuf.RecSize := ExaRecSize ; { may be destoyed, load each time }
  PrmRet ( PFIND, IdxFile, RetBuf, RecBuf, Status ) ;	{ find 1st rec. }

  IF Status[1] < 1 
    THEN writeln('idx retreive error=',status[1], status[2])
    ELSE
      BEGIN
        writeln ; writeln('begin xfer');
        i := 1 ;
        RetBuf.Search := NEX ;		{ set sequential mode of retrieval }
        REPEAT 
          RetBuf.RecSize := ExaRecSize ; { may be destoyed, load each time }
          PrmRet( PGET, IdxFile, RetBuf, RecBuf, Status ) ; { get a record }
          IF Status[1] < 1 
            THEN writeln('GET fail = ',status[1],status[2] )
            ELSE
              BEGIN
                { no need to xfer buffer, seq and idx have same rec. buffers }
                RetBuf.RecSize := ExaRecSize ; { load each time }
                PRMSto ( PPUT, SeqFile, SeqStoBuf, RecBuf, Status ) ;
                IF Status[1] < 1 
                  THEN writeln('PUT fail = ',status[1],status[2] )
                  ELSE 
                    IF i < 5 THEN	{ Store 4 RFA's for retreival }
                    BEGIN
                      SeqRfas[i,1] := SeqStoBuf.RfaOut[1] ;  { save the RFA }
                      SeqRfas[i,2] := SeqStoBuf.RfaOut[2] ;  { save the RFA }
                      SeqRfas[i,3] := SeqStoBuf.RfaOut[3] ;  { save the RFA }
                      writeln('Stored at RFA=', SeqRfas[i,1]:4, 
                               SeqRfas[i,2]:4,SeqRfas[i,3]:4, ' data=',
                               RecBuf.SecNum, 
                               RecBuf.SecSup, recBuf.SecDesc ) ;
                      i := i + 1 ;
                    END ;
              END ;
        UNTIL Status[1] = ErEof ;    { get all record, go till end-of-file }
        writeln('xfer from idx to seq complete') ;
      END ;	{ ELSE }
           
END;	{ PROCEDURE XferToSeq }

PROCEDURE RetByRfa ;
  PROCEDURE GetRecord ( i : integer ) ;
  BEGIN
    RetBuf.KeyNum[1] := SeqRfas[i,1] ;  	{ load keynum with the rfa }
    RetBuf.KeyNum[2] := SeqRfas[i,2] ;  
    RetBuf.KeyNum[3] := SeqRfas[i,3] ;  
    RetBuf.RecSize := ExaRecSize ;	{ load each time }
    PrmRet( PGET, SeqFile, RetBuf, RecBuf, Status ) ;	{ get the record }
    IF Status[1] >= 1 
      THEN		{ write the record }
        writeln('RFA NO.= ', SeqRfas[i,1]:4,
                SeqRfas[i,2]:4, SeqRfas[i,3]:3,' data=',
                RecBuf.SecNum, RecBuf.SecSup, recBuf.SecDesc ) 
      ELSE
        writeln('RFA access error=',status[1],status[2]) ;
  END ;
BEGIN
  writeln; writeln('Begin random retreival from a seq. file by RFA') ;
  RetBuf.RecSize := ExaRecSize ;	{ record size chg. by PRMRet that
                                          failed due to ErEof, must reload }
    RetBuf.Search := RFA ;		{ set search to access by RFA }
    GetRecord ( 4 ) ;			{ get record spec. in array [4] }
    GetRecord ( 1 ) ;
    GetRecord ( 3 ) ;
    GetRecord ( 2 ) ;
END;	{ PROCEDURE RetByRfa }


PROCEDURE RetRelative ;
BEGIN
  RetBuf.KeyData.RecNum[1] := 1 ;	{ specify record number, 2 word }
  RetBuf.KeyData.RecNum[2] := 0 ;
  RetBuf.Search := REC ;	{ search by a rec # vs. a string or RFA }
  RetBuf.RecSize := ExaRecSize ;
  PrmRet( PFIND, RelFile, RetBuf, RecBuf, Status ) ;
  IF Status[1] < 1 
    THEN writeln (' fail to find 1st relative record, sts=',status[1] ) ;

  RetBuf.Search := NEX ;		{ switch from random to seq search }
  writeln; writeln('Begin Relative File data retreival') ;
  IF Status[1] >= 1 
    THEN
      REPEAT	{ dump the entire file contents }
        PrmRet( PGET, RelFile, RetBuf, RecBuf, Status ) ;
        IF Status[1] >= 1 
          THEN writeln('data = ', RecBuf.SecNum, RecBuf.SecDesc ) 
          ELSE writeln('Get error=',status[1], status[2]);
      UNTIL Status[1] = ErEof ;  
END ;


BEGIN
  RmsIni ;			{ must specify before any rms ops }
  Openfiles ;			{ open all the files }
  AddNewRec ( IdxFile, RecBuf, IdxStoBuf ) ;	{ add to indexed file }
  AddNewRec ( RelFile, RecBuf, IdxStoBuf ) ;	{ add to relative file }
  AddNewRec ( SeqFile, RecBuf, SeqStoBuf ) ;	{ add to sequential file }
  XferToSeq ;			{ transfer records from idex to seq. file }
  RetByRfa ;			{ retrieve random from seq. by RFA }
  RetRelative ;			{ retrieve all records from relative file }
  PrmClo ( IdxFile ,status) ;	{ close all the files that are open }
  PrmClo ( RelFile ,status) ;
  PrmClo ( SeqFile ,status) ;
END.
