$MACRO REGS $ENDM / PROGRAM ;unix io .mcall fdop$a,fdat$a,fdbdf$,fdrc$a .mcall read$,write$,wait$ .mcall fdrc$r,fdat$r nofile=-26. eof=-10. newline=12 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - struct bfdb ;buffered fdb's bfdb=-32. member b.lh,b.lhl[4],b.max[1],b.cur[1] member b.type,b.dirty,b.stat,b.seek[4] member b.stype,b.ssize,b.sracc member b.io,b.prec,b.pos,b.check end-struct b.peek=b.lhl ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - .title uio ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - function bclose[fdb] r4 := fdb if b.type(r4) = 1 lrufin[r4] elseif b.prec(r4) ne 0 if b.io(r4) ge 0 and b.dirty(r4) = 0 and b.type(r4) = 1 putblk[r4] fi if b.io(r4) ge 0 and b.type(r4) ne 1 fl$ush[r4] fi if b.type(r4) = 1 csattr[r4,r4] fi dealb[r4] fi close[r4] ret ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - auto type,io e%s status 14 e%s fd 13 e%s access 12 function bopen[fdb,name,acc,ptype] status=%4 ;define register variables fd=%3 ;for highly used stuff access=%2 ; type := 0 ;assume rsx record i/o fd := fdb ifb @ptype(r5) = #'U or @ptype(r5) = #'u ;test for unix type type := 1 fi if b.check(fd) ne 12345 ;check for this to be safe printf "Bad Fdb=%o - invalid check word" fdb fi access := fdb f.actl(access) := #fa.dlk!fa.enb ;don't lock files b.prec(access) := new[#512.] access := acc movb @acc(r5),status bic #40,status ;to upper case select case status of caseb #'U io := 0 access := "u" break caseb #'A io := 0 access := "a" break caseb #'R io := -1 break caseb #'W io := 1 break esac status := op$en[fdb,name,access] if status = #nofile ;-26 movb @acc(r5),r0 ifb r0 = #'u or r0 = #'U or r0 = #'a or r0 = #'A status := op$en[fdb,name,"write"] if status ne 1 jmp badopn fi fi elseif status ne 1 badopn: if access ne acc and strlen[acc] ne 1 printf "Cannot open %s for %s (%d)" name acc status fi dealb[fdb] ret status fi b.io(fd) := io b.stat(fd) := status b.type(fd) := type if io lt 0 b.pos(fd) := 0 ;if read else b.pos(fd) := b.prec(fd) ;if writing fi b.seek(fd) := 0 b.seek+2(fd) := 0 b.dirty(fd) := 1 b.stype(fd) := f.rtyp(fd) b.ssize(fd) := f.rsize(fd) b.sracc(fd) := f.racc(fd) if type = 1 f.rtyp(fd) := #r.fix if b.io(fd) = 1 b.io(fd) := 0 ;always do update mode now fi #f.racc[fd,b] := #fd.rwm f.rsize(fd) := 512 lruset[fd] ;init lru linkage else mov #-1,b.peek(fd) ;clear peek char fi if b.io(fd) ne 1 and type = 1 clr f.bkvb(fd) mov #1,f.bkvb+2(fd) b.stat(fd) := getblk[fd] fi ret status ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - function cattr[fdb1,fdb2] loop for r4 = 0 to 1 .fdb2[r4] := .fdb1[r4] next r4 loop for r4 = 4 to 6 .fdb2[r4] := .fdb1[r4] next r4 ret ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - function csattr[fdb1,fdb2] #f.rtyp[fdb2] := #b.stype[fdb1] #f.rsize[fdb2] := #b.ssize[fdb1] #f.racc[fdb2] := #b.sracc[fdb1] ret ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - function dealb[fdb] r4 := fdb if b.prec(r4) ne 0 release[b.prec(r4)] b.prec(r4) := 0 fi ret ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - function fl$ush[fdb] r4 := fdb if b.pos(r4) = 0 or b.pos(r4) = b.prec(r4) ret else clrb @b.pos(r4) put[r4,b.prec(r4)] clr b.pos(r4) ret fi ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - function getchar[xxx] ret getc[stdin] ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - auto s[4] regs function getc[fdb] mov fdb,r0 ;copy file desc if b.type(r0) = 1 if b.stat(r0) lt 0 ;check for eof on last seek ret b.stat(r0) fi mov b.prec(r0),r1 ;get addr of block buffer mov b.seek(r0),r4 ;get seek low order bic 0177000,r4 ;just the offset into block mov r4,r2 ;copy for later add r1,r4 ;this is the byte address movb (r4),r3 ;move the char from block buffer bic 0177400,r3 ;just return 8 bits of char if r2 = 0777 ;is it going to overflow to next block mov b.seek(r0),s(r5) ;need to compute new seek address mov b.seek+2(r0),s+2(r5) ;in 32 bit integers add #1,s(r5) ;can't use an inc here adc s+2(r5) ;or the overflow don't get set seekm[r0,&s] ; else inc b.seek(r0) ;no, just inc it for speed fi ret r3 else mov r0,r4 if b.peek(r4) = -1 if b.pos(r4) = 0 get[r4,b.prec(r4),510] b.pos(r4) := b.prec(r4) if r0 ne 1 ret fi fi movb @b.pos(r4),r0 if eq mov #12,r0 clr b.pos(r4) else inc b.pos(r4) fi else movb b.peek(r4),r0 mov -1,b.peek(r4) fi ret fi function ungetc[c,fd] r4 := fd movb c,b.peek(r4) ret ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - function mark[fdb,plong] r4 := plong r3 := fdb (r4) := b.seek(r3) 2(r4) := b.seek+2(r3) ret r4 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - function markl[fdb] r3 := fdb r1 := b.seek(r3) r0 := b.seek+2(r3) ret ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - auto s[4] regs function putc[char,fdb] mov fdb,r0 ;copy file desc if b.type(r0) = 1 mov b.prec(r0),r1 ;get addr of block buffer mov b.seek(r0),r4 ;get seek low order bic 0177000,r4 ;just the offset into block mov r4,r2 ;copy for later add r1,r4 ;this is the byte address movb char,(r4) ;move the char into block buffer clr b.dirty(r0) ;indicate a dirty block if r2 = 0777 ;is it going to overflow to next block mov b.seek(r0),s(r5) ;need to compute new seek address mov b.seek+2(r0),s+2(r5) ;in 32 bit integers add #1,s(r5) ;can't use an inc here adc s+2(r5) ;or the overflow don't get set if seekm[r0,&s] = #eof ; #b.stat[fdb] := 1 r0 := 1 fi ret else inc b.seek(r0) ;no, just inc it for speed ret 1 fi else mov r0,r4 ifb char ne #newline movb char,@b.pos(r4) inc b.pos(r4) else clrb @b.pos(r4) put[r4,b.prec(r4)] b.pos(r4) := b.prec(r4) fi ret fi function putchar[ch] ret putc[ch,stdout] ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - auto long[4] function seekl[fd,plong1,plong2] long(r5) := plong2 long+2(r5) := plong1 ret seekm[fd,&long] ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - auto rflag,newblk regs function seekm[fdb,plong] r4 := fdb ;copy fdb rflag := 0 ;assume no read r0 := plong ;pointer to 32 bit byte address r3 := (r0) ;low r2 := 2(r0) ;hi r1 := r3 ;copy r0 := b.seek(r4) bic 0777,r0 ;clear low bits bic 0777,r1 ;just the block number is compared if r0 ne r1 or b.seek+2(r4) ne r2 select type b.io(r4) of case -1 ;just read inc rflag break case 0 ;write if dirty/read new if b.dirty(r4) = 0 b.stat(r4) := putblk[r4] else b.stat(r4) := 1 fi if b.stat(r4) = 1 inc rflag fi break case 1 ;write current b.stat(r4) := putblk[r4] esac b.dirty(r4) := 1 fi b.seek(r4) := r3 ;update seek pointer (low order) b.seek+2(r4) := r2 ;high order if rflag ne 0 b.stat(r4) := getblk[r4] ;read new fi ret b.stat(r4) .end