ack/mach/mantra/int/mloop0
1987-03-30 09:39:38 +00:00

511 lines
15 KiB
Plaintext

.define filb
.define curproc
.define pd
.define nproc
.define retarea
.define retsize
.define hp
.define maxcount
.define firstp
.define globmax
.define tblmax
.define ml
.define argc
.sect .text
.sect .rom
.sect .data
.sect .bss
.sect .text
!---------------------------------------------------------------------------
! START OF THE PROGRAM
!---------------------------------------------------------------------------
lea retarea,a1 !a1 POINTS AT RETURN AREA
move.l nd,-(sp) !nd contains endbss
bsr _Xbreak
add.l wrd,sp
#if last
move.l #126,d0 !initialise lasttable
lea lasttable,a5
0: clr.l (a5)+
dbra d0,0b
move.l #-1,(a5)
move.l #linused-8,linused
#endif
move.l 4(sp),a2
move.l (a2),filb !interpreter name in filb
sub.l #1,(sp)
bgt 0f
.sect .data
emfile: .asciz "e.out"
.align 2
.sect .text
move.l 4(sp),a0 !4(sp) is argv
move.l #emfile,(a0) !pointer to e.out in argp1
add.l #1,(sp) !only 1 argument in this case
bra 1f
0: add.l #4,4(sp) !skip name of interpreter
1: add.l #4-word,sp
move.l sp,ml
move.l word(sp),a2
cl -(sp)
move.l (a2),-(sp)
lea eb,a6
bsr _Xopen
testen (sp)+
bne nofile
mov (sp)+,savefd
move.l (a2),filb !load file name in filb
!information about file for error mess.
move.l #16,-(sp) ; pea header
mov savefd,-(sp) !skip first header
bsr _Xread ; testen (sp)+
bne badarg1
move.l #32,(sp)
pea header
mov savefd,-(sp)
bsr _Xread
testen (sp)+
bne badarg1
cmp.l #32,(sp)+
bne badarg1
lea header,a0
move.l #5,d0 !convert em integer to integer
0: add.l #4,a1
move.b (a0)+,-(a1) ; move.b (a0)+,-(a1)
move.b (a0)+,-(a1) ; move.b (a0)+,-(a1)
move.l (a1),-4(a0) ; dbra d0,0b
move.l nd,a0 ; move.l a0,pb !Bottom emtext
add.l ntext,a0 ; move.l a0,pd !proc. descr. base
move.l nproc,d1 ; asl.l #3,d1 !2 pointers
#if count + prof + flow
mulu #3,d1 !or 6 pointers
#endif
add.l d1,a0 ; move.l a0,eb !external base
add.l szdata,a0 ; move.l a0,tblmax
move.l a0,globmax ; move.l a0,hp
add.l #2000,a0 ; move.l a0,-(sp)
bsr _Xbreak !ask for core
testen (sp)+ ; bne toolarge
move.l eb,a6 ; move.l filb,4(a6)
move.l ntext,-(sp)
move.l pb,-(sp)
mov savefd,-(sp)
bsr _Xread
testen (sp)+ ; bne badarg
add.l #4,sp
#if float
! PM
#endif
lblbuf: sub.l #2048,sp
claimstack
move.l sp,a4 !transport ptr a4
move.l sp,a5
move.l #2048,-(sp) ; move.l a4,-(sp)
mov savefd,-(sp) ; bsr _Xread
testen (sp)+ ; bne badarg
move.l (sp)+,d0
cmp.l #2048,d0 ; bcs 0f
add.l #1024,a5 ; bra 1f !a5 =buffer middle
0: add.l d0,a5 !a5 = buffer end
1: move.l eb,a3 !At a3 filling has to start
clr.l d1 ; clr.l d2
move.l #datswi,a6
datloop: cmp.l a4,a5 ; bhi 9f !Go on filling data
bsr blshift !shift block down , read next block
9: sub.l #1,ndata ; blt finito
move.b (a4)+,d1 ; beq dat0 !type byte in d1
move.l a3,a2 ; move.b (a4)+,d2 !count byte in d2
asl.l #2,d1 ; move.l -4(a6,d1),a0
jmp (a0)
.sect .data
datswi: .data4 dat1; .data4 dat2; .data4 dat3; .data4 dat4
.data4 dat5; .data4 dat6; .data4 dat6; .data4 dofloat
.sect .text
dat0: add.l #4,a1
move.b (a4)+,-(a1) ; move.b (a4)+,-(a1)
move.b (a4)+,-(a1) ; move.b (a4)+,-(a1)
move.l (a1),d0 ; move.l a3,d4 !d0 =count
sub.l a2,d4 !reconstruct byte count of previous describtor
sub.l #1,d0 ; sub.l #1,d4
1: move.l d4,d3
2: move.b (a2)+,(a3)+ ; dbra d3,2b
dbra d0,1b ; bra datloop
dat1: mov und,(a3)+ ; sub.b #1,d2
bne dat1 ; bra datloop
dat2: move.b (a4)+,(a3)+ ; sub.b #1,d2
bne dat2 ; bra datloop
dat3: move.w wrd,d1 ; add.l d1,a3 !wrd = 2 or 4
3: move.b (a4)+,-(a3) ; sub.b #1,d1 ; bgt 3b
add.l wrd,a3 ; sub.b #1,d2
bne dat3 ; bra datloop
dat4: move.l eb,d4 ; bra 4f
dat5: move.l pb,d4
4: add.l #4,a3
move.b (a4)+,-(a3) ; move.b (a4)+,-(a3)
move.b (a4)+,-(a3) ; move.b (a4)+,-(a3)
add.l d4,(a3)+ ; sub.b #1,d2
bne 4b ; bra datloop
dat6: add.l d2,a3 ; move.l d2,d3
6: move.b (a4)+,-(a3) ; sub.b #1,d2
bne 6b ; add.l d3,a3
bra datloop
dofloat: add.l d2,a3
bsr atof ; bra datloop
!DUMMY ASCII TO FLOAT ROUTINE
atof: tst.b (a4)+ ; bne atof
rts
blshift: move.l a5,a0 ; move.l #1024,d0
sub.l d0,a0 ; move.l d0,-(sp)
sub.l d0,a4 !update pointer
asr.l #2,d0
0: move.l (a5)+,(a0)+ ; sub.w #1,d0
bgt 0b ; move.l a0,a5
move.l a5,-(sp) ; mov savefd,-(sp)
bsr _Xread
testen (sp)+ ; bne badarg
move.l (sp)+,d0
cmp.l #1024,d0 ; beq 1f
add.l d0,a5
1: rts
finito: cmp.l hp,a3 ; bne badarg !load file error
move.l eb,a6 !eb IN a6 NOW
lea 4(a6),a0 !filb CONTAINS eb+4
move.l a0,filb
!WE START TO READ THE PROCEDURE DESCRIPTORS
move.l nproc,d1 ; move.l pd,a3
asl.l #3,d1 !proc. descr. is 8 bytes
4: move.l a5,d2 ; sub.l a4,d2 !What is available?
add.l #7,d2 ; and.w #-0x8,d2 !multiple of 8!
sub.l d2,d1 !subtract what can
asr.l #3,d2 !be read. divide by 8
sub.l #1,d2
2: add.l #4,a3
move.b (a4)+,-(a3) ; move.b (a4)+,-(a3)
move.b (a4)+,-(a3) ; move.b (a4)+,-(a3)
add.l #8,a3
move.b (a4)+,-(a3) ; move.b (a4)+,-(a3)
move.b (a4)+,-(a3) ; move.b (a4)+,-(a3)
move.l pb,d0 ; add.l d0,(a3)+ !em address to machine address
#if count+prof+flow
clr.l (a3)+
clr.l (a3)+
clr.l (a3)+
clr.l (a3)+
#endif
dbra d2,2b ; tst.l d1
ble 3f ; bsr blshift !more or ready
bra 4b
3: cmp.l eb,a3 ; bne badarg
move.l savefd,-(sp) ; bsr _Xclose
move.l ml,sp !refresh stack
#if count+prof+flow
! |=======================|
! Here we fill the fields in the procedure | current file name |
! descriptor with table information. The |-----------------------|
! procedure descriptor has six fields, | link to next proc |
! like described in this picture. We |-----------------------|
! construct a linked list of the procedure | first line number |
! descriptors, such that the defined |-----------------------|
! order of procedures is compatible | count pointer |
! with the text order. Thereafter we |-----------------------|
! scan the text for line information to | start address |
! fill the count pointer and startline |-----------------------|
! field. The link to the first procedure | bytes for locals |
! is in firstp , links are descriptor |=======================|
! start addresses. The last procedure
! links to the external base. All lines in the text get a count
! number, lines of a procedure get consecutive count numbers,
! the procedure count pointer gives the number of the first line.
! Count pointer zero is reserved for the case that no line number
! is yet defined.
! Register use: a6 is external base ("eb"), a1 points at return area, other
! registers are free
makelink: move.l pd,a0
move.l #0,a2
move.l a0,a3 !a3 will point at the first proc.
move.l a0,a4 !a4 will point at proc descr base
0: move.l a0,a5 !keep former descr pointer in a5
add.l #24,a0 !a0 points at next one
cmp.l a0,a6 !top of descriptor space
bls 4f !yes? ready!
1: move.l 4(a0),d0 !start address of current proc in d0
cmp.l 4(a5),d0 !compair start address with previous
bcc 2f !d0 large? follow link!
sub.l #24,a5 !d0 small? compair with previous
cmp.l a5,a4 !is a5 smaller than pd
bls 1b !no? try again
move.l a3,16(a0) !yes? then smallest text add up to now
move.l a0,a3 !remind a3 is to point at first proc
bra 0b !next descriptor
2: move.l 16(a5),d1 !follow the link to find place
beq 3f !if 0 then no link defined
move.l d1,a2
cmp.l 4(a2),d0 !compair start address
bcs 3f !start addr between those of a5 and a2
move.l a2,a5 !d0 above start address of a5
bra 2b !go on looking
3: move.l a0,16(a5) !a0 follows a5
move.l d1,16(a0) !a2 follows a0
bra 0b
4: move.l a3,firstp !firstp links to first procedure
! Register use: a3 points at first procedure , d0 opcode byte , a5 base of
! table , d1 keeps min line nr , d2 keeps max line nr , d3 current line nr ,
! maxcount in d4
procinf: move.l #1,maxcount !count pointer for first procedure
move.l #1,d4
move.l #0,d3
move.l #0,d0
0: move.l a3,-(sp) !stack current procedure
move.l #-1,d1 !minimal line number on 0xFFFFFFFF
move.l #0,d2 !maximal line number on 0
tst.l 16(a3) !bottom address next procedure
beq 6f !if 0 last procedure
move.l 16(a3),a4
move.l 4(a4),a4 !a4 points at top of current proc
bra 2f
6: move.l pd,a4
2: move.l 4(a3),a3 !start address of current procedure
8: move.b (a3)+,d0 !start scanning
cmp.b #-2,d0
beq 1f !case escape1
cmp.b #-1,d0
beq 6f !case escape2
cmp.b #-106,d0
bhi 7f !ordinary skip at 7
beq 2f !case lni at 2
cmp.b #-108,d0 !lin_l ?
bcs 7f !ordinary skip at 7
beq 3f !lin_l at 3
move.l #0,d3
move.b (a3)+,d3 !lin_s0 here
bra 4f !compare at 4
2: add.l #1,d3
bra 4f
3: adroff
move.l #0,d3
move.w (a1),d3
bra 4f
6: move.b (a3)+,d0
cmp.b #35,d0 !lin_q ?
bne 6f !skip for escape2 at 6f
move.b (a3)+,(a1)+
move.b (a3)+,(a1)+
move.b (a3)+,(a1)+
move.b (a3)+,(a1)
sub.l #3,a1
move.l (a1),d3
4: cmp.l d1,d3 !d3 less than minimum ?
bcc 5f
move.l d3,d1
5: cmp.l d3,d2 !d3 more than maximum ?
bcc 9f
move.l d3,d2
bra 9f
6: add.l #4,a3
bra 9f
1: move.b (a3)+,d0
move.l d0,a2 !escape1 opcodes treated here
add.l #256,a2 !second table
bra 1f
7: move.l d0,a2
1: move.b skipdisp(a2),d0 !look for argument size
add.l d0,a3
9: cmp.l a3,a4 !still more text
bhi 8b
move.l (sp)+,a3 !bottom back
sub.l d1,d2 !compute number of lines
bcs 9f !no line so no information
move.l d4,8(a3)
move.l d1,12(a3)
add.l #1,d2
add.l d2,d4 !this is the new maxcount
move.l d4,maxcount
9: tst.l 16(a3) !follow link to next procedure
beq 1f
move.l 16(a3),a3
bra 0b
1:
countlabel:
.sect .data
skipdisp:
.data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0;
.data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0;
.data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0;
.data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0;
.data1 0; .data1 0; .data1 0; .data1 1; .data1 0; .data1 0; .data1 2; .data1 0;
.data1 0; .data1 1; .data1 1; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0;
.data1 0; .data1 0; .data1 1; .data1 2; .data1 1; .data1 1; .data1 1; .data1 1;
.data1 1; .data1 1; .data1 1; .data1 2; .data1 1; .data1 1; .data1 1; .data1 1;
.data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0;
.data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0;
.data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0;
.data1 0; .data1 0; .data1 0; .data1 0; .data1 1; .data1 0; .data1 0; .data1 0;
.data1 1; .data1 0; .data1 0; .data1 0; .data1 1; .data1 0; .data1 0; .data1 0;
.data1 1; .data1 1; .data1 0; .data1 1; .data1 0; .data1 2; .data1 0; .data1 2;
.data1 1; .data1 0; .data1 0; .data1 0; .data1 1; .data1 1; .data1 0; .data1 1;
.data1 2; .data1 1; .data1 1; .data1 1; .data1 1; .data1 1; .data1 1; .data1 1;
.data1 2; .data1 2; .data1 0; .data1 0; .data1 1; .data1 1; .data1 1; .data1 0;
.data1 0; .data1 2; .data1 1; .data1 0; .data1 1; .data1 0; .data1 0; .data1 1;
.data1 1; .data1 1; .data1 0; .data1 0; .data1 2; .data1 1; .data1 0; .data1 2;
.data1 0; .data1 1; .data1 1; .data1 2; .data1 1; .data1 1; .data1 1; .data1 1;
.data1 1; .data1 2; .data1 0; .data1 0; .data1 0; .data1 0; .data1 1; .data1 2;
.data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 1; .data1 2; .data1 2;
.data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0;
.data1 0; .data1 0; .data1 0; .data1 0; .data1 1; .data1 1; .data1 0; .data1 0;
.data1 0; .data1 1; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 1;
.data1 0; .data1 0; .data1 1; .data1 0; .data1 0; .data1 1; .data1 1; .data1 1;
.data1 1; .data1 0; .data1 2; .data1 1; .data1 1; .data1 1; .data1 2; .data1 0;
.data1 0; .data1 1; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 1;
.data1 2; .data1 2; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0; .data1 0;
.data1 0; .data1 1; .data1 0; .data1 0; .data1 0; .data1 0; .data1 2; .data1 1;
.data1 1; .data1 1; .data1 1; .data1 1; .data1 1; .data1 1; .data1 1; .data1 1;
.data1 2; .data1 1; .data1 0; .data1 0; .data1 1; .data1 2; .data1 7; .data1 5;
!escaped opcodes
.data1 2; .data1 0; .data1 2; .data1 0; .data1 2; .data1 0; .data1 2; .data1 0;
.data1 2; .data1 0; .data1 2; .data1 0; .data1 2; .data1 2; .data1 0; .data1 2;
.data1 2; .data1 2; .data1 2; .data1 2; .data1 0; .data1 2; .data1 2; .data1 0;
.data1 2; .data1 0; .data1 0; .data1 0; .data1 2; .data1 0; .data1 2; .data1 0;
.data1 2; .data1 0; .data1 2; .data1 0; .data1 2; .data1 0; .data1 2; .data1 0;
.data1 2; .data1 0; .data1 0; .data1 0; .data1 0; .data1 2; .data1 2; .data1 2;
.data1 2; .data1 2; .data1 0; .data1 2; .data1 0; .data1 2; .data1 0; .data1 2;
.data1 0; .data1 2; .data1 0; .data1 2; .data1 0; .data1 2; .data1 2; .data1 2;
.data1 0; .data1 2; .data1 0; .data1 2; .data1 0; .data1 2; .data1 2; .data1 2;
.data1 2; .data1 2; .data1 2; .data1 2; .data1 0; .data1 2; .data1 0; .data1 1;
.data1 2; .data1 2; .data1 2; .data1 2; .data1 0; .data1 2; .data1 0; .data1 2;
.data1 0; .data1 0; .data1 2; .data1 0; .data1 2; .data1 0; .data1 0; .data1 2;
.data1 0; .data1 2; .data1 2; .data1 0; .data1 2; .data1 0; .data1 2; .data1 0;
.data1 2; .data1 0; .data1 0; .data1 2; .data1 0; .data1 2; .data1 0; .data1 2;
.data1 0; .data1 2; .data1 0; .data1 2; .data1 0; .data1 2; .data1 2; .data1 2;
.data1 2; .data1 2; .data1 0; .data1 0; .data1 2; .data1 2; .data1 0; .data1 2;
.data1 0; .data1 2; .data1 0; .data1 2; .data1 0; .data1 2; .data1 0; .data1 2;
.data1 2; .data1 0; .data1 1; .data1 0; .data1 0; .data1 0; .data1 2; .data1 0;
.data1 2; .data1 0; .data1 2; .data1 2; .data1 2; .data1 2; .data1 2; .data1 2;
.data1 0; .data1 2; .data1 0; .data1 1; .data1 2; .data1 0; .data1 0; .data1 2;
.sect .text
move.l globmax,d1
move.l d1,a3
#if prof
move.l d1,ltime
move.l d1,profile !PROFILE POINTER FOR CURRENT PROC
move.l maxcount,d0
add.l #1,d0
asl.l #2,d0 !4 BYTES FOR EACH LINE
add.l d0,d1
move.l d0,profsiz !profsiz CONTAINS NEEDED MEM SIZE
#endif
#if flow
move.l d1,lflow
move.l maxcount,d0
asr.l #3,d0 !divide by 8
add.l #2,d0
bclr #0,d0 !make integer number of words (2 byte!)
add.l d0,d1
move.l d0,flowsiz
#endif
#if count
move.l d1,lcount
move.l maxcount,d0
add.l #1,d0
asl.l #2,d0
add.l d0,d1
move.l d0,countsiz
#endif
move.l d1,tblmax
add.l #1024,d1
cmp.l nd,d1
bcs 2f
move.l d1,-(sp)
bsr _Xbreak
testen (sp)+
bne toolarge
2: sub.l a3,d1
asr.l wmu,d1
3: cl (a3)+
dbra d1,3b
sub.l #1024,a3
move.l a3,hp
cfp: move.l ml,sp !LABEL FOR DEBUGGING
#endif
!----------------------------------------------------------------------------
! START CALLING SEQUENCE HERE
!-----------------------------------------------------------------------------
lea loop,a4
move.l pb,a3
move.l #0,a2
move.l wmu-1,d7
clr.l d6
lblsp: move.l entry,-(sp) !start procedure to call
bra cai_z
nofile: mov #0xD,d0 ; bra notrap1
badarg: move.l eb,a6
badarg1: mov #0xE,d0 ; bra notrap1
toolarge: mov #0xF,d0 ; bra notrap1
.sect .data
retsize: .space 2
retarea: .space 32
.sect .bss
argc: .space 4
argv: .space 4
envp: .space 4
savefd: .space 4
header:
ntext: .space 4
ndata: .space 4
nproc: .space 4
entry: .space 4
nline: .space 4
szdata: .space 4
firstp: .space 4
maxcount: .space 4
tblmax: .space 4
globmax: .space 4
ml: .space 4
eb: .space 4 !EXPLICITELY REQUIRED eb, filb, curproc IN
filb: .space 4 !THIS ORDER
curproc: .space 4
pb: .space 4
pd: .space 4
hp: .space 4
.sect .text