.ENABL LC
 ; library-created 3/5/80 - for WHT-SM c runtime
        .title rec
        .enabl lc
        .psect rec
        .enabl ama
	.nlist sym
        .mcall qiow$,dir$,fdop$r,finit$,fsrsz$,nmblk$,fdbk$r
        .mcall fdat$r,fdrc$r,write$,wait$,close$,exst$s,mrkt$s
        .mcall cmkt$s,alun$
        flun=2 
        fev=20. 
        bad=4
        good=1
begin:   
puic:   .word 0                         ;owner uic
uic:    .word 0                         ;uic of file
len:    .word 0                         ;length of file name
name:   .blkb 16.*3+20                  ;file name is input here
buf:    .blkb 16.                       ;get packet buffer
code:   .word                           ; is 16 bytes,2 bytes=code,2bytes=cksum
sum:    .word 0                         ; this is the checksum
        .blkb 6.                        ;safety - so we don't clobber anything
ack:    .byte 'A,'A                     ;ack/nack buffer (goes back)
        .byte 0                         ;abort code (odd alligned)
abrt:   .byte 'F                        ;the code is followed by 2 byte error
acode:  .word 0                         ;word (word alligned for mov instr)
         
ios:    .word 0,0                       ;2 word qio status block
i:      .word 0                         ;index
j:      .word 0                         ;index
chk:    .word 0                         ;for computing checksum
p:      .word ffdb                      ;pointer into fdb/block buffer
fsize:  .word 0				;size of the file in blocks
bnum:   .word 0,0                       ;block number double prec
bios:   .word 0,0                       ;block i/o status block
alunb:  alun$ 1,CM,0
kill:   qiow$ io.kil ,1                   ;kill i/o
in:     qiow$ io.ral ,1,7,,ios,,<buf,20.> ;input qio
insy:   qiow$ io.ral ,1,7,,ios,,<buf,1>   ;input qio (sync)
out:    qiow$ io.wal ,1,7,,ios,,<ack,1,0> ;output qio
aout:   qiow$ io.wal ,1,7,,ios,,<abrt,3,0>;output qio for abort
osync:  qiow$ io.wal ,1,7,,ios,,<osy,4,0>   ;output qio
osy:    .ascii /RRRR/
         
	.MCALL CSI$
	CSI$
	.EVEN
CSIBLK:: .BLKB C.SIZE
ffdb:
;FDB lun B/R,[block]
       .mcall fdop$a,fdat$a,fdbdf$,fdrc$a,fdbk$a
       fdbdf$
       fdop$a flun,csiblk+c.dsds
ffdb1:
;FDB lun B/R,[block]
       .mcall fdop$a,fdat$a,fdbdf$,fdrc$a,fdbk$a
       fdbdf$
       fdop$a flun,csiblk+c.dsds
        .blkw 20.                       ;safety
block:  .blkb   512.                    ;block buffer
dfnb:   nmblk$ ,,,sy                    ;defaults to current uic, and sy
         
         
start:     
        finit$ 
        dir$ #alunb                     ;assign lun to communications line
        mov #begin,r0                   ;for debugging
        mov #ffdb,r1
        mov #p,r2
        mov #ios,r3
        mov #in-buf,r4
         
         
         
        nop 
        call sync
        dir$ #osync
        call getfdb                     ;receive the fdb part
        call getnam                     ;receive the file name
         
        mov #ffdb,r0                    ;now prepare the fdb
        mov #ffdb1,r1                   ;from the orig file
        mov f.efbk+2(r1),fsize          ;get file size
	TST f.ffby(r1)		;IS f.ffby(r1) = #0
	BNE REC1	;Not if NE
	TST fsize		;IS fsize GT #0
	BLE REC4	;Not if LE
	BR REC7	;Here IF fsize GT #0    
REC4=.
	BR REC1		;Here if not
REC7=.
	        dec fsize
REC1=.			; 
REC3=.
        mov fsize,f.cntg(r0)            ;set size to create
         
	TST len		;IS len LT #0
	BGE REC8	;Not if GE
            neg len                     ; of the length
	JMP REC11
REC8=.			; 
            neg f.cntg(r0)              ;and make this non contigous
REC11=.			; 
REC10=.
         
        fdat$r #ffdb,#r.fix,,#512.      ;set up for
        fdrc$r #ffdb,#fd.rwm            ;block i/o
        fdbk$r #ffdb,#block,#512.       ;until we've coppied in everything
         
         
        mov uic,r1
        mov @#.fsrpt,r0                 ;do this ourselves so we can use
        mov r1,102(r0)                  ;fcs res
        clr 24(r0)                      ;this is what module rwfsr2 does
;FILE addr-of-string len-str
	.MCALL CSI$1,CSI$2
	CSI$1 #CSIBLK,#name,len
	BCS REC12
        CSI$2   ,OUTPUT
REC12=.
	BCC REC13	;Not if CC
	        mov #-54.,acode
	        clrb acode
	        jmp abort
REC13=.			; 
REC15=.
;OPEN fdb rd/wrt/upd/mod
	.mcall open$
	open$ #ffdb,#fo.wrt
	BCC REC16	;Not if CC
	        mov f.err(r0),acode
	        jmp abort
REC16=.			; 
REC18=.
        call getfil
        call closeit
         
         
        exst$s  #good
         
         
closeit: 
        mov #ffdb1,r0
        mov #ffdb,r1
        mov #7*2,r2
REC19=.
        movb (r0)+,(r1)+
        sob r2,REC19
        mov fsize,ffdb+f.hibk+2         ;but correctly set size
        mov puic,r1                     ;get owner uic
        call .wfown                     ;and set fsr owner word
        close$ #ffdb                    ;
        rts pc
         
getfil:  
	MOV #1,bnum+2	;Init loop index
REC20=.
	CMP bnum+2,fsize	;done loop?
	BGT REC21	;yes if GT
            call getblk
            write$ #ffdb,#block,#512.,#bnum,#fev,#bios
            wait$ 
	CMP bios,#1		;IS bios NE #1
	BEQ REC22	;Not if EQ
            mov bios,acode
            jmp abort
REC22=.			; 
REC24=.
	CMP ffdb+f.err,#1		;IS ffdb+f.err NE #1
	BEQ REC25	;Not if EQ
            mov ffdb+f.err,acode
            jmp abort
REC25=.			; 
REC27=.
	INC bnum+2
	JMP REC20		;back to top
REC21=.
        rts pc
getfdb:  
        mov #ffdb1,p                    ;point at output
	MOV #1,j	;Init loop index
REC28=.
	CMP j,#7	;done loop?
	BGT REC29	;yes if GT
            call getp                   ;get a packet in
        mov #buf,r0
        mov p,r1
        mov #16.,r2
REC30=.
        movb (r0)+,(r1)+
        sob r2,REC30
            add #16.,p                  ;update to next area coming in
	INC j
	JMP REC28		;back to top
REC29=.
        rts pc
getnam:  
         
        mov #puic,p                 ;point at output
	MOV #1,j	;Init loop index
REC31=.
	CMP j,#3	;done loop?
	BGT REC32	;yes if GT
            call getp               ;get a packet in
        mov #buf,r0
        mov p,r1
        mov #16.,r2
REC33=.
        movb (r0)+,(r1)+
        sob r2,REC33
            add #16.,p              ;update to next area coming in
	INC j
	JMP REC31		;back to top
REC32=.
        rts pc
         
getblk:  
         
        mov #block,p                ;point at output
	MOV #1,j	;Init loop index
REC34=.
	CMP j,#32.	;done loop?
	BGT REC35	;yes if GT
            call getp               ;get a packet in
        mov #buf,r0
        mov p,r1
        mov #16.,r2
REC36=.
        movb (r0)+,(r1)+
        sob r2,REC36
            add #16.,p              ;update to next area coming in
	INC j
	JMP REC34		;back to top
REC35=.
        rts pc
         
         
         
getp:        
REC37=.
            dir$ #in
l1:         clr chk
	MOV #buf,i	;Init loop index
REC39=.
	CMP i,#buf+17.	;done loop?
	BHI REC40	;yes if HI
                add @i,chk
	ADD #2,i
	JMP REC39		;back to top
REC40=.
                 
	CMP chk,sum		;IS chk = sum
	BNE REC41	;Not if NE
                movb #'A,ack
	JMP REC38		;break 
	JMP REC44
REC41=.			; 
                clrb ack
	        dir$ #out
REC44=.			; 
REC43=.
	JMP REC37		;Repeat loop
REC38=.
        dir$ #out
l2:      
        return 
         
abort:  dir$ #aout
        close$ #ffdb
        exst$s #bad
sync:
        mrkt$s ,#5,#2,#timout            ;marktime for ast
        clr r2
REC45=.
	        clrb buf
	        dir$ #insy
	CMPB buf,#'S		;IS buf = #'S
	BNE REC47	;Not if NE
		        inc r2
	JMP REC50
REC47=.			; 
		        clr r2
REC50=.			; 
REC49=.
	CMP r2,#4		;IS r2 GE #4
	BLT REC51	;Not if LT
	JMP REC46		;break 
REC51=.			; 
REC53=.
	JMP REC45		;Repeat loop
REC46=.
        cmkt$s
        rts pc
timout:
        dir$ #kill
        exst$s #bad
        fsrsz$   1
        .end start
