home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / ncr9800 / vkncrlio.ncr < prev    next >
Text File  |  2020-01-01  |  8KB  |  246 lines
  1. 000010?? TITLE := 'VKNCRLIO - NCRL I/O FOR OBJECT FILES' ??
  2. 000020module vkncrlio;
  3. 000030 "
  4.        /**********************************************************************
  5.         *                                                                     *
  6.         * IVS / MCS-Kermit REL 2                                              *
  7.         * source code                                                         *
  8.         *                                                                     *
  9.         * Change History:                                                     *
  10.         *                                                                     *
  11.         *                1. Modify C-Kermit(4E) source code to                *
  12.         *                   produce new module for MCS/IVS-Kermit             *
  13.         *                   ORIGINAL RELEASE                                  *
  14.         *                   June 22, 1990                                     *
  15.         *                                                                     *
  16.         *                                                                     *
  17.         ***********************************************************************/
  18.  
  19. 000040  This module provides NCRL runtime interfaces to perform
  20. 000050  I/O on VRX object files.
  21. 000060 "
  22. 000070
  23. 000080*CALL FOR0307.COMPILATION_CONTROL_DEFINITION,SUD=D04
  24. 000090*CALL SYS0015.SYSTEM_DEFINITIONS,SUD=D04
  25. 000100*CALL VRXMAIN.VRXNCRL,SUD=D04
  26. 000110*CALL SYSPROCS.SET_FILE_REFERENCE,SUD=D04
  27. 000120*CALL SYSPROCS.SETOUTCOME,SUD=D04
  28. 000130*CALL SYSPROCS.VRXOUTCOME,SUD=D04
  29. 000140
  30. 000150
  31. 000160?? OLDTITLE ??
  32. 000170?? NEWTITLE := 'GLOBAL TYPES AND VARIABLES' ??
  33. 000180?? EJECT ??
  34. 000190
  35. 000200 type
  36. 000210    legible_type = (leginfile, legoutfile),
  37. 000220    nio_result = (nio_ok, nio_bad, nio_eof);
  38. 000230
  39. 000240  "Dummy types for clean compiles"
  40. 000250 type
  41. 000260   task_descriptor_block = cell;
  42. 000270
  43. 000280 var
  44. 000290   errcell : [xref] integer;  " we pass back bad outcomes to
  45. 000300                                a global int for output to
  46. 000310                                screen and stderr "
  47. 000320
  48. 000330?? OLDTITLE ??
  49. 000340?? NEWTITLE := 'OBJOPENI' ??
  50. 000350?? EJECT ??
  51. 000360  proc [XDCL] objopeni (
  52. 000370    ref
  53. 000380      fname: string (*) of char,
  54. 000390      fref: string (*) of char,
  55. 000400      myfile: legible,
  56. 000410      result: nio_result);
  57. 000420
  58. 000430  var
  59. 000440    infile : legible := [#OLD, #IN, fname],
  60. 000450    refset : boolean,
  61. 000460    transfer_ptr1 : ^string( * ) of char,
  62. 000470    transfer_ptr2 : ^string( * ) of char;
  63. 000480
  64. 000490    result := nio_ok;
  65. 000500
  66. 000510   " Determine the file operation and set myfile parameter.
  67. 000520     This must be done indirectly with bind statements since
  68. 000530     NCRL does not allow the direct assignments of legible files.
  69. 000540    "
  70. 000550      bind transfer_ptr1 : [#size(legible)] to #loc(infile);
  71. 000560
  72. 000570    bind transfer_ptr2 : [#size(legible)] to #loc(myfile);
  73. 000580    transfer_ptr2^ (1, *) := transfer_ptr1^ (1, *);
  74. 000590
  75. 000600    "
  76. 000610     Set the file reference so FCL can be used on the file.
  77. 000620     The filetype and recordsize must be set to be appropriate
  78. 000630     for object files in FCL as there is no way to do it with
  79. 000640     NCRL I/O.
  80. 000650    "
  81. 000660    set_file_reference($SYSPROCS#FILEREC[LEGF, ^myfile], fref,
  82. 000670      refset);
  83. 000680    if (not refset) then
  84. 000690      result := nio_bad;
  85. 000700      return;
  86. 000710    ifend;
  87. 000720
  88. 000730    " all #open, #put, #get, #close
  89. 000740    we check the outcome from :CAM with
  90. 000750    the vrxoutcome function call. we
  91. 000760    do not have to setoutcome to ok or 0
  92. 000770    this is done just in case. At least
  93. 000780    this way nothing bites us later
  94. 000790    PEG March 6, 1990 "
  95. 000800
  96. 000810    setoutcome(ok);
  97. 000820
  98. 000830    #open(myfile);
  99. 000840
  100. 000850    if (vrxoutcome() /= ok ) then
  101. 000860       result := nio_bad;
  102. 000870       errcell := vrxoutcome();
  103. 000880       return;
  104. 000890    ifend;
  105. 000900
  106. 000910  procend objopeni;
  107. 000920?? OLDTITLE ??
  108. 000930?? NEWTITLE := 'OBJOPENO' ??
  109. 000940?? EJECT ??
  110. 000950  proc [XDCL] objopeno (
  111. 000960    ref
  112. 000970      fname: string (*) of char,
  113. 000980      fref: string (*) of char,
  114. 000990      myfile: legible,
  115. 001000      result: nio_result);
  116. 001010
  117. 001020  var
  118. 001030    outfile : legible := [#NEW, #OUT, fname],
  119. 001040    refset : boolean,
  120. 001050    transfer_ptr1 : ^string( * ) of char,
  121. 001060    transfer_ptr2 : ^string( * ) of char;
  122. 001070
  123. 001080    result := nio_ok;
  124. 001090
  125. 001100   " Determine the file operation and set myfile parameter.
  126. 001110     This must be done indirectly with bind statements since
  127. 001120     NCRL does not allow the direct assignments of legible files.
  128. 001130    "
  129. 001140      bind transfer_ptr1 : [#size(legible)] to #loc(outfile);
  130. 001150
  131. 001160    bind transfer_ptr2 : [#size(legible)] to #loc(myfile);
  132. 001170    transfer_ptr2^ (1, *) := transfer_ptr1^ (1, *);
  133. 001180
  134. 001190    "
  135. 001200     Set the file reference so FCL can be used on the file.
  136. 001210     The filetype and recordsize must be set to be appropriate
  137. 001220     for object files in FCL as there is no way to do it with
  138. 001230     NCRL I/O.
  139. 001240    "
  140. 001250    set_file_reference($SYSPROCS#FILEREC[LEGF, ^myfile], fref,
  141. 001260      refset);
  142. 001270    if (not refset) then
  143. 001280      result := nio_bad;
  144. 001290      return;
  145. 001300    ifend;
  146. 001310
  147. 001320    setoutcome(ok);
  148. 001330    #open(myfile);
  149. 001340
  150. 001350    if (vrxoutcome() /= ok ) then
  151. 001360       result := nio_bad;
  152. 001370       errcell := vrxoutcome();
  153. 001380       return;
  154. 001390    ifend;
  155. 001400
  156. 001410  procend objopeno;
  157. 001420?? OLDTITLE ??
  158. 001430?? NEWTITLE := 'OBJCLOSE' ??
  159. 001440?? EJECT ??
  160. 001450  proc [XDCL] objclose (
  161. 001460    ref
  162. 001470      closefile: legible,
  163. 001480      result   : nio_result);
  164. 001490
  165. 001500    setoutcome(ok);
  166. 001510    #close(closefile);
  167. 001520    if (vrxoutcome() /= ok ) then
  168. 001530       result := nio_bad;
  169. 001540       errcell := vrxoutcome();
  170. 001550       return;
  171. 001560    ifend;
  172. 001570
  173. 001580  procend objclose;
  174. 001590?? OLDTITLE ??
  175. 001600?? NEWTITLE := 'OBJRECIN' ??
  176. 001610?? EJECT ??
  177. 001620  proc [XDCL] objrecin (
  178. 001630    ref
  179. 001640      infile: legible,
  180. 001650      buf: string (*) of char,
  181. 001660      charsread : integer,
  182. 001670      result: nio_result);
  183. 001680
  184. 001690    "
  185. 001700     This routine reads the next record into a buffer. The VLI
  186. 001710     is reconstructed and placed at the beginning of the buffer.
  187. 001720     The buffer (including room for the VLI) must be allocated by
  188. 001730     caller. The file must have been opened by objopen.
  189. 001740    "
  190. 001750
  191. 001760    "Repeat until a good read, skipping over empty records.
  192. 001770     Note that one place this may happen is just before EOF
  193. 001780     is detected."
  194. 001790
  195. 001800    repeat
  196. 001810      if #EOF(infile) then
  197. 001820        result := nio_eof;
  198. 001830        return;
  199. 001840      else
  200. 001850        result := nio_ok;
  201. 001860      ifend;
  202. 001870
  203. 001880      setoutcome(ok);
  204. 001890      #GET(infile, charsread, buf(3, *));
  205. 001900      if (vrxoutcome() /= ok ) then
  206. 001910          result := nio_bad;
  207. 001920          errcell := vrxoutcome();
  208. 001930          return;
  209. 001940      ifend;
  210. 001950
  211. 001960      if (charsread > 0) then
  212. 001970        " Add the VLI to the beginning "
  213. 001980        buf (2) := $char (charsread mod 256);
  214. 001990        buf (1) := $char ((charsread / 256) mod 256);
  215. 002000      ifend;
  216. 002010    until ((charsread > 0) or (result = nio_eof));
  217. 002020
  218. 002030  procend objrecin;
  219. 002040?? OLDTITLE ??
  220. 002050?? NEWTITLE := 'OBJRECOUT' ??
  221. 002060?? EJECT ??
  222. 002070  proc [XDCL] objrecout (
  223. 002080    ref
  224. 002090      outfile: legible,
  225. 002100      buf: string (*) of char,
  226. 002110      result: nio_result);
  227. 002120
  228. 002130  var
  229. 002140    charstowrite: integer;
  230. 002150
  231. 002160    result := nio_ok;
  232. 002170    charstowrite := ($integer(buf(1)) * 256) + $integer(buf(2));
  233. 002180
  234. 002190    setoutcome(ok);
  235. 002200
  236. 002210    #PUT(outfile, buf (3, charstowrite) );
  237. 002220
  238. 002230    if (vrxoutcome() /= ok ) then
  239. 002240       result := nio_bad;
  240. 002250       errcell := vrxoutcome();
  241. 002260       return;
  242. 002270    ifend;
  243. 002280
  244. 002290  procend objrecout;
  245. 002300modend vkncrlio;
  246.