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 } RecordSize := ExaRecSize ; { get full record } END ; { all fields not specified will take their default condition } PrmOpe ( IdxFile, Status ) ; 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.