ORCA-Pascal/objout.asm

404 lines
9.8 KiB
NASM

mcopy objout.macros
****************************************************************
*
* Code Generator Output Routines
*
* This module provides fast object module output for the code
* generator. Currently, the maximum size for a single object
* segment is 64K.
*
* By Mike Westerfield
*
* Copyright July 1987
* Byte Works, Inc.
*
****************************************************************
*
ObjData privdata place with ~globals
;
; Constants
;
! NOTE: tokenBuffSize also defined in cgi.pas
tokenBuffSize equ 4095 size of the token buffer
end
****************************************************************
*
* COut - write a code byte to the object file
*
* Inputs:
* b - byte to write (on stack)
*
****************************************************************
*
COut start
phb OutByte(b);
pla
ply
plx
phy
pha
plb
jsr OutByte
inc blkcnt blkcnt := blkcnt+1;
inc4 pc pc := pc+1;
rtl
end
****************************************************************
*
* CnOut - write a byte to the constant buffer
*
* Inputs:
* i - byte to write
*
****************************************************************
*
CnOut start
maxCBuffLen equ 191 max index into the constant buffer
lda cBuffLen if cBuffLen = maxCBuffLen then
cmp #maxCBuffLen
bne lb1
jsl Purge Purge;
lb1 phb cBuff[cBuffLen] := i;
plx
ply
pla
phy
phx
plb
ldx cBuffLen
short M
sta cBuff,X
long M
inc cBuffLen cBuffLen := cBuffLen+1;
rtl
end
****************************************************************
*
* CnOut2 - write a word to the constant buffer
*
* Inputs:
* i - word to write
*
****************************************************************
*
CnOut2 start
maxCBuffLen equ 191 max index into the constant buffer
lda cBuffLen if cBuffLen+1 >= maxCBuffLen then
inc A
cmp #maxCBuffLen
blt lb1
jsl Purge Purge;
lb1 phb cBuff[cBuffLen] := i;
plx
ply
pla
phy
phx
plb
ldx cBuffLen
sta cBuff,X
inx cBuffLen := cBuffLen+2;
inx
stx cBuffLen
rtl
end
****************************************************************
*
* GrowHandle - Grow the area occupied by a handle
*
* Inputs:
* size - new size for the buffer
* haddr - address of the handle
*
* Notes:
* This subroutine must only be used if the handle is
* grown. It will fail if you try to shrink the handle.
*
****************************************************************
*
GrowHandle start
shandle equ 1 source handle
dhandle equ 5 destination handle
sptr equ 9 source pointer
dptr equ 13 destination pointer
sub (4:size,4:haddr),16
ldy #2 recover the source handle
lda [haddr]
sta shandle
lda [haddr],Y
sta shandle+2
ph4 shandle unlock the handle
_HUnlock
pha allocate a new area
pha
ph4 size
ph2 >~User_ID
ph2 #$8000
ph4 #0
_NewHandle
bcc lb0
ph2 #3
ph4 #0
jsl TermError
lb0 pl4 dhandle
ph4 shandle lock the source handle
_HLock
ldy #2 dereference the dest handle
lda [dhandle]
sta dptr
lda [dhandle],Y
sta dptr+2
lda [shandle] dereference the source handle
sta sptr
lda [shandle],Y
sta sptr+2
pha get the size of the source handle
pha
ph4 shandle
_GetHandleSize
pl2 size
plx move 64K chunks
beq lb2
ldy #0
lb1 lda [sptr],Y
sta [dptr],Y
dey
dey
bne lb1
inc sptr+2
inc dptr+2
dex
bne lb1
lb2 lda size move the remaining bytes
beq lb5
lsr a
bcc lb2a
short M
lda [sptr]
sta [dptr]
long M
inc4 sptr
inc4 dptr
dec size
beq lb5
lb2a ldy size
bra lb4
lb3 lda [sptr],Y
sta [dptr],Y
lb4 dey
dey
bne lb3
lda [sptr]
sta [dptr]
lb5 ph4 shandle dispose of the source handle
_DisposeHandle
ldy #2 save the new handle
lda dhandle
sta [haddr]
lda dhandle+2
sta [haddr],Y
ret
end
****************************************************************
*
* Out - write a byte to the output file
*
* Inputs:
* b - byte to write (on stack)
*
****************************************************************
*
Out start
phb OutByte(b);
pla
ply
plx
phy
pha
plb
jsr OutByte
inc blkcnt blkcnt := blkcnt+1;
rtl
end
****************************************************************
*
* Out2 - write a word to the output file
*
* Inputs:
* w - word to write (on stack)
*
****************************************************************
*
Out2 start
phb OutWord(w);
pla
ply
plx
phy
pha
plb
jsr OutWord
inc blkcnt blkcnt := blkcnt+2;
inc blkcnt
rtl
end
****************************************************************
*
* OutByte - write a byte to the object file
*
* Inputs:
* X - byte to write
*
****************************************************************
*
OutByte private
lda objLen if objLen+segDisp = buffSize then
clc
adc segDisp
bcc lb2
phx PurgeObjBuffer;
jsl PurgeObjBuffer
plx
lda objLen check for segment overflow
clc
adc segDisp
bcs lb2a
lb2 ph4 objPtr p := pointer(ord4(objPtr)+segDisp);
tsc p^ := b;
phd
tcd
ldy segDisp
short M
txa
sta [1],Y
long M
inc segDisp segDisp := segDisp+1;
pld
tsc
clc
adc #4
tcs
rts
lb2a lda #$8000 handle a segment overflow
sta segDisp
ph2 #112
jsl Error
rts
end
****************************************************************
*
* OutWord - write a word to the object file
*
* Inputs:
* X - word to write
*
****************************************************************
*
OutWord private
lda objLen if objLen+segDisp+1 = buffSize then
sec
adc segDisp
bcc lb2
phx PurgeObjBuffer;
jsl PurgeObjBuffer
plx
lda objLen check for segment overflow
sec
adc segDisp
bcs lb3
lb2 ph4 objPtr p := pointer(ord4(objPtr)+segDisp);
tsc p^ := b;
phd
tcd
ldy segDisp
txa
sta [1],Y
iny segDisp := segDisp+2;
iny
sty segDisp save new segDisp
pld
tsc
clc
adc #4
tcs
rts
lb3 ph2 #112 flag segment overflow error
jsl Error
lda #$8000
sta segDisp
rts
end
****************************************************************
*
* TokenOut - write a byte to the interface file
*
* Inputs:
* 4,s - byte to write (in a word)
*
****************************************************************
*
TokenOut start
using ObjData
ptr equ 1 pointer to token buffer
sub (2:byte),4
lda codeGeneration quit if no keep
jeq lb2
ldy tokenDisp if at end of buffer then
cpy #tokenBuffSize
bne lb1
add4 tokenLen,#tokenBuffSize update tokenLen
clc expand the token buffer
lda tokenLen
adc #tokenBuffSize+1
tax
lda tokenLen+2
adc #0
pha
phx
ph4 #tokenHandle
jsl GrowHandle
move4 tokenHandle,ptr dereference the pointer
clc
lda [ptr]
adc tokenLen
sta tokenPtr
ldy #2
lda [ptr],Y
adc tokenLen+2
sta tokenPtr+2
stz tokenDisp set the disp back to 0
lb1 anop endif
move4 tokenPtr,ptr set the buffer pointer
ldy tokenDisp
lda byte save the byte
sta [ptr],Y
inc tokenDisp inc disp in buffer
lb2 ret
end