home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / pdp11 / k11atr.mac < prev    next >
Text File  |  2020-01-01  |  21KB  |  752 lines
  1.     .title    k11atr    process attribute packets
  2.     .ident    /1.0.02/
  3.     .enabl    gbl
  4.  
  5. ;    18-Apr-84  11:20:59 Brian Nelson
  6. ;
  7. ;    24-Mar-86  12:00:56 BDN    Major revision which has some rather
  8. ;                unpleasant compatibility problems with
  9. ;                older Kermit-11's.
  10. ;
  11. ;    12-Sep-86  10:37:04 BDN Convert for I/D space running
  12. ;
  13. ;    Copyright (C) 1984  Change Software, Inc.
  14. ;
  15. ;
  16. ;    Process attribute packets for RSTS/E and RSX11M/M+
  17. ;
  18. ;     This module is intended to be placed into an overlay
  19. ;    which MUST be the 'ERROR' cotree as the server, which
  20. ;    is overlayed in the  'UTILTY'  cotree can  indirectly
  21. ;    call the module through the packet control routines.
  22. ;     This module will also be rather RMS11 dependent.
  23. ;
  24. ;
  25. ;    Get the Kermi-11 common macro definition INCLUDE file
  26.  
  27.  
  28.  
  29.     .if ndf, K11INC
  30.     .ift
  31.     .include    /IN:K11MAC.MAC/
  32.     .endc
  33.  
  34.  
  35.     .psect    $pdata
  36.  
  37. watt:    .word    sn.sys    ,sn.typ    ,sn.fab    ,sn.pr0    ,sn.pr1    ,sn.len    ,sn.fty
  38. ;-    .word    sn.cdt
  39.     .word    0
  40. attrty:    .byte    41    ,42    ,43    ,44    ,45    ,46    ,47
  41.     .byte    50    ,51    ,52    ,53    ,54    ,55    ,56
  42.     .byte    57    ,60    ,61
  43.     .byte    0
  44.     .even
  45.  
  46. attrds:    .word    at.$$
  47.     .word    at.len    ,at.typ    ,at.cre    ,at.id    ,at.bil    ,at.area,at.pas
  48.     .word    at.bsiz    ,at.acc    ,at.enc    ,at.dis    ,at.pr0    ,at.pr1    ,at.sys
  49.     .word    at.for    ,at.fab    ,at.xle
  50.  
  51. badpak:    .asciz    /Unknown attribute packet type /
  52. incomp:    .ascii    /?K11-ATR Protocol bugfix detected. Use/<CR><LF> 
  53.     .asciz    /SET NOATT and see K11.BWR, K11INS.DOC./<CR><LF>
  54.     .even
  55.  
  56.     .psect    tempda    ,rw,d,lcl,rel,con
  57. curatr:    .blkb    200
  58.  
  59.     .psect    $code
  60.  
  61.  
  62.     .sbttl    return the next attribute packet to send
  63.  
  64. ;    W $ A T T R
  65. ;
  66. ;    input:    @r5    filename address
  67. ;        2(r5)    lun it's using
  68. ;        4(r5)    output packet address
  69. ;
  70. ;    output:    r0    rms error code, else zero
  71. ;        r1    > 0 the packet length, also come back for more later
  72. ;        r1    = 0 no more packets or else receiver can't handle them
  73.  
  74.  
  75. w$attr::save    <r2,r3,r4>        ; save registers that we may use here
  76.     bitb    #capa.a    ,conpar+p.capas    ; the other system handle 'A' packets?
  77.     beq    90$            ; no, exit with 'eof'
  78. 10$:    mov    4(r5)    ,r4        ; point to the packet
  79.     mov    atrctx    ,r0        ; now dispatch on what to send next
  80.     asl    r0            ; simple to do
  81.     tst    watt(r0)        ; all done ?
  82.     beq    90$            ; yes, just exit then
  83.     jsr    pc    ,@watt(r0)    ; and do it
  84.     inc    atrctx            ; next time, do the next one in the list
  85.     tst    r0            ; was it possible to do this attr?
  86.     bne    10$            ; no, try the next one then
  87.     strlen    4(r5)            ; get the length and return it
  88.     mov    r0    ,r1        ; and say that this packet is for real
  89.     clr    r0            ; exit without error
  90.     br    100$            ; bye
  91.     
  92. 90$:    clr    r0            ; all done, no more attributes to
  93.     clr    r1            ; send over
  94.     clr    atrctx            ; init for the next file we send
  95.  
  96. 100$:    unsave    <r4,r3,r2>        ; pop these and exit
  97.     return                ; bye
  98.  
  99.  
  100.  
  101.  
  102.  
  103.     .sbttl    dispatch routines for sending 'a' packets
  104.     .enabl    lsb
  105.  
  106. sn.sys:    call    getsys            ; get the system type first
  107.     scan    r0    ,#200$        ; find out what we are
  108.     tst    r0            ; did it work ?
  109.     beq    110$            ; no
  110.     movb    #'.    ,(r4)+        ; sys id attr packet
  111.     movb    #42    ,(r4)+        ; /49/ Length of whats to follow
  112.     movb    #'D&137    ,(r4)+        ; return the vendor code (DEC)
  113.     movb    210$(r0),(r4)+        ; and the system type
  114.     clrb    @r4            ; .asciz
  115.     clr    r0            ; say it worked
  116.     return                ; bye
  117.  
  118. 110$:    mov    sp    ,r0        ; it failed
  119.     return
  120.  
  121.  
  122.     .save
  123.     .psect    $PDATA    ,D
  124. 200$:    .byte    sy$11m    ,sy$ias    ,sy$rsts,sy$mpl    ,sy$rt    ,sy$pos    ,0
  125. 210$:    .byte    0
  126.     .byte    '8    ,'9    ,'A&137    ,'8    ,'B&137    ,'C&137    ,0
  127.     .even
  128.     .restore
  129.     .dsabl    lsb
  130.  
  131.  
  132.  
  133.     .sbttl    send a copy of the ifab over
  134.  
  135.  
  136. ;     The routine 'GETATR' takes the directory (or file header) information
  137. ;    regarding the file format from the IFAB allocated  to the FAB for  the
  138. ;    file currently being sent. This data is converted to octal strings and
  139. ;    then sent over as an ATTRIBUTE packet with a type of '0', which is the
  140. ;    type reserved for system specific data.
  141. ;     The  receiver  KERMIT should ALWAYS get the SYSTEM and EXECUTIVE type
  142. ;    attribute packet first so it can decide whether or not it wants to use
  143. ;    the data being sent.
  144. ;
  145. ;    For instance, the file A.A would have a packet sent over as in below
  146. ;
  147. ; Name .Typ    Size    Prot   Access     Date      Time   Clu  RTS    Pos 
  148. ;A     .A         1    < 60> 01-May-84 01-May-84 10:17 AM   4 ...RSX  3493
  149. ; RF:VAR=132 FO:SEQ   USED:1:98       RECSI:46       CC:IMP
  150. ;
  151. ;
  152. ;
  153. ;SPACK -   Length   78   Type  A    Paknum    3                       
  154. ;0001002 000056 000000 000001 000000 000001 000142 000000 000204 000000 000000 
  155.  
  156.  
  157.  
  158.  
  159. sn.fab:    calls    getatr    ,<2(r5),#at$fab>; get the ifab stuff now
  160.     tst    r0            ; but did it work?
  161.     bmi    100$            ; no, it crapped out
  162.     movb    #'0    ,(r4)+        ; return sys type attr code
  163.     movb    #<13*7>+40,(r4)+    ; Length of data to follow.
  164.     mov    r4    ,r0        ; fill it with spaces first
  165.     mov    #13*7    ,r1        ; simple
  166. 5$:    movb    #40    ,(r0)+        ;
  167.     sob    r1    ,5$        ; next
  168.     mov    #at$fab    ,r2        ; where we store such things
  169.     mov    #13    ,r0        ; number of words to send
  170. 10$:    calls    l$otoa    ,<r4,(r2)+>    ; do it
  171.     add    #7    ,r4        ; skip over it
  172.     sob    r0    ,10$        ; next
  173.     clr    r0            ; say that it worked
  174.     clrb    @r4            ; .asciz
  175. 100$:    return
  176.     
  177.  
  178.     .sbttl    send file type (ascii,binary), protection and size
  179.  
  180. ;    SN.FTY added /52/
  181.  
  182.     .enabl    lsb
  183.  
  184. sn.fty:    movb    #'0    ,(r4)+        ; Attribute type (SYS type)
  185.     movb    #42    ,(r4)+        ; Length of data to follow.
  186.     movb    #42    ,(r4)+        ; Sending extended filetype
  187.     mov    image    ,r0        ; Index into it
  188.     movb    200$(r0),(r4)+        ; Insert it
  189.     clrb    @r4            ; .Asciz
  190.     clr    r0            ; Success
  191.     return                ; Exit
  192.  
  193.     .ASSUME    TEXT    EQ    0
  194.     .ASSUME    BINARY    EQ    1
  195.     .ASSUME    DECNAT    EQ    2
  196.  
  197.     .save                ; Save, start a DATA psect
  198.     .psect    $pdata    ,d
  199. 200$:    .byte    'A&137    ,'I&137    ,'N&137    ,'A&137
  200.     .even
  201.     .restore            ; Pop old psect
  202.     .dsabl    lsb            ; And drop local symbol block
  203.  
  204.  
  205.  
  206. sn.cdt:    movb    #'0    ,(r4)+        ; System dependent data following
  207.     movb    #41+<6*4>,(r4)+        ; Amount of data to follow
  208.     movb    #43    ,(r4)+        ; Date of creation, 64bit format
  209.     CALLS    getcdt    ,<2(r5)>    ; Get address of data
  210.     mov    r0    ,r2        ; Successful (ie, not RT11)
  211.     beq    90$            ; No
  212.     mov    #4    ,r3        ; Number of words
  213. 10$:    CALLS    l$otoa    ,<r4,(r2)+>    ; Do it
  214.     add    #6    ,r4        ; Move over
  215.     sob    r3    ,10$        ; Next please
  216.     clrb    @r4            ; .ASCIZ
  217.     clr    r0            ; Success
  218.     br    100$            ; Exit
  219. 90$:    mov    #-1    ,r0        ; Failure
  220. 100$:    return                ; Exit
  221.  
  222.  
  223. sn.typ:    movb    #42    ,(r4)+        ; attribute type
  224.     movb    #41    ,(r4)+        ; /49/ Length of what follows
  225.     movb    #'A&137    ,@r4        ; assume ascii
  226.     cmpb    image    ,#binary    ; already decided that it's binary?
  227.     bne    10$            ; no
  228.     movb    #'I&137    ,@r4        ; yes, say it's image mode today
  229. 10$:    clrb    1(r4)            ; insure .asciz
  230.     clr    r0            ; flag success and exit
  231.     return                ; bye
  232.  
  233.  
  234. sn.pr0:    call    getsys            ; /59/ Get system type
  235.     mov    r0    ,-(sp)        ; /59/ Save it
  236.     calls    getpro    ,<2(r5)>    ; /59/ Get protection for file
  237.     cmpb    (sp)+    ,#4        ; /59/ If RSTS, we want to convert
  238.     bne    10$            ; /59/ to files11 format.
  239.     call    tof11            ; /59/ Yes, convert
  240. 10$:    movb    #54    ,(r4)+        ; /59/ Sending internal protection
  241.     movb    #40+6    ,(r4)+        ; /59/ Field is six characters
  242.     calls    l$otoa    ,<r4,r0>    ; /59/ Convert to octal
  243.     add    #6    ,r4        ; /59/ Always leave pointing to end
  244.     clrb    @r4            ; /59/ And make it .asciz
  245.     clr    r0            ; /59/ Success
  246.     return                ; /59/ Exit
  247.  
  248. sn.pr1:    mov    #-1    ,r0
  249.     return
  250.  
  251.  
  252. sn.len:    calls    getsiz    ,<2(r5)>    ; get the size of the file please
  253.     tst    r0            ; did this work ?
  254.     bne    100$            ; no
  255.     inc    r1            ; try to accomodate rounding
  256.     asr    r1            ; in 1024 blocks, not 512
  257.     bic    #100000    ,r1        ; insure no sign bits now
  258.     movb    #41    ,(r4)+        ; attribute type (file size)
  259.     movb    #45    ,(r4)+        ; length of the number
  260.     deccvt    r1,r4,#5        ; convert to ascii
  261.     mov    #5    ,r0        ; convert leading spaces to '0'
  262. 10$:    cmpb    @r4    ,#40        ; if a space, then make it a '0'
  263.     bne    20$            ; no
  264.     movb    #'0    ,@r4        ; yes, stuff a space in
  265. 20$:    inc    r4            ; next please
  266.     sob    r0    ,10$        ; next please
  267.     clrb    @r4            ; insure .asciz
  268.     clr    r0            ; to be safe
  269. 100$:    return                ; bye
  270.  
  271.  
  272.  
  273.  
  274.     .sbttl    dispatch on the type of attribute packet received
  275.     .psect    $code
  276.  
  277. ;    R $ A T T R
  278. ;
  279. ;    input:    @r5    the packet address
  280. ;    output:    r0    error code, zero for success
  281.  
  282. r$attr::save    <r1,r2,r3,r4,r5>    ; just to be safe
  283.     mov    @r5    ,r5        ; /49/ Get packet data address
  284. 10$:    movb    (r5)+    ,r0        ; /49/ Attribute type code
  285.     beq    90$            ; /49/ Nothing there ???
  286.     movb    (r5)+    ,r1        ; /49/ Get length field next
  287.     beq    90$            ; /49/ Nothing there ?
  288.     cmpb    r0    ,#'.        ; /49/ If this is an OLD kermit-11
  289.     bne    20$            ; /49/ with the invalid packet fmt
  290.     cmpb    r1    ,#'D&137    ; /49/ then we will have to make a
  291.     bne    20$            ; /49/ note of it and try to fix it
  292.     mov    sp    ,oldatt        ; /49/ up.
  293.  
  294. 20$:    call    200$            ; /49/ Perhaps fix packets from old K11
  295.     sub    #40    ,r1        ; /49/ Convert length to integer
  296.     bmi    90$            ; /49/ Again, nothing was there
  297.     mov    #curatr    ,r2        ; /49/ Copy current attribute argument
  298. 40$:    movb    (r5)+    ,(r2)+        ; /49/ over to a save area now.
  299.     sob    r1    ,40$        ; /49/ Next please
  300.     clrb    (r2)+            ; /49/ Insure .asciz please
  301.     mov    r5    ,-(sp)        ; /49/ Make sure the r5 context saved
  302.     scan    r0    ,#attrty    ; look for the attribute packet type?
  303.     asl    r0            ; simple to do
  304.     jsr    pc    ,@attrds(r0)    ; process the attribute packet now
  305.     mov    (sp)+    ,r5        ; /49/ Restore the R5 context now.
  306.     tst    r0            ; Success
  307.     beq    10$            ; Yes
  308.     br    100$            ; No, exit
  309. 90$:    clr    r0            ; Packet format error or end of data
  310. 100$:    unsave    <r5,r4,r3,r2,r1>    ; bye
  311.     return                ; exit
  312.  
  313.  
  314. 200$:    mov    r0    ,-(sp)        ; /49/ Fix bad attribute data up (?)
  315.     cmpb    r0    ,#41        ; /49/ The old (and incorrect) K11's
  316.     beq    220$            ; /49/ did the filesize format ok
  317.     tst    oldatt            ; /49/ Is this a fubarred old Kermit-11
  318.     beq    220$            ; /49/ No
  319.     dec    r5            ; /49/ Yes, we had been forgetting to
  320.     strlen    r5            ; /49/ include the length field before 
  321.     mov    r0    ,r1        ; /49/ the actual attribute data.
  322.     add    #40    ,r1        ; /49/ Convert to char format.
  323. 220$:    mov    (sp)+    ,r0        ; /49/ So backup one char and reset the
  324.     return                ; /49/ Length.
  325.  
  326. at.$$:    clr    r0            ; /49/ Ignore unknown attribute types
  327.     return                ; /49/ Exit
  328. ;-    calls    error    ,<#1,#badpak>    ; send error back to abort things
  329. ;-    mov    #-1    ,r0        ; return 'abort'
  330. ;-    return
  331.  
  332.  
  333.     .sbttl    process specific attribute types
  334.  
  335.  
  336. ;    File size in 1024 byte chunks (512 would have been better)
  337.  
  338. at.len:    save    <r1,r2>            ; save temps please
  339.     clr    at$len            ; assume zero
  340.     mov    #curatr    ,r2        ; /49/ Where we saved attributes
  341.     clr    r1            ; init the accumulator
  342. 10$:    tstb    @r2            ; eol ?
  343.     beq    30$            ; yep
  344.     cmpb    @r2    ,#40        ; ignore leading spaces please
  345.     beq    20$            ; yes, a space
  346.     clr    -(sp)            ; get the next digit please
  347.     movb    @r2    ,@sp        ; and convert to decimal
  348.     sub    #'0    ,@sp        ; got it
  349.     mul    #12    ,r1        ; shift accum over 10
  350.     add    (sp)+    ,r1        ; add in the current digit
  351. 20$:    inc    r2            ; next ch please
  352.     br    10$            ; /49/ Next please
  353. 30$:    asl    r1            ; convert 1024 blocks to 512 blocks
  354.     mov    r1    ,at$len        ; save it please
  355. 100$:    unsave    <r2,r1>            ; pop temps and exit
  356.     clr    r0
  357.     return
  358.  
  359.  
  360. ;    Exact size in bytes (type '1')
  361.  
  362. at.xlen:save    <r1,r2,r4,r4,r5>    ; /49/ Save temps please
  363.     asl    r1            ; /49/ Convert 1024 blocks to 512 blocks
  364.     clr    at$len            ; /49/ Assume zero
  365.     mov    #curatr    ,r5        ; /49/ Point to attribute save area
  366.     clr    r3            ; /49/ Init the accumulator
  367.     clr    r2            ; /49/ Double precision please
  368. 10$:    tstb    @r5            ; /49/ Eol ?
  369.     beq    30$            ; /49/ Yep
  370.     cmpb    @r5    ,#40        ; /49/ Ignore leading spaces please
  371.     beq    20$            ; /49/ Yes, a space
  372.     mov    #12    ,r0        ; /49/ Setup for call to $DMUL
  373.     call    $dmul            ; /49/ Do it please
  374.     mov    r0    ,r2        ; /49/ Restore accumulator values now
  375.     mov    r1    ,r3        ; /49/ Ditto....
  376.     clr    -(sp)            ; /49/ Get the next digit please
  377.     movb    @r5    ,@sp        ; /49/ And convert to decimal
  378.     sub    #'0    ,@sp        ; /49/ Got it
  379.     add    (sp)+    ,r3        ; /49/ Add in the current digit
  380.     adc    r2            ; /49/ Add carry bit in also please
  381. 20$:    inc    r5            ; /49/ Next ch please
  382.     br    10$            ; /49/ Next please
  383. 30$:    mov    r2    ,r1        ; /49/ Setup for call to $DDIV now
  384.     mov    r3    ,r2        ; /49/ Ditto....
  385.     mov    #1000    ,r0        ; /49/ Convert to 512 byte blocks now
  386.     call    $ddiv            ; /49/ Simple
  387.     mov    r2    ,at$len        ; /49/ Save it please
  388.     tst    r0            ; /49/ Was there a remainder ?
  389.     beq    40$            ; /49/ No, exit
  390.     inc    at$len            ; /49/ Yes, len++
  391. 40$:    call    getsys            ; /61/ See if RT11, since a UNIX system
  392.     cmpb    r0    ,#SY$RT        ; /61/ will send the wrong size, ie, RT
  393.     bne    100$            ; /61/ needs CrLf rather than Lf at eol
  394.     mov    at$len    ,r1        ; /61/ So we will add a small fudge 
  395.     ash    #-5    ,r1        ; /61/ factor in (len += len/32)
  396.     bic    #174000    ,r1        ; /61/ ...
  397.     add    r1    ,at$len        ; /61/ Tacky, but effective I guess
  398. 100$:    mov    at$len    ,at$xlen    ; /61/ Save
  399.     unsave    <r5,r4,r3,r2,r1>    ; /49/ Pop temps and exit
  400.     clr    r0
  401.     return
  402.  
  403.  
  404.     global    <$ddiv    ,$dmul>
  405.     global    <at.xlen>
  406.  
  407.  
  408.  
  409.     .sbttl    more attribute receive options
  410.  
  411.  
  412. at.typ:    cmpb    curatr    ,#'B&137    ; 'binary' ?
  413.     beq    10$            ; yes
  414.     cmpb    curatr    ,#'I&137    ; 'image'  ?
  415.     bne    100$            ; no
  416. 10$:    mov    #binary    ,image        ; flag for image mode then
  417.     mov    #binary    ,at$typ        ; save it here also
  418. 100$:    clr    r0
  419.     return
  420.  
  421.  
  422. at.cre:    clr    r0
  423.     return
  424.  
  425. at.id:    clr    r0
  426.     return
  427.  
  428. at.bil:    clr    r0
  429.     return
  430.  
  431. at.area:clr    r0
  432.     return
  433.  
  434. at.pas:    clr    r0
  435.     return
  436.  
  437. at.bsiz:clr    r0
  438.     return
  439.  
  440. at.acc:    clr    r0
  441.     return
  442.  
  443. at.enc:    clr    r0
  444.     return
  445.  
  446. at.dis:    movb    curatr    ,at$dis
  447.     clr    r0
  448.     return
  449.  
  450. at.pr0:    call    ispdp            ; /59/ Is this another Kermit-11
  451.     tst    r0            ; /59/ sending us protection in
  452.     beq    100$            ; /59/ internal (Files11) format?
  453.     call    getsys            ; /59/ If it's RSTS, convert from
  454.     mov    r0    ,r2        ; /59/ F11 format to RSTS format.
  455.     calls    octval    ,<#curatr>    ; /59/ Convert from octal string.
  456.     cmpb    r2    ,#4        ; /59/ Is it RSTS ?
  457.     bne    10$            ; /59/ No, can use as is
  458.     mov    r1    ,r0        ; /59/ We are running on a RSTS
  459.     call    torsts            ; /59/ system, convert it.
  460. 10$:    mov    r1    ,at$pr0        ; /59/ Save the protection.
  461. 100$:    clr    r0            ; /59/ Success
  462.     return                ; /59/ And exit
  463.  
  464. at.pr1:    clr    r0
  465.     return
  466.  
  467. at.sys:    movb    curatr    ,at$sys        ; major vendor type
  468.     movb    curatr+1,at$sys+1    ; save the system type
  469.     clr    r0            ; no errors
  470.     return                ; exit
  471.  
  472. at.for:    clr    r0
  473.     return
  474.  
  475.  
  476.  
  477.     .sbttl    recieve the ifab data for file attributes from another 11
  478.     .enabl    lsb
  479.  
  480.     fabsiz    =    7*13        ; need at least this many 
  481.  
  482. at.fab:    mov    #curatr    ,r5        ; /49/ Save area for current attr's
  483.     call    ispdp            ; are we compatible today?
  484.     tst    r0            ; no if eq
  485.     beq    100$            ; no, ignore the system dep attr's
  486.     strlen    r5            ; packet size ok
  487.     cmp    r0    ,#fabsiz    ; well....
  488.     bge    40$            ; Ok, must be a IFAB
  489.     mov    r5    ,r3        ; /53/ Not an IFAB, perhaps other sys
  490.     cmpb    (r3)    ,#43        ; /54/ Date info?
  491.     bne    30$            ; /54/ No
  492.     inc    r3            ; /54/ Yes, process 4 octal words
  493.     mov    sp    ,at$cdt        ; /54/ Flag we have been here
  494.     mov    #4    ,-(sp)        ; /54/ Number of words
  495.     mov    #at$klu    ,r2        ; /54/ Destination
  496. 10$:    clr    r1            ; /54/ Accumulator
  497.     mov    #6    ,r0        ; /54/ Number of itmes
  498. 20$:    movb    (r3)+    ,r4        ; /54/ The next character
  499.     sub    #'0    ,r4        ; /54/ Convert to a number
  500.     asl    r1            ; /54/ Multiply by 8
  501.     asl    r1            ; /54/ ...
  502.     asl    r1            ; /54/ ......
  503.     add    r4    ,r1        ; /54/ Put in current result
  504.     sob    r0    ,20$        ; /54/ Next please
  505.     mov    r1    ,(r2)+        ; /54/ Copy the word
  506.     dec    (sp)            ; /54/ More to do
  507.     bne    10$            ; /54/ Yep
  508.     tst    (sp)+            ; /54/ All done
  509.     br    100$            ; /54/ Exit
  510.                     ;
  511. 30$:    cmpb    (r3)+    ,#42        ; /53/ File type subfunction?
  512.     bne    100$            ; /53/ No, ignore for now
  513.     movb    (r3)+    ,r0        ; /53/ Get the file type
  514.     SCAN    r0    ,#200$        ; /53/ Look for it
  515.     asl    r0            ; /53/ Word addressing
  516.     mov    210$(r0),image        ; /53/ Set it
  517.     mov    210$(r0),at$typ        ; /53/ Here also.
  518.     br    100$            ; /53/ Exit
  519.  
  520. 40$:    mov    #at$fab    ,r4        ; copy the packet over now
  521.     mov    r5    ,r3        ; and the source please
  522.     mov    #-1    ,(r4)+        ; flag that the attributes are for real
  523.     mov    #13    ,r2        ; number of words to convert back
  524. 50$:    clrb    6(r3)            ; insure .asciz now
  525.     calls    octval    ,<r3>        ; simple
  526.     tst    r0            ; successfull?
  527.     bne    90$            ; no, clear flag and exit
  528.     mov    r1    ,(r4)+        ; and save the value now
  529.     add    #7    ,r3        ; point to the next octal number
  530.     sob    r2    ,50$        ; next please
  531.     mov    sp    ,at$val        ; it's ok to use the attributes
  532.     br    100$            ; bye
  533. 90$:    clr    at$fab            ; error exit (conversion error)
  534.     message    <Fab attribute error>,cr; /49/
  535. 100$:    clr    r0            ; always flag success and exit
  536.     return
  537.  
  538.     .save
  539.     .psect    $pdata    ,d
  540. 200$:    .byte    'A    ,'I    ,'N    ,0
  541. 210$:    .word    TEXT
  542.     .word    TEXT    ,BINARY    ,DECNAT    ,0
  543.     .even
  544.     .restore
  545.     .dsabl    lsb
  546.  
  547.  
  548.     .sbttl    utility routines
  549.  
  550.     pd$rsx    =    '8
  551.     pd$ias    =    '9
  552.     pd$rsts    =    'A&137
  553.     pd$rt    =    'B&137
  554.     pd$pos    =    'C&137
  555.  
  556. ;    I S P D P
  557. ;
  558. ;    input:    nothing
  559. ;    output:    r0 <> 0 if the other system is a KERMIT-11 system
  560. ;    errors:    none
  561.  
  562.  
  563.     .psect    $pdata
  564.  
  565. pdplst:    .byte    pd$rsx    ,pd$ias    ,pd$rsts,pd$rt    ,pd$pos    ,0
  566.     .even
  567.     .psect    $code
  568.  
  569. ispdp::    clr    r0            ; presume failure
  570.     cmpb    at$sys    ,#'D&137    ; a DEC system ?
  571.     bne    100$            ; no, exit
  572.     scan    <at$sys+1>,#pdplst
  573. 100$:    return
  574.  
  575. clratr::clr    at$len    
  576.     clr    at$xlen
  577.     clr    at$typ    
  578.     clr    at$cre    
  579.     clr    at$id    
  580.     clr    at$bil    
  581.     clr    at$area
  582.     clr    at$pas
  583.     clr    at$bsiz    
  584.     clr    at$acc    
  585.     clr    at$enc    
  586.     clr    at$dis    
  587.     clr    at$pr0    
  588.     clr    at$pr1    
  589.     clr    at$sys
  590.     clr    at$for    
  591.     clr    at$fab
  592.     clr    atrctx
  593.     clr    at$klu+0
  594.     clr    at$klu+2
  595.     clr    at$klu+4
  596.     clr    at$klu+6
  597.     clr    at$cdt
  598.     return
  599.  
  600.  
  601.     .sbttl    finish up the update of rms file attributes to output
  602.  
  603. ;    A T R F I N
  604. ;
  605. ;    If the file was send in image mode, and we have been sent
  606. ;    valid attributes (basically, the sender's IFAB), then call
  607. ;    PUTATR to place these attributes into our output file's
  608. ;    IFAB so they will get updated.
  609. ;
  610. ;
  611. ;    Note: 11-Jul-84  17:12:49  BDN,  edit /19/
  612. ;
  613. ;     Note that for RSTS/E, we have an unusual problem in that if
  614. ;    the sender sent a stream ascii file (most likely a file with
  615. ;    NO attributes)  over and the sender  said it's binary,  then
  616. ;    RMS-11 sends GARBAGE for the VFC header size. When this data
  617. ;    is wriiten  into the output file's IFAB, RMS11 finds invalid
  618. ;    data in the IFAB and writes attributes to disk with the last
  619. ;    block field (F$HEOF and F$LEOF)  equal to ZERO.  Such a file
  620. ;    would thus be unreadable to PIP, RMS and other programs that
  621. ;    look at the file attributes.  The fix  is one of two things.
  622. ;    One, we can clear the invalid  VFC size and fudge the record
  623. ;    size and maximum record size to something usable (like 512),
  624. ;    or  we can simply ignore  the senders attributes and let the
  625. ;    file  stand as a  FIXED, NO CC, recordsize 512 file.  Rather
  626. ;    than to try to fix the attributes, we will simple ignore the
  627. ;    attributes  if the sender said that the file is stream ascii
  628. ;    with a garbage VFC.  Since  the attributes  are only used if
  629. ;    the transfer was in image moed, this will not  affect normal
  630. ;    files, only files like DMS-500 files that have no attributes
  631. ;    but must be sent in image mode.
  632. ;    Of course, the sending Kermit-11 can always be given the SET
  633. ;    ATT OFF and SET FIL BIN and the receiving Kermit-11 be given
  634. ;    the SET FIL BIN and the issue will never arise.
  635. ;
  636. ;    The mods are noted with /19/ after the statement.
  637.  
  638. atrfin::save    <r1,r2,r3>        ; just in case please
  639.     tst    @r5            ; lun zero ?
  640.     beq    100$            ; yep
  641.     tst    at$val            ; valid attributes to write ?
  642.     beq    100$            ; no
  643.     tst    at$cdt            ; Ever set the creation date/time?
  644.     beq    10$            ; No
  645.     calls    putcdt    ,<@r5,#at$klu>    ; Yes, update it
  646. 10$:    cmpb    at$typ    ,#binary    ; did we get this as a binary file?
  647.     bne    100$            ; no
  648.     mov    #at$fab    ,r1        ; yes
  649.     tst    (r1)+            ; valid data present ?
  650.     beq    100$            ; no
  651.     cmp    @r1    ,#2000        ; /19/ stream ascii ?
  652.     bne    30$            ; /19/ no
  653.     cmp    16(r1)    ,#177400    ; /19/ garbage for the vfc header size?
  654.     beq    90$            ; /19/ yes, forget about the attributes
  655. 30$:    calls    putatr    ,<@r5,r1>    ; /19/ update the ifab for the file
  656. 90$:    clr    at$typ            ; /19/ no longer valid please
  657.     clr    at$fab            ; no longer valid please
  658.     clr    at$val            ; no longer valid please
  659. 100$:    clr    at$cdt
  660.     unsave    <r3,r2,r1>        ; output file and exit
  661.     return
  662.  
  663.  
  664.  
  665.     .sbttl    Map RSTS protection codes to Files-11 codes and back
  666.  
  667.  
  668. ;    /59/  9-OCT-1987 08:11 BDN
  669. ;
  670. ;     Use the files11 format for transfering protection code
  671. ;    between two kermit-11's, thus it will work even for RSX
  672. ;    to RSTS transfer.
  673.  
  674.     .Save
  675.     .Psect    $Pdata    ,d
  676.  
  677.  
  678. dflt.f:    .word    ^B1100110000000000    ; Default to no world, group
  679. rsts.p:    .word    1*20            ; If 0 set, no owner read
  680.     .word    2*20            ; If 1 set, no owner write
  681.     .word    1*400            ; If 2 set, no group read
  682.     .word    2*400            ; If 3 set, no group write
  683.     .word    1*10000            ; If 4 set, no world read
  684.     .word    2*10000            ; If 5 set, no world write
  685.  
  686.     .Restore
  687.  
  688. torsts:    mov    #77    ,r1        ; Start with no access
  689.     clr    r2            ; Current bit to set
  690.     mov    #6    ,r3        ; Six times please
  691.     clr    r4            ; Indexing into bit table
  692.     mov    #1    ,r2        ; Start with bit one
  693. 10$:    bit    rsts.p(r4),r0        ; Check for F11 bit set
  694.     bne    20$            ; Set, implies access
  695.     bic    r2    ,r1        ; So clear it here
  696. 20$:    asl    r2            ; Shift it
  697.     tst    (r4)+            ; Next bit pattern
  698.     sob    r3    ,10$        ; Loopback
  699.     return                ; Exit
  700.  
  701. tof11:    mov    dflt.f    ,r1        ; Default Files-11 bitmask
  702.     clr    r2            ; Start with bit zero of RSTS
  703.     mov    #6    ,r3        ; Loop six times
  704. 10$:    bit    #1    ,r0        ; Check for bit being set in RSTS
  705.     beq    20$            ; code. Not set, leave alone
  706.     bis    rsts.p(r2),r1        ; Set, so set the Files-11 prot
  707. 20$:    tst    (r2)+            ; Next
  708.     asr    r0            ; Get the next bit moved over
  709.     sob    r3    ,10$        ; And loop back
  710.     mov    r1    ,r0        ; Return in r0
  711.     return                ; Exit
  712.  
  713.  
  714.  
  715.     .sbttl    32 bit arithmetic modules from RSX Syslib.olb
  716.  
  717. $DMUL:    MOV    R0,-(SP)
  718.     CLR    R0
  719.     CLR    R1
  720. 10$:    TST    (SP)
  721.     BEQ    30$
  722.     ROR    (SP)
  723.     BCC    20$
  724.     ADD    R3,R1
  725.     ADC    R0
  726.     ADD    R2,R0
  727. 20$:    ASL    R3
  728.     ROL    R2
  729.     BR    10$
  730. 30$:    TST    (SP)+
  731.     RETURN
  732.  
  733. $DDIV:    MOV    R3,-(SP)
  734.     MOV    #40,R3
  735.     MOV    R0,-(SP)
  736.     CLR    R0
  737. 10$:    ASL    R2
  738.     ROL    R1
  739.     ROL    R0
  740.     CMP    R0,(SP)
  741.     BCS    20$
  742.     SUB    (SP),R0
  743.     INC    R2
  744. 20$:    DEC    R3
  745.     BGT    10$
  746.     TST    (SP)+
  747.     MOV    (SP)+,R3
  748.     RETURN
  749.  
  750.  
  751.     .end
  752.