522 lines
9.7 KiB
NASM
522 lines
9.7 KiB
NASM
mcopy pcommon.macros
|
|
****************************************************************
|
|
*
|
|
* MMCom - common data area for the memory manager
|
|
*
|
|
****************************************************************
|
|
*
|
|
MMCom privdata
|
|
;
|
|
; constants
|
|
;
|
|
maxBuffSize equ 16*1024 size of a buffer
|
|
;
|
|
; data
|
|
;
|
|
buffSize ds 2 remaining bytes in the current buffer
|
|
currBuffHand ds 4 handle of current buffer
|
|
currBuffStart ds 4 pointer to start of current buffer
|
|
nextPtr ds 4 pointer to next byte in current buffer
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* BRK - break into the debugger
|
|
*
|
|
* Inputs:
|
|
* 4,S - break code
|
|
*
|
|
****************************************************************
|
|
*
|
|
BRK start
|
|
|
|
phb
|
|
plx
|
|
ply
|
|
pla
|
|
and #$00FF
|
|
xba
|
|
sta lb1
|
|
phy
|
|
phx
|
|
plb
|
|
lb1 brk $00
|
|
rtl
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* Calloc - allocate and clear a new memory area
|
|
*
|
|
* Inputs:
|
|
* size - # bytes to allocate
|
|
*
|
|
* Outputs:
|
|
* X-A - pointer to memory
|
|
*
|
|
* Notes: Assumes size > 2
|
|
*
|
|
****************************************************************
|
|
*
|
|
Calloc start
|
|
ptr equ 1 pointer to memory
|
|
|
|
sub (2:size),4
|
|
|
|
ph2 size allocate the memory
|
|
jsl Malloc
|
|
sta ptr
|
|
stx ptr+2
|
|
|
|
ldy size if there are an odd number of bytes then
|
|
tya
|
|
lsr A
|
|
bcc lb1
|
|
dey clear the last byte
|
|
short M
|
|
lda #0
|
|
sta [ptr],Y
|
|
long M
|
|
lb1 lda #0 clear the memory, one word at a time
|
|
lb2 dey
|
|
dey
|
|
sta [ptr],Y
|
|
bne lb2
|
|
|
|
ret 4:ptr
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* CompNames - Compare two names
|
|
*
|
|
* Inputs:
|
|
* name1, name2 - addresses of the two strings to compare
|
|
*
|
|
* Outputs:
|
|
* int - 0 if equal, -1 if name1<name2, 1 if name1>name2
|
|
*
|
|
****************************************************************
|
|
*
|
|
CompNames start
|
|
result equ 1
|
|
|
|
sub (4:name1,4:name2),2
|
|
|
|
short I,M
|
|
lda [name1] get the length of the shorter string
|
|
cmp [name2]
|
|
blt lb1
|
|
lda [name2]
|
|
lb1 tax
|
|
beq lb2a
|
|
ldy #1 compare the existing characters
|
|
lb2 lda [name1],Y
|
|
cmp [name2],Y
|
|
bne lb4
|
|
iny
|
|
dex
|
|
bne lb2
|
|
lb2a lda [name1] characters match -- compare the lengths
|
|
cmp [name2]
|
|
bne lb4
|
|
|
|
lb3 long I,M
|
|
lda #0 strings match
|
|
bra lb6
|
|
|
|
lb4 long I,M strings don't match -- set condition code
|
|
bge lb5
|
|
lda #-1
|
|
bra lb6
|
|
lb5 lda #1
|
|
lb6 sta result
|
|
|
|
ret 2:result
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* KeyPress - Has a key been presed?
|
|
*
|
|
* If a key has not been pressed, this function returns
|
|
* false. If a key has been pressed, it clears the key
|
|
* strobe. If the key was an open-apple ., a terminal exit
|
|
* is performed; otherwise, the function returns true.
|
|
*
|
|
****************************************************************
|
|
*
|
|
KeyPress start
|
|
|
|
KeyPressGS kpRec
|
|
lda kpAvailable
|
|
beq rts
|
|
ReadKeyGS rkRec
|
|
lda rkKey
|
|
cmp #'.'
|
|
bne lb1
|
|
lda rkModifiers
|
|
and #$0100
|
|
beq lb1
|
|
ph2 #0
|
|
ph4 #0
|
|
jsl TermError
|
|
|
|
lb1 lda #1
|
|
rts rtl
|
|
|
|
kpRec dc i'3'
|
|
kpKey ds 2
|
|
kpModifiers ds 2
|
|
kpAvailable ds 2
|
|
|
|
rkRec dc i'2'
|
|
rkKey ds 2
|
|
rkModifiers ds 2
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* Mark - mark the stack
|
|
*
|
|
* Inputs:
|
|
* ptr - location to place mark
|
|
*
|
|
****************************************************************
|
|
*
|
|
Mark start
|
|
using MMCom
|
|
|
|
sub (4:ptr),0
|
|
|
|
ldy #2 ptr^ := nextPtr
|
|
lda nextPtr
|
|
sta [ptr]
|
|
lda nextPtr+2
|
|
sta [ptr],Y
|
|
|
|
ret
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* MMInit - initialize the memory manager
|
|
*
|
|
****************************************************************
|
|
*
|
|
MMInit start
|
|
using MMCom
|
|
|
|
stz buffSize no bytes in current buffer
|
|
stz currBuffHand nil handle
|
|
stz currBuffHand+2
|
|
rtl
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* Malloc - allocate a new memory area
|
|
*
|
|
* Inputs:
|
|
* size - # bytes to allocate
|
|
*
|
|
* Outputs:
|
|
* X-A - pointer to memory
|
|
*
|
|
****************************************************************
|
|
*
|
|
Malloc start
|
|
using MMCom
|
|
ptr equ 1 pointer to memory
|
|
handle equ 5 new memory handle
|
|
lptr equ 9 work pointer
|
|
|
|
sub (2:size),12
|
|
|
|
lda buffSize if buffSize < size then begin
|
|
cmp size
|
|
bge lb2
|
|
ph4 #0 handle := AppleNew(maxBuffSize);
|
|
ph4 #maxBuffSize
|
|
ph2 >~User_ID
|
|
ph2 #$C010
|
|
ph4 #0
|
|
_NewHandle
|
|
bcc lb1
|
|
ph2 #3
|
|
ph4 #0
|
|
jsl TermError
|
|
|
|
lb1 pl4 handle
|
|
ldy #2 lptr := handle^;
|
|
lda [handle],Y currBuffStart := handle^;
|
|
sta lptr+2
|
|
sta currBuffStart+2
|
|
lda [handle]
|
|
sta lptr
|
|
sta currBuffStart
|
|
lda currBuffHand+2 lptr[0] := currBuffHand;
|
|
sta [lptr],Y
|
|
lda currBuffHand
|
|
sta [lptr]
|
|
move4 handle,currBuffHand currBuffHand := handle;
|
|
add4 lptr,#4,nextPtr nextPtr := lptr+4;
|
|
lda #maxBuffSize-4 buffSize := maxBuffSize-4;
|
|
sta buffSize
|
|
lb2 anop end;
|
|
clc ptr := nextPtr;
|
|
lda nextPtr nextPtr := nextPtr+size;
|
|
sta ptr
|
|
adc size
|
|
sta nextPtr
|
|
lda nextPtr+2
|
|
sta ptr+2
|
|
adc #0
|
|
sta nextPtr+2
|
|
sub2 buffSize,size buffSize := buffSize-size;
|
|
|
|
ret 4:ptr
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* ~Move - move some bytes
|
|
*
|
|
* Inputs:
|
|
* source - pointer to source bytes
|
|
* dest - pointer to destination bytes
|
|
* len - number of bytes to move
|
|
*
|
|
* Notes:
|
|
* Also used to copy strings via CopyString entry point
|
|
*
|
|
****************************************************************
|
|
*
|
|
~Move start
|
|
CopyString entry
|
|
|
|
sub (4:dest,4:source,2:len),0
|
|
|
|
lda len move one byte if the move length is odd
|
|
lsr a
|
|
bcc lb1
|
|
short M
|
|
lda [source]
|
|
sta [dest]
|
|
long M
|
|
inc4 source
|
|
inc4 dest
|
|
dec len
|
|
lb1 ldy len move the bytes
|
|
beq lb4
|
|
dey
|
|
dey
|
|
beq lb3
|
|
lb2 lda [source],Y
|
|
sta [dest],Y
|
|
dey
|
|
dey
|
|
bne lb2
|
|
lb3 lda [source]
|
|
sta [dest]
|
|
|
|
lb4 ret
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* Release - release previously marked memory
|
|
*
|
|
* Inputs:
|
|
* ptr - pointer supplied by Mark
|
|
*
|
|
****************************************************************
|
|
*
|
|
Release start
|
|
using MMCom
|
|
lptr equ 1 local work pointer
|
|
handle equ 5 work handle
|
|
|
|
sub (4:ptr),8
|
|
|
|
lb1 lda ptr+2 while not ((ptr >= currBuffStart)
|
|
cmp currBuffStart+2 and (ptr <= nextPtr)) do begin
|
|
bne lb2
|
|
lda ptr
|
|
cmp currBuffStart
|
|
lb2 blt lb4
|
|
lda ptr+2
|
|
cmp nextPtr+2
|
|
bne lb3
|
|
lda ptr
|
|
cmp nextPtr
|
|
lb3 ble lb5
|
|
lb4 move4 currBuffStart,lptr handle := currBuffStart[0];
|
|
ldy #2
|
|
lda [lptr]
|
|
sta handle
|
|
lda [lptr],Y
|
|
sta handle+2
|
|
ph4 currBuffHand AppleDispose(currBuffHand);
|
|
_DisposeHandle
|
|
move4 handle,currBuffHand currBuffHand := handle;
|
|
ldy #2 currBuffStart := handle^;
|
|
lda [handle]
|
|
sta currBuffStart
|
|
lda [handle],Y
|
|
sta currBuffStart+2
|
|
! nextPtr := currBuffStart+maxBuffSize;
|
|
add4 currBuffStart,#maxBuffSize,nextPtr
|
|
stz buffSize buffSize := 0;
|
|
bra lb1 end;
|
|
lb5 sec buffSize := buffSize-ptr+nextPtr;
|
|
lda nextPtr
|
|
sbc ptr
|
|
clc
|
|
adc buffSize
|
|
sta buffSize
|
|
move4 ptr,nextPtr nextPtr := ptr;
|
|
|
|
ret
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* StdNames - Initialize the standard names array
|
|
*
|
|
* Outputs:
|
|
* NA - set to addresses of appropriate strings
|
|
*
|
|
****************************************************************
|
|
*
|
|
StdNames start
|
|
ptrSize equ 4 size of a pointer
|
|
maxNA equ 77 # elements in NA array
|
|
|
|
move lNA,NA,#ptrSize*maxNA
|
|
rtl
|
|
|
|
|
|
lNA dc a4'l01,l02,l03,l04,l05,l06,l07,l08,l09,l10'
|
|
dc a4'l11,l12,l13,l14,l15,l16,l17,l18,l19,l20'
|
|
dc a4'l21,l22,l23,l24,l25,l26,l27,l28,l29,l30'
|
|
dc a4'l31,l32,l33,l34,l35,l36,l37,l38,l39,l40'
|
|
dc a4'l41,l42,l43,l44,l45,l46,l47,l48,l49,l50'
|
|
dc a4'l51,l52,l53,l54,l55,l56,l57,l58,l59,l60'
|
|
dc a4'l61,l62,l63,l64,l65,l66,l67,l68,l69,l70'
|
|
dc a4'l71,l72,l73,l74,l75,l76,l77'
|
|
|
|
l01 dw 'FALSE'
|
|
l02 dw 'TRUE'
|
|
l03 dw 'INPUT'
|
|
l04 dw 'OUTPUT'
|
|
l05 dw 'GET'
|
|
l06 dw 'PUT'
|
|
l07 dw 'OPEN'
|
|
l08 dw 'CLOSE'
|
|
l09 dw 'RESET'
|
|
l10 dw 'REWRITE'
|
|
l11 dw 'READ'
|
|
l12 dw 'WRITE'
|
|
l13 dw 'PACK'
|
|
l14 dw 'UNPACK'
|
|
l15 dw 'NEW'
|
|
l16 dw '@B1'
|
|
l17 dw 'READLN'
|
|
l18 dw 'WRITELN'
|
|
l19 dw 'PAGE'
|
|
l20 dw '@B2'
|
|
l21 dw 'DISPOSE'
|
|
l22 dw '@B3'
|
|
l23 dw 'SEEK'
|
|
l24 dw 'ABS'
|
|
l25 dw 'SQR'
|
|
l26 dw 'TRUNC'
|
|
l27 dw 'ROUND'
|
|
l28 dw 'ODD'
|
|
l29 dw 'ORD'
|
|
l30 dw 'CHR'
|
|
l31 dw 'PRED'
|
|
l32 dw 'SUCC'
|
|
l33 dw 'EOF'
|
|
l34 dw 'EOLN'
|
|
l35 dw 'SIN'
|
|
l36 dw 'COS'
|
|
l37 dw 'EXP'
|
|
l38 dw 'SQRT'
|
|
l39 dw 'LN'
|
|
l40 dw 'ARCTAN'
|
|
l41 dw 'HALT'
|
|
l42 dw 'SEED'
|
|
l43 dw 'DELETE'
|
|
l44 dw 'INSERT'
|
|
l45 dw 'SHELLID'
|
|
l46 dw 'COMMANDLINE'
|
|
l47 dw 'STARTGRAPH'
|
|
l48 dw 'STARTDESK'
|
|
l49 dw 'ENDGRAPH'
|
|
l50 dw 'ENDDESK'
|
|
l51 dw 'ORD4'
|
|
l52 dw 'CNVDS'
|
|
l53 dw 'CNVIS'
|
|
l54 dw 'CNVSR'
|
|
l55 dw 'CNVSI'
|
|
l56 dw 'CNVSL'
|
|
l57 dw 'RANDOM'
|
|
l58 dw 'RANDOMINTEGER'
|
|
l59 dw 'RANDOMLONGINT'
|
|
l60 dw 'CONCAT'
|
|
l61 dw 'COPY'
|
|
l62 dw 'LENGTH'
|
|
l63 dw 'POS'
|
|
l64 dw 'RANDOMDOUBLE'
|
|
l65 dw 'CNVRS'
|
|
l66 dw 'CNVSD'
|
|
l67 dw 'USERID'
|
|
l68 dw 'POINTER'
|
|
l69 dw 'TAN'
|
|
l70 dw 'ARCCOS'
|
|
l71 dw 'ARCSIN'
|
|
l72 dw 'ARCTAN2'
|
|
l73 dw 'TOOLERROR'
|
|
l74 dw 'SIZEOF'
|
|
l75 dw 'TRUNC4'
|
|
l76 dw 'ROUND4'
|
|
l77 dw 'MEMBER'
|
|
end
|
|
|
|
****************************************************************
|
|
*
|
|
* WaitForKeyPress - If necessary, wait for a keypress
|
|
*
|
|
* This routine is called after reporting non-terminal errors.
|
|
* If the user has flagged all errors as terminal (+T), a
|
|
* terminal exit is made. If the user has not, but has requested
|
|
* that the compiler wait for a keypress after printeing an error
|
|
* (+W), it waits for a keypress.
|
|
*
|
|
* Inputs:
|
|
* r0 - long address of the error message
|
|
* wait - wait for a keypress?
|
|
* allTerm - are all errors terminal?
|
|
*
|
|
****************************************************************
|
|
*
|
|
WaitForKeyPress start
|
|
using GetCom
|
|
|
|
lda allTerm if allTerm then
|
|
beq lb1
|
|
ph2 #0 do a terminal error exit;
|
|
ph4 #0
|
|
jsl TermError
|
|
lb1 lda wait if wait then begin
|
|
beq lb3
|
|
jsl DrawHourglass draw the wait symbol
|
|
lb1a jsl KeyPress get a keypress
|
|
tay
|
|
beq lb1a
|
|
jsl ClearHourglass clear the wait symbol
|
|
lb3 rtl
|
|
end
|