%recordformat Emashf(%integer dataend,datastart,filesize,filetype,s1,s2,s3,ofm)
%recordformat fidf(%integer dev,%short ino0,ino1,ino2,mode,%integer nlink,
      uid,%short gid,%integer charad,filesize,atime,mtime,ctime,
      %byte rfm,rat,%integer mrs)
%owninteger srcelink
%externalintegerfnspec Fstat(%integer filedes,bufad)
%externalintegerfnspec Open(%integer adname,mode,prot)
%externalintegerfnspec read(%integer id,bytead,bytesize)
%externalintegerfnspec Malloc(%integer Bytesize)
%externalroutinespec Free(%integer bytead)
%externalroutinespec Cstring(%string(*)%name Impstring,%integer adcstr)
%externalstring(255)%fnspec Impstring(%integer acstring)
%externalroutine filenames(%integer asrce,aobj,alist)
!***********************************************************************
!*    The command source name is a cstring at asrce                    *
!*     Generate in Imp the source,object&listing file names            *
!*    Tell put via pset source and put back in the cstrings            *
!***********************************************************************
%string(255) base,srce,obj,list,gen
%externalroutinespec Psetfiles(%string(*)%name srce,obj)
      srce=Impstring(Asrce)
      %if srce->Base .(".IMP").Gen %then ->OK
      %if srce->Base.(";").Gen %then Srce=Base.".IMP;".Gen %else %c
         Base=srce %and srce=srce.".IMP"
ok:
      Obj=Base.".OBJ"
      list=Base.".LIS"
      Psetfiles(srce,obj)
      Cstring(Srce,asrce)
      Cstring(Obj,Aobj)
      Cstring(List,alist)
%end;                          ! of filenames
%externalroutine Inputsource(%integer Adcstr,%integername Filead)
!***********************************************************************
!*     Reads a file into a malloc area and adds Emas Header            *
!***********************************************************************
%integer srcid,i,k,srcsize
%record(EmasHF)%name Hdr
%record (fidf) Fid
%string(31) s
%constinteger readmode=0
      srcid=Open(Adcstr,readmode,0)
      %if srcid=-1 %then s="Open fails" %and ->Crunch
      i=Fstat(srcid,addr(Fid))
      %if i#0 %then S="Get status fails " %and ->Crunch
      Srcsize=integer(addr(Fid)+26);             ! Not aligned!!!
      filead=Malloc(Srcsize+20)
      %if Filead=0 %then S="Malloc fails" %and ->Crunch
!      Printstring("Filesize=")
!      write(srcsize,5)
      k=0; %cycle
         i=Read(srcid,filead+32+k,srcsize-k)
         %exit %if i=0
         k=k+i
         %exit %if k>=srcsize
      %repeat
      Hdr==record(Filead)
      Hdr=0
      hDR_datastart=32
      HDR_dataend=Srcsize+32
      HDR_OFM=srcelink
      srcelink=filead
      %return
Crunch:Printstring(s."Obtaining text of ")
       %for i=0,1,15 %cycle
          k=byteinteger(adcstr+i)
         %exit %if k=0
         printsymbol(k)
        %repeat
         newline
     %stop
%end
%externalroutine Consource(%string(255)filename,%integername Filead)
%bytearray Cstr(0:255)
%integer adcstr
      adcstr=addr(Cstr(0))
      Cstring(Filename,adcstr)
      Inputsource(Adcstr,filead)
%end
%externalroutine FreeSource Areas
!***********************************************************************
!*      Gives back to VMS the areas for source and include files       *
!***********************************************************************
      %cycle
         FREE(Srcelink)
         srcelink=integer(srcelink+28)
       %repeat %until srcelink=0
%end
%endoffile