.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