; move comments over 1 tab	C/;/	;/
; move back 1 tab        	C/	;/;/
; find leading spaces and convert to tabs	4y5y6y
; put 24 leading	1,$c/^                        /			/4p
;      16        	1,$c/^                /		/5p
;       8         	1,$c/^        /	/6p
;
$MACRO moveb from to nbytes
?? 4
        mov #@1,r0
        mov #@2,r1
        mov #@3,r2
#@4=.
        movb (r0)+,(r1)+
        sob r2,#@4
$ENDM
;
$MACRO type string to lun 3
?? 3,4,5
        br #@5
#@4=.
	.ascii ~#@1~
#@3=.
	.even
#@5=.
I%NB <#@2> <pu.sh <#@2>>
I%B  <#@2> <pu.sh <40>>
?+ 2
        qiow$s #io.wvb,#3,#15. ,, ,, <#<#@4>,#<#@3-#@4>,#<#@2>>
$ENDM
;
$MACRO pu.sh
?- <#@1>
$ENDM
/
        PROGRAM SND
        .title SND
        .enabl lc
        .psect SND
        .enabl ama
	.nlist sym

        .mcall qiow$,dir$,fdop$r,finit$,fsrsz$,nmblk$,fdbk$r,qiow$s
        .mcall fdat$r,fdrc$r,read$,wait$,close$,exst$s,alun$,gmcr$
        .mcall gtsk$s,mrkt$s,cmkt$s

        flun=2 
        fev=20. 
        cr=15
        esc=33
        good=1
        bad=4

begin:   
;     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
namep:  .word 0                         ;temp cell
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.                       ;put 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)
newline: .byte 12,15,0,0                ;newline output string
;     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ios:    .word 0,0                       ;2 word qio status block
i:      .word 0                         ;index
j:      .word 0                         ;index
        .word 0                         ;spare
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
dsw:    .word 0                         ;save dsw on get mcr line
;     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
alun:   alun$  3,TI,0
alunb:  alun$  1,CM 0
kill:   qiow$ io.kil ,1                     ;kill i/o
inabo:  qiow$ io.ral ,1,7,,ios,,<buf,2>     ;input qio on abort code
in:     qiow$ io.ral ,1,7,,ios,,<ack,1>     ;input qio
insy:   qiow$ io.ral ,1,7,,ios,,<buf,1,0>   ;input sync
out:    qiow$ io.wal ,1,7,,ios,,<buf,20.,0> ;output qio
osync:  qiow$ io.wal ,1,7,,ios,,<osy,4,0>   ;output qio
;;;f1:     qiow$  sf.smc,1,7,,ios,,<p1,s1>     ;flush input
;;;
;;;p1:     .byte tc.tbf,1
;;;	s1=.-p1
osy:    .ascii /SSSS/                           ;output sync
;     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
gmcr:   gmcr$
;     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        CSI                             ;init csi buffers ([222,7]file.mac
ffdb:   FDB flun,B,block                ;fdb allocated, pointing to csi dsdp
block:  .blkb   512.                    ;block buffer
dfnb:   nmblk$ ,,,sy                    ;defaults to current uic, and sy
stat:   .blkw 5                         ;statistics block (for contiguous attr)
;     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        .even
 

start:     

        finit$ 

        dir$ #alun                      ;lun for ti:
        dir$ #alunb                     ;lun for communications
        mov #begin,r0                   ;for debugging
        mov #ffdb,r1
        mov #p,r2
        mov #ios,r3
        mov #in-buf,r4

;        iot
        nop 
        nop 
         
;;        dir$ #f1                      ;flush typeahead buffer
         
        dir$ #gmcr
        mov $dsw,dsw
        IF dsw LT #0
usage:
                type <Send Usage: Send filename>
	        exst$s #bad
        ELSE
 
                mov dsw,r1              ;length computation
                LOOP FOR r0 = #gmcr+g.mcrb+3 THRU #gmcr+g.mcrb+79.
		        IFB (r0) = #40 OR (r0) = #cr  OR (r0) = #esc
			        BREAK
		        FI
		        dec r1
                NEXT r0
                IFB (r0) = #cr  OR  (r0) = #esc
badfil:
                     type <Bad file name>
                     jmp usage
                FI

                sub #4, r1              ;don't include blank or uic
                IF LE
	                br badfil
                FI
                inc r0                  ;point past blank
                mov r1,len              ;the length of file is in r1
                mov r0,namep            ;and the name starts at r0

	FI
         
        moveb namep,#name,len           ;move to area for transfer
         
        FILE #name,len                  ;len contains file length (set csi blk)
        IF CS
            jmp badfil
        FI

        mov #block,r0                   ;use scratch buffer
        gtsk$s r0                       ;get task info
        mov block+g.tsdu,puic           ;protection uic
        mov block+g.tspc,uic            ;default uic (might be file uic)

        IFB gmcr+g.mcrb = #1            ;is the uic in the mcr line
            movb gmcr+g.mcrb+1,uic      ;yes, so -
            movb gmcr+g.mcrb+2,uic+1    ;copy from command line
        FI

        mov uic,r1
;-      call .wdfui                     ;set default uic to what came in
        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
                                        ;disassembled it.

        mov #stat,ffdb+f.stbk           ;set up to return statistics
        OPEN #ffdb,rd                  ;open for write
        IF CS
            call putl
            type <Cannot open file - Fcs error code (octal) = > 0
            mov f.err+FFDB,r0
            call putn8b
            call putl
            exst$s #bad
        FI

        IF stat NE #0  OR  stat+2 NE #0 ;if either is non-zero, contig file.
        neg len                         ;send negative file length = contig.
        FI

        nop
        nop


        mov ffdb+f.dspt,r2              ;get data set descripter pointer
        add #4,r2                       ;address of string descripter
        IF (r2) NE #0                   ;if not zero
                mov #uic,r3             ;output the uic here
	        call .ascpp
        FI
        IFB puic+1 NE uic+1             ;can't transfer unless match (of group)
           IFB puic+1 HI #10            ;or priveledged acnt
              type <LOGIN uic group must match FILE uic group to send file>
              exst$s #bad
           FI
        FI

        dir$ #osync                     ;output sync
        call sync                       ;sync on receiver too
        call putfdb                     ;output the fdb part
        call putnam                     ;output the file name
         
        mov #ffdb,r1                    ;now prepare the fdb
        mov f.efbk+2(r1),fsize          ;save file size
        IF f.ffby(r1) = #0 AND fsize GT #0      ;eof might be at end of block
	        dec fsize
        FI
         
        call putfil
        call closeit
         
         
;        iot
          exst$s #good
         
         
;+
; closeit - close file
;
;-
closeit: 
        close$ #ffdb
        rts pc
         
;+
; putfil - put the file block at a time
;
;          calls putblk repeatedly until the last block (eof block)
;-
putfil:  
        LOOP for bnum+2 = #1 TO fsize
            read$ #ffdb,#block,#512.,#bnum,#fev,#bios
            wait$ 
            call putblk
        NEXT bnum+2
        rts pc
;+
; putfdb - put the fdb in 7 packets into name:
;          when all done ffdb has 7*16 bytes = 112 bytes (at least enough)
;          more than an entire fdb is probably transfered (100 is all of it)
;-
putfdb:  
        mov #ffdb,p                    ;point at input
        LOOP FOR j = #1 TO #7
            moveb p,#buf,#16.           ;move out the 16 data bytes
            call putp                   ;put a packet out
            add #16.,p                  ;update to next area going out
        NEXT j
        rts pc
;+
; putnam - put the file name in 3 packets into name:
;-
putnam:  
         
        mov #puic,p                 ;point at input
        LOOP FOR j = #1 TO #3
            moveb p,#buf,#16.       ;move out the 16 data bytes
            call putp               ;put a packet out
            add #16.,p              ;update to next area going out
        NEXT j
        rts pc
         
;+
; putblk - put a block of data
;          does it in 32 packets
;-
putblk:  
         
        mov #block,p                ;point at input
        LOOP FOR j = #1 TO #32.
            moveb p,#buf,#16.       ;move out the 16 data bytes
            call putp               ;put out packet
            add #16.,p              ;update to next area going out
        NEXT j
        rts pc
;+
;putp - put a packet out - packet is 20 bytes, 1-16 data,17-18,data,
;                                              19-20 checksum
;-
putp:        
            clr sum
            LOOP for i  = #buf THRU #buf+17. STEP #2
                add @i,sum
            NEXT i
                 
        DO FOREVER
            dir$ #out
            dir$ #in
            BREAK IFB ack = #'A
            IFB ack = #'F               ;fatal return code
                jmp abort
            FI
            type <Checksum error reported, retrying>
        OD 
l2:      
        return 

;+
;Abort - reads abort code and puts message on ti: (then exits)
;-
abort:
        dir$ #inabo
        call putl
        type <Unrecoverable error on other machine - code = > 0
        mov buf,r0
        call putn8b
        call putl
        exst$s #bad


;+
; putstr - put string, r0=asciz string
; putn8  - put octal number, r0=number
; putn8b - put octal number, r0=number  (suppress leading zeros)
; putl   - put newline
;
;          all use r0,r1,r2
;-

putstr:
        mov r0,r2
1$:     tstb(r0)+
        bne 1$
        LET r1 = r0 - r2
        dec r1
        qiow$s #io.wvb,#3,#7,,#ios,,<r2,r1,#0>
        rts pc
putl:
        mov #newline,r0
        call putstr
        rts pc
putn8:
        mov r0,r1
        mov #block,r0
        mov #1,r2
        call $cbomg
        clrb (r0)
        mov #block,r0
        call putstr
        rts pc
putn8b:
        mov r0,r1
        mov #block,r0
        clr r2
        call $cbomg
        clrb (r0)
        mov #block,r0
        call putstr
        rts pc


;+
; sync  -  monitor the line until 4 'R s come in
;          don't have to be priv'd this way
;-
sync:
        mrkt$s ,#20.,#2,#timout            ;marktime for ast
        clr r2
        DO FOREVER
	        clrb buf
	        dir$ #insy
                IFB buf = #'R
		        inc r2
	        ELSE
		        clr r2
	        FI
	        BREAK IF r2 GE #4
        OD
        cmkt$s
        rts pc


timout:
	        dir$ #kill
                type <Initialization failure (time-out)>
                exst$s #bad



        fsrsz$   1
        .end start
