
























[inherit('mcv:mcvlib', 'mcv:rtl', 'sys$library:starlet')]

program symout(output);
   {Writes the global absolute names defined in FILENAME.obj to 
    a Pascal module file with name FILENAME.pas, giving each a declaration of 
    [external, value] integer. The FILENAME.pas module header is 
    [environment('tglib:messages')] module messages;
    FILENAME is given on the command line}

var
   MSGPAS__unknown, MSGPAS__skipped, MSGPAS__CANOPEFIL: 
      [external, value] integer;

[external(lib$find_file)] function find_file(
   %descr    file_spec: [readonly] pas_fileSpec;
   %descr  result_spec:            pas_fileSpec;
   var         context:            unsigned;
   %descr default_spec: [readonly] pas_fileSpec := %immed 0;
   %descr related_spec: [readonly] pas_fileSpec := %immed 0;
   var        stv_addr:            integer := %immed 0
                     ):            integer;
   extern;

[external(lib$stop)] procedure stop(
   %immed signal: integer;
   %immed   numP: integer := %immed 1;
               a: [readonly, class_s] packed array[al..ah: integer] of char;
   %immed   more: [list] integer);
   extern;

type
   lotsOfBytes = array[0..OBJ$C_MAXRECSIZ-2] of $ubyte;
   objRecType = [volatile] record
      length: $uword;
      recType: $ubyte;
      rest: lotsOfBytes;
      end;
   objRecString = [volatile] varying[OBJ$C_MAXRECSIZ] of char;
   lenfo =record
      header, offset: integer;
      end;
   linkName = record
      len: $ubyte;
      nam: packed array[1..31] of char;
      end;
   atLinkName = ^linkName;
   atGSY = ^GSY$type;

const
   glo = true; loc = false;
   def = true; ref = false;
   byt = true; wor = false;

var
   delta: [static, readonly] array[gsd$C_psc..gsd$C_spsc] of lenfo;
   symdelta: [static, readonly] array[boolean, boolean, boolean] of integer;
value
   delta[GSD$C_PSC]  := lenfo(size(gps$type)-31, byte_offset(gps$type, gps$B_namlng));
   delta[GSD$C_SYM]  := lenfo(0, -1); 
   delta[GSD$C_EPM]  := lenfo(size(epm$type)-31, byte_offset(epm$type, epm$B_namlng));
   delta[GSD$C_PRO]  := lenfo(size(pro$type)-31, byte_offset(pro$type, pro$B_namlng));
   delta[GSD$C_SYMW] := lenfo(0, -1);
   delta[GSD$C_EPMW] := lenfo(size(epmw$type)-31, byte_offset(epmw$type, epmw$B_namlng));
   delta[GSD$C_PROW] :=	lenfo(size(prow$type)-31, byte_offset(prow$type, prow$B_namlng));
   delta[GSD$C_IDC]  := lenfo(size(idc$type)-31, byte_offset(idc$type, idc$B_namlng));
   delta[GSD$C_ENV]  := lenfo(size(env$type)-31, byte_offset(env$type, env$B_namlng));
   delta[GSD$C_LSY]  := lenfo(0, -1);
   delta[GSD$C_LEPM] := lenfo(size(lepm$type)-31, byte_offset(lepm$type, lepm$B_namlng));
   delta[GSD$C_LPRO] :=	lenfo(size(lpro$type)-31, byte_offset(lpro$type, lpro$B_namlng));
   delta[GSD$C_SPSC] := lenfo(size(sgps$type)-31, byte_offset(sgps$type, sgps$B_namlng));
   symdelta[glo, ref, byt] := size(srf$type) - 32;
   symdelta[glo, ref, wor] := size(srf$type) - 32;
   symdelta[glo, def, byt] := size(sdf$type) - 32;
   symdelta[glo, def, wor] := size(sdfw$type) - 32;
   symdelta[loc, ref, byt] := 0; {should not occur}
   symdelta[loc, ref, wor] := size(lsrf$type) - 32;
   symdelta[loc, def, byt] := 0; {should not occur}
   symdelta[loc, def, wor] := size(lsdf$type) - 32;

var
   obj: text;
   out: text;
   objRec: objRecType;
   cursor: ^lotsOfBytes;
   limit: unsigned;
   kind: integer;
   global, definition, bytePsect, absolute: boolean;
   objName, pasName, pasName2, moduleName: pas_fileSpec;
   numArgs: integer;
   msgPasTable: [external] cli_tableType;
   valuelst: [static] record
      length, item: $uword;
      pointer, sentinel: integer;
      end := (0, fscn$_name, 0, 0);
   context: unsigned;
   stat1,stat2: integer;
begin
   cli_parse_foreign(msgPasTable, 'msgPas');
   cli$get_value('MESSAGE_FILE', %descr objName);
   open(obj, file_name:=objName, history:=readonly, default:='.obj',
       record_length:=OBJ$C_MAXRECSIZ, carriage_control:=none);
   objName := pas_getFileSpec(obj);
   cli$get_value('PASCAL_FILE', %descr pasName);
   if pasName.length = 0 then 
      open(out, file_name:='SYS$DISK:[].PAS', history:=new, default:=objName)
   else begin
      context := 0;
      stat1 := find_file(pasName, pasName2, context, 'SYS$DISK:[].PAS', objName,
                         stat2);
      if not odd(stat1) and (stat1 <> rms$_fnf) then 
         stop(MSGPAS__canopefil,, pasName2, stat1, stat2);
      pasName2.length := index(pasName2, ';')-1;
      open(out, file_name:=pasName2, history:=new);
      end;
   reset(obj);
   rewrite(out);
   pasName := pas_getFileSpec(out);
   $filescan(pasName, valuelst);
   with valuelst do moduleName := 
      substr(pasName, pointer-iaddress(pasName.body)+1, length);
   writeln(out, 'module '+moduleName+';');
   writeln(out, 'var');
   while not eof(obj) do begin
      readln(obj, objRec::objRecString);
      with objRec do if recType = obj$C_gsd then begin
	 cursor := address(rest);
	 limit := (address(recType))::unsigned + uint(length);
	 while cursor::unsigned < limit do begin
            kind := cursor^[0];
	    case kind of
	       GSD$C_PSC, GSD$C_EPM, GSD$C_EPMW, GSD$C_IDC, GSD$C_ENV,
	       GSD$C_LEPM, GSD$C_SPSC:
		  with delta[kind] do cursor::unsigned := 
		     cursor::unsigned + header + cursor^[offset];
	       GSD$C_SYMW, GSD$C_LSY, GSD$C_SYM: begin
		  global := not(kind = gsd$C_lsy);
                  with cursor::atGsy^ do begin
		     definition := GSY$V_DEF;
                     absolute := not GSY$V_REL;
                     end;
		  bytePsect := kind = gsd$C_sym;
		  cursor::unsigned := 
		     cursor::unsigned + symDelta[global, definition, bytePsect];
		  if global and definition and absolute then 
                     with cursor::atLinkName^ do
		        writeln(out,
                           substr(nam, 1, len), ': [external, value] integer;');
		  cursor::unsigned := cursor::unsigned + cursor^[0] + 1;
		  end;
	       GSD$C_PRO, GSD$C_PROW, GSD$C_LPRO: begin
		  with delta[kind] do cursor::unsigned := 
		     cursor::unsigned + header + cursor^[offset] + 1;
		  numArgs := cursor^[0];
		  cursor::unsigned := cursor::unsigned+1;
		  while numArgs > 0 do begin
		     cursor::unsigned := cursor::unsigned + cursor^[1] + 2;
		     numArgs := numArgs-1;
		     end;
		  end;
	       otherwise begin
                  lib$signal(MSGPAS__unknown, 1, kind, MSGPAS__skipped);
		  cursor::unsigned := limit;
                  end;
	       end; {case}
	    end; {while cursor <= limit}
         if cursor::unsigned <> limit then halt;
	 end; {if obj$_gsd}
      end; {while not eof(obj)}
   writeln(out, 'end.');
   end. {program}

