.title rsxcre create a file .ident /4.0.01/ .enabl gbl .psect $code ; edits ; ; 07-Jan-83 10:20:06 BDN fix device defaults for VMS ; 23-Feb-83 16:37:37 BDN kludge to catch bug in VMS/AME for ; returned IE.NSF for certain types ; of bad filenames. ; 03-Mar-83 14:28:29 BDN don't alter default protection if ; the file is a new one (ie, prot=0) inpbuf = inbuf bf$pnt = bufpnt er$sav = errsav by$cnt = recount bl$num = blknum io$sta = iostat .mcall fdbdf$ ,fdat$a ,fdrc$a ,fdop$a ,fdbf$a ,fdbk$a .mcall qiow$ ,dir$ ,finit$ ,exit$s ,fsrsz$ .mcall csi$ ,csi$1 ,csi$2 .mcall opns$r ,open$w ,ofnb$r ,opnt$d ,close$ .mcall get$ ,put$ ,read$ ,write$ ,wait$ ,fdbk$r .mcall fdat$r ,fdof$l .mcall alun$s ,fdop$r fdof$l .mcall nmblk$ rsxdef: nmblk$ ,,,SY,0 .macro moverr err mov err ,-(sp) call seterr .endm moverr .sbttl create seq record i/o file e$crea:: $creat::call cre tstb er$sav beq 100$ cmpb er$sav ,#ie.alc beq 10$ cmpb er$sav ,#ie.dfu bne 100$ 10$: neg outsiz call cre neg outsiz 100$: return global fsize = 60. cre: save ; save registers please sub #fsize ,sp ; a temp place to copy to mov sp ,r2 clr er$sav ; assume no errors yet. mov #45 ,r1 ; max count to copy mov @r5 ,r0 ; copy the string now so we 10$: cmpb @r0 ,#'/ ; can remove switches and also beq 20$ ; protect ourselves from the movb (r0)+ ,(r2)+ ; unfortunate CSI feature of beq 20$ ; overwriting the filename which sob r1 ,10$ ; does not work for r/o RESLIBs. 20$: clrb @r2 ; insure a .asciz string mov sp ,r2 ; point back to the ame copy .len r2 ; get the string length now mov r0 ,r1 ; save it so CSI doesn't zap it. beq 90$ ; oops, no string length here! save ; clear csiblk out please mov #csiblk ,r2 ; address of csi work area mov #c.size ,r0 ; size in bytes of it 30$: clrb (r2)+ ; clear a byte sob r0 ,30$ ; next please unsave ; pop register --> filename csi$1 #csiblk,r2,r1 ; now do the first scan. bcs 100$ ; oops csi$2 #csiblk,OUTPUT ; finish up the scan please bcs 100$ ; oops mov 2(r5) ,r1 ; channel number to use beq 90$ ; channel 0 ? asl r1 ; times 2 please clr bf$pnt(r1) ; init single char pointer clr bl$num(r1) ; clear current block number clr mx$siz(r1) ; clear max size of written rec save mov inprot ,r1 ; set prot code for create beq 35$ ; file must be new if no old prot bic #40!100 ,r1 ; allow owner write access call .wdffp ; 35$: mov infilo ,r1 ; set correct file owner now call .wfown ; simple unsave mov rwfdbl(r1),r0 ;Get FDB ; HAH mov r0 ,-(sp) ; for VMS, try to insure that ;BDN add #f.fnb ,r0 ; there nothing is left over ;BDN mov #s.fdb-f.fnb,r2 ; in the fdb filename block ;BDN 40$: clrb (r0)+ ; clear name,device,did and ;BDN sob r2 ,40$ ; fileid out please ;BDN mov (sp)+ ,r0 ; restore FDB pointer now ;BDN mov @#outsiz,f.cntg(r0) ;Set block size wanted ; HAH alun$s 2(r5),#"SY,#0 open$w rwfdbl(r1),2(r5),,,buflst(r1),#512. mov rwfdbl(r1),r0 ; point to the fbd for this file bcc 50$ ; oops call 400$ ; on VMS certain bad filenames get br 105$ ; ie.nsf instead of an ie.bnm err. 50$: movb f.racc(r0),filmod(r1) ; save the record access (fd.rw) movb f.rtyp(r0),rc$fmt+0(r1) ; save the record type movb f.ratt(r0),rc$fmt+1(r1) ; and record attributes if any mov #10000 ,io$sta(r1) ; force RSTS disk flag 90$: add #fsize ,sp ; pop filename buffer and exit unsave ; pop temps and exit clc ; success? return ; bye 100$: moverr # ; say filename was bad br 110$ ; and exit 105$: mov fdblst(r1),r1 ; point to fdb and extract the moverr f.err(r1) ; error code, then exit 110$: add #fsize ,sp ; fix stack at exit unsave ; bye sec return 400$: tst f.fnb+n.stat(r0) ; if .parse crapped then the status bne 410$ ; field will be zapped on VMS AME. movb #ie.bnm ,f.err(r0) ; if so, stuff a bad name error in. sec ; and say we failed return 410$: clc ; success return global .end