! File:   FINLST.BLI
!
Module FINLST=
Begin

Require 'Bliss';

Forward Routine
	ERASEDET;

! create a new code/label/reference cell

Global Routine GETCELL(TYPE : Integer,SIZE : Integer) =
Begin
    Local
	P		: Ref CELL;

    P = GETSPACE(.SIZE);
    P[cel_next] = .P;
    P[cel_prev] = .P;
    P[cel_bot]  = .P;
    P[cel_top]  = .P;
    P[cel_size] = .SIZE;
    P[cel_type] = .TYPE;
    Return .P
End;

! create a new code cell

Global Routine NEWCODECELL =
Begin
    Return GETCELL(CELL_CODE,SZ_CELL_CODE)
End;

! create a new label cell

Global Routine NEWLABCELL(LTYPE : Integer,LNAME : Ref ST) =
Begin
    Local
	LAB		: Ref CELL;

    LAB = GETCELL(CELL_LABEL,SZ_CELL_LABEL);
    LAB[cel_lab_type] = .LTYPE;
    LAB[cel_lab_name] = .LNAME;
    Return .LAB
End;

! place a cell at the end of a given cell's attached list

Global Routine PUSHBOT(HD : Ref CELL,IND : Ref CELL) =
Begin
    Local
	PREVBOT		: Ref CELL;

    PREVBOT = .HD[cel_bot];
    HD[cel_bot] = .IND;
    If .PREVBOT Eql .HD Then
	PREVBOT[cel_top] = .IND
    Else
	PREVBOT[cel_next] = .IND;
    IND[cel_prev] = .PREVBOT;
    IND[cel_next] = .HD;
    Return .IND
End;

! place a cell at the front of a given cell's attached list

Global Routine PUSHTOP(HD : Ref CELL,IND : Ref CELL) =
Begin
    Local
	PREVTOP		: Ref CELL;

    PREVTOP = .HD[cel_top];
    HD[cel_top] = .IND;
    If .PREVTOP Eql .HD Then
	PREVTOP[cel_bot] = .IND
    Else
	PREVTOP[cel_prev] = .IND;
    IND[cel_prev] = .HD;
    IND[cel_next] = .PREVTOP;
    Return .IND
  End;

! PLACE UNATTACHED C2 AFTER C1

Global Routine AFTER(C1 : Ref CELL,C2 : Ref CELL) =
Begin
    Local
	P		: Ref CELL;

    P = .C1[cel_next];
    If .P[cel_prev] Neq .C1 Then
	P[cel_bot] = .C2
    Else
	P[cel_prev] = .C2;
    C2[cel_prev] = .C1;
    C2[cel_next] = .C1[cel_next];
    C1[cel_next] = .C2;
    Return .C2
End;

! PLACE UNATTACHED C1 BEFORE C2

Global Routine BEFORE(C2 : Ref CELL,C1 : Ref CELL) =
Begin
    Local
	P		: Ref CELL;

    P = .C2[cel_prev];
    If .P[cel_next] Neq .C2 Then
	P[cel_top] = .C1
    Else
	P[cel_next] = .C1;
    C1[cel_prev] = .C2[cel_prev];
    C1[cel_next] = .C2;
    C2[cel_prev] = .C1
End;

Global Routine NEWBOT(HD : Ref CELL,TYPE : Integer,SIZE : Integer) =
Begin
    PUSHBOT(.HD,GETCELL(.TYPE,.SIZE))
End;

! detach a cell from any other cells it is attached to

Global Routine DETACH(IND : Ref CELL) =
Begin
    Local
	P		: Ref CELL;

    P = .IND[cel_next];
    If .P[cel_prev] Neq .IND Then
	P[cel_bot] = .IND[cel_prev]
    Else
	P[cel_prev] = .IND[cel_prev];
    P = .IND[cel_prev];
    If .P[cel_next] Neq .IND Then
	P[cel_top] = .IND[cel_next]
    Else
	P[cel_next] = .IND[cel_next];
    Return .IND
End;

! erase all cells attached to a given cell

Global Routine EMPTYDET(IND : Ref CELL) =
Begin
    Local
	CURS		: Ref CELL;

    CURS = .IND[cel_top];
    Until .CURS Eql .IND Do
	CURS = ERASEDET(.CURS);
    Return .IND
End;

! erase a cell

Global Routine ERASEDET(IND : Ref CELL) =
Begin
    Local
	VAL		: Ref CELL;

    VAL = .IND[cel_next];
    EMPTYDET(.IND);
    RELEASESPACE(.IND,.IND[cel_size]);
    Return .VAL
End;

Global Routine ERASE(IND : Ref CELL) =
Begin
    Return ERASEDET(DETACH(.IND))
End;

Global Routine ERASELIST(HDR : Ref CELL) : Novalue =
Begin
    Local
	CURS		: Ref CELL;

    CURS = .HDR[cel_next];
    Until .CURS Eql .HDR Do
	CURS = ERASEDET(.CURS)
End;

! create a new label cell

Global Routine NEWLAB =
Begin
    LABELNO = .LABELNO + 1;
    Return NEWLABCELL(LAB_COMP,.LABELNO)
End;

Global Routine NEWTOP(HD : Ref CELL,TYPE : Integer,SIZE : Integer) =
Begin
    Return PUSHTOP(.HD,GETCELL(.TYPE,.SIZE))
End;

! move to the next code cell

Global Routine NXTCC(I : Ref CELL) =
Begin
    Do
	I = .I[cel_next]
    Until .I[cel_type] Eql CELL_CODE;
    Return .I
End;

! move to the next code or label cell

Global Routine NXTLCC(I : Ref CELL) =
Begin
    Do
	I = .I[cel_next]
    Until .I[cel_type] Eql CELL_CODE Or .I[cel_type] Eql CELL_LABEL;
    Return .I
End;

! move to the previous non-conditional jump cell

Global Routine PREVNONBR(CURS : Ref CELL) =
Begin
    Do
	CURS = .CURS[cel_prev]
    While .CURS[cel_type] Eql CELL_CODE And .CURS[cel_class] Eql INST_COND_JUMP;
    Return .CURS
End;

! move to the previous code cell

Global Routine PRVCC(I : Ref CELL) =
Begin
    Do
	I = .I[cel_prev]
    Until .I[cel_type] Eql CELL_CODE;
    Return .I
End;

! move to the previous code or label cell

Global Routine PRVLCC(I : Ref CELL) =
Begin
    Do
	I = .I[cel_prev]
    Until .I[cel_type] Eql CELL_CODE Or .I[cel_type] Eql CELL_LABEL;
    Return .I
End;

End
Eludom