.title rsxcre create a file .ident /4.0.01/ .enabl gbl .psect $code 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 fdof$l .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 cre: save ; save registers please sub #50 ,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! 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 bic #40!100 ,r1 ; allow owner write access call .wdffp ; mov infilo ,r1 ; set correct file owner now call .wfown ; simple unsave mov rwfdbl(r1),r0 ;Get FDB ; HAH mov @#outsiz,f.cntg(r0) ;Set block size wanted ; HAH ;;- fdat$r rwfdbl(r1),#r.var,#fd.cr; open$w rwfdbl(r1),2(r5),,,buflst(r1),#512. bcs 105$ ; oops mov rwfdbl(r1),r0 ; point to the fbd for this file 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 #50 ,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 #50 ,sp ; fix stack at exit unsave ; bye sec return global .end