lee@uhccux.UUCP (Greg Lee) (08/28/87)
# 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: # ./a-box # ./color-chart # ./console.a # ./control.a # ./dict.a # ./fan # ./ffpa.a # ./files.a # if `test ! -s ./a-box` then echo "writing ./a-box" sed 's/^X//' > ./a-box << '\Rogue\Monster\' X Xsave X X/A { /simplex findfont 100 scalefont setfont X 300 100 moveto X (A) true charpath X stroke X } def X X/B { 100 100 moveto X 100 200 lineto X 200 200 lineto X 200 100 lineto X closepath X stroke X } def X X 2 pencolor 18 setlinewidth B A X 1 pencolor 8 setlinewidth B A X 3 pencolor 4 setlinewidth B A X Xrestore X \Rogue\Monster\ else echo "will not over write ./a-box" fi if [ `wc -c ./a-box | awk '{printf $1}'` -ne 346 ] then echo `wc -c ./a-box | awk '{print "Got " $1 ", Expected " 346}'` fi if `test ! -s ./color-chart` then echo "writing ./color-chart" sed 's/^X//' > ./color-chart << '\Rogue\Monster\' X X% Set up colors and show chart X Xsave X1 penmode X Xerasepage X X/xpos 0 def X/ypos 364 def X X/boxwidth 10 def X/boxheight 20 def X X/nextx { /xpos xpos boxwidth add def } def X/nexty { /xpos 0 def /ypos ypos boxheight sub def } def X X/onebox { X xpos ypos xpos boxwidth add ypos boxheight sub box X nextx X } def X X/fourbox { X .6 setgray onebox X .3 setgray onebox X .1 setgray onebox X 0 setgray onebox X } def X X/boxrow { X 0 1 15 X { pencolor fourbox } X for X } def X X/allbox { X 0 1 15 X { penbcolor boxrow nexty } X for X } def X X 0 pencolor 2 2 2 setrgbcolor % black X 1 pencolor 11 11 11 setrgbcolor % white X 2 pencolor 3 12 3 setrgbcolor % green X 3 pencolor 13 4 2 setrgbcolor % red X 4 pencolor 0 0 15 setrgbcolor % blue X 5 pencolor 12 12 0 setrgbcolor % yellow X 6 pencolor 0 8 2 setrgbcolor % olive X 7 pencolor 10 0 9 setrgbcolor % wine X 8 pencolor 6 2 0 setrgbcolor % rust X 9 pencolor 0 6 6 setrgbcolor % sea X10 pencolor 9 15 1 setrgbcolor % apple X11 pencolor 14 11 0 setrgbcolor % orange X12 pencolor 12 0 4 setrgbcolor % fire X13 pencolor 9 2 15 setrgbcolor % grape X14 pencolor 12 7 7 setrgbcolor % salmon X15 pencolor 0 15 8 setrgbcolor % sky X X allbox X X X 2 pencolor 0 penbcolor 1 penmode X/topaz findfont 8 scalefont setfont X/theight 364 boxheight sub 6 add def X/txpos 2 def X/nexttext { txpos theight moveto X /txpos txpos 4 boxwidth mul add def X /theight theight boxheight sub def X } def X X nexttext (black) show X nexttext (white) show X nexttext (green) show X nexttext (red) show X nexttext (blue) show X nexttext (yellow) show X nexttext (olive) show X nexttext (wine) show X nexttext (rust) show X nexttext (sea) show X nexttext (apple) show X nexttext (orange) show X nexttext (fire) show X nexttext (grape) show X nexttext (salmon) show X nexttext (sky) show X Xrestore X X \Rogue\Monster\ else echo "will not over write ./color-chart" fi if [ `wc -c ./color-chart | awk '{printf $1}'` -ne 1925 ] then echo `wc -c ./color-chart | awk '{print "Got " $1 ", Expected " 1925}'` fi if `test ! -s ./console.a` then echo "writing ./console.a" sed 's/^X//' > ./console.a << '\Rogue\Monster\' X X X xref abortps X xref the_window X X* xdef con_signal_number X X section one X X include "ps.h" X X X lref FindTask,45 X lref AllocSignal,51 X lref FreeSignal,52 X lref AddPort,55 X lref RemPort,56 X lref GetMsg,58 X lref OpenDevice,70 X lref CloseDevice,71 X lref DoIO,72 X lref SendIO,73 X Xcallex macro X move.l A6,-(SP) X move.l 4,A6 X jsr _LVO\1(A6) X move.l (SP)+,A6 X endm X X xdef start_console X xdef stop_console X xdef conmayread X xdef conputchar X xdef conputstr X Xnt_msgport equ 4 X Xpa_signal equ 0 Xpa_ignore equ 2 X Xcmd_reset equ 1 Xcmd_read equ 2 Xcmd_write equ 3 Xcmd_update equ 4 Xcmd_clear equ 5 Xcmd_stop equ 6 Xcmd_start equ 7 Xcmd_flush equ 8 X X Xstart_console X move.l the_window,o_window X X move.l #128,o_length X* X lea console_name,A0 X moveq #0,D0 unit X lea out_request,A1 IORequest X moveq #0,D1 flags X callex OpenDevice X* X X tst.l D0 X bne abortps X X* was opened X move.b #nt_msgport,ln_type X* clr.b port_flags X move.b #pa_ignore,port_flags X X moveq #-1,D0 X callex AllocSignal X move.b D0,con_signal_number X X moveq #0,D0 current task X move.l D0,A1 X callex FindTask X move.l D0,this_task X X lea console_port,A1 X callex AddPort X X move.l #console_port,reply_port X X move.l #out_request,A1 X move.l #in_request,A0 X moveq #11,D2 X1$ move.l (A1)+,(A0)+ X dbra D2,1$ X X bra conin X X X Xstop_console X moveq #0,D0 X move.b con_signal_number,D0 X bls 1$ X callex FreeSignal X1$ X X lea console_port,A1 X callex RemPort X X lea out_request,A1 X callex CloseDevice X rts X X Xconmayread X lea console_port,A0 X callex GetMsg X tst.l D0 X bne 1$ X moveq #-1,D0 X rts X1$ X moveq #0,D0 X move.b con_in_buffer,D0 X move.l D0,-(SP) X bsr conin X move.l (SP)+,D0 X rts X Xconin X move.w #cmd_read,i_command X move.l #con_in_buffer,i_data X moveq #1,D0 X move.l D0,i_length X X lea in_request,A1 X callex SendIO X X rts X X Xconputchar X move.w #cmd_write,o_command X lea con_out_buffer,A0 X move.b D0,(A0) X move.l A0,o_data X moveq #1,D0 X move.l D0,o_length X lea out_request,A1 X callex DoIO X rts X X Xconputstr X move.w #cmd_write,o_command X move.l D2,o_data X move.l D3,o_length X lea out_request,A1 X callex DoIO X move.l o_actual,D0 X rts X X Xconsole_name X dc.b 'console.device',0 X X section two,bss X Xout_request X ds.b 14 LN Xreply_port X ds.l 1 reply port X ds.w 1 length X ds.l 2 device node pointer & unit Xo_command X ds.w 1 X ds.b 2 flags & error Xo_actual X ds.l 1 actual length Xo_length X ds.l 1 Xo_window Xo_data X ds.l 2 X X X Xin_request X ds.b 14 LN X ds.l 1 X ds.w 1 X ds.l 2 Xi_command X ds.w 1 X ds.b 2 X ds.l 1 Xi_length X ds.l 1 Xi_data X ds.l 2 X X* message port Xconsole_port X* LN = A A B B A X ds.l 1 X ds.l 1 X* type of LN & pri & name Xln_type X ds.b 1 X ds.b 1 X ds.l 1 Xport_flags X ds.b 1 ;flags Xcon_signal_number X ds.b 1 ;signal bit num Xthis_task X ds.l 3 ;task & next 14b. is LH X ds.b 6 X* end of message port X Xcon_in_buffer X ds.b 2 Xcon_out_buffer X ds.b 2 X X end X \Rogue\Monster\ else echo "will not over write ./console.a" fi if [ `wc -c ./console.a | awk '{printf $1}'` -ne 3523 ] then echo `wc -c ./console.a | awk '{print "Got " $1 ", Expected " 3523}'` fi if `test ! -s ./control.a` then echo "writing ./control.a" sed 's/^X//' > ./control.a << '\Rogue\Monster\' X X xref ipop X xref popnum X xref r.ipush X xref msg X xref reinterp X xref type_mismatch X X section one X X include "ps.h" X X xdef initloops X X X X DEF exec X bsr ipop X cmp.w #ICode,D2 X bne r.ipush X move.l D0,A0 X jmp (A0) X X DEF if X ARG ICode X move.l D0,-(SP) X ARG Boolean X tst.l D0 X bne 1$ X addq #4,SP X1$ rts X X DEF ifelse X ARG ICode X move.l D0,D1 X ARG ICode X move.l D0,D3 X ARG Boolean X tst.l D0 X bne 1$ X move.l D1,A0 X jmp (A0) X1$ move.l D3,A0 X jmp (A0) X X DEF for X ARG ICode X bsr makeloop X X bsr popnum X move.l D0,4(SP) limit X bsr popnum X move.l D0,8(SP) incr X bsr popnum X move.l D0,12(SP) init X X1$ move.l 12(SP),D0 X move.l 8(SP),D1 X move.l 4(SP),D2 X X tst.l D1 X bmi 2$ X cmp.l D2,D0 X bra 3$ X2$ cmp.l D0,D2 X3$ bgt _exit X X move.w #Integer,D2 X bsr r.ipush X X add.l D1,D0 X move.l D0,12(SP) X X move.l (SP),A0 X jsr (A0) X bra 1$ X X DEF repeat X ARG ICode X bsr makeloop X bsr popnum X1$ subq.l #1,D0 X bmi _exit X move.l D0,4(SP) X move.l (SP),A0 X jsr (A0) X move.l 4(SP),D0 X bra 1$ X X DEF loop X ARG ICode X bsr makeloop X1$ move.l (SP),A0 X jsr (A0) X bra 1$ X X* stack while looping: X* ret after loop X* save exitsp 16(SP) X* init 12(SP) <- addr for looping proc X* incr 8(SP) X* limit 4(SP) X* proc (SP) X* ret for next repeat X X X DEF exit X move.w loops,D0 X beq 1$ X subq.w #1,D0 X move.w D0,loops X move.l exitsp,D0 X beq 1$ this should be impossible X move.l D0,SP X move.l (SP)+,exitsp X rts X1$ ERR no_loop X Xmakeloop X move.l (SP)+,A0 ret address to loop requestor X move.l exitsp,-(SP) X move.l SP,exitsp for possible call to _exit X lea -12(SP),SP room for init, incr, limit X move.l D0,-(SP) procedure to loop on X move.w loops,D0 note one more nesting level X addq.w #1,D0 X move.w D0,loops X jmp (A0) return X Xinitloops X moveq #0,D0 X move.w D0,loops X move.l D0,exitsp X rts X Xloops dc.w 0 Xexitsp dc.l 0 X X X DEF stop X move.l stopsave,D0 X beq type_mismatch change X move.l D0,SP X rts X X DEF stopped X ARG ICode X pea ..stop X move.l SP,stopsave X move.l D0,A0 X jsr (A0) X addq.l #4,SP X moveq #0,D0 X RETURN Boolean X Xstopsave dc.l 0 X X..stop X moveq #-1,D0 X RETURN Boolean X X DEF countexecstack X move.w #Integer,D2 X moveq #0,D0 X RETURN Integer X X DEF execstack X rts X X X DEF start X rts X X X bstr no_loop,<exit outside loop> X X end X \Rogue\Monster\ else echo "will not over write ./control.a" fi if [ `wc -c ./control.a | awk '{printf $1}'` -ne 2908 ] then echo `wc -c ./control.a | awk '{print "Got " $1 ", Expected " 2908}'` fi if `test ! -s ./dict.a` then echo "writing ./dict.a" sed 's/^X//' > ./dict.a << '\Rogue\Monster\' X X X X idnt dict X X section one X X include "ps.h" X X xref _hex X xref _quit X xref _run X xref _print X xref _equalsprint X xref _file X xref _read X xref _write X X xref _string X xref _dict X xref _begin X xref _end X xref _array X xref _maxlength X xref _length X xref _get X xref _put X X xref _mark X xref _rbracket X X xref _save X xref _restore X X xref _eq X xref _ne X xref _ge X xref _gt X xref _le X xref _lt X xref _add X xref _sub X xref _mul X xref _idiv X xref _div X xref _mod X xref _abs X xref _neg X xref _ceiling X xref _floor X xref _round X xref _truncate X X xref _sqrt X xref _ln X xref _log X xref _exp X xref _pow X xref _tanh X xref _cosh X xref _sinh X xref _tan X xref _cos X xref _sin X xref _atan X X xref _currentpoint X xref _gsave X xref _grestore X xref _translate X xref _scale X xref _rotate X xref _concat X xref _concatmatrix X xref _transform X xref _dtransform X X xref _def X xref _pop X xref _exch X xref _dup X xref _copy X xref _index X xref _roll X xref _count X xref _clear X xref _true X xref _false X X xref _exec X xref _if X xref _ifelse X xref _for X xref _repeat X xref _loop X xref _exit X xref _stop X xref _stopped X xref _countexecstack X xref _execstack X xref _start X X xref _cvr X xref _cvi X xref _cvs X X xref _stringwidth X xref _charpath X xref _strokepath X xref _setlinewidth X xref _currentlinewidth X xref _setlinecap X xref _currentlinecap X xref _setlinejoin X xref _currentlinejoin X xref _setflat X xref _currentflat X xref _show X xref _moveto X xref _rmoveto X xref _lineto X xref _rlineto X xref _curveto X xref _rcurveto X xref _closepath X xref _newpath X xref _setgray X xref _currentgray X xref _greyline X xref _flood X xref _fill X xref _stroke X xref _erasepage X xref _pencolor X xref _penbcolor X xref _penmode X xref _penpattern X xref _box X xref _currentrgbcolor X xref _setrgbcolor X xref _findfont X xref _scalefont X xref _makefont X xref _setfont X xref _currentfont X xref _pixel X X****************** X X xdef systemdict X xdef fdict X xdef enddict X xdef .true X xdef .false X X****************** X Xdentry macro X dc.l .\1 X dc.w ICode X dc.l _\1 X endm X Xnentry macro X.\1 dc.b 1$-*-1 X dc.b '\1' X1$ X endm X Xsystemdict X dentry hex X dentry quit X dentry run X dentry print X dentry equalsprint X dentry file X dentry read X dentry write X X X dentry string X dentry dict X dentry begin X dentry end X dentry array X dentry maxlength X dentry length X dentry get X dentry put X X dentry mark X* dentry lbracket X dc.l .lbracket X dc.w ICode X dc.l _mark X dentry rbracket X X dentry save X dentry restore X X dentry eq X dentry ne X dentry ge X dentry gt X dentry le X dentry lt X dentry add X dentry sub X dentry mul X dentry idiv X dentry div X dentry mod X dentry abs X dentry neg X dentry ceiling X dentry floor X dentry round X dentry truncate X X dentry sqrt X dentry ln X dentry log X dentry exp X dentry pow X dentry tanh X dentry cosh X dentry sinh X dentry tan X dentry cos X dentry sin X dentry atan X X dentry currentpoint X dentry gsave X dentry grestore X dentry translate X dentry scale X dentry rotate X dentry concat X dentry concatmatrix X dentry transform X dentry dtransform X X dentry def X dentry pop X dentry exch X dentry dup X dentry copy X dentry index X dentry roll X dentry count X dentry clear X dentry true X dentry false X X dentry exec X dentry if X dentry ifelse X dentry for X dentry repeat X dentry loop X dentry exit X dentry stop X dentry stopped X dentry countexecstack X dentry execstack X dentry start X X dentry cvr X dentry cvi X dentry cvs X X dentry stringwidth X dentry charpath X dentry strokepath X dentry setlinewidth X dentry currentlinewidth X dentry setlinecap X dentry currentlinecap X dentry setlinejoin X dentry currentlinejoin X dentry setflat X dentry currentflat X X dentry show X dentry moveto X dentry rmoveto X dentry lineto X dentry rlineto X dentry curveto X dentry rcurveto X dentry closepath X dentry newpath X dentry setgray X dentry currentgray X dentry greyline X dentry flood X dentry fill X dentry stroke X dentry erasepage X dentry pencolor X dentry penbcolor X dentry penmode X dentry penpattern X dentry box X dentry currentrgbcolor X dentry setrgbcolor X dentry findfont X dentry scalefont X dentry makefont X dentry setfont X dentry currentfont X dentry pixel X Xfdict X dcb.w 5*SizeDict,0 Xenddict X dcb.w 10,0 X Xsarea X nentry hex X nentry quit X nentry run X nentry print X* nentry equalsprint X.equalsprint dc.b 1,'=' X nentry file X nentry read X nentry write X X nentry string X nentry dict X nentry begin X nentry end X nentry array X nentry maxlength X nentry length X nentry get X nentry put X X nentry mark X* nentry lbracket X.lbracket dc.b 1,'[' X* nentry rbracket X.rbracket dc.b 1,']' X X nentry save X nentry restore X X nentry eq X nentry ne X nentry ge X nentry gt X nentry le X nentry lt X nentry add X nentry sub X nentry mul X nentry idiv X nentry div X nentry mod X nentry abs X nentry neg X nentry ceiling X nentry floor X nentry round X nentry truncate X X nentry sqrt X nentry ln X nentry log X nentry exp X nentry pow X nentry tanh X nentry cosh X nentry sinh X nentry tan X nentry cos X nentry sin X nentry atan X X nentry currentpoint X nentry gsave X nentry grestore X nentry translate X nentry scale X nentry rotate X nentry concat X nentry concatmatrix X nentry transform X nentry dtransform X X nentry def X nentry pop X nentry exch X nentry dup X nentry copy X nentry index X nentry roll X nentry count X nentry clear X nentry true X nentry false X X nentry exec X nentry if X nentry ifelse X nentry for X nentry repeat X nentry loop X nentry exit X nentry stop X nentry stopped X nentry countexecstack X nentry execstack X nentry start X X nentry cvr X nentry cvi X nentry cvs X X nentry stringwidth X nentry charpath X nentry strokepath X nentry setlinewidth X nentry currentlinewidth X nentry setlinecap X nentry currentlinecap X nentry setlinejoin X nentry currentlinejoin X nentry setflat X nentry currentflat X nentry show X nentry moveto X nentry rmoveto X nentry lineto X nentry rlineto X nentry curveto X nentry rcurveto X nentry closepath X nentry newpath X nentry setgray X nentry currentgray X nentry greyline X nentry flood X nentry fill X nentry stroke X nentry erasepage X nentry pencolor X nentry penbcolor X nentry penmode X nentry penpattern X nentry box X nentry currentrgbcolor X nentry setrgbcolor X nentry findfont X nentry scalefont X nentry makefont X nentry setfont X nentry currentfont X nentry pixel X X cnop 0,2 X X end X \Rogue\Monster\ else echo "will not over write ./dict.a" fi if [ `wc -c ./dict.a | awk '{printf $1}'` -ne 7654 ] then echo `wc -c ./dict.a | awk '{print "Got " $1 ", Expected " 7654}'` fi if `test ! -s ./fan` then echo "writing ./fan" sed 's/^X//' > ./fan << '\Rogue\Monster\' X Xsave X X/h {350 100 moveto} def X X 50 10 200 X { h 400 exch lineto stroke} for X X 390 -10 250 X { h 200 lineto stroke} for X X 190 -10 50 X { h 250 exch lineto stroke} for X X 260 10 390 X { h 50 lineto stroke} for X Xrestore X \Rogue\Monster\ else echo "will not over write ./fan" fi if [ `wc -c ./fan | awk '{printf $1}'` -ne 214 ] then echo `wc -c ./fan | awk '{print "Got " $1 ", Expected " 214}'` fi if `test ! -s ./ffpa.a` then echo "writing ./ffpa.a" sed 's/^X//' > ./ffpa.a << '\Rogue\Monster\' X X xdef FFPAFP X xdef FFPFPA X X section one X XFFPAFP X moveq #0,D7 X moveq #0,D6 X bsr R0004CA X beq lab0448 X bcs lab042E X cmp.b #'-',D5 X seq D6 X swap D6 X bsr R0004CA X beq lab0448 Xlab042E X cmp.b #'.',D5 X bne lab043A X bsr R0004CA X beq lab04A4 Xlab043A X subq.l #1,A0 X or.b #1,CCR X rts Xlab0442 X bsr R0004CA X bne lab049A Xlab0448 X bsr R0004AC X bcc lab0442 Xlab044C X addq.w #1,D6 X bsr R0004CA X beq lab044C X cmp.b #'.',D5 X bne lab045C Xlab0458 X bsr R0004CA X beq lab0458 Xlab045C X cmp.b #'E',D5 X bne lab0492 X bsr R0004CA X beq lab0476 X bcs lab043A X rol.l #8,D6 X cmp.b #'-',D5 X seq D6 X ror.l #8,D6 X bsr R0004CA X bne lab043A Xlab0476 X move.w D5,D4 Xlab0478 X bsr R0004CA X bne lab048A X mulu #$0A,D4 X cmp.w #$07D0,D4 X bhi lab043A X add.w D5,D4 X bra lab0478 Xlab048A X tst.l D6 X bpl lab0490 X neg.w D4 Xlab0490 X add.w D4,D6 Xlab0492 X subq.l #1,A0 X jmp FFPDBF Xlab049A X cmp.b #'.',D5 X bne lab045C Xlab04A0 X bsr R0004CA X bne lab045C Xlab04A4 X bsr R0004AC X bcs lab0458 X subq.w #1,D6 X bra lab04A0 X XR0004AC X move.l D7,D3 X lsl.l #1,D3 X bcs lab04C8 X lsl.l #1,D3 X bcs lab04C8 X lsl.l #1,D3 X bcs lab04C8 X add.l D7,D3 X bcs lab04C8 X add.l D7,D3 X bcs lab04C8 X add.l D5,D3 X bcs lab04C8 X move.l D3,D7 Xlab04C8 X rts X XR0004CA X moveq #0,D5 X move.b (A0)+,D5 X cmp.b #'+',D5 X beq lab04F0 X cmp.b #'-',D5 X beq lab04F0 X cmp.b #'0',D5 X bcs lab04F6 X cmp.b #'9',D5 X bhi lab04F6 X and.b #$0F,D5 X move #4,CCR X rts Xlab04F0 X move #0,CCR X rts Xlab04F6 X move #1,CCR X rts X X X XFFPDBF X moveq #$20,D5 X tst.l D7 X beq lab0330 X bmi lab02B6 X moveq #$1F,D5 Xlab02B0 X add.l D7,D7 X dbmi D5,lab02B0 Xlab02B6 X cmp.w #$12,D6 X bgt lab033A X cmp.w #$FFE4,D6 X blt lab0332 X move.w D6,D4 X neg.w D4 X muls #6,D4 X move.l A0,-(SP) X lea .wmidtable,A0 X add.w 0(A0,D4.w),D5 X move.w D5,D6 X move.l 2(A0,D4.w),D3 X move.l (SP),A0 X move.l D3,(SP) X move.w D7,D5 X mulu D3,D5 X clr.w D5 X swap D5 X moveq #0,D4 X swap D3 X mulu D7,D3 X add.l D3,D5 X addx.b D4,D4 X swap D7 X move.w D7,D3 X mulu 2(SP),D3 X add.l D3,D5 X bcc lab0300 X addq.b #1,D4 Xlab0300 X move.w D4,D5 X swap D5 X mulu (SP),D7 X lea 4(SP),SP X add.l D5,D7 X bmi lab0312 X add.l D7,D7 X subq.w #1,D6 Xlab0312 X add.l #$00000080,D7 X bcc lab031E X roxr.l #1,D7 X addq.w #1,D6 Xlab031E X moveq #9,D3 X move.w D6,D4 X asl.w D3,D6 X bvs lab0336 X eor.w #$8000,D6 X lsr.l D3,D6 X move.b D6,D7 X beq lab0332 Xlab0330 X rts Xlab0332 X moveq #0,D7 X rts Xlab0336 X tst.w D4 X bmi lab0332 Xlab033A X moveq #-1,D7 X swap D6 X roxr.b #1,D6 X roxr.b #1,D7 X tst.b D7 X or.b #2,CCR X rts X X XFFPFPA X lea -$0A(SP),SP X move.l $0A(SP),-(SP) X move.w #0,-(SP) X tst.b D7 X movem.l D2-D6/A0/A1,-(SP) X bne lab0512 X moveq #$41,D7 Xlab0512 X move.w #$2B2E,$22(SP) X move.b D7,D6 X bpl lab0520 X addq.b #2,$22(SP) Xlab0520 X add.b D6,D6 X move.b #$80,D7 X eor.b D7,D6 X ext.w D6 X asr.w #1,D6 X moveq #1,D3 X lea .wmidtable,A0 X cmp.w (A0),D6 X blt lab0554 X bgt lab0546 Xlab053A X cmp.l 2(A0),D7 X bcc lab0560 Xlab0540 X addq.w #6,A0 X subq.w #1,D3 X bra lab0560 Xlab0546 X lea -6(A0),A0 X addq.w #1,D3 X cmp.w (A0),D6 X bgt lab0546 X beq lab053A X bra lab0540 Xlab0554 X lea 6(A0),A0 X subq.w #1,D3 X cmp.w (A0),D6 X blt lab0554 X beq lab053A Xlab0560 X move.l #$452B3030,$2C(SP) X move.w D3,D2 X bpl lab0572 X neg.w D2 X addq.b #2,$2D(SP) Xlab0572 X cmp.w #$0A,D2 X bcs lab0580 X addq.b #1,$2E(SP) X sub.w #$0A,D2 Xlab0580 X or.b D2,$2F(SP) X moveq #7,D2 X lea $24(SP),A1 X tst.l D7 X bpl lab0594 X tst.b 5(A0) X bne lab0596 Xlab0594 X clr.b D7 Xlab0596 X move.w D6,D4 X sub.w (A0)+,D4 X move.l (A0)+,D5 X lsr.l D4,D5 X moveq #9,D4 Xlab05A0 X sub.l D5,D7 X dbcs D4,lab05A0 X bcs lab05AA X clr.b D4 Xlab05AA X add.l D5,D7 X sub.b #9,D4 X neg.b D4 X or.b #'0',D4 X move.b D4,(A1)+ X dbra D2,lab0596 X move.w D3,D7 X ext.l D7 X movem.l (SP)+,D2-D6/A0/A1 X addq.l #2,SP X rts X X section two,data X X.wFFP10TBL X dc.w $40,$8AC7,$2305,$3C,$DE0B,$6B3A X dc.w $39,$B1A2,$BC2F,$36,$8E1B,$C9BF X dc.w $32,$E35F,$A932,$2F,$B5E6,$20F5 X dc.w $2C,$9184,$E72A,$28,$E8D4,$A510 X dc.w $25,$BA43,$B740,$22,$9502,$F900 X dc.w $1E,$EE6B,$2800,$1B,$BEBC,$2000 X dc.w $18,$9896,$8000,$14,$F424,0,$11 X dc.w $C350,0,$0E,$9C40,0,$0A,$FA00 X dc.w 0,7,$C800,0,4,$A000,0 X.wmidtable X dc.w 1,$8000,0,$FFFD,$CCCC,$CCCD,$FFFA X dc.w $A3D7,$0A3D,$FFF7,$8312,$6E98 X dc.w $FFF3,$D1B7,$1759,$FFF0,$A7C5 X dc.w $AC47,$FFED,$8637,$BD06,$FFE9 X dc.w $D6BF,$94D6,$FFE6,$ABCC,$7712 X dc.w $FFE3,$8970,$5F41,$FFDF,$DBE6 X dc.w $FECF,$FFDC,$AFEB,$FF0C,$FFD9 X dc.w $8CBC,$CC09,$FFD5,$E12E,$1342 X dc.w $FFD2,$B424,$DC35,$FFCF,$901D X dc.w $7CF7,$FFCB,$E695,$94BF,$FFC8 X dc.w $B877,$AA32,$FFC5,$9392,$EE8F X dc.w $FFC1,$EC1E,$4A7E,$FFBE,$BCE5 X dc.w $0865,$FFBB,$971D,$A050,$FFB7 X dc.w $F1C9,$81,$FFB4,$C16D,$9A01,$FFB1 X dc.w $9ABE,$14CD,$FFAD,$F796,$87AE X dc.w $FFAA,$C612,$0625,$FFA7,$9E74 X dc.w $D1B8,$FFA3,$FD87,$B5F3 X X end X \Rogue\Monster\ else echo "will not over write ./ffpa.a" fi if [ `wc -c ./ffpa.a | awk '{printf $1}'` -ne 6330 ] then echo `wc -c ./ffpa.a | awk '{print "Got " $1 ", Expected " 6330}'` fi if `test ! -s ./files.a` then echo "writing ./files.a" sed 's/^X//' > ./files.a << '\Rogue\Monster\' X X* file input X X* in console.o X xref start_console X xref stop_console X xref conmayread X xref conputchar X xref conputstr X X* in ps.o X xref ihandle,ohandle X xref rastport,wbscreen X xref intuitionbase X xref graphicsbase X xref mathffpbase X xref mathtransbase X X xref _quit X X xref type_mismatch X xref reinterp X xref ipop X xref r.ipush X X* in lmath.o X xref lmoddivu X* in ffpa.o X xref FFPFPA X X X xdef the_window X xdef viewport X xdef abortps X X xdef readln X xdef runclose called by _quit X X xdef showreal X xdef show8x X xdef showdec X xdef newline X xdef getstr X xdef msg,longmsg X xdef ioinit X xdef endio X X X section one X X include "ps.h" X X X X lref CloseScreen,7 X lref CloseWindow,8 X lref OpenScreen,29 X lref OpenWindow,30 X Xintuit macro X move.l A6,-(SP) X move.l intuitionbase,A6 X jsr _LVO\1(A6) X move.l (SP)+,A6 X endm X X XSysBase equ 4 X X lref OpenLibrary,88 X X X lref Output,6 X lref Input,5 X lref Write,4 X lref Read,3 X lref DeleteFile,8 X lref Open,1 X lref Close,2 X lref IoErr,18 X lref LoadSeg,21 X lref UnLoadSeg,22 X lref IsInteractive,32 X X XIbufLen equ 80 XRnameLen equ 30 X Xabortps X print leaving X bra _quit X X X DEF run X bsr ipop X cmp.w #String,D2 X bne type_mismatch X X lea runflag,A0 X tst.b (A0) X bne .rierr X X move.l D0,A0 X move.w (A0)+,D3 X beq .rnerr X cmp.w #RnameLen,D3 X bhi .rnerr X lea runname,A1 X move.l A1,D1 X bra 2$ X1$ move.b (A0)+,(A1)+ X2$ dbra D3,1$ X clr.b (A1) X move.l #1005,D2 X call Open X tst.l D0 X beq .opnerr X X move.b #$FF,runflag X X* save standard input data X move.l ihandle,s_ihandle X move.l bufptr,s_bufptr X move.b bufchcount,s_bufchcount X move.w #IbufLen+4,D3 X lea ilen,A0 X lea s_ibuf,A1 X bra 4$ X3$ move.b (A0)+,(A1)+ X4$ dbra D3,3$ X X* initialize for run file X move.l D0,ihandle X lea ibuf,A0 X move.l A0,bufptr X clr.b bufchcount X rts X Xrunclose X st D0 signal exhausted X lea runflag,A0 X tst.b (A0) X bne 1$ X lea backgroundflag,A0 X tst.b (A0) X beq 5$ X clr.b (A0) X moveq #0,D0 X rts X X1$ clr.b (A0) X X move.l ihandle,D1 X call Close X X* restore standard input data X move.l s_ihandle,ihandle X move.l s_bufptr,bufptr X move.b s_bufchcount,bufchcount X move.w #IbufLen+4,D3 X lea ilen,A1 X lea s_ibuf,A0 X bra 4$ X3$ move.b (A0)+,(A1)+ X4$ dbra D3,3$ X move.b bufchcount,D0 X5$ rts X X.rierr X print ri_err X bra reinterp X.rnerr X print rn_err X bra reinterp X.opnerr X print op_err X bra reinterp X X bstr ri_err,<can''t imbed run files> X bstr rn_err,<bad file name> X bstr op_err,<can''t open file> X bstr leaving,<problem of some sort> X cnop 0,2 X X* return A0 pointing to line and D3 length of line Xreadln X move.l bufptr,A0 X move.l A0,-(SP) X moveq #0,D3 * no chars in line yet X* back to here when was necessary to read more from file X.rdln.cont X moveq #0,D2 X move.b bufchcount,D2 X bmi 5$ * this means file is exhausted X beq .rdln.more X X subq.b #1,D2 X2$ cmp.b #10,(A0)+ X beq 4$ X addq.b #1,D3 X3$ dbra D2,2$ X* ran out of chars -- go get more X bra .rdln.more X* have one line -- check not empty X4$ tst.b D3 X bne 5$ X move.l A0,(SP) * replace pointer to ret. X bra 3$ X5$ move.l A0,bufptr X move.b D2,bufchcount X move.l (SP)+,A0 X rts X X X.rdln.more X* have partial line in buffer with D3 chars in it X move.l (SP)+,A1 * beginning of partial line X* while D3>0 move chars back to beginning of buffer X lea ibuf,A0 X move.l A0,-(SP) * for ret. X move.l D3,-(SP) X subq.b #1,D3 X bmi 8$ * if line was of 0 length X6$ move.b (A1)+,(A0)+ X dbra D3,6$ X X* fill remainder of buffer with 80-(D3) chars X8$ move.l #IbufLen,D3 X move.l (SP)+,D0 X sub.b D0,D3 X move.l D0,-(SP) X X lea ibuf,A1 X add.l D0,A1 X* save where to continue processing line X move.l A1,-(SP) X X move.l ihandle,D1 X move.l A1,D2 X* call Read X bsr nread X X tst.b D0 X bne 9$ X bsr runclose X9$ move.b D0,bufchcount X X move.l (SP)+,A0 * continue processing here X move.l (SP)+,D3 * chars scanned so far X bra .rdln.cont X X Xshowreal X move.l D0,D7 X jsr FFPFPA X lea olen,A1 X move.l A1,A0 X move.b #14,(A1)+ X moveq #6,D1 X1$ move.w (SP)+,(A1)+ X dbra D1,1$ X bsr fmtfloat X* bra msg X rts X Xfmtfloat X cmp.b #'0',13(A0) would be too many digits? X bne 10$ X cmp.b #'4',10(A0) last digit often wrong X bhi 89$ X move.b #'0',10(A0) X89$ X cmp.b #'-',12(A0) X bne 100$ X moveq #10,D2 X moveq #0,D1 X90$ X cmp.b #'0',0(A0,D2.w) X bne 91$ X subq.l #1,D2 X addq.l #1,D1 X bra 90$ X91$ X move.b 14(A0),D3 X sub.b #'0',D3 X cmp.b D1,D3 X bgt 10$ X move.l D2,D1 X add.l D3,D1 X92$ X move.b 0(A0,D2.w),D0 X cmp.b #'.',D0 X bne 93$ X move.b #'0',D0 X addq #1,D2 X93$ X move.b D0,0(A0,D1.w) X subq #1,D2 X subq #1,D1 X cmp #2,D1 X bne 92$ X X move.b #'0',14(A0) X X100$ X move.b #'0',11(A0) X moveq #0,D3 X move.b 14(A0),D3 X sub.b #'0',D3 X movem.l A0/A1,-(SP) X lea 2(A0),A1 X lea 3(A0),A0 X bra 2$ X1$ move.b (A0)+,(A1)+ X2$ dbra D3,1$ X move.b #'.',(A1) X movem.l (SP)+,A0/A1 X X moveq #11,D3 X move.b D3,(A0) X3$ cmp.b #'0',0(A0,D3.w) X bne 4$ X sub.b #1,(A0) X subq #1,D3 X bra 3$ X X4$ cmp.b #'.',0(A0,D3.w) X bne 5$ X sub.b #1,(A0) X cmp.b #1,(A0) X bne 5$ X move.b #'0',1(A0) X rts X5$ X X10$ X cmp.b #'+',1(A0) remove initial + X bne 11$ X move.b (A0)+,D0 X subq.b #1,D0 X move.b D0,(A0) X11$ X rts X Xshow8x X bsr binhex X lea olen,A0 X X move.l A0,A1 X move.b (A1)+,D1 X1$ cmp.b #'0',(A1)+ X bne 2$ *msg X subq.b #1,D1 X beq 2$ *msg X addq.l #1,A0 X move.b D1,(A0) X bra 1$ X2$ rts X Xshowdec X lea obuf,A2 X lea 10(A2),A2 X moveq #8,D3 X move.l D0,-(SP) X move.l D0,D1 X bpl 3$ X neg.l D1 X3$ moveq #10,D2 X jsr lmoddivu D1/D2->D1, rem in D0 X move.b D0,-(A2) X add.b #'0',(A2) X dbra D3,3$ X X moveq #9,D1 X4$ cmp.b #'0',(A2) X bne 6$ X subq #1,D1 X beq 5$ X addq.l #1,A2 X bra 4$ X5$ addq #1,D1 X6$ move.l (SP)+,D0 X bpl 7$ X move.b #'-',-(A2) X addq #1,D1 X7$ move.b D1,-(A2) X move.l A2,A0 X* bra msg X rts X X* D0 to hex in obuf Xbinhex X move.b #8,olen X lea obuf,A0 X add.l #8,A0 X lea hextab,A1 X moveq #7,D1 X1$ move.l D0,D2 X and.l #15,D2 X move.b 0(A1,D2),-(A0) X lsr.l #4,D0 X dbra D1,1$ X rts X Xhextab dc.b '0123456789ABCDEF' X Xnread X tst.w runflag i.e., run or background X beq conreadln X call Read X rts X XCSI equ $9B X Xconreadln X move.l D4,-(SP) X move.l D2,A0 X moveq #0,D1 X move.l D1,D4 X X tst.l D3 X beq 6$ X X1$ movem.l D1/A0,-(SP) X2$ bsr conmayread X tst.l D0 X bmi 2$ X cmp.b #13,D0 X bne 3$ X move.b #10,D0 X3$ X bsr echochar X movem.l (SP)+,D1/A0 X bsr csicheck X beq 1$ X cmp.b #10,D0 X beq 41$ X cmp.b #8,D0 X bne 4$ X tst.l D1 X beq 5$ X subq.l #1,A0 X subq.l #1,D1 X bra 5$ X4$ X cmp.b #' ',D0 X bcs 5$ X41$ X or.b D4,D0 X move.b D0,(A0)+ X addq.l #1,D1 X5$ X cmp.l D3,D1 X beq 6$ X cmp.b #10,D0 X bne 1$ X6$ move.l (SP)+,D4 X move.l D1,D0 X rts X Xechochar X move.w D0,-(SP) X cmp.b #CSI,D0 X beq 8$ X cmp.b #' ',D0 X bcc 6$ X cmp.b #10,D0 X beq 6$ X cmp.b #8,D0 X beq 6$ X cmp.b #14,D0 shift in X bne 1$ X move.b #$80,D4 X bra 6$ X1$ X cmp.b #15,D0 shift out X bne 8$ X clr.b D4 X6$ X bsr conputchar X8$ X move.w (SP)+,D0 X rts X Xcsicheck X cmp.b #CSI,D0 X bne 100$ X movem.l D1/A0,-(SP) X1$ bsr conmayread X tst.l D0 X bmi 1$ X cmp.b #'A',D0 up X beq 3$ X cmp.b #'B',D0 down X beq 3$ X cmp.b #'C',D0 left X beq 3$ X cmp.b #'D',D0 right X beq 3$ X2$ bsr conmayread X tst.l D0 X bmi 2$ X cmp.b #'~',D0 X bne 2$ X3$ X movem.l (SP)+,D1/A0 X100$ X rts X Xgetstr X bsr readln X tst.l D3 X beq _quit X move.l A0,A1 X lea -1(A1,D3.W),A0 X cmp.b #10,(A0) case of file that does not end w. NL X beq 1$ X addq.l #1,A0 X1$ move.b #0,(A0) X rts X X X DEF file X ARG String X move.l D0,A1 X ARG String X move.l D0,A0 X move.w (A1)+,D3 X subq.w #1,D3 X bne 5$ X move.b (A1),D1 X lea stdinname,A1 X bsr st01cmp X bne 2$ X cmp.b #'r',D1 X bne 5$ X moveq #1,D0 X bra 4$ X2$ lea stdoutname,A1 X bsr st01cmp X bne 6$ X cmp.b #'w',D1 X bne 5$ X moveq #2,D0 X4$ RETURN File X5$ ERR badfa X6$ ERR badfn X X DEF read X ARG File X subq.l #1,D0 X bne 3$ X1$ bsr conmayread X tst.l D0 X bmi 1$ X bsr 2$ X moveq #-1,D0 X RETURN Boolean X2$ RETURN Integer X3$ ERR filerr X X X DEF write X ARG Integer X move.l D0,D1 X ARG File X exg D0,D1 X subq.l #2,D1 X beq conputchar X ERR filerr X Xst01cmp X move.l A0,-(SP) X move.w (A0)+,D3 X cmp.b (A1)+,D3 X bne 2$ X subq.l #1,D3 X1$ cmp.b (A0)+,(A1)+ X dbne D3,1$ X2$ move.l (SP)+,A0 X rts X Xstdinname dc.b 6,'%stdin' Xstdoutname dc.b 7,'%stdout' X cnop 0,2 X Xnewline X move.b #10,D0 Xprtchr X move.b D0,obuf X move.l ohandle,D1 X lea obuf,A1 X move.l A1,D2 X moveq #1,D3 X bra .msg1 X X* message to console Xmsg X clr.l D3 X move.b (A0)+,D3 Xlongmsg X move.l ohandle,D1 X move.l A0,D2 X.msg1 X* call Write X bra conputstr X* rts X X* obtain pointer to AmigaDOS Xioinit X move.l SysBase,A6 * ready call to OpenLibrary X X lea ilibname,A1 X moveq #0,D0 X call OpenLibrary X move.l D0,intuitionbase X move.l D0,A0 X lea $3C(A0),A0 X move.l (A0),A0 X move.l A0,wbscreen X X lea $2C(A0),A1 X move.l A1,viewport X X lea 4(A0),A0 X X move.l (A0),A0 X* move.l A0,thiswindow X1$ move.l (A0),D0 X beq 2$ X move.l D0,A0 X bra 1$ X2$ X* move.l A0,doswindow X X lea $32(A0),A0 X move.l (A0),rastport X X lea glibname,A1 X moveq #0,D0 X call OpenLibrary X move.l D0,graphicsbase X X lea mlibname,A1 X moveq #0,D0 X call OpenLibrary X move.l D0,mathffpbase X X lea tlibname,A1 X moveq #0,D0 X call OpenLibrary X move.l D0,mathtransbase X X lea libname,A1 X moveq #0,D0 X call OpenLibrary X move.l D0,A6 X* move.l D0,DOS_point X* obtain file handles for output and input opened by CLI X call Output X move.l D0,ohandle X call Input X move.l D0,ihandle X X move.l D0,D1 X call IsInteractive X tst.l D0 X bne .ii1 X move.b #$FF,backgroundflag X.ii1 X X X ifne HiRes X lea my_screen,A0 X intuit OpenScreen X move.l D0,the_screen X move.l D0,the_screenb X X move.l D0,A0 X lea $2C(A0),A0 X move.l A0,viewport X X lea my_bwindow,A0 X intuit OpenWindow X move.l D0,the_bwindow X X* ShowTitle(FALSE) around here X move.l D0,A0 X lea $32(A0),A0 X move.l (A0),rastport X X lea my_window,A0 X intuit OpenWindow X move.l D0,the_window X X bsr start_console X X endc X X rts X X Xendio X X ifne HiRes X bsr stop_console X X move.l the_window,A0 X intuit CloseWindow X X move.l the_bwindow,A0 X intuit CloseWindow X X move.l the_screen,A0 X intuit CloseScreen X endc X rts X X X X X section fdata,data X Xbufptr dc.l ibuf Xbufchcount dc.b 0,0 X Xs_ihandle dc.l 0 Xs_bufptr dc.l 0 Xs_bufchcount dc.b 0,0 Xrunflag dc.b 0 Xbackgroundflag dc.b 0 X Xiihandle dc.l 0 Xcloseit dc.l 0 X X bstr badfa,<unknown file attribute> X bstr badfn,<only files %stdin/out> X bstr filerr,<file error> X X X*wname dc.b 'CON:0/0/640/40/' Xsignature dc.b ' ps PostScript emulator, ) Greg Lee, April, 1986 ',0 X cnop 0,2 X X X X; ======================================================================== X; === NewScreen ========================================================== X; ======================================================================== X* STRUCTURE NewScreen,0 X* X* WORD ns_LeftEdge ; initial Screen dimensions X* WORD ns_TopEdge ; initial Screen dimensions X* WORD ns_Width ; initial Screen dimensions X* WORD ns_Height ; initial Screen dimensions X* WORD ns_Depth ; initial Screen dimensions X* X* BYTE ns_DetailPen ; default rendering pens (for Windows too) X* BYTE ns_BlockPen ; default rendering pens (for Windows too) X* X* WORD ns_ViewModes ; display "modes" for this Screen X* X* WORD ns_Type ; Intuition Screen Type specifier X* X* APTR ns_Font ; default font for Screen and Windows X* X* APTR ns_DefaultTitle ; Title when Window doesn't care X* X* APTR ns_Gadgets ; Your own initial Screen Gadgets X* X* ; if you are opening a CUSTOMSCREEN and already have a BitMap X* ; that you want used for your Screen, you set the flags CUSTOMBITMAP in X* ; the Types variable and you set this variable to point to your BitMap X* ; structure. The structure will be copied into your Screen structure, X* ; after which you may discard your own BitMap if you want X* APTR ns_CustomBitMap; X* X* LABEL ns_SIZEOF X* X* X X Xviewport dc.l 0 X X ifne HiRes Xthe_window dc.l 0 X Xmy_screen X dc.w 0,0,640,400 X X dc.w NumPlanes depth X dc.b 0,1 X dc.w $C004 modes X dc.w $0F type = custon X dc.l screenfont font X dc.l signature title X dc.l 0 no gadgets X dc.l 0 no bitmap X* X Xthe_bwindow dc.l 0 X Xmy_bwindow X X dc.w 0,0,640,400 X dc.b 0,1 X dc.l 0 X X* flag req. (backdrop,) borderless, smart refresh, nocarerefresh X dc.l $0800+$20000 (+$0100) X* X dc.l 0 first gadget X dc.l 0 check mark X dc.l signature title X Xthe_screenb X dc.l 0 screen X X dc.l 0 bitmap X dc.w 0,0 minimum width and height X dc.w 0,0 maximum width and height X X dc.w $0F type = customscreen X X X Xmy_window X X dc.w 100,10,300,100 X dc.b 0,2 X dc.l 0 initial IDCMP state X X* flags req. sizing, drag, X* smart refresh , and activate X dc.l $001003+$20000 X* X dc.l 0 first gadget X dc.l 0 check mark X dc.l .amsname title X Xthe_screen X dc.l 0 screen X X dc.l 0 bitmap X dc.w 100,45 minimum width and height X dc.w 300,100 maximum width and height X X dc.w $0F type = customscreen X Xscreenfont X dc.l dfname X dc.w 9 X dc.b 0 X dc.b %01 Xdfname dc.b 'topaz.font',0 X X.amsname dc.b ' ps' X dcb.b 30,' ' X dc.b 0 X X X endc X Xlibname dc.b 'dos.library',0 Xilibname dc.b 'intuition.library',0 Xglibname dc.b 'graphics.library',0 Xmlibname dc.b 'mathffp.library',0 Xtlibname dc.b 'mathtrans.library',0 X X************************** X X X X section fstr,bss X X ds.b 1 align ibuf Xilen ds.b 1 Xibuf ds.b IbufLen+2 X X X ds.b 1 align obuf Xolen ds.b 1 Xobuf ds.b 80 X Xrunname ds.b RnameLen+2 X Xs_ibuf ds.b IbufLen+4 X X end X \Rogue\Monster\ else echo "will not over write ./files.a" fi if [ `wc -c ./files.a | awk '{printf $1}'` -ne 16356 ] then echo `wc -c ./files.a | awk '{print "Got " $1 ", Expected " 16356}'` fi echo "Finished archive 3 of 3" # if you want to concatenate archives, remove anything after this line exit