DataMuseum.dk

top - metrics - download

    Length: 6016 (0x1780)
    Types: TextFile
    Names: »LNKDF1.PAS«

└─⟦91467e717⟧ Bits:30009789/_.ft.Ibm2.50007348.imd Mogens Pelles Zilog 80,000 / EOS projekt
    └─⟦this⟧ »LNKDF1.PAS« 

TextFile

(*
SEGMENT LnkDF1X;
*)
   (* Segment LnkDF1X defines the test output primitives used for debugging
      program link and its associated subroutines and functions. The
      corresponding external declarations should be found in file
      'LnkDC1.pas'.
   *)

(* $I B:lnkDC0.pas   Declarations of global constants, types, and commons *)

   FUNCTION memavail: integer; EXTERNAL;

   PROCEDURE TSTasc(N: i8
                   );

     BEGIN (*TSTASC*)
      IF (31 < N) and (N < 127) THEN
         write(TestOut, chr(N) )
      ELSE
         write(TestOut, '+')
     END;  (*TSTASC*)

   PROCEDURE TSThex(N: i8
                   );

      VAR
         Nibble: i8;

     BEGIN (*TSTHEX*)
      Nibble := N div 16;
      IF Nibble < 10 THEN
         write(TestOut, chr( ord('0') + Nibble ) )
      ELSE
         write(TestOut, chr( ord('A') - 10 + Nibble ) );
      Nibble := N mod 16;
      IF Nibble < 10 THEN
         write(TestOut, chr( ord('0') + Nibble ) )
      ELSE
         write(TestOut, chr( ord('A') - 10 + Nibble ) )
     END;  (*TSTHEX*)

   PROCEDURE TSTbool(A: boolean
                    );

     BEGIN (*TSTBOOL*)
      IF A THEN
         write(TestOut, 'T')
      ELSE
         write(TestOut, 'F')
     END;  (*TSTBOOL*)

   PROCEDURE TSTindt;

     BEGIN (*TSTindt*)
      write(TestOut, ' ':3)
     END;  (*TSTindt*)

   PROCEDURE TSTln;

     BEGIN (*TSTln*)
      writeln(TestOut)
     END;  (*TSTln*)

   PROCEDURE TSTsymbol(S: SymbolNameType
                      );

      VAR
         I: SymbolNameIndexType;

     BEGIN (*TSTSYMBOL*)
      WITH S DO
        BEGIN
         write(TestOut, 'SYMBOLÆ', Length:1, 'Å=');
         FOR I := 1 TO Length DO
            TSTasc(Name(.I.));
         TSTln;
        END
     END;  (*TSTSYMBOL*)

   PROCEDURE TSTstat(Status: StatusType
                );

      VAR
         Inx: StatusBaseType;

     BEGIN (*TSTstat*)
      write(TestOut, 'STAT=(');
      IF Status = (..) THEN
         write(TestOut, 'SUCCESS)' )
      ELSE
        BEGIN
         FOR Inx := succ(Success) TO Error DO
            IF Inx IN Status THEN
               write(TestOut, ' ', ord(Inx):1);
        write(TestOut, ' )');
       END
     END;  (*TSTstat*)

   PROCEDURE TSTmem;

     BEGIN (*TSTmem*)
      write(TestOut, 'MEMAVAIL=', memavail:1)
     END;  (*TSTmem*)

   PROCEDURE TSTfpos(VAR Fl: FileType
                );

     BEGIN (*TSTfpos*)
      write(TestOut, 'FPOS=',
                     (*Fl.S:1, '/',*)
                     Fl.P:1)
     END;  (*TSTfpos*)

   PROCEDURE TSTeit(Inx: ExternalImportTableIndexType
                );

     BEGIN (*TSTeit*)
      WITH ExternalImportTable(.Inx.) DO
         writeln(TestOut, 'EITÆ', Inx:1, '/', CurExternalImportSymbolNo:1,
                             'Å=(SblNo=', SymbolNo:1, ')' )
     END;  (*TSTeit*)

   PROCEDURE TSTfnt(Inx: FileNameTableIndexType
                );

     BEGIN (*TSTfnt*)
      writeln(TestOut, 'FNTÆ', Inx:1, '/', CurFileNo:1,
                          'Å=(FlNm=', FileNameTable(.inx.), ')' )
     END;  (*TSTfnt*)

   PROCEDURE TSTheap(Heap: HeapType
                    ;HeapMax: ModuleTableIndexType
                    );

      VAR
         I: ModuleTableIndexType;

     BEGIN (*TSTHEAP*)
      TSTindt; TSTindt; TSTindt;
      write(TestOut, 'HeapÆ',HeapMax:2,'Å=(' );
      FOR I := 1 TO HeapMax + 1 DO
         write(TestOut, Heap(.I.):2, ' ':1);
      writeln(TestOut, ')');
     END;  (*TSTHEAP*)

   PROCEDURE TSTiit(Inx: InternalImportTableIndexType
                );

     BEGIN (*TSTiit*)
     END;  (*TSTiit*)

   PROCEDURE TSTmdt(Inx: ModuleTableIndexType
                );

     BEGIN (*TST*)
      WITH moduleTable(.Inx.) DO
        BEGIN
         write(TestOut, 'MDTÆ', Inx:1, '/', CurModuleNo:1,
                           'Å=(MdNm#=', ModuleNameReference:1, ' ':2
                              ,'Fn#=', FileNameReference:1, ' ':2
                              ,'CurFlAddr=', CurrentFileAddress:1, ' ':2
                              ,'Refd='
               );
         TSTbool(Referenced);
         TSTln;
         TSTindt; TSTindt; TSTindt;
         writeln(TestOut      ,'#Sgm=', NooSegments:1, ' ':2
                              ,'#EIsbl=', NooExternalImportSymbols:1, ' ':2
                              ,'EIT#=', EITOffset:1, ' ':2
                              ,'SBTLH=', SBTlinkHead:1
                              ,')'
              );
        END
     END;  (*TST*)

   PROCEDURE TSTopt;

     BEGIN (*TSTopt*)
      writeln(TestOut, 'OPT=(LogKind=', ord(OptionTable.LogFileKind):1, ' ':2
                            ,'TargetKind=', ord(OptionTable.TargetFileKind):1
                            ,')' )
     END;  (*TSTopt*)

   PROCEDURE TSTsct(Inx: SectionTableIndexType
                );

     BEGIN (*TSTsct*)
      WITH SectionTable(.Inx.) DO
        BEGIN
         writeln(TestOut, 'SCT=Æ', Inx:1, '/', SCTOffset:1, '/', CurSegmentCount:1
                         ,'Å=(Mdl#=', ModuleNo:1, ' ':2
                         ,'Sgm#=', SegmentNo:1
                         ,'#IISbl=', NooInternalImportSymbols:1
                );
         writeln(TestOut, '         ImSz=', ImageSize, ' ':2
                         ,'RlSz=', RldSize, ' ':2
                         ,'RlConst=', RelocationConstant
                         ,')'
                );
        END
     END;  (*TSTsct*)

   PROCEDURE TSTvlt(Inx: SymbolTableIndexType
                );

     BEGIN (*TSTvlt*)
      WITH ValueTable(.Inx.) DO
        BEGIN
         write(TestOut, 'VLTÆ',Inx:1,'Å=(Resolved='); TSTbool(Resolved);
         write(TestOut, '  Value=', Value:1)
        END
     END;  (*TSTvlt*)



(*  BEGIN (*LNKTST*)
(*  END.  (*LNKTST*)

«eof»