PRMCRE.PAS/-AU=
{
DATE : 

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

REVISION HISTORY :

  DATE     BY      DESCRIPTION

03-AUG-81 KGT      It was assumed that the buffer passed to PrmCre was
                   clear and only the rab and fab fields that required
                   loading were loaded.  It is possible to have garbage
                   left in the rab and fab and a file create would bomb.
                   The designated rab and fab areas are now cleared first.
10-AUG-81 KGT      The above change destoyed any previous call to PrmKey
                   used for indexed files.  PrmKey will clear the rab and
                   fab and indicate the action by setting fab.ctx = 1.
                   The clearing of the rab and fab is now conditional.

DESCRIPTION :

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

}

{$E+ External procedure}
{$C
	.TITLE	PRMCRE
	.IDENT	"810810"
}
@[300,47]prmconst.pas
@RMSCONST.PAS
TYPE
@RMSTYPE.PAS
@Fab.pas
@rab.Pas
@xab.pas
@PRMTYPE.PAS
  
{ Create the file described by the CreFileDesc buffer }
PROCEDURE PRMCre (VAR CreBuf : RmsFileDesc ;
                  VAR Status  : RmsStatus ) ;	{ status of Sts and Stv }
VAR
  i,j 			: integer ;
  FPtr,XPtr,DPtr	: ^XabRec ;
BEGIN
  WITH CreBuf DO
  WITH Fab DO
    BEGIN
      { clear the rab and fab allocated buffer area before using }
      IF Ctx <> 1	{ has PrmKey cleared the buffers? }
        THEN	{ PRMKEY call will set Fab.Ctx = 1 after init of rab & fab }
          BEGIN
            FOR i := 1 TO 40 DO
              BEGIN
                Rab.AllRab[i] := 0 ;
                Fab.AllFab[i] := 0 ;
              END ;	{ FOR }
            Ctx := 1 ;		{ may be set false multiple places below }
          END ;	{ THEN }


      FOR i := 1 TO NameSize DO IF FileName[i] = ' ' THEN EXIT ;
      FOR j := 1 TO i DO IF FileName[j] >= 'a' 	{ make all caps }
        THEN FileName[j] := chr(ord(FileName[j]) - 40B) ;
      Fns := chr(i - 1) ;		{ name size if one less than blank }
      Fna := @FileName ;
      Lch := chr(LogChan) ;		{ logical channel number }
 
      IF RecForm = FFIX THEN Rfm := chr(FbFix) ;
      IF RecForm = FVAR THEN Rfm := chr(FbVar) ;
      IF RecForm = FSTREAM  THEN Rfm := chr(FbStm) ;
      Mrs := RecordSize ;

      Fac := chr(FbGet OR FbPut OR FbDel OR FbUpd) ;
      Rtv := chr(Windows) ;		{ set window size }

      bid := chr(3B);		{ Set buffer identification field }
      bln := chr(120B);		{ Set rab length field }
      bpa := 0;			{ Set buffer pool for GSA routine }

      CASE CreBuf.ORG OF
        SEQ : Org := chr (FbSeq) ;
        REL : Org := chr (FbRel) ;
        IDX : 
          BEGIN
            Org := chr (FbIdx) ;
            IF Xab = NIL 
              THEN 
                BEGIN
		  Status[1] := PrKNS ;	{ primary key not specified }
		  Ctx := -1 ;		{ inhibit record operations }
		END ;
          END ;
        END ;	{ CASE }

      Alq.Low := Allocation[1] ;
      Alq.High := Allocation[2] ;
      Bks := chr(BucketSize) ;
      Deq := ExtQua ;
      Fop := 0 ;	{ initialize before bit sets below }
      IF Contiguous = 'Y' THEN Fop := ((Fop) OR (FbCtg )) ;
      IF DeferWrite = 'Y' THEN Fop := ((Fop) OR (FbDfw )) ;
      IF Temporary  = 'Y' THEN Fop := ((Fop) OR (FbTmd )) ;

      IF Ctx = 1 
        THEN
          BEGIN
            {$C
            .mcall $Create
            MOV CreBuf(sp), r0
            ADD #FAB, r0 	
            $Create r0 
            }

           { time to get rid of the XAB if any and return the memory }
           IF Xab <> Nil 	{ do we have XAB allocated? }
             THEN
               BEGIN
                 REPEAT
                   XPtr := Xab ;	{ get the first pointer }
                   While XPtr^.Nxt <> Nil DO 
                     BEGIN
                       FPtr := Xptr ;
                       Xptr := XPtr^.Nxt ;
                     END ;
                   DisPose ( XPtr ) ;
                   Fptr^.Nxt := Nil ;
                 UNTIL XPtr = Xab ;	{ if = we have dispose the last one }
               END ;


            IF Fab.Sts >= 1 
              THEN
                BEGIN
                  Rab.Fab := @Fab ;		{ set address of fab in rab }

  		 { set up record options }
		IF CreBuf.Org = REL 
		  THEN Rab.Ksz := chr(4) ;  { key size always for REL files }
	    
		rab.bid := chr(1B);	{ Set buffer identification field }
		rab.bln := chr(120B);	{ Set rab length field }
                {$C
                .mcall $connect
                mov CreBuf(sp), r0	; address of filebuf from stack
                add #rab, r0		; calc addr. of rab in filebuf
                $connect r0		; Connect to the file
                }
                IF Rab.Sts < 1 		{ did connect fail? }
                  THEN Ctx := -1 ;	{ indication to other PRM routines
                                          that PRMOPE failed. }
              END ;	{ IF Fab.Sts >= 1 }


            IF Fab.Sts < 1	{ load with fab if fail otherwise rab }
              THEN 
                BEGIN
                  Ctx := -1 ;		{ inhibit any record operations }
                  Status[1] := Fab.Sts ;
                  Status[2] := Fab.Stv ;
                END
              ELSE
                BEGIN
                  Status[1] := Rab.Sts ;
                  Status[2] := Rab.Stv ;
                END 
          END ;	{ IF Ctx = 1 }
    END ;	{ WITH }  
END ;
/