-- ListCode.mesa; edited by Sandman; September 29, 1980  9:21 AM
--  edited by Sandman; September 29, 1980  9:21 AM
--  edited by Sweet; 27-Oct-80 14:07:14

DIRECTORY
  AltoDefs USING [BYTE, PageCount],
  BcdDefs USING [Base, MTIndex],
  BcdOps USING [BcdBase, MTHandle],
  CommanderDefs USING [AddCommand, CommandBlockHandle],
  ControlDefs USING [CSegPrefix, EntryVectorItem, FrameHandle, FrameVec],
  InlineDefs USING [BITAND, BITOR, BITXOR, COPY],
  IODefs USING [ControlZ, CR, NumberFormat, SP, WriteString],
  ListerDefs,
  Mopcodes USING [
    zJ2, zJ9, zJEQ2, zJEQ9, zJIB, zJIW, zJNE2, zJNE9, zLI0, zLI6, zLIB, zLIW, zRF,
    zRFC, zRFL, zRIGP, zRIGPL, zRILP, zRILPL, zRXGPL, zRXLP, zRXLPL, zWF, zWFL,
    zWIGPL, zWILP, zWILPL, zWSF, zWXGPL, zWXLP, zWXLPL],
  OpTableDefs USING [instaligned, instlength, InstName, popstack, pushstack],
  OutputDefs USING [
    CloseOutput, OpenOutput, PutChar, PutCR, PutNumber, PutString, PutSubString,
    PutTab],
  SegmentDefs USING [
    DefaultVersion, DeleteFileSegment, FileNameError, FileSegmentAddress, NewFile,
    Read, SwapError, SwapIn, Unlock],
  StreamDefs USING [
    CreateByteStream, SetIndex, StreamError, StreamHandle, StreamIndex],
  String USING [AppendString, SubStringDescriptor],
  Symbols USING [
    BodyInfo, BodyRecord, BTIndex, BTNull, CBTIndex, HTIndex, HTNull, ISEIndex,
    SENull],
  SymbolSegment USING [FGTEntry],
  SymbolTable USING [Acquire, Base, Release, TableForSegment],
  Storage USING [Free, Node];

ListCode: PROGRAM
  IMPORTS
    CommanderDefs, InlineDefs, IODefs, ListerDefs, OpTableDefs, OutputDefs,
    SegmentDefs, StreamDefs, Storage, String, SymbolTable
  EXPORTS ListerDefs
  SHARES SymbolTable =
  BEGIN OPEN AltoDefs, OutputDefs;
  
  MTIndex: TYPE = BcdDefs.MTIndex;
  FileSegmentHandle: TYPE = ListerDefs.FileSegmentHandle;
  FrameHandle: TYPE = ControlDefs.FrameHandle;
  NumberFormat: TYPE = IODefs.NumberFormat;
  opcode: TYPE = BYTE;
  
  JumpOp: TYPE = [Mopcodes.zJ2..Mopcodes.zJIW];
  InstWord: TYPE = MACHINE DEPENDENT RECORD [
    SELECT COMPUTED BOOLEAN FROM
    FALSE => [oddbyte, evenbyte: BYTE],
      TRUE => [evenbyte, oddbyte: BYTE],
      ENDCASE];
  
  FineGrainInfo: TYPE = RECORD [
    firstSource, lastSource: CARDINAL _ NullSource,
    pc: CARDINAL,
    procEnd: BOOLEAN,
    bti: Symbols.CBTIndex];
  NullSource: CARDINAL = LAST[CARDINAL]; -- if lastSource, causes to EOF
  
  myFGT: DESCRIPTOR FOR ARRAY OF FineGrainInfo;
  
  DigestFGT: PROCEDURE =
    BEGIN OPEN s: symbols;
    i, n: CARDINAL;
    bti, prev: Symbols.BTIndex;
    cspp: POINTER TO ControlDefs.CSegPrefix = codebase;
    
    AddMyEntry: PROCEDURE [
      source: CARDINAL _ NullSource, object: CARDINAL, procEnd: BOOLEAN _ FALSE] =
      BEGIN
      IF n = myFGTSize THEN
	BEGIN
	oldFGT: DESCRIPTOR FOR ARRAY OF FineGrainInfo = myFGT;
	myFGTSize _ myFGTSize + 10;
	SetupMyFGT[];
	InlineDefs.COPY[
	  from: BASE[oldFGT], to: BASE[myFGT], nwords: n*SIZE[FineGrainInfo]];
	Storage.Free[BASE[oldFGT]];
	END;
      myFGT[n] _
	[firstSource: source, pc: object, procEnd: procEnd, bti: LOOPHOLE[bti]];
      n _ n + 1;
      END;
      
    AddBodyFGT: PROCEDURE [bti: Symbols.CBTIndex] =
      BEGIN OPEN s: symbols;
      body: POINTER TO Callable Symbols.BodyRecord = @s.bb[bti];
      evi: POINTER TO ControlDefs.EntryVectorItem = @cspp.entry[body.entryIndex];
      procstart: CARDINAL = evi.initialpc*2;
      info: External Symbols.BodyInfo;
      i, fgLast, lastSource, lastObject: CARDINAL;
      f: SymbolSegment.FGTEntry;
      WITH bi: body.info SELECT FROM External => info _ bi; ENDCASE => ERROR;
      fgLast _ info.startIndex + info.indexLength - 1;
      lastSource _ s.bb[bti].sourceIndex;
      lastObject _ procstart;
      FOR i IN [info.startIndex..fgLast] DO
	f _ s.fgTable[i];
	WITH f SELECT FROM
	  normal =>
	    BEGIN
	    lastSource _ lastSource + deltaSource;
	    lastObject _ lastObject + deltaObject;
	    AddMyEntry[source: lastSource, object: lastObject];
	    END;
	  step =>
	    IF which = source THEN lastSource _ lastSource + delta
	    ELSE lastObject _ lastObject + delta;
	  ENDCASE;
	ENDLOOP;
      AddMyEntry[object: procstart + info.bytes, procEnd: TRUE];
      END;
      
    SetupMyFGT: PROCEDURE =
      BEGIN
      myFGT _ DESCRIPTOR[Storage.Node[myFGTSize*SIZE[FineGrainInfo]], myFGTSize];
      END;
      
    BySource: PROCEDURE [r1, r2: POINTER TO FineGrainInfo] RETURNS [BOOLEAN] =
      BEGIN
      IF r1.firstSource > r2.firstSource THEN RETURN[TRUE];
      IF r1.firstSource = r2.firstSource THEN RETURN[r1.pc > r2.pc];
      RETURN[FALSE];
      END;
      
    ByPC: PROCEDURE [r1, r2: POINTER TO FineGrainInfo] RETURNS [BOOLEAN] =
      BEGIN
      IF r1.pc > r2.pc THEN RETURN[TRUE];
      IF r1.pc < r2.pc THEN RETURN[FALSE];
      IF r1.procEnd THEN RETURN[FALSE];
      IF r2.procEnd THEN RETURN[TRUE];
      RETURN[r1.firstSource > r2.firstSource];
      END;
      
    Sort: PROCEDURE [
      greater: PROCEDURE [r1, r2: POINTER TO FineGrainInfo] RETURNS [BOOLEAN]] =
      BEGIN
      i: CARDINAL;
      temp: FineGrainInfo;
      SiftUp: PROC [l, u: CARDINAL] =
        BEGIN
	s: CARDINAL;
	key: FineGrainInfo _ myFGT[l-1];
	DO
	  s _ l*2;
	  IF s > u THEN EXIT;
	  IF s < u AND greater[@myFGT[s+1-1], @myFGT[s-1]] THEN s _ s+1;
	  IF greater[@key, @myFGT[s-1]] THEN EXIT;
	  myFGT[l-1] _ myFGT[s-1];
	  l _ s;
	  ENDLOOP;
	myFGT[l-1] _ key;
	END;
      FOR i DECREASING IN [2..n/2] DO SiftUp[i, n]; ENDLOOP;
      FOR i DECREASING IN [2..n] DO
	SiftUp[1, i];
	temp _ myFGT[1-1];
	myFGT[1-1] _ myFGT[i-1];
	myFGT[i-1] _ temp;
	ENDLOOP;
      END;
      
    myFGTSize: CARDINAL _ (3*LENGTH[s.fgTable])/2;
    SetupMyFGT[];
    n _ 0;
    bti _ LOOPHOLE[0];
    IF s.bb[bti].sourceIndex # 0 THEN
      BEGIN
      bti _ Symbols.BTNull;
      AddMyEntry[source: 0, object: cspp.entry[0].initialpc*2];
      bti _ LOOPHOLE[0];
      END;
    DO
      WITH s.bb[bti] SELECT FROM
	Callable => IF ~inline THEN AddBodyFGT[LOOPHOLE[bti]];
	ENDCASE;
      IF s.bb[bti].firstSon # Symbols.BTNull THEN bti _ s.bb[bti].firstSon
      ELSE
	DO
	  prev _ bti;
	  bti _ s.bb[bti].link.index;
	  IF bti = Symbols.BTNull THEN GO TO Done;
	  IF s.bb[prev].link.which # parent THEN EXIT;
	  ENDLOOP;
      REPEAT Done => NULL;
      ENDLOOP;
    myFGT _ DESCRIPTOR[BASE[myFGT], n]; -- set length correctly
    Sort[BySource];
    FOR i IN [0..n - 1) DO
      IF myFGT[i].firstSource = NullSource THEN EXIT;
      myFGT[i].lastSource _ myFGT[i + 1].firstSource; -- may be same
      
      ENDLOOP;
    Sort[ByPC];
    END;
    
  offset: CARDINAL;
  codebase: POINTER;
  codepages: PageCount;
  symbols: SymbolTable.Base;
  Tinst, Tbytes, Pinst, Pbytes: CARDINAL _ 0;
  freqing: BOOLEAN _ FALSE;
  absolute: BOOLEAN _ FALSE;
  dStar: BOOLEAN _ FALSE;
  
  -- number formats
  
  decimal: NumberFormat = NumberFormat[
    base: 10, columns: 1, zerofill: FALSE, unsigned: TRUE];
  decimal3: NumberFormat = NumberFormat[
    base: 10, columns: 3, zerofill: FALSE, unsigned: TRUE];
  hoctal3: NumberFormat _ NumberFormat[
    base: 8, columns: 3, zerofill: FALSE, unsigned: TRUE];
  hoctal3z: NumberFormat _ NumberFormat[
    base: 8, columns: 3, zerofill: TRUE, unsigned: TRUE];
  hoctal5: NumberFormat _ NumberFormat[
    base: 8, columns: 5, zerofill: FALSE, unsigned: TRUE];
  hoctal6: NumberFormat _ NumberFormat[
    base: 8, columns: 6, zerofill: FALSE, unsigned: TRUE];
  hoctal1: NumberFormat _ NumberFormat[
    base: 8, columns: 1, zerofill: FALSE, unsigned: TRUE];
  
  -- set base for listings
  
  
  Hexify: PROCEDURE =
    BEGIN
    hoctal3 _ NumberFormat[base: 16, columns: 3, zerofill: FALSE, unsigned: TRUE];
    hoctal3z _ NumberFormat[
      base: 16, columns: 3, zerofill: FALSE, unsigned: TRUE];
    hoctal5 _ NumberFormat[base: 16, columns: 5, zerofill: FALSE, unsigned: TRUE];
    hoctal6 _ NumberFormat[base: 16, columns: 6, zerofill: FALSE, unsigned: TRUE];
    hoctal1 _ NumberFormat[base: 16, columns: 1, zerofill: FALSE, unsigned: TRUE];
    END;
    
  Octify: PROCEDURE =
    BEGIN
    hoctal3 _ NumberFormat[base: 8, columns: 3, zerofill: FALSE, unsigned: TRUE];
    hoctal3z _ NumberFormat[base: 8, columns: 3, zerofill: TRUE, unsigned: TRUE];
    hoctal5 _ NumberFormat[base: 8, columns: 5, zerofill: FALSE, unsigned: TRUE];
    hoctal6 _ NumberFormat[base: 8, columns: 6, zerofill: FALSE, unsigned: TRUE];
    hoctal1 _ NumberFormat[base: 8, columns: 1, zerofill: FALSE, unsigned: TRUE];
    END;
    
  -- generate list of opcode lengths
  
  OpcodeLengths: PROCEDURE [root: STRING] =
    BEGIN OPEN OpTableDefs;
    i: opcode;
    digit: STRING = "0123456789"L;
    OpenOutput[root, ".list"L];
    PutString["  OpcodeLengths: PACKED ARRAY [0..255] OF [0..3] = ["L];
    FOR i IN opcode DO
      IF i MOD 32 = 0 THEN {PutCR[]; PutString["    "L]};
      PutChar[digit[instlength[i]]];
      IF i # LAST[opcode] THEN PutChar[',];
      ENDLOOP;
    PutString["];"];
    PutCR[];
    CloseOutput[];
    END;
    
  -- generate list of opcodes
  
  OpcodeList: PROCEDURE [root: STRING] =
    BEGIN OPEN OpTableDefs;
    op: STRING;
    length: [0..3];
    i: opcode;
    digit: STRING = "0123456789"L;
    OpenOutput[root, ".list"L];
    PutString[
      "-- Mesa Opcodes
-- Format: name hoctal(decimal)push,pop,length,aligned

"L];
    FOR i IN opcode DO
      op _ InstName[i];
      IF (length _ instlength[i]) = 0 THEN op.length _ 0;
      PutString[op];
      THROUGH (op.length..8] DO PutChar[' ] ENDLOOP;
      PutNumber[i, hoctal3];
      PutChar['(];
      PutNumber[i, decimal3];
      PutChar[')];
      PutChar[digit[pushstack[i]]];
      PutChar[',];
      PutChar[digit[popstack[i]]];
      PutChar[',];
      PutChar[digit[length]];
      PutChar[',];
      PutChar[IF instaligned[i] THEN 'T ELSE 'F];
      IF i MOD 4 = 3 THEN BEGIN PutChar[';]; PutCR[] END ELSE PutString[";  "L];
      ENDLOOP;
    CloseOutput[];
    END;
    
  -- source file procedures
  
  SourceStream: StreamDefs.StreamHandle;
  sourceavailable: BOOLEAN;
  
  outcheck: PROCEDURE [xfirst: CARDINAL, xlast: CARDINAL] =
    BEGIN OPEN StreamDefs;
    nextchar: CHARACTER;
    lastcr: CARDINAL;
    IF ~sourceavailable THEN RETURN;
    FOR lastcr _ xfirst, lastcr - 1 UNTIL lastcr = 0 DO
      SetIndex[SourceStream, [0, lastcr]];
      IF SourceStream.get[SourceStream] = IODefs.CR THEN EXIT;
      ENDLOOP;
    THROUGH (lastcr..xfirst) DO PutChar[IODefs.SP] ENDLOOP;
    SetIndex[SourceStream, StreamIndex[0, xfirst]];
    WHILE xfirst # xlast DO
      nextchar _ SourceStream.get[SourceStream ! StreamError => GOTO eof];
      xfirst _ xfirst + 1;
      IF nextchar = IODefs.ControlZ THEN
	WHILE nextchar # IODefs.CR DO
	  nextchar _ SourceStream.get[SourceStream ! StreamError => GOTO eof];
	  xfirst _ xfirst + 1;
	  ENDLOOP;
      PutChar[nextchar];
      REPEAT eof => NULL;
      ENDLOOP;
    IF nextchar # IODefs.CR THEN PutChar[IODefs.CR];
    END;
    
  setupsource: PROCEDURE =
    BEGIN OPEN SegmentDefs;
    sourceavailable _ TRUE;
    SourceStream _ StreamDefs.CreateByteStream[
      NewFile[
      symbols.sourceFile, Read, DefaultVersion !
      FileNameError => BEGIN sourceavailable _ FALSE; CONTINUE END], Read];
    END;
    
  closesource: PROCEDURE =
    BEGIN IF sourceavailable THEN SourceStream.destroy[SourceStream] END;
    
  PrintBodyName: PROCEDURE [bti: Symbols.BTIndex] =
    BEGIN OPEN String, Symbols, symbols;
    sei: ISEIndex;
    hti: HTIndex;
    ss: SubStringDescriptor;
    IF sourceavailable THEN RETURN;
    WITH bb[bti] SELECT FROM
      Callable =>
	IF (sei _ id) = SENull OR (hti _ seb[sei].hash) = HTNull THEN RETURN;
      ENDCASE => RETURN;
    SubStringForHash[@ss, hti];
    PutSubString[@ss];
    PutChar[':];
    PutCR[];
    END;
    
  EvenUp: PROCEDURE [n: CARDINAL] RETURNS [CARDINAL] = 
    -- Round up to an even number
    BEGIN RETURN[n + n MOD 2]; END;
    
  getbyte: PROCEDURE [pc: CARDINAL] RETURNS [b: BYTE] = 
    -- pc is a byte address
    BEGIN OPEN InlineDefs;
    w: POINTER TO InstWord;
    IF absolute THEN
      BEGIN
      w _ LOOPHOLE[pc/2];
      b _
	IF BITAND[pc, 1] = 0 THEN
	(WITH w SELECT dStar FROM
	   FALSE => evenbyte,
	   TRUE => evenbyte,
	   ENDCASE => 0)
	ELSE
	  (WITH w SELECT dStar FROM
	     FALSE => oddbyte,
	     TRUE => oddbyte,
	     ENDCASE => 0);
      END
    ELSE
      BEGIN
      w _ codebase + pc/2;
      b _
	IF BITAND[pc, 1] = 0 THEN
	(WITH w SELECT dStar FROM
	   FALSE => evenbyte,
	   TRUE => evenbyte,
	   ENDCASE => 0)
	ELSE
	  (WITH w SELECT dStar FROM
	     FALSE => oddbyte,
	     TRUE => oddbyte,
	     ENDCASE => 0);
      END;
    END;
    
  getword: PROCEDURE [pc: CARDINAL] RETURNS [WORD] = 
    -- pc is a word address
    BEGIN
    IF absolute THEN RETURN[LOOPHOLE[pc, POINTER]^];
    RETURN[(codebase + pc)^];
    END;
    
  jumpaddress: PROCEDURE [jop: opcode, arg: INTEGER] RETURNS [CARDINAL] =
    BEGIN -- given a jump operator and its argument, return
    -- its target address
     OPEN Mopcodes;
    SELECT OpTableDefs.instlength[
      jop] FROM
      1 =>
	SELECT jop FROM
	  IN [zJ2..zJ9] => arg _ jop - zJ2 + 2;
	  IN [zJEQ2..zJEQ9] => arg _ jop - zJEQ2 + 2;
	  IN [zJNE2..zJNE9] => arg _ jop - zJNE2 + 2;
	  ENDCASE => ERROR;
      2 =>
	BEGIN
	IF arg > 177B THEN arg _ InlineDefs.BITOR[arg, 177400B];
	IF dStar THEN arg _ arg - 1;
	END;
      ENDCASE => IF dStar THEN arg _ arg - 2;
    RETURN[INTEGER[offset] + arg]
    END;
    
  outwjtab: PROCEDURE [
    tabstart, tablength: CARDINAL, octal: BOOLEAN, stripped: BOOLEAN] =
    BEGIN
    w: INTEGER;
    pc: CARDINAL;
    Pbytes _ Pbytes + tablength*2;
    FOR pc IN [tabstart..tabstart + tablength) DO
      w _ getword[pc];
      PutCR[];
      PutTab[];
      PutTab[];
      IF stripped THEN BEGIN PutNumber[w, hoctal5]; LOOP END;
      IF octal THEN BEGIN PutTab[]; PutTab[]; END;
      PutString[" ("L];
      PutNumber[jumpaddress[Mopcodes.zJIW, w], hoctal5];
      PutChar[')];
      ENDLOOP;
    END;
    
  outbjtab: PROCEDURE [
    tabstart, tablength: CARDINAL, octal: BOOLEAN, stripped: BOOLEAN] =
    BEGIN
    b: BYTE;
    pc: CARDINAL;
    Pbytes _ Pbytes + EvenUp[tablength];
    FOR pc IN [tabstart*2..tabstart*2 + tablength) DO
      b _ getbyte[IF dStar THEN pc ELSE InlineDefs.BITXOR[pc, 1]];
      -- bytes "backwards"
      PutCR[];
      PutTab[];
      PutTab[];
      IF stripped THEN BEGIN PutNumber[b, hoctal5]; LOOP END;
      IF octal THEN BEGIN PutTab[]; PutTab[]; END;
      PutString[" ("L];
      PutNumber[jumpaddress[Mopcodes.zJIB, b], hoctal5];
      PutChar[')];
      ENDLOOP;
    END;
    
  PutPair: PROCEDURE [byte: CARDINAL] =
    BEGIN
    a: CARDINAL = byte/16;
    b: CARDINAL = byte MOD 16;
    IF a < 8 AND b < 8 THEN PutChar[IODefs.SP];
    PutChar['[];
    PutNumber[a, hoctal1];
    PutChar[',];
    PutNumber[b, hoctal1];
    PutChar[']];
    RETURN
    END;
    
  printcode: PROCEDURE [
    startcode, endcode: CARDINAL, octal: BOOLEAN, stripped: BOOLEAN] =
    BEGIN -- list opcodes for indicated segment of code
     OPEN InlineDefs, Mopcodes;
    inst, byte: BYTE;
    lastconstant, v: INTEGER;
    il: [0..3];
    FOR offset IN [startcode..endcode) DO
      inst _ getbyte[offset];
      -- loginst[inst];
      Pinst _ Pinst + 1;
      PutTab[];
      IF ~stripped THEN
	BEGIN
	IF octal THEN
	  BEGIN
	  PutNumber[offset/2, hoctal5];
	  PutString[(IF offset MOD 2 = 0 THEN ",E " ELSE ",O ")];
	  END;
	PutNumber[offset, hoctal5];
	PutChar[':];
	END;
      IF octal THEN
	BEGIN PutTab[]; PutChar['[]; PutNumber[inst, hoctal3z]; PutChar[']]; END;
      PutTab[];
      PutString[OpTableDefs.InstName[inst]];
      il _ OpTableDefs.instlength[inst];
      IF ~dStar AND OpTableDefs.instaligned[inst] AND il # 2 AND 
	  (offset + il) MOD 2 # 0 THEN
	BEGIN
	byte _ getbyte[offset _ offset + 1];
	IF byte = 377B THEN PutChar['*]
	ELSE BEGIN PutString[" <"L]; PutNumber[byte, hoctal3]; PutChar['>]; END;
	Pbytes _ Pbytes + 1;
	END;
      SELECT il FROM
	0, 1 =>
	  BEGIN
	  Pbytes _ Pbytes + 1;
	  IF inst IN [zLI0..zLI6] THEN lastconstant _ inst - zLI0
	  ELSE
	    IF inst IN JumpOp AND ~stripped THEN
	      BEGIN
	      PutTab[];
	      PutString["       ("L];
	      PutNumber[jumpaddress[inst, 0], hoctal1];
	      PutChar[')];
	      END;
	  END;
	2 =>
	  BEGIN
	  Pbytes _ Pbytes + 2;
	  byte _ getbyte[(offset _ offset + 1)];
	  PutTab[];
	  SELECT inst FROM
	    zRILP, zWILP, zRXLP, zWXLP, zRIGP, zRXLPL, zWXLPL, zRXGPL, zWXGPL,
	      zRILPL, zWILPL, zRIGPL, zWIGPL => PutPair[byte];
	    ENDCASE => PutNumber[byte, hoctal6];
	  IF inst = zLIB THEN lastconstant _ byte
	  ELSE
	    IF inst IN JumpOp AND ~stripped THEN
	      BEGIN
	      PutString[" ("L];
	      PutNumber[jumpaddress[inst, byte], hoctal1];
	      PutChar[')];
	      END;
	  END;
	3 =>
	  BEGIN
	  ab: RECORD [first, second: BYTE];
	  Pbytes _ Pbytes + 3;
	  IF dStar THEN
	    BEGIN
	    ab.first _ getbyte[(offset _ offset + 1)];
	    ab.second _ getbyte[(offset _ offset + 1)];
	    END
	  ELSE
	    BEGIN
	    ab.second _ getbyte[(offset _ offset + 1)];
	    ab.first _ getbyte[(offset _ offset + 1)];
	    END;
	  PutTab[];
	  SELECT inst FROM
	    zRF, zWF, zWSF, zRFC, zRFL, zWFL =>
	      BEGIN
	      PutNumber[ab.first, hoctal6];
	      PutString[", "L];
	      PutPair[ab.second];
	      END;
	    ENDCASE =>
	      BEGIN
	      PutNumber[(v _ ab.first*256 + ab.second), hoctal6];
	      SELECT inst FROM
		zJIB => outbjtab[v, lastconstant, octal, stripped];
		zJIW => outwjtab[v, lastconstant, octal, stripped];
		zLIW => lastconstant _ v;
		IN JumpOp =>
		  IF ~stripped THEN
		    BEGIN
		    PutString[" ("L];
		    PutNumber[jumpaddress[inst, v], hoctal1];
		    PutChar[')];
		    END;
		ENDCASE;
	      END;
	  END;
	ENDCASE;
      PutCR[];
      ENDLOOP;
    END;
    
  ListFile: PROCEDURE [root: STRING, octal, stripped: BOOLEAN] =
    BEGIN OPEN String, SegmentDefs, symbols, Symbols;
    i: CARDINAL;
    cseg, sseg, bcdseg: FileSegmentHandle;
    bcdFile: STRING _ [40];
    AppendString[bcdFile, root];
    FOR i IN [0..root.length) DO
      IF root[i] = '. THEN EXIT;
      REPEAT FINISHED => AppendString[bcdFile, ".bcd"L];
      ENDLOOP;
    [cseg, sseg, bcdseg] _ ListerDefs.Load[bcdFile, TRUE];
    DoCodeListing[root, cseg, sseg, bcdseg, FIRST[MTIndex], octal, stripped];
    END;
    
  ListModInConfig: PROCEDURE [config, module: STRING, octal, stripped: BOOLEAN] =
    BEGIN OPEN String, SegmentDefs, symbols, Symbols;
    i: CARDINAL;
    cseg, sseg, bcdseg: FileSegmentHandle;
    bcdFile: STRING _ [40];
    mti: BcdDefs.MTIndex;
    AppendString[bcdFile, config];
    FOR i IN [0..config.length) DO
      IF config[i] = '. THEN EXIT;
      REPEAT FINISHED => AppendString[bcdFile, ".bcd"L];
      ENDLOOP;
    [cseg, sseg, bcdseg, mti] _ ListerDefs.LoadFromConfig[bcdFile, module, TRUE];
    DoCodeListing[module, cseg, sseg, bcdseg, mti, octal, stripped];
    END;
    
  ShowTotals: PROCEDURE =
    BEGIN OPEN String, SegmentDefs, symbols, Symbols;
    PutString["Instructions: "L];
    PutNumber[Pinst, decimal];
    PutString[", Bytes: "L];
    PutNumber[Pbytes _ EvenUp[Pbytes], decimal];
    PutCR[];
    PutCR[];
    Tinst _ Tinst + Pinst;
    Pinst _ 0;
    Tbytes _ Tbytes + Pbytes;
    Pbytes _ 0;
    END;
    
  DoCodeListing: PROC [
    root: STRING, cseg, sseg, bcdseg: FileSegmentHandle, mti: MTIndex,
    octal, stripped: BOOLEAN] =
    BEGIN OPEN BcdDefs, Symbols, SegmentDefs;
    i: CARDINAL;
    cspp: POINTER TO ControlDefs.CSegPrefix;
    ff: FineGrainInfo;
    bcd: BcdOps.BcdBase;
    mth: BcdOps.MTHandle;
    prevBti: BTIndex _ BTNull;
    SwapIn[bcdseg];
    bcd _ FileSegmentAddress[bcdseg];
    mth _ @LOOPHOLE[bcd + bcd.mtOffset, Base][mti];
    SwapIn[cseg];
    codebase _ FileSegmentAddress[cseg] + mth.code.offset;
    codepages _ cseg.pages;
    cspp _ codebase;
    dStar _ ~cspp.header.info.altoCode;
    symbols _ SymbolTable.Acquire[SymbolTable.TableForSegment[sseg]];
    ListerDefs.SetRoutineSymbols[symbols];
    setupsource[];
    OpenOutput[root, ".cl"L];
    ListerDefs.WriteFileID[];
    IF dStar THEN BEGIN PutCR[]; PutString["D* Format"L]; PutCR[]; END;
    IF mth.crossJumped THEN
      BEGIN PutCR[]; PutString["Cross Jumped"L]; PutCR[]; END;
    PutString["Global frame size:  "L];
    PutNumber[mth.framesize, decimal];
    PutCR[];
    PutCR[];
    Unlock[bcdseg];
    DeleteFileSegment[bcdseg];
    Tbytes _ Tinst _ 0;
    DigestFGT[];
    FOR i IN [0..LENGTH[myFGT]) DO
      ff _ myFGT[i];
      IF ff.bti # prevBti AND prevBti # BTNull THEN ShowTotals[];
      IF ff.firstSource # NullSource THEN
	IF ff.lastSource = ff.firstSource THEN PutCR[]
	ELSE outcheck[ff.firstSource, ff.lastSource];
      IF ff.bti # prevBti THEN
	BEGIN
	ep: CARDINAL = symbols.bb[ff.bti].entryIndex;
	evi: POINTER TO ControlDefs.EntryVectorItem = @cspp.entry[ep];
	fsize: CARDINAL = ControlDefs.FrameVec[evi.info.framesize];
	PrintBodyName[ff.bti];
	IF octal THEN PutTab[];
        PutString["   Entry point: "L];
	PutNumber[ep, decimal];
	PutString[",   Frame size:  "L];
	PutNumber[fsize, decimal];
	PutCR[];
	END;
      IF ~ff.procEnd THEN printcode[ff.pc, myFGT[i + 1].pc, octal, stripped];
      PutCR[];
      prevBti _ ff.bti;
      ENDLOOP;
    IF prevBti # Symbols.BTNull THEN ShowTotals[];
    Storage.Free[BASE[myFGT]];
    SymbolTable.Release[symbols];
    DeleteFileSegment[sseg ! SwapError => CONTINUE];
    Unlock[cseg];
    DeleteFileSegment[cseg ! SwapError => CONTINUE];
    closesource[];
    PutCR[];
    IF octal THEN PutTab[];
    PutString["Total instructions: "L];
    PutNumber[Tinst, decimal];
    PutString[", Bytes: "L];
    PutNumber[Tbytes, decimal];
    PutCR[];
    CloseOutput[];
    END;
    
  LCode: PROCEDURE [name: STRING, octal, stripped: BOOLEAN] =
    BEGIN OPEN ListerDefs;
    ListFile[
      name, octal, stripped !
      NoCode => BEGIN IODefs.WriteString["Code not available"L]; CONTINUE END;
      NoSymbols =>
	BEGIN IODefs.WriteString["Symbols not available"L]; CONTINUE END;
      NoFGT, IncorrectVersion =>
	BEGIN IODefs.WriteString["Bad format"L]; CONTINUE END;
      SegmentDefs.FileNameError =>
	BEGIN IODefs.WriteString["File not found"L]; CONTINUE END];
    END;
    
  Code: PROCEDURE [name: STRING] = BEGIN LCode[name, FALSE, FALSE]; END;
    
  OctalCode: PROCEDURE [name: STRING] = BEGIN LCode[name, TRUE, FALSE]; END;
    
  StrippedCode: PROCEDURE [name: STRING] = BEGIN LCode[name, FALSE, TRUE]; END;
    
  LCodeInConfig: PROCEDURE [config, name: STRING, octal, stripped: BOOLEAN] =
    BEGIN OPEN ListerDefs;
    ListModInConfig[
      config, name, octal, stripped !
      NoCode => BEGIN IODefs.WriteString["Code not available"L]; CONTINUE END;
      NoSymbols =>
	BEGIN IODefs.WriteString["Symbols not available"L]; CONTINUE END;
      NoFGT, IncorrectVersion =>
	BEGIN IODefs.WriteString["Bad format"L]; CONTINUE END;
      SegmentDefs.FileNameError =>
	BEGIN IODefs.WriteString["File not found"L]; CONTINUE END];
    END;
    
  CodeInConfig: PROCEDURE [config, name: STRING] =
    BEGIN LCodeInConfig[config, name, FALSE, FALSE]; END;
    
  OctalCodeInConfig: PROCEDURE [config, name: STRING] =
    BEGIN LCodeInConfig[config, name, TRUE, FALSE]; END;
    
  StrippedCodeInConfig: PROCEDURE [config, name: STRING] =
    BEGIN LCodeInConfig[config, name, FALSE, TRUE]; END;
    
  Init: PROCEDURE =
    BEGIN
    command: CommanderDefs.CommandBlockHandle;
    command _ CommanderDefs.AddCommand["Hexify", LOOPHOLE[Hexify], 0];
    command _ CommanderDefs.AddCommand["Octify", LOOPHOLE[Octify], 0];
    command _
      CommanderDefs.AddCommand["OpcodeLengths", LOOPHOLE[OpcodeLengths], 1];
    command.params[0] _ [type: string, prompt: "Filename"];
    command _ CommanderDefs.AddCommand["OpcodeList", LOOPHOLE[OpcodeList], 1];
    command.params[0] _ [type: string, prompt: "Filename"];
    command _ CommanderDefs.AddCommand["OctalCode", LOOPHOLE[OctalCode], 1];
    command.params[0] _ [type: string, prompt: "Filename"];
    command _ CommanderDefs.AddCommand["Code", LOOPHOLE[Code], 1];
    command.params[0] _ [type: string, prompt: "Filename"];
    command _ CommanderDefs.AddCommand["StrippedCode", LOOPHOLE[StrippedCode], 1];
    command.params[0] _ [type: string, prompt: "Filename"];
    command _ CommanderDefs.AddCommand[
      "OctalCodeInConfig", LOOPHOLE[OctalCodeInConfig], 2];
    command.params[0] _ [type: string, prompt: "ConfigName"];
    command.params[1] _ [type: string, prompt: "ModName"];
    command _ CommanderDefs.AddCommand["CodeInConfig", LOOPHOLE[CodeInConfig], 2];
    command.params[0] _ [type: string, prompt: "ConfigName"];
    command.params[1] _ [type: string, prompt: "ModName"];
    command _ CommanderDefs.AddCommand[
      "StrippedCodeInConfig", LOOPHOLE[StrippedCodeInConfig], 2];
    command.params[0] _ [type: string, prompt: "ConfigName"];
    command.params[1] _ [type: string, prompt: "ModName"];
    END;
    
  Init[];
  END. of listcode