480 lines
10 KiB
Plaintext
480 lines
10 KiB
Plaintext
.define e_memflt
|
|
.sect .text
|
|
.sect .rom
|
|
.sect .data
|
|
.sect .bss
|
|
.sect .text
|
|
e_array: cl -(sp) ; bra error
|
|
e_range: mov #0x1,-(sp) ; bra error
|
|
e_set: mov #0x2,-(sp) ; bra error
|
|
e_iovfl: mov #0x3,-(sp) ; bra error
|
|
e_fovfl: mov #0x4,-(sp) ; bra error
|
|
e_funfl: mov #0x5,-(sp) ; bra error
|
|
e_idivz: mov #0x6,-(sp) ; bra error
|
|
e_fdivz: mov #0x7,-(sp) ; bra error
|
|
e_iund: mov #0x8,-(sp) ; bra error
|
|
e_fund: mov #0x9,-(sp) ; bra error
|
|
e_conv: mov #0xA,-(sp) ; bra error
|
|
e_stack: mov #0x10,-(sp) ; bra fatal
|
|
e_heap: mov #0x11,-(sp) ; bra error
|
|
e_illins: mov #0x12,-(sp) ; bra fatal
|
|
e_oddz: mov #0x13,-(sp) ; bra fatal
|
|
e_case: mov #0x14,-(sp) ; bra fatal
|
|
e_memflt: mov #0x15,-(sp) ; bra fatal
|
|
e_badptr: mov #0x16,-(sp) ; bra fatal
|
|
e_badpc: mov #0x17,-(sp) ; bra fatal
|
|
e_badlae: mov #0x18,-(sp) ; bra error
|
|
e_badmon: mov #0x19,-(sp) ; bra error
|
|
e_badlin: mov #0x1A,-(sp) ; bra error
|
|
e_badgto: mov #0x1B,-(sp) ; bra error
|
|
|
|
flnim: bra e_illins
|
|
no8bar: bra e_oddz
|
|
!---------------------------------------------------------------------------
|
|
! ERRORS AND TRAPS
|
|
!----------------------------------------------------------------------------
|
|
fatal: clr.l -(sp) !dummy return address
|
|
pea hlt_z !RETURN FROM FATAL HALTS
|
|
mov 8(sp),-(sp)
|
|
|
|
error: movem.l d0/d1/d2/d3/d4/d5/d6/d7/a0/a1/a2/a3/a4/a5/a6,-(sp)
|
|
mov 60(sp),d0 !ERROR NUMBER IN d0
|
|
lea retsize,a1
|
|
move.l eb,a6 !JUST TO BE SURE
|
|
lea retarea,a5 !JUST TO BE SURE
|
|
lea loop,a4
|
|
move.l #16,d1
|
|
1: move.w -(a1),-(sp)
|
|
dbra d1,1b
|
|
cmp.w #0xB,d0
|
|
bge 0f !FATAL ERROR , START ERROR HANDLING
|
|
move.l #0x1,d1
|
|
asl.l d0,d1
|
|
move.w ignmask,d2
|
|
not.w d2
|
|
and.w d2,d1
|
|
bne 0f
|
|
move.l #16,d1
|
|
lea retsize,a1
|
|
1: move.w (sp)+,(a1)+
|
|
dbra d1,1b
|
|
movem.l (sp)+,d0/d1/d2/d3/d4/d5/d6/d7/a0/a1/a2/a3/a4/a5/a6
|
|
|
|
add.l wrd,sp !REMOVE ERROR NUMBER
|
|
rts
|
|
|
|
0: move.l uerrorp,a0
|
|
cmp.l #-1,a0
|
|
beq notrap
|
|
mov d0,-(sp)
|
|
move.l uerrorp,-(sp)
|
|
move.l #-1,uerrorp !USER MUST SET TRAP AGAIN
|
|
bra cai_z
|
|
|
|
!-----------------------------------------------------------------------------
|
|
rtt_z: move.l a2,sp
|
|
add.l #0x10,sp !REMOVE RETURN STATUS BLOCK
|
|
add.l wrd,sp !REMOVE ERROR NUMBER
|
|
move.l #16,d0
|
|
lea retsize,a1
|
|
1: move.w (sp)+,(a1)+
|
|
dbra d0,1b
|
|
movem.l (sp)+,d0/d1/d2/d3/d4/d5/d6/d7/a0/a1/a2/a3/a4/a5/a6
|
|
add.l wrd,sp
|
|
rts
|
|
|
|
trp_z: sub.l #4,sp
|
|
mov 4(sp),(sp) !COPY ERROR NUMBER
|
|
move.l a4,word(sp) !RETURN ADDRESS TO MAIN LOOP
|
|
bra error
|
|
|
|
sig_z: move.l (sp),d0
|
|
move.l uerrorp,(sp)
|
|
move.l d0,uerrorp
|
|
jmp (a4)
|
|
|
|
.sect .data
|
|
uerrorp: .data4 0x-1
|
|
.sect .text
|
|
|
|
!-----------------------------------------------------------------------------
|
|
!FIRST INFORMATION ABOUT THE KIND OF THE ERROR
|
|
notrap: add.l #38,sp
|
|
movem.l (sp)+,d1/d2/d3/d4/d5/d6/d7/a0/a1/a2/a3/a4/a5/a6
|
|
notrap1: comp #29,d0 !ERROR NUMBER STILL IN d0
|
|
blt 1f !START PRINTING ERROR
|
|
extend d0 !NUMBER.
|
|
move.l d0,d1
|
|
lea erno+5,a0
|
|
bsr itoa
|
|
move.l #609,d0
|
|
bra 2f
|
|
1: mulu #21,d0
|
|
2: lea emerr,a0
|
|
move.l #20,-(sp)
|
|
pea 0(a0,d0)
|
|
mov #2,-(sp) !STANDARD ERROR
|
|
bsr _Xwrite
|
|
add.l wrd+4,sp
|
|
!NEXT INFORMATION ABOUT THE LINE NUMBER
|
|
clr.l d1
|
|
mov (a6),d1
|
|
lea emess+14,a0
|
|
bsr itoa
|
|
move.l #30,-(sp)
|
|
pea emess
|
|
mov #2,-(sp)
|
|
bsr _Xwrite
|
|
add.l wrd+4,sp
|
|
!NOW INFORMATION ABOUT THE FILES
|
|
2: move.l 4(a6),a0
|
|
cmp.l #0,a0
|
|
beq 5f
|
|
move.l a0,a1
|
|
sub.l #4,sp
|
|
move.l a1,-(sp)
|
|
move.l #-1,d0
|
|
1: add.l #1,d0
|
|
tst.b (a1)+
|
|
bne 1b
|
|
move.l d0,4(sp)
|
|
mov #2,-(sp)
|
|
bsr _Xwrite
|
|
add.l wrd+4,sp
|
|
5: move.w #0x0A,-(sp)
|
|
move.l #2,-(sp)
|
|
pea 4(sp)
|
|
mov #2,-(sp)
|
|
bsr _Xwrite
|
|
add.l wrd+6,sp
|
|
comp #0xB,(sp)
|
|
beq 1f
|
|
|
|
move.l #-1,argc
|
|
clr.l -(sp) !dummy return address
|
|
bra hlt_z
|
|
|
|
1: add.l wrd,sp
|
|
jmp (a4)
|
|
|
|
!---------------------------------------------------------------------------
|
|
! EXIT HANDLING
|
|
!--------------------------------------------------------------------------
|
|
hlt_z: add.l #4,sp !remove return address
|
|
#if prof
|
|
.sect .data
|
|
emprof: .asciz "em_profile\0"
|
|
.align 2
|
|
.sect .bss
|
|
profile: .space 4
|
|
ltime: .space 4
|
|
profsiz: .space 4
|
|
.sect .text
|
|
tst.l firstp
|
|
beq lhalt
|
|
pea emprof
|
|
bsr _Xunlink
|
|
testen (sp)+
|
|
blt 1f
|
|
mov #0x1B6,-(sp)
|
|
pea emprof
|
|
bsr _Xcreat
|
|
testen (sp)+
|
|
blt 1f
|
|
mov (sp)+,d0
|
|
move.l ltime,a4 !a4 points at bottem of prof table
|
|
bsr tabprint
|
|
1:
|
|
#endif
|
|
#if flow
|
|
tst.l firstp
|
|
beq lhalt
|
|
pea emflow
|
|
bsr _Xunlink
|
|
testen (sp)+
|
|
blt 1f
|
|
mov #0x1B6,-(sp)
|
|
pea emflow
|
|
bsr _Xcreat
|
|
testen (sp)+
|
|
blt 1f
|
|
mov (sp)+,d0
|
|
move.l flowsiz,-(sp)
|
|
move.l lflow,-(sp)
|
|
mov d0,-(sp)
|
|
bsr _Xwrite
|
|
testen (sp)+
|
|
blt 1f
|
|
add.l #4,sp
|
|
.sect .data
|
|
emflow: .asciz "em_flow\0"
|
|
.align 2
|
|
.sect .bss
|
|
lflow: .space 4
|
|
flowsiz: .space 4
|
|
.sect .text
|
|
1:
|
|
#endif
|
|
#if count
|
|
tst.l firstp
|
|
beq lhalt
|
|
pea emcount
|
|
bsr _Xunlink
|
|
testen (sp)+
|
|
blt 1f
|
|
mov #0x1B6,-(sp)
|
|
pea emcount
|
|
bsr _Xcreat
|
|
testen (sp)+
|
|
blt 1f
|
|
mov (sp)+,d0
|
|
move.l lcount,a4
|
|
bsr tabprint
|
|
1:
|
|
.sect .data
|
|
emcount: .asciz "em_count\0"
|
|
.align 2
|
|
.sect .bss
|
|
lcount: .space 4
|
|
countsiz: .space 4
|
|
#endif
|
|
#if opfreq
|
|
.sect .data
|
|
emopf: .asciz "em_opfreq\0"
|
|
.align
|
|
.sect .bss
|
|
counttab: .space 1892
|
|
.sect .text
|
|
pea emopf
|
|
bsr _Xunlink
|
|
testen (sp)+
|
|
blt 1f
|
|
mov #0x1B6,-(sp)
|
|
pea emopf
|
|
bsr _Xcreat
|
|
testen (sp)+
|
|
blt 1f
|
|
mov (sp)+,d0
|
|
move.l #1884,-(sp)
|
|
pea counttab
|
|
mov d0,-(sp)
|
|
bsr _Xwrite
|
|
testen (sp)+
|
|
blt 1f
|
|
add.l #4,sp
|
|
1:
|
|
#endif
|
|
#if count+flow+prof
|
|
.sect .bss
|
|
countfld: .space 4 !COUNT NUMBER - NUMBER OF LINE 1 OF PROC
|
|
countptr: .space 4 !COUNT NUMBER OF CURRENT LINE
|
|
#endif
|
|
lhalt:
|
|
#if last
|
|
.sect .text
|
|
pea emlast
|
|
bsr _Xunlink
|
|
testen (sp)+
|
|
blt halt
|
|
mov #0x1B6,-(sp)
|
|
pea emlast
|
|
bsr _Xcreat
|
|
testen (sp)+
|
|
blt halt
|
|
mov (sp)+,d6 !d6 contains file descriptor
|
|
cmp.l #-1,linused-4 !test if buffer is fully used
|
|
beq 0f
|
|
bsr nexttab
|
|
bra 1f
|
|
0: lea lasttable,a1
|
|
1: tst.l (a1)
|
|
bne 2f !exists entry in table
|
|
move.l #22,-(sp) !here case no lines processed
|
|
pea mess1
|
|
mov d6,-(sp)
|
|
bsr _Xwrite
|
|
testen (sp)+
|
|
blt halt
|
|
add.l #4,sp
|
|
bra 9f
|
|
2: move.l a1,-(sp)
|
|
move.l #7,-(sp) !announce new file name
|
|
pea mess2
|
|
mov d6,-(sp)
|
|
bsr _Xwrite
|
|
testen (sp)+
|
|
blt halt
|
|
add.l #4,sp
|
|
move.l (sp)+,a1
|
|
move.l (a1),d7
|
|
move.l d7,a0 !keep file pointer in d7
|
|
clr.l (a1)+ !this will stop the printing
|
|
move.l #-1,d1 !d1 will contain length of file name
|
|
3: add.l #1,d1
|
|
tst.b (a0)+
|
|
bne 3b
|
|
move.l a1,-(sp)
|
|
move.l d1,-(sp)
|
|
move.l d7,-(sp)
|
|
mov d6,-(sp)
|
|
bsr _Xwrite
|
|
add.l wrd+4,sp
|
|
move.l (sp)+,a1
|
|
4: move.l (a1),d1 !next print line numbers
|
|
lea mess3,a0
|
|
bsr itoa
|
|
move.l a1,-(sp)
|
|
move.l #12,-(sp)
|
|
pea mess3
|
|
mov d6,-(sp)
|
|
bsr _Xwrite
|
|
testen (sp)+
|
|
blt halt
|
|
add.l #4,sp
|
|
move.l (sp)+,a1
|
|
bsr nexttab
|
|
tst.l (a1) !in case 0 no more lines
|
|
beq 9f
|
|
cmp.l (a1),d7
|
|
bne 2b !new file name
|
|
clr.l (a1)+ !skip file name
|
|
bra 4b !only new line
|
|
9:
|
|
.sect .data
|
|
emlast: .asciz "em_last"
|
|
mess1: .asciz "no line processed yet\n"
|
|
mess2: .asciz "\nfile :"
|
|
mess3: .asciz " \n"
|
|
.align 2
|
|
.sect .bss
|
|
lasttable: .space 512
|
|
linused: .space 4
|
|
#endif
|
|
.sect .text
|
|
halt: bsr _Xexit
|
|
|
|
.sect .data
|
|
emerr:
|
|
.asciz "ARRAY BOUND ERROR \n"
|
|
.asciz "RANGE BOUND ERROR \n"
|
|
.asciz "SET BOUND ERROR \n"
|
|
.asciz "INTEGER OVERFLOW \n"
|
|
.asciz "FLOATING OVERFLOW \n"
|
|
.asciz "FLOATING UNDERFLOW \n"
|
|
.asciz "INT. DIV. BY ZERO \n"
|
|
.asciz "DIVIDE BY 0.0 \n"
|
|
.asciz "UNDEFINED INTEGER \n"
|
|
.asciz "UNDEFINED FLOAT \n"
|
|
.asciz "CONVERSION ERROR \n"
|
|
.asciz "NO FLOATING POINT \n"
|
|
.asciz "NO 8 BYTE ARITH. \n"
|
|
.asciz "NO LOAD FILE \n"
|
|
.asciz "LOAD FILE ERROR \n"
|
|
.asciz "PROGRAM TOO LARGE \n"
|
|
.asciz "STACK OVERFLOW \n"
|
|
.asciz "HEAP OVERFLOW \n"
|
|
.asciz "ILLEGAL INSTRUCTION\n"
|
|
.asciz "ILLEGAL SIZE ARG. \n"
|
|
.asciz "CASE ERROR \n"
|
|
.asciz "ADDRESS NON EX. MEM\n"
|
|
.asciz "BAD POINTER USED \n"
|
|
.asciz "PR COUNT. OUT RANGE\n"
|
|
.asciz "BAD ARG. OF LAE \n"
|
|
.asciz "BAD MONITOR CALL \n"
|
|
.asciz "ARG OF LIN TOO HIGH\n"
|
|
.asciz "GTO DESCR. ERROR \n"
|
|
.asciz "BAD RETURN SIZE \n"
|
|
erno:
|
|
.asciz "ERRNO \n"
|
|
emess:
|
|
.asciz "ON SOURCE LINE OF\n"
|
|
.align 2
|
|
!-----------------------------------------------------------------------------
|
|
! SUBROUTINES FOR THE INTERPRETOR
|
|
!------------------------------------------------------------------------------
|
|
.sect .text
|
|
#if last
|
|
nexttab: move.l linused,a1
|
|
add.l #8,a1
|
|
cmp.l #linused,a1 !top of buffer reached?
|
|
bne 1f !if so back to bottom
|
|
sub.l #512,a1
|
|
1: move.l a1,linused
|
|
rts
|
|
#endif
|
|
#if count+prof
|
|
!SUBROUTINE FOR PRINTING TABLES . EXPECTS BOTTOM OF TABLE IN a4 AND FILE
|
|
!DESCRIPTOR IN d0 .IN maxcount NUMBER OF 4 BYTE WORDS IN THE TABLE.
|
|
.sect .text
|
|
tabprint: mov d0,-(sp) !KEEP FILE DESCRIPTOR FOR WRITING
|
|
lea buffer,a3
|
|
move.l firstp,a1 !IN a1 POINTER TO CURRENT PROC.
|
|
move.l #0,a2 !IN a2 POINTER TO FILENAME .
|
|
2: move.l 16(a1),d0
|
|
beq 9f !LAST PROCEDURE , EXCEPTION .
|
|
move.l d0,a6 !IN a6 POINTER TO NEXT PROCEDURE .
|
|
7: move.l 8(a6),d7 !COUNTPTR OF NEXT IN d7
|
|
bne 8f
|
|
move.l 16(a6),d0
|
|
beq 9f
|
|
move.l d0,a6
|
|
bra 7b
|
|
8: move.l 8(a1),d6 !COUNTPTR OF CURRENT IN d6.
|
|
move.l 12(a1),d5 !FIRST LINE NUMBER IN d5.
|
|
beq 1f !NO LINES : GO ON.
|
|
cmp.l 20(a1),a2 !START PRINTING FILE NAME .
|
|
beq 6f !NO NEW NAME.
|
|
move.l 20(a1),a2 !NEW FILE NAME.
|
|
cmp.l #0,a2 !NO FILE NAME .
|
|
beq 6f
|
|
move.l #0,d1 !START SCANNING FILE NAME
|
|
5: move.b (a2),d0 !d1 WILL CONTAIN NUMBER OF SYMBOLS.
|
|
beq 4f
|
|
add.l #1,d1
|
|
add.l #1,a2
|
|
bra 5b
|
|
4: sub.l d1,a2
|
|
move.l d1,-(sp)
|
|
move.l a2,-(sp)
|
|
mov 8(sp),-(sp) !WRITE FILE NAME.
|
|
bsr _Xwrite
|
|
testen (sp)+
|
|
blt 3f
|
|
add.l #4,sp !CLEAN STACK.
|
|
6: sub.l d6,d7 !IN d7 NUMBER OF LINES OF CURRENT PROC.
|
|
asl.l #2,d6
|
|
0: move.l a3,a0
|
|
move.l d5,d1 !SET UP FOR CALLING itoa.
|
|
bsr itoa
|
|
lea 11(a3),a0
|
|
move.l 0(a4,d6),d1
|
|
bsr itoa
|
|
move.l #23,-(sp)
|
|
pea buffer
|
|
mov 8(sp),-(sp)
|
|
bsr _Xwrite !PRINT LINE NUMBER AND INTEGER .
|
|
testen (sp)+
|
|
blt 3f
|
|
add.l #4,sp !CLEAN STACK.
|
|
add.l #1,d5 !NEXT LINE NUMBER .
|
|
add.l #4,d6 !NEXT COUNT.
|
|
sub.l #1,d7 !ONE LINE LESS TO GO.
|
|
bhi 0b
|
|
1: move.l a6,a1
|
|
cmp.l #0,a1
|
|
bne 2b
|
|
add.l wrd,sp !REMOVE FILE DESCR.
|
|
rts !READY.
|
|
9: move.l maxcount,d7
|
|
move.l #0,a6 !NO NEXT PROCEDURE.
|
|
bra 8b
|
|
3:
|
|
testen (sp)+
|
|
testen (sp)+
|
|
rts
|
|
|
|
.sect .data
|
|
buffer: .asciz " \n"
|
|
.sect .text
|
|
#endif
|