Usenet 1994 January

home *** CD-ROM | disk | FTP | other *** search

/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume7 / basic / part05 < prev next >

Wrap

Internet Message Format | 1986-12-03 | 57.5 KB

Subject: v07i077: A BASIC Interpreter, Part05/06 Newsgroups: mod.sources Approved: mirror!rs Submitted by: phil@Cs.Ucl.AC.UK Mod.sources: Volume 7, Issue 77 Archive-name: basic/Part05 # Shar file shar05 (of 6) # # This is a shell archive containing the following files :- # pdp11/assist.s # pdp11/conf.h # pdp11/fpassist.s # pdp11/lfunc.s # pdp11/nfp.s # pdp11/term.c # pyramid/Makefile # ------------------------------ # This is a shell archive, shar, format file. # To unarchive, feed this text into /bin/sh in the directory # you wish the files to be in. echo x - pdp11/assist.s 1>&2 sed 's/^X//' > pdp11/assist.s << 'End of pdp11/assist.s' X/ (c) P. (Rabbit) Cockcroft 1982 X/ This file contains machine code routines that either can't X/ be implemented or are very slow in C. X/ X X/ When the 'shell' command was first added it was noticed that X/ it would bus-error about five times ( an old form of memory X/ allocation was being used at the time ) before it started to X/ do the wait. The reason for this is rather awful. In the call X/ it uses _nargs to find how many arguments it has got. This is X/ a routine that will not work in split i and d space, since it tries X/ to access the text segment. X/ The routine was thus taken from the C library and has been changed X/ to need no parameters. It just returns -1 on error or the waited for's X/ process id. X/ X/ pid == -1 if error X X.globl _wait, cerror X Xwait = 7. X X_wait: X mov r5,-(sp) X mov sp,r5 X sys wait X bec 1f X jmp cerror X1: X tst 4(r5) X beq 1f X mov r1,*4(r5) X1: X mov (sp)+,r5 X rts pc X X/ getch() is used all over the place to get the next character on the line. X/ It uses 'point' ( _point ) as the pointer to the next character. X/ It skips over all leading spaces. X/ It was put into machine code for speed since it does not have to X/ call csv and cret ( the C subroutine call and return routines ). X/ this saves a lot of time. It can also be written more efficiently X/ in machine code. X/ X X.text X.globl _point , _getch X X_getch: X mov _point,r1 X1: cmpb $40,(r1)+ / ignore spaces X beq 1b X mov r1,_point X clr r0 X bisb -(r1),r0 X rts pc X X/ check() is used by many routines that want to know if there is any X/ garbage characters after its arguments. e.g. in 'goto' there X/ should be nothing after the line number. It gives a SYNTAX X/ error if the next character is not a terminator. X/ check() was also taken out of C for speed reasons. X X.globl _point , _check , _elsecount , _error X XELSE= 0351 X X_check: X mov _point,r0 X1: cmpb $40,(r0)+ X beq 1b X movb -(r0),r1 X beq 1f X cmpb r1,$': X beq 1f X cmpb r1,$ELSE X bne 2f X tstb _elsecount X beq 2f X1: mov r0,_point X rts pc X2: mov $1,-(sp) / syntax error X jsr pc,_error X X/ startfp() this is called in main to intialise the floating point X/ hardware if it is used. it is only called once to set up fpfunc() X/ this routine does nothing in non-floating point hardware machines X/ X.globl _startfp , _fpfunc X X_startfp: X clr _fpfunc X rts pc X X.bss X_fpfunc: .=.+2 X.text X X/ getop() will convert a number into in ascii form to a binary number X/ it returns non-zero if the number is ok, with the number in X/ the union 'res'. It uses the floating point routines (nfp.s) and X/ some of its storage locations ( areg ) to do the hard work. X/ If the number will fit into an integer, then the value returned is an X/ integer, with 'vartype' set accordingly. This convertion to integers X/ is only operative if the convertion needed is an easy one. X/ Zero is always returned as an integer. X/ This routine was written in assembler since it is impossible X/ to write in C. X X.globl _getop X_getop: X jsr r5,csv X mov $areg,r0 X clr (r0)+ X clr (r0)+ X clr (r0)+ X clr (r0)+ X clr aexp X clr dpoint X clr dflag X mov $1,asign X clrb _vartype X clr count / number of actual digits X1: movb *_point,r4 X inc _point X cmp r4,$'. X bne 4f X tst dflag / decimal point X bne out1 / already had one so get out of loop X inc dflag / set the decimal point flag. X br 1b X4: X cmp r4,$'0 X blt out1 X cmp r4,$'9 X bgt out1 X inc count / we have a digit X bit $!07,areg / enough space for another digit X bne 2f / no X sub $'0,r4 / multiply number by ten X mov r4,r2 / and add the new digit. X jsr pc,tenmul X tst dflag / if we have not had a decimal point X beq 1b / don't decrement the significance X dec dpoint / counter. X br 1b X2: / get here if all digits are filled X tst dflag / if decimal point , forget it X bne 1b X inc dpoint / increment the significance counter X br 1b / get some more. Xout1: X tst count / check to see that we have had a digit X bne 9f / yes then continue. X jmp bad / no goto bad. X9: cmp r4,$'e / do we have an exponent. X bne out2 / no. X clr count / count number of exponent digits X clr r3 / clear exponent value X clr r2 / clear exponent sign X movb *_point,r4 X inc _point X cmp r4,$'- / exponents sign X bne 1f X inc r2 / set the flag X br 2f X1: cmp r4,$'+ X bne 3f X2: movb *_point,r4 X inc _point X3: X cmp r4,$'0 / get the exponent digits X blt 1f X cmp r4,$'9 X bgt 1f X inc count / we have a digit. X sub $'0,r4 X cmp r3,$1000. / if the digit would make the exponent X blt 7f / greater than ten thousand X3: / for get the following digits X movb *_point,r4 / ( we are heading for an overflow ) X inc _point X cmp r4,$'0 X blt 1f X cmp r4,$'9 X ble 3b X br 1f X7: X mul $12,r3 / multiply the exponent by ten and X add r4,r3 / add the new digit. X br 2b / get some more X1: X tst r2 / check sign of exponent X beq 1f X neg r3 X1: add r3,dpoint / add the exponent to the decimal X tst count / point counter X beq bad / check to see if we had any digits Xout2: X dec _point / adjust the character pointer X tst dpoint / check to see if number can be X ble 1f / multiplied by ten if need be. X2: bit $!07,areg X bne 1f / no X clr r2 X jsr pc,tenmul / multiply by ten X dec dpoint X bne 2b X1: X tst areg / check to see if we have an integer X bne 1f X tst areg+2 X bne 1f X tst areg+4 X bne 1f X tst dpoint X bne 2f X bit $100000,areg+6 X beq 3f X2: tst areg+6 / test for zero X bne 1f X3: mov areg+6,_res / yes we have an integer put the X movb $1,_vartype / value in 'res' and set 'vartype' X inc r0 / stop bad number error, since at this X jmp cret / point r0 is zero. X1: X mov $56.,aexp / convert to floating point format X jsr pc,norm X tst dpoint / number wants to be multiplied X ble 2f / by ten X cmp dpoint,$1000. X bgt bad X1: clr r2 X jsr pc,tenmul / do it X3: bit $!377,areg / normalise the number X bne 1f X dec dpoint / decrement the counter X bne 1b X br 2f X1: mov $areg,r0 / shift right to normalise X asr (r0)+ X ror (r0)+ X ror (r0)+ X ror (r0)+ X inc aexp X cmp aexp,$177 X bgt bad X br 3b X2: X tst dpoint / wants to be divided by ten X bge 2f X3: mov $3,r1 X1: mov $areg+8,r0 / shift left to save significant X asl -(r0) / digits X rol -(r0) X rol -(r0) X rol -(r0) X dec aexp X sob r1,1b X jsr pc,tendiv / divide number by ten X1: bit $200,areg / normalise number X bne 1f X mov $areg+8,r0 / shift left X asl -(r0) X rol -(r0) X rol -(r0) X rol -(r0) X dec aexp X br 1b X1: inc dpoint X bne 3b X2: X cmp aexp,$177 / check for overflow X bgt bad X mov $_res,r2 / return value to 'res' via the floating X jmp retng / point return routine, r0 is non-zero Xbad: clr r0 / bad number , clear r0 X jmp cret / return X X.bss Xdflag: .=.+2 / temporary space for decimal point counter X X.text X X/ cmp() is used to compare two numbers , it uses 'vartype' to decide X/ which kind of variable to test. X/ The result is -1,0 or 1 , depending on the result of the comparison X/ X X.globl _cmp , _vartype X X_cmp: mov 2(sp),r0 X mov 4(sp),r1 X tstb _vartype X beq 6f X cmp (r0)+,(r1)+ X blt 4f X bgt 3f X5: clr r0 X rts pc X3: mov $1,r0 X rts pc X4: mov $-1,r0 X rts pc X / floating point comparisons X6: tst (r0) / straight out of the floating X bge 1f / point trap routines X tst (r1) X bge 1f X cmp (r0),(r1) X bgt 4b X blt 3b X1: X cmp (r0)+,(r1)+ X bgt 3b X blt 4b X cmp (r0)+,(r1)+ X bne 1f X cmp (r0)+,(r1)+ X bne 1f X cmp (r0)+,(r1)+ X beq 5b X1: X bhi 3b X br 4b X X/ routine to multiply two numbers together. returns zero on overflow X/ used in dimensio() only. X X.globl _dimmul X X_dimmul: X mov 2(sp),r1 X mul 4(sp),r1 X bcc 1f X clr r1 X1: mov r1,r0 X rts pc X X/ The calling routines for the maths functions ( from bas3.c). X/ The arguments passed to the routines are as follows. X/ at 6(sp) The operator funtion required. X/ at 4(sp) The pointer to second parameter and X/ the location where the result is to be put. X/ at 2(sp) The pointer to the first parameter. X X/ The jump table is called by the following sequence:- X/ (*mbin[priority*2+vartype])(&j->r1,&res,j->operator) X/ X/ So the values in this table are such that integer and real X/ types are dealt with separately, and the different types of operators X/ are also dealt with seperately. X/ e.g. *, /, mod for reals are dealt with by 'fmdm' X/ and , or , xor for integers are dealt with by 'andor' X/ X X.globl _mbin , csv , cret , _error , _fmul , _fdiv , _fadd , _fsub X X/ jump table for the maths functions X/ straight from the eval() routine in bas3.c X X.data X_mbin: 0 X 0 X fandor X andor X comop X comop X fads X ads X fmdm X mdm X fex X ex X.text X X/ locations from the jump table X/ integer exponentiation , convert to reals then call the floating X/ point convertion routines. X/ X Xex: mov 2(sp),-(sp) X jsr pc,_cvt X mov 6(sp),(sp) X jsr pc,_cvt X tst (sp)+ X clrb _vartype Xfex: jmp _fexp X X Xfmdm: X cmp $'*,6(sp) / times X bne 1f X jmp _fmul X1: X cmp $'/,6(sp) / div X bne 1f X jmp _fdiv X1: X jmp _fmod / mod X X Xmdm: cmp $'*,6(sp) / integer multiply X bne 1f X mov *2(sp),r0 X mul *4(sp),r0 X bcs over / overflow X br 2f X1: mov *2(sp),r1 / divide or mod X sxt r0 X div *4(sp),r0 X bvs 1f X cmp $'/,6(sp) / div X bne 2f / no , must be mod. X tst r1 X bne 3f X mov r0,*4(sp) X rts pc X2: mov r1,*4(sp) X rts pc X1: mov $25.,-(sp) / zero divisor error X jsr pc,_error X / code to do integer divisions.. etc. X3: mov 2(sp),-(sp) / if the result of the integer division X jsr pc,_cvt / is not an integer then convert to X mov 6(sp),(sp) / float and call the floationg point X jsr pc,_cvt / routine X clrb _vartype X tst (sp)+ X jmp _fdiv X Xfads: / floating add and subtract X cmp $'+,6(sp) X bne 1f X jmp _fadd X1: X jmp _fsub X X Xads: mov *2(sp),r1 X cmp $'+,6(sp) / add or subtract X bne 1f X add *4(sp),r1 / add X br 2f X1: sub *4(sp),r1 / subtract X2: bvs over1 / branch on overflow X mov r1,*4(sp) X rts pc X Xover1: tst *2(sp) / move value to 'overfl' X sxt r0 Xover: mov r0,_overfl X mov r1,_overfl+2 X jmp _over / return via call to 'over' X X/ comparison operators ( float and integer ) X/ cmp() expects to have only two parameters . So save return address X/ and so simulate environment. X Xcomop: mov (sp)+,comsav / save return address X jsr pc,_cmp / call comparison routine X mov r0,-(sp) X mov 6(sp),-(sp) / call routine to convert X jsr pc,_compare / this result into logical result X tst (sp)+ X mov comsav,(sp) / restore return address X rts pc / return X.bss Xcomsav: .=.+2 X.text X X/ floating logical operators X/ convert floating types into integers. If the value is non zero X/ then value has a true (-1) value. X/ X Xfandor: X mov *2(sp),r0 X beq 2f X mov $-1,r0 X2: mov *4(sp),r1 X beq 2f X mov $-1,r1 X2: movb $1,_vartype X br 2f X X/ integer logical operators X/ does a bitwise operaotion on the two numbers ( in r0 , r1 ). X/ X Xandor: X mov *2(sp),r0 X mov *4(sp),r1 X2: cmpb $356,6(sp) X bne 2f X com r1 X bic r1,r0 X br 1f X2: cmp $357,6(sp) X bne 2f X bis r1,r0 X br 1f X2: xor r1,r0 X1: mov r0,*4(sp) X rts pc X X/ This routine converts a floationg point number into an integers X/ if the result would overflow then return non zero. X/ X X.globl _conv X X_conv: X mov 2(sp),r1 X mov (r1)+,r0 X beq 3f X mov (r1),r1 X asl r0 X clrb r0 X swab r0 X sub $200,r0 X cmp r0,$20 X bge 1f / overflow or underflow X sub $8,r0 X mov r0,-(sp) / counter X mov *4(sp),r0 X bic $!0177,r0 X bis $200,r0 X ashc (sp)+,r0 X tst *2(sp) X bpl 3f X neg r0 X3: X mov r0,*2(sp) X clr r0 X rts pc X X1: bne 1f X cmp *2(sp),$144000 / check for -32768 X bne 1f X bit r1,$177400 X bne 1f X mov $-32768.,r0 X br 3b X1: rts pc X X X/ convert from integer to floating point , this will never fail. X/ X X.globl _cvt X_cvt: mov r2,-(sp) X clr r0 X mov *4(sp),r1 X beq 4f X bpl 1f X neg r1 X1: mov $220,r2 /counter X ashc $8,r0 X1: bit $200,r0 X bne 1f X ashc $1,r0 X dec r2 X br 1b X1: swab r2 X ror r2 X tst *4(sp) X bpl 1f X bis $100000,r2 X1: bic $!177,r0 X bis r2,r0 X4: mov 4(sp),r2 X mov r0,(r2)+ X mov r1,(r2)+ X clr (r2)+ X clr (r2)+ X mov (sp)+,r2 X rts pc X X/ add two numbers used in the 'next' routine X/ depends on the type of the number. calls error on overflow. X/ X X.globl _foreadd X_foreadd: X add 2(sp),*4(sp) X bvs 1f X rts pc X1: mov $35.,-(sp) / integer overflow X jsr pc,_error X X/ This routine converts a floating point number into decimal X/ It uses the following algorithm:- X/ forever{ X/ If X > 1 then { X/ X = X / 10 X/ decpoint++ X/ continue X/ } X/ If X < 0.1 then { X/ X = X * 10 X/ decpoint-- X/ continue X/ } X/ } X/ for i = 1 to 10 do { X/ digit[i] = int ( X * 10) X/ X = frac ( X * 10 ) X/ } X/ This routine is not very complicated but very fiddly so was one X/ of the last ones written. X/ X X X.globl _necvt , tendiv , tenmul X X_necvt: jsr r5,csv / needs to look like ecvt to X clr dpoint / the outside world X clr *10.(r5) X mov $buf,r3 X mov 6(r5),r2 X mov r2,mdigit X inc r2 X mov r2,count X tst *4(r5) X beq zer X bpl 1f X inc *10.(r5) / sign part of ecvt X1: mov 4(r5),r2 X mov $asign,r0 X jsr pc,seta / set up number in areg X1: tst aexp X ble 1f X mov $3,r1 / number is greater than one X2: mov $areg+8,r0 X asl -(r0) / save significant digits X rol -(r0) X rol -(r0) X rol -(r0) X dec aexp X sob r1,2b X jsr pc,tendiv X inc dpoint / increment decimal point X2: bit $200,areg X bne 1b X mov $areg+8,r0 / normalise after the division X asl -(r0) X rol -(r0) X rol -(r0) X rol -(r0) X dec aexp X br 2b X1: X cmp aexp,$-3 / number greate than 0.1 X bgt 5f X blt 2f X cmp areg,$314 X bgt 5f X blt 2f X mov $3,r1 X mov $areg+2,r0 X3: cmp (r0)+,$146314 X bhi 5f X blo 2f X sob r1,3b X2: / no X clr r2 X jsr pc,tenmul / multiply by ten X3: tstb areg+1 X bne 4f X dec dpoint X br 1b X4: X mov $areg,r0 / normalise X asr (r0)+ X ror (r0)+ X ror (r0)+ X ror (r0)+ X inc aexp X br 3b X5: X tst aexp / get decimal point in correct place X beq 9f X1: mov $areg,r0 X asr (r0)+ X ror (r0)+ X ror (r0)+ X ror (r0)+ X inc aexp X bne 1b X9: X clr r2 / get the digits X jsr pc,tenmul X bic $!377,areg X clrb r1 / top word in r1 X swab r1 X add $'0,r1 X movb r1,(r3)+ X dec count / got all digits X bne 9b X br out X Xzer: inc dpoint / deal with zero X1: movb $'0,(r3)+ X sob r2,1b Xout: / correct the last digit X mov $buf,r0 X add mdigit,r0 X movb (r0),r2 X add $5,r2 X movb r2,(r0) X1: X cmpb (r0),$'9 X ble 1f / don't correct it X movb $'0,(r0) X cmp r0,$buf X blos 2f X incb -(r0) X br 1b X2: X inc dpoint X movb $'1,(r0) / correction has made number a one X1: X mov mdigit,r0 / pass values back X clrb buf(r0) X mov $buf,r0 X mov dpoint,*8(r5) X jmp cret X Xtenmul: / multiply value in areg by 10 X mov $areg+8.,r4 X1: mov -(r4),r0 X mul $12,r0 X bpl 2f X add $12,r0 X2: add r2,r1 X adc r0 X mov r1,(r4) X mov r0,r2 X cmp r4,$areg X bne 1b X rts pc X Xtendiv: / divide value in areg by 10 X mov $areg,r4 X clr r0 X1: mov (r4),r1 / has to divide by 20 to stop X div $24,r0 / multiply thinking there is an X asl r0 / overflow X cmp r1,$9 X ble 2f X inc r0 X sub $12,r1 X2: mov r0,(r4)+ X mov r1,r0 X cmp r4,$areg+8 X bne 1b X rts pc X X .bss Xmdigit: .=.+2 Xcount: .=.+2 Xbuf: .=.+20. Xdpoint: .=.+2 X .text X X/ convert a long in 'overfl' to a real. uses the floating point X/ routines. returns via these routines. X X.globl _over X_over: X jsr r5,csv X clrb _vartype X mov _overfl,areg X mov _overfl+2,areg+2 X clr areg+4 X clr areg+6 X mov $1,asign X mov $32.-8,aexp X jmp saret X X/ X/ put a value into a variable , does the convertions from integer X/ to real and back as needed. X/ X X.globl _putin X_putin: cmpb 4(sp),_vartype X beq 3f X mov $_res,-(sp) X tstb 6(sp) X beq 2f X jsr pc,_conv X tst r0 X beq 1f X mov $35.,(sp) X jsr pc,_error / no return X2: jsr pc,_cvt X1: tst (sp)+ X3: mov $_res,r0 X mov 2(sp),r1 X mov (r0)+,(r1)+ X tstb 4(sp) / type of variable that is to be assigned X bne 1f / to X mov (r0)+,(r1)+ X mov (r0)+,(r1)+ X mov (r0)+,(r1)+ X1: rts pc X X/ high speed move of variables X/ can't use floating point moves because of '-0'. X X.globl _movein X_movein: mov 2(sp),r0 X mov 4(sp),r1 X mov (r0)+,(r1)+ X mov (r0)+,(r1)+ X mov (r0)+,(r1)+ X mov (r0)+,(r1)+ X rts pc X X/ puts the value from a variable into 'res'. It might be thought X/ that 'movein' could be used but it can't for the reason given in X/ the report. X/ X X.globl _getv X_getv: mov 2(sp),r0 X mov $_res,r1 X mov (r0)+,(r1)+ X tstb _vartype X bne 1f X mov (r0)+,(r1)+ X mov (r0)+,(r1)+ X mov (r0)+,(r1)+ X1: rts pc X X/ move the value in res onto the maths 'stack'. A simple floating X/ move cannot be used due to the possibility of "minus zero" or X/ -32768 being in 'res'. This could check 'vartype' but for speed just X/ does the move. X X.globl _push X_push: mov 2(sp),r1 X mov $_res,r0 X mov (r0)+,(r1)+ X mov (r0)+,(r1)+ X mov (r0)+,(r1)+ X mov (r0)+,(r1)+ X rts pc X X/ negate a number , checks for overflow and for type of number. X/ X X.globl _negate X_negate: X tstb _vartype X beq 1f X neg _res X bvs 2f / negating -32768 X rts pc X1: tst _res / stop -0 X beq 1f X add $100000,_res X1: rts pc X2: X mov $044000,_res / 32768 in floating form X clr _res+2 X clr _res+4 X clr _res+6 X clrb _vartype X rts pc X X/ unary negation X X.globl _notit X X_notit: tstb _vartype X beq 1f X com _res X rts pc X1: movb $1,_vartype X tst _res X bne 1f X com _res X rts pc X1: clr _res X rts pc X X/ routine to dynamically check the stack X.globl _checksp X X_checksp: X cmp sp,$160000+1024. X blos 1f X rts pc X1: mov $44.,(sp) X jsr pc,_error / no return End of pdp11/assist.s chmod u=rw-,g=r,o=r pdp11/assist.s echo x - pdp11/conf.h 1>&2 sed 's/^X//' > pdp11/conf.h << 'End of pdp11/conf.h' X/* X * BASIC by Phil Cockcroft X */ X/* X * Configuration file for a pdp11 X */ X/* X * hardware specific. Can't change MAXMEM upwards X */ X X#define MAXMEM (memp)0160000 /* max data address on a pdp11 */ X#define MEMINC 1023 /* size of memory increments - 1 */ X X/* X * various options. X */ X X#define V7 X#define UCB_NTTY X#define LKEYWORDS X#define LNAMES X#define RENUMB X#define SCOMMS X#define BERK X X#ifdef BERK X#define BLOCKSIZ 1024 X#else X#define BLOCKSIZ 512 X#endif X X/* X * terminal specific options X */ X#define DEFPAGE 80 /* default page width */ X#define DEFLENGTH 24 /* default page length */ X#define CTRLINT 03 /* ctrl -c - sig int */ X#define CTRLQUIT 034 /* ctrl - \ FS sig quit */ X X/* #define V7 */ /* define for v7 */ X/* #define SOFTFP */ /* define if not got fp hardware */ X/* #define V6C */ /* if got V6 compiler (no structure assignments ) */ X/* #define BERK */ /* define if got Berkley tty driver ( not v6 ) */ X/* #define UCB_NTTY */ /* if got the new driver ..... */ X X/* #define NOEDIT /* define if don't want editing ever ! */ X /* NB basic -e will still turn on editing */ X /* basic -x will still turn off editing */ X X/* #define LKEYWORDS /* define this if you want to have variable names which*/ X /* contain commands this is like the later versions of */ X /* microsoft but not like the orignal version */ X /* it wastes more space since you have to have some */ X /* spaces in to distinguish keywords */ X X/* #define RENUMB /* define if you want to put the code for renumbering */ X /* in. It works but is very wasteful of space. If you */ X /* are short of space then don't use it. */ X X/* #define LNAMES /* define if you want long variables names. This only */ X /* slows it down by a small fraction */ X X/* #define _BLOCKED /* This is a switch to allow block mode files */ X /* don't define it here look below for where it is done*/ X /* in the file handling bits */ X/* #define SCOMMS /* to allow shortened command names e.g. l. -> list */ X /* this might cause some problems with overwriting of */ X /* core but I think they have all been solved */ End of pdp11/conf.h chmod u=rw-,g=r,o=r pdp11/conf.h echo x - pdp11/fpassist.s 1>&2 sed 's/^X//' > pdp11/fpassist.s << 'End of pdp11/fpassist.s' X/ (c) P. (Rabbit) Cockcroft 1982 X X.globl _wait, cerror X Xwait = 7. X X_wait: X mov r5,-(sp) X mov sp,r5 X sys wait X bec 1f X jmp cerror X1: X tst 4(r5) X beq 1f X mov r1,*4(5) X1: X mov (sp)+,r5 X rts pc X X/ getch() is used all over the place to get the next character on the line. X/ It uses 'point' ( _point ) as the pointer to the next character. X/ It skips over all leading spaces. X/ It was put into machine code for speed since it does not have to X/ call csv and cret ( the C subroutine call and return routines ). X/ this saves a lot of time. It can also be written more efficiently X/ in machine code. X/ X X.text X.globl _point , _getch X X_getch: X mov _point,r1 X1: cmpb $40,(r1)+ / ignore spaces X beq 1b X mov r1,_point X clr r0 X bisb -(r1),r0 X rts pc X X/ check() is used by many routines that want to know if there is any X/ garbage characters after its arguments. e.g. in 'goto' there X/ should be nothing after the line number. It gives a SYNTAX X/ error if the next character is not a terminator. X/ check() was also taken out of C for speed reasons. X X.globl _point , _check , _elsecount , _error X XELSE= 0351 X X_check: X mov _point,r0 X1: cmpb $40,(r0)+ X beq 1b X movb -(r0),r1 X beq 1f X cmpb r1,$': X beq 1f X cmpb r1,$ELSE X bne 2f X tstb _elsecount X beq 2f X1: mov r0,_point X rts pc X2: mov $1,-(sp) / syntax error X jsr pc,_error X X/ startfp() this is called in main to intialise the floating point X/ hardware if it is used. it is only called once to set up fpfunc() X/ this routine does nothing in non-floating point hardware machines. X/ X X .globl _startfp , _fpfunc X Xldfps = 0170100 ^ tst X X_startfp: X mov $fpcrash,_fpfunc X ldfps $1200 X rts pc X.bss X_fpfunc: .=.+2 X.text X Xfpcrash: X mov $34.,-(sp) X jsr pc,_error / no return X X/ cmp() is used to compare two numbers , it uses 'vartype' to decide X/ which kind of variable to test. X/ The result is -1,0 or 1 , depending on the result of the comparison X/ X X.globl _cmp , _vartype X X_cmp: X tstb _vartype X beq 6f X cmp *2(sp),*4(sp) X1: X blt 4f X bgt 3f X5: clr r0 X rts pc X3: mov $1,r0 X rts pc X4: mov $-1,r0 X rts pc X / floating point comparisons X6: movf *4(sp),fr0 X cmpf *2(sp),fr0 X cfcc X br 1b X X X/ routine to multiply two numbers together. returns zero on overflow X/ used in dimensio() only. X X.globl _dimmul X X_dimmul: X mov 2(sp),r1 X mul 4(sp),r1 X bcc 1f X clr r1 X1: mov r1,r0 X rts pc X X.globl _mbin X X/ jump table for the maths functions X/ straight from the eval() routine in bas3.c X X.data X_mbin: 0 X 0 X fandor X andor X comop X comop X fads X ads X fmdm X mdm X fex X ex X.text X X/ locations from the jump table X/ integer exponentiation , convert to reals then call the floating X/ point convertion routines. X/ X.globl _exp , _log X Xexp: movf fr0,-(sp) X jsr pc,_exp X tstf (sp)+ X rts pc X Xlog: movf fr0,-(sp) X jsr pc,_log X tstf (sp)+ X rts pc X X Xex: movif *2(sp),fr0 X movif *4(sp),fr1 X movf fr1,*4(sp) X clrb _vartype X br 1f Xfex: X movf *2(sp),fr0 X1: X tstf fr0 X cfcc X beq 1f X bmi 2f X jsr pc,log / call log X mulf *4(sp),fr0 X1: X jsr pc,exp / exponentiate X bes 1f X movf fr0,*4(sp) X rts pc X1: mov $40.,-(sp) / overflow in ^ X jsr pc,_error X2: mov $41.,-(sp) / negative value to ^ X jsr pc,_error X Xfmdm: X movf *2(sp),fr0 X cmp $52,6(sp) / times X bne 1f X mulf *4(sp),fr0 X movf fr0,*4(sp) X rts pc X1: X movf *4(sp),fr2 X cfcc X beq zerodiv X divf fr2,fr0 X cmp $'/,6(sp) / div X beq 1f X modf $040200,fr0 / mod X mulf fr2,fr0 X1: X movf fr0,*4(sp) X rts pc X X Xmdm: cmp $52,6(sp) / integer multiply X bne 1f X mov *2(sp),r0 X mul *4(sp),r0 X bcs over / overflow X br 2f X1: mov *2(sp),r1 / divide or mod X sxt r0 X div *4(sp),r0 X bvs 1f X cmp $57,6(sp) / div X bne 2f / no , must be mod. X tst r1 X bne 3f X mov r0,r1 X2: mov r1,*4(sp) X rts pc X1: Xzerodiv: X mov $25.,-(sp) / zero divisor error X jsr pc,_error X / code to do integer divisions.. etc. X3: movif *2(sp),fr0 X movif *4(sp),fr1 X divf fr1,fr0 X movf fr0,*4(sp) X clrb _vartype X rts pc X Xfads: / floating add and subtract X movf *2(sp),fr0 X cmp $53,6(sp) X bne 1f X X addf *4(sp),fr0 X movf fr0,*4(sp) X rts pc X1: X subf *4(sp),fr0 X movf fr0,*4(sp) X rts pc X X Xads: mov *2(sp),r1 X cmp $53,6(sp) / add or subtract X bne 1f X add *4(sp),r1 / add X br 2f X1: sub *4(sp),r1 / subtract X2: bvs over1 / branch on overflow X mov r1,*4(sp) X rts pc X Xover1: tst *2(sp) / move value to 'overfl' X sxt r0 Xover: mov r0,_overfl X mov r1,_overfl+2 X jmp _over / return via call to 'over' X X/ comparison operators ( float and integer ) X/ cmp() expects to have only two parameters . So save return address X/ and so simulate environment. X Xcomop: mov (sp)+,comsav / save return address X jsr pc,_cmp / call comparison routine X mov r0,-(sp) X mov 6(sp),-(sp) / call routine to convert X jsr pc,_compare / this result into logical result X tst (sp)+ X mov comsav,(sp) / restore return address X rts pc / return X.bss Xcomsav: .=.+2 X.text X X/ floating logical operators X/ convert floating types into integers. If the value is non zero X/ then value has a true (-1) value. X/ X Xfandor: X mov *2(sp),r0 X beq 2f X mov $-1,r0 X2: mov *4(sp),r1 X beq 2f X mov $-1,r1 X2: movb $1,_vartype X br 2f X X/ integer logical operators X/ does a bitwise operaotion on the two numbers ( in r0 , r1 ). X/ X Xandor: X mov *2(sp),r0 X mov *4(sp),r1 X2: cmpb $356,6(sp) X bne 2f X com r1 X bic r1,r0 X br 1f X2: cmp $357,6(sp) X bne 2f X bis r1,r0 X br 1f X2: xor r1,r0 X1: mov r0,*4(sp) X rts pc X X/ This routine converts a floationg point number into an integers X/ if the result would overflow then return non zero. X/ X X.globl _conv X X_conv: X movf *2(sp),fr0 X movfi fr0,r0 X cfcc X bcs 1f X mov r0,*2(sp) X clr r0 X rts pc X1: X mov $1,r0 X rts pc X X X/ add two numbers used in the 'next' routine X/ depends on the type of the number. calls error on overflow. X/ X X.globl _foreadd X_foreadd: X add 2(sp),*4(sp) X bvs 1f X rts pc X1: mov $35.,-(sp) / integer overflow X jsr pc,_error X X/ convert a long in 'overfl' to a real. uses the floating point X/ routines. returns via these routines. X X.globl _over X_over: X setl X movif _overfl,fr0 X clrb _vartype X movf fr0,*4(sp) X seti X rts pc X/ X/ put a value into a variable , does the convertions from integer X/ to real and back as needed. X/ X X.globl _putin X_putin: cmpb 4(sp),_vartype X beq 1f X tstb 4(sp) X beq 2f X movf _res,fr0 X movfi fr0,r0 X cfcc X bes 3f X mov r0,*2(sp) X rts pc X3: X mov $35.,-(sp) X jsr pc,*$_error / no return X2: X movif _res,fr0 X movf fr0,*2(sp) X rts pc X1: X tstb 4(sp) X bne 1f X movf _res,fr0 X movf fr0,*2(sp) X rts pc X1: X mov _res,*2(sp) X rts pc X X/ high speed move of variables X/ can't use floating point moves because of '-0'. X X.globl _movein X_movein: mov 2(sp),r0 X mov 4(sp),r1 X mov (r0)+,(r1)+ X mov (r0)+,(r1)+ X mov (r0)+,(r1)+ X mov (r0)+,(r1)+ X rts pc X X/ puts the value from a variable into 'res'. It might be thought X/ that 'movein' could be used but it can't for the reason given in X/ the report. X/ X X.globl _getv X_getv: mov 2(sp),r0 X mov $_res,r1 X mov (r0)+,(r1)+ X tstb _vartype X bne 1f X mov (r0)+,(r1)+ X mov (r0)+,(r1)+ X mov (r0)+,(r1)+ X1: rts pc X X/ move the value in res onto the maths 'stack'. A simple floating X/ move cannot be used due to the possibility of "minus zero" or X/ -32768 being in 'res'. This could check 'vartype' but for speed just X/ does the move. X X.globl _push X_push: mov 2(sp),r1 X mov $_res,r0 X mov (r0)+,(r1)+ X mov (r0)+,(r1)+ X mov (r0)+,(r1)+ X mov (r0)+,(r1)+ X rts pc X X/ negate a number , checks for overflow and for type of number. X/ X X.globl _negate X_negate: X tstb _vartype X beq 1f X neg _res X bvs 2f / negating -32768 X rts pc X1: tst _res / stop -0 X beq 1f X add $100000,_res X1: X rts pc X2: X mov $044000,_res / 32768 in floating form X clr _res+2 X clr _res+4 X clr _res+6 X clrb _vartype X rts pc X X/ unary negation X X.globl _notit X X_notit: tstb _vartype X beq 1f X com _res X rts pc X1: movb $1,_vartype X tst _res X bne 1f X com _res X rts pc X1: clr _res X rts pc X X/ routine to dynamically check the stack X X.globl _checksp X X_checksp: X cmp sp,$160000+1024. X blos 1f X rts pc X1: mov $44.,(sp) / expression too complex X jsr pc,_error / no return End of pdp11/fpassist.s chmod u=rw-,g=r,o=r pdp11/fpassist.s echo x - pdp11/lfunc.s 1>&2 sed 's/^X//' > pdp11/lfunc.s << 'End of pdp11/lfunc.s' X/ (c) P. (Rabbit) Cockcroft 1982 X/ This file contains the routines to implement the some of the X/ more complex mathematical functions. X/ It currently contains the code for sqrt() , log() and exp() X X/ The sqrt() routine is based on the the standard Newtonian method. X/ It uses mull and divv from nfp.s X X.globl _sqrt , sqrt X/ X/ for ( i = 0 ; i < 6 ; i++ ) X/ areg = ( areg + creg / areg ) >> 1 ; X/ X X_sqrt: X jsr r5,csv X mov 4(r5),r2 X mov $asign,r0 X jsr pc,seta X jsr pc,sqrt X mov 4(r5),r2 X mov $asign,r0 X jmp retng X X X/ value in areg X Xsqrt: X tst asign / test for zero X bne 1f X rts pc X1: X bit $1,aexp / sort out the exponent X beq 1f X mov $areg,r0 / shifting as need be X asr (r0)+ X ror (r0)+ X ror (r0)+ X ror (r0)+ X inc aexp X1: X mov $asign,r0 / save in creg X mov $csign,r1 X mov $6,r2 X1: X mov (r0)+,(r1)+ X sob r2,1b X X asr aexp / initial guess in areg X mov $6.,-(sp) / number of iterations X X / main loop starts here X5: X mov $4,r2 X mov $areg,r0 X mov $breg,r1 / set up to do the division X1: / areg/breg X mov (r0)+,(r1)+ X sob r2,1b X mov $4,r2 X mov $creg,r0 X mov $areg,r1 X1: X mov (r0)+,(r1)+ X sob r2,1b X jsr pc,divv / the division X1: mov $areg+8,r0 / add result to old value X mov $breg+8,r1 X jsr pc,addm X mov $areg,r0 / divide by two X asr (r0)+ X ror (r0)+ X ror (r0)+ X ror (r0)+ X dec (sp) / decrement iteration counter X bne 5b X tst (sp)+ X jsr pc,norm / normalise result X rts pc X X/ The routines below handle the log and exp functions X/ They return zero if there is an error or on overflow X/ these routines are almost totally incomprehensible but the algorithms X/ are discussed in the report. X X X ITER=11. / loop count X X.globl _log X_log: X jsr r5,csv X mov 4(r5),r2 X mov $asign,r0 X jsr pc,seta X jsr pc,log X mov 4(r5),r2 X mov $asign,r0 X jmp retng X X.globl log X Xlog: X clr pt X mov $creg,r0 X clr (r0)+ X clr (r0)+ X clr (r0)+ X clr (r0)+ X1: X mov pt,r1 X mov r1,r4 X mul $3,r1 X mov r1,pt1 X3: X mov $areg,r0 X mov $breg,r1 X jsr pc,movm X mov pt1,r1 X beq 5f X mov $breg,r0 X jsr pc,shiftl X5: X mov $breg+8,r0 X mov $areg+8,r1 X jsr pc,addm X cmp breg,$400 X bhi 2f X blo 5f X tst breg+2 X bne 2f X tst breg+4 X bne 2f X tst breg+6 X bne 2f X5: X mov $areg,r1 X mov $breg,r0 X jsr pc,movm X mov pt,r1 X ash $3,r1 X add $logtable+8,r1 X mov $creg+8,r0 X jsr pc,addm X br 3b X2: X inc pt X cmp pt,$ITER X blt 1b / first loop finished X X sub $400,areg X mov $creg+8,r1 X mov $areg+8,r0 X jsr pc,subm X X mov aexp,r4 / deal with the exponent X beq 3f X bmi 2f X1: X mov $logtable+8,r1 /log2n X mov $areg+8,r0 X jsr pc,addm X dec r4 X bne 1b X br 3f X2: X mov $logtable+8,r1 /log2n X mov $areg+8,r0 X jsr pc,subm X inc r4 X bne 2b X3: X tst areg X bpl 1f X mov $areg+8,r0 X jsr pc,negat X neg asign X1: X clr aexp X jsr pc,norm X rts pc X X X.globl _exp X X_exp: X jsr r5,csv X mov 4(r5),r2 X mov $asign,r0 X jsr pc,seta X jsr pc,exp X bec 1f X clr r0 X jmp cret X1: X mov 4(r5),r2 X mov $asign,r0 X jmp retng X X.globl exp X Xexp: clr cexp X tst aexp / test of exponent. X bmi 1f X beq 5f X cmp aexp,$7 X ble 4f X sec X rts pc X4: X mov $areg+8,r0 X asl -(r0) X rol -(r0) X rol -(r0) X rol -(r0) X dec aexp X bne 4b X4: X tstb areg+1 X beq 5f X mov $logtable+8,r1 X mov $areg+8,r0 X jsr pc,subm X inc cexp X br 4b X5: mov $logtable+8,r1 X mov $areg+8,r0 X jsr pc,subm X tst areg X bpl 3f X mov $logtable+8,r1 X mov $areg+8,r0 X jsr pc,addm X br 5f X3: inc cexp X br 5f X1: X mov $areg,r0 X mov aexp,r1 X neg r1 X jsr pc,shiftl X X5: mov $1,r4 / main loop starts here X3: X clrb count(r4) X mov r4,r1 X ash $3,r1 X add $logtable+8,r1 X mov r1,r3 X2: X mov $areg+8,r0 X jsr pc,subm X tst areg X bmi 1f X incb count(r4) X mov r3,r1 X br 2b X1: X mov r3,r1 X mov $areg+8,r0 X jsr pc,addm X inc r4 X cmp r4,$ITER X blt 3b / end of first loop X6: X X add $400,areg X mov $1,pt X1: X mov pt,r1 X mul $3,r1 X mov r1,pt1 X2: X mov pt,r4 X tstb count(r4) X beq 2f X decb count(r4) X mov $areg,r0 X mov $breg,r1 X jsr pc,movm X mov pt1,r1 X beq 5f X mov $breg,r0 X jsr pc,shiftl X5: X mov $breg+8,r1 X mov $areg+8,r0 X jsr pc,addm X br 2b X2: X inc pt X cmp pt,$ITER X blt 1b X tst asign X bne 3f X inc asign X3: X mov cexp,aexp X jsr pc,norm X tst asign X bpl 1f X jsr pc,recip X neg asign X1: X cmp aexp,$177 X ble 1f X sec X rts pc X1: X clc X rts pc X X.globl recip Xrecip: X mov $areg,r0 / return reciprical of areg X mov $breg,r1 / done by division X jsr pc,movm X mov $200,areg X clr areg+2 X clr areg+4 X clr areg+6 X jsr pc,divv X neg aexp X inc aexp X jsr pc,norm X rts pc X X X.bss Xcount: .=.+12. / counters for the log and exp functs. Xpt: .=.+2 Xpt1: .=.+2 X X.globl logtable X X.data X / log2n is in fact the first entry in logtable X Xlogtable: X 000261; 071027; 173721; 147572 X 000036; 023407; 067052; 171341 X 000003; 174025; 013037; 100174 X 000000; 077740; 005246; 126103 X 000000; 007777; 100005; 052425 X 000000; 000777; 177000; 001252 X 000000; 000077; 177770; 000001 X 000000; 000007; 177777; 160000 X 000000; 000000; 177777; 177600 X 000000; 000000; 017777; 177777 X 000000; 000000; 001777; 177777 X.text X X.globl _fexp X_fexp: jsr r5,csv / do exponentiation X mov 4(r5),r2 X mov $asign,r0 X jsr pc,seta X tst asign / deal with 0^x X beq 1f X bmi 2f X jsr pc,log / call log X mov 6(r5),r2 X mov $bsign,r0 X jsr pc,seta X jsr pc,mull / multiply X add bexp,aexp X dec aexp X jsr pc,xorsign X jsr pc,norm X1: X jsr pc,exp / exponentiate X bes 1f X mov 6(r5),r2 X jmp retng X1: mov $40.,-(sp) / overflow in ^ X jsr pc,_error X2: mov $41.,-(sp) / negative value to ^ X jsr pc,_error X X/ trig functions that are not as yet implemented X/ put in as place holders. Calls error with illegal function X X.globl _sin , _cos , _atan X_sin: X_cos: X_atan: X mov $11.,-(sp) X jsr pc,_error X X/ These routines do quad precision arithmetic and are called by many of X/ the higher mathematical functions. These are usually called with the X/ addresses of the operands in r0 and r1. (r0 is usually destination ) X X.globl addm , subm , movm , shiftl , negat X Xaddm: X mov $4,r2 / add quad length X clc X1: X adc -(r0) X bcs 3f X add -(r1),(r0) X sob r2,1b X rts pc X3: X add -(r1),(r0) X sec X sob r2,1b X rts pc X X Xsubm: / subtract quad length X mov $4,r2 X clc X1: X sbc -(r0) X bcs 3f X sub -(r1),(r0) X sob r2,1b X rts pc X3: X sub -(r1),(r0) X sec X sob r2,1b X rts pc X Xshiftl: / a misnomer X mov r5,-(sp) / it actually shifts right X mov r1,r5 / the number of places in r1 X mov (r0)+,r1 X mov (r0)+,r2 X mov (r0)+,r3 X mov (r0)+,r4 X1: X asr r1 X ror r2 X ror r3 X ror r4 X sob r5,1b X mov r4,-(r0) X mov r3,-(r0) X mov r2,-(r0) X mov r1,-(r0) X mov (sp)+,r5 X rts pc X Xmovm: / quad move - the parameters are the X mov (r0)+,(r1)+ / other way around X mov (r0)+,(r1)+ X mov (r0)+,(r1)+ X mov (r0)+,(r1)+ X rts pc X X Xnegat: / quad negation X mov $4,r1 X clc X1: X adc -(r0) X bcs 2f X neg (r0) X2: X sob r1,1b X rts pc End of pdp11/lfunc.s chmod u=rw-,g=r,o=r pdp11/lfunc.s echo x - pdp11/nfp.s 1>&2 sed 's/^X//' > pdp11/nfp.s << 'End of pdp11/nfp.s' X/ (c) P. (Rabbit) Cockcroft 1982 X/ this file contains all the floating point routines to execute the four X/ basic mathematical functions. Also routines for exponentiation and the X/ floating mod function. X/ X/ These routines are the same as used in the floating point simulator X/ but have been changed to make them more flexible and to enable the use X/ of C calling and return conventions. X/ They have also been modified so that they use instructions in the X/ extended arithmetic option for the PDP-11's e.g. sob's. X/ X X/ It is expected that during the reading of these routines that the X/ general principles behind floating point work and the general operation X/ of the floating point interpreter are understood. X X/ definiton of all global variables. X X.globl _fadd , _fsub , _fmul , _fdiv , csv , cret , areg , asign , aexp X.globl seta , retng , norm , saret , divv , bsign , breg , bexp , retb , reta X.globl csign , creg , cexp , mull , xorsign X X/ All the standard mathematical functions expect the second argument to X/ be the place where the result is to be put. This is exactly how they are X/ called from the eval() routine. ( via mbin ). X X X_fadd: jsr r5,csv / save the registers X jsr pc,setab / set up the parameters (in areg and breg) X br 1f X X_fsub: jsr r5,csv X jsr pc,setab X neg bsign X1: X tst bsign / test for adding zero X beq reta X tst asign X beq retb X mov areg+8,r1 / compare the exponents X sub breg+8,r1 X blt 1f X beq 2f X cmp r1,$56. / test for underflows X bge reta X mov $breg,r0 X br 4f X1: X neg r1 X cmp r1,$56. X bge retb X mov $areg,r0 X4: X mov r1,-(sp) X mov (r0)+,r1 X mov (r0)+,r2 X mov (r0)+,r3 X mov (r0)+,r4 X add (sp),(r0) X1: X asr r1 / shift the required value X ror r2 X ror r3 X ror r4 X dec (sp) X bgt 1b X mov r4,-(r0) X mov r3,-(r0) X mov r2,-(r0) X mov r1,-(r0) X tst (sp)+ X2: X mov $areg+8,r1 X mov $breg+8,r2 X mov $4,r0 X cmp asign,bsign / compare sign of arguments X bne 4f X clc X1: X adc -(r1) / signs are equal so add X bcs 3f X add -(r2),(r1) X sob r0,1b X br 5f X3: X add -(r2),(r1) X sec X sob r0,1b X br 5f X4: X clc X1: X sbc -(r1) / signs are not so subtract X bcs 3f X sub -(r2),(r1) X sob r0,1b X br 5f X3: X sub -(r2),(r1) X sec X sob r0,1b Xsaret: / return of a signed areg X mov $areg,r1 X5: X tst (r1) / is it negative X bge 3f X mov $areg+8,r1 X mov $4,r0 X clc X1: X adc -(r1) / yes then make positive X bcs 2f X neg (r1) X2: X sob r0,1b X neg -(r1) / negate sign of areg X3: Xcreta: X X jsr pc,norm / normalise result X br reta X Xretb: X mov $bsign,r1 X mov $asign,r2 X mov $6,r0 X1: X mov (r1)+,(r2)+ X sob r0,1b Xreta: X mov 6(r5),r2 / get return address Xretng: X mov $asign,r0 / convert into normal representation X tst (r0) X beq unflo X mov aexp,r1 / check for overflow X cmp r1,$177 X bgt ovflo X cmp r1,$-177 X blt unflo / check for overflow X add $200,r1 X swab r1 X clc X ror r1 X tst (r0)+ X bge 1f X bis $100000,r1 X1: X bic $!177,(r0) X bis (r0)+,r1 X mov r1,(r2)+ X mov (r0)+,(r2)+ X mov (r0)+,(r2)+ X mov (r0)+,(r2)+ X jmp cret Xunflo: / return zero on underflow X clr (r2)+ X clr (r2)+ X clr (r2)+ X clr (r2)+ X jmp cret X X.globl _error Xovflo: X mov $34.,-(sp) / call error on overflow X jsr pc,_error Xzerodiv: X mov $25.,-(sp) / call error for zero divisor X jsr pc,_error X X_fdiv: jsr r5,csv X jsr pc,setab / setup parameters X tst bsign / check for zero divisor X beq zerodiv X sub bexp,aexp X jsr pc,xorsign / set the signs correctly X jsr pc,divv / call the division routine X jmp creta / jump to return X Xdivv: X mov r5,-(sp) / this routine is taken straight X mov $areg,r0 / out of the floating point X mov (r0),r1 / interpreter. If you have enough X clr (r0)+ / time, try to find out how it X mov (r0),r2 / works. X clr (r0)+ X mov (r0),r3 X clr (r0)+ X mov (r0),r4 X clr (r0)+ X mov $areg,r5 X mov $400,-(sp) / ?????? X1: X mov $breg,r0 X cmp (r0)+,r1 X blt 2f X bgt 3f X cmp (r0)+,r2 X blo 2f X bhi 3f X cmp (r0)+,r3 X blo 2f X bhi 3f X cmp (r0)+,r4 X bhi 3f X2: X mov $breg,r0 X sub (r0)+,r1 X clr -(sp) X sub (r0)+,r2 X adc (sp) X clr -(sp) X sub (r0)+,r3 X adc (sp) X sub (r0)+,r4 X sbc r3 X adc (sp) X sub (sp)+,r2 X adc (sp) X sub (sp)+,r1 X bis (sp),(r5) X3: X asl r4 X rol r3 X rol r2 X rol r1 X clc X ror (sp) X bne 1b X mov $100000,(sp) X add $2,r5 X cmp r5,$areg+8 X blo 1b X tst (sp)+ X mov (sp)+,r5 X rts pc X X_fmul: jsr r5,csv / almost same as _fdiv X jsr pc,setab X add bexp,aexp X dec aexp X jsr pc,xorsign X jsr pc,mull X jmp creta Xmull: X mov r5,-(sp) / also taken from the interpreter X mov $breg+8,r5 X clr r0 X clr r1 X clr r2 X clr r3 X clr r4 X1: X asl r0 X bne 2f X inc r0 X tst -(r5) X2: X cmp r0,$400 X bne 2f X cmp r5,$breg X bhi 2f X mov $areg,r0 X mov r1,(r0)+ X mov r2,(r0)+ X mov r3,(r0)+ X mov r4,(r0)+ X mov (sp)+,r5 X rts pc X2: X clc X ror r1 X ror r2 X ror r3 X ror r4 X bit r0,(r5) X beq 1b X mov r0,-(sp) X mov $areg,r0 X add (r0)+,r1 X clr -(sp) X add (r0)+,r2 X adc (sp) X clr -(sp) X add (r0)+,r3 X adc (sp) X add (r0)+,r4 X adc r3 X adc (sp) X add (sp)+,r2 X adc (sp) X add (sp)+,r1 X mov (sp)+,r0 X br 1b X X.globl _integ X_integ: X jsr r5,csv X mov 4(r5),r2 X mov $asign,r0 X jsr pc,seta X clr r0 X mov $200,r1 X clr r2 X1: X cmp r0,aexp X blt 2f X bic r1,areg(r2) X2: X inc r0 X clc X ror r1 X bne 1b X mov $100000,r1 X add $2,r2 X cmp r2,$8 X blt 1b X mov 4(r5),r2 X jmp retng X X X.globl _fmod X_fmod: X jsr r5,csv / this routine cheats. X jsr pc,setab X jsr pc,divv / the function 'a mod b' == X sub bexp,aexp X jsr pc,norm X clr r0 / count X mov $200,r1 / bit X clr r2 / reg offset X1: X cmp r0,aexp X bge 2f / in fraction X bic r1,areg(r2) / this bit of code is taken from X2: / the f.p. interpreter's mod function X inc r0 / N.B. this does not do the same thing X clc / as _fmod. X ror r1 X bne 1b X mov $100000,r1 X add $2,r2 X cmp r2,$8 X blt 1b X jsr pc,norm X jsr pc,mull X add bexp,aexp X dec aexp X jmp creta X Xxorsign: X cmp asign,bsign X beq 1f X mov $-1,asign X rts pc X1: X mov $1,asign X rts pc X Xsetab: X mov $asign,r0 / set up both areg and breg X mov 4(r5),r2 X jsr pc,seta X mov 6(r5),r2 X mov $bsign,r0 X Xseta: X clr (r0) / set up one register X mov (r2)+,r1 X mov r1,-(sp) X beq 1f X blt 2f X inc (r0)+ X br 3f X2: X dec (r0)+ X3: X bic $!177,r1 X bis $200,r1 X br 2f X1: X clr (r0)+ X2: X mov r1,(r0)+ X mov (r2)+,(r0)+ X mov (r2)+,(r0)+ X mov (r2)+,(r0)+ X mov (sp)+,r1 X asl r1 X clrb r1 X swab r1 X sub $200,r1 X mov r1,(r0)+ / exp X rts pc X Xnorm: X mov $areg,r0 / normalise the areg X mov (r0)+,r1 X mov r1,-(sp) X mov (r0)+,r2 X bis r2,(sp) X mov (r0)+,r3 X bis r3,(sp) X mov (r0)+,r4 X bis r4,(sp)+ X bne 1f X clr asign X rts pc X1: X bit $!377,r1 X beq 1f X clc X ror r1 X ror r2 X ror r3 X ror r4 X inc (r0) X br 1b X1: X bit $200,r1 X bne 1f X asl r4 X rol r3 X rol r2 X rol r1 X dec (r0) X br 1b X1: X mov r4,-(r0) X mov r3,-(r0) X mov r2,-(r0) X mov r1,-(r0) X rts pc X X.bss Xasign: .=.+2 / the areg - sign Xareg: .=.+8 / - mantissa Xaexp: .=.+2 / - exponent Xbsign: .=.+2 / the breg Xbreg: .=.+8 Xbexp: .=.+2 Xcsign: .=.+2 / the creg - this register was added so that other functions Xcreg: .=.+8 / could use this set up. e.g. sqrt() Xcexp: .=.+2 / it could be that when sin() is implemented a X / fourth register might be needed End of pdp11/nfp.s chmod u=rw-,g=r,o=r pdp11/nfp.s echo x - pdp11/term.c 1>&2 sed 's/^X//' > pdp11/term.c << 'End of pdp11/term.c' X/* X * BASIC by Phil Cockcroft X */ X/* X * machine dependent terminal interface X */ X X#include "pdp11/conf.h" X#ifdef V7 X#include <sgtty.h> X#endif X X#ifndef V7 X Xstruct term { /* the structure for the terms */ X char _j[4]; /* system call */ X int flags; /* most of it is not needed */ X char __j[4]; X char width,length; X int ___j[8]; X } nterm, oterm; X X#else X X#ifndef SCOPE X#define SCOPE 0 X#endif X X#ifdef TIOCOSTP X#undef TIOCSLPN X#endif X X#ifdef TIOCSLPN Xstruct lsgttyb osttyb,nsttyb; X#undef TIOCGETP X#undef TIOCSETN X#define TIOCGETP TIOCGLPG X#define TIOCSETN TIOCSLPN X#else Xstruct sgttyb osttyb,nsttyb; X#endif Xstruct tchars ntchr,otchr; X#ifdef UCB_NTTY Xstruct ltchars nltchr,oltchr; X#endif X X#endif X Xextern int ter_width; Xextern char noedit; X Xstatic int got_mode; X Xsetu_term() X{ X register i; X#ifdef V7 X char *p, *getenv(); X X p = getenv("TERM"); X ioctl(0,TIOCGETP,&osttyb); X nsttyb=osttyb; X#ifdef TIOCSLPN X osttyb.lsg_length = DEFLENGTH; X nsttyb.lsg_length = 0; X if(ter_width <= 0) X ter_width = osttyb.lsg_width & 0377; X osttyb.lsg_width = DEFPAGE; X nsttyb.lsg_width = 0; X#endif X#ifdef TIOCOSTP X osttyb.sg_length = DEFLENGTH; X nsttyb.sg_length = 0; X if(ter_width <= 0) X ter_width = osttyb.sg_width & 0377; X osttyb.sg_width = DEFPAGE; X nsttyb.sg_width = 0; X#endif X ioctl(0,TIOCGETC,&otchr); X ntchr = otchr; /* do we need this ??? */ X if(p && strcmp(p, "ucl7009") == 0){ X ntchr.t_startc = -1; X ntchr.t_stopc = -1; X } X ntchr.t_brkc = -1; X ntchr.t_eofc = -1; X ntchr.t_intrc = CTRLINT; X ntchr.t_quitc = CTRLQUIT; X#ifdef TIOCSLPN X i = osttyb.lsg_flags & ( LCASE | XTABS); X nsttyb.lsg_flags = CBREAK | ANYP | i; X osttyb.lsg_flags = ECHO | ANYP | CRMOD | SCOPE | i; X#else X i = osttyb.sg_flags & ( LCASE | XTABS); X nsttyb.sg_flags = CBREAK | ANYP | i; X osttyb.sg_flags = ECHO | ANYP | CRMOD | SCOPE | i; X#endif X X#ifdef UCB_NTTY X ioctl(0,TIOCGLTC,&oltchr); X nltchr = oltchr; /* is this needed ?? */ X nltchr.t_suspc = -1; X nltchr.t_dsuspc = -1; X nltchr.t_rprntc = -1; X nltchr.t_flushc = -1; X nltchr.t_werasc = -1; X nltchr.t_lnextc = -1; X#endif X#else X terms(0,('t'<<8)+2,&oterm); X#ifndef V6C X nterm = oterm; X#else X terms(0,('t'<<8)+2,&nterm); X#endif X nterm.width=0; X nterm.length=0; X i= oterm.flags & 04; X nterm.flags= 040340 |i; X if(ter_width <= 0) X ter_width = oterm.width & 0377; X oterm.width=0; X oterm.length=DEFLENGTH; X oterm.flags= 0730 | i; X#endif X if(ter_width <= 0) X ter_width=DEFPAGE; X got_mode = 1; X} X Xset_term() X{ X if(noedit || !got_mode) X return; X#ifdef V7 X ioctl(0,TIOCSETN,&nsttyb); X ioctl(0,TIOCSETC,&ntchr); X#ifdef UCB_NTTY X ioctl(0,TIOCSLTC,&nltchr); X#endif X#else X terms(0,('t'<<8)+3,&nterm); X#endif X} X Xrset_term(type) X{ X X if(noedit || !got_mode) X return; X#ifdef V7 X#ifdef TIOCOSTP X if(type) X osttyb.sg_width=ter_width; X#endif X#ifdef TIOCSLPN X if(type) X osttyb.lsg_width=ter_width; X#endif X ioctl(0,TIOCSETN,&osttyb); X ioctl(0,TIOCSETC,&otchr); X#ifdef UCB_NTTY X ioctl(0,TIOCSLTC,&oltchr); X#endif X#else X if(type) X oterm.width=ter_width; X terms(0,('t'<<8)+3,&oterm); /* reset terminal modes */ X#endif X} End of pdp11/term.c chmod u=rw-,g=r,o=r pdp11/term.c echo x - pyramid/Makefile 1>&2 sed 's/^X//' > pyramid/Makefile << 'End of pyramid/Makefile' X# Makefile for a pyramid X X# which cursor file we want. X# can be ucl or ukc XCURSOR = ucl X Xbasic: bas1.o bas2.o bas3.o bas4.o bas5.o bas6.o bas7.o bas8.o \ X bas9.o cursor.o termcap.o assist.o term.o X cc -O bas1.o bas2.o bas3.o bas4.o bas5.o bas6.o bas7.o \ X bas8.o bas9.o cursor.o termcap.o assist.o term.o -lm -ltermcap -o basic X Xclean: X rm -f *.o *.s cursor.c term.c X Xassist.o: bas.h assist.c X cc -O -c -Dpyramid assist.c X Xtermcap.o: bas.h termcap.c cursor.c X cc -O -c -Dpyramid termcap.c X Xcursor.c: cursor/cursor.c.${CURSOR} X cp cursor/cursor.c.${CURSOR} cursor.c X Xcursor.o: cursor.c X cc -O -c -Dpyramid cursor.c X Xterm.o: term.c X cc -O -c -Dpyramid term.c X Xterm.c: pyramid/term.c pyramid/conf.h X cp pyramid/term.c term.c X X.c.o: X cc -O -c -Dpyramid -DBSD42 $*.c X Xbas.h: pyramid/conf.h X Xbas1.o: bas1.c bas.h Xbas2.o: bas2.c bas.h Xbas3.o: bas3.c bas.h Xbas4.o: bas4.c bas.h Xbas5.o: bas5.c bas.h Xbas6.o: bas6.c bas.h Xbas7.o: bas7.c bas.h Xbas7.c: cursor.c Xbas8.o: bas8.c bas.h Xbas9.o: bas9.c bas.h End of pyramid/Makefile chmod u=rw-,g=r,o=r pyramid/Makefile