home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / b / krtatr.mac < prev    next >
Text File  |  2020-01-01  |  20KB  |  648 lines
  1.     .title    KRTATR    Process attribute packets
  2.     .ident    "V03.63"
  3.  
  4. ; /63/    27-Sep-97  Billy Youdelman  V03.63
  5.  
  6. ; /62/    27-Jul-93  Billy Youdelman  V03.62
  7. ;
  8. ;    add 25% to rec'd length for text files from non RT-11/TSX systems
  9.  
  10. ; /BBS/     1-Dec-91  Billy Youdelman  V03.61
  11. ;
  12. ;    modified rx.cdt,sn.cdt to do the "#" date/time attribute
  13. ;    hosed unused stuff, added rx.pro,sn.pro for protected file attribute
  14. ;
  15. ;    added support for date/time/prot file attributes
  16. ;    patched open, close and I/O data table to support it..
  17. ;
  18. ;    modified w$attr to send all attributes in a single packet
  19. ;    rx.xle result in at$len no longer overwritten by rx.len
  20. ;    added send exact file length in bytes
  21. ;    call binary files "BINARY" not "IMAGE" so MS-Kermit is happy
  22.  
  23. ;    Copyright 1984 Change Software, Inc.
  24. ;
  25. ;    18-Apr-84  11:20:59 Brian Nelson
  26. ;    24-Mar-86  12:00:56 BDN    Major revision which has some rather
  27. ;                unpleasant compatibility problems with
  28. ;                older Kermit-11's.
  29. ;    12-Sep-86  10:37:04 BDN Convert for I/D space
  30.  
  31. ;     This module is intended to be placed into an overlay
  32. ;    which MUST be the "ERROR" cotree as the server, which
  33. ;    is overlaid in the  "UTILTY"  cotree  can  indirectly
  34. ;    call the module through the packet control routines.
  35.  
  36. ;     The receiving Kermit should ALWAYS get the SYSTEM and
  37. ;    EXECUTIVE type attribute packet first so it can decide
  38. ;    if it should use the data being sent.
  39.  
  40.  
  41.     .include "IN:KRTMAC.MAC"
  42.     .iif ndf  KRTINC  .error    <; .include for IN:KRTMAC.MAC failed>
  43.  
  44.     .mcall    .DATE    ,.GTIM        ; /BBS/
  45.  
  46.  
  47.     .psect    $rwdata    ,rw,d,lcl,rel,con
  48. atrctx::.word    0            ; /E64/ send attrs context (index)
  49. curatr:    .blkb    200            ; current attribute scratch buffer
  50. day.x:    .word    0            ; /BBS/ integer file create day
  51. day.y:    .byte    0 ,0 ,0 ,0        ; /BBS/ ascii file create day
  52. mon.x:    .word    0            ; /BBS/ integer file create month
  53. mon.y:    .byte    0 ,0 ,0 ,0        ; /BBS/ ascii file create month
  54. sizbuf:    .byte    0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ; /BBS/ sn.xle ascii size
  55. xblock:    .word    0 ,0            ; /BBS/ buffer for sn.xle, .gtim
  56. yr.x:    .word    0            ; /BBS/ integer file create year
  57. yr.y:    .byte    0 ,0 ,0 ,0 ,0 ,0    ; /BBS/ ascii file create year
  58.  
  59.  
  60.     .psect    $code
  61.     .sbttl    Send all attributes in a single packet    ; /BBS/ modified to..
  62.  
  63. ;    W $ A T T R
  64. ;
  65. ;    input:     (r5)    = file lun
  66. ;        2(r5)    = output packet buffer address
  67. ;    output:      r1    > 0 is packet length, 0 = receiver can't do attributes
  68.  
  69. w$attr::save    <r2,r3,r4>
  70.     clr    r1            ; preset in case other system
  71.     bitb    #capa.a    ,conpar+p.capas    ; can't handle attributes
  72.     beq    40$            ; it can't
  73.     bit    #at.on    ,doattr        ; /63/ are attributes enabled?
  74.     beq    40$            ; /63/ no
  75.     mov    2(r5)    ,r4        ; point to the packet
  76.     clr    atrctx            ; init index
  77.  
  78. 10$:    mov    atrctx    ,r0        ; dispatch on what to send next
  79.     asl    r0            ; word indexing
  80.     tst    watt(r0)        ; all done?
  81.     beq    30$            ; yes, finish up
  82.     bit    at.tx(r0),doattr    ; /62/ is this attribute enabled?
  83.     beq    20$            ; /62/ no
  84.     jsr    pc    ,@watt(r0)    ; do it
  85. 20$:    inc    atrctx            ; index to next subroutine
  86.     br    10$            ; loop back for it
  87.  
  88. 30$:    strlen    2(r5)            ; get the length and return it
  89.     mov    r0    ,r1        ; and say that this packet is for real
  90. 40$:    clr    r0            ; no error possible
  91.     unsave    <r4,r3,r2>
  92.     return
  93.  
  94.     .save
  95.     .psect    $pdata
  96. watt:    .word    sn.sys    ,sn.typ    ,sn.pro    ,sn.len    ,sn.inf    ,sn.cdt    ,sn.xle
  97. at.rx:    .word    0            ; /62/ also terminates watt
  98. at.tx:    .word    at.sys    ,at.typ    ,at.pro    ,at.len    ,at.inf    ,at.cdt    ,at.xle
  99.     .restore
  100.  
  101.  
  102.     .sbttl    Send system type
  103.  
  104. sn.sys:    movb    #'.    ,(r4)+        ; the system id attribute
  105.     movb    #42    ,(r4)+        ; /49/ length of what follows
  106.     movb    #'D&137    ,(r4)+        ; return the vendor code (DEC)
  107.     movb    #'B&137    ,(r4)+        ; /BBS/ it's RT-11 for sure here
  108.     br    sn.end            ; /63/ go make it .asciz
  109.  
  110.  
  111.     .sbttl    Send generic file type
  112.  
  113. sn.typ:    movb    #42    ,(r4)+        ; file type attribute
  114.     movb    #41    ,(r4)+        ; /49/ length of what follows
  115.     movb    #'A&137    ,r0        ; /BBS/ assume ascii
  116.     cmpb    image    ,#binary    ; is it binary or 8-bit text?
  117.     blt    10$            ; /63/ no
  118.     movb    #'B&137    ,r0        ; /BBS/ yes, indicate it is..
  119. 10$:    movb    r0    ,(r4)+        ; /BBS/ put file type in packet
  120.     br    sn.end            ; /63/ go make it .asciz
  121.  
  122.  
  123.     .sbttl    Send file protection    ; /BBS/ fixed for RT-11
  124.  
  125. sn.pro:                    ;    bit_0    =  read
  126.                     ;    bit_1    =  write
  127. ; protection codes from "Kermit, A        bit_2    =  execute
  128. ; File Transfer Protocol," 1987, for        bit_3    =  append
  129. ; the "-" (octal 55) attribute            bit_4    =  delete
  130.                     ;    bit_5    =  directory
  131.     movb    #55    ,(r4)+        ; public file protection
  132.     movb    #41    ,(r4)+        ; length of what follows
  133.     mov    (r5)    ,r0        ; get lun
  134.     asl    r0            ; word indexing
  135.     tst    prot.a(r0)        ; is it protected?
  136.     bne    10$            ; ya
  137.     mov    #<1!2!4!10!20!40>,r0    ; no, set bits 0 thru 5
  138.     br    20$            ; continue
  139. 10$:    mov    #<1!4!40>,r0        ; protected, set bits 0,2,5 only
  140. 20$:    add    #40    ,r0        ; tochar r0
  141.     movb    r0    ,(r4)+        ; put it into packet
  142. sn.end:    clrb    @r4            ; .asciz
  143.     return
  144.  
  145.  
  146.     .sbttl    Send file length    ; /BBS/
  147.  
  148. sn.len:    mov    (r5)    ,r1        ; lun open to the file
  149.     asl    r1            ; word indexing
  150.     mov    sizof(r1),r1        ; get file size
  151.     inc    r1            ; accommodate rounding to
  152.     asr    r1            ; 1024. byte blocks, not 512.
  153.     bne    10$            ; /BBS/ something is left of size..
  154.     inc    r1            ; /BBS/ no, make it at least one block
  155. 10$:    movb    #41    ,(r4)+        ; attribute type (file size)
  156.     movb    #45    ,(r4)+        ; length of the number
  157.     deccvt    r1    ,r4    ,#5    ; convert to ascii
  158.     mov    #5    ,r0        ; for 5 chars
  159. 20$:    cmpb    @r4    ,#space        ; if a space, then make it a "0"
  160.     bne    30$            ; not a space
  161.     movb    #'0    ,@r4        ; it was a space
  162. 30$:    inc    r4            ; next
  163.     sob    r0    ,20$        ; please
  164. 40$:    br    sn.end            ; /63/ go make it .asciz
  165.  
  166.  
  167.     .sbttl    Send system specific info    ; /52/ added /BBS/ cleaned up
  168.  
  169. sn.inf:    movb    #'0    ,(r4)+        ; DEC-specific file type
  170.     movb    #42    ,(r4)+        ; length of data to follow
  171.     movb    #42    ,(r4)+        ; sending extended file type
  172.     mov    image    ,r0        ; use this to index to it
  173.     movb    sn$inf(r0),(r4)+    ; /63/ insert it
  174.     br    sn.end            ; /63/ go make it .asciz
  175.  
  176.     .save
  177.     .psect    $pdata
  178. sn$inf:    .byte    'A&137    ,'I&137    ,'N&137
  179.     .even
  180.     .restore
  181.  
  182.  
  183.     .sbttl    Get file creation date/time    ; /BBS/ added this..
  184.  
  185. sn.cdt:    save    <r4>            ; pointer to current position in buff
  186.     mov    (r5)    ,r4        ; channel
  187.     asl    r4            ; word offsets
  188.     mov    date.a(r4),r0        ; recover current file's date
  189.     mov    #curatr    ,r1        ; the result address
  190.  
  191.     mov    r0    ,r3        ; copy the date to extract
  192.     bic    #^c<37>    ,r3        ; the year
  193.     add    #1972.    ,r3        ; plus the bias please
  194.     mov    r0    ,r2        ; copy the date
  195.     bic    #^c<140000>,r2        ; extend max year w/two hi bits
  196.     swab    r2            ; two hi bits now are bits 7,6
  197.     asr    r2            ; shift to bits 6,5 (true value)
  198.     add    r2    ,r3        ; add to total years
  199.     call    i4toa            ; do all 4 digits of year
  200.  
  201.     mov    r0    ,r3        ; copy to extract months
  202.     swab    r3            ; get the month to bits 7..2
  203.     asr    r3            ; now bits 6..1
  204.     asr    r3            ; now bits 5..0
  205.     bic    #^c<37>    ,r3        ; hose everything else
  206.     call    i2toa            ; write ascii to out buff
  207.  
  208.     mov    r0    ,r3        ; copy to extract day of month
  209.     ash    #3    ,r3        ; /62/ shift left 3 places
  210.     swab    r3            ; then swap bytes to get
  211.     bic    #^c<37>    ,r3        ; the date
  212.     call    i2toa            ; write ascii to out buff
  213.  
  214.     tst    tsxsav            ; only do file time under TSX
  215.     beq    10$            ; it's not TSX
  216.     movb    #space    ,(r1)+        ; a space delimiter between date,time
  217.  
  218.     mov    time.a(r4),r3        ; recover current file's time
  219.     clr    r2            ; clear hi word for upcoming divide
  220.     div    #20.    ,r2        ; get # of 3-sec units since midnight
  221.     mov    r3    ,-(sp)        ; put on stack
  222.     asl    r3            ; 2x secs
  223.     add    r3    ,(sp)        ; plus 1x = 3x = number_of_seconds
  224.     mov    r2    ,r3        ; get rest of time
  225.     clr    r2            ; set up for next divide
  226.     div    #60.    ,r2        ; get number of minutes
  227.     mov    r3    ,-(sp)        ; and save on stack
  228.     mov    r2    ,r3        ; this is the number of hours
  229.     call    i2toa            ; write ascii to out buff
  230.     movb    #':    ,(r1)+        ; a colon into the buffer
  231.     mov    (sp)+    ,r3        ; recover minutes
  232.     call    i2toa            ; write ascii to out buff
  233.     movb    #':    ,(r1)+        ; a colon into the buffer
  234.     mov    (sp)+    ,r3        ; recover secs
  235.     call    i2toa            ; write ascii to out buff
  236.  
  237. 10$:    clrb    @r1            ; .asciz
  238.     unsave    <r4>            ; recover packet buffer pointer
  239.     mov    #curatr    ,r1        ; pointer to string just built
  240.     strlen    r1            ; get length of string
  241.     add    #40    ,r0        ; encode length (tochar..)
  242.     movb    #'#    ,(r4)+        ; file create time/date data
  243.     movb    r0    ,(r4)+        ; put length into packet buffer
  244. 20$:    movb    (r1)+    ,(r4)+        ; then copy data into it
  245.     bne    20$            ; until null
  246.     dec    r4            ; bump pointer back to the null
  247.     return
  248.  
  249.  
  250.     .sbttl    Send file length in bytes  ; /BBS/ all new
  251.  
  252. sn.xle:    mov    (r5)    ,r3        ; file open on this chan
  253.     asl    r3            ; word indexing
  254.     clr    r2            ; double precision, init high word
  255.     mov    sizof(r3),r3        ; size in the accumulator low word
  256.     bne    10$            ; something is there
  257.     inc    r3            ; make it at least one block
  258. 10$:    mov    #512.    ,r0        ; setup call to $dmul, size*512.
  259.     call    $dmul            ; double precision multiply
  260.     mov    r0    ,xblock        ; save hi word
  261.     mov    r1    ,xblock+2    ; save low word
  262.     clr    r2            ; suppress leading zeros in output
  263.     mov    #xblock    ,r1        ; address of 32-bit number
  264.     mov    #sizbuf    ,r0        ; address of out buff for ascii
  265.     call    $cddmg            ; convert 32-bit integer to ascii
  266.     clrb    @r0            ; null terminate the string
  267.     cmpb    #'*    ,sizbuf        ; did $cddmg overflow?
  268.     beq    30$            ; ya, bail out..
  269.     strlen    #sizbuf            ; get its length
  270.     movb    #61    ,(r4)+        ; attribute type (exact size in bytes)
  271.     add    #40    ,r0        ; tochar the string length
  272.     movb    r0    ,(r4)+        ; stuff into the attribute string
  273.     mov    #sizbuf    ,r0        ; get pointer to the length string
  274. 20$:    movb    (r0)+    ,(r4)+        ; then copy ascii'd length into attr$
  275.     bne    20$            ; until hitting the null terminator
  276. 30$:    return
  277.  
  278.  
  279.     .sbttl    Received attribute packet processing
  280.  
  281. ;    R $ A T T R
  282. ;
  283. ;    input:     (r5)    = packet buffer address
  284. ;    output:      r0    = if <>, error code
  285.  
  286. r$attr::save    <r1,r2,r5>        ; /BBS/ cleaned this up a bit..
  287.     bit    #at.on    ,doattr        ; /63/ attribute processing enabled?
  288.     beq    70$            ; /62/ nope
  289.     mov    @r5    ,r5        ; /49/ get packet data address
  290.  
  291. 10$:    movb    (r5)+    ,r0        ; /49/ attribute type code
  292.     beq    60$            ; /49/ nothing there..
  293.     movb    (r5)+    ,r1        ; /49/ get length field next
  294.     beq    60$            ; /49/ nothing there..
  295.     cmpb    r0    ,#'.        ; /49/ if this is an OLD Kermit-11
  296.     bne    20$            ; /49/ with the invalid system type
  297.     cmpb    r1    ,#'D&137    ; /49/ format then we have to fix it
  298.     bne    20$            ; /49/ it is not..
  299.     dec    r5            ; /49/ it is, we'd been forgetting to
  300.     mov    #42    ,r1        ; /49/ include the length field
  301.  
  302. 20$:    sub    #40    ,r1        ; /49/ convert length to integer
  303.     ble    60$            ; /BBS/ nothing there
  304.     mov    #curatr    ,r2        ; /49/ copy current attribute argument
  305. 30$:    movb    (r5)+    ,(r2)+        ; /49/ over to a save area now
  306.     sob    r1    ,30$        ; /49/ next please
  307.     clrb    (r2)+            ; /49/ ensure .asciz please
  308.     mov    r5    ,-(sp)        ; /49/ make sure the r5 context saved
  309.     scan    r0    ,#attrty    ; look for the attribute packet type?
  310.     asl    r0            ; simple to do
  311.     bit    at.rx(r0),doattr    ; /62/ is this attribute enabled?
  312.     bne    40$            ; /62/ ya
  313.     clr    r0            ; /62/ no, check for
  314.     br    50$            ; /62/ more attributes
  315. 40$:    jsr    pc    ,@attrds(r0)    ; process the attribute packet now
  316. 50$:    mov    (sp)+    ,r5        ; /49/ restore the r5 context now
  317.     tst    r0            ; success?
  318.     beq    10$            ; yes
  319.     br    80$            ; no, exit with error in r0
  320.  
  321. 60$:    call    ispdp            ; /62/ if other end is RT-11 or TSX..
  322.     cmp    r0    ,#4        ; /62/ well?
  323.     beq    70$            ; /62/ it is, so file sizes are exact
  324.     cmp    image    ,#binary    ; /62/ then if file type isn't binary
  325.     beq    70$            ; /62/ it is, image size is always ok
  326.     mov    at$len    ,r0        ; /62/ otherwise save the passed size
  327.     beq    80$            ; /62/ nothing was there, r0 is clear
  328.     asr    r0            ; /62/ divide by two
  329.     asr    r0            ; /62/ now it's by four, 25% of total
  330.     inc    r0            ; /62/ bump one more block to be sure
  331.     add    r0    ,at$len        ; /62/ now bump requested space by 25%
  332.     bcc    70$            ; /62/ result didn't overflow
  333.     mov    #65497.    ,at$len        ; /62/ it did, try the max possible..
  334. 70$:    clr    r0            ; packet format error or end of data
  335. 80$:    unsave    <r5,r2,r1>
  336.     return
  337.  
  338.     .save
  339.     .psect    $pdata
  340. attrty:    .byte    56    ,42    ,55    ,41    ,60    ,43    ,61
  341.     .byte    0
  342.     .even
  343. attrds:    .word    rx.$$            ; /62/ must conform to at.rx
  344.     .word    rx.sys    ,rx.typ    ,rx.pro    ,rx.len    ,rx.inf    ,rx.cdt    ,rx.xle
  345.     .restore
  346.  
  347.  
  348.     .sbttl    Null attribute handler
  349.  
  350. rx.$$:    clr    r0            ; /49/ ignore unknown attribute types
  351.     return
  352.  
  353.  
  354.     .sbttl    Process received length specified in 1024. byte blocks
  355.  
  356. rx.len:    tst    at$len            ; /BBS/ size from rx.xle already here?
  357.     bne    40$            ; /BBS/ ya, use it instead of this
  358.     mov    #curatr    ,r2        ; /49/ where we saved attributes
  359.     clr    r1            ; init the accumulator
  360. 10$:    tstb    @r2            ; EOL?
  361.     beq    30$            ; yep
  362.     cmpb    @r2    ,#space        ; ignore leading spaces please
  363.     beq    20$            ; yes, a space
  364.     clr    -(sp)            ; avoid sxt
  365.     bisb    @r2    ,@sp        ; get the next digit please
  366.     sub    #'0    ,@sp        ; and convert to decimal
  367.     mul    #12    ,r1        ; shift accum over 10.
  368.     add    (sp)+    ,r1        ; add in the current digit
  369. 20$:    inc    r2            ; next ch please
  370.     br    10$            ; /49/ Next please
  371. 30$:    asl    r1            ; convert 1024. blocks to 512. blocks
  372.     mov    r1    ,at$len        ; save it please
  373. 40$:    clr    r0            ; success
  374.     return
  375.  
  376.  
  377.     .sbttl    Received file type
  378.  
  379. rx.typ:    tst    doauto            ; /BBS/ auto file type enabled?
  380.     bne    10$            ; /BBS/ ya
  381.     mov    $image    ,image        ; /BBS/ no, use what's SET
  382.     br    30$
  383. 10$:    cmpb    curatr    ,#'B&137    ; binary?
  384.     beq    20$            ; yes
  385.     cmpb    curatr    ,#'I&137    ; image?
  386.     bne    30$            ; no
  387. 20$:    mov    #binary    ,image        ; flag for image mode
  388. 30$:    clr    r0            ; success
  389.     return
  390.  
  391.  
  392.     .sbttl    Put create date/time where close can get them later ; /BBS/
  393.  
  394. rx.cdt:    clr    -(sp)            ; init 2 digit year flag
  395.     scan    #space    ,#curatr    ; find the space between date and time
  396.     tst    r0            ; get it?
  397.     bne    10$            ; ya..
  398.     strlen    #curatr            ; no time is there
  399.     cmp    r0    ,#7        ; 2 or 4 digit year?
  400.     bgt    20$            ; it's 4
  401.     br    30$            ; it's 2
  402.  
  403. 10$:    cmp    r0    ,#10        ; 2 or 4 digit year?
  404.     blt    30$            ; 2 digits
  405. 20$:    mov    sp    ,(sp)        ; 4 digits, set flag
  406. 30$:    mov    #curatr    ,r1        ; pointer to date/time packet data
  407.     mov    #yr.y    ,r0        ; extract the ascii year here
  408.     call    mov2b            ; copy two bytes
  409.     tst    (sp)+            ; two or four digit year string?
  410.     beq    40$            ; just two
  411.     call    mov2b            ; copy two bytes
  412. 40$:    mov    #mon.y    ,r0        ; extract the ascii month here
  413.     call    mov2b            ; copy two bytes
  414.     mov    #day.y    ,r0        ; extract the ascii day here
  415.     call    mov2b            ; copy two bytes
  416.  
  417.     save    <r1>            ; save pointer to time string
  418.  
  419.     mov    #yr.y    ,r3        ; recover ascii year
  420.     call    gnum            ; make it an integer
  421.     mov    r1    ,yr.x        ; and save it here
  422.     mov    #mon.y    ,r3        ; recover ascii month
  423.     call    gnum            ; make it an integer
  424.     mov    r1    ,mon.x        ; and save it here
  425.     mov    #day.y    ,r3        ; recover ascii day
  426.     call    gnum            ; make it an integer
  427.     mov    r1    ,day.x        ; and save it here
  428.  
  429.     ;  2_bits<year_ext> ,4_bits<mon> ,5_bits<day> ,5_bits<year-1972>
  430.     mov    mon.x    ,r1        ; recover month
  431.     ash    #5    ,r1        ; partial shift towards final location
  432.     add    day.x    ,r1        ; recover days
  433.     ash    #5    ,r1        ; shift days/months to final positions
  434.     mov    yr.x    ,-(sp)        ; recover year
  435.     cmp    (sp)    ,#100.        ; is it two digits only?
  436.     bge    60$            ; no
  437.     cmp    (sp)    ,#71.        ; ya but ambiguity impossible 'til '72
  438.     ble    50$            ; it has to be 21st century
  439.  
  440.     ; if two-digit year extend to four-digits based on the current century
  441.     .gtim    #rtwork    ,#xblock    ; ensure clock rollover..
  442.     .date                ; ya, which century is it now?
  443.     mov    r0    ,r3        ; copy the date
  444.     bic    #^c<37>    ,r3        ; the year
  445.     add    #1972.    ,r3        ; plus the bias
  446.     bic    #^c<140000>,r0        ; extend max year w/two hi bits
  447.     swab    r0            ; two hi bits now are bits 7,6
  448.     asr    r0            ; shift to bits 6,5 (true value)
  449.     add    r0    ,r3        ; now it's the total years
  450.     cmp    r3    ,#1999.        ; well?
  451.     bgt    50$            ; it's 2000 A.D. or above
  452.     add    #1900.    ,(sp)        ; not 2000 A.D. yet ..
  453.     br    60$            ; and continue
  454. 50$:    add    #2000.    ,(sp)        ; default to current century
  455.  
  456. 60$:    sub    #1972.    ,(sp)        ; RT-11 dates begin at 1972..
  457.     bge    70$            ; an ok date for RT-11
  458.     clr    r1            ; a bad date, so hose it
  459.     br    80$            ; and continue..
  460.  
  461. 70$:    mov    (sp)    ,r0        ; copy to..
  462.     bic    #^c<100!40>,r0        ; ..extract bits 6,5
  463.     asl    r0            ; shift them to bits 7,6
  464.     swab    r0            ; now they are the two hi bits
  465.     bic    #^c<37>    ,(sp)        ; hose possible hi bits in here
  466.     add    (sp)    ,r1        ; and add it into the date word
  467.     bis    r0    ,r1        ; then insert year extension bits
  468.  
  469. 80$:    tst    (sp)+            ; pop buffer
  470.     mov    #lun.ou    ,r0        ; assume it's the output file
  471.     asl    r0            ; word indexing
  472.     mov    r1    ,date.a(r0)    ; save date for use when closing file
  473.  
  474.     unsave    <r1>            ; recover pointer to time string
  475.     tstb    (r1)+            ; bump past space delimiter
  476.     beq    100$            ; no time supplied
  477.  
  478.     mov    r1    ,r3        ; now do time..  copy pointer
  479.     call    gnum            ; convert hours to integer
  480.     mul    #<60.*20.>,r1        ; and to 3-sec intervals
  481.     mov    r1    ,-(sp)        ; save them
  482.     inc    r3            ; bump past colon
  483.     call    gnum            ; convert mins to integer
  484.     mul    #20.    ,r1        ; and to 3-sec intervals
  485.     mov    r1    ,-(sp)        ; save them
  486.     clr    r1            ; preset in case no seconds supplied
  487.     cmpb    (r3)+    ,#':        ; if not a colon, there's no secs
  488.     bne    90$            ; done
  489.     call    gnum            ; convert secs to integer
  490.     clr    r0            ; prep for divide
  491.     div    #3    ,r0        ; and to 3-sec intervals
  492. 90$:    add    (sp)+    ,r0        ; add in minutes data
  493.     add    (sp)+    ,r0        ; add in hours data
  494.     mov    #lun.ou    ,r1        ; assume it's the output file
  495.     asl    r1            ; word indexing
  496.     mov    r0    ,time.a(r1)    ; save time for use when closing file
  497. 100$:    clr    r0            ; success
  498.     return
  499.  
  500. mov2b:    movb    (r1)+    ,(r0)+        ; move two bytes
  501.     movb    (r1)+    ,(r0)+
  502.     clrb    (r0)            ; null terminate
  503.     return
  504.  
  505. gnum:    clr    r1            ; the answer  ; return the next number
  506. 110$:    movb    (r3)+    ,r0        ; next char
  507.     sub    #'9+1    ,r0        ; convert ascii byte
  508.     add    #9.+1    ,r0        ; to an integer
  509.     bcc    120$            ; not a number
  510.     mul    #10.    ,r1        ; bump accumulator by 10s
  511.     add    r0    ,r1        ; add in result from this pass
  512.     br    110$            ; then try the next byte
  513. 120$:    tstb    -(r3)            ; park on first non-numeric byte
  514.     return
  515.  
  516.  
  517.     .sbttl    Put file protection code where close can get it later ; /BBS/
  518.  
  519. rx.pro:    mov    #lun.ou    ,r1        ; assume output file
  520.     asl    r1            ; word indexing
  521.     bicb    #<1!4!40!100!200>,curatr ; hose bits 0,2,5 and unused bits 6,7
  522.     beq    10$
  523.     clr    prot.a(r1)        ; it's read-write
  524.     br    20$
  525. 10$:    mov    sp    ,prot.a(r1)    ; it's read-only
  526. 20$:    clr    r0            ; success
  527.     return
  528.  
  529.  
  530.     .sbttl    Received system type
  531.  
  532. rx.sys:    movb    curatr    ,at$sys        ; save major vendor type
  533.     movb    curatr+1,at$sys+1    ; save the operating system type
  534.     clr    r0            ; success
  535.     return
  536.  
  537.  
  538.     .sbttl    Receive system specific info
  539.  
  540. rx.inf:    call    ispdp            ; are we
  541.     tst    r0            ; compatible today?
  542.     beq    10$            ; no, ignore the system dep attr's
  543.     mov    #curatr    ,r0        ; /BBS/ current attribute data
  544.     cmpb    (r0)+    ,#42        ; /53/ file type subfunction?
  545.     bne    10$            ; /53/ no, ignore for now
  546.     tst    doauto            ; /BBS/ auto file type enabled?
  547.     beq    10$            ; /BBS/ no, ignore this stuff..
  548.     scan    (r0)    ,#rx$in0    ; /63/ get IFAB file attributes data
  549.     asl    r0            ; /53/ word addressing
  550.     mov    rx$in1(r0),image    ; /63/ set it
  551. 10$:    clr    r0
  552.     return
  553.  
  554.     .save
  555.     .psect    $pdata
  556. rx$in0:    .byte    'A&137    ,'B&137    ,'I&137    ,'N&137    ; /63/ add "B" type
  557.     .byte    0
  558.     .even
  559. rx$in1:    .word    TEXT            ; if not in this list call it text
  560.     .word    TEXT    ,BINARY    ,BINARY    ,DECNAT
  561.     .restore
  562.  
  563.  
  564.     .sbttl    Exact file size in bytes (type "1")
  565.  
  566. rx.xle:    mov    #curatr    ,r5        ; /49/ point to attribute save area
  567.     clr    r3            ; /49/ init the accumulator (low word)
  568.     clr    r2            ; /49/ double precision (high word)
  569. 10$:    tstb    @r5            ; /49/ EOL?
  570.     beq    30$            ; /49/ yep
  571.     cmpb    @r5    ,#space        ; /49/ ignore leading spaces please
  572.     beq    20$            ; /49/ yes, a space
  573.     mov    #12    ,r0        ; /49/ setup for call to $dmul
  574.     call    $dmul            ; /49/ do it please
  575.     mov    r0    ,r2        ; /49/ restore accumulator values now
  576.     mov    r1    ,r3        ; /49/ ditto...
  577.     clr    -(sp)            ; /49/ get the next digit please
  578.     bisb    @r5    ,@sp        ; /BBS/ convert to decimal
  579.     sub    #'0    ,@sp        ; /49/ got it
  580.     add    (sp)+    ,r3        ; /49/ add in the current digit
  581.     adc    r2            ; /49/ add carry bit in also please
  582. 20$:    inc    r5            ; /49/ next ch please
  583.     br    10$            ; /49/ next please
  584. 30$:    div    #1000    ,r2        ; /BBS/ convert to 512 byte blocks now
  585.     mov    r2    ,at$len        ; /49/ save it please
  586.     tst    r3            ; /BBS/ was there a remainder?
  587.     beq    40$            ; /49/ no, exit
  588.     inc    at$len            ; /49/ yes, len++
  589. 40$:    clr    r0            ; success
  590.     return
  591.  
  592.  
  593.     .sbttl    Determine if other system is a PDP-11
  594.  
  595. ;    I S P D P
  596. ;
  597. ;    output:    r0 = 5    other system running POS
  598. ;             4    RT-11 or TSX+
  599. ;             3    RSTS
  600. ;             2    IAS
  601. ;             1    RSX
  602. ;             0    it's something else..
  603.  
  604.     PD$RSX    = '8
  605.     PD$IAS    = '9
  606.     PD$RSTS    = 'A&137
  607.     PD$RT    = 'B&137        ; includes TSX
  608.     PD$POS    = 'C&137
  609.  
  610. ispdp:    clr    r0            ; presume failure
  611.     cmpb    at$sys    ,#'D&137    ; a DEC system?
  612.     bne    10$            ; no, exit
  613.     scan    <at$sys+1>,#pdplst    ; ya, determine operating system type
  614. 10$:    return
  615.  
  616.     .save
  617.     .psect    $pdata
  618. pdplst:    .byte    pd$rsx    ,pd$ias    ,pd$rsts,pd$rt    ,pd$pos    ,0
  619.     .even
  620.     .restore
  621.  
  622.  
  623.     .sbttl    Clear attributes
  624.  
  625. clratr::clr    at$len            ; clear the file length
  626.     clr    at$sys            ; clear the system type
  627.     return
  628.  
  629.     .sbttl    32-bit multiply from RSX SYSLIB.OLB
  630.  
  631. $DMUL:    MOV    R0    ,-(SP)
  632.     CLR    R0
  633.     CLR    R1
  634. 10$:    TST    (SP)
  635.     BEQ    30$
  636.     ROR    (SP)
  637.     BCC    20$
  638.     ADD    R3    ,R1
  639.     ADC    R0
  640.     ADD    R2    ,R0
  641. 20$:    ASL    R3
  642.     ROL    R2
  643.     BR    10$
  644. 30$:    TST    (SP)+
  645.     RETURN
  646.  
  647.     .end
  648.