rminnich@udel.UUCP (08/31/87)
Sorry to hit the net with this but i cannot mail to the author- my mailer is unhelpful. The PostScript interpreter recently posted is missing the include file 'ps.h'. Anybody got this and can mail it to me? Thanks, ron -- Ron Minnich
lee@uhccux.UUCP (09/01/87)
Sorry I forgot to include ps.h. Here it is. I don't know how to reach me on the net, but one of these might work: * UUCP: {ihnp4,seismo,ucbvax,dcdwest}!sdcsvax!nosc!uhccux!lee * ARPA: uhccux!lee@nosc.MIL File ps.h follows: * header for ps modules lref macro _LVO\1 equ -6*(\2+4) endm call macro jsr _LVO\1(A6) endm print macro lea \1,A0 bsr msg endm ERR macro lea \1,A0 bsr msg bra reinterp endm DEF macro xdef _\1 _\1 endm ARG macro cmp.w #\1,(A5)+ bne type_mismatch move.l (A5)+,D0 endm RETURN macro move.w #\1,D2 bra r.ipush endm bstr macro \1 dc.b 1$-*-1 dc.b '\2',10 1$ endm cnttype set -1 newtype macro \1 equ cnttype cnttype set cnttype+1 endm newtype Illegal newtype ICode newtype Integer newtype Name newtype String newtype Boolean newtype Real newtype FontID newtype Array newtype Mark newtype Dictionary newtype Save newtype Dummy newtype File PointFive equ $80000040 OnePoint equ $80000041 ThreePoint equ $C0000042 FourPoint equ $80000043 HiRes equ 1 NumColors equ 16 InterAct equ 1 NumPlanes equ 4 PstackSize equ 20 IstackSize equ 100 DstackSize equ 20 SstackSize equ 10 SAreaSize equ 3000 SizeDict equ 100 CodeSize equ 5000
scott@applix.UUCP (Scott Evernden) (09/04/87)
The recent source of the "ps" PostScript Interpreter, recently posted, seems to be missing the 0s, 1s, and 5s in file "ps.a". So far, it's been quite a puzzle, but I give up. Did anyone receive this file properly? - scott
lee@uhccux.UUCP (Greg Lee) (09/04/87)
I tried to mail to individuals who wanted a good copy of this file, but can't get mail out. As I should have noted before, this source is for the MetaComco assembler. To those who inquired about a binary, I did post one several weeks ago to comp.binaries.amiga. But I will email one to you as soon as I can find paths that work. # This is a shell archive. Remove anything before this line # then unpack it by saving it in a file and typing "sh file" # (Files unpacked will be owned by you and have default permissions). # This archive contains the following files: # ./ps.a # if `test ! -s ./ps.a` then echo "writing ./ps.a" sed 's/^X//' > ./ps.a << '\Rogue\Monster\' X* X* This program is in the public domain. PostScript is a trademark X* of Adobe Systems. X* Greg Lee, July, 1987. X* U.S. mail: 562 Moore Hall, Dept. of Linguistics X* INTERNET: lee@uhccux.uhcc.hawaii.edu X* UUCP: {ihnp4,dcdwest,ucbvax}!sdcsvax!nosc!uhccux!lee X* BITNET: lee%uhccux.uhcc.hawaii.edu@rutgers.edu X* X X X* link with ffpa.o X xref FFPAFP X* link with lmath.o X xref lmulu X xref ldivu X xref ldivs X* link with files.o X xref readln X xref runclose X xref showreal X xref show8x X xref showdec X xref newline X xref getstr X xref msg,longmsg X xref ioinit X xref endio X* in control.o X xref initloops X xref _exec X* in graphics.o X xref initgr,endgr X* in rmath.o X xref _gsave,_grestore X* in dict.o X xref systemdict X xref fdict,enddict X xref .true,.false X X X X xdef reinterp X X xdef ihandle,ohandle X xdef rastport,wbscreen X xdef intuitionbase X xdef graphicsbase X xdef mathffpbase X xdef mathtransbase X X X X X idnt PS X X section one X X include "ps.h" X X Xmath macro X move.l A6,-(SP) X move.l mathffpbase,A6 X jsr _LVO\1(A6) X move.l (SP)+,A6 X endm X X X lref Open,1 X lref Close,2 X lref Read,3 X lref Write,4 X lref Input,5 X lref Output,6 X lref DeleteFile,8 X lref IoErr,18 X lref LoadSeg,21 X lref UnLoadSeg,22 X lref IsInteractive,32 X X lref SPFix,1 X lref SPFlt,2 X lref SPCmp,3 X lref SPTst,4 X lref SPAbs,5 X lref SPNeg,6 X lref SPAdd,7 X lref SPSub,8 X lref SPMul,9 X lref SPDiv,10 X X X X_RTS equ %0100111001110101 X_JSR equ %0100111010111001 destination abs. long X_JMP equ %0100111011111001 destination abs. long X_MOVELD0 equ %0010000000111100 source immediate long X_MOVEVD0 equ %0010000000111001 source abs. long X_MOVEWD2 equ %0011010000111100 source immediate word X_MOVEVD2 equ %0011010000111001 source abs. long X X X Xmain X move.l SP,stacksave X bsr ioinit X bsr initgr X X X* here on error to redo stack Xmain1 X bsr _clear X bsr dsclear X X* get more stuff to interpret Xmain.in X bsr getstr X* (from here, A1 -> next stuff to interpret) X X X* interpret next symbol Xmain.next X bsr skipsp X beq main.in X X pea main.next X move.b compilelevel,D3 X X* if it's a number, push it X bsr testnumber X beq pushnum X X* name literal? X cmp.b #'/',D0 X beq pushlit X X cmp.b #'(',D0 X beq pushstr X X cmp.b #'{',D0 X beq start_compile X X cmp.b #'}',D0 X beq end_compile X X cmp.b #'%',D0 X beq getstr X X* interpret a name X bsr findsym X tst.l D2 X bpl name.ok Xsay_undefined X print unknown X bra reinterp X Xname.ok X move.b compilelevel,D3 X beq no.dummies X cmp.w #Dummy,D2 X bne no.dummies X bsr vpush X lea _exec,A0 X move.l A0,D0 X bra stowcall X Xno.dummies X cmp.w #ICode,D2 X bne vpush X X tst.b D3 X bne stowcall X X move.l A1,-(SP) X move.l D0,A0 X jsr (A0) X move.l (SP)+,A1 X rts X X* exit Xsystem X bsr endgr X bsr endio X moveq #0,D0 X rts X*********************** X X DEF clear X lea istacktop,A5 X moveq #Illegal,D0 X move.l D0,-(A5) X move.w D0,-(A5) X rts X Xcountistack X moveq #-1,D0 X moveq #Illegal,D2 X move.l A5,A0 X1$ addq.l #1,D0 X move.w (A0),D1 X addq.l #6,A0 X cmp.w D1,D2 X bne 1$ X rts X X X DEF count X bsr countistack X RETURN Integer X Xindex1istack X bsr popnum X addq.l #1,D0 X bgt ..ndxis X bra iuflow Xindexistack X bsr popnum X..ndxis X move.l D0,D3 X bmi iuflow X bsr countistack X cmp.l D0,D3 X bhi iuflow X move.l D3,D0 X subq #1,D0 X mulu #6,D0 X move.l A5,A2 X add.l D0,A2 X rts X X DEF copy X bsr indexistack X bra 2$ X1$ move.w (A2)+,D2 X move.l (A2),D0 X bsr r.ipush X subq.l #8,A2 X2$ dbra D3,1$ X rts X X DEF index X bsr index1istack X move.w (A2)+,D2 X move.l (A2)+,D0 X bra r.ipush X X DEF roll X bsr popnum X move.l D0,-(SP) X bsr indexistack X move.l (SP)+,D0 X subq.l #1,D3 X bmi 2$ X move.l D3,D4 X1$ move.l D4,D3 X bsr roll1 X bne 1$ X2$ rts Xroll1 X tst.l D0 X beq 1$ X bmi rollm X bra rollp X1$ rts X Xrollp X subq.l #1,D0 X move.l D0,-(SP) X move.l A5,A0 X move.l A5,A1 X move.w (A0)+,-(SP) X move.l (A0)+,-(SP) X bra 2$ X1$ move.w (A0)+,(A1)+ X move.l (A0)+,(A1)+ X2$ dbra D3,1$ X move.l (SP)+,D0 X move.w (SP)+,(A1)+ X move.l D0,(A1) X move.l (SP)+,D0 X rts X Xrollm X addq.l #1,D0 X move.l D0,-(SP) X move.l A2,A1 X move.l A2,A0 X subq.l #6,A0 X move.w (A2)+,-(SP) X move.l (A2)+,-(SP) X bra 2$ X1$ move.w (A0)+,(A1)+ X move.l (A0),(A1) X subq.l #8,A0 X subq.l #8,A1 X2$ dbra D3,1$ X move.l (SP)+,D0 X move.w (SP)+,(A1)+ X move.l D0,(A1) X move.l (SP)+,D0 X rts X Xdsclear X lea dstacktop,A0 X move.l A0,dstack X moveq #0,D0 X move.w D0,dstackcnt X lea sstacktop,A0 X move.l A0,sstack X moveq #0,D0 X move.w D0,sstackcnt X rts X X Xstart_compile X addq.l #1,A1 X move.b compilelevel,D0 X move.w D0,-(SP) X move.l nextcode,A0 X move.w #ICode,D2 X move.w (SP),D0 X tst.b D0 X beq 2$ X add.l #6+4+6+6,A0 allow for push & jmp if doing sub-proc X2$ move.l A0,D0 X* if doing sub-proc, this generates code to do the push X bsr ipush X move.w (SP),D0 X addq.b #1,D0 X move.b D0,compilelevel X move.w (SP)+,D0 X tst.b D0 X bne 3$ X rts X3$ X move.w #_JMP,D0 X bsr stowword X move.l nextcode,A0 X move.l A0,-(SP) where to put dest of jmp X moveq #0,D0 leave room for dest of jmp X bsr stowword X bsr stowword X X bsr main.next go compile the sub-procedure X* should return to here when get matching '}' X move.l (SP)+,A0 patch in dest of jmp X move.l nextcode,(A0) X rts X X Xend_compile X addq.l #1,A1 X move.b compilelevel,D0 X beq 2$ unmatched '}' X move.w D0,-(SP) X move.w #_RTS,D0 X bsr stowword X move.w (SP)+,D0 X subq.b #1,D0 X move.b D0,compilelevel X beq 1$ X addq.l #4,SP discard ret to main.next and ret to above X1$ rts X2$ print rbrace X bra reinterp X Xtestnumber X cmp.b #'-',D0 X beq ..endtestn X cmp.b #'+',D0 X beq ..endtestn X cmp.b #'.',D0 (only if next is digit?) X beq ..endtestn Xtestdig X cmp.b #'0',D0 * is it a decimal digit? X bcs ..endtestn X cmp.b #'9',D0 X bhi ..endtestn X cmp.b D0,D0 X..endtestn X rts X Xpushstr X addq.l #1,A1 X move.w #1,parenlevel X move.l farea,D0 X btst #0,D0 X beq 1$ X bsr stowbyte X move.l farea,D0 X1$ X move.l D0,-(SP) place to put length X move.w #String,D2 X bsr ipush X X moveq #0,D0 X move.w D0,-(SP) count length X bsr stowbyte room for length X bsr stowbyte X X..nextsbyte X addq.w #1,(SP) X pea ..nextsbyte X move.b (A1)+,D0 X bne 2$ X move.b #10,D0 X bsr stowbyte X bra getstr X X2$ cmp.b #'(',D0 X bne 3$ X add.w #1,parenlevel X bra stowbyte X X3$ cmp.b #')',D0 X bne 4$ X sub.w #1,parenlevel X bne stowbyte X addq.l #4,SP discard ret to ..nextsbyte X X move.w (SP)+,D0 X subq.w #1,D0 correct for ')' not stored X move.l (SP)+,A0 X move.w D0,(A0) X rts X X4$ cmp.b #'\',D0 X bne stowbyte X move.b (A1)+,D0 X beq getstr X move.b D0,D1 X X move.b #10,D0 X cmp.b #'n',D1 X beq stowbyte X X move.b #13,D0 X cmp.b #'r',D1 X beq stowbyte X X move.b #9,D0 X cmp.b #'t',D1 X beq stowbyte X X move.b #8,D0 X cmp.b #'b',D1 X beq stowbyte X X move.b #12,D0 X cmp.b #'f',D1 X beq stowbyte X X cmp.b #'0',D1 X bcs ..noct X cmp.b #'7',D1 X bhi ..noct X moveq #0,D0 X bsr ..isoct X bsr ..isoct X sub.b #'0',D1 X asl.b #3,D0 X add.b D1,D0 X bra stowbyte X X..isoct X sub.b #'0',D1 X asl.b #3,D0 X add.b D1,D0 X move.b (A1),D1 X cmp.b #'0',D1 X bcs 1$ X cmp.b #'7',D1 X bhi 1$ X addq.l #1,A1 X rts X1$ addq.l #4,SP X bra stowbyte X X..noct X move.b D1,D0 X cmp.b #'\',D1 X beq stowbyte X cmp.b #'(',D1 X beq stowbyte X cmp.b #')',D1 X beq stowbyte X rts X X Xpushlit X addq.l #1,A1 past '/' X move.l farea,A0 save to push X moveq #0,D3 count X bsr stowbyte room for length X1$ move.b (A1)+,D0 X bsr testendchar X bne 2$ X move.b D3,(A0) X subq.l #1,A1 X move.l A0,D0 X move.w #Name,D2 X bra ipush X2$ bsr stowbyte X addq.l #1,D3 X bra 1$ X Xpushnum X moveq #0,D1 X move.l D1,D2 neg flag X move.l D1,D3 dec point flag X move.l A1,A0 X cmp.b #'-',(A0) X bne 1$ X move.b (A1)+,D2 X1$ move.b (A1)+,D0 X bsr testdig X bne 2$ X sub.b #'0',D0 X ext.w D0 X ext.l D0 X X move.l D0,-(SP) X add.l D1,D1 X move.l D1,D0 X lsl.l #2,D1 X add.l D0,D1 X move.l (SP)+,D0 X add.l D0,D1 X bra 1$ X X2$ tst.b D3 X beq 6$ X cmp.b #'E',D0 X bne realpush X3$ move.b (A1)+,D0 X cmp.b #'-',D0 X bne 5$ X4$ move.b (A1)+,D0 X5$ bsr testdig X beq 4$ X bra realpush X X6$ cmp.b #'E',D0 X beq 3$ X cmp.b #'.',D0 X bne intpush X move.b D0,D3 X bra 1$ X Xrealpush X subq.l #1,A1 X move.l A1,-(SP) X jsr FFPAFP X move.l (SP)+,A1 X bvs 1$ X move.w #Real,D2 X move.l D7,D0 X bra ipush X1$ print fperr X bra reinterp X Xintpush X subq.l #1,A1 X move.b D2,D3 X move.w #Integer,D2 X move.l D1,D0 X tst.b D3 X beq ipush X neg.l D0 X Xipush X move.b compilelevel,D3 X beq r.ipush X bsr stowmovel X bsr stowmovew X..iptype X lea r.ipush,A0 X move.l A0,D0 X bra stowcall X Xvpush X tst.b D3 X beq r.ipush X move.l A2,D0 get address of value X addq.l #2,D0 X move.l A2,-(SP) X bsr stowmovev X move.l (SP)+,D0 get address of type X bsr stowmovevw X bra ..iptype X X xdef r.ipush Xr.ipush X* move.l istack,A5 X move.l D0,-(A5) X move.w D2,-(A5) X cmp.l #istackbot,A5 X bhi ipush.ok X print overflow Xreinterp X move.b #0,compilelevel X bsr initloops X bsr runclose X move.l stacksave,SP X bra main1 X Xipush.ok X* move.l A5,istack X rts X X X xdef ipop Xipop X DEF pop X* move.l istack,A5 X move.w (A5)+,D2 X cmp.w #Illegal,D2 X bne ..ippok Xiuflow X print underflow X bra reinterp X..ippok X move.l (A5)+,D0 X* move.l A5,istack X rts X X xdef popnum Xpopnum X bsr ipop X cmp.w #Integer,D2 X beq 1$ X cmp.w #Real,D2 X bne type_mismatch X move.l D1,-(SP) X math SPFix X move.l (SP)+,D1 X move.w #Integer,D2 X1$ rts X Xskipsp X move.b (A1),D0 X beq 2$ X cmp.b #10,D0 X beq 1$ X cmp.b #' ',D0 X bne 2$ X1$ addq.l #1,A1 X bra skipsp X2$ rts X Xtestendchar X tst.b D0 X beq 1$ X cmp.b #' ',D0 X beq 1$ X cmp.b #10,D0 X beq 1$ X cmp.b #'}',D0 X beq 1$ X cmp.b #'{',D0 X beq 1$ X cmp.b #')',D0 X beq 1$ X cmp.b #'(',D0 X beq 1$ X cmp.b #'/',D0 X beq 1$ X cmp.b #'%',D0 X beq 1$ X cmp.b #']',D0 X beq 1$ X cmp.b #'[',D0 X beq 1$ X cmp.b #'>',D0 X beq 1$ X cmp.b #'<',D0 X1$ rts X X* A1 -> name to look for X* return with A1 -> past name X* D2 = -1 if not found, else D2 = type X* D0 = value & A2 -> type of entry Xfindsym X move.l A1,A0 X moveq #0,D3 X move.l D3,D2 X X1$ move.b (A0)+,D0 get length in D3 X bsr testendchar X beq 2$ X addq.l #1,D3 X bra 1$ X2$ tst.l D3 X bne 4$ X cmp.b #'[',D0 X beq 3$ X cmp.b #']',D0 X bne .nonefound X3$ moveq #1,D3 X4$ bsr allsym X tst.l D2 X bpl 5$ X move.b compilelevel,D1 X bne dummyentry X5$ add.l D3,A1 X rts X Xallsym X move.w dstackcnt,D1 X move.l dstack,A0 X1$ subq.w #1,D1 X bmi 2$ X move.l (A0)+,A2 X addq.l #2,A2 X movem.l A0/D1,-(SP) X moveq #0,D2 X bsr nextsym X movem.l (SP)+,A0/D1 X tst.l D2 X bmi 1$ X rts X2$ moveq #0,D2 X lea systemdict,A2 X X* also called by dictsearch Xnextsym X move.l (A2)+,D0 X beq .nonefound X move.l D0,A3 A3 -> name in dict X move.l A1,A0 A0 -> name X move.l D3,D1 X move.w (A2)+,D2 D2 = type X move.l (A2)+,D0 D0 = value X X cmp.b (A3)+,D1 same length? X bne nextsym X X subq.l #1,D1 X4$ cmp.b (A3)+,(A0)+ X dbne D1,4$ X bne nextsym X subq.l #6,A2 X rts X X.nonefound X moveq #-1,D2 X rts X X* from above -- A1 -> name; D3 = length Xdummyentry X move.l A1,A0 X add.l D3,A0 X move.l A0,-(SP) X move.l farea,A0 save for entry name X move.l D3,D0 X bsr stowbyte length X bra 2$ X1$ move.b (A1)+,D0 X bsr stowbyte X2$ dbra D3,1$ X X lea say_undefined,A1 X move.l A1,D0 X move.l #Dummy,D2 X bsr newentry X subq.l #6,A0 X move.l A0,A2 X bsr vpush X lea _exec,A0 X move.l #ICode,D2 X move.l A0,D0 X move.l (SP)+,A1 X rts X X X X DEF begin X ARG Dictionary X lea dstackcnt,A0 X cmp.w #DstackSize,(A0) X beq 1$ X addq.w #1,(A0) X move.l dstack,A0 X move.l D0,-(A0) X move.l A0,dstack X rts X1$ print dstackov X bra reinterp X X DEF end X lea dstackcnt,A0 X tst.w (A0) X beq 1$ X subq.w #1,(A0) X move.l dstack,A0 X move.l (A0)+,D0 X move.l A0,dstack X rts X1$ print dstackuv X bra reinterp X X********** X X Xstowbyte X move.l farea,A2 X move.b D0,(A2)+ X cmp.l #endsarea,A2 X bne 1$ X print areafull X bra reinterp X1$ move.l A2,farea X rts X X* store instruction 'move.w <D0>,D2' Xstowmovevw X move.l D0,-(SP) X move.w #_MOVEVD2,D0 X bra ..stowi X* store instruction 'move.w #<D2>,D2' Xstowmovew X move.w #_MOVEWD2,D0 X bsr stowword X move.w D2,D0 X bra stowword X* store instruction 'move.l <D0>,D0' Xstowmovev X move.l D0,-(SP) X move.w #_MOVEVD0,D0 X bra ..stowi X* store instruction 'move.l #<D0>,D0' Xstowmovel X move.l D0,-(SP) X move.w #_MOVELD0,D0 X bra ..stowi X* store instruction 'jsr <D0>' Xstowcall X move.l D0,-(SP) X move.w #_JSR,D0 change to BSR? X..stowi X bsr stowword X move.l (SP),D0 X swap D0 X bsr stowword X move.l (SP)+,D0 X Xstowword X move.l nextcode,A2 X move.w D0,(A2)+ X cmp.l #endcode,A2 X bls 1$ X print codefull X bra reinterp X1$ move.l A2,nextcode X rts X Xstowlong X swap D0 X bsr stowword X swap D0 X bra stowword X X************************************ X X DEF hex X bsr ipop X bsr show8x X move.l A0,D0 X RETURN Name X X DEF quit X move.l stacksave,SP X bsr runclose X bra system X X DEF cvs X ARG String X move.l D0,-(SP) X moveq #-1,D0 flag this is a string conversion X bra ..prnt X..cvs2 X* it better be long enough X move.l (SP)+,A1 X move.l A1,D0 X* A0 -> name; A1 -> string X moveq #0,D1 X move.b D1,(A1)+ X move.b (A0),D1 X1$ move.b (A0)+,(A1)+ X dbra D1,1$ X RETURN String X X..pors X move.l (SP)+,D0 X bne ..cvs2 X bsr msg X bra newline X X DEF print X ARG String X move.l D0,A0 X moveq #0,D3 X move.w (A0)+,D3 X bra longmsg X X X DEF equalsprint X moveq #0,D0 flag this is a print X..prnt X move.l D0,-(SP) X bsr ipop X cmp.w #Integer,D2 X bne 2$ X bsr showdec X bra ..pors X X2$ cmp.w #Name,D2 X bne 3$ X move.l D0,A0 X bra ..pors X X3$ cmp.w #String,D2 X bne 4$ X move.l D0,A0 X move.l (SP)+,D1 X beq 30$ X move.l (SP)+,D1 X bra r.ipush it's already a string -- should copy it? X30$ X moveq #0,D3 X move.w (A0)+,D3 X bsr longmsg X bra newline X X4$ cmp.w #Boolean,D2 X bne 6$ X lea .true,A0 X tst.l D0 X bne 5$ X lea .false,A0 X5$ bra ..pors X X6$ cmp.w #Real,D2 X bne 7$ X bsr showreal X bra ..pors X X7$ X lea nsv,A0 X bra ..pors X X X DEF string X bsr popnum X move.l D0,D3 X swap D0 X tst.w D0 X bne 2$ X X move.l farea,D0 X btst #0,D0 X beq 1$ X bsr stowbyte X move.l farea,D0 X1$ X move.l D0,A2 X add.l D3,A2 X addq.l #2,A2 X cmp.l #endsarea,A2 X bcs 3$ X2$ print areafull X bra reinterp X3$ move.l D0,A0 X move.w D3,(A0) X move.l A2,farea X RETURN String X X DEF dict X moveq #-1,D4 X bra ..arry X X DEF array X moveq #0,D4 X..arry X bsr popnum X move.l nextcode,A2 X move.l A2,A0 X move.w D0,(A2)+ X add.l D0,D0 bytes -> words X move.l D0,D1 X add.l D1,D0 X add.l D1,D0 length * 3 X tst.l D4 X beq 1$ X add.l D1,D0 X add.l D1,D0 length * 5 X addq.l #4,D0 +1 for null at end X move.l A2,A0 X clr.w (A2)+ current length is 0 X clr.l (A2) flag end X1$ add.l D0,A2 X cmp.l #endcode,A2 X bls 2$ X ERR codefull X2$ move.l A2,nextcode X move.l A0,D0 X tst.l D4 X bne 3$ X RETURN Array X3$ RETURN Dictionary X X DEF fontalloc X move.l nextcode,A0 X lea 12(A0),A2 X cmp.l #endcode,A2 X bls 1$ X ERR codefull X1$ move.l A2,nextcode X rts X X X DEF maxlength X bsr ipop X move.l D0,A0 X subq.l #2,A0 X bra ..lngth X X DEF length X bsr ipop X move.l D0,A0 X cmp.w #String,D2 X beq ..rlngth X cmp.w #Array,D2 X beq ..rlngth X..lngth X cmp.w #Dictionary,D2 X bne type_mismatch X..rlngth X moveq #0,D0 X move.w (A0),D0 X move.w #Integer,D2 X bra r.ipush X X Xarrayref X bsr popnum X move.l D0,D1 the index X bsr ipop X move.l D0,A0 base of array X moveq #0,D3 X cmp.w #Array,D2 X beq 1$ X cmp.w #String,D2 X bne type_mismatch X1$ move.w (A0)+,D3 X subq.l #1,D3 length - 1 is max index X bmi 3$ X cmp.l D3,D1 past end? X bhi 3$ X cmp.w #Array,D2 X beq 2$ X add.l D1,A0 ret not equal X rts X2$ add.l D1,D1 word reference X move.l D1,D0 X add.l D1,D0 times 3 X add.l D1,D0 X add.l D0,A0 index to element X cmp.l D0,D0 X rts X3$ print arr_err X bra reinterp X X X DEF get X bsr arrayref X bne 1$ X move.w (A0)+,D2 type X move.l (A0),D0 value X bra r.ipush X1$ move.w #Integer,D2 X moveq #0,D0 X move.b (A0),D0 X bra r.ipush X X DEF put X bsr ipop X move.l D0,-(SP) X move.w D2,-(SP) X bsr arrayref X bne 1$ X move.w (SP)+,(A0)+ X move.l (SP)+,(A0) X rts X1$ move.w (SP)+,D2 X move.l (SP)+,D0 X cmp.w #Integer,D2 X bne type_mismatch X move.b D0,(A0) X rts X X DEF mark X moveq #0,D0 X RETURN Mark X X DEF rbracket X moveq #0,D3 count array elements X1$ bsr ipop X cmp.w #Mark,D2 X beq 2$ X addq.l #1,D3 X move.l D0,-(SP) X move.w D2,-(SP) X bra 1$ X2$ move.l nextcode,D0 X move.w #Array,D2 X bsr r.ipush X move.l D3,D0 X bsr stowword X bra 4$ X X3$ move.w (SP)+,D0 X bsr stowword X move.l (SP)+,D0 X bsr stowlong X4$ dbra D3,3$ X rts X X X DEF def X bsr ipop X movem.l D0/D2,-(SP) X ARG Name X move.l D0,A1 first check dict to see if old symbol X move.l D0,-(SP) save for name of new entry X bsr alldictsearch X move.l (SP)+,D0 X tst.l D2 found? X bmi newentry1 X* replace old entry X movem.l (SP)+,D0/D2 X*(perhaps change this so that when types don't match, X* make old entry nameless and create new entry, to prevent X* problem with previously compiled code) X move.w D2,(A2)+ new type X move.l D0,(A2) new value X rts X X* called from findsym Xnewentry X movem.l D0/D2,-(SP) X move.l A0,D0 X* make new entry X* type & value on stack; D0 -> name Xnewentry1 X move.w dstackcnt,D1 X bne 4$ X move.l nextentry,A0 X move.l D0,(A0)+ X movem.l (SP)+,D0/D2 X move.w D2,(A0)+ X move.l D0,(A0)+ X clr.l (A0) X cmp.l #enddict,A0 X bhi 3$ X move.l A0,nextentry X rts X3$ print fulldict X bra reinterp X4$ move.l dstack,A0 X move.l (A0),A0 address of dict -> current size X move.w -(A0),D1 D1 = maxsize X addq.l #2,A0 point at current size again X cmp.w (A0),D1 if max <= current, no room X bls 3$ X moveq #0,D1 form address for new entry X move.w (A0),D1 X add.l D1,D1 word X move.l D1,D2 5 * new current size X add.l D1,D1 X add.l D1,D1 X add.l D2,D1 X X addq.w #1,(A0)+ new current size, & point to 1st entry X add.l D1,A0 point to new entry X tst.l (A0) if not null, imp. error X bne imp_error X X move.l D0,(A0)+ X movem.l (SP)+,D0/D2 X move.w D2,(A0)+ X move.l D0,(A0)+ X clr.l (A0) X X rts X Xalldictsearch X move.l dstack,A0 X move.w dstackcnt,D3 X1$ subq.w #1,D3 X bmi 3$ X move.l (A0)+,A2 X addq.l #2,A2 past current length X movem.l D3/A0,-(SP) X bsr dictsearch X movem.l (SP)+,D3/A0 X tst.l D2 X* bmi 1$ (it was a mistake to search past top dictionary) X rts X3$ lea systemdict,A2 X xdef dictsearch X* A1 -> Name (bstr) X* A2 -> dict X* returns D2 = -1 if not found X* else D2 = type X* D0 = value X* A2 -> type in entry Xdictsearch X move.l A1,-(SP) X moveq #0,D3 len X move.l D3,D2 X move.b (A1)+,D3 X bsr nextsym X move.l (SP)+,A1 X rts X X X DEF exch X bsr ipop X move.l D0,D1 X move.w D2,D3 X bsr ipop X exg D0,D1 X exg D2,D3 X bsr r.ipush X move.l D1,D0 X move.w D3,D2 X bra r.ipush X X DEF dup X bsr ipop X bsr r.ipush X bra r.ipush X X DEF true X moveq #-1,D0 X RETURN Boolean X X DEF false X moveq #0,D0 X RETURN Boolean X X DEF cvr X ARG Integer X math SPFlt X RETURN Real X X DEF cvi X ARG Real X math SPFix X RETURN Integer X X************** X X DEF save X lea sstackcnt,A0 X cmp.w #SstackSize,(A0) X beq 1$ X addq.w #1,(A0) X move.l sstack,A0 X move.l farea,-(A0) X move.l nextentry,-(A0) X move.l nextcode,-(A0) X move.l A0,sstack X bsr _gsave X moveq #0,D0 X RETURN Save X1$ print sstkov X bra reinterp X X DEF restore X ARG Save X lea sstackcnt,A0 X tst.w (A0) X beq 1$ X subq.w #1,(A0) X move.l sstack,A0 X move.l (A0)+,nextcode X move.l (A0)+,A1 X clr.l (A1) X move.l A1,nextentry X move.l (A0)+,farea X bra _grestore X1$ print sstkuv X bra reinterp X X X**************** X Ximp_error X print imperr X bra reinterp X X xdef type_mismatch Xtype_mismatch X print mismatch X bra reinterp X X***************************** X section three,bss X Xstacksave ds.l 1 X Xgraphicsbase ds.l 1 Xintuitionbase ds.l 1 Xmathffpbase ds.l 1 Xmathtransbase ds.l 1 X Xwbscreen ds.l 1 Xrastport ds.l 1 X Xohandle ds.l 1 Xihandle ds.l 1 X X Xcodearea ds.w CodeSize Xendcode ds.w 4 X Xistack ds.l 1 X ds.b 12 Xistackbot ds.b 6*IstackSize Xistacktop ds.l 1 X Xdstackcnt ds.w 1 Xdstack ds.l 1 X ds.b 8 Xdstackbot ds.b 4*DstackSize Xdstacktop ds.l 1 X X Xsstackcnt ds.w 1 Xsstack ds.l 1 X ds.b 12 Xsstackbot ds.b 12*SstackSize Xsstacktop ds.l 1 X Xfsarea ds.b SAreaSize Xendsarea ds.b 2 X X section two,data X Xfarea dc.l fsarea Xnextentry dc.l fdict Xnextcode dc.l codearea Xcompilelevel dc.w 0 Xparenlevel dc.w 0 X X X bstr underflow,<stack underflow> X bstr overflow,<stack overflow> X bstr areafull,<string area is full> X bstr mismatch,<type mismatch> X bstr nsv,<--nostringval--> X bstr fulldict,<dictionary is full> X bstr codefull,<code area is full> X bstr unknown,<unknown symbol> X bstr rbrace,<unmatched right brace> X bstr fperr,<floating point error> X bstr arr_err,<bad array reference> X bstr dstackov,<dict stack overflow> X bstr dstackuv,<dict stack underflow> X bstr imperr,<implementation error> X bstr sstkov,<save stack overflow> X bstr sstkuv,<save stack underflow> X X end X \Rogue\Monster\ else echo "will not over write ./ps.a" fi if [ `wc -c ./ps.a | awk '{printf $1}'` -ne 19579 ] then echo `wc -c ./ps.a | awk '{print "Got " $1 ", Expected " 19579}'` fi echo "Finished archive 1 of 1" # if you want to concatenate archives, remove anything after this line exit
dillon@CORY.BERKELEY.EDU.UUCP (09/06/87)
>The recent source of the "ps" PostScript Interpreter, recently >posted, seems to be missing the 0s, 1s, and 5s in file "ps.a". Same here. I gave up assembling it. Otherwise, It looks like quite an accomplishment being completely written in assembly. -Matt