home *** CD-ROM | disk | FTP | other *** search
/ kermit.columbia.edu / kermit.columbia.edu.tar / kermit.columbia.edu / old / ckermit70 / cklxtr.cm < prev    next >
Text File  |  1997-04-07  |  1KB  |  44 lines
  1. &begin_parameters
  2.    SRC source:pathname,required
  3.    DST destination:pathname.pm,required
  4.    DBG switch(-debug),=0
  5. &end_parameters
  6. &if &DBG& &then &echo macro_lines input_lines command_lines
  7. &attach_input
  8. test_system_calls
  9. s$create_file &DST& -organization fixed -record_size 4096
  10. s$attach_port dest &DST& -no_hold_attach -no_hold_open
  11. s$open dest -organization fixed -max_size 4096 -io_type output
  12. create_buffer buffer -no_display
  13. set_buffer_length 1000
  14. &set buff_ndx 0
  15. &set src_rec_cnt 0
  16. &label read_loop
  17. &set src_rec_cnt &src_rec_cnt& + 1
  18. &set_string record (contents &SRC& &src_rec_cnt& -hold)
  19. &if (command_status) ^= 0 &then &goto done
  20. &if (end_of_file &SRC&) &then &goto done
  21. &if (substr &$record& 1 1) = 'Z' &then &goto do_null
  22. &set src_ndx 1
  23. &label data_loop
  24. set_buffer_longword (before (hexadecimal &buff_ndx&) 'x') &+
  25.   (substr &$record& &src_ndx& 8)
  26. &set buff_ndx &buff_ndx& + 4
  27. &set src_ndx &src_ndx& + 8
  28. &if &src_ndx& <= 64 &then &goto data_loop
  29. &goto rec_done
  30. &label do_null
  31. &set null_cnt 0(substr &$record& 2 2)x * 32
  32. fill_buffer (before (hexadecimal &buff_ndx&) 'x') &+
  33.   (before (hexadecimal &null_cnt&) 'x') 0
  34. &set buff_ndx &buff_ndx& + &null_cnt&
  35. &label rec_done
  36. &if &buff_ndx& < 4096 &then &goto read_loop
  37. s$seq_write dest
  38. &set buff_ndx 0
  39. &goto read_loop
  40. &label done
  41. s$close dest
  42. s$detach_port dest
  43. quit
  44.