MODULE ;RELGEN.ACT

;COPYRIGHT 1984, QMI, JS DeMar
;REV. 1.1, March 20, 1984

;OBJECT CODE RELOCATION GENERATOR for
;ACTION! compiled binary-load files.

;WARNING!!! This program requires
;four OPEN files simultaneously.
;Be sure that DOS is configured for
;this. With DOS 2.0, set $709 equal
;to at least 4, rewrite DOS and
;reboot.

;Requires the second file compiled
;at any even page increment higher
;than the first file, for example:
;$3000 and $3100.

;Generates a table of the locations
;that require relocating and saves
;it in a ".GEN" file in ACTION!.
;  The ".REL" file is the original
;object code with an origin of "0". 
;The actual relocator is compiled
;from the generic relocator source
;called "RELOC.ACT" merged with the
;".GEN" file generated here. Append
;".REL" file to that code and it
;will load and relocate to MEMLO.

DEFINE in1="1",
       in2="2",
       out1="3",
       out2="4"

BYTE abrt

;---------------------------------

PROC MyError(BYTE a,x,y)

IF y=170 THEN
  PrintE("ERROR File not found!")
ELSE
  Print("ERROR! ")
  PrintBE(y)
FI
abrt=1
RETURN
;---------------------------------

PROC Ferror()

BYTE t,clock=$14

PrintE("ERROR in Output filespec!")
t=clock-$80
DO
UNTIL t=clock
OD
RETURN
;---------------------------------

PROC Main()

CARD start1,start2,end1,end2
CARD offsets,offsete,i,count,hits
CARD test1,test2,old1,old2,old3,old0
BYTE x,z,j,wnum,d1,d2,
     sthigh

BYTE ARRAY fname1(18),fname2(18),
           fnameout1(18),fnameout2(18)

DO
PrintE("}     Relocation Code Generator ")
PrintE("           JS DeMar 3/84 ")
PutE()
PrintE("  Requires two code files compiled")
PrintE("      with an offset of $0100.")
PutE()

Print("Filespec for code A >") 
InputMD(device,fname1,18)
PutE()
Print("Filespec for code B >") 
InputMD(device,fname2,18)
PutE()

Scopy(fnameout1,fname1)
SCopy(fnameout2,fnameout1)
j=1
IF fnameout1(1)#'D 
      OR fnameout1(0)<4 THEN
  Ferror()
ELSEIF fnameout1(2)=': THEN
  z=0
ELSEIF fnameout1(3)=': THEN
  z=1
FI
DO 
  x=fnameout1(j)
  j==+1
  IF x=$20 THEN
    EXIT
  ELSEIF x='. THEN
    EXIT
  ELSEIF j>fnameout1(0) THEN
    j==+1
    EXIT
  ELSEIF j>11+z THEN
    Ferror()
  FI
OD

fnameout1(j-1)='.
fnameout1(j)='G
fnameout1(j+1)='E
fnameout1(j+2)='N
fnameout1(0)=j+2

j=1
IF fnameout2(1)#'D 
      OR fnameout2(0)<4 THEN
  Ferror()
ELSEIF fnameout2(2)=': THEN
  z=0
  EXIT
ELSEIF fnameout2(3)=': THEN
  z=1
  EXIT
FI
OD
DO 
  x=fnameout2(j)
  j==+1
  IF x=$20 THEN
    EXIT
  ELSEIF x='. THEN
    EXIT
  ELSEIF j>fnameout2(0) THEN
    j==+1
    EXIT
  ELSEIF j>11+z THEN
    Ferror()
    EXIT
  FI
OD

fnameout2(j-1)='.
fnameout2(j)='R
fnameout2(j+1)='E
fnameout2(j+2)='L
fnameout2(0)=j+2

Print("Generation file = ")
PrintE(fnameout1)
Print("Relocation file = ")
PrintE(fnameout2)

Error=MyError
abrt=0
Close(in1)
Close(in2)
Close(out1)
Close(out2)
Open(in1,fname1,4)
Open(in2,fname2,4)
IF abrt=1 THEN 
  Close(1)
  Close(2)
  RETURN
FI
Open(out1,fnameout1,8)
Open(out2,fnameout2,8)

x=GetD(in1) ;throw away two $FF's.
x=GetD(in1)
PutD(out2,$FF)
PutD(out2,$FF)
x=GetD(in1)
PutD(out2,x)
start1=x    ;start addr of file1.
x=GetD(in1)
PutD(out2,x)
start1==+(x*256)
x=GetD(in1)
PutD(out2,x)
end1=x
x=GetD(in1)
PutD(out2,x)
end1==+(x*256) ;end addr of file1.

x=GetD(in2) ;throw away two $FF's.
x=GetD(in2)
x=GetD(in2)
start2=x    ;start addr of file2.
x=GetD(in2)
start2==+(x*256)
x=GetD(in2)
end2=x
x=GetD(in2)
end2==+(x*256) ;end addr of file2.

offsets=start2-start1
sthigh=start1/256
offsete=end2-end1


PrintDE(out1,"MODULE")
PrintD(out1,";For file ")
PrintDE(out1,fnameout2)
PrintDE(out1,"")
Print("Code starts at ")
PrintD(out1,"CARD start=[")
PrintCE(start1)
PrintCD(out1,start1)
PrintDE(out1,"]")
Print("   and ends at ")
PrintD(out1,"CARD finish=[")
PrintCE(end1)
PrintCD(out1,end1)
PrintDE(out1,"]")
Print("Compile offset was ")
PrintCE(offsets)

IF offsete#offsets THEN
  PrintE("Diferrent size files!")
  PrintE("ABORTED!")
ELSE
  PrintDE(out1,"")
  PrintD(out1,"CARD ARRAY otable=[")
  wnum=0
  hits=0
  count=0
  WHILE EOF(in1)=0 
  DO
    d1=GetD(in1)
    d2=GetD(in2)
    IF d1#d2 THEN
      IF count<(end1-start1)-5 THEN
        hits==+1
        IF wnum=0 THEN
          PrintD(out1,"  ")
          Print(" ")
        ElSE 
          PrintD(out1," ")
          Print(" ")
        FI
        PrintCD(out1,count)
        Print(" ")
        PrintC(count)
        wnum==+1
        IF wnum>4 THEN
          PrintDE(out1,"")
          PrintE("")
          wnum=0
        FI
      FI
      old0=d1
      test1=old0*256
      test1==+old1
      test2=old2*256
      test2==+old3
      IF test1>=start1 AND test1<=end1 THEN
        IF test2=$02E3 OR test2=$02E1 THEN
          PrintDE(out1,"]")
          PrintE("]")
          PrintD(out1,"CARD hits=[")
          PrintCD(out1,hits)
          PrintDE(out1,"]")
          PrintDE(out1,"")
          Print("CARD hits=[")
          PrintC(hits)
          PrintE("]")
          PrintE("")
          PrintD(out1,"CARD runaddr=[")
          Print("CARD runaddr=[")
          test1==-start1
          PrintCD(out1,test1)
          PrintC(test1)
          PrintDE(out1,"]")
          PrintE("]")
          wnum=0
        FI
      FI
      old3=old2
      old2=old1
      old1=d1
      d1==-sthigh
    ELSE 
      old3=old2
      old2=old1
      old1=d1
    FI
    PutD(out2,d1)
    count==+1
  OD
FI
PrintE("")
PrintDE(out1,"")
Close(in1)
Close(in2)
Close(out1)
Close(out2)
PrintE("Finished!}")
RETURN