home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / decpro300 / profil.mac < prev    next >
Text File  |  2020-01-01  |  47KB  |  1,641 lines

  1.     .TITLE    KERFIL - KERMIT - FILE PROCESSING
  2.     .SBTTL    David Stevens, Stuart Hecht, Robert McQueen
  3.  
  4. ;
  5. ; Kerfil is the file processing routine for Pro/Kermit
  6. ;
  7. ;   Created on July 14,1983
  8. ;
  9. ;   Written by Stuart Hecht and David Stevens
  10. ;
  11. ; Version 1
  12. ;
  13.  
  14.     .IDENT    /1.0.09/
  15.  
  16. ; Directives
  17.  
  18.     .LIBRARY /KERMLB/
  19.     .LIBRARY /LB:[1,5]RMSMAC/
  20.     .ENABLE    LC
  21.     .NLIST    BEX
  22.  
  23.     .SBTTL    Revision History
  24.  
  25. ;++
  26. ; 1.0.00    By: Many            On: Long time
  27. ;        Create this module.
  28. ;
  29. ; 1.0.01    By: Nick Bush            On: 15-Feb-1984
  30. ;        Fix FILE.OPEN to make sure it always returns an
  31. ;        error when NEXT.FILE fails.  KERMSG is not expecting
  32. ;        a "no more files" return from FILE.OPEN.
  33. ;
  34. ; 1.0.02    By: Robert C. McQueen        On: 16-Feb-1984
  35. ;        Add checks for exceeding the size of the output buffer
  36. ;        for ASCII mode files.
  37. ; 1.0.03    By: David Stevens        On: 21-Feb-1984
  38. ;        Make FILE.OPEN (send) usable in server mode,and have 
  39. ;        file.name contain the first file name before entering 
  40. ;        KERMSG.
  41. ;
  42. ; 1.0.04    By: Stuart Hecht        On: 06-Mar-1984
  43. ;        Change default device from 'LB:' to 'SY:' so that
  44. ;        PRO/Kermit can use a device other than the Library
  45. ;        default.  'SY:' uses the device from the default directory.
  46. ;
  47. ; 1.0.05    By: Robert C. McQueen        On: 6-March-1984
  48. ;        Restructure the sending of multiple files and use PJMPs when
  49. ;        possible.
  50. ;
  51. ; 1.0.06    By: Robert C. McQueen        On: 6-March-1984
  52. ;        Sending LSA files to the -10 do not work correctly.  The
  53. ;        problem is MOVBs extend the sign.  Rework some code to
  54. ;        not set the sign bit.
  55. ;
  56. ; 1.0.07    By: Robert C. McQueen        On: 14-March-1984
  57. ;        Redo the inter task communication between KERMIT and KERFIL.
  58. ;
  59. ; 1.0.08    By: Robert C. McQueen        On: 20-March-1984
  60. ;        Make M$RES global, so that we can use it from KERXFR.
  61. ;
  62. ; 1.0.09    By: Nick Bush            On: 21-May-1984
  63. ;        Initialize FILSTA when file is opened for reading.
  64. ;--
  65.  
  66.     .SBTTL    Kermit symbol definitions
  67. ;
  68. ; THe following will cause the Pro/Kermit symbol definitions to be include
  69. ; in this module.
  70. ;
  71.  
  72.     .MCALL    KERDEF            ; Get the macro
  73.     KERDEF                ; Cause the symbols to be defined
  74.  
  75.     .MCALL    CHRDEF            ; Character definition macro
  76.     CHRDEF                ; Define the special characters
  77.  
  78.     .MCALL    BITS            ; Bit definitions
  79.     BITS                ; Define bit definitions
  80.  
  81.     .MCALL    BLSRTN            ; Allow use of BLISS macros from
  82.     .MCALL    BLSCAL            ;   library
  83.     .MCALL    PJMP            ; Jump to subroutine that returns
  84.  
  85.     .SBTTL    RMS-11 Directives and macros
  86.  
  87. ;++
  88. ; RMS-11 directives and macros
  89. ;++
  90.  
  91. ;+
  92. ; RMS data strcutures
  93. ;-
  94.  
  95.     .MCALL    FAB$B            ; File attributes block
  96.     .MCALL    ORG$            ; Allowed organizations
  97.     .MCALL    NAM$B            ; Name block
  98.     .MCALL    RAB$B            ; Record attributes block
  99.  
  100. ;+
  101. ; RMS routines
  102. ;-
  103.  
  104.     .MCALL    $CLOSE            ; RMS routine to close a file
  105.     .MCALL    $CONNECT        ; RMS routine to connect RAB/FAB
  106.     .MCALL    $CREATE            ; Create a file
  107.     .MCALL    $DISCONNECT        ; RMS routine to disconnect RAB/FAB
  108.     .MCALL    $ERASE            ; RMS routine to delete a file
  109.     .MCALL    $GET            ; RMS routine to get a record
  110.     .MCALL    $OPEN            ; RMS routine to open a file
  111.     .MCALL    $PARSE            ; RMS routine to parse wildcards
  112.     .MCALL    $PUT            ; RMS routine to put a record
  113.     .MCALL    $READ            ; RMS routine to read a block
  114.     .MCALL    $SEARCH            ; RMS routine to search for a wild file
  115.     .MCALL    $WRITE            ; RMS routine to write a block
  116.  
  117. ;+
  118. ; RMS data structure access macros
  119. ;-
  120.  
  121.     .MCALL    $COMPARE
  122.     .MCALL    $FETCH
  123.     .MCALL    $OFF
  124.     .MCALL    $SET
  125.     .MCALL    $STORE
  126.     .MCALL    $TESTBITS
  127. ;
  128. ; RMS 11 data structure
  129. ;
  130.     ORG$    SEQ            ; $Open a sequential file
  131.  
  132.     .SBTTL    Symbol definitions -- File types
  133.  
  134. ;++
  135. ; The following are the various file types that are supported by
  136. ; Pro/Kermit.  These formats are used as offsets into tables to jump
  137. ; directly to the input routines associated with the various types.
  138. ;--
  139.  
  140. $TYCR    =0*2                ; Carriage return RAT
  141. $TYFTN    =1*2                ; Fortran RAT
  142. $TYPRN    =2*2                ; Printer file RAT
  143. $TYNONE    =3*2                ; No attribute file RAT
  144.  
  145.  
  146.  
  147.  
  148.     .SBTTL    Symbol definitions -- File reader states
  149.  
  150. ;++
  151. ; The file reader is a finite state machine.  It will dispatch to various
  152. ; states depending on the type of record attributes (RAT) are dealing with
  153. ; and what the position is in the record we are dealing with.
  154. ;--
  155.  
  156. $REPR1    =0*2                ; Record pre processing state 1
  157. $REPR2    =1*2                ; Record pre precessing state 2
  158. $RERD    =2*2                ; Record reading
  159. $REPS1    =3*2                ; Record post processing state 1
  160. $REPS2    =4*2                ; Record post prrocessing state 2
  161.  
  162. ; NOTE: *2 so that we can use directly into a dispatch table.
  163.  
  164.     .SBTTL    Data
  165.  
  166.     .PSECT    $OWN$,  D  
  167.  
  168. ;
  169. ; Data for Fab, Nam, & Rab blocks
  170. ;
  171.  
  172. RESSTR:    .BLKB    50.            ; Block for the resultant string.
  173. STRBUF:    .BLKB    128.            ; Expanded string buffer for search.
  174. DEFALT:    .ASCIZ    'SY:'            ;[04] System default.
  175. DEFALN    =.-DEFALT            ; Size of the default device.
  176.     .EVEN
  177.  
  178. ;++
  179. ; The following are used for reading character from the input file.
  180. ; These locations may be used by the print file, FORTRAN, or CRLF
  181. ; file record attribute routines.
  182. ;--
  183.  
  184. BYTCNT:    .BLKW    1            ; Holds the byte counter for send.
  185. BYTOFS:    .BLKW    1            ; Byte offset we are reading
  186. PRNCNT:    .BLKW    1            ; Count of the number of LFs to output
  187. PSTPRN:    .BLKW    1            ; Post print file byte
  188. CRFLG:    .BLKW    1            ; Must put CR on at end of record
  189. FILSTA:    .BLKW    1            ; Current state file reader is in
  190.  
  191. ;
  192. ; Locations needed for sending of the next file
  193. ;
  194.  
  195. SIZPOI:    .blkw    1            ; Pointer to size of next filename.
  196. FILPOI:    .blkw    1            ; Pointer to next filename.
  197.  
  198. ;
  199. ; Flag for Send/Receive
  200. ;
  201.  
  202. LSTFG:    .BLKW    1            ; Last file flag.
  203. FORMAT:    .BLKW    1            ; Format type for opened file.
  204. CRLF.FLG:
  205.     .BLKW    1            ; Carriage return line feed flag.
  206. M$POS:    .ASCIZ    <.CHCSI>/23;1H/<.CHLF><.CHLF><.CHCSI>/23;1H/
  207. M$RES::    .BYTE    .CHLF,.CHCR
  208.     .ASCII    'Please press RESUME to continue'
  209.     .BYTE    .CHCR,.CHNUL
  210.     .EVEN
  211.  
  212.     .SBTTL    FAB, NAM, and RAB blocks for send
  213.  
  214.     .PSECT    $PLIT$, RO, D
  215.  
  216. ; Pure copies of RMS blocks to be copied to impure data when needed
  217.  
  218. PURFAB:    FAB$B                ; Beginning of FAB block.
  219.     F$DNA    DEFALT            ; Address of default device.
  220.     F$DNS    DEFALN            ; Default length field.
  221.     F$NAM    NAMBLK            ; Chain to the NAM block
  222.     F$LCH    1            ; Use the logical channel 1.
  223.     FAB$E                ; End of FAB block.
  224. FABLEN=.-PURFAB
  225.     .EVEN
  226.  
  227. PURNAM:    NAM$B                ; Beginning of NAM block.
  228.     N$ESA    STRBUF            ; Address of the expanded string
  229.     N$ESS    128.            ;   buffer and its length.
  230.     N$RSA    RESSTR            ; Address of the resultant string
  231.     N$RSS    50.            ;   buffer and its length.
  232.     NAM$E                ; End of NAM block.
  233. NAMLEN=.-PURNAM
  234.     .EVEN
  235.  
  236. PURRAB:    RAB$B                ; Beginning of RAB block.
  237.     R$FAB    FILFAB            ; Chain to FAB block.
  238.     R$MBC    2            ; Size of the multiblock count.
  239.     R$RAC    RB$SEQ            ; Set the sequential access flag.
  240.     RAB$E                ; End RAB block.
  241. RABLEN=.-PURRAB
  242.  
  243.  
  244.     .PSECT    $OWN$, RW, D
  245. FILFAB::
  246.     FAB$B                ; Beginning of FAB block.
  247.     F$DNA    DEFALT            ; Address of default device.
  248.     F$DNS    DEFALN            ; Default length field.
  249.     F$NAM    NAMBLK            ; Chain to the NAM block
  250.     F$LCH    1            ; Use the logical channel 1.
  251.     FAB$E                ; End of FAB block.
  252.     .EVEN
  253.  
  254. NAMBLK::
  255.     NAM$B                ; Beginning of NAM block.
  256.     N$ESA    STRBUF            ; Address of the expanded string
  257.     N$ESS    128.            ;   buffer and its length.
  258.     N$RSA    RESSTR            ; Address of the resultant string
  259.     N$RSS    50.            ;   buffer and its length.
  260.     NAM$E                ; End of NAM block.
  261.     .EVEN
  262.  
  263. RABBLK::
  264.     RAB$B                ; Beginning of RAB block.
  265.     R$FAB    FILFAB            ; Chain to FAB block.
  266.     R$MBC    2            ; Size of the multiblock count.
  267.     R$RAC    RB$SEQ            ; Set the sequential access flag.
  268.     RAB$E                ; End RAB block.
  269.  
  270.  
  271.     .SBTTL    Send Routine
  272.  
  273. ;
  274. ; The send routine takes a file from your directory and sends
  275. ;   a copy of it to the host computer.
  276. ;
  277. ;        SUBROUTINES:
  278. ;            Open:    Routine to open up a file.
  279. ;
  280. ;    Send also updates the status board, by moving in information
  281. ;       relative to the transfer.
  282. ;
  283.  
  284.     .PSECT    $CODE$,  RO 
  285.  
  286. X$SEND::CLR    LSTFG            ; Initialize the pointer
  287.     CLR    SIZPOI            ; Reset size pointer.
  288.     CLR    FILPOI            ; Reset filename pointer.
  289.     JSR    PC,SETNUL        ; Call setnul subroutine.
  290.     JSR    PC,STARTRANS        ; Set initial parameters. . .
  291.  
  292. ;
  293. ; Put first file name into file.name.
  294. ;
  295. 4$:    JSR    PC,INFLNM        ; Copy the first file name
  296. ;
  297. ; Enter KERMSG.
  298. ;
  299.     JSR    PC,SEND.SWITCH        ; Go into Kermsg.
  300.     PJMP    DONETRANS        ; Finished with transaction and return
  301.  
  302.     .SBTTL    Receive
  303.  
  304. ;
  305. ; This routine receives a file from the host kermit.
  306. ;
  307. ;
  308.  
  309.     .PSECT    $CODE$,  RO 
  310.  
  311. X$RECV::JSR    PC,SWAPNM        ; Put input file into File.name.
  312.     JSR    PC,STARTRANS        ; Set initial parameters. . .
  313.     BLSCAL    REC.SWITCH        ; Call the message processing
  314.     JSR    PC,DONETRANS        ; Jump to trannsfer complete routine.
  315.     RTS    PC
  316.  
  317.     .sbttl    File Open Routine:  Send
  318.  
  319.  
  320. ; This routine Opens up a file for sending.
  321. ;    The register R1 is used as a general purpose register for the 
  322. ;    system calls.  A status check is made after opening to confirm a 
  323. ;    successful file opening.
  324. ;    INPUT:    The file name and the length of the filename.
  325. ;
  326. ;    OUTPUT:    The buffer containing the record.
  327. ;
  328. ;    REGISTERS:
  329. ;        R0 =>    Takes back a true or false value to Kermsg
  330. ;        R1 =>    Pointer to the currently used control block.
  331. ;        R2 =>    Register to carry value to clear buffer routine.
  332. ;
  333.  
  334.     .PSECT    $CODE$,  RO 
  335.  
  336. BLSRTN    FILE.OPEN,2,SNRCFG        ; Open a file routine.
  337. ;[03]
  338. ;[03] Initialize the RAV/FAB/NAM blocks for RMS from the prototypes
  339. ;[03]
  340.     BLSCAL    BL$MOV,<#FABLEN,#PURFAB,#FILFAB>,+ ;[03] Initialize the FAB
  341.     BLSCAL    BL$MOV,<#NAMLEN,#PURNAM,#NAMBLK>,+ ;[03] And the name block
  342.     BLSCAL    BL$MOV,<#RABLEN,#PURRAB,#RABBLK>,- ;[03] And the RAB
  343.  
  344.     CLR    BYTCNT            ; Clear the count of bytes read/writen
  345.     TST    SNRCFG(SP)        ; Are we sending?
  346.     BNE    RCVOPN            ; No, open for receiving
  347. ;
  348. ; Go to next.file routine and put parsed file name into file.name.
  349. ;
  350.     JSR    PC,PARSE        ; Parse the file specification
  351.     CMP    #KNORMAL,R0        ; Get a good return?
  352.     BNE    99$            ; Branch if not and return
  353. ;
  354. ; Now attempt to search for the first of the files
  355. ;
  356.     MOV    #FILFAB,R0        ; Get the FAB address
  357.     $SET    #FB$FID,FOP,R0        ; Set the wildcard flag
  358.     $SEARCH    #FILFAB            ; Search for this file
  359.     JSR    PC,SENCHK        ; Check for errors
  360.     CMP    #KNORMAL,R0        ; Get a good return?
  361.     BNE    99$            ; Branch if an error and return
  362.     CMP    #NOMORFILES,R0        ; No more files?
  363.     BNE    OP1            ; No, skip this
  364.     MOV    #ER$FNF,R0        ; Get the error code back
  365.     JSR    PC,RMSERR        ; Issue an RMS error
  366.     MOV    #RMS11,R0        ;[01] No, some type of error
  367. 99$:    RTS    PC            ; Return to caller, with error.
  368. ;
  369. ; Here if we can really open the file for processing
  370. ;
  371. OP1:    MOV    #$REPR1,FILSTA        ;[09] Start out in first prefix state
  372.     MOV    #FILFAB,R1        ; Put address of FAB into R1.
  373.     CMP    FILFLG,#MODBLK        ; Are we in block transfer mode.
  374.     BNE    5$            ; No, skip
  375. ;
  376. ; Set up for block reads
  377. ;
  378.     $SET    #FB$REA,FAC,R1        ; Otherwise set the block read in FAB.
  379. ;
  380. ; Now prepare to open the file.
  381. ;
  382. 5$:    $SET    #FB$FID,FOP,R1        ; Set up for wild card transfer.
  383.     $STORE    FILE.SIZE,FNS,R1    ; Store filename size in the FAB.
  384.     $STORE    #FILE.NAME,FNA,R1    ; Store filename in the FAB.
  385.     $OPEN    #FILFAB            ; Open up file specified in the FAB.
  386.     JSR    PC,SENCHK        ; Jump to status check routine.
  387.     CMP    #KNORMAL,R0        ; Did we get a good returned value ?
  388.     BEQ    6$            ; Yes, branch to continue.
  389.     RTS    PC            ; Return with error.
  390. ;
  391. ; If here we wish to have the file name cut up as determined by the
  392. ;  fil.narmal.form field.
  393. ;
  394. 6$:    JSR    PC,FIXNAM        ; Fix name to desired fashion.
  395.     CMP    #KNORMAL,R0        ; Did we get a good returned value ?
  396.     BEQ    7$            ; Yes, branch to continue.
  397.     RTS    PC            ; Return to caller with error.
  398. ;
  399. ; If here then we didn't get any screwy error in fixnam.
  400. ;
  401. 7$:    CMP    FILFLG,#MODBLK        ; Are we in block mode ?
  402.     BEQ    30$            ; Yes, branch.
  403.     CMP    FILFLG,#MODFIX        ; Are we in fixed mode ?
  404.     BEQ    30$            ; Yes, branch.
  405. ;
  406. ; Here if we have an ASCII or BINARY file.  Determine which of the file 
  407. ;  processing routines are to be used.  Store the converted RAT into FORMAT
  408. ;
  409.     MOV    #$TYNONE,FORMAT        ; Assume NO ATTRIBUTE file
  410.     MOV    #FILFAB,R1        ; Store address of FAB in R1.
  411.     $FETCH    R0,RAT,R1        ; Get the record attributes
  412.     BIC    R0,#FB$BLK        ; Clear the block bit
  413. ;
  414. ; Assume we have a NO ATTRIBUTE file, and check to see if right
  415. ;
  416.     CMP    R0,#FB$PRN        ; Print file?
  417.     BNE    10$            ; No, skip this
  418.     MOV    #$TYPRN,FORMAT        ; Yes, set the print file format
  419.     BR    30$            ; And skip other code
  420. ;
  421. ; Wasn't a PRINT file, so check FORTRAN
  422. ;
  423. 10$:    CMP    R0,#FB$FTN        ; Fortran file?
  424.     BNE    20$            ; No, skip this
  425.     MOV    #$TYFTN,FORMAT        ; Yes, store the new format
  426.     BR    30$            ; Branch.
  427. ;
  428. ; Wasn't a fortran file, so check CRLF
  429. ;
  430. 20$:    CMP    R0,#FB$CR        ; Carriage return line feed file ?
  431.     BNE    30$            ; No, branch.
  432.     MOV    #$TYCR,FORMAT        ; Yes, set offset into FORMAT.
  433. ;
  434. ; We now have the format type, display the file name, and connect to the
  435. ;  file.
  436. ;
  437. 30$:    PJMP    CONOPN            ; Connect to the file and return
  438.  
  439.     .SBTTL File Open Routine:  Receive
  440.  
  441. ;
  442. ; Receive open creates the file that the remote Kermit is sending.
  443. ; If it can not create the file or connect to it it returns a false 
  444. ;    value to Kermsg.  Before creating the file though it makes sure 
  445. ;    that the file name and type is compatible with the P/OS system
  446. ;    by fixing the name to nine characters at most, and the type being
  447. ;    three characters long.
  448.  
  449.     .PSECT    $CODE$,  RO 
  450.  
  451. RCVOPN:    MOV    #FILFAB,R1        ; Put address of Filfab into R1.
  452.     $STORE    #FILE.NAME,FNA,R1    ; Store the file name in the Fab.
  453.     $STORE    FILE.SIZE,FNS,R1    ; Store the name length in the Fab.
  454.  
  455.     $STORE    #FB$VAR,RFM,R1        ; Variable length records
  456.  
  457. ;
  458. ; Check to see if we are receiving an ascii file
  459. ;
  460.     CMP    FILFLG,#MODASC        ; Are we receiving an ascii file.
  461.     BNE    21$            ; No, then skip.
  462.     $SET    #FB$CR,RAT,R1        ; Set the record handling mask.
  463. ;
  464. ; Check to see if we are receiving a block file
  465. ;
  466.  
  467. 21$:    CMP    FILFLG,#MODBLK        ; Are we recieving a block file.
  468.     BNE    22$            ; No, skip.
  469.     $SET    #FB$WRT,FAC,R1        ; Otherwise set the block write in FAB.
  470.     $STORE    #FB$VAR,RFM,R1        ; Fixed size records
  471.     $STORE    #8192.,MRS,R1        ; 8192 bytes per record
  472. ;
  473. ; See if we are doing a fixed length file.
  474. ;
  475.  
  476. 22$:    CMP    FILFLG,#MODFIX        ; Are we receiving in fixed mode ?
  477.     BNE    25$            ; No, branch.
  478.     $STORE    #FB$FIX,RFM,R1        ; Set for fixed length records.
  479.     $STORE    #512.,MRS,R1        ; 512 bytes per record
  480. ;
  481. ; Create the file by the specifications given in the FAB
  482. ;
  483.  
  484. 25$:    $CREATE    #FILFAB            ; Create the new file.
  485.     JSR    PC,SENCHK        ; Check the status return.
  486.     CMP    #KNORMAL,R0        ; Did we get a true return ?
  487.     BEQ    30$            ; Yes, branch to connect to the file.
  488.     RTS    PC            ; Return with error.
  489. ;
  490. ; If here then we must connect to the file
  491. ;
  492. 30$:    PJMP    CONOPN            ; Connect to the file and return
  493.  
  494.     .SBTTL File Open Routine:  Connect
  495.  
  496. ;
  497. ; Conect connects to the open file, it does not care whether it was
  498. ;    opened by send open or receive open.  Conect will return a false
  499. ;    value if it was unable to open the file.
  500.  
  501.     .PSECT    $CODE$,  RO 
  502.  
  503. CONOPN:    MOV    #RABBLK,R1        ; Put address of RAB into R1.
  504.     $STORE    #DSKBUF,UBF,R1        ; Put address of user buffer in RAB.
  505.     $STORE    #1400.,USZ,R1        ; Put size of user buffer into RAB.
  506.     $SET    #RB$SEQ,RAC,R1        ; Load RAC field of RAB.
  507.     $CONNECT #RABBLK        ; Connect to record.
  508.     PJMP    SENCHK            ; Check status and return
  509.  
  510.     .SBTTL    Next file routine
  511.  
  512. ;
  513. ; This routine sets you up for the next file to be sent.
  514. ;
  515. ;    INPUT:    The block containing the file names, or a
  516. ;           string to search for.
  517. ;
  518. ;    OUTPUT:    The next file to transfer or a return 
  519. ;           indicating no more files.
  520. ;
  521. ;    REGISTERS: { The old values in the registers are saved }
  522. ;        R0 =>    Takes back a true or false value to Kermsg
  523. ;        R1 =>    Holds the address of the Rab.
  524. ;
  525.  
  526.     .PSECT    $CODE$,  RO 
  527.  
  528. BLSRTN    NEXT.FILE,2,
  529.     MOV    #KNORMAL,R0        ; Assume this will work
  530.  
  531. ; Search for parsed string
  532.  
  533. 10$:    MOV    #FILFAB,R1        ; Put address of FAB into R1.
  534.     $SET    #FB$FID,FOP,R1        ; Set wildcard flag in FAB.
  535.     $SEARCH    #FILFAB            ; Search for the file specified.
  536.     JSR    PC,SENCHK        ; Check for an error in the parsing.
  537.     CMP    #KNORMAL,R0        ; Did we get a true return ?
  538.     BEQ    20$            ; Yes, then branch.
  539.     CMP    #NOMORFILES,R0        ; No more files for this wild card?
  540.     BNE    99$            ; Return if another type of error
  541. ;
  542. ; See if there is another file on the list of files to process.
  543. ;
  544.     CMP    LSTFG,NOCHOS        ; See if it matches the number 
  545.     BNE    15$            ;   chosen, if so then branch.
  546.     MOV    #NOMORFILES,R0        ; Put error message into R0.
  547.     RTS    PC            ; Return to calling routine.
  548. ;
  549. ; Move the file specification to FILE.NAME and set up to process it
  550. ;
  551.  
  552. 15$:    JSR    PC,INFLNM        ; Go to increment file, & size routine.
  553. ;
  554. ; When we get here we may have an unparsed string.  If we do then
  555. ;  parse it.  Then search for the file until we have no more then 
  556. ;  return the error NOMORFILES to kermsg.
  557. ;
  558.  
  559.     JSR    PC,PARSE        ; Parse for the search.
  560.     CMP    #KNORMAL,R0        ; Did we get a successful return.
  561.     BNE    99$            ; No, return to caller with error.
  562.     BR    10$            ; Loop for all files
  563. ;
  564. ; If here then we still have files.
  565. ;
  566. 20$:    MOV    #NAMBLK,R1        ; Put address of block into R1
  567.     $FETCH    FILE.SIZE,RSL,R1    ; Get the length of the name.
  568. ;
  569. ; Open the file for reading now and then return to the caller
  570. ;
  571.     JSR    PC,OP1            ; Open the file.
  572. 99$:    RTS    PC            ; Return to caller.
  573.  
  574.     .SBTTL Get File Routine
  575.  
  576. ;
  577. ; This routine gets a record out of the open file, and then gets 
  578. ;   characters out of the record.
  579. ;
  580. ;    INPUT:    The currently open file,
  581. ;        flag indicating an empty record,
  582. ;        and where to put the character.
  583. ;
  584. ;    OUTPUT:    A character stored in the location 
  585. ;        specified by Kermsg.
  586. ;
  587. ;    REGISTERS:    { The old values are saved }
  588. ;        R0 =>    Takes back a true or false value to Kermsg
  589. ;        R1 =>    Holds the address of the Rab
  590. ;
  591.  
  592.     .PSECT    $CODE$,  RO 
  593.  
  594. BLSRTN    GET.FILE,3,<CHRADR>
  595.  
  596.     CMP    FILFLG,#MODBLK        ; Are we transfering a block file ?
  597.     BEQ    5$            ; Yes we are, branch.
  598.     CMP    FILFLG,#MODFIX        ; Are we transfering in fixed mode ?
  599.     BNE    20$            ; No, branch
  600.  
  601. ; If we get here then we are transfering in block or fixed mode.
  602.  
  603. 5$:    TST    BYTCNT            ; Do we need to get a buffer ?
  604.     BNE    10$            ; No we do not, branch.
  605.     JSR    PC,GETBUF        ; Jump to the get-buffer routine.
  606.     CMP    #KNORMAL,R0        ; Did we successfully get the buffer ?
  607.     BNE    99$            ; No, return with the error
  608.  
  609. ; We successfully got a buffer of data.
  610.  
  611. 10$:    JSR    PC,GETCHR        ; Get a character from the buffer.
  612.     MOVB    R1,@CHRADR(SP)        ; Put that char. into the address 
  613.     MOV    #KNORMAL,R0        ;  specified, set up for a normal
  614.     RTS    PC            ;   return, and return to caller.
  615. ;
  616. ; If we get here then we are transfering in either ascii or binary mode.
  617. ;
  618. 20$:    MOV    FORMAT,R0        ; Put offset into R0.
  619.     JSR    PC,@RATDSP(R0)        ; Jump to the specified routine.
  620.     CMP    #KNORMAL,R0        ; Did we get a successfull return ?
  621.     BNE    99$            ; No, branch.
  622.     MOVB    R1,@CHRADR(SP)        ; Put that char. into the address 
  623. 99$:    RTS    PC            ;   return, and return to caller.
  624.  
  625. ;
  626. ; Record attributes dispatch table.
  627. ;
  628.  
  629.     .PSECT    $PLIT$,    RO,  D
  630.  
  631. RATDSP:    .WORD    CRLF            ; Dispatch to the input
  632.     .WORD    FORTRAN            ; Dispatch to the FORTRAN input
  633.     .WORD    PRINT            ; Dispatch to the print file input
  634.     .WORD    NONE            ; Dispatch to no attribute routine.
  635.  
  636.     .sbttl Suport routines - GET.FILE - GETBUF - Get a buffer
  637. ;++
  638. ; This routine will read the next buffer from the input file.  It will
  639. ; return with the status in R0 to determine if it failed or succeeded.
  640. ;
  641. ; Usage:
  642. ;    JSR    PC,GETBUF
  643. ;    (Return)
  644. ;
  645. ; On return:
  646. ;    R0/ Kermit error code
  647. ;
  648. ;--
  649.  
  650.  
  651.     .PSECT    $CODE$,  RO 
  652.  
  653. GETBUF:    MOV    #RABBLK,R1        ; Put address of RAB into R1.
  654.     CMP    FILFLG,#MODBLK        ; Are we transfering in block ?
  655.     BEQ    10$            ; Yes we are, branch.
  656.  
  657. ; If we are here then we want to do a $get.
  658.  
  659.     $GET    #RABBLK            ; Get the buffer of data.
  660.     BR    20$            ; Branch to common code.
  661.  
  662. ; If we are here then we want to do a $read.
  663.  
  664. 10$:    $STORE    #512.,USZ,R1        ; Put size of user buffer into RAB.
  665.     $READ    #RABBLK            ; Read in the buffer of data.
  666.  
  667. ; The following code is used for both types of files.
  668.  
  669. 20$:    JSR    PC,SENCHK        ; Check for RMS-11 error.
  670.     $FETCH    BYTCNT,RSZ,R1        ; Get the byte-count from the RSZ field
  671.     CLR    BYTOFS            ; Reset the byte-offset
  672.     RTS    PC            ; Return to caller.
  673.  
  674.     .sbttl    Support routine - GET.FILE - Getchr
  675. ;++
  676. ; Getchr will return a value in R1. If there are no more words in
  677. ;  the buffer it will return a -1, if there are still bytes to be
  678. ;  transfered then it will put the next byte into R1.  The bytcnt
  679. ;  is a counter that is zero when all the bytes of the current record 
  680. ;  have been transfered.  The bytofs points to the byte to be
  681. ;  transfered and is incramented before returning to the caller.
  682. ;--
  683.  
  684.     .PSECT    $CODE$,  RO 
  685.  
  686. GETCHR:    TST    BYTCNT            ; Is the byte-count zero ?
  687.     BNE    10$            ; No, we still have characters, branch.
  688.     MOV    #-1,R1            ; Put a -1 into R1.
  689.     RTS    PC            ; Return to caller.
  690. ;
  691. ; If here then we still have characters to get.
  692. ;
  693. 10$:    MOV    BYTOFS,R0        ; Put byte-pointer into R0.
  694.     CLR    R1            ; Clear the register
  695.     BISB    DSKBUF(R0),R1        ; Mov the character into R1.
  696.     DEC    BYTCNT            ; Decrament the byte-count.
  697.     INC    BYTOFS            ; Move forward the byte-pointer.
  698.     RTS    PC            ; Return to caller.
  699.  
  700.  
  701.  
  702.  
  703.  
  704.  
  705. ;++
  706. ; This routine is called whenever one of the routines called by get.file
  707. ;  return an error that is not RMS related.
  708. ;  It returns to the message processor an internal error code that will
  709. ;  shut down the file transfer.
  710. ;--
  711.  
  712. INTERR:    MOV    #INTERNALERR,R0        ; Put code for an internal error into
  713.     RTS    PC            ;   R0, and return to caller.
  714.  
  715.     .SBTTL    Support routine - GET.FILE - CRLF file
  716.  
  717. ;++
  718. ; This routine is called to read a character from a normal file.
  719. ; This will return the character to be sent in R1 and the status of
  720. ; the fetch in R0.
  721. ;
  722. ; Usage:
  723. ;    JSR    PC,CRLF
  724. ;    (Return)
  725. ;
  726. ; On return:
  727. ;    R0/ Status (Kermit error status)
  728. ;    R1/ Character
  729. ;
  730. ;--
  731.  
  732.     .PSECT    $CODE$,    RO
  733.  
  734. CRLF:    MOV    FILSTA,R0        ; Get the file reader state
  735.     JMP    @CRDSP(R0)        ; Dispatch to the correct routine
  736.  
  737. ;++
  738. ; Pre processing state one
  739. ;--
  740. CRPR1:    JSR    PC,GETBUF        ; Get a record.
  741.     CMP    #KNORMAL,R0        ; Get it ok?
  742.     BEQ    10$            ; Yes, branch.
  743.     RTS    PC            ; Return to caller.
  744. ;
  745. ; Now just change state to record reading.
  746. ;
  747. 10$:    MOV    #$RERD,FILSTA        ; Change file state to read.
  748.     BR    CRLF            ; Branch back.
  749.  
  750. ;++
  751. ; Pre processing state two -- Internal error
  752. ;--
  753. CRPR2=    INTERR                ; Internal error
  754.  
  755. ;++
  756. ; Record processing state - Return the record character to the caller
  757. ;--
  758. CRREC:    JSR    PC,GETCHR        ; Get a character
  759.     TST    R1            ; Fail?
  760.     BGE    310$            ; No, got a character - branch
  761.     MOV    #$REPS1,FILSTA        ; Change to post processing state->1.
  762.     BR    CRLF            ; Try again from the top
  763.  
  764. 310$:    MOV    #KNORMAL,R0        ; Return a good error code
  765.     RTS    PC            ; Return to the caller
  766.  
  767.  
  768. ;++
  769. ; First post processing state - Just append the CR to the information sent
  770. ;--
  771. CRPS1:    MOVB    #.CHCR,R1        ; Store the carriage return
  772.     MOV    #$REPS2,FILSTA        ; Change to the preprocessing routine
  773.     MOV    #KNORMAL,R0        ; Return normal
  774.     RTS    PC            ; And return
  775.  
  776. ;++
  777. ; Post processing state 2 return a line-feed.
  778. ;--
  779. CRPS2:    MOVB    #.CHLF,R1        ; Store a line feed in R1.
  780.     MOV    #$REPR1,FILSTA        ; Change state to pre pros 1.
  781.     MOV    #KNORMAL,R0        ; Set up normal return.
  782.     RTS    PC            ; Return to caller.
  783. ;++
  784. ; The following is the dispatch table for the various states that we can be
  785. ; in reading the records.
  786. ;--
  787.  
  788.     .PSECT    $PLIT$,    RO, D
  789. CRDSP:    .WORD    CRPR1            ; Preprocessing state one
  790.     .WORD    CRPR2            ; Preprocessing state two
  791.     .WORD    CRREC            ; Record processing
  792.     .WORD    CRPS1            ; Postprocessing state one
  793.     .WORD    CRPS2            ; Postprocessing satte two
  794.  
  795.     .SBTTL    Support routine - GET.FILE - PRINT file
  796.  
  797. ;++
  798. ; This routine will read character for a file with the PRN record attributes.
  799. ; It will return the characters to the caller in R1 and the status in R0.
  800. ;
  801. ; Usage:
  802. ;    JSR    PC,PRINT
  803. ;    (Return)
  804. ;
  805. ; On return:
  806. ;    R0/ Kermit status
  807. ;    R1/ Character
  808. ;
  809. ;--
  810.  
  811.     .PSECT    $CODE$,    RO
  812.  
  813. PRINT:    MOV    FILSTA,R0        ; Get the file state
  814.     JMP    @PRNDSP(R0)        ; Dispatch to the correct routine
  815.  
  816. ;++
  817. ; Preprocessing state one.  This will read the print file carriage control
  818. ; information and change to state two to return the characters
  819. ;--
  820. PRNPR1:    JSR    PC,GETBUF        ; Get the next record
  821.     CMP    #KNORMAL,R0        ; Did we get it ok?
  822.     BEQ    110$            ; Branch if we did
  823.     RTS    PC            ; No, just pass back the error
  824. ;
  825. ;  If here then we got no rms error.
  826. ;
  827. 110$:    JSR    PC,GETCHR        ; Get the first character of the record
  828.     TST    R1            ; Did we get anything?
  829.     BLT    PRINT            ; Try again if not
  830.     MOV    R1,R2            ; Move to a safer place
  831.     JSR    PC,GETCHR        ; Get the second byte
  832.     TST    R1            ; Is this one really here?
  833.     BLT    PRINT            ; No, try again, broken file
  834.     MOV    R1,PSTPRN        ; Store for later
  835.     BIC    #B7,R2            ; Is this clear
  836.     BEQ    120$            ; No, must be a character to output
  837.     MOV    R2,PRNCNT        ; Store as the count
  838.     MOV    #$REPR2,FILSTA        ; Set the new state
  839.     BR    PRINT            ; Try again
  840.  
  841. ;
  842. ; Here if we have a character that must be output.
  843. ; First try for a control character to be output
  844. ;
  845. 120$:    MOV    #$RERD,FILSTA        ; Change state
  846.     BIC    #B6,R2            ; Is bit six on?
  847.     BNE    130$            ; Branch if it was off
  848.     BIC    #B5,R2            ; Was bit 5 on?
  849.     BEQ    PRINT            ; Yes, reserved code try again
  850.     ADD    #128.,R2        ; Offset to the correct place
  851. 130$:    MOV    R2,R1            ; Copy to the right place
  852.     MOV    #KNORMAL,R0        ; Give a good return
  853.     RTS    PC            ; Return to the caller
  854.  
  855. ;++
  856. ; Preprocessing state two.  This will return the lead in characters for the
  857. ; record.  After this state is finished it will change to the record processing
  858. ; state.
  859. ;--
  860. PRNPR2:    TST    PRNCNT            ; Finished with the LFs?
  861.     BEQ    210$            ; Branch if so
  862.     MOVB    #.CHLF,R1        ; Return a LF
  863.     MOV    #KNORMAL,R0        ; And a good return
  864.     RTS    PC            ; Return to the caller
  865. ;
  866. ; Here if finished with the LFs.  Just return a CR now and change the state
  867. ; reading the record
  868. ;
  869. 210$:    MOV    #$RERD,FILSTA        ; Now reading the record
  870.     MOVB    #.CHCR,R1        ; Return the CR
  871.     MOV    #KNORMAL,R0        ; Return the code
  872.     RTS    PC            ; Return to the caller
  873.  
  874. ;++
  875. ; Record processing state - This will return characters to the calling routine.
  876. ; from the record.  When the characters are finished it will change to first
  877. ; post processing state.
  878. ;--
  879. PRNREC:    JSR    PC,GETCHR        ; Get a byte from the record
  880.     TST    R1            ; End of record?
  881.     BGE    310$            ; Branch if not
  882.     MOV    #$REPS1,FILSTA        ; Yes, set the post processing state
  883.     BR    PRINT            ; And try from the top
  884. ;
  885. ; If here then we want to return the character.
  886. ;
  887. 310$:    MOV    #KNORMAL,R0        ; Give a normal return
  888.     RTS    PC            ; And return to the caller
  889.  
  890.  
  891. ;++
  892. ; Postprocessing state one.  This will determine what type of carriage control
  893. ; must be placed on the end of the record.  After it has determined the
  894. ; type it will dispatch to either the preprocessing or the other postprocessing
  895. ; routine.
  896. ;--
  897. PRNPS1:    MOV    PSTPRN,R2        ; Get the postfix character
  898.     BIC    #B7,R2            ; Is this clear
  899.     BEQ    410$            ; No, must be a character to output
  900.     MOV    R2,PRNCNT        ; Store as the count
  901.     MOV    #$REPR2,FILSTA        ; Set the new state
  902.     BR    PRINT            ; Try again
  903. ;
  904. ; Here if we have a character that must be output.
  905. ; First try for a control character to be output
  906. ;
  907. 410$:    MOV    #$RERD,FILSTA        ; Change state
  908.     BIC    #B6,R2            ; Is bit six on?
  909.     BNE    420$            ; Branch if it was off
  910.     BIC    #B5,R2            ; Was bit 5 on?
  911.     BEQ    PRINT            ; Yes, reserved code try again
  912.     ADD    #128.,R2        ; Offset to the correct place
  913. 420$:    MOV    R2,R1            ; Copy to the right place
  914.     MOV    #KNORMAL,R0        ; Give a good return
  915.     RTS    PC            ; Return to the caller
  916.  
  917. ;++
  918. ; Postprocessing state two.  This routine will return the characters that are
  919. ; to be output after the record.  It will change to the first preprocessing 
  920. ; routine after it has finished the returning of the characters.
  921. ;--
  922. PRNPS2:    TST    PRNCNT            ; Finished with the LFs?
  923.     BEQ    510$            ; Branch if so
  924.     MOVB    #.CHLF,R1        ; Return a LF
  925.     MOV    #KNORMAL,R0        ; And a good return
  926.     RTS    PC            ; Return to the caller
  927. ;
  928. ; Here if finished with the LFs.  Just return a CR now and change the state
  929. ; reading the record
  930. ;
  931. 510$:    MOV    #$REPR1,FILSTA        ; Now reading the record
  932.     MOVB    #.CHCR,R1        ; Return the CR
  933.     MOV    #KNORMAL,R0        ; Return the code
  934.     RTS    PC            ; Return to the caller
  935.  
  936. ;++
  937. ; Print file dispatch table.
  938. ;--
  939.  
  940.     .PSECT    $PLIT$,    RO, D
  941.  
  942. PRNDSP:    .WORD    PRNPR1            ; First preprocessing routine
  943.     .WORD    PRNPR2            ; Second preprocessing routine
  944.     .WORD    PRNREC            ; Record processing routine
  945.     .WORD    PRNPS1            ; First postprocessing routine
  946.     .WORD    PRNPS2            ; Second postprocessing rouine
  947.  
  948.     .sbttl    Support routine - GET.FILE - FORTRAN file
  949.  
  950. ;++
  951. ; This routine is called to read a character from a FORTRAN file.  The 
  952. ; file contains the leading character followed by the record.  The leading
  953. ; character must be converted to a normal ASCII character for processing.
  954. ;
  955. ; Usage:
  956. ;    JSR    PC,FORTRAN
  957. ;    (Return)
  958. ;
  959. ; On return:
  960. ;    R0/ Status
  961. ;    R1/ Character if any
  962. ;--
  963.  
  964.     .PSECT    $CODE$,  RO 
  965.  
  966. FORTRAN:MOV    FILSTA,R0        ; Get the current state
  967.     JMP    @FTNDSP(R0)        ; Dispatch to the correct routine
  968.  
  969. ;++
  970. ; Pre processing routine 1.
  971. ;--
  972. FTNPR1:    MOV    #TRUE,CRFLG        ; Set the flag
  973.     JSR    PC,GETBUF        ; Get the next record
  974.     CMP    #KNORMAL,R0        ; Did we get it ok?
  975.     BEQ    110$            ; Branch if we did
  976.     RTS    PC            ; No, just pass back the error
  977. ;
  978. ;  If here then we got no rms error.
  979. ;
  980. 110$:    JSR    PC,GETCHR        ; Get the first character of the record
  981.     TST    R1            ; Is this the end of line already?
  982.     BGE    120$            ; No, Check the first character
  983.     BR    FORTRAN            ; Try again from the top
  984. ;
  985. ;  If we get here then we want to check the first byte.
  986. ;
  987. ;
  988. ; Check for "null" format type.
  989. ;
  990. 120$:    TST    R1            ; Is this a null byte?
  991.     BNE    130$            ; No, check for other characters
  992.     CLR    CRFLG            ; Yes, clear output a CR flag.
  993. 125$:    MOV    #$RERD,FILSTA        ; Set new state to read the record
  994.     BR    FORTRAN            ; And try again from the top
  995. ;
  996. ; Check for "0" format type.
  997. ;
  998. 130$:    CMPB    DSKBUF,#'0        ; Is this a "0"?
  999.     BNE    140$            ; Branch if not
  1000.     MOV    #$REPR2,FILSTA        ; Set to preprocessing state-> 2.
  1001.     BR    170$            ; Join common code to return LF
  1002.  
  1003. ;
  1004. ; Check for  "1" format type.
  1005. ;
  1006. 140$:    CMPB    DSKBUF,#'1        ; Is this a "1"?
  1007.     BNE    150$            ; Branch if not
  1008.     MOVB    #.CHFF,R1        ; It is, so return FF <record> CR
  1009.     MOV    #$RERD,FILSTA        ; Set state to read the record next
  1010.     RTS    PC            ; Return to the caller
  1011. ;
  1012. ; Check for "+" format type.
  1013. ;
  1014. 150$:    CMPB    DSKBUF,#'+        ; Is this a "+"?
  1015.     BNE    160$            ; Branch if not
  1016.     BR    125$            ; Join the common code
  1017. ;
  1018. ; Check for "$" format type.
  1019. ;
  1020. 160$:    CMPB    DSKBUF,#'$        ; Is this a "$"?
  1021.     BNE    170$            ; Branch if not
  1022.     CLR    CRFLG            ; Clear flag noting CR needed
  1023. ;
  1024. ; All other characters default to this.
  1025. ;
  1026. 170$:    MOVB    #.CHLF,R1        ; Return a LF
  1027.     MOV    #$RERD,FILSTA        ; Set the new state
  1028.     RTS    PC            ; Return to the caller
  1029.  
  1030. ;++
  1031. ; Pre-processing routine 2.
  1032. ;__
  1033. FTNPR2=    170$                ; Same, just return LF and change
  1034.                     ; states
  1035.  
  1036. ;++
  1037. ; Record reading routine.
  1038. ;--
  1039. FTNREC:    JSR    PC,GETCHR        ; Get a byte from the record
  1040.     TST    R1            ; End of record?
  1041.     BGE    310$            ; Branch if not
  1042.     MOV    #$REPS1,FILSTA        ; Yes, set the post processing state
  1043.     BR    FORTRAN            ; And try from the top
  1044. ;
  1045. ; If here then we want to return the character.
  1046. ;
  1047. 310$:    MOV    #KNORMAL,R0        ; Give a normal return
  1048.     RTS    PC            ; And return to the caller
  1049.  
  1050.  
  1051. ;++
  1052. ; Post processing routine 1.
  1053. ;--
  1054. FTNPS1:    MOV    #$REPR1,FILSTA        ; Set the to preprocessing routine
  1055.     TST    CRFLG            ; Need to output the CR?
  1056.     BEQ    FORTRAN            ; Branch if not
  1057.     MOVB    #.CHCR,R1        ; Return the CR
  1058.     MOV    #KNORMAL,R0        ; Give a normal return
  1059.     RTS    PC            ; Return to the caller
  1060.  
  1061. ;++
  1062. ; Post processing routine 2.  INTERNAL ERROR if we get here
  1063. ;--
  1064. FTNPS2=    INTERR
  1065.  
  1066.  
  1067. ;++
  1068. ; The following is the FORTRAN dispatch table.  This table is used to
  1069. ; dispatch to the correct routine depending on the state of the character
  1070. ; reader.
  1071. ;--
  1072.  
  1073.     .PSECT    $PLIT$,    RO,  D
  1074.  
  1075. FTNDSP:    .WORD    FTNPR1            ; Pre processing state 1
  1076.     .WORD    FTNPR2            ; Pre processing state 2
  1077.     .WORD    FTNREC            ; Record processing state
  1078.     .WORD    FTNPS1            ; Post processing state 1
  1079.     .WORD    FTNPS2            ; Post processing state 2
  1080.  
  1081.     .SBTTL    Support routine - GET.FILE - No attribute file
  1082. ;++
  1083. ; This file processing mode is used when the file to be sent has no
  1084. ;  record attributes.  It will get a buffer when the bytecount is zero
  1085. ;  and transfer over every byte in the record.
  1086. ;
  1087. ;
  1088. ; Usage:
  1089. ;    JSR    PC,@RATDSP(R0)
  1090. ;        (return) 
  1091. ;        (R0 must have the offset value)
  1092. ;
  1093. ;--
  1094.  
  1095.     .PSECT    $CODE$,  RO 
  1096.  
  1097. NONE:    TST    BYTCNT            ; Is the byte-count zero ?
  1098.     BNE    10$            ; No, go get characters.
  1099.     JSR    PC,GETBUF        ; Yes, go get a buffer.
  1100.     CMP    #KNORMAL,R0        ; Did we get a normal return ?
  1101.     BNE    99$            ; No, return with error.
  1102. ;
  1103. ; If here then we want to get characters.
  1104. ;
  1105. 10$:    JSR    PC,GETCHR        ; Go get a character.
  1106.     MOV    #KNORMAL,R0        ; Set up normal return.
  1107. 99$:    RTS    PC            ; Return to caller.
  1108.  
  1109.     .SBTTL    Bliss interface -- PUT.FILE - Write a character
  1110.  
  1111. ;++
  1112. ; This routine will write a character into the output file.  It will then
  1113. ; return to the calling routine.
  1114. ;
  1115. ; Usage:
  1116. ; BLISS:
  1117. ;    Status = PUT.FILE(.CHARACTER);
  1118. ;
  1119. ;--
  1120.  
  1121.     .PSECT    $CODE$,  RO 
  1122.  
  1123. BLSRTN    PUT.FILE,2,<CHARACTER>
  1124.     MOV    CHARACTER(SP),R1    ; Get the character
  1125. ;
  1126. ; First determine the type of output we are doing.
  1127. ;
  1128.     CMP    FILFLG,#MODBLK        ; Are we doing block mode?
  1129.     BNE    10$            ; No, skip this
  1130.     JSR    PC,PUTCHR        ; Output the character
  1131.     CMP    #512.,BYTCNT        ; Buffer full now?
  1132.     BNE    30$            ; No, just give a good return
  1133.     BR    40$            ; Yes, dump the buffer and get out
  1134. ;
  1135. ; Here if we are not processing a Block file.
  1136. ;
  1137. 10$:    CMP    FILFLG,#MODASC        ; Doing an ASCII file?
  1138.     BNE    35$            ; No, just output the byte
  1139. ;
  1140. ; Here if we are doing an ASCII file, must check for end of record
  1141. ; characters
  1142. ;
  1143.     CMPB    #.CHCRT,R1        ; Is this a carriage return.
  1144.     BNE    15$            ; No, branch.
  1145.     MOV    #TRUE,CRLF.FLG        ; Set on the flag.
  1146.     BR    30$            ; Branch.
  1147. ;
  1148. ; Here if it wasn't a <CR>.
  1149. ;
  1150. 15$:    TST    CRLF.FLG        ; Is the carraige return flag set ?
  1151.     BEQ    20$            ; No, branch.
  1152. ;
  1153. ; Here if a carriage return was the previous character.
  1154. ;
  1155.     CMPB    #.CHLFD,R1        ; Is this a line feed?
  1156.     BEQ    40$            ; Yes, branch.
  1157. ;
  1158. ; Here if we got a carriage return and no line feed.
  1159. ;
  1160.     CMP    #512.,BYTCNT        ;[02] Buffer full now?
  1161.     BEQ    98$            ;[02] Return record too big error
  1162.     MOV    R1,-(SP)        ; Save the current byte.
  1163.     MOVB    #.CHCRT,R1        ; Put a <CR> in R1.
  1164.     JSR    PC,PUTCHR        ; Put it into the buffer.
  1165.     MOV    (SP)+,R1        ; Restore the current byte
  1166.     CLR    CRLF.FLG        ; Reset the flag.
  1167.  
  1168. ;
  1169. ; Here to just store the byte and return to the caller
  1170. ;
  1171. 20$:    CMP    #512.,BYTCNT        ;[02] Buffer full now?
  1172.     BEQ    98$            ;[02] Return record too bit
  1173.     JSR    PC,PUTCHR        ; Output the character
  1174. 30$:    MOV    #KNORMAL,R0        ; Give a normal return
  1175.     RTS    PC            ; Return to the caller
  1176. ;
  1177. ; Here if you are playing with a BINARY or FIXED file.  Put in the character
  1178. ;   if your buffer has 512. bytes in it dump it else return.
  1179. ;
  1180. 35$:    JSR    PC,PUTCHR        ; Output the character.
  1181.     CMP    #512.,BYTCNT        ; Do we have 510 characters ?
  1182.     BEQ    40$            ; Yes, branch to dump the file.
  1183.     MOV    #KNORMAL,R0        ; Give a normal return.
  1184.     RTS    PC            ; Return to caller.
  1185. ;
  1186. ; Here to dump the buffer and return to the caller
  1187. ;
  1188. 40$:    JSR    PC,BUFDMP        ; Output the buffer
  1189.     CLR    CRLF.FLG        ; Reset the flag.
  1190.     RTS    PC            ; Return to the caller
  1191. ;[02]
  1192. ;[02] Here when the record is filled and we must dump the buffer.
  1193. ;[02]
  1194. 98$:    MOV    #REC.TOO.BIG,R0        ;[02] Store the error code
  1195.     RTS    PC            ;[02] Return to the caller
  1196.  
  1197.     .SBTTL    Support -- BUFDMP - Dump the current buffers
  1198.  
  1199. ;++
  1200. ; This routine will dump what is in the current buffers.  It will then return
  1201. ; to the caller.  First checks will be done to determine if there is anything
  1202. ; to dump in the first place.
  1203. ;
  1204. ; Usage:
  1205. ;
  1206. ;    JSR    PC,BUFDMP        ; Output the buffer
  1207. ;    (Return)
  1208. ;
  1209. ; Returns with:
  1210. ;    R0/ Error code if any
  1211. ;--
  1212.  
  1213.     .PSECT    $CODE$,  RO 
  1214.  
  1215. BUFDMP:    MOV    #RABBLK,R1        ; Put address of RAB into R1.
  1216.     $STORE    #DSKBUF,RBF,R1        ; Store address of record buffer.
  1217.     CMP    FILFLG,#MODBLK        ; Block mode?
  1218.     BEQ    10$            ; Yes, output the full block
  1219. ;
  1220. ; Here to write a record for an ASCII file or a block mode file
  1221. ;
  1222.     MOV    BYTCNT,R0        ; Get byte count
  1223.     CMP    FILFLG,#MODFIX        ; Fixed length records?
  1224.     BNE    5$            ; No, go store length
  1225.     MOV    #512.,R0        ; Yes, get length
  1226. 5$:    $STORE    R0,RSZ,R1        ; Put its size into the RAB.
  1227.     $PUT    #RABBLK            ; Output the record
  1228.     BR    20$            ; Finish up
  1229. ;
  1230. ; Here to write a dump mode block to the disk
  1231. ;
  1232. 10$:    $STORE    #512.,RSZ,R1        ; Store the block size
  1233.     $WRITE    #RABBLK            ; Write out the buffer into the file.
  1234. ;
  1235. ; Determine if we got any errors.  If so pass them back to the calling routine
  1236. ; Also inform the remote if it is something bad.
  1237. ;
  1238. 20$:    JSR    PC,SENCHK        ; Check for any errors.
  1239.     CLR    BYTCNT            ; Clear the byte count
  1240.     RTS    PC            ; Return to caller.
  1241.  
  1242.     .SBTTL    Support -- PUTCHR - Put a character into the output buffer
  1243.  
  1244. ;++
  1245. ; This routine will store a byte into the output buffer that is being built.
  1246. ; It will then return to the caller after the byte count and the character
  1247. ; has been stored.
  1248. ;
  1249. ; Usage:
  1250. ;    MOV    #Character,R1
  1251. ;    JSR    PC,PUTCHR
  1252. ;    (Return)
  1253. ;
  1254. ; On return:
  1255. ;    Character stored.
  1256. ;
  1257. ;--
  1258.  
  1259.     .PSECT    $CODE$,  RO 
  1260.  
  1261. PUTCHR:    MOV    BYTCNT,R0        ; Put byte count into R2.
  1262.     MOVB    R1,DSKBUF(R0)        ; Move the character into the byte at 
  1263.     INC    BYTCNT            ;    R2, and increment the byte pointer
  1264.     RTS    PC
  1265.  
  1266.     .SBTTL File closing routine
  1267.  
  1268. ;++
  1269. ; This routine will close the file for KERMSG.  It assumes that the file has
  1270. ; been opened (KERMSG will insure this).  The routine may or may not delete
  1271. ; the file depending on the value of the argument.
  1272. ;
  1273. ; Usage BLISS:
  1274. ;
  1275. ;    Status = FILE_CLOSE (Flag);
  1276. ;
  1277. ;--
  1278.  
  1279.     .PSECT    $CODE$,  RO 
  1280.  
  1281. BLSRTN    FILE.CLOSE,2,<DELFLG>        ; Close file routine.
  1282.     TST    BYTCNT            ; Get the byte count
  1283.     BEQ    10$            ; Skip if nothing in the buffer
  1284.     JSR    PC,BUFDMP        ; Dump anything in the buffers
  1285. ;
  1286. ; Disconnect the file from processing
  1287. ;
  1288.  
  1289. 10$:    MOV    #RABBLK,R1        ; Put address of RAB into R1.
  1290.     $DISCONNECT #RABBLK        ; Disconnect from file.
  1291. ;
  1292. ; Close the open file
  1293. ;
  1294.     MOV    #FILFAB,R1        ; Put address of FAB into R1
  1295.     $OFF    #FB$REA,FAC,R1        ; Turn off fac field in FAB.
  1296.     $OFF    #FB$WRT,FAC,R1        ; Turn off fac field in FAB.
  1297.     $CLOSE    #FILFAB            ; Close the file specified in the FAB.
  1298. ;
  1299. ; See if we wish to close with delete
  1300. ;
  1301.     BIT    DELFLG(SP),#TRUE    ; Do we want to close with delete ?
  1302.     BEQ    90$            ; No, we do not so branch.
  1303.     MOV    #FILFAB,R1        ; Put address of FAB into R1.
  1304.     $TESTBITS #FB$FID,FOP,R1    ; Open by file-id?
  1305.     BNE    90$            ; Yes, we don't really want to delete it
  1306.     $ERASE    R1            ; Delete the file
  1307. 90$:    MOV    #KNORMAL,R0        ; Set up success code in R0.
  1308.     RTS    PC            ; Return to Kermsg.
  1309.  
  1310.     .sbttl    Parser for File.open
  1311.  
  1312. ;
  1313. ; Parse the filename for wildcard searches
  1314. ;
  1315. ;    INPUT:    The name string located in file.n
  1316. ;          and its length in file.s.
  1317. ;
  1318. ;    OUTPUT:    The fields required by $Search are initialized
  1319. ;           and a match string is build.
  1320. ;
  1321. ;    REGISTERS:
  1322. ;        R1 =>    Pointer to the FAB block.
  1323. ;
  1324.  
  1325.     .PSECT    $CODE$,  RO 
  1326.  
  1327. PARSE:    BLSCAL    BL$MOV,<#FABLEN,#PURFAB,#FILFAB> ; Initialize the FAB
  1328.     BLSCAL    BL$MOV,<#NAMLEN,#PURNAM,#NAMBLK> ; And the name block
  1329.     BLSCAL    BL$MOV,<#RABLEN,#PURRAB,#RABBLK> ; And the RAB
  1330.  
  1331.     MOV    #FILFAB,R1        ; Put address of FAB into R1.
  1332.     $STORE    FILE.SIZE,FNS,R1    ; Store filename size in the FAB.
  1333.     $STORE    #FILE.NAME,FNA,R1    ; Store filename in the FAB.
  1334.     $SET    #FB$FID,FOP,R1        ; Set flag in Fop field of FILFAB.
  1335.     $PARSE    #FILFAB            ; Parse the file string.
  1336.     PJMP    SENCHK            ; Check for errors and return to caller
  1337.  
  1338.     .SBTTL    Startup routine for file transfers
  1339.  
  1340.     .PSECT    $CODE$,  RO 
  1341.  
  1342. STARTRANS::
  1343.     JSR    PC,INIKEY        ; Initialize key routines
  1344.     JSR    PC,XK.INT        ; Initialize the XK port
  1345. ;** PUT ERROR CHECK IN HERE **
  1346.     RTS    PC            ; Return to sender
  1347.  
  1348.     .sbttl    Reset routine when file transfer is complete
  1349.  
  1350.     .PSECT    $CODE$,  RO 
  1351.  
  1352. DONETRANS:
  1353.     BLSCAL    TT.TEXT,#M$POS,+    ; Position the cursor
  1354.     MOV    #SUCC$L,R1        ; Get the successful message and length
  1355.     MOV    #M$SUCC,R2        ;
  1356.     BIT    #TRUE,R0        ; See if transfer was successful
  1357.     BNE    DONEOK            ; If OK then branch
  1358.     MOV    #ABOR$L,R1        ; Bad transfer so get the aborted
  1359.     MOV    #M$ABOR,R2        ;  message and length
  1360. DONEOK:    JSR    PC,KILKEY        ; Kill off any pending QIO
  1361.  
  1362.     BLSCAL    TT.TEXT,R2,+        ; Ouput the correct transfer done
  1363.     BLSCAL    TT.TEXT,#M$RES,+    ;  messages
  1364.     BLSCAL    TT.OUTPUT,,-        ;
  1365.  
  1366.     BIT    #TRUE,NOSCRN        ; Check to see if we are watching
  1367.     BNE    99$            ;   transfer, If not then branch
  1368.     CALL    WTRES            ; Do a regular wait for resume
  1369. 20$:    JSR    PC,S$RXFR        ; Reset screen transfer info
  1370. 99$:    JSR    PC,XK.SHT        ; Close the XK port and reset parms
  1371.     RTS    PC            ; Return to caller
  1372.  
  1373.     .sbttl    Name Fixing Routine for $Search
  1374.  
  1375. ;
  1376. ; This routine fixes the name string built by search by removing old
  1377. ;   characters that were left from the previous file name.
  1378. ;
  1379. ;    INPUT:    The size of the new file name
  1380. ;          and pointer to the bytes of the name.
  1381. ;
  1382. ;    OUTPUT:    The file name written as specified by the
  1383. ;           fil.normal.form flag.
  1384. ;
  1385. ;    REGISTERS:    { No registers are permanently smashed }
  1386. ;
  1387. ;        R0 =>    Holds the address of the file.name block.
  1388. ;        R1 =>    Holds the address of the resultant string block.
  1389. ;        R2 =>    Holds the counter for the length of the new
  1390. ;               file name.
  1391. ;
  1392.  
  1393.     .PSECT    $CODE$,  RO 
  1394.  
  1395. FIXNAM:    JSR    R1,$SAVE3        ; Save registers one thru three.
  1396. ;
  1397. ; Set up R2 as the counter, put the address of the file name into R3,
  1398. ;  put the address of the resultant string into R1.  
  1399. ; Decide if we wish to remove any thing off the dame build by the resultant
  1400. ;  string.
  1401. ;
  1402.     MOV    FILE.SIZE,R2        ; Set up R2 to contain the max length.
  1403.     MOV    #FILE.NAME,R3        ; Put the destination into R3.
  1404.     MOV    #RESSTR,R1        ; Put address of source into R1.
  1405.     CMP    FIL.NORMAL.FORM,#FNM.FULL  ; Do we want anything cut off ?
  1406.     BNE    10$            ; Yes we do, branch.
  1407. ;
  1408. ; If here then we want the entire name used.
  1409. ;
  1410. 5$:    MOVB    (R1)+,(R3)+        ; Move the string.
  1411.     BEQ    99$            ; Branch if the moved byte was a null.
  1412.     SOB    R2,5$            ; Subtract one and branch if not zero.
  1413.     BR    30$            ; Branch due to error.
  1414. ;
  1415. ; If here then we want only the " NAME.EXT", or "NAME.EXT;ver"
  1416. ;
  1417. 10$:    CMPB    (R1)+,#']        ; Incrament the pointer until the byte
  1418.     BNE    10$            ;   pointed to is a "]".
  1419.  
  1420. ;
  1421. ; When here it means we are at the beginning of the name.
  1422. ;
  1423. 20$:    CMP    FIL.NORMAL.FORM,#FNM.UNTRAN ; Want to keep version number?
  1424.     BEQ    25$            ; Yes, skip check
  1425.  
  1426.     CMPB    (R1),#';        ; Is the next byte a ";".
  1427.     BEQ    99$            ; Yes, branch we don't want version #'s
  1428.  
  1429. 25$:    MOVB    (R1)+,(R3)+        ; Move in the file-name and extension.
  1430.     BEQ    99$            ; Return if done
  1431.     SOB    R2,20$            ; Sub one and branch if result isn't 0.
  1432. ;
  1433. ; If we are here then there is a problem, return an internal error code 
  1434. ;  to the calling routine.
  1435. ;
  1436. 30$:    MOV    #INTERR,R0        ; Return error code in R0.
  1437.     RTS    PC            ; Return to caller.
  1438. ;
  1439. ; When here it means  the name is moved into the file.name field, put its
  1440. ; length into file.size.  Then restore the smashed registers.
  1441. ;
  1442. 99$:    SUB    R2,FILE.SIZE        ; Find size of string, put it in file.s
  1443.     MOV    #KNORMAL,R0        ; Set up normal return.
  1444.     RTS    PC            ; Return to caller.
  1445.  
  1446.     .sbttl    Set Null Routines
  1447.  
  1448.  
  1449. ; Sets a null after the end of each file name in file.n.
  1450. ;
  1451. ;    INPUT:
  1452. ;        The only input required is the buffer address,
  1453. ;          and the offset.
  1454. ;
  1455. ;    OUTPUT:
  1456. ;        The output is the old buffer with the nulls inserted.
  1457. ;
  1458. ;    REGISTERS:
  1459. ;        R2 =>    Carries down the offset value.
  1460. ;        R3 =>    Brings down the address of the buffer.
  1461.  
  1462.     .PSECT    $CODE$,  RO 
  1463.  
  1464. SETNUL:
  1465.     JSR    R1,$SAVE3        ; Save registers one thru three.
  1466.     MOV    NOCHOS,R1        ; Get the number choosen
  1467.     MOV    #FSIZE,R2        ; Put the address of the lengths in R2.
  1468.     MOV    #FILES,R3        ; Put address of buffer into R3.
  1469. ;
  1470. ; At this point you wish to move to the end of the file name pointed to 
  1471. ;  by R3 and set a null byte after it.
  1472. ;
  1473. 10$:    ADD    (R2),R3            ; Add contents of R2 to the address
  1474.                     ;   located in R3.
  1475.     MOVB    #.CHNUL,(R3)        ; Set a null byte.
  1476. ;
  1477. ; At this point you want to move on to the next file name.  To do that you
  1478. ;  must go back to the beginning of the current file name, and then incrament
  1479. ;  to the next file name. Then you incrament the pointer in R2 to point to 
  1480. ;  the length of this new file name.
  1481. ;
  1482.     SUB    (R2),R3            ; Subtract the value at R2 from R5.
  1483.     ADD    #50.,R3            ; Add 50 to whats at R3.
  1484.     ADD    #2,R2            ; Increment to the next size.
  1485.     SOB    R1,10$            ; Loop for all files choosen
  1486. ;
  1487. ; When we get here we have set a null byte after each file name
  1488. ;
  1489.     RTS    PC            ; Return to caller.
  1490.  
  1491.     .SBTTL     Increment to Next File Routine
  1492.  
  1493. ;++
  1494. ; This routine sets up for the next file to be transfered by
  1495. ;  moving the file name to front of the buffer, and the length
  1496. ;  of the name to the beginning of its block.
  1497. ;
  1498. ;    INPUT:    File.n contains the filename to be moved, filpoi
  1499. ;          contains the pointer to the file name.
  1500. ;        File.s contains the file name length to be moved,
  1501. ;          sizpoi contains the pointer to that length.
  1502. ;
  1503. ;    OUTPUT:    Name of the next file is at beginning of File.n, and
  1504. ;          the corresponding length is in the beginning of its
  1505. ;          block.
  1506. ;
  1507. ;    REGISTERS:
  1508. ;        R2 =>    Holds address of old locations.
  1509. ;        R1 =>    Holds address of target location.
  1510. ;
  1511.  
  1512.     .PSECT    $CODE$,  RO 
  1513.  
  1514. INFLNM:    JSR    R1,$SAVE2        ; Save R1 to R2.
  1515. ;
  1516. ; This part will move the file size of the current file from fsize to
  1517. ;  file.size.
  1518. ;
  1519.     MOV    #FSIZE,R2        ; Put address of size into R2.
  1520.     ADD    SIZPOI,R2        ; Move pointer in R2
  1521.     MOV    (R2),FILE.SIZE        ; Move size of current filname into 
  1522.                     ;   file.s location.
  1523. ;
  1524. ; Here we initialize the pointer to point at the current file.
  1525. ;
  1526.     MOV    #FILES,R2        ; Put address of source into R2.
  1527.     ADD    FILPOI,R2        ; Move pointer in R2.
  1528.     MOV    #FILE.NAME,R1        ; Put address of destination into R1.
  1529. ;
  1530. ; This loop will move the file from files to file.name, exiting the loop 
  1531. ;  when it moves over a null byte.
  1532. ;
  1533. 80$:    MOVB    (R2),(R1)+        ; Move the byte in R2 into R1.
  1534.     TSTB    (R2)+            ; Was the source byte a "null" ?
  1535.     BNE    80$            ; No , continue the loop.
  1536. ;
  1537. ; When we get here we want to set the pointers for the next file, then
  1538. ;  return to the calling routine.
  1539. ;
  1540.     ADD    #2,SIZPOI        ; Add 2 to filename size pointer.
  1541.     ADD    #50.,FILPOI        ; Add 50 to filename pointer.
  1542.     INC    LSTFG            ; Increment the last file flag.
  1543.     RTS    PC            ; Yes, return to caller.
  1544.  
  1545.     .SBTTL    Swap Name Routine
  1546.  
  1547. ; This routine moves the name from a source buffer to
  1548. ;    a destination buffer
  1549. ;
  1550. ;    INPUT:    The file name in the source buffer.
  1551. ;
  1552. ;    OUTPUT:    The file name in the destination buffer.
  1553. ;
  1554. ;    REGISTERS:
  1555. ;        R1 =>    Counter of the length of the name
  1556. ;        R2 =>    Holds address of source buffer
  1557. ;        R3 =>    holds address of destination buffer
  1558. ;
  1559. ;    SWAPNM - Requires no input, moves data from rcvbuf to file.name.
  1560. ;
  1561.  
  1562.     .PSECT    $CODE$,  RO 
  1563.  
  1564. SWAPNM:    MOV    #RCVBUF,R2        ; Put address of source buffer into R2.
  1565.     MOV    #FILE.NAME,R3        ; Put address of destination into R5.
  1566.     CLR    FILE.SIZE        ; Clear the counter.
  1567. ;
  1568. ; This loop does the file movement.  It will exit the loop if it moves 
  1569. ;  either an escape or a null.  Until then it moves the contents of the
  1570. ;  source file in R2 into file.name.
  1571. ;
  1572. 10$:    CMPB    (R2),#.CHESC        ; Is the byte an escape ?
  1573.     BEQ    99$            ; Yes then we are done.
  1574.     MOVB    (R2)+,(R3)+        ; Move byte from source to destination.
  1575.     BEQ    99$            ; Leave the routine if null
  1576.     INC    FILE.SIZE        ; Increment R1.
  1577.     BR    10$            ; Branch back.
  1578. ;
  1579. ; Return to the caller
  1580. ;
  1581. 99$:    RTS    PC            ; Return to caller.
  1582.  
  1583.     .SBTTL    Status Error Check
  1584.  
  1585. ;
  1586. ; Senchk checks the status return of the RMS calls.
  1587. ;
  1588. ;  It first checks to see if it was successful,and
  1589. ;    then if unsuccessful it sees if the error was
  1590. ;    due to an EOF.
  1591. ;
  1592. ;    REGISTERS:
  1593. ;        R1 =>    pointer to either RAB block or FAB block.
  1594. ;
  1595.  
  1596.     .PSECT    $CODE$,  RO 
  1597.  
  1598. SENCHK:    $FETCH    R0,STS,R1        ; Get the status and put it in R0.
  1599.     TST    R0            ; Test the status code for success.
  1600.     BMI    20$            ; If negative then branch.
  1601.     MOV    #KNORMAL,R0        ; Set up a successful return code.
  1602.     RTS    PC            ; Return to caller
  1603.  
  1604. ;++
  1605. ; If here the we are checking for errors
  1606. ;--
  1607.  
  1608. ;
  1609. ; Check for end of file
  1610. ;
  1611. 20$:    CMP    #ER$EOF,R0        ; Check for EOF
  1612.     BNE    40$            ; If no then skip.
  1613.     MOV    #EOF,R0            ; Set up false return flag
  1614.     RTS    PC            ; Return to caller
  1615. ;
  1616. ; If here check for no more files
  1617. ;
  1618. 40$:    CMP    #ER$NMF,R0        ; Is error due to no more files.
  1619.     BNE    50$            ; If no then branch.
  1620.     MOV    #NOMORFILES,R0        ; Set up false return flag.
  1621.     RTS    PC            ; Return to caller
  1622. ;
  1623. ; If here check for record to big
  1624. ;
  1625. 50$:    CMP    #ER$RTB,R0        ; Was the record too big ?
  1626.     BNE    60$            ; No branch.
  1627.     MOV    #REC.TOO.BIG.,R0    ; Set up false return
  1628.     RTS    PC            ; Return to the caller
  1629. ;
  1630. ; If here call error routine and return an RMS error
  1631. ;
  1632. 60$:    JSR    PC,RMSERR        ; Jump to error output routine.
  1633.     MOV    #RMS11,R0        ; Set up false retrn flag.
  1634.     RTS    PC            ; Return to calling routine.
  1635.  
  1636.     .SBTTL    End of KERFIL.MAC
  1637.  
  1638.     .END
  1639.