home *** CD-ROM | disk | FTP | other *** search
/ kermit.columbia.edu / kermit.columbia.edu.tar / kermit.columbia.edu / test / pdp11 / krtatr.mac < prev    next >
Text File  |  1996-10-17  |  35KB  |  1,094 lines
  1.     .title    KRTATR    Process attribute packets
  2.     .ident    "V04.64"
  3.  
  4. ; /E64/    10-May-96  John Santos
  5. ;
  6. ;    Conditionalize for RSTS/E.
  7. ;    Restore RSTS/E attibutes handling from K11ATR.MAC
  8. ;    Send two words of file size in sn.len & sn.xle
  9. ;    Send our system type as RSTS/E
  10. ;    Restore attribute 54 (RSTS/RSX protection code)
  11. ;    handle creation date (cdt) attribute
  12. ;    split up internal packet type (sn.inf) so that it can be sent in
  13. ;    multiple packets.
  14. ;    Send multiple attribute packets because they are too big.
  15.  
  16. ; /63/    23-Dec-94  Billy Youdelman
  17.  
  18. ; /62/    27-Jul-93  Billy Youdelman  V03.62
  19. ;
  20. ;    add 25% to rec'd length for text files from non RT-11/TSX systems
  21.  
  22. ; /BBS/     1-Dec-91  Billy Youdelman  V03.61
  23. ;
  24. ;    modified rx.cdt,sn.cdt to do the "#" date/time attribute
  25. ;    hosed unused stuff, added rx.pro,sn.pro for protected file attribute
  26. ;
  27. ;    added support for date/time/prot file attributes
  28. ;    patched open, close and I/O data table to support it..
  29. ;
  30. ;    modified w$attr to send all attributes in a single packet
  31. ;    rx.xle result in at$len no longer overwritten by rx.len
  32. ;    added send exact file length in bytes
  33. ;    call binary files "BINARY" not "IMAGE" so MS-Kermit is happy
  34.  
  35. ;    Copyright 1984 Change Software, Inc.
  36. ;
  37. ;    18-Apr-84  11:20:59 Brian Nelson
  38. ;    24-Mar-86  12:00:56 BDN    Major revision which has some rather
  39. ;                unpleasant compatibility problems with
  40. ;                older Kermit-11's.
  41. ;    12-Sep-86  10:37:04 BDN Convert for I/D space
  42.  
  43. ;     This module is intended to be placed into an overlay
  44. ;    which MUST be the "ERROR" cotree as the server, which
  45. ;    is overlaid in the  "UTILTY"  cotree  can  indirectly
  46. ;    call the module through the packet control routines.
  47.  
  48. ;     The receiving Kermit should ALWAYS get the SYSTEM and
  49. ;    EXECUTIVE type attribute packet first so it can decide
  50. ;    if it should use the data being sent.
  51.  
  52.  
  53.     .include "IN:KRTMAC.MAC"
  54.     .iif ndf  KRTINC  .error    <; .include for IN:KRTMAC.MAC failed>
  55.  
  56. .if    df    RT11            ; /E64/
  57.     .mcall    .DATE    ,.GTIM        ; /BBS/
  58. .endc    ;RT11                ; /E64/
  59.  
  60.  
  61.     .psect    $rwdata    ,rw,d,lcl,rel,con
  62. atrctx::.word    0            ; /E64/ send attrs context (index)
  63. .if    df    RSTS            ; /E64/
  64. atrsnt::.word    0            ; /E64/ attributes actually sent
  65. atrsiz:    .word    0            ; /E64/ approx size of current packet
  66. .endc    ;RSTS                ; /E64/
  67. curatr:    .blkb    200            ; current attribute scratch buffer
  68. day.x:    .word    0            ; /BBS/ integer file create day
  69. day.y:    .byte    0 ,0 ,0 ,0        ; /BBS/ ascii file create day
  70. mon.x:    .word    0            ; /BBS/ integer file create month
  71. mon.y:    .byte    0 ,0 ,0 ,0        ; /BBS/ ascii file create month
  72. sizbuf:    .byte    0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ; /BBS/ sn.xle ascii size
  73. xblock:    .word    0 ,0            ; /BBS/ buffer for sn.xle, .gtim
  74. yr.x:    .word    0            ; /BBS/ integer file create year
  75. yr.y:    .byte    0 ,0 ,0 ,0 ,0 ,0    ; /BBS/ ascii file create year
  76.  
  77.  
  78.     .psect    $code
  79.     .sbttl    Send all attributes in a single packet    ; /BBS/ modified to..
  80.  
  81. ;    W $ A T T R
  82. ;
  83. ;    input:     (r5)    = file lun
  84. ;        2(r5)    = output packet buffer address
  85. ;    output:      r1    > 0 is packet length, 0 = receiver can't do attributes
  86.  
  87. w$attr::save    <r2,r3,r4>
  88.     clr    r1            ; preset in case other system
  89.     bitb    #capa.a    ,conpar+p.capas    ; can't handle attributes
  90.     beq    40$            ; it can't
  91.     bit    #at.on    ,doattr        ; /63/ are attributes enabled?
  92.     beq    40$            ; /63/ no
  93.     mov    2(r5)    ,r4        ; point to the packet
  94. .if    df    RT11            ; /E64/
  95.     clr    atrctx            ; init index
  96. .endc    ;RT11                ; /E64/
  97. .if    df    RSTS            ; /E64/
  98.     clrb    @r4            ; /E64/ init packet in case it's empty
  99.     clr    atrsiz            ; /E64/ no attrs yet in this packet
  100.     mov    atrsnt    ,atrctx        ; /E64/ here's where we start
  101. .endc    ;RSTS                ; /E64/
  102.  
  103. 10$:    mov    atrctx    ,r0        ; dispatch on what to send next
  104.     asl    r0            ; word indexing
  105.     tst    watt(r0)        ; all done?
  106.     beq    30$            ; yes, finish up
  107.     bit    at.tx(r0),doattr    ; /62/ is this attribute enabled?
  108.     beq    20$            ; /62/ no
  109. .if    df    RSTS            ; /E64/
  110.     add    at.ln(r0),atrsiz    ; /E64/ room for next attribute?
  111.     cmp    atrsiz    ,#94.        ; /E64/ (max allowed is 94 bytes)
  112.     bhi    30$            ; /E64/ no, so out of here
  113. .endc    ;RSTS                ; /E64/
  114.     jsr    pc    ,@watt(r0)    ; do it
  115. .if    df    RSTS            ; /E64/
  116.     strlen    2(r5)            ; /E64/ get length so far
  117.     mov    r0    ,atrsiz        ; /E64/ and save it
  118. .endc    ;RSTS                ; /E64/
  119. 20$:    inc    atrctx            ; index to next subroutine
  120.     br    10$            ; loop back for it
  121.  
  122. 30$:    strlen    2(r5)            ; get the length and return it
  123.     mov    r0    ,r1        ; and say that this packet is for real
  124. 40$:    clr    r0            ; no error possible
  125.     unsave    <r4,r3,r2>
  126.     return
  127.  
  128.     .save
  129.     .psect    $pdata
  130. .if    df    RT11            ; /E64/
  131. watt:    .word    sn.sys    ,sn.typ    ,sn.pro    ,sn.len    ,sn.inf    ,sn.cdt    ,sn.xle
  132. at.rx:    .word    0            ; /62/ also terminates watt
  133. at.tx:    .word    at.sys    ,at.typ    ,at.pro    ,at.len    ,at.inf    ,at.cdt    ,at.xle
  134. .endc    ;RT11                ; /E64/
  135. .if    df    RSTS            ; /E64/
  136. watt:    .word    sn.sys    ,sn.typ    ,sn.pro    ,sn.len    ,sn.in1    ,sn.inf    ,sn.cdt
  137.     .word    sn.xle
  138. at.rx:    .word    0            ; /62/ also terminates watt
  139. at.tx:    .word    at.sys    ,at.typ    ,at.pro    ,at.len    ,at.inf    ,at.inf    ,at.cdt
  140.     .word    at.xle
  141. at.ln:    .word    4    ,3    ,8.    ,9.    ,79.    ,31.    ,16.
  142.     .word    12.
  143. .endc    ;RSTS                ; /E64/
  144.     .restore
  145.  
  146.     .sbttl    Send system type
  147.  
  148. sn.sys:    movb    #'.    ,(r4)+        ; the system id attribute
  149.     movb    #42    ,(r4)+        ; /49/ length of what follows
  150.     movb    #'D&137    ,(r4)+        ; return the vendor code (DEC)
  151. .if    df    RT11            ; /E64/
  152.     movb    #'B&137    ,(r4)+        ; /BBS/ it's RT-11 for sure here
  153. .endc    ;RT11                ; /E64/
  154. .if    df    RSTS            ; /E64/
  155.     movb    #'A&137    ,(r4)+        ; /E64/ it's RSTS/E for sure here
  156. .endc    ;RSTS                ; /E64/
  157.     br    sn.end            ; /63/ go make it .asciz
  158.  
  159.  
  160.     .sbttl    Send generic file type
  161.  
  162. sn.typ:    movb    #42    ,(r4)+        ; file type attribute
  163.     movb    #41    ,(r4)+        ; /49/ length of what follows
  164.     movb    #'A&137    ,r0        ; /BBS/ assume ascii
  165.     cmpb    image    ,#binary    ; is it binary or 8-bit text?
  166.     blt    10$            ; /63/ no
  167.     movb    #'B&137    ,r0        ; /BBS/ yes, indicate it is..
  168. 10$:    movb    r0    ,(r4)+        ; /BBS/ put file type in packet
  169.     br    sn.end            ; /63/ go make it .asciz
  170.  
  171.  
  172.     .sbttl    Send file protection    ; /BBS/ fixed for RT-11
  173.  
  174. .if    df    RT11            ; /E64/
  175. sn.pro:                    ;    bit_0    =  read
  176.                     ;    bit_1    =  write
  177. ; protection codes from "Kermit, A        bit_2    =  execute
  178. ; File Transfer Protocol," 1987, for        bit_3    =  append
  179. ; the "-" (octal 55) attribute            bit_4    =  delete
  180.                     ;    bit_5    =  directory
  181.     movb    #55    ,(r4)+        ; public file protection
  182.     movb    #41    ,(r4)+        ; length of what follows
  183.     mov    (r5)    ,r0        ; get lun
  184.     asl    r0            ; word indexing
  185.     tst    prot.a(r0)        ; is it protected?
  186.     bne    10$            ; ya
  187.     mov    #<1!2!4!10!20!40>,r0    ; no, set bits 0 thru 5
  188.     br    20$            ; continue
  189. 10$:    mov    #<1!4!40>,r0        ; protected, set bits 0,2,5 only
  190. 20$:    add    #40    ,r0        ; tochar r0
  191.     movb    r0    ,(r4)+        ; put it into packet
  192. sn.end:    clrb    @r4            ; .asciz
  193.     return
  194. .endc    ;RT11                ; /E64/
  195.  
  196. .if    df    RSTS            ; /E64/
  197. sn.pro: calls    getpro    ,<(r5)>        ; /E64/ Get protection for file
  198.     call    tof11            ; /59/ Yes, convert
  199.     movb    #54    ,(r4)+        ; /59/ Sending internal protection
  200.     movb    #40+6    ,(r4)+        ; /59/ Field is six characters
  201.     calls    l$otoa    ,<r4,r0>    ; /59/ Convert to octal
  202.     add    #6    ,r4        ; /59/ Always leave pointing to end
  203. sn.end:    clrb    @r4            ; .asciz
  204.     return
  205. .endc    ;RSTS                ; /E64/
  206.  
  207.  
  208.     .sbttl    Send file length    ; /BBS/
  209.  
  210. sn.len:    mov    (r5)    ,r1        ; lun open to the file
  211.     asl    r1            ; word indexing
  212. .if    df    RT11            ; /E64/
  213.     mov    sizof(r1),r1        ; get file size
  214.     inc    r1            ; accommodate rounding to
  215.     asr    r1            ; 1024. byte blocks, not 512.
  216.     bne    10$            ; /BBS/ something is left of size..
  217.     inc    r1            ; /BBS/ no, make it at least one block
  218. 10$:    movb    #41    ,(r4)+        ; attribute type (file size)
  219.     movb    #45    ,(r4)+        ; length of the number
  220.     deccvt    r1    ,r4    ,#5    ; convert to ascii
  221.     mov    #5    ,r0        ; for 5 chars
  222. 20$:    cmpb    @r4    ,#space        ; if a space, then make it a "0"
  223.     bne    30$            ; not a space
  224.     movb    #'0    ,@r4        ; it was a space
  225. 30$:    inc    r4            ; next
  226.     sob    r0    ,20$        ; please
  227. .endc    ;RT11                ; /E64/
  228. .if    df    RSTS            ; /E64/
  229.     ; /E64/ this code isn't really RSTS/E specific.  It is
  230.     ; /E64/ large file (>65535. blocks) specific.
  231.     mov    sizofh(r1),r0        ; /E64/ high word of size
  232.     mov    sizof(r1),r2        ; /E64/ low word of size
  233.     add    #1    ,r2        ; /E64/ round up
  234.     adc    r0            ; /E64/ carry to high word
  235.     asr    r0            ; /E64/ divide by 2 to convert to
  236.     ror    r2            ; /E64/ 1024. byte blocks
  237.     mov    #xblock+2,r1        ; /E64/ address of 32-bit number
  238.     mov    r2    ,(r1)        ; /E64/ store low word
  239.     mov    r0    ,-(r1)        ; /E64/   and high word
  240.                     ; /E64/ sorry, this is ludicrously
  241.                     ; /E64/ optimized for no good reason,
  242.                     ; /E64/ but I couldn't resist!
  243.                     ; /E64/ R1 now points to xblock
  244.     clr    r2            ; suppress leading zeros in output
  245.     mov    #sizbuf    ,r0        ; address of out buff for ascii
  246.     call    $cddmg            ; convert 32-bit integer to ascii
  247.     clrb    @r0            ; null terminate the string
  248.     cmpb    #'*    ,sizbuf        ; did $cddmg overflow?
  249.     beq    40$            ; ya, bail out..
  250.     strlen    #sizbuf            ; get its length
  251.     mov    r0    ,r1        ; /E64/ save length
  252.     movb    #41    ,(r4)+        ; attribute type (file size)
  253.     add    #40    ,r0        ; tochar the string length
  254.     movb    r0    ,(r4)+        ; stuff into the attribute string
  255.     mov    #sizbuf    ,r0        ; get pointer to the length string
  256. 20$:    movb    (r0)+    ,(r4)+        ; then copy ascii'd length into attr$
  257.     sob    r1    ,20$        ; /E64/ next...
  258. .endc    ;RSTS                ; /E64/
  259. 40$:    br    sn.end            ; /63/ go make it .asciz
  260.  
  261.  
  262.     .sbttl    Send system specific info    ; /52/ added /BBS/ cleaned up
  263.  
  264. ;    send a copy of the ifab over
  265. ;
  266. ;     The routine 'GETATR' takes the directory (or file header) information
  267. ;    regarding the file format from the IFAB allocated  to the FAB for  the
  268. ;    file currently being sent. This data is converted to octal strings and
  269. ;    then sent over as an ATTRIBUTE packet with a type of '0', which is the
  270. ;    type reserved for system specific data.
  271. ;     The  receiver  KERMIT should ALWAYS get the SYSTEM and EXECUTIVE type
  272. ;    attribute packet first so it can decide whether or not it wants to use
  273. ;    the data being sent.
  274. ;
  275. ;    For instance, the file A.A would have a packet sent over as in below
  276. ;
  277. ; Name .Typ    Size    Prot   Access     Date      Time   Clu  RTS    Pos
  278. ;A     .A         1    < 60> 01-May-84 01-May-84 10:17 AM   4 ...RSX  3493
  279. ; RF:VAR=132 FO:SEQ   USED:1:98       RECSI:46       CC:IMP
  280. ;
  281. ;
  282. ;
  283. ;SPACK -   Length   78   Type  A    Paknum    3
  284. ;0001002 000056 000000 000001 000000 000001 000142 000000 000204 000000 000000
  285.  
  286.  
  287. .if    df    RSTS            ; /E64/
  288. sn.in1:    calls    getatr    ,<(r5),#at$fab>    ; get the ifab stuff now
  289.     movb    #'0    ,(r4)+        ; return sys type attr code
  290.     movb    #<13*7>+40,(r4)+    ; Length of data to follow.
  291.     mov    #at$fab    ,r2        ; where we store such things
  292.     mov    #13    ,r0        ; number of words to send
  293. 20$:    calls    l$otoa    ,<r4,(r2)+>    ; do it
  294.     add    #6    ,r4        ; skip over it
  295.     movb    #40    ,(r4)+        ;
  296.     sob    r0    ,20$        ; next
  297. 30$:    br    sn.end            ; go make it .asciz
  298. .endc    ;RSTS                ; /E64/
  299.  
  300. ;    Send internal file type
  301. ;
  302. sn.inf:    movb    #'0    ,(r4)+        ; DEC-specific file type
  303.     movb    #42    ,(r4)+        ; length of data to follow
  304.     movb    #42    ,(r4)+        ; sending extended file type
  305.     mov    image    ,r0        ; use this to index to it
  306.     movb    sn$inf(r0),(r4)+    ; /63/ insert it
  307.  
  308. ;    Send creation date and time in RMS format
  309. ;
  310. .if    df    RSTS            ; /E64/
  311.     movb    #'0    ,(r4)+        ; System dependent data following
  312.     movb    #41+<6*4>,(r4)+        ; Amount of data to follow
  313.     movb    #43    ,(r4)+        ; Date of creation, 64bit format
  314.     CALLS    getcdt    ,<(r5)>        ; Get address of data
  315.     mov    r0    ,r2        ; Successful (ie, not RT11)
  316.     mov    #4    ,r3        ; Number of words
  317. 40$:    CALLS    l$otoa    ,<r4,(r2)+>    ; Do it
  318.     add    #6    ,r4        ; Move over
  319.     sob    r3    ,40$        ; Next please
  320. .endc    ;RSTS                ; /E64/
  321.     br    sn.end            ; /63/ go make it .asciz
  322.  
  323.     .save
  324.     .psect    $pdata
  325. sn$inf:    .byte    'A&137    ,'I&137    ,'N&137
  326.     .even
  327.     .restore
  328.  
  329.  
  330.     .sbttl    Get file creation date/time    ; /BBS/ added this..
  331.  
  332. sn.cdt:    save    <r4>            ; pointer to current position in buff
  333.     mov    (r5)    ,r4        ; channel
  334.     asl    r4            ; word offsets
  335. .if    df    RT11            ; /E64/
  336.     mov    date.a(r4),r0        ; recover current file's date
  337.     mov    #curatr    ,r1        ; the result address
  338.  
  339.     mov    r0    ,r3        ; copy the date to extract
  340.     bic    #^c<37>    ,r3        ; the year
  341.     add    #1972.    ,r3        ; plus the bias please
  342.     mov    r0    ,r2        ; copy the date
  343.     bic    #^c<140000>,r2        ; extend max year w/two hi bits
  344.     swab    r2            ; two hi bits now are bits 7,6
  345.     asr    r2            ; shift to bits 6,5 (true value)
  346.     add    r2    ,r3        ; add to total years
  347.     call    i4toa            ; do all 4 digits of year
  348.  
  349.     mov    r0    ,r3        ; copy to extract months
  350.     swab    r3            ; get the month to bits 7..2
  351.     asr    r3            ; now bits 6..1
  352.     asr    r3            ; now bits 5..0
  353.     bic    #^c<37>    ,r3        ; hose everything else
  354.     call    i2toa            ; write ascii to out buff
  355.  
  356.     mov    r0    ,r3        ; copy to extract day of month
  357.     ash    #3    ,r3        ; /62/ shift left 3 places
  358.     swab    r3            ; then swap bytes to get
  359.     bic    #^c<37>    ,r3        ; the date
  360.     call    i2toa            ; write ascii to out buff
  361.  
  362.     tst    tsxsav            ; only do file time under TSX
  363.     beq    10$            ; it's not TSX
  364.     movb    #space    ,(r1)+        ; a space delimiter between date,time
  365.  
  366.     mov    time.a(r4),r3        ; recover current file's time
  367.     clr    r2            ; clear hi word for upcoming divide
  368.     div    #20.    ,r2        ; get # of 3-sec units since midnight
  369.     mov    r3    ,-(sp)        ; put on stack
  370.     asl    r3            ; 2x secs
  371.     add    r3    ,(sp)        ; plus 1x = 3x = number_of_seconds
  372.     mov    r2    ,r3        ; get rest of time
  373.     clr    r2            ; set up for next divide
  374.     div    #60.    ,r2        ; get number of minutes
  375.     mov    r3    ,-(sp)        ; and save on stack
  376.     mov    r2    ,r3        ; this is the number of hours
  377.     call    i2toa            ; write ascii to out buff
  378.     movb    #':    ,(r1)+        ; a colon into the buffer
  379.     mov    (sp)+    ,r3        ; recover minutes
  380.     call    i2toa            ; write ascii to out buff
  381.     movb    #':    ,(r1)+        ; a colon into the buffer
  382.     mov    (sp)+    ,r3        ; recover secs
  383.     call    i2toa            ; write ascii to out buff
  384.  
  385. 10$:    clrb    @r1            ; .asciz
  386. .endc    ;RT11                ; /E64/
  387.  
  388. .if    df    RSTS            ; /E64/
  389.     calls    cantim    ,<#curatr,date.a(r4),time.a(r4)>
  390.                     ; /E64/ convert date & time to ascii
  391. .endc    ;RSTS                ; /E64/
  392.  
  393.     unsave    <r4>            ; recover packet buffer pointer
  394.     mov    #curatr    ,r1        ; pointer to string just built
  395.     strlen    r1            ; get length of string
  396.     add    #40    ,r0        ; encode length (tochar..)
  397.     movb    #'#    ,(r4)+        ; file create time/date data
  398.     movb    r0    ,(r4)+        ; put length into packet buffer
  399. 20$:    movb    (r1)+    ,(r4)+        ; then copy data into it
  400.     bne    20$            ; until null
  401.     dec    r4            ; bump pointer back to the null
  402.     return
  403.  
  404.  
  405.     .sbttl    Send file length in bytes  ; /BBS/ all new
  406.  
  407. sn.xle:    mov    (r5)    ,r3        ; file open on this chan
  408.     asl    r3            ; word indexing
  409. .if    df    RT11            ; /E64/
  410.     clr    r2            ; double precision, init high word
  411. .endc    ;RT11                ; /E64/
  412. .if    df    RSTS            ; /E64/
  413.     mov    sizofh(r3),r2        ; /E64/ high word of size
  414. .endc    ;RSTS                ; /E64/
  415.     mov    sizof(r3),r3        ; size in the accumulator low word
  416.     bne    10$            ; something is there
  417. .if    df    RSTS            ; /E64/
  418.     tst    r2            ; /E64/ both words zero?
  419.     bne    10$            ; /E64/ nope
  420. .endc    ;RSTS                ; /E64/
  421.     inc    r3            ; make it at least one block
  422. 10$:    mov    #512.    ,r0        ; setup call to $dmul, size*512.
  423.     call    $dmul            ; double precision multiply
  424.     mov    r0    ,xblock        ; save hi word
  425.     mov    r1    ,xblock+2    ; save low word
  426.     clr    r2            ; suppress leading zeros in output
  427.     mov    #xblock    ,r1        ; address of 32-bit number
  428.     mov    #sizbuf    ,r0        ; address of out buff for ascii
  429.     call    $cddmg            ; convert 32-bit integer to ascii
  430.     clrb    @r0            ; null terminate the string
  431.     cmpb    #'*    ,sizbuf        ; did $cddmg overflow?
  432.     beq    30$            ; ya, bail out..
  433.     strlen    #sizbuf            ; get its length
  434.     movb    #61    ,(r4)+        ; attribute type (exact size in bytes)
  435.     add    #40    ,r0        ; tochar the string length
  436.     movb    r0    ,(r4)+        ; stuff into the attribute string
  437.     mov    #sizbuf    ,r0        ; get pointer to the length string
  438. 20$:    movb    (r0)+    ,(r4)+        ; then copy ascii'd length into attr$
  439.     bne    20$            ; until hitting the null terminator
  440. 30$:    return
  441.  
  442.  
  443.     .sbttl    Received attribute packet processing
  444.  
  445. ;    R $ A T T R
  446. ;
  447. ;    input:     (r5)    = packet buffer address
  448. ;    output:      r0    = if <>, error code
  449.  
  450. r$attr::save    <r1,r2,r5>        ; /BBS/ cleaned this up a bit..
  451.     bit    #at.on    ,doattr        ; /63/ attribute processing enabled?
  452.     beq    70$            ; /62/ nope
  453.     mov    @r5    ,r5        ; /49/ get packet data address
  454.  
  455. 10$:    movb    (r5)+    ,r0        ; /49/ attribute type code
  456.     beq    60$            ; /49/ nothing there..
  457.     movb    (r5)+    ,r1        ; /49/ get length field next
  458.     beq    60$            ; /49/ nothing there..
  459.     cmpb    r0    ,#'.        ; /49/ if this is an OLD Kermit-11
  460.     bne    20$            ; /49/ with the invalid system type
  461.     cmpb    r1    ,#'D&137    ; /49/ format then we have to fix it
  462.     bne    20$            ; /49/ it is not..
  463.     dec    r5            ; /49/ it is, we'd been forgetting to
  464.     mov    #42    ,r1        ; /49/ include the length field
  465.  
  466. 20$:    sub    #40    ,r1        ; /49/ convert length to integer
  467.     ble    60$            ; /BBS/ nothing there
  468.     mov    #curatr    ,r2        ; /49/ copy current attribute argument
  469. 30$:    movb    (r5)+    ,(r2)+        ; /49/ over to a save area now
  470.     sob    r1    ,30$        ; /49/ next please
  471.     clrb    (r2)+            ; /49/ ensure .asciz please
  472.     mov    r5    ,-(sp)        ; /49/ make sure the r5 context saved
  473.     scan    r0    ,#attrty    ; look for the attribute packet type?
  474.     asl    r0            ; simple to do
  475.     bit    at.rx(r0),doattr    ; /62/ is this attribute enabled?
  476.     bne    40$            ; /62/ ya
  477.     clr    r0            ; /62/ no, check for
  478.     br    50$            ; /62/ more attributes
  479. 40$:    jsr    pc    ,@attrds(r0)    ; process the attribute packet now
  480. 50$:    mov    (sp)+    ,r5        ; /49/ restore the r5 context now
  481.     tst    r0            ; success?
  482.     beq    10$            ; yes
  483.     br    80$            ; no, exit with error in r0
  484.  
  485. 60$:
  486. .if    df    RT11            ; /E64/
  487.     call    ispdp            ; /62/ if other end is RT-11 or TSX..
  488.     cmp    r0    ,#4        ; /62/ well?
  489.     beq    70$            ; /62/ it is, so file sizes are exact
  490.     cmp    image    ,#binary    ; /62/ then if file type isn't binary
  491.     beq    70$            ; /62/ it is, image size is always ok
  492.     mov    at$len    ,r0        ; /62/ otherwise save the passed size
  493.     beq    80$            ; /62/ nothing was there, r0 is clear
  494.     asr    r0            ; /62/ divide by two
  495.     asr    r0            ; /62/ now it's by four, 25% of total
  496.     inc    r0            ; /62/ bump one more block to be sure
  497.     add    r0    ,at$len        ; /62/ now bump requested space by 25%
  498.     bcc    70$            ; /62/ result didn't overflow
  499.     mov    #65497.    ,at$len        ; /62/ it did, try the max possible..
  500. .endc    ;RT11                ; /E64/
  501. 70$:    clr    r0            ; packet format error or end of data
  502. 80$:    unsave    <r5,r2,r1>
  503.     return
  504.  
  505.     .save
  506.     .psect    $pdata
  507. .if    df    RT11            ; /E64/
  508. attrty:    .byte    56    ,42    ,55    ,41    ,60    ,43    ,61
  509. .endc    ;RT11                ; /E64/
  510. .if    df    RSTS            ; /E64/
  511. attrty:    .byte    56    ,42    ,54    ,41    ,60    ,43    ,61 ; /E64/
  512. .endc    ;RSTS                ; /E64/
  513.     .byte    0
  514.     .even
  515. attrds:    .word    rx.$$            ; /62/ must conform to at.rx
  516.     .word    rx.sys    ,rx.typ    ,rx.pro    ,rx.len    ,rx.inf    ,rx.cdt    ,rx.xle
  517.     .restore
  518.  
  519.  
  520.     .sbttl    Null attribute handler
  521.  
  522. rx.$$:    clr    r0            ; /49/ ignore unknown attribute types
  523.     return
  524.  
  525.  
  526.     .sbttl    Process received length specified in 1024. byte blocks
  527.  
  528. rx.len:    tst    at$len            ; /BBS/ size from rx.xle already here?
  529.     bne    40$            ; /BBS/ ya, use it instead of this
  530. .if    df    RSTS            ; /E64/
  531.     tst    at$len+2        ; /E64/ check high word, too
  532.     bne    40$            ; /E64/ ya, use it instead of this
  533. .endc    ;RSTS                ; /E64/
  534.     mov    #curatr    ,r2        ; /49/ where we saved attributes
  535. .if    df    RSTS            ; /E64/
  536.     clr    r0            ; /E64/ high word of result
  537. .endc    ;RSTS                ; /E64/
  538.     clr    r1            ; init the accumulator
  539. 10$:    tstb    @r2            ; EOL?
  540.     beq    30$            ; yep
  541.     cmpb    @r2    ,#space        ; ignore leading spaces please
  542.     beq    20$            ; yes, a space
  543.     clr    -(sp)            ; avoid sxt
  544.     bisb    @r2    ,@sp        ; get the next digit please
  545.     sub    #'0    ,@sp        ; and convert to decimal
  546. .if    df    RT11            ; /E64/
  547.     mul    #12    ,r1        ; shift accum over 10.
  548. .endc    ;RT11                ; /E64/
  549. .if    df    RSTS            ; /E64/
  550.     mov    r2    ,-(sp)        ; /E64/ save pointer
  551.     mov    r0    ,r2        ; /E64/ high word of multiplicand
  552.     mov    r1    ,r3        ; /E64/ low word
  553.     mov    #12    ,r0        ; /E64/  shift accum over 10.
  554.     call    $dmul            ; /E64/ multiply it
  555.     mov    (sp)+    ,r2        ; /E64/ restore pointer
  556. .endc    ;RSTS                ; /E64/
  557.     add    (sp)+    ,r1        ; add in the current digit
  558. .if    df    RSTS            ; /E64/
  559.     adc    r0            ; /E64/ carry from add
  560. .endc    ;RSTS                ; /E64/
  561. 20$:    inc    r2            ; next ch please
  562.     br    10$            ; /49/ Next please
  563. 30$:    asl    r1            ; convert 1024. blocks to 512. blocks
  564.     mov    r1    ,at$len        ; save it please
  565. .if    df    RSTS            ; /E64/
  566.     rol    r0            ; /E64/ high word of size
  567.     mov    r0    ,at$len+2    ; /E64/ save it please
  568. .endc    ;RSTS                ; /E64/
  569. 40$:    clr    r0            ; success
  570.     return
  571.  
  572.  
  573.     .sbttl    Received file type
  574.  
  575. rx.typ:    tst    doauto            ; /BBS/ auto file type enabled?
  576.     bne    10$            ; /BBS/ ya
  577.     mov    $image    ,image        ; /BBS/ no, use what's SET
  578.     br    30$
  579. 10$:    cmpb    curatr    ,#'B&137    ; binary?
  580.     beq    20$            ; yes
  581.     cmpb    curatr    ,#'I&137    ; image?
  582.     bne    30$            ; no
  583. 20$:    mov    #binary    ,image        ; flag for image mode
  584. 30$:    clr    r0            ; success
  585.     return
  586.  
  587.  
  588.     .sbttl    Put create date/time where close can get them later ; /BBS/
  589.  
  590. rx.cdt:    clr    -(sp)            ; init 2 digit year flag
  591.     scan    #space    ,#curatr    ; find the space between date and time
  592.     tst    r0            ; get it?
  593.     bne    10$            ; ya..
  594.     strlen    #curatr            ; no time is there
  595.     cmp    r0    ,#7        ; 2 or 4 digit year?
  596.     bgt    20$            ; it's 4
  597.     br    30$            ; it's 2
  598.  
  599. 10$:    cmp    r0    ,#10        ; 2 or 4 digit year?
  600.     blt    30$            ; 2 digits
  601. 20$:    mov    sp    ,(sp)        ; 4 digits, set flag
  602. 30$:    mov    #curatr    ,r1        ; pointer to date/time packet data
  603.     mov    #yr.y    ,r0        ; extract the ascii year here
  604.     call    mov2b            ; copy two bytes
  605.     tst    (sp)+            ; two or four digit year string?
  606.     beq    40$            ; just two
  607.     call    mov2b            ; copy two bytes
  608. 40$:    mov    #mon.y    ,r0        ; extract the ascii month here
  609.     call    mov2b            ; copy two bytes
  610.     mov    #day.y    ,r0        ; extract the ascii day here
  611.     call    mov2b            ; copy two bytes
  612.  
  613.     save    <r1>            ; save pointer to time string
  614.  
  615.     mov    #yr.y    ,r3        ; recover ascii year
  616.     call    gnum            ; make it an integer
  617.     mov    r1    ,yr.x        ; and save it here
  618.     mov    #mon.y    ,r3        ; recover ascii month
  619.     call    gnum            ; make it an integer
  620.     mov    r1    ,mon.x        ; and save it here
  621.     mov    #day.y    ,r3        ; recover ascii day
  622.     call    gnum            ; make it an integer
  623.     mov    r1    ,day.x        ; and save it here
  624.  
  625. .if    df    RT11            ; /E64/
  626.     ;  2_bits<year_ext> ,4_bits<mon> ,5_bits<day> ,5_bits<year-1972>
  627.     mov    mon.x    ,r1        ; recover month
  628.     ash    #5    ,r1        ; partial shift towards final location
  629.     add    day.x    ,r1        ; recover days
  630.     ash    #5    ,r1        ; shift days/months to final positions
  631. .endc    ;RT11                ; /E64/
  632.  
  633. .if    df    RSTS            ; /E64/
  634.     mov    mon.x    ,r0        ; /E64/ get month
  635.     asl    r0            ; /E64/ *2 for indexing
  636.     mov    monday-2(r0),r0        ; /E64/ days in the month
  637.     add    day.x    ,r0        ; /E64/ day of year (mod leap year!)
  638. .endc    ;RSTS                ; /E64/
  639.  
  640.     mov    yr.x    ,-(sp)        ; recover year
  641.     cmp    (sp)    ,#100.        ; is it two digits only?
  642.     bge    60$            ; no
  643.  
  644. .if    df    RT11            ; /E64/
  645.     cmp    (sp)    ,#71.        ; ya but ambiguity impossible 'til '72
  646.     ble    50$            ; it has to be 21st century
  647.  
  648.     ; if two-digit year extend to four-digits based on the current century
  649.     .gtim    #rtwork    ,#xblock    ; ensure clock rollover..
  650.     .date                ; ya, which century is it now?
  651.     mov    r0    ,r3        ; copy the date
  652.     bic    #^c<37>    ,r3        ; the year
  653.     add    #1972.    ,r3        ; plus the bias
  654.     bic    #^c<140000>,r0        ; extend max year w/two hi bits
  655.     swab    r0            ; two hi bits now are bits 7,6
  656.     asr    r0            ; shift to bits 6,5 (true value)
  657.     add    r0    ,r3        ; now it's the total years
  658.     cmp    r3    ,#1999.        ; well?
  659.     bgt    50$            ; it's 2000 A.D. or above
  660. .endc    ;RT11                ; /E64/
  661.  
  662. .if    df    RSTS            ; /E64/
  663.     cmp    (sp)    ,#69.        ; /E64/ before '70?
  664.     ble    50$            ; /E64/ yes, it has to be 21st century
  665. .endc    ;RSTS                ; /E64/
  666.  
  667.     add    #1900.    ,(sp)        ; not 2000 A.D. yet ..
  668.     br    60$            ; and continue
  669. 50$:    add    #2000.    ,(sp)        ; default to current century
  670.  
  671. .if    df    RT11            ; /E64/
  672. 60$:    sub    #1972.    ,(sp)        ; RT-11 dates begin at 1972..
  673.     bge    70$            ; an ok date for RT-11
  674.     clr    r1            ; a bad date, so hose it
  675.     br    80$            ; and continue..
  676.  
  677. 70$:    mov    (sp)    ,r0        ; copy to..
  678.     bic    #^c<100!40>,r0        ; ..extract bits 6,5
  679.     asl    r0            ; shift them to bits 7,6
  680.     swab    r0            ; now they are the two hi bits
  681.     bic    #^c<37>    ,(sp)        ; hose possible hi bits in here
  682.     add    (sp)    ,r1        ; and add it into the date word
  683.     bis    r0    ,r1        ; then insert year extension bits
  684. .endc    ;RT11                ; /E64/
  685.  
  686. .if    df    RSTS            ; /E64/
  687. 60$:    bit    #3,(sp)            ; /E64/ is it a multiple of 4
  688.  
  689.     ; /E64/ (i.e. leapyear? -- All RSTS/E dates fall between 1970 and
  690.     ; /E64/ 2035, so this simplified rule works!
  691.  
  692.     bne    65$            ; /E64/ no
  693.     cmp    mon.x,#3        ; /E64/ yes, March or later?
  694.     blo    65$            ; /E64/ no
  695.     inc    r0            ; /E64/ yes, so allow for Feb 29.
  696. 65$:    sub    #1970.    ,(sp)        ; /E64/ RSTS/E dates begin at 1970..
  697.     bge    70$            ; an ok date for RSTS
  698.     clr    r1            ; a bad date, so hose it
  699.     br    80$            ; and continue..
  700.  
  701. 70$:    mov    (sp)    ,r1        ; /E64/ copy to..
  702.     mul    #1000.    ,r1        ; /E64/ year * 1000
  703.     add    r0    ,r1        ; /E64/   + day
  704. .endc    ;RSTS                ; /E64/
  705.  
  706. 80$:    tst    (sp)+            ; pop buffer
  707.     mov    #lun.ou    ,r0        ; assume it's the output file
  708.     asl    r0            ; word indexing
  709.     mov    r1    ,date.a(r0)    ; save date for use when closing file
  710.  
  711.     unsave    <r1>            ; recover pointer to time string
  712.     tstb    (r1)+            ; bump past space delimiter
  713.     beq    100$            ; no time supplied
  714.  
  715.     mov    r1    ,r3        ; now do time..  copy pointer
  716.     call    gnum            ; convert hours to integer
  717. .if    df    RT11            ; /E64/
  718.     mul    #<60.*20.>,r1        ; and to 3-sec intervals
  719. .endc    ;RT11                ; /E64/
  720. .if    df    RSTS            ; /E64/
  721.     mul    #<60.>    ,r1        ; /E64/ and to minutes
  722. .endc    ;RSTS                ; /E64/
  723.     mov    r1    ,-(sp)        ; save them
  724.     inc    r3            ; bump past colon
  725.     call    gnum            ; convert mins to integer
  726. .if    df    RT11            ; /E64/
  727.     mul    #20.    ,r1        ; and to 3-sec intervals
  728.     mov    r1    ,-(sp)        ; save them
  729.     clr    r1            ; preset in case no seconds supplied
  730.     cmpb    (r3)+    ,#':        ; if not a colon, there's no secs
  731.     bne    90$            ; done
  732.     call    gnum            ; convert secs to integer
  733.     clr    r0            ; prep for divide
  734.     div    #3    ,r0        ; and to 3-sec intervals
  735. 90$:    add    (sp)+    ,r0        ; add in minutes data
  736.     add    (sp)+    ,r0        ; add in hours data
  737. .endc    ;RT11                ; /E64/
  738. .if    df    RSTS            ; /E64/
  739.                     ; /E64/ RSTS times have no seconds
  740.     add    (sp)+    ,r1        ; /E64/ add in hours data
  741.     mov    #1440.    ,r0        ; /E64/ Make minutes to midnight
  742.     sub    r1    ,r0        ; /E64/  (1440 minutes in a day)
  743. .endc    ;RSTS                ; /E64/
  744.     mov    #lun.ou    ,r1        ; assume it's the output file
  745.     asl    r1            ; word indexing
  746.     mov    r0    ,time.a(r1)    ; save time for use when closing file
  747. 100$:    clr    r0            ; success
  748.     return
  749.  
  750. mov2b:    movb    (r1)+    ,(r0)+        ; move two bytes
  751.     movb    (r1)+    ,(r0)+
  752.     clrb    (r0)            ; null terminate
  753.     return
  754.  
  755. gnum:    clr    r1            ; the answer  ; return the next number
  756. 110$:    movb    (r3)+    ,r0        ; next char
  757.     sub    #'9+1    ,r0        ; convert ascii byte
  758.     add    #9.+1    ,r0        ; to an integer
  759.     bcc    120$            ; not a number
  760.     mul    #10.    ,r1        ; bump accumulator by 10s
  761.     add    r0    ,r1        ; add in result from this pass
  762.     br    110$            ; then try the next byte
  763. 120$:    tstb    -(r3)            ; park on first non-numeric byte
  764.     return
  765.  
  766. .if    df    RSTS            ; /E64/
  767.     .save
  768.     .psect    $pdata
  769. ;    table of number of before the 1st of each month
  770. monday:    .word    0    ,31.    ,59.    ,90.    ,120.    ,151.
  771.     .word    181.    ,212.    ,243.    ,273.    ,304.    ,334.
  772.     .restore
  773. .endc    ;RSTS                ; /E64/
  774.  
  775.     .sbttl    Put file protection code where close can get it later ; /BBS/
  776.  
  777. .if    df    RT11            ; /E64/
  778. rx.pro:    mov    #lun.ou    ,r1        ; assume output file
  779.     asl    r1            ; word indexing
  780.     bicb    #<1!4!40!100!200>,curatr ; hose bits 0,2,5 and unused bits 6,7
  781.     beq    10$
  782.     clr    prot.a(r1)        ; it's read-write
  783.     br    20$
  784. 10$:    mov    sp    ,prot.a(r1)    ; it's read-only
  785. 20$:    clr    r0            ; success
  786.     return
  787. .endc    ;RT11                ; /E64/
  788.  
  789. .if    df    RSTS            ; /E64/
  790. rx.pro:    call    ispdp            ; /59/ Is this another Kermit-11
  791.     tst    r0            ; /59/ sending us protection in
  792.     beq    100$            ; /59/ internal (Files11) format?
  793.     calls    octval    ,<#curatr>    ; /59/ Convert from octal string.
  794.     mov    r1    ,r0        ; /59/ We are running on a RSTS
  795.     call    torsts            ; /59/ system, convert it.
  796.     mov    r1    ,at$pro        ; /E64/ Save the protection.
  797. 100$:    clr    r0            ; /59/ Success
  798.     return                ; /59/ And exit
  799. .endc    ;RSTS                ; /E64/
  800.  
  801.     .sbttl    Received system type
  802.  
  803. rx.sys:    movb    curatr    ,at$sys        ; save major vendor type
  804.     movb    curatr+1,at$sys+1    ; save the operating system type
  805.     clr    r0            ; success
  806.     return
  807.  
  808.  
  809.     .sbttl    Receive system specific info
  810.  
  811.     fabsiz    =    7*13        ; need at least this many 
  812.  
  813.  
  814. rx.inf:    call    ispdp            ; are we
  815.     tst    r0            ; compatible today?
  816.     beq    10$            ; no, ignore the system dep attr's
  817. .if    df    RSTS            ; /E64/
  818.     mov    #curatr    ,r5        ; /E64/ current attribute data
  819.     strlen    r5            ; packet size ok
  820.     cmp    r0    ,#fabsiz    ; well....
  821.     bge    40$            ; Ok, must be a IFAB
  822.     cmpb    (r5)    ,#43        ; /54/ Date info?
  823.     bne    100$            ; /54/ No
  824.     inc    r0            ; /54/ Yes, process 4 octal words
  825.     mov    sp    ,at$cdt        ; /54/ Flag we have been here
  826.     mov    #4    ,-(sp)        ; /54/ Number of words
  827.     mov    #at$klu    ,r2        ; /54/ Destination
  828. 20$:    clr    r1            ; /54/ Accumulator
  829.     mov    #6    ,r3        ; /54/ Number of itmes
  830. 30$:    movb    (r0)+    ,r4        ; /54/ The next character
  831.     sub    #'0    ,r4        ; /54/ Convert to a number
  832.     asl    r1            ; /54/ Multiply by 8
  833.     asl    r1            ; /54/ ...
  834.     asl    r1            ; /54/ ......
  835.     add    r4    ,r1        ; /54/ Put in current result
  836.     sob    r3    ,30$        ; /54/ Next please
  837.     mov    r1    ,(r2)+        ; /54/ Copy the word
  838.     dec    (sp)            ; /54/ More to do
  839.     bne    20$            ; /54/ Yep
  840.     tst    (sp)+            ; /54/ All done
  841.     br    10$            ; /54/ Exit
  842.  
  843. 40$:    mov    #at$fab    ,r4        ; copy the packet over now
  844.     mov    #-1    ,(r4)+        ; flag that the attributes are for real
  845.     mov    #13    ,r2        ; number of words to convert back
  846. 50$:    clrb    6(r5)            ; insure .asciz now
  847.     calls    octval    ,<r5>        ; simple
  848.     tst    r0            ; successfull?
  849.     bne    90$            ; no, clear flag and exit
  850.     mov    r1    ,(r4)+        ; and save the value now
  851.     add    #7    ,r5        ; point to the next octal number
  852.     sob    r2    ,50$        ; next please
  853.     mov    sp    ,at$val        ; it's ok to use the attributes
  854.     br    10$            ; bye
  855. 90$:    clr    at$fab            ; error exit (conversion error)
  856. ;    message    <Fab attribute error>,cr; /49/
  857.     br    10$            ; /E64/
  858. 100$:                    ;
  859. .endc    ;RSTS                ; /E64/
  860.     mov    #curatr    ,r0        ; /BBS/ current attribute data
  861.     cmpb    (r0)+    ,#42        ; /53/ file type subfunction?
  862.     bne    10$            ; /53/ no, ignore for now
  863.     tst    doauto            ; /BBS/ auto file type enabled?
  864.     beq    10$            ; /BBS/ no, ignore this stuff..
  865.     scan    (r0)    ,#rx$in0    ; /63/ get IFAB file attributes data
  866.     asl    r0            ; /53/ word addressing
  867.     mov    rx$in1(r0),image    ; /63/ set it
  868. 10$:    clr    r0
  869.     return
  870.  
  871.     .save
  872.     .psect    $pdata
  873. rx$in0:    .byte    'A&137    ,'B&137    ,'I&137    ,'N&137    ; /63/ add "B" type
  874.     .byte    0
  875.     .even
  876. rx$in1:    .word    TEXT            ; if not in this list call it text
  877.     .word    TEXT    ,BINARY    ,BINARY    ,DECNAT
  878.     .restore
  879.  
  880.  
  881.     .sbttl    Exact file size in bytes (type "1")
  882.  
  883. rx.xle:    mov    #curatr    ,r5        ; /49/ point to attribute save area
  884.     clr    r3            ; /49/ init the accumulator (low word)
  885.     clr    r2            ; /49/ double precision (high word)
  886. 10$:    tstb    @r5            ; /49/ EOL?
  887.     beq    30$            ; /49/ yep
  888.     cmpb    @r5    ,#space        ; /49/ ignore leading spaces please
  889.     beq    20$            ; /49/ yes, a space
  890.     mov    #12    ,r0        ; /49/ setup for call to $dmul
  891.     call    $dmul            ; /49/ do it please
  892.     mov    r0    ,r2        ; /49/ restore accumulator values now
  893.     mov    r1    ,r3        ; /49/ ditto...
  894.     clr    -(sp)            ; /49/ get the next digit please
  895.     bisb    @r5    ,@sp        ; /BBS/ convert to decimal
  896.     sub    #'0    ,@sp        ; /49/ got it
  897.     add    (sp)+    ,r3        ; /49/ add in the current digit
  898.     adc    r2            ; /49/ add carry bit in also please
  899. 20$:    inc    r5            ; /49/ next ch please
  900.     br    10$            ; /49/ next please
  901. .if    df    RT11            ; /E64/
  902. 30$:    div    #1000    ,r2        ; /BBS/ convert to 512 byte blocks now
  903.     mov    r2    ,at$len        ; /49/ save it please
  904.     tst    r3            ; /BBS/ was there a remainder?
  905.     beq    40$            ; /49/ no, exit
  906.     inc    at$len            ; /49/ yes, len++
  907. .endc    ;RT11                ; /E64/
  908. .if    df    RSTS            ; /E64/
  909. 30$:    add    #777    ,r3        ; /E64/ round up to block boundary
  910.     adc    r2            ; /E64/ propagate carry
  911.     ashc    #-9.    ,r2        ; /E64/ shift leaving 32-bit result
  912.     mov    r2    ,at$len+2    ; /E64/ save it please
  913.     mov    r3    ,at$len        ; /E64/ save it please
  914. .endc    ;RSTS                ; /E64/
  915. 40$:    clr    r0            ; success
  916.     return
  917.  
  918.  
  919.     .sbttl    Determine if other system is a PDP-11
  920.  
  921. ;    I S P D P
  922. ;
  923. ;    output:    r0 = 5    other system running POS
  924. ;             4    RT-11 or TSX+
  925. ;             3    RSTS
  926. ;             2    IAS
  927. ;             1    RSX
  928. ;             0    it's something else..
  929.  
  930.     PD$RSX    = '8
  931.     PD$IAS    = '9
  932.     PD$RSTS    = 'A&137
  933.     PD$RT    = 'B&137        ; includes TSX
  934.     PD$POS    = 'C&137
  935.  
  936. ispdp:    clr    r0            ; presume failure
  937.     cmpb    at$sys    ,#'D&137    ; a DEC system?
  938.     bne    10$            ; no, exit
  939.     scan    <at$sys+1>,#pdplst    ; ya, determine operating system type
  940. 10$:    return
  941.  
  942.     .save
  943.     .psect    $pdata
  944. pdplst:    .byte    pd$rsx    ,pd$ias    ,pd$rsts,pd$rt    ,pd$pos    ,0
  945.     .even
  946.     .restore
  947.  
  948.  
  949.     .sbttl    Clear attributes
  950.  
  951. clratr::clr    at$len            ; clear the file length
  952. .if    df    RSTS            ; /E64/
  953.     clr    at$len+2        ; /E64/ clear the file length - high
  954.     clr    at$pro            ; /E64/
  955. .endc    ;RSTS                ; /E64/
  956.     clr    at$sys            ; clear the system type
  957. .if    df    RSTS            ; /E64/
  958.     clr    at$fab
  959.     clr    atrctx
  960.     clr    at$klu+0
  961.     clr    at$klu+2
  962.     clr    at$klu+4
  963.     clr    at$klu+6
  964.     clr    at$cdt
  965. .endc    ;RSTS                ; /E64/
  966.     return
  967.  
  968.     .sbttl    finish up the update of rms file attributes to output
  969. ;    A T R F I N
  970. ;
  971. ;    If the file was sent in image mode, and we have been sent
  972. ;    valid attributes (basically, the sender's IFAB), then call
  973. ;    PUTATR to place these attributes into our output file's
  974. ;    IFAB so they will get updated.
  975. ;
  976. ;
  977. ;    Note: 11-Jul-84  17:12:49  BDN,  edit /19/
  978. ;
  979. ;     Note that for RSTS/E, we have an unusual problem in that if
  980. ;    the sender sent a stream ascii file (most likely a file with
  981. ;    NO attributes)  over and the sender  said it's binary,  then
  982. ;    RMS-11 sends GARBAGE for the VFC header size. When this data
  983. ;    is wriiten  into the output file's IFAB, RMS11 finds invalid
  984. ;    data in the IFAB and writes attributes to disk with the last
  985. ;    block field (F$HEOF and F$LEOF)  equal to ZERO.  Such a file
  986. ;    would thus be unreadable to PIP, RMS and other programs that
  987. ;    look at the file attributes.  The fix  is one of two things.
  988. ;    One, we can clear the invalid  VFC size and fudge the record
  989. ;    size and maximum record size to something usable (like 512),
  990. ;    or  we can simply ignore  the senders attributes and let the
  991. ;    file  stand as a  FIXED, NO CC, recordsize 512 file.  Rather
  992. ;    than to try to fix the attributes, we will simple ignore the
  993. ;    attributes  if the sender said that the file is stream ascii
  994. ;    with a garbage VFC.  Since  the attributes  are only used if
  995. ;    the transfer was in image mode, this will not  affect normal
  996. ;    files, only files like DMS-500 files that have no attributes
  997. ;    but must be sent in image mode.
  998. ;    Of course, the sending Kermit-11 can always be given the SET
  999. ;    ATT OFF and SET FIL BIN and the receiving Kermit-11 be given
  1000. ;    the SET FIL BIN and the issue will never arise.
  1001. ;
  1002. ;    The mods are noted with /19/ after the statement.
  1003. .if    df    RSTS            ; /E64/
  1004. atrfin::save    <r1,r2,r3>        ; just in case please
  1005.     tst    @r5            ; lun zero ?
  1006.     beq    100$            ; yep
  1007.     tst    at$val            ; valid attributes to write ?
  1008.     beq    100$            ; no
  1009.     tst    at$cdt            ; Ever set the creation date/time?
  1010.     beq    10$            ; No
  1011.     calls    putcdt    ,<@r5,#at$klu>    ; Yes, update it
  1012. 10$:    cmpb    image    ,#binary    ; did we get this as a binary file?
  1013.     bne    100$            ; no
  1014.     mov    #at$fab    ,r1        ; yes
  1015.     tst    (r1)+            ; valid data present ?
  1016.     beq    100$            ; no
  1017.     cmp    @r1    ,#2000        ; /19/ stream ascii ?
  1018.     bne    30$            ; /19/ no
  1019.     cmp    16(r1)    ,#177400    ; /19/ garbage for the vfc header size?
  1020.     beq    90$            ; /19/ yes, forget about the attributes
  1021. 30$:    calls    putatr    ,<@r5,r1>    ; /19/ update the ifab for the file
  1022. 90$:    clr    at$fab            ; no longer valid please
  1023.     clr    at$val            ; no longer valid please
  1024. 100$:    clr    at$cdt
  1025.     unsave    <r3,r2,r1>        ; output file and exit
  1026.     return
  1027. .endc    ;RSTS                ; /E64/
  1028.  
  1029.     .sbttl    Map RSTS protection codes to Files-11 codes and back
  1030. ;    /59/  9-OCT-1987 08:11 BDN
  1031. ;
  1032. ;     Use the files11 format for transfering protection code
  1033. ;    between two kermit-11's, thus it will work even for RSX
  1034. ;    to RSTS transfer.
  1035. .if    df    RSTS            ; /E64/
  1036.  
  1037.     .Save
  1038.     .Psect    $Pdata    ,d
  1039. dflt.f:    .word    ^B1100110000000000    ; Default to no world, group
  1040. rsts.p:    .word    1*20            ; If 0 set, no owner read
  1041.     .word    2*20            ; If 1 set, no owner write
  1042.     .word    1*400            ; If 2 set, no group read
  1043.     .word    2*400            ; If 3 set, no group write
  1044.     .word    1*10000            ; If 4 set, no world read
  1045.     .word    2*10000            ; If 5 set, no world write
  1046.     .Restore
  1047.  
  1048. torsts:    mov    #77    ,r1        ; Start with no access
  1049.     clr    r2            ; Current bit to set
  1050.     mov    #6    ,r3        ; Six times please
  1051.     clr    r4            ; Indexing into bit table
  1052.     mov    #1    ,r2        ; Start with bit one
  1053. 10$:    bit    rsts.p(r4),r0        ; Check for F11 bit set
  1054.     bne    20$            ; Set, implies access
  1055.     bic    r2    ,r1        ; So clear it here
  1056. 20$:    asl    r2            ; Shift it
  1057.     tst    (r4)+            ; Next bit pattern
  1058.     sob    r3    ,10$        ; Loopback
  1059.     return                ; Exit
  1060.  
  1061. tof11:    mov    dflt.f    ,r1        ; Default Files-11 bitmask
  1062.     clr    r2            ; Start with bit zero of RSTS
  1063.     mov    #6    ,r3        ; Loop six times
  1064. 10$:    bit    #1    ,r0        ; Check for bit being set in RSTS
  1065.     beq    20$            ; code. Not set, leave alone
  1066.     bis    rsts.p(r2),r1        ; Set, so set the Files-11 prot
  1067. 20$:    tst    (r2)+            ; Next
  1068.     asr    r0            ; Get the next bit moved over
  1069.     sob    r3    ,10$        ; And loop back
  1070.     mov    r1    ,r0        ; Return in r0
  1071.     return                ; Exit
  1072.  
  1073. .endc    ;RSTS                ; /E64/
  1074.  
  1075.     .sbttl    32-bit multiply from RSX SYSLIB.OLB
  1076.  
  1077. $DMUL:    MOV    R0    ,-(SP)
  1078.     CLR    R0
  1079.     CLR    R1
  1080. 10$:    TST    (SP)
  1081.     BEQ    30$
  1082.     ROR    (SP)
  1083.     BCC    20$
  1084.     ADD    R3    ,R1
  1085.     ADC    R0
  1086.     ADD    R2    ,R0
  1087. 20$:    ASL    R3
  1088.     ROL    R2
  1089.     BR    10$
  1090. 30$:    TST    (SP)+
  1091.     RETURN
  1092.  
  1093.     .end
  1094.