home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / b / krtrms.mac < prev    next >
Text File  |  2020-01-01  |  41KB  |  1,203 lines
  1.     .title    KRTRMS    RT-11 file I/O
  2.     .ident    "V03.63"
  3.  
  4. ; /63/    27-Sep-97  Billy Youdelman  V03.63
  5. ;
  6. ;    add support for SET WILDCARDS
  7. ;    add support for specifying file size as in "file.nam[siz]"
  8. ;    use er$wpe instead of er$eof for .writw error reporting
  9. ;    move getnxt, getcr0, tgetcr here from KRTPAK
  10. ;    add REWIND routine
  11.  
  12. ; /62/    27-Jul-93  Billy Youdelman  V03.62
  13. ;
  14. ;    save created (.enter) file size in sizeof entry in data table
  15. ;    make filtyp entry in same global
  16. ;    reset SET FILE CREATE-SIZE on successful file open
  17. ;    moved LOGFIL name buffer here
  18. ;    dropped NONAME.TMP for a nfs .enter, return "bad file name" error
  19. ;    move most of ccast to mainline code in KRTCMD.MAC
  20. ;    add version testing to support RT-11 V4
  21. ;    moved GETREC here, so HELP via PF2 can't ever crash..
  22.  
  23. ; /BBS/     1-Dec-91  Billy Youdelman  V03.61
  24. ;
  25. ;    getrec patched to accept passed buffer_length
  26. ;    iswild modified to catch implicit wildcarding
  27. ;    error mapping tables augmented to accommodate new routines
  28. ;    .rctrlo added to file close routine
  29. ;    chkdev added, used for bbs device access restriction
  30. ;    limits: (activation char list for TSX) lives here, also vlflag
  31. ;    added prewind routine for faking RMS stuff when reading help text
  32. ;    add er$dev at end of faterr table to catch non-init'd device lookup
  33. ;
  34. ;    suspend: patched to wait in one tick increments, allowing ^C to
  35. ;    abort - also now uses clkflg to accommodate 50 or 60 Hz..
  36. ;
  37. ;    fixed fparse handling of device name, also disallow a leading
  38. ;    comma in the arg string, as this will do a nfs lookup..
  39. ;
  40. ;    ccast - now does trouble-free aborts from anywhere you'd need it
  41. ;    when talking to the handler or when something is running which
  42. ;    if aborted would leave virtual addressing in a mess, the bell
  43. ;    will be rung acknowledging the abort, at which point it's best
  44. ;    to wait for the program to do it, which it will as soon as it
  45. ;    can.  further ^C's will ring the bell up to CC$MAX times, then
  46. ;    a complete abort and return to the main command line via .spcps
  47. ;    occurs.  if necessary an error packet will be sent, however this
  48. ;    may not be as effective as using ^E, which waits for the packet
  49. ;    in progress to complete first..
  50. ;
  51. ;    added getmcr routine to get arg(s) from KMON passed to chain
  52. ;    area when Kermit is started.  owing to the way RT-11/TSX+ parse
  53. ;    the "@" (causes KMON to try to open the file and read the
  54. ;    first line of it into the command buffer, including the chain
  55. ;    area) the syntax "KERMIT @TAKEFILE" is not usable under RT/TSX.
  56. ;    "KERMIT TAKE TAKEFILE" is a poor but functional substitute..
  57. ;    any other command and args may be passed, ie; .kermit dial tommy
  58. ;
  59. ;    add fixwild, translates "?" to "%" in file names
  60. ;    fixed error handling in file close routine
  61. ;    added getdk, gets physical name of "DK"
  62. ;
  63. ;    moved direr$ here, moved error messages from various modules to
  64. ;    krterr, and added calls to them via direrr..
  65.  
  66. ;    08-Mar-84  09:18:25  Brian Nelson
  67. ;
  68. ;    Copyright 1984,1986 Change Software, Inc.
  69. ;
  70. ;    This is the RT-11 version of K11RMS.MAC.  It simply tries
  71. ;    to emulate, as much as is reasonable, what the RMS-11 I/O
  72. ;    routines do for RSX and RSTS.   Since Kermit-11 was built
  73. ;    around RMS I/O we map RT-11 errors into RMS codes.   Note
  74. ;    that for RT-11, of course, all files are considered to be
  75. ;    image files.
  76. ;
  77. ;    This module (KRTRMS.MAC) must NEVER be swapped out!
  78. ;
  79. ;    The use of %loc and %val are from VMS Pascal and Fortran.
  80. ;    %loc means ADDRESS, whereas %val means literal.  All call
  81. ;    formats assume the first argument is at 0(r5), the next
  82. ;    at 2(r5) and so on, as in:
  83. ;
  84. ;    mov    #-1    ,-(sp)        ; do today's date
  85. ;    mov    #datebf    ,-(sp)        ; where to put the converted string
  86. ;    mov    sp    ,r5        ; pointer to above data
  87. ;    call    ascdat            ; simple
  88. ;    cmp    (sp)+    ,(sp)+        ; all done, pop buffer
  89. ;
  90. ;    or by using the CALLS macro (defined in KRTMAC.MAC)
  91. ;
  92. ;    calls    ascdat    ,<#datebf,#-1>
  93. ;
  94. ;    Disk I/O entry points:
  95. ;
  96. ;    CLOSE    (%val channel_number)
  97. ;    CREATE    (%loc filename ,%val channel_number, %val type)
  98. ;    GETC    (%val channel_number)
  99. ;    GETREC    (%loc buffer ,%val ch_number ,%val buf_siz) {rtns RSZ in r1}
  100. ;    LOOKUP    (%val unused ,%loc in_filespec ,%val index ,%loc out_filename)
  101. ;    OPEN    (%loc filename ,%val channel_number ,%val type)
  102. ;    PUTC    (%val char ,%val channel_number)
  103. ;    PUTREC    (%loc buffer ,%val record_size ,%val channel_number)
  104. ;
  105. ;    Non-disk I/O entry points:
  106. ;
  107. ;    In most cases, r0 will return an error code or zero for success
  108. ;    For KBREAD and READ, r1 will have the size of the read
  109. ;    For BINREAD, r1 will have the character just read
  110. ;
  111. ;    ASCDAT    (%loc buffer ,%val date_value)
  112. ;    ASCTIM    (%loc buffer ,%loc time_value)    ; /62/
  113. ;    ASSDEV    (%loc device_name)
  114. ;    BINREA    (%val time_out)
  115. ;    BINWRI    (%loc buffer ,%val byte_count)
  116. ;    CANTYP    ()
  117. ;    CHKABO    ()
  118. ;    CLOSTT    ()
  119. ;    DODIR    (%loc directory_string)
  120. ;    EXIT    ()
  121. ;    KBREAD    (%loc buffer)
  122. ;    L$NOLF    ()
  123. ;    L$PCRL    ()
  124. ;    L$TTYO    (%loc buffer ,%val byte_count)
  125. ;    LOGOUT    ()
  126. ;    NAMCVT    (%loc source_filename ,%loc returned_normal_name)
  127. ;    OPENTT    ()
  128. ;    PRINTM    (%val #_args ,%loc arg_1 ,%loc arg_2 ,... ,%loc arg_n)
  129. ;    SETCC    ()
  130. ;    SETSPD    (%val speed)
  131. ;    SUSPEN    (%val seconds ,%val ticks)
  132. ;    SYSERR    (%val error_number ,%loc error_text_buffer)
  133. ;    TTSPEE    ()
  134. ;    TTYFIN    ()
  135. ;    TTYHAN    ()
  136. ;    TTYRST    (%loc terminal_name)
  137. ;    XINIT    ()
  138.  
  139.  
  140.     .include "IN:KRTMAC.MAC"
  141.     .iif ndf  KRTINC  .error    <; .include for IN:KRTMAC.MAC failed>
  142.     .include "IN:KRTDEF.MAC"
  143.     .iif ndf  MSG$DA  .error    <; .include for IN:KRTDEF.MAC failed>
  144.  
  145. ; /62/    .FPROT,.SFDAT bypassed for V4, also expanded to allow assy under same
  146.  
  147.     .MCALL    .CLOSE    ,.CMKT    ,.CSISPC,.DSTAT    ,.ENTER    ,.EXIT
  148.     .MCALL    .FETCH    ,.GTIM    ,.GTLIN    ,.HRESET,.LOOKUP,.MRKT
  149.     .MCALL    .PURGE    ,.RCTRLO,.READW    ,.SCCA    ,.SPCPS    ,.TWAIT
  150.     .MCALL    .WRITW
  151.  
  152.  
  153.     .sbttl    I/O database
  154.  
  155.     LUN.KB    ==      0    ; the local terminal
  156.     LUN.IN    ==      1    ; input file channel
  157.     LUN.OU    ==      2    ; output file channel
  158.     LUN.LO    ==      3    ; packet and file logging channel
  159.     LUN.TA    ==      4    ; TAKE command file channel
  160.     LUN.AT    ==      5    ; /BBS/ get/set RT-11 file attributes
  161.     LUN.SR    ==      6    ; directory lookup channel
  162.     LUN.XK    ==      7    ; comm handler data channel
  163.     LUN.LD    ==     12    ; /BBS/ TSX LD assign channel
  164.  
  165.     NRTQUE    ==     16    ; /62/ KRT needs 14. queue elements
  166.     PROT    =  100000    ; /BBS/ protected file bit in dir status word
  167.     TTBSIZ    ==     40    ; terminal output buffer size
  168.  
  169.     .psect    $rtque    ,rw,d,gbl,rel,con
  170. rtque::    .blkw    10.*nrtque        ; buffers for extra queue elements
  171.  
  172. ; /51/    the IN, OUT, TAKE and LOG file I/O buffers are allocated
  173. ;    by xinit after the initial .settop and swap with the USR
  174.  
  175.     .psect    rtioda    ,rw,d,gbl,rel,con
  176. ;  channel #:    lun.kb    ,lun.in    ,lun.out,lun.log,lun.take
  177. blknum::.word    0    ,0    ,0    ,0    ,0    ; current block number
  178. buflst::.word    ttbuf    ,0    ,0    ,0    ,0    ; data I/O buffer addr
  179. bufsiz::.word    ttbsiz    ,maxsiz    ,maxsiz    ,maxsiz    ,maxsiz    ; size of buffer
  180. bufp::    .word    0    ,0    ,0    ,0    ,0    ; current byte pointer
  181. bufs::    .word    0    ,0    ,0    ,0    ,0    ; size (end) of data
  182. date.a::.word    0    ,0    ,0    ,0    ,0    ; /BBS/ date attribute
  183. filtyp::.word    terminal,text    ,text    ,text    ,text    ; term, text, bin, dec
  184. mode::    .word    1    ,0    ,0    ,0    ,0    ; if <> writing to buf
  185. prot.a::.word    0    ,0    ,0    ,0    ,0    ; /BBS/ prot attribute
  186. sizof::    .word    0    ,0    ,0    ,0    ,0    ; size of file, blocks
  187. time.a::.word    0    ,0    ,0    ,0    ,0    ; /BBS/ time attribute
  188.  
  189. ; special buffers
  190. status::.word    0            ; this is Kermit-11's error status reg
  191. totp.s::.word    0            ; send packet stats buffer address
  192. totp.r::.word    0            ; and same for rec packet stats
  193. ttbuf::    .blkb    ttbsiz+2        ; TT out buffer for writing via lun.kb
  194. xklgbu::.word    0            ; /51/ pointer to handler write buffer
  195.  
  196. ; device and file data
  197. asname::.blkb    ln$max            ; /62/ for GET or SEND file asfile
  198. bintyp::.word    0            ; addr of BINARY-TYPE list in hi mem
  199. context::.word    0            ; /62/ offset into current dir segment
  200. cstat::    .word    0 ,0 ,0 ,0 ,0 ,0    ; /BBS/ .cstat device physical name
  201. dblk::    .rad50    "   "            ; ..getdk puts DK at start-up here
  202.     .word    0 ,0 ,0            ; (unused) file name and extent
  203. defdir::.blkb    4+2            ; /62/ the default directory
  204. defext:    .word    0 ,0 ,0 ,0        ; default extents for .csispc
  205. dirbfr::.word    0            ; /62/ ptr to DIR output to TT buffer
  206. dirflg::.word    0            ; /62/ if <> keep blanks in file name
  207. dirnam::.word    0            ; /62/ ptr to DIR input name buffer
  208. dkblk::    .rad50    "DK "            ; /62/ used to get DK's physical name
  209.     .word    0 ,0 ,0            ; (unused) file name and extent
  210. dkname::.asciz    "DK:"            ; /BBS/ home here (len=4 3bytes+.even)
  211.     .byte    0 ,0            ; /BBS/ leave room for a unit number
  212. en$siz::.word    0            ; file create size, 0=let RT-11 do it
  213. filnam::.blkb    ln$max            ; /62/ output name from dir lookup
  214. indnam::.blkb    16+2            ; /62/ current take or init file name
  215. ininam::.blkb    16+2            ; /62/ init file name for show file
  216. logfil::.blkb    26+2            ; /63/ log file name
  217. lokdate::.word    0            ; /62/ file date from lookup
  218. loklen::.word    0            ; /62/ file length
  219. lokstat::.word    0            ; /62/ file status
  220. loktime::.word    0            ; /62/ TSX+ file create time
  221. r50out::.word    0 ,0 ,0 ,0        ; /BBS/ last output file opened name
  222. rtwork::.word    0 ,0 ,0 ,0 ,0 ,0 ,0 ,0    ; /62/ must be in a non-swapping psect
  223. sftim:    .byte    lun.at    ,146        ; /BBS/ TSX set file create time emt
  224.     .word    r50out            ; /BBS/ pointer to out file name
  225. tim.sf:    .word    0            ; /BBS/ put desired time here
  226. srcnam::.blkb    ln$max            ; /62/ in file name as typed by user..
  227.  
  228. ; operating system data
  229. jobsts::.word    0 ,0 ,0 ,0 ,0 ,0 ,0 ,0    ; /51/ from .gtjb
  230. montyp::.word    0            ; /51/ <0 -> SJ,  0 -> FB, >0 -> XM
  231. rt11up::.word    0            ; /62/ RT-11 monitor release level
  232. rt11ve::.word    0            ; /62/ and monitor version number
  233. tsxsav::.word    0            ; /BBS/ if TSX, this contains line #
  234. tsxver::.word    0            ; /BBS/ and this the version number
  235. vbgexe::.word    0            ; /62/ if <> running under VBGEXE
  236.  
  237. ; memory allocation data
  238. fetpt::    .word    0            ; /51/ pointer for the next .fetch
  239. fetptm::.word    0            ; /51/ max address for fetching
  240. freept::.word    0            ; /51/ for the next general allocation
  241. hilimi::.word    50            ; /51/ it's 50 for FB, $limit+2 for XM
  242. maxtop::.word    0            ; /51/ size after .settop
  243. xmfetp::.word    0            ; /51/ base of area for XM fetching
  244.  
  245. ; TSX terminal options
  246. m.tsxs::.byte    35 ,'Y&137 ,0        ; don't echo LF after CR is typed
  247. m.tsxr::.byte    35 ,'Z&137 ,0        ; do echo LF after CR
  248. limits::.byte    35 ,'D&137 ,3        ; /BBS/ kill ^C special handling
  249.     .byte    35 ,'D&137 ,12        ; LF
  250.     .byte    35 ,'D&137 ,15        ; RET
  251.     .byte    35 ,'D&137 ,17        ; ^O
  252.     .byte    35 ,'D&137 ,22        ; ^R
  253.     .byte    35 ,'D&137 ,24        ; ^T
  254.     .byte    35 ,'D&137 ,25        ; ^U
  255.     .byte    35 ,'D&137 ,33        ; ESC
  256.     .byte    35 ,'D&137 ,177        ; DEL
  257. vl$chr::.byte    35 ,'D&137 ,27        ; ^W  here to allow on/off select
  258.     .byte    35 ,'D&137 ,2        ; ^B  and this should track ^W..
  259.     .byte    0            ; null terminator
  260. vlflag::.byte    0            ; /BBS/ ^W local/remote flag..
  261.     .even
  262.  
  263.  
  264.     .sbttl    Error mapping, codes are defined in KRTERR.MAC
  265.  
  266.     .psect    $pdata
  267. alloer::.word    er$sys    ,er$120    ,er$121    ,er$122    ,er$120    ,er$123
  268. atterr::.word    er$sys    ,er$124    ,er$121    ,er$125    ,er$126    ,er$127    ,er$120
  269. cloerr:    .word    er$sy1    ,er$sy1    ,er$sys    ,er$prv
  270. csierr::.word    er$fnm    ,er$dev    ,er$sy2
  271. drderr::.word    fa$dio    ,er$rer    ,er$nop    ,er$sys    ; /BBS/ add for TSX dir errs
  272. dsterr:    .word    fa$nhd                ; /62/
  273. enterr:    .word    er$lby    ,er$ful    ,er$sy3    ,er$prv    ,er$sy3
  274. faterr::.word    fa$imp    ,fa$nhd    ,fa$dio    ,fa$fet    ,fa$ovr    ,fa$dfl    ,fa$adr
  275.     .word    fa$lun    ,fa$imp    ,fa$imp    ,fa$imp    ,fa$idr    ,fa$imp    ,fa$imp
  276.     .word    fa$imp    ,fa$imp    ,fa$imp    ,fa$imp    ,fa$dio    ; /62/
  277. feterr:    .word    er$dev    ,er$sy4
  278. lokerr::.word    er$lby    ,er$fnf    ,er$sys
  279. mnterr::.word    er$lby    ,er$ld1    ,er$sys    ,er$lby    ,er$fnm    ,er$ld5    ,er$fnf
  280.     .word    er$ld1                ; /BBS/ logical disk errors
  281. reaerr::.word    er$eof    ,er$rer    ,er$nop    ,er$sys
  282. renerr::.word    er$lby    ,er$fnf    ,er$iop    ,er$prv
  283. wrierr:    .word    er$wpe    ,er$wer    ,er$nop    ,er$sys    ; /63/
  284. xcierr::.word    er$lby    ,er$xco    ,er$sys        ; /62/
  285.  
  286.  
  287. ;    .sbttl    Allowable device assignments for the BBS
  288. ;
  289. ;devlst::.ascii    "DU2:"            ; /BBS/ table of allowed devices
  290. ;    .ascii    "LD0:"            ; /BBS/ fparse will insert missing "0"
  291. ;    .ascii    "LD1:"
  292. ;    .ascii    "LD2:"            ; /63/ append trailing blanks to
  293. ;    .ascii    "LD3:"            ; /63/ any device name less than
  294. ;    .ascii    "LD4:"            ; /63/ 4 characters long, so that
  295. ;    .ascii    "LD5:"            ; /63/ its entry here is 4 bytes
  296. ;    .ascii    "LD6:"
  297. ;    .ascii    "LD7:"
  298. ;    .byte    0            ; /BBS/ end of it all
  299.  
  300.  
  301.     .sbttl    Local data
  302.  
  303. kp.res:    .byte    33 ,'> ,0        ; type this out to reset keypad
  304.     .even
  305.  
  306.  
  307.     .psect    $code
  308.     .sbttl    Get KMON command line args and pass to Kermit  ; /BBS/ added
  309.  
  310. ;    G E T M C R        (only used ONCE at start-up)
  311. ;
  312. ;    output:     (r5)    = command line less the task name, .asciz
  313. ;          r0    = length of whats left
  314.  
  315. getmcr::save    <r1,r2,r3>
  316.     mov    sp    ,mcrcmd    ; flag to only come here and try this once
  317.     mov    #510    ,r1    ; get address of # of bytes in chain area
  318.     mov    @r1    ,r2    ; save a copy of number of bytes
  319.     dec    @r1        ; anything there?  (byte count includes null)
  320.     ble    20$        ; nope..
  321.     clr    (r1)+        ; hose location 510 and bump to location 512
  322.     mov    @r5    ,r3    ; point at where to put command line
  323. 10$:    movb    (r1)+    ,(r3)+    ; copy contents of chain area to input buffer
  324.     bne    10$        ; until hitting the null terminator
  325.     sub    #ln$max+2,sp    ; /63/ a temporary buffer on the stack
  326.     mov    sp    ,r0    ; point to buffer  must do this to hose KMON's
  327.     .gtlin    r0        ; buffer or args are passed to KMON on exit,
  328.     add    #ln$max+2,sp    ; /63/ generating error msg.. dump temp buffer
  329.     mov    r2    ,r0    ; put length where calling routine needs it
  330.     br    30$
  331. 20$:    mov    @r5    ,r0    ; address of command string buffer
  332.     clrb    @r0        ; clear it
  333.     clr    r0        ; and return a length of zero
  334. 30$:    unsave    <r3,r2,r1>
  335.     return
  336.  
  337.  
  338.     .sbttl    Load a handler if not already resident (BG only)
  339.  
  340. ;    F E T C H
  341. ;
  342. ;    input:     (r5)    = rad50 device name to fetch
  343. ;          r0    = if <>, the error code
  344.  
  345. fetch::    .dstat    #rtwork,r5        ; get handler status
  346.     bcs    40$            ; no such handler present
  347.     tst    rtwork+4        ; is this handler resident?
  348.     bne    10$            ; yes
  349.     tst    jobsts            ; no, we must be job zero to be in
  350.     bne    20$            ; the background, else error return
  351.     mov    fetptmax,-(sp)        ; check for space to load it
  352.     sub    @fetpt    ,@sp        ; simple to do
  353.     cmp    rtwork+2,(sp)+        ; is there sufficient space?
  354.     bhi    30$            ; no, error and exit
  355.     .fetch    @fetpt    ,r5        ; try hard to load the thing
  356.     bcs    50$            ; no way, map the error code please
  357.     mov    r0    ,@fetpt        ; update the free pointer and exit
  358. 10$:    clr    r0            ; no errors
  359.     br    80$
  360.  
  361. 20$:    mov    #er$fgf    ,r0        ; can't fetch if running in FG
  362.     br    80$
  363. 30$:    mov    #er$fet    ,r0        ; return no room for the handler
  364.     br    80$
  365. 40$:    mov    #dsterr    ,-(sp)        ; map a .dstat error
  366.     br    60$            ; and do it
  367. 50$:    mov    #feterr    ,-(sp)        ; map a .fetch error
  368. 60$:    movb    @#errbyt,r0        ; get the error code
  369.     bpl    70$            ; normal error code here
  370.     com    r0            ; fatal error from .serr
  371.     mov    #faterr    ,(sp)        ; map to fatal error message
  372. 70$:    asl    r0            ; word offsets
  373.     add    (sp)+    ,r0        ; the actual address
  374.     mov    @r0    ,r0        ; get it and exit
  375. 80$:    return
  376.  
  377.  
  378.     .sbttl    Parse file name and fill in with defaults ; /BBS/ all new
  379.  
  380. ;    F P A R S E
  381. ;
  382. ;    input:      (r5)    = input file name, .asciz
  383. ;         defdir    = the default directory name string to use
  384. ;    output:     2(r5)    = expanded file name, .asciz, max len is ln$max bytes
  385. ;           r0    = if <>, error code
  386.  
  387. ; /BBS/    For the BBS, be sure there is an authorized device in the file spec
  388.  
  389. fparse::save    <r3,r2,r1>
  390.     mov    2(r5)    ,r2        ; output pointer
  391.     mov    @r5    ,r1        ; input pointer
  392.     mov    #er$fnm    ,r0        ; preset error reg in case
  393.     cmpb    @r1    ,#comma        ; a leading comma will do a nfs
  394.     beq    80$            ; open, which is disallowed here
  395.     cmpb    @r1    ,#'D
  396.     bne    10$            ; if it's "DK:"
  397.     cmpb    1(r1)    ,#'K        ; then use Kermit's default
  398.     bne    10$
  399.     cmpb    2(r1)    ,#':        ; not the op system's DK !!
  400.     beq    40$            ; it is "DK:" so use defdir
  401.  
  402. 10$:    scan    #':    ,r1        ; any device name specified?
  403.     mov    r0    ,r3        ; save copy whilst testing..
  404.     beq    50$            ; no, so use the defdir
  405.  
  406. 20$:    movb    (r1)+    ,(r2)+        ; borrow output buff for temp
  407.     sob    r0    ,20$        ; copy of dev name to check
  408. ;    cmp    r3    ,#3        ; is there a unit num here?
  409. ;    bgt    30$            ; most likely ya..
  410. ;    movb    #'0    ,-(r2)        ; no, stick a zero in it, and..
  411. ;    tstb    (r2)+            ; ..bump back past it, then..
  412. ;    movb    #':    ,(r2)+        ; ..replace just zapped colon
  413. 30$:    clrb    @r2            ; null terminate
  414. ;x    calls    chkdev    ,<2(r5)>    ; check for a valid device
  415. ;x    tst    r0            ; well?
  416. ;x    bne    80$            ; nope..
  417.     br    70$            ; take the whole input string
  418.  
  419. 40$:    add    #3    ,r1        ; bump past "DK:"
  420. 50$:    mov    #defdir    ,r0        ; copy in default dir
  421. 60$:    movb    (r0)+    ,(r2)+        ; one byte at a time
  422.     bne    60$            ; until hitting the null terminator
  423.     dec    r2            ; back up over null
  424. 70$:    copyz    r1    ,r2 ,#ln$max-4    ; /62/ copy in file name, if any..
  425.     clr    r0            ; success
  426. 80$:    unsave    <r1,r2,r3>
  427.     return
  428.  
  429.  
  430. ;    .sbttl    Ensure the device called is authorized for access  ; /BBS/
  431. ;
  432. ; /BBS/ if you want access restrictions uncomment the code below,
  433. ;    along with filling in the device list as appropriate, then
  434. ;    uncomment the sho$dv routine in KRTSHO
  435. ;
  436. ;chkdev::save    <r1,r2,r3,r4>
  437. ;    sub    #6    ,sp        ; allocate a temp buffer for the
  438. ;    mov    sp    ,r1        ; incoming device and point to it
  439. ;    copyz    @r5    ,r1,#5        ; dev name has four chars max + null
  440. ;    strlen    r1            ; how much is left?
  441. ;    tst    r0            ; if nothing..
  442. ;    beq    50$            ; nothing to do, error exit
  443. ;    strlen    r1            ; get length of device name
  444. ;    mov    #4    ,r3        ; need result in a reg
  445. ;    sub    r0    ,r3        ; must be 4 chars or less
  446. ;    beq    20$            ; it's exactly 4, on to testing
  447. ;    blt    50$            ; it's greater than 4, bail out
  448. ;    mov    r1    ,r2        ; save copy of pointer
  449. ;    add    r0    ,r2        ; point to last char
  450. ;10$:    movb    #space    ,(r2)+        ; space pad
  451. ;    sob    r3    ,10$        ; until total length is 4
  452. ;    clrb    @r2            ; null terminate padded string
  453. ;
  454. ;20$:    mov    #devlst    ,r2        ; ok, get listhead of device types
  455. ;30$:    mov    r2    ,r3        ; get next device type address
  456. ;    tstb    @r3            ; end of the list?
  457. ;    beq    50$            ; if null, then all done
  458. ;    mov    r1    ,r4        ; not done, get pointer to passed type
  459. ;    cmpb    (r4)+    ,(r3)+        ; look for match on device type
  460. ;    bne    40$            ; not today
  461. ;    cmpb    (r4)+    ,(r3)+        ; again please
  462. ;    bne    40$            ; not bloody likely
  463. ;    cmpb    (R4)+    ,(r3)+        ; and so on
  464. ;    bne    40$            ; you know
  465. ;    cmpb    (r4)+    ,(r3)+        ; one more time
  466. ;    beq    60$            ; a match, success
  467. ;40$:    add    #4    ,r2        ; get the next one please
  468. ;    br    30$            ; no match, try the next one
  469. ;
  470. ;50$:    mov    #fa$idr    ,r0        ; return access error
  471. ;    br    70$            ; and exit
  472. ;60$:    clr    r0            ; no error
  473. ;70$:    add    #6    ,sp        ; pop local buffer
  474. ;    unsave    <r4,r3,r2,r1>
  475. ;    return
  476.  
  477.  
  478.     .sbttl    Is it wild?    ; /BBS/ heavily hacked
  479.  
  480. iswild::save    <r1>
  481.     mov    @r5    ,r1    ; address of string to check
  482.     scan    #comma    ,r1    ; /62/ always call a comma delimiter wild
  483.     tst    r0        ; /62/ find one?
  484.     bne    40$        ; /62/ ya..
  485.  
  486.     tst    dowild        ; /63/ EXPLICIT wildcarding enabled?
  487.     bne    10$        ; /63/ no
  488.     scan    #'*    ,r1    ; /63/ ya, look for an asterisk
  489.     tst    r0        ; /63/ well?
  490.     bne    40$        ; /63/ found one, call it wild
  491.     scan    #'%    ,r1    ; /63/ look for a percent-sign
  492.     tst    r0        ; /63/ well?
  493.     bne    40$        ; /63/ found one, call it wild
  494.     br    50$        ; /63/ no wildcards found, r0 is cleared
  495.  
  496. 10$:    scan    #'.    ,r1    ; IMPLICIT wildcarding - look for a dot
  497.     tst    r0        ; find one?
  498.     beq    40$        ; no dot implies extent is wild
  499.     clr    r0        ; init as not wild
  500. 20$:    cmpb    @r1    ,#'.    ; leading dot ala implicit wildcards?
  501.     beq    40$        ; ya, so flag it as wildcarded file_spec
  502. 30$:    tstb    @r1        ; is it a null?
  503.     beq    50$        ; ya, done
  504.     cmpb    @r1    ,#'%    ; is it a percent sign?
  505.     beq    40$        ; ya, return it's wild
  506.     cmpb    @r1    ,#'*    ; is it a star?
  507.     beq    40$        ; ya, return it's wild
  508.     cmpb    (r1)+    ,#':    ; also disallow  DU5:.MAC  wildcarding
  509.     bne    30$        ; this isn't that..
  510.     tstb    @r1        ; a null?
  511.     bne    20$        ; and bomb "DU5:" just a device, no file
  512. 40$:    mov    #er$wld    ,r0    ; return wildcards not supported error
  513. 50$:    unsave    <r1>
  514.     return
  515.  
  516.  
  517.     .sbttl    Open a file        ; MTB$OP  20-Nov-86 14:56:59  BDN
  518.     .enabl    lsb
  519.  
  520. ;    C R E A T E    (write to a file)
  521. ;    O P E N        (read from a file)
  522. ;
  523. ;    input:      (r5)    = address of .asciz file spec
  524. ;         2(r5)    = logical unit number
  525. ;         4(r5)    = 0 to .lookup, <> to .enter
  526. ;    output:       r0    = if <>, error code
  527.  
  528. create::mov    #1    ,r0        ; say we want to create
  529.     br    10$            ; and off to common code
  530.  
  531. open::    clr    r0            ; force .lookup for this ept
  532. 10$:    save    <r1,r2,r3,r4,r5>    ; /62/ condensed mtb$op into this..
  533.     mov    r0    ,r2        ; r2 saved, make it enter/lookup flag
  534.     mov    (r5)    ,r1        ; filespec address, .asciz
  535.     mov    2(r5)    ,r4        ; /62/ recover the lun to use
  536.     mov    r4    ,r3        ; /62/ save a copy of it
  537.     asl    r4            ; word indexing into data table
  538.     bne    20$            ; non-zero lun means disk I/O
  539.     mov    sp    ,mode+0        ; zero, implies terminal always
  540.     clr    bufp+0            ; clear this out also
  541.     clr    r0            ; no errors
  542.     jmp    140$            ; /62/ done
  543.  
  544. 20$:    sub    #ln$max+2,sp        ; /63/ allocate a buffer for .csispc
  545.     clr    sizof(r4)        ; clear I/O subsystem tables
  546.     clr    bufp(r4)        ; clear buffer pointer out
  547.     clr    bufs(r4)        ; clear data in buffer size out
  548.     clr    mode(r4)        ; assume reading
  549.     clr    blknum(r4)        ; to keep track of current vbn
  550.     mov    4(r5)    ,filtyp(r4)    ; /62/ binary or text flag
  551.     mov    buflst(r4),r0        ; /62/ buffer address
  552.     mov    bufsiz(r4),r5        ; /62/ the buffer size
  553. 30$:    clrb    (r0)+            ; clear it out
  554.     sob    r5    ,30$        ; next please
  555.     mov    sp    ,r5        ; point to save area
  556. 40$:    movb    (r1)+    ,(r5)+        ; copy the file name over now
  557.     bne    40$            ; next please
  558.     dec    r5            ; back up to the null
  559.     movb    #'=    ,(r5)+        ; setup dummy input spec for csispc
  560.     clrb    @r5            ; .asciz
  561.     mov    sp    ,r5        ; point back to save area
  562.     mov    #csierr    ,r1        ; assume CSI error mapping
  563.     .csispc    r5,#defext,r5        ; do it
  564.     mov    r5    ,sp        ; restore the stack pointer
  565.     bcs    110$            ; file name parse error
  566.     call    fetch            ; ensure that handlers are loaded
  567.     tst    r0            ; well?
  568.     bne    130$            ; error code is already mapped
  569.     tst    r2            ; .enter this time?
  570.     bne    70$            ; ya..
  571.     mov    #lokerr    ,r1        ; .lookup error mapping
  572.     .lookup    #rtwork,r3,r5        ; do it
  573.     bcs    110$            ; it failed
  574.     mov    r0    ,sizof(r4)    ; success, return the file's size
  575.     mov    #-1    ,bufp(r4)    ; force a disk read on first call
  576.     call    clr.at            ; /BBS/ init attribute words
  577.     mov    lokdate    ,date.a(r4)    ; /BBS/ file create date from lookup
  578.     beq    50$            ; /BBS/ nothing there
  579.     mov    loktime    ,time.a(r4)    ; /BBS/ lookup's file create time
  580. 50$:    bit    #prot    ,lokstat    ; /BBS/ protected file?
  581.     beq    60$            ; /BBS/ nope..
  582.     inc    prot.a(r4)        ; /BBS/ ya, set file protection
  583. 60$:    clr    r0            ; success
  584.     br    130$            ; done
  585.  
  586. 70$:    tst    2(r5)            ; never allow nfs writes to a disk
  587.     bne    80$            ; it's ok
  588.     mov    #csierr    ,r1        ; /62/ use CSI error mapping to force
  589.     br    110$            ; /62/ a "bad file name" error return
  590. 80$:    mov    #enterr    ,r1        ; assume .enter error code mapping
  591.     mov    10(r5)    ,r2        ; /63/ "file.nam[siz]" has priority
  592.     bne    90$            ; /63/ if user specified it, that is
  593.     mov    en$siz    ,r2        ; did user SET FILE CREATE-SIZE?
  594.     bne    90$            ; yes
  595.     mov    at$len    ,r2        ; no, use passed attribute value
  596. 90$:    .enter    #rtwork,r3,r5,r2    ; try hard to create the file
  597.     bcs    110$            ; no way
  598.     clr    en$siz            ; /62/ reset on successful file open
  599.     mov    r0    ,sizof(r4)    ; /62/ return the created size
  600.     mov    sp    ,mode(r4)    ; we are writing today
  601.     cmp    r3    ,#lun.ou    ; /BBS/ is this the output file?
  602.     bne    100$            ; /BBS/ no
  603.     clr    skipfile        ; /62/ ya, be sure this is reset
  604.     mov    r5    ,r0        ; /BBS/ ptr to current file rad50 name
  605.     mov    #r50out    ,r1        ; /BBS/ where to save it
  606.     mov    (r0)+    ,(r1)+        ; /BBS/ copy
  607.     mov    (r0)+    ,(r1)+        ; /BBS/ the
  608.     mov    (r0)+    ,(r1)+        ; /BBS/ file
  609.     mov    (r0)    ,(r1)        ; /BBS/ name
  610. 100$:    clr    r0            ; success
  611.     br    130$            ; done
  612.  
  613. 110$:    movb    @#errbyt,r0        ; get the error code
  614.     bpl    120$            ; normal error
  615.     com    r0            ; hard error code
  616.     mov    #faterr    ,r1        ; map into the hard errors
  617. 120$:    asl    r0            ; word addressing
  618.     add    r0    ,r1        ; get the mapped error
  619.     call    clr.at            ; /BBS/ don't leave anything lingering
  620.     asr    r4            ; recover actual channel number
  621.     .purge    r4            ; ensure the channel is released
  622.     mov    (r1)    ,r0        ; copy and exit
  623. 130$:    add    #ln$max+2,sp        ; /63/ pop stack
  624. 140$:    unsave    <r5,r4,r3,r2,r1>    ; /62/
  625.     return
  626.  
  627.     .dsabl    lsb
  628.  
  629.  
  630.     .sbttl    Clear attributes
  631.  
  632. ;    input:      r4    = lun*2 (word indexing)
  633.  
  634. clr.at:    clr    date.a(r4)        ; /BBS/ creation date
  635.     clr    time.a(r4)        ; /BBS/ creation time
  636.     clr    prot.a(r4)        ; /BBS/ protected file
  637.     return
  638.  
  639.  
  640.     .sbttl    Preset a file I/O channel to desired block and offset ; /BBS/
  641.  
  642. ;    P R E W I N D
  643. ;
  644. ;    input:      (r5)    = lun
  645. ;         2(r5)    = block number
  646. ;         4(r5)    = byte offset in above block
  647.  
  648. prewind::save    <r2,r3>
  649.     mov    @r5    ,r2        ; channel number please
  650.     asl    r2            ; word indexing
  651.     mov    2(r5)    ,blknum(r2)    ; req'd block of the disk file
  652.     mov    bufsiz(r2),r3        ; we need buffer size in words
  653.     asr    r3            ; convert bytes to words
  654.     .readw    #rtwork,@r5,buflst(r2),r3,blknum(r2) ; read in the block
  655.     bcs    10$            ; it failed, bye
  656.     inc    blknum(r2)        ; next time read the next block
  657.     mov    4(r5)    ,r3        ; get a copy of required offset
  658.     mov    r3    ,bufp(r2)    ; now preset offset in block
  659.     asl    r0            ; convert words read to bytes
  660.     sub    r3    ,r0        ; don't count unused bytes..
  661.     mov    r0    ,bufs(r2)    ; save the record size
  662. 10$:    unsave    <r3,r2>
  663.     return
  664.  
  665.  
  666.     .sbttl    Reset a file I/O channel to the top    ; /63/
  667.  
  668. ;    R E W I N D
  669. ;
  670. ;    input:      (r5)    = lun
  671.  
  672. rewind::mov    @r5    ,r0        ; get the channel number (LUN)
  673.     beq    10$            ; for the terminal, a no-op
  674.     asl    r0            ; word indexing is used here
  675.     mov    #-1    ,bufp(r0)    ; flag a buffer reload is needed
  676.     clr    bufs(r0)        ; nothing is in the buffer (size=0)
  677.     clr    blknum(r0)        ; first block of the disk file
  678. 10$:    clr    r0            ; no errors are possible
  679.     return                ; bye
  680.  
  681.  
  682.     .sbttl    Close a file        ; /BBS/    merged flush(lun) into this
  683.  
  684. ;    C L O S E
  685. ;
  686. ;    input:     (r5)    = channel number to close
  687. ;    output:      r0    = if <>, mapped error code
  688.  
  689. close::    save    <r4,r2>            ; use r4, for calling clr.at
  690.     cmp    @r5    ,#lun.ou    ; is it the output file?
  691.     bne    10$            ; nope
  692.     tst    skipfile        ; ya, skipping this one?
  693.     beq    10$            ; no, save it
  694.     .purge    @r5            ; ya, hose it
  695.     clr    skipfile        ; just this one tho
  696.     br    60$            ; then go clean up buffer
  697.  
  698. 10$:    mov    @r5    ,r4        ; get the internal channel number
  699.     asl    r4            ; word indexing
  700.     tst    bufp(r4)        ; anything in the buffer
  701.     beq    30$            ; no
  702.     tst    mode(r4)        ; writing today?
  703.     beq    30$            ; no
  704.     tst    r4            ; terminal today?
  705.     bne    20$            ; no
  706.     mov    buflst(r4),r0        ; yes, get start of buffer
  707.     add    bufp(r4),r0        ; point to next byte AFTER data
  708.     clrb    (r0)            ; null terminate for wrtall
  709.     wrtall    buflst(r4)        ; dump last buffer of data to TT
  710.     br    60$            ; go finish up
  711.  
  712. 20$:    mov    bufsiz(r4),r2        ; buffer is this size
  713.     asr    r2            ; RT-11 likes to have word counts
  714.     .writw    #rtwork,@r5,buflst(r4),r2,blknum(r4) ; write last buff to disk
  715.     bcc    30$            ; it wuz ok
  716.     movb    @#errbyt,r0        ; it failed, get the error code
  717.     asl    r0            ; word indexing
  718.     mov    wrierr(r0),r0        ; map it into a global error code
  719.     save    <r0>            ; save error
  720.     .close    @r5            ; save what there is of it
  721.     unsave    <r0>            ; restore error
  722.     br    70$            ; and go map it
  723.  
  724. 30$:    mov    @r5    ,r4        ; channel number
  725.     beq    60$            ; terminal
  726.     .close    r4            ; close the file
  727.     bcc    40$            ; it worked
  728.     movb    @#errbyt,r0        ; it failed, map the error
  729.     asl    r0            ; to something more descriptive
  730.     mov    cloerr(r0),r0        ; simple
  731.     br    70$            ; map the error please
  732.  
  733.     ; /BBS/ this stuff handles passed attributes, such as they are w/RT-11
  734. 40$:    cmp    rt11ver    ,#5        ; /62/ is this RT-11 V5 or above?
  735.     blt    60$            ; /62/ no, V4 can't .sfdat or .fprot
  736.     cmp    r4    ,#lun.ou    ; is it the output file?
  737.     bne    60$            ; nope
  738.     asl    r4            ; word indexing
  739.     tst    date.a(r4)        ; anything there?
  740.     beq    50$            ; no date was passed
  741. ; /62/    .sfdat    #rtwork    ,#lun.at,#r50out,date.a(r4) ; set the date
  742.     MOV    #rtwork    ,R0        ; /62/ expanded to assemble under V4
  743.     MOV    #lun.at+<34.*^o400>,@R0    ; /62/ even though V4 can't run it
  744.     MOV    #r50out    ,2.(R0)        ; /62/
  745.     MOV    date.a(r4),4.(R0)    ; /62/
  746.     EMT    ^o375            ; /62/
  747.     tst    tsxsav            ; running under TSX?
  748.     beq    50$            ; no
  749.     mov    time.a(r4),tim.sf    ; load desired time
  750.     mov    #sftim    ,r0        ; load set file time emt args
  751.     emt    375            ; do it
  752. 50$:    tst    prot.a(r4)        ; protected?
  753.     beq    60$            ; nope..
  754. ; /62/    .fprot    #rtwork    ,#lun.at,#r50out,#1 ; ya, set the protection
  755.     MOV    #rtwork    ,R0        ; /62/ expanded to assemble under V4
  756.     MOV    #lun.at+<35.*^o400>,@R0    ; /62/ even though V4 can't run it
  757.     MOV    #r50out    ,2.(R0)        ; /62/
  758.     MOVB    #1    ,4.(R0)        ; /62/
  759.     EMT    ^o375            ; /62/
  760. 60$:    clr    r0            ; no errors
  761.  
  762. 70$:    mov    @r5    ,r4        ; restore pointer
  763.     asl    r4            ; word indexing
  764.     clr    bufp(r4)        ; buffer_pointer[lun] := 0
  765.     clr    sizof(r4)        ; no size please
  766.     call    clr.at            ; clean out just used attributes
  767.     save    <r0>            ; /62/ save error
  768.     .rctrlo                ; make sure TT output is on
  769.     unsave    <r0>            ; /62/ restore error
  770.     unsave    <r2,r4>            ; and exit with error in r0
  771.     return
  772.  
  773.  
  774.     .sbttl    Get next file to send    ; /63/ moved here from KRTPAK
  775.  
  776. ;    G E T N X T
  777. ;
  778. ;    input:    srcnam    = possibly wildcarded file name
  779. ;        index    = 0 if this is the first time through
  780. ;    output:    filnam    = next file to do
  781. ;         r0    = if <>, error code
  782.  
  783. getnxt::save    <r1>
  784.     calls    lookup    ,<#srcnam,#filnam> ; /62/
  785.     tst    r0            ; did it work?
  786.     beq    30$            ; yes
  787.     cmp    r0    ,#er$nmf    ; no more files matching name?
  788.     beq    10$            ; yes, we are all done then
  789.     cmp    r0    ,#er$fnf    ; how about file not found?
  790.     bne    20$            ; no, print the error message out
  791. 10$:    tst    index            ; ya, but did any files match yet?
  792.     bne    30$            ; yes, that's ok then
  793.     mov    #er$fnf    ,r0        ; no, convert er$nmf to er$fnf
  794. 20$:    mov    r0    ,-(sp)        ; save lookup error
  795.     calls    syserr    ,<r0,#errtxt>    ; get the error text
  796.     calls    error    ,<#3,#errtxt,#aspace,#filnam> ; /62/ include file name
  797.     .purge    #lun.sr            ; /62/ dump search channel
  798.     mov    (sp)+    ,r0        ; restore saved error code from lookup
  799. 30$:    unsave    <r1>
  800.     return
  801.  
  802.  
  803.     .sbttl    Get one character from a file
  804.  
  805. ;    G E T C
  806. ;
  807. ;    input:     (r5)    = channel number
  808. ;    output:      r1    = character just read
  809. ;          r0    = RMS error status
  810.  
  811. getc::    mov    @r5    ,r0        ; channel to use
  812.     .br    getcr0            ; /63/ dispatch to desired routine
  813.  
  814.  
  815.     .sbttl    Decide where to get the next character    ; /63/ was in KRTPAK
  816.  
  817. ;    G E T C R 0            ; /38/ 06-Nov-85 11:22:14 BDN
  818. ;    T G E T C R
  819. ;
  820. ;    Passed:      r0    = lun
  821. ;    Return:      r0    = if <>, error code (generally er$eof)
  822. ;          r1    = character just read
  823. ;
  824. ;    GETCR0  is  the lowest level entry point called in Kermit to
  825. ;    obtain the next character for a  send  function  (even  GETC
  826. ;    calls  it),  where  that  may  be a normal file transfer, or
  827. ;    a server extended response.  The main idea in altering it is
  828. ;    so   that   a   server   dispatch  routine  can  change  the
  829. ;    default  (get from a file)  to,  say,  get  from  an  .asciz
  830. ;    string   in   memory   or  switch  to  some  other  kind  of
  831. ;    get_next_character routine.  This requires that  the service
  832. ;    routine  insert  its  get_next_char routine address into the
  833. ;    global  GETCROUTINE  and  also  reset  it when the action is
  834. ;    complete (by use of the textsrc macro sans an argument).
  835.  
  836. getcr0::tst    getcroutine        ; /38/ is there a routine address set?
  837.     beq    fgetcr0            ; /63/ no, default to file reading
  838.     jmp    @getcroutine        ; /63/ goto currently defined routine
  839.  
  840. tgetcr::tst    tgetaddr        ; /38/ have we ever been initted?
  841.     beq    10$            ; /38/ no, return er$eof
  842.     clr    r1            ; /63/   avoid sign extension
  843.     bisb    @tgetaddr,r1        ; /63/ yes, get next character please
  844.     beq    10$            ; /38/ nothing is left to do
  845.     inc    tgetaddr        ; /38/ text_address++
  846.     clr    r0            ; /38/ return(no_error)
  847.     br    20$
  848. 10$:    mov    #er$eof    ,r0        ; /38/ return(end_of_file)
  849.     clr    getcroutine        ; /62/ reset to file reading please
  850. 20$:    return
  851.  
  852. fgetcr0:save    <r3>
  853. 10$:    mov    r0    ,r3        ; save the channel number please
  854.     call    .getc            ; get the next char please
  855.     tst    r0            ; did the read work?
  856.     bne    20$            ; no, exit
  857.     asl    r3            ; word indexing
  858.     cmp    filtyp(r3),#text    ; if file_type[lun] = text
  859.     bne    20$            ;  then
  860.     tstb    r1            ;   if char = null
  861.     bne    20$            ;    then try_again
  862.     asr    r3            ; get original channel back
  863.     mov    r3    ,r0        ; setup the correct call format
  864.     br    10$
  865. 20$:    unsave    <r3>
  866.     return
  867.  
  868. .getc:    save    <r2,r3>
  869.     mov    r0    ,r2        ; channel number please
  870.     mov    r0    ,r1        ; for the .readw please
  871.     asl    r2            ; word indexing
  872.     tst    bufs(r2)        ; anything in the buffer?
  873.     beq    10$            ; no, please load it
  874.     cmp    bufp(r2),#-1        ; need to initialize the buffer?
  875.     bne    40$            ; no
  876. 10$:    mov    bufsiz(r2),r3        ; we need buffer size in words
  877.     asr    r3            ; convert bytes to words
  878.     .readw    #rtwork,r1,buflst(r2),r3,blknum(r2)
  879.     bcs    50$            ; it failed, bye
  880.     inc    blknum(r2)        ; next time read the next block
  881.     clr    bufp(r2)        ; it worked, clear current pointer
  882.     asl    r0            ; convert words read to bytes
  883.     mov    r0    ,bufs(r2)    ; and save the record size
  884.  
  885. 20$:    add    #1    ,rdrate+4    ; /BBS/ extracted from K11E80.MAC
  886.     bcs    30$            ; overflowed
  887.     add    r0    ,rdrate+2    ; count the data
  888.     adc    rdrate+0        ; 32. bits worth
  889.     bcc    40$            ; continue if not overflowed
  890. 30$:    clr    rdrate+0        ; overflow, so reset
  891.     clr    rdrate+2
  892.     clr    rdrate+4
  893.     br    20$            ; and start over
  894.  
  895. 40$:    mov    buflst(r2),r3        ; get the address of the buffer
  896.     add    bufp(r2),r3        ; and point to the next character
  897.     clr    r1            ; to be returned in r1
  898.     bisb    @r3    ,r1        ; avoid byte sign extension
  899.     inc    bufp(r2)        ; bufp := succ(bufp)
  900.     dec    bufs(r2)        ; amount_left := pred(amount_left)
  901.     clr    r0            ; no errors please
  902.     br    60$
  903.  
  904. 50$:    movb    @#errbyt,r0        ; get the error code
  905.     asl    r0            ; word indexing
  906.     mov    reaerr(r0),r0        ; map it
  907. 60$:    unsave    <r3,r2>
  908.     return
  909.  
  910.  
  911.     .sbttl    Read a record from a sequential file
  912.  
  913. ;    G E T R E C
  914. ;
  915. ;    input:      (r5)    = address of user buffer
  916. ;         2(r5)    = channel number
  917. ;         4(r5)    = buffer length in bytes    ; /BBS/ added this..
  918. ;    output:       r1    = record size
  919. ;           r0    = RMS status
  920. ;
  921. ;    Read the next record from a disk file, up to 4(r5) bytes
  922. ;    in length.  GETREC assumes text (stream    ascii) file only.
  923.  
  924. getrec::save    <r2,r3,r4>
  925.     clr    r4            ; recordsize := 0
  926.     mov    @r5    ,r3        ; the recordbuffer address
  927.     mov    4(r5)    ,r2        ; the recordbuffer size
  928.     clr    r1            ; nothing read as of yet
  929.  
  930. 10$:    cmpb    r1    ,#ff        ; if char = form_feed
  931.     beq    20$            ; then exit, with it in the buffer
  932.     mov    2(r5)    ,r0        ; the channel number (lun) to use
  933.     call    getcr0            ; read the next character now
  934.     tst    r0            ; did it work?
  935.     bne    40$            ; no, reason why is in r0
  936.     cmpb    r1    ,#cr        ; if char = return
  937.     beq    20$            ; then exit
  938.     cmpb    r1    ,#'z&37        ; if char = ^Z
  939.     beq    20$            ; then exit
  940.     cmpb    r1    ,#lf        ; if a line feed
  941.     beq    10$            ; ignore it
  942.     inc    r4            ; length := succ(length)
  943.     movb    r1    ,(r3)+        ; yes, stuff the char in
  944.     sob    r2    ,10$        ; up until maxrec size
  945.     mov    #er$rtb    ,r0        ; error, record too big for buffer
  946.     br    40$
  947.  
  948. 20$:    cmpb    r1    ,#'z&37        ; record terminators come here
  949.     bne    30$            ; it's not ^Z
  950.     mov    #er$eof    ,r0        ; ^Z means end of file
  951.     clr    r1            ; say no data are there at all
  952.     br    40$
  953. 30$:    mov    r4    ,r1        ; return the record length
  954. 40$:    unsave    <r4,r3,r2>
  955.     return
  956.  
  957.  
  958.     .sbttl    Put a single character to a file
  959.  
  960. ;    P U T C
  961. ;
  962. ;    input:      (r5)    = character to put
  963. ;         2(r5)    = channel number to use
  964. ;
  965. ;    Buffer single character I/O to internal disk buffer or terminal.
  966. ;    Buffer is allocated by CREATE and dumped to disk when it becomes full.
  967.  
  968. putc::    save    <r1>            ; simply save r1 and call putcr0
  969.     mov    2(r5)    ,r1        ; putcr0 will be somewhat faster
  970.     clr    r0            ; to call directly due to the
  971.     bisb    @r5    ,r0        ; overhead involved in setting
  972.     call    putcr0            ; up an argument list
  973.     unsave    <r1>
  974.     return
  975.  
  976. putcr0::save    <r1,r2,r3,r4>        ; r0 = input_char, r1 = lun
  977.     mov    r1    ,r2        ; channel number
  978.     asl    r2            ; word indexing
  979.     cmp    bufp(r2),bufsiz(r2)    ; is the buffer full?
  980.     blo    50$            ; no, store this char in it
  981.     movb    r0    ,r3        ; yes, save a copy of the input char
  982.     mov    bufsiz(r2),r4        ; and setup for a .writw
  983.     asr    r4            ; RT-11 needs word not byte count
  984.     tst    r1            ; channel zero is always terminal
  985.     beq    10$            ; simple
  986.     cmp    filtyp(r2),#terminal    ; check for being a terminal today?
  987.     bne    20$            ; not a terminal
  988. 10$:    mov    buflst(r2),r0        ; a terminal, get start of buffer
  989.     add    bufsiz(r2),r0        ; point to next byte AFTER data
  990.     clrb    (r0)            ; null terminate for wrtall
  991.     wrtall    buflst(r2)        ; dump buffer to TT
  992.     br    30$            ; and reinit the buffer now
  993. 20$:    .writw    #rtwork,r1,buflst(r2),r4,blknum(r2) ; dump this block to disk
  994.     bcs    60$            ; it failed for some reason
  995. 30$:    inc    blknum(r2)        ; next time do next block
  996.     clr    bufp(r2)        ; pointer := 0
  997.     mov    buflst(r2),r4        ; it worked, zero the buffer now
  998.     mov    bufsiz(r2),r0        ; get the buffer address and size
  999. 40$:    clrb    (r4)+            ; for i := 1 to bufsiz
  1000.     sob    r0    ,40$        ;   do buffer[i] := char(0)
  1001.     movb    r3    ,r0        ; ok, now restore the old character
  1002. 50$:    mov    bufp(r2),r1        ; get the current buffer pointer
  1003.     add    buflst(r2),r1        ; and point to a new home for the
  1004.     movb    r0    ,@r1        ; the input character is in r0
  1005.     inc    bufp(r2)        ; pointer := succ(pointer)
  1006.     clr    r0            ; success
  1007.     br    70$
  1008.  
  1009. 60$:    movb    @#errbyt,r0        ; get the error code
  1010.     asl    r0            ; word indexing
  1011.     mov    wrierr(r0),r0        ; map it
  1012. 70$:    unsave    <r4,r3,r2,r1>
  1013.     return
  1014.  
  1015.  
  1016.     .sbttl    Put a record to a sequential file
  1017.  
  1018. ;    P U T R E C
  1019. ;
  1020. ;    input:      (r5)    = address of user buffer
  1021. ;         2(r5)    = record size
  1022. ;         4(r5)    = channel number
  1023. ;    output:       r0    = RMS error status
  1024. ;
  1025. ;    assumes:    the record written will have a CR/LF appended unless
  1026. ;            the file type is not text or if writing to a terminal
  1027.  
  1028. putrec::save    <r1,r2,r3>
  1029.     mov    2(r5)    ,r2        ; the size of the I/O
  1030.     mov    @r5    ,r3        ; the buffer address
  1031.     mov    4(r5)    ,r1        ; the channel number please
  1032.     bne    10$            ; it's a real disk file
  1033.  
  1034.     tst    r2            ; faking output to a terminal
  1035.     beq    40$            ; nothing to do
  1036.     mov    r3    ,r0        ; get start of buffer
  1037.     add    r2    ,r0        ; point to next byte AFTER data
  1038.     clrb    (r0)            ; null terminate for wrtall
  1039.     wrtall    r3            ; dump buffer to TT
  1040.     clr    r0            ; no error
  1041.     br    40$
  1042.  
  1043. 10$:    tst    r2            ; the size of the I/O to do
  1044.     beq    30$            ; nothing to do, add carriage control
  1045.  
  1046. 20$:    clr    r0            ; avoid sign extension
  1047.     bisb    (r3)+    ,r0        ; the character to write out
  1048.     call    putcr0            ; channel is passed in r1
  1049.     tst    r0            ; did the write fail?
  1050.     bne    40$            ; yes, exit asap
  1051.     sob    r2    ,20$        ; next char please
  1052.  
  1053. 30$:    asl    r1            ; word indexing
  1054.     cmp    filtyp(r1),#text    ; is this a text file?
  1055.     bne    40$            ; no, don't add carriage control in
  1056.     asr    r1            ; get the channel number back
  1057.     mov    #cr    ,r0        ; and tag with a newline
  1058.     call    putcr0            ; simple
  1059.     tst    r0            ; /62/ did the write fail?
  1060.     bne    40$            ; /62/ yes, exit asap
  1061.     mov    #lf    ,r0        ; and at last the line feed
  1062.     call    putcr0            ; /62/ error here falls thru anyway..
  1063. 40$:    unsave    <r3,r2,r1>
  1064.     return
  1065.  
  1066.  
  1067.     .sbttl    Suspend the mainline program    ; /62/ cleaned up..
  1068.  
  1069. suspen::save    <r2,r1>
  1070.     clr    r0            ; start with no error in case no wait
  1071.     mov    @r5    ,r1        ; sleep time in seconds
  1072.     beq    10$            ; nothing, must be fractional
  1073.     mul    clkflg    ,r1        ; don't forget 50Hz users..
  1074.     br    20$            ; ignore the fractional part
  1075. 10$:    mov    2(r5)    ,r1        ; sleep < 1 second?
  1076.     beq    60$            ; no wait, skip looping..
  1077. 20$:    mov    #1    ,-(sp)        ; wait just one tick per loop
  1078.     clr    -(sp)            ; clear hi word of wait time
  1079.     mov    sp    ,r2        ; point to it
  1080. 30$:    .twait    #rtwork,r2        ; do the wait one tick at a time..
  1081.     bcs    40$            ; (the wait failed)
  1082.     sob    r1    ,30$        ; ..^C can only abort between ticks!
  1083.     clr    r0            ; return success
  1084.     br    50$
  1085. 40$:    mov    #er$que    ,r0        ; only error possible
  1086. 50$:    cmp    (sp)+    ,(sp)+        ; pop twait time buffer
  1087. 60$:    unsave    <r1,r2>
  1088.     return
  1089.  
  1090.  
  1091.     .sbttl    Reset the keypad    ; /BBS/ added
  1092.  
  1093. kp.clr::wrtall    #kp.res            ; dump reset string to terminal
  1094.     return
  1095.  
  1096.  
  1097.     .sbttl    Logout
  1098.  
  1099. logout::tst    tsxsav            ; /45/ does this make sense?
  1100.     beq    exit            ; /BBS/ not really, so just exit
  1101.     mov    #510    ,r0        ; /45/ address of chain command
  1102.     mov    #4    ,(r0)+        ; /45/ number of bytes (inc. null)
  1103.     movb    #'B&137    ,(r0)+        ; /45/ then insert BYE
  1104.     movb    #'Y&137    ,(r0)+        ; /45/  ...
  1105.     movb    #'E&137    ,(r0)+        ; /45/   ...
  1106.     clrb    (r0)            ; /45/ make it .asciz please
  1107.     bis    #4000    ,@#jsw        ; /45/ pass to KMON
  1108.     clr    r0            ; /45/ must be zero
  1109.     .exit                ; /45/ try to logout on TSX+
  1110.  
  1111.  
  1112.     .sbttl    Exit to KMON
  1113.  
  1114. exit::    tst    sl.on            ; is SL on?
  1115.     beq    10$            ; no
  1116.     tst    sl.ked            ; ya, but is it in KED mode?
  1117.     beq    10$            ; no
  1118.     call    kp.clr            ; ya, reset the keypad
  1119. 10$:    mov    #cr    ,r0        ; return here to kill newline for
  1120.     call    writ1char        ; an unterminated line by hreset..
  1121.     .hreset                ; MUST DO to dump the comm handler
  1122.     clr    r0            ; do a hard .exit
  1123.     .exit                ; bye..
  1124.  
  1125.  
  1126.     .sbttl    Control C AST
  1127.  
  1128.     .save
  1129.     .psect    sccada    ,rw,d,lcl,rel,con
  1130. sccwork:.word    0 ,0            ; /51/ .scca work area
  1131. ccflag::.word    0            ; /51/ ^C flag
  1132. mkw:    .word    0 ,0 ,0 ,0        ; /51/ mark time work area
  1133. mktime:    .word    0 ,15.            ; /51/ check for ^C every 15 ticks
  1134. spcwork:.word    0 ,0            ; /51/ for the .spcps directive
  1135. spcarg:    .word    cmdloop ,0 ,0        ; /51/ where to alter flow
  1136.  
  1137.     .psect    sccain    ,ro,i,lcl,rel,con
  1138. setcc::    clr    ccflag            ; /51/ no ^C as of yet
  1139.     clr    cc$max            ; init what_to_do register
  1140.     .cmkt    #mkw    ,#40        ; /51/ clear previous mark time
  1141.     .scca    #sccwork,#ccflag    ; /51/ set the address for flag word
  1142.     .mrkt    #mkw,#mktime,#ccast,#40 ; /51/ schedule a checkup for ^C
  1143.     return
  1144.  
  1145. ccast:    tst    ccflag            ; /51/ was there a ^C typed?
  1146.     beq    20$            ; /62/ no, just reschedule
  1147.     clr    ccflag            ; /51/ clear the flag
  1148.     inc    cccnt            ; /51/ bump the global ^C count
  1149.     cmp    cccnt    ,cc$max        ; try to abort nicely first?
  1150.     bge    10$            ; no, bail out then..
  1151.     mov    #bell    ,r0        ; ya, load a bell
  1152.     emt    341            ; ring it, if possible..
  1153.     clc                ; ignore errors here and
  1154.     br    20$            ; go wait for program to abort
  1155.  
  1156. 10$:    .spcps    #spcwork,#spcarg    ; /51/ get RT-11 to jump to spcarg
  1157.     bcc    30$            ; /51/ success
  1158.     jmp    exit            ; failure
  1159. 20$:    .mrkt    #mkw,#mktime,#ccast,#40 ; /51/ reschedule ^C timed watch
  1160. 30$:    return
  1161.  
  1162.     .restore
  1163.  
  1164.  
  1165.     .sbttl    Main error handler    ; /BBS/ somewhat modified
  1166.  
  1167. ; /BBS/ moved this to the root, so it can be called from anywhere,
  1168. ;    as it is now the entire program's error handler.. 4-Jan-91
  1169.  
  1170. direr$::mov    r0    ,-(sp)        ; don't destroy r0
  1171.     mov    4(sp)    ,r0        ; recover error code
  1172.     beq    30$            ; error 0 is a nop
  1173.     calls    syserr    ,<r0,#errtxt>    ; get appropriate error message
  1174.     tst    cmdlun            ; indirect command file running?
  1175.     beq    10$            ; nope..
  1176.     mov    r0    ,tk.err        ; ya, flag and save the error
  1177.     br    30$            ; it will be dumped at readcmd
  1178. 10$:    tst    logini            ; need a newline?
  1179.     beq    20$            ; no
  1180.     .newline            ; ya
  1181. 20$:    wrtall    #errtxt            ; dump the err msg
  1182.     .newline
  1183.     clr    logini            ; now on a new line
  1184. 30$:    mov    (sp)+    ,r0        ; restore r0 to as when entering this
  1185.     mov    @sp    ,2(sp)        ; fix up the stack here, saving many
  1186.     tst    (sp)+            ; words by not doing this in the macro
  1187.     return
  1188.  
  1189.  
  1190.     .sbttl    Increment status    ; /BBS/ added this
  1191.  
  1192. ;    This kludge is provided because RT-11XM for some reason loses
  1193. ;    track of the status word's address, even when it's kept in the
  1194. ;    root, after calling c$dial results in a failed call four times.
  1195. ;    Then, it writes into RMON, trashing it and crashing everything.
  1196.  
  1197. ;    This is NOT any problem under TSX-Plus..   Billy Y.  24-Apr-91
  1198.  
  1199. incsts::inc    status
  1200.     return
  1201.  
  1202.     .end
  1203.