v07i077: A BASIC Interpreter, Part05/06
sources-request at mirror.UUCP
sources-request at mirror.UUCP
Fri Dec 5 01:35:44 AEST 1986
Submitted by: phil at 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
More information about the Mod.sources
mailing list