000010?? TITLE := 'VKNCRLIO - NCRL I/O FOR OBJECT FILES' ?? 000020module vkncrlio; 000030 " /********************************************************************** * * * IVS / MCS-Kermit REL 2 * * source code * * * * Change History: * * * * 1. Modify C-Kermit(4E) source code to * * produce new module for MCS/IVS-Kermit * * ORIGINAL RELEASE * * June 22, 1990 * * * * * ***********************************************************************/ 000040 This module provides NCRL runtime interfaces to perform 000050 I/O on VRX object files. 000060 " 000070 000080*CALL FOR0307.COMPILATION_CONTROL_DEFINITION,SUD=D04 000090*CALL SYS0015.SYSTEM_DEFINITIONS,SUD=D04 000100*CALL VRXMAIN.VRXNCRL,SUD=D04 000110*CALL SYSPROCS.SET_FILE_REFERENCE,SUD=D04 000120*CALL SYSPROCS.SETOUTCOME,SUD=D04 000130*CALL SYSPROCS.VRXOUTCOME,SUD=D04 000140 000150 000160?? OLDTITLE ?? 000170?? NEWTITLE := 'GLOBAL TYPES AND VARIABLES' ?? 000180?? EJECT ?? 000190 000200 type 000210 legible_type = (leginfile, legoutfile), 000220 nio_result = (nio_ok, nio_bad, nio_eof); 000230 000240 "Dummy types for clean compiles" 000250 type 000260 task_descriptor_block = cell; 000270 000280 var 000290 errcell : [xref] integer; " we pass back bad outcomes to 000300 a global int for output to 000310 screen and stderr " 000320 000330?? OLDTITLE ?? 000340?? NEWTITLE := 'OBJOPENI' ?? 000350?? EJECT ?? 000360 proc [XDCL] objopeni ( 000370 ref 000380 fname: string (*) of char, 000390 fref: string (*) of char, 000400 myfile: legible, 000410 result: nio_result); 000420 000430 var 000440 infile : legible := [#OLD, #IN, fname], 000450 refset : boolean, 000460 transfer_ptr1 : ^string( * ) of char, 000470 transfer_ptr2 : ^string( * ) of char; 000480 000490 result := nio_ok; 000500 000510 " Determine the file operation and set myfile parameter. 000520 This must be done indirectly with bind statements since 000530 NCRL does not allow the direct assignments of legible files. 000540 " 000550 bind transfer_ptr1 : [#size(legible)] to #loc(infile); 000560 000570 bind transfer_ptr2 : [#size(legible)] to #loc(myfile); 000580 transfer_ptr2^ (1, *) := transfer_ptr1^ (1, *); 000590 000600 " 000610 Set the file reference so FCL can be used on the file. 000620 The filetype and recordsize must be set to be appropriate 000630 for object files in FCL as there is no way to do it with 000640 NCRL I/O. 000650 " 000660 set_file_reference($SYSPROCS#FILEREC[LEGF, ^myfile], fref, 000670 refset); 000680 if (not refset) then 000690 result := nio_bad; 000700 return; 000710 ifend; 000720 000730 " all #open, #put, #get, #close 000740 we check the outcome from :CAM with 000750 the vrxoutcome function call. we 000760 do not have to setoutcome to ok or 0 000770 this is done just in case. At least 000780 this way nothing bites us later 000790 PEG March 6, 1990 " 000800 000810 setoutcome(ok); 000820 000830 #open(myfile); 000840 000850 if (vrxoutcome() /= ok ) then 000860 result := nio_bad; 000870 errcell := vrxoutcome(); 000880 return; 000890 ifend; 000900 000910 procend objopeni; 000920?? OLDTITLE ?? 000930?? NEWTITLE := 'OBJOPENO' ?? 000940?? EJECT ?? 000950 proc [XDCL] objopeno ( 000960 ref 000970 fname: string (*) of char, 000980 fref: string (*) of char, 000990 myfile: legible, 001000 result: nio_result); 001010 001020 var 001030 outfile : legible := [#NEW, #OUT, fname], 001040 refset : boolean, 001050 transfer_ptr1 : ^string( * ) of char, 001060 transfer_ptr2 : ^string( * ) of char; 001070 001080 result := nio_ok; 001090 001100 " Determine the file operation and set myfile parameter. 001110 This must be done indirectly with bind statements since 001120 NCRL does not allow the direct assignments of legible files. 001130 " 001140 bind transfer_ptr1 : [#size(legible)] to #loc(outfile); 001150 001160 bind transfer_ptr2 : [#size(legible)] to #loc(myfile); 001170 transfer_ptr2^ (1, *) := transfer_ptr1^ (1, *); 001180 001190 " 001200 Set the file reference so FCL can be used on the file. 001210 The filetype and recordsize must be set to be appropriate 001220 for object files in FCL as there is no way to do it with 001230 NCRL I/O. 001240 " 001250 set_file_reference($SYSPROCS#FILEREC[LEGF, ^myfile], fref, 001260 refset); 001270 if (not refset) then 001280 result := nio_bad; 001290 return; 001300 ifend; 001310 001320 setoutcome(ok); 001330 #open(myfile); 001340 001350 if (vrxoutcome() /= ok ) then 001360 result := nio_bad; 001370 errcell := vrxoutcome(); 001380 return; 001390 ifend; 001400 001410 procend objopeno; 001420?? OLDTITLE ?? 001430?? NEWTITLE := 'OBJCLOSE' ?? 001440?? EJECT ?? 001450 proc [XDCL] objclose ( 001460 ref 001470 closefile: legible, 001480 result : nio_result); 001490 001500 setoutcome(ok); 001510 #close(closefile); 001520 if (vrxoutcome() /= ok ) then 001530 result := nio_bad; 001540 errcell := vrxoutcome(); 001550 return; 001560 ifend; 001570 001580 procend objclose; 001590?? OLDTITLE ?? 001600?? NEWTITLE := 'OBJRECIN' ?? 001610?? EJECT ?? 001620 proc [XDCL] objrecin ( 001630 ref 001640 infile: legible, 001650 buf: string (*) of char, 001660 charsread : integer, 001670 result: nio_result); 001680 001690 " 001700 This routine reads the next record into a buffer. The VLI 001710 is reconstructed and placed at the beginning of the buffer. 001720 The buffer (including room for the VLI) must be allocated by 001730 caller. The file must have been opened by objopen. 001740 " 001750 001760 "Repeat until a good read, skipping over empty records. 001770 Note that one place this may happen is just before EOF 001780 is detected." 001790 001800 repeat 001810 if #EOF(infile) then 001820 result := nio_eof; 001830 return; 001840 else 001850 result := nio_ok; 001860 ifend; 001870 001880 setoutcome(ok); 001890 #GET(infile, charsread, buf(3, *)); 001900 if (vrxoutcome() /= ok ) then 001910 result := nio_bad; 001920 errcell := vrxoutcome(); 001930 return; 001940 ifend; 001950 001960 if (charsread > 0) then 001970 " Add the VLI to the beginning " 001980 buf (2) := $char (charsread mod 256); 001990 buf (1) := $char ((charsread / 256) mod 256); 002000 ifend; 002010 until ((charsread > 0) or (result = nio_eof)); 002020 002030 procend objrecin; 002040?? OLDTITLE ?? 002050?? NEWTITLE := 'OBJRECOUT' ?? 002060?? EJECT ?? 002070 proc [XDCL] objrecout ( 002080 ref 002090 outfile: legible, 002100 buf: string (*) of char, 002110 result: nio_result); 002120 002130 var 002140 charstowrite: integer; 002150 002160 result := nio_ok; 002170 charstowrite := ($integer(buf(1)) * 256) + $integer(buf(2)); 002180 002190 setoutcome(ok); 002200 002210 #PUT(outfile, buf (3, charstowrite) ); 002220 002230 if (vrxoutcome() /= ok ) then 002240 result := nio_bad; 002250 errcell := vrxoutcome(); 002260 return; 002270 ifend; 002280 002290 procend objrecout; 002300modend vkncrlio;