1 line
7.0 KiB
NASM
1 line
7.0 KiB
NASM
|
mcopy symbols.macros
****************************************************************
*
* EnterId - Enter an identifier in the symbol table
*
* Inputs:
* fcp - pointer to the identifier record
*
****************************************************************
*
EnterId start
using GetCom
lcp equ 1 local identifier pointer
lcpl equ 5 last lcp
lleft equ 9 left link?
p1 equ 13 work pointers
p2 equ 17
sub (4:fcp),20
ldx #displaySize lcp := display[top].fname;
lda TOP
jsl ~mul2
clc
adc #display_fname
tax
lda DISPLAY,X
sta lcp
lda DISPLAY+2,X
sta lcp+2
ora lcp if lcp = nil then
bne lb1
lda fcp display[top].fname := fcp
sta DISPLAY,X
lda fcp+2
sta DISPLAY+2,X
brl lb10 else begin
lb1 anop repeat
move4 lcp,lcpl lcpl := lcp;
ldy #2 comp :=
lda [lcp],Y compnames(lcp^.name^,fcp^.name^);
pha
lda [lcp]
pha
lda [fcp],Y
pha
lda [fcp]
pha
jsl CompNames
tax if comp = 0 then begin
bne lb4 {name conflict, follow right link}
listerror #30 error(30);
! lcp := lcp^.rlink;
! lleft := false;
bra lb5 end
lb4 bpl lb6 else if comp < 0 then begin
lb5 ldy #identifier_rlink lcp := lcp^.rlink;
lda [lcp],Y
tax
iny
iny
lda [lcp],Y
sta lcp+2
stx lcp
stz lleft lleft := false;
bra lb7 end
lb6 anop else begin
ldy #identifier_llink lcp := lcp^.llink;
lda [lcp],Y
tax
iny
iny
lda [lcp],Y
sta lcp+2
stx lcp
lda #true lleft := true;
sta lleft
! end
lb7 lda lcp until lcp = nil;
ora lcp+2
bne lb1
lda lleft if lleft then
beq lb8
ldy #identifier_llink lcpl^.llink := fcp
bra lb9 else
lb8 ldy #identifier_rlink lcpl^.rlink := fcp
lb9 lda fcp
sta [lcpl],Y
iny
iny
lda fcp+2
sta [lcpl],Y
lb10 anop end;
ldy #identifier_llink fcp^.llink := nil;
lda #0 fcp^.rlink := nil;
sta [fcp],Y
iny
iny
sta [fcp],Y
iny
iny
sta [fcp],Y
iny
iny
sta [fcp],Y
ret
end
****************************************************************
*
* MarkAsUsed - Insert a name into the list of names used from other levels
*
* Inputs:
* name - pointer to name used
* top - index to display for the proper used list
*
****************************************************************
*
MarkAsUsed private
using GetCom
p1 equ 1 work pointer
p2 equ 5
p3 equ 9
sub (4:name),12
lda TOP p1 := @display[top].labsused;
ldx #DisplaySize
jsl ~mul2
clc
adc #display_labsused
adc #display
sta p1
lda #^display
sta p1+2
ldy #2 p2 := p1^;
lda [p1]
sta p2
lda [p1],Y
sta p2+2
lb1 lda p2 while p2 <> nil do begin
ora p2+2
beq lb3
ldy #ltype_name if p2^.name = name then
lda [p2],Y
cmp name
bne lb2
iny
iny
lda [p2],Y
cmp name+2
beq lb4 goto 1;
lb2 ldy #ltype_next p2 := p2^.next;
lda [p2],Y
tax
iny
iny
lda [p2],Y
sta p2+2
stx p2
bra lb1 end;
lb3 ph2 #ltypeSize new(p3);
jsl Malloc
sta p3
stx p3+2
ldy #ltype_name p3^.name := name;
lda name
sta [p3],Y
iny
iny
lda name+2
sta [p3],Y
ldy #ltype_next p3^.next := p1^;
lda [p1]
sta [p3],Y
ldy #2
lda [p1],Y
ldy #ltype_next+2
sta [p3],Y
ldy #ltype_disx p3^.disx := disx;
lda DISX
sta [p3],Y
lda p3 p1^ := p3;
sta [p1]
ldy #2
lda p3+2
sta [p1],Y
lb4 anop 1:
ret
end
****************************************************************
*
* SearchId - find an identifier
*
* Inputs:
* fidcls - set of allowable identifiers
* fcp - address to place pointer to identifier found
*
****************************************************************
*
SearchId start
using GetCom
lcp equ 1 pointer to current symbol
ldisx equ 5 address of display record being searched
len equ 9 length of the string
p1 equ 11
!DISX pointer display level where the symbol is found
typesSet equ 1 set masks for elements of idclass
konstSet equ 2
varsmSet equ 4
fieldSet equ 8
procSet equ 16
; sub (1:fidcls,4:fcp),14 Pascal 1.x
sub (2:fidcls,4:fcp),14 Pascal 2.x
lda id len := length(ID)+1;
and #$00FF
inc a
sta len
lda TOP for ldisx := top downto 0 do begin
sta DISX disx := ldisx;
ldx #displaySize
jsl ~mul2
clc
adc #DISPLAY
sta ldisx
lda #^DISP
|