Return to rhflib.s CVS log

Up to [Research Unix] / researchv10no / cmd / PDP11 / fpp

Annotation of researchv10no/cmd/PDP11/fpp/rhflib.s, revision 1.1

1.1     ! root        1: .text
        !             2: .globl fad,fsb,fdv,fmp,int,float /
        !             3:        /each of these expects its args on the stack, and returns its
        !             4:        /answer on the stack. eg.,
        !             5:        /       mov alow,-(sp)
        !             6:        /       mov ahi,-(sp)
        !             7:        /       jsr pc,int
        !             8:        /       mov (sp)+,iahi
        !             9:        /       mov (sp)+,ialow
        !            10:        / &&
        !            11:        /       mov alow,-(sp)
        !            12:        /       mov ahi,-(sp)
        !            13:        /       mov blow,-(sp)
        !            14:        /       mov bhi,-(sp)
        !            15:        /       jsr pc,fdv
        !            16:        /       mov (sp)+,a/b.hi
        !            17:        /       mov (sp)+,a/b.low
        !            18:        /
        !            19:        /       "hi" means "most significant bits"
        !            20:        /
        !            21:        / MJM backwards compiled RH octal code
        !            22:        / using original NORGEN listing from RH
        !            23:        /
        !            24: saver:
        !            25:        mov r1,-(sp)
        !            26:        mov r2,-(sp)
        !            27:        mov r3,-(sp)
        !            28:        mov r4,-(sp)
        !            29:        mov r5,-(sp)
        !            30:        mov 10.(sp),-(sp)
        !            31:        rts r0
        !            32: rest:
        !            33:        mov (sp)+,r0
        !            34:        mov (sp)+,r5
        !            35:        mov (sp)+,r4
        !            36:        mov (sp)+,r3
        !            37:        mov (sp)+,r2
        !            38:        mov (sp)+,r1
        !            39:        rts r0
        !            40: /// ***
        !            41: ///
        !            42: / ddiv,ddivl;  ddivl has no fancy checks
        !            43: / double (actualy any size) divide
        !            44: / world's slowest method (shift and subtract)
        !            45: / calling seq:
        !            46: /      mov numerator low part,-(sp)
        !            47: /      ...
        !            48: /      mov numerator high part,-(sp)
        !            49: /      mov number of numerator words,-(sp)
        !            50: /      mov denom low part,-(sp)
        !            51: /      ...
        !            52: /      mov denom high part,-(sp)
        !            53: /      mov number of denom words,-(sp)
        !            54: /      jsr pc,ddiv
        !            55: /
        !            56: / on return the quotient has overwritten the
        !            57: / numerator (and is same size)
        !            58: / and the remainder has overwritten the denom
        !            59: / (and is same size).  remainder sign is same as
        !            60: / numerator.  so that n-r=q*d.
        !            61: / to bump remainder from stack user can
        !            62: /   asl (sp)
        !            63: /   add (sp)+,sp
        !            64: / or similarly then for quotient
        !            65: /
        !            66: ddiv:
        !            67:        cmp 2(sp),$2    / can we do quickie divide?
        !            68:        bhi ugh
        !            69:        blt ugh3        / maybe
        !            70:        tst 4(sp)
        !            71:        bne ugh
        !            72:        tst 6(sp)
        !            73:        bmi ugh
        !            74:        cmp 8.(sp),$2
        !            75:        bne ugh
        !            76:        mov r0,-(sp)
        !            77:        mov r1,-(sp)
        !            78:        mov 14.(sp),r0
        !            79:        mov 16.(sp),r1
        !            80:        div 10.(sp),r0
        !            81:        bvs ugh2
        !            82:        blo ugh2
        !            83:        mov r0,16.(sp)
        !            84:        clr 14.(sp)
        !            85:        mov r1,10.(sp)
        !            86:        mov (sp)+,r1
        !            87:        mov (sp)+,r0
        !            88:        rts pc
        !            89: /
        !            90: ugh3:
        !            91:        cmp 6(sp),$2
        !            92:        bne ugh
        !            93:        tst 4(sp)
        !            94:        bmi ugh
        !            95:        mov r0,-(sp)
        !            96:        mov r1,-(sp)
        !            97:        mov 12.(sp),r0
        !            98:        mov 14.(sp),r1
        !            99:        div 8.(sp),r0
        !           100:        bvs ugh2
        !           101:        blo ugh2
        !           102:        mov r0,14.(sp)
        !           103:        clr 12.(sp)
        !           104:        mov r1,8.(sp)
        !           105:        mov (sp)+,r1
        !           106:        mov (sp)+,r0
        !           107:        rts pc
        !           108: /
        !           109: ugh2:
        !           110:        mov (sp)+,r1
        !           111:        mov (sp)+,r0
        !           112: /
        !           113: ddivl:
        !           114: ugh:
        !           115:        jsr r0,saver
        !           116:        mov sp,r5
        !           117:        add $14.,r5     / point to wd (# words in denom)
        !           118:        mov (r5)+,r4    / wd to r4
        !           119:        add r4,r5
        !           120:        add r4,r5       / bump r5 to wn (# wrds in num)
        !           121:        clr -(sp)       / copy denom and zero to stack
        !           122:        mov r4,r0       / set to copy d
        !           123: 1:
        !           124:        mov -(r5),-(sp)
        !           125:        sob r0,1b
        !           126:        bpl 2f  / if denom was neg we must negate it
        !           127:        mov r4,r0       / wd to r0
        !           128:        mov sp,r2       / addr of first wd to r2
        !           129:        jsr pc,ns       / negate subroutine
        !           130: 2:
        !           131:        mov r4,-(sp)    / store wd
        !           132:        add r4,r5
        !           133:        add r4,r5       / point r5 to callers wn
        !           134:        mov sp,r4       / r4 will stay pointed to my wd
        !           135:        mov (r5)+,r3    / wn to r3
        !           136:        add r3,r5
        !           137:        add r3,r5       / r5 just past numerator
        !           138:        mov r3,r0       / wn to r0
        !           139: 6:
        !           140:        mov -(r5),-(sp) / copy num to my stack
        !           141:        sob r0,6b
        !           142:        bpl 7f  / if negative we must negate it
        !           143:        mov r3,r0       / wn
        !           144:        mov sp,r2       / addr of first word of num
        !           145:        jsr pc,ns       / negate subroutine
        !           146: 7:
        !           147:        add (r4),r3     / wn+wd to r3
        !           148:        mov (r4),r0     / wd to r0
        !           149: 8:
        !           150:        clr -(sp)       / prefix wd zeroes on num
        !           151:        sob r0,8b
        !           152:        mov r3,-(sp)    / store wd+wn ahead of all this
        !           153:        mov sp,r3       / denom fits in at r3+2
        !           154:        mov -2(r5),-(sp)        / wn is iteration counter
        !           155:        mov $100000,-(sp)       / quotient bit finder
        !           156:        mov (r4),r0     / shift denom right one bit
        !           157:        mov r4,r1       / code same as below
        !           158:        tst (r1)+
        !           159: t20:
        !           160:        ror (r1)+
        !           161:        sob r0,t20
        !           162:        ror (r1)
        !           163: /
        !           164: / master shift and subtract loop
        !           165: /
        !           166: 9:
        !           167:        clc     / shift quotient bit right one
        !           168:        ror (sp)        / bit in question this iteration
        !           169:        bhis t11        / bcc   / its still in word; no extra work.
        !           170:                / bit was shifted out, we need to bump everything
        !           171:        ror (sp)        / get our bit back
        !           172:        dec 2(sp)       / iteration counter
        !           173:        ble t12 / done if zero
        !           174:        mov (r4),r0     / wd
        !           175:        mov r4,r1       / addr of denom minus 2
        !           176:        tst (r1)+
        !           177: t13:
        !           178:        mov 2(r1),(r1)+ / copy denom back one word
        !           179:        sob r0,t13
        !           180:        clr (r1)        / clear extra word
        !           181:        cmp (r3)+,(r5)+ / bump r3 and r5 up
        !           182: t11:
        !           183:        bic (sp),(r5)   / assume we won't subtract
        !           184:        mov (r4),r0     / shift d one bit right
        !           185:        mov r4,r1
        !           186:        tst (r1)+       / to first word of d
        !           187: t10:
        !           188:        ror (r1)+       / shift.  tst clears carry
        !           189:        sob r0,t10
        !           190:        ror (r1)        / extra word at end gets bits
        !           191:        mov (r4),r0     / wd
        !           192:        inc r0  / plus one
        !           193:        mov r3,r1       / addr in numerator
        !           194:        mov r4,r2       / addr in denom
        !           195:        cmp (r2)+,(r1)+ / bump both
        !           196: t14:
        !           197:        cmp (r1)+,(r2)+ / cmp num to denom
        !           198:        bne t15
        !           199:        sob r0,t14
        !           200:        br t21  / equal, do subtract
        !           201: t15:
        !           202:        blo 9b  / no subtract if num less
        !           203:        dec r0  / subtract off residual word count
        !           204:        asl r0  / to wrds
        !           205:        add r0,r1
        !           206:        add r0,r2
        !           207: t21:
        !           208:        mov (r4),r0
        !           209:        bis (sp),(r5)   / we were wrong.. set the bit
        !           210:        mov r4,-(sp)    / save r4
        !           211: t16:
        !           212:        sub -(r2),-(r1) / sub denom from num
        !           213:        mov r1,r4
        !           214: t22:
        !           215:        sbc -(r4)
        !           216:        blo t22 / bcs
        !           217:        sob r0,t16
        !           218:        sub -(r2),-(r1)
        !           219:        mov (sp)+,r4    / restore r4
        !           220:        br 9b
        !           221: t12:
        !           222:        cmp (sp)+,(sp)+ / bump sp to wd+wn
        !           223:        mov (sp),r0     / wd+wn to r0
        !           224:        sub (r4),r0     / wn to r0
        !           225:        sub r0,r5
        !           226:        sub r0,r5       / r5 now points to callers wn
        !           227:        mov r5,r3
        !           228:        tst (r5)+       / now to numerator
        !           229:        sub (r4),r3
        !           230:        sub (r4),r3     / r3 points to first wd of callers denom
        !           231:        mov (r5),r2     / sign of numerator to r2
        !           232:        bpl t18 / remainder if ok (positive)
        !           233:        mov r4,r2       / change sign of remainder via ns
        !           234:        mov (r4),r0     / wd to r0
        !           235:        sub r0,r2
        !           236:        sub r0,r2       / r2 points at remainder
        !           237:        jsr pc,ns       / negate it
        !           238:        mov (r5),r2     / sign of numerator
        !           239:        bic $100000,(r5)
        !           240: t18:
        !           241:        xor r2,(r3)     / are signs of n and d same
        !           242:        bpl t17 / yes quotient is ok (positive)
        !           243:        mov -2(r5),r0   / wn to r0
        !           244:        mov r5,r2
        !           245:        jsr pc,ns       / negate quotient
        !           246: t17:
        !           247:        mov r4,r2       / now copy remainder to callers denom
        !           248:        mov (r4),r0     / wd to r0
        !           249:        tst -(r5)       / r5 pts to callers wn
        !           250: t19:
        !           251:        mov -(r2),-(r5) / copy remainder to denom
        !           252:        sob r0,t19
        !           253:        sub $16.,r5     / r5 pts to save area
        !           254:        mov r5,sp
        !           255:        jsr pc,rest
        !           256:        rts pc
        !           257: ns:                    / negate subroutine
        !           258:        mov r0,r1
        !           259: 4:
        !           260:        com (r2)+
        !           261:        sob r0,4b
        !           262: 5:
        !           263:        adc -(r2)
        !           264:        sob r1,5b
        !           265:        rts pc
        !           266: /// ***
        !           267: ///
        !           268: /
        !           269: / convert number on stack from flt to int
        !           270: /
        !           271: int:
        !           272:        mov r0,-(sp)
        !           273:        mov r1,-(sp)
        !           274:        mov r2,-(sp)
        !           275:        clr -(sp)       / sign of input number
        !           276:        mov 12.(sp),r1  / low part
        !           277:        mov 10.(sp),r0  / hi part
        !           278:        bpl 1f  / ok
        !           279:        mov $100000,(sp)        / set sign -
        !           280:        bic (sp),r0     / set number plus
        !           281: 1:
        !           282:        mov r0,r2       / extract exponent
        !           283:        bic $100177,r2
        !           284:        bic r2,r0
        !           285:        ash $-7,r2      / make it an integer
        !           286:        bis $200,r0     / set hidden bit
        !           287:        sub $200,r2     / subtr off excess 200
        !           288:        ble 2f  / zero, whole thing zero.
        !           289:        sub $24.,r2     / set for shift
        !           290:        ashc r2,r0      / left or right
        !           291: 4:
        !           292:        tst (sp)+       / sign
        !           293:        bpl 3f
        !           294:        neg r0
        !           295:        neg r1
        !           296:        sbc r0
        !           297: 3:
        !           298:        mov r0,8.(sp)
        !           299:        mov r1,10.(sp)
        !           300:        mov (sp)+,r2
        !           301:        mov (sp)+,r1
        !           302:        mov (sp)+,r0
        !           303:        rts pc
        !           304: 2:
        !           305:        clr r0
        !           306:        clr r1
        !           307:        br 4b
        !           308: /
        !           309: / float an integer on stack
        !           310: /
        !           311: float:
        !           312:        mov 4(sp),-(sp)
        !           313:        mov 4(sp),-(sp)
        !           314:        bmi negflt
        !           315:        clr -(sp)
        !           316:        mov $[200+24.]*200,-(sp)        / mov $46000,-(sp)
        !           317: 1:
        !           318:        bit $377*200,4(sp)      / bit $77600,4(sp)
        !           319:        beq 2f
        !           320:        asr 4(sp)
        !           321:        ror 6(sp)
        !           322:        add $200,(sp)
        !           323:        br 1b
        !           324: 2:
        !           325:        bis (sp),4(sp)
        !           326:        jsr pc,fsb              // fsbx. (assuming hdwf=0; else 075016)
        !           327:        mov (sp)+,4(sp)
        !           328:        mov (sp)+,4(sp)
        !           329:        rts pc
        !           330: negflt:
        !           331:        neg (sp)
        !           332:        neg 2(sp)
        !           333:        sbc (sp)
        !           334:        bmi 3f  / overflow. avoid recursion to 0
        !           335:        jsr pc,float
        !           336:        bis $100000,(sp)
        !           337:        mov (sp)+,4(sp)
        !           338:        mov (sp)+,4(sp)
        !           339:        rts pc
        !           340: 3:
        !           341:        cmp (sp)+,(sp)+ / toss
        !           342:        mov $[200+32.]*200+100000,2(sp) / mov $150000,2(sp) / -2**-31
        !           343:        clr 4(sp)
        !           344:        rts pc
        !           345: /// ***
        !           346: ///
        !           347: / 32 bit and sub mul neg
        !           348: /
        !           349: / jsr pd,dmul
        !           350: / input is 2 32-bit no's on stack
        !           351: / output is 64-bit product on stack
        !           352: /      mov n low,-(sp)
        !           353: /      mov n high,-(sp)
        !           354: /      mov m low,-(sp)
        !           355: /      mov m hi,-(sp)
        !           356: /      jsr pc,dmul
        !           357: /
        !           358: dmul:
        !           359:        jsr r0,saver
        !           360:        tst 14.(sp)     / see if we can simply multiply
        !           361:        bne ughx
        !           362:        tst 18.(sp)
        !           363:        bne ughx
        !           364:        mov 16.(sp),r0
        !           365:        bmi ughx
        !           366:        mov 20.(sp),r2
        !           367:        bmi ughx
        !           368:        mul r2,r0
        !           369:        mov r1,20.(sp)
        !           370:        mov r0,18.(sp)
        !           371:        sxt 16.(sp)
        !           372:        sxt 14.(sp)
        !           373:        jsr pc,rest
        !           374:        rts pc
        !           375: /
        !           376: ughx:
        !           377:        clr -(sp)       / signs differ flag
        !           378:        mov sp,r5
        !           379:        add $22.,r5     / r5 -> l1
        !           380:        mov (r5),r0     / l1
        !           381:        mov -(r5),r2    / h1
        !           382:        bpl 1f  / make positive if not
        !           383:        inc (sp)        / signs differ flag
        !           384:        neg r2
        !           385:        neg r0
        !           386:        sbc r2
        !           387: 1:
        !           388:        mov -(r5),r1    / l2
        !           389:        mov -(r5),r4    / h2
        !           390:        bpl 2f  / make pos if neg
        !           391:        neg r4
        !           392:        neg r1
        !           393:        sbc r4
        !           394:        dec (sp)        / (sp) is zero of both signs same
        !           395: 2:
        !           396:        mov r1,-(sp)    / l2
        !           397:        mov r0,-(sp)    / l1
        !           398:        mov r2,-(sp)    / h1
        !           399:        bic $100000,r0
        !           400:        bic $100000,r1  / clear l1 l2 sign bits so mul works
        !           401: ///
        !           402: / stack now looks like this: low core up
        !           403: /      h1<-sp
        !           404: /      l1
        !           405: /      l2
        !           406: /      sign flag
        !           407: /      r5
        !           408: /      r4
        !           409: /      r3
        !           410: /      r2
        !           411: /      r1
        !           412: /      r0
        !           413: /      return
        !           414: /      h2  (p4=hi part of product)
        !           415: /      l2  (p3)
        !           416: /      h1  (p2)
        !           417: /      l1  (p1)
        !           418: /
        !           419:        mul r4,r2       /  h1 * h2
        !           420:        mov r2,(r5)+    / to p4, r5 to p3
        !           421:        mov r3,(r5)+    / to p3, r5 to p2
        !           422:        mov r1,r2       / l2
        !           423:        mul r0,r2       / l1 * l2
        !           424:        mov r2,(r5)+    / to p2, r5 to p1
        !           425:        mov r3,(r5)     / to p1, r5 to p1
        !           426:        mov r4,r2       / h2
        !           427:        mul r0,r2       / l1 * h2
        !           428:        add r3,-(r5)    / to p2, r5 to p2
        !           429:        adc -(r5)       / carry to p3, r5 to p3
        !           430:        adc -2(r5)      / carry to p4, r5 to p3
        !           431:        add r2,(r5)     / to p3, r5 to p3
        !           432:        adc -(r5)       / to p4, r5 to p4
        !           433:        mov (sp),r2     / h1
        !           434:        mul r1,r2       / l2 * h1
        !           435:        cmp (r5)+,(r5)+ / r5 to p2
        !           436:        add r3,(r5)     / to p2, r5 to p2
        !           437:        adc -(r5)       / to p3, r5 to p3
        !           438:        adc -2(r5)      / to p4, r5 to p3
        !           439:        add r2,(r5)     / to p3
        !           440:        adc -(r5)       / to p4
        !           441:        tst 2(sp)       / was l1 sign bit set
        !           442:        bpl 3f  / no
        !           443:        cmp (r5)+,(r5)+ / r5 to p2
        !           444:        mov r4,r2       / h2
        !           445:        mov r1,r3       / l2
        !           446:        ashc $-1,r2
        !           447:        bhis 4f         / bcc
        !           448:        add $100000,2(r5)       / add to p1, r5 to p2
        !           449:        adc (r5)
        !           450:        adc -(r5)       / r5 to p3
        !           451:        adc -(r5)       / r5 to p4
        !           452:        cmp (r5)+,(r5)+ /  r5 to p2
        !           453: 4:
        !           454:        add r3,(r5)     /  add to p2
        !           455:        adc -(r5)       / to p3
        !           456:        adc -(r5)       / to p4
        !           457:        add r2,2(r5)    /  add to p3
        !           458:        adc (r5)        /  to p4
        !           459: 3:
        !           460:        tst 4(sp)       /  is l2 sign bit set
        !           461:        bpl 5f  / no
        !           462:        mov (sp),r2     /  h1
        !           463:        mov r0,r3       /  l1
        !           464:        cmp (r5)+,(r5)+ /  r5 to p2
        !           465:        ashc $-1,r2
        !           466:        bhis 6f         / bcc
        !           467:        add $100000,2(r5)       / add to p1
        !           468:        adc (r5)        / to p2
        !           469:        adc -(r5)       / to p3
        !           470:        adc -(r5)       / to p4
        !           471:        cmp (r5)+,(r5)+ / r5 to p2
        !           472: 6:
        !           473:        add r3,(r5)     / to p2
        !           474:        adc -(r5)       / to p3
        !           475:        adc -(r5)       / to p4
        !           476:        add r2,2(r5)    / to p3
        !           477:        adc (r5)        / to p4
        !           478:        tst 2(sp)       /  is l1 sign bit set as well
        !           479:        bpl 5f  /  no
        !           480:        cmp (r5)+,(r5)+ / r5 to p2
        !           481:        add $40000,(r5) / add to p2
        !           482:        adc -(r5)       / to p3
        !           483:        adc -(r5)       / to p4
        !           484: 5:
        !           485:        add $6,sp       / get to sign flag
        !           486:        tst (sp)+
        !           487:        beq 7f  / signs were same
        !           488:        com (r5)+       / set product negative
        !           489:        com (r5)+
        !           490:        com (r5)+
        !           491:        com (r5)
        !           492:        adc (r5)
        !           493:        adc -(r5)
        !           494:        adc -(r5)
        !           495:        adc -(r5)
        !           496: 7:
        !           497:        jsr pc,rest
        !           498:        rts pc
        !           499: /// ***
        !           500: ///
        !           501: /
        !           502: / floating point operations
        !           503: /      mov (arg1)+,-(sp)
        !           504: /      mov (arg1)+,-(sp)
        !           505: /      mov (arg2)+,-(sp)
        !           506: /      mov (arg2)+,-(sp)
        !           507: /      jsr pc,fad/fsb/fmp/fdv
        !           508: / ans returned over arg1 and stack popped
        !           509: /
        !           510: fsb:
        !           511:        tst 2(sp)       / jsr pc,*$tryflt, when no fltg hdware.
        !           512:        bgt 1f
        !           513:        bic $100000,2(sp)
        !           514:        br fad
        !           515: 1:
        !           516:        bis $100000,2(sp)
        !           517: /
        !           518: fad:
        !           519:        jsr r0,saver    / was: jsr pc,*$tryflt
        !           520:        mov sp,r5
        !           521:        add $18.,r5     / point to arg 1 (high order part)
        !           522:        jsr pc,fxt      / extract exp to r0, leave dint on stack
        !           523:        mov r5,r4       / point to h1 with r4
        !           524:        mov r0,r1       / e1 to r1
        !           525:        cmp -(r5),-(r5) / point to h2 with r5
        !           526:        jsr pc,fxt      / decipher it too
        !           527:        cmp r1,r0       / which has bigger (or eqal) exponent?
        !           528:        bge 1f
        !           529:        mov r4,r3       / swap the args so that (r4) does
        !           530:        mov r5,r4
        !           531:        mov r3,r5
        !           532:        mov r0,r3
        !           533:        mov r1,r0
        !           534:        mov r3,r1
        !           535: 1:
        !           536:        sub r1,r0       / get negative shift count
        !           537:        ash $-7,r0      / make exponent integer
        !           538:        cmp r0,$-24.    / if ge 24 get a zero instead
        !           539:        ble 2f
        !           540:        mov (r5)+,r2    / get number in r2-r3
        !           541:        mov (r5),r3
        !           542:        ashc r0,r2
        !           543:        adc r3
        !           544:        adc r2  / round the result
        !           545:        br 3f
        !           546: 2:
        !           547:        clr r2
        !           548:        clr r3  / shifted off... get zero
        !           549: 3:
        !           550:        mov r1,r0       / get correct exponent to r1
        !           551:        add 2(r4),r3    / add the numbers
        !           552:        adc r2
        !           553:        add (r4),r2
        !           554:        jsr pc,dfxt     / reassemble the flt point format
        !           555:        mov sp,r4
        !           556:        add $18.,r4     / set to overwrite arg1
        !           557:        mov r2,(r4)+
        !           558:        mov r3,(r4)
        !           559: exit1: / was exit; no good on unix
        !           560:        jsr pc,rest
        !           561:        mov (sp),4(sp)
        !           562:        cmp (sp)+,(sp)+
        !           563:        jmp *(sp)+      / return
        !           564: /
        !           565: / floating point utilities
        !           566: /
        !           567: fxt:
        !           568: /
        !           569: / in:  r5 points to high part (low addr) of flt pt num
        !           570: / out: ro=exponent (bits 14-7, excess 200)
        !           571: / (r5),(r5)+2=32 bit 2's compl integer part
        !           572: /
        !           573:        mov (r5),r0     / extract flt number componets
        !           574: 3:
        !           575:        bic $100177,r0  / clear fraction
        !           576:        beq 4f  / if exp zero, whole number is zero
        !           577:        bic r0,(r5)     / clear exp part in (r5)
        !           578:        bpl 1f  / number is postive
        !           579:        bis $200,(r5)   / num is negative, set hidden bit
        !           580:        bic $100000,(r5)        / reset sign bit
        !           581:        com (r5)+
        !           582:        com (r5)
        !           583:        adc (r5)
        !           584:        adc -(r5)
        !           585:        br 2f
        !           586: 1:
        !           587:        bis $200,(r5)   / set hidden bit
        !           588: 2:
        !           589:        rts pc
        !           590: 4:
        !           591:        clr 2(r5)       / make sure number is zero
        !           592:        clr (r5)
        !           593:        rts pc
        !           594: /
        !           595: / routine to reverse the procedure
        !           596: /      in:  r0 = exponent
        !           597: /      r2-r3 = 2's compl integer part
        !           598: /      out: r2-r3 = flt pt number
        !           599: /
        !           600: dfxt:
        !           601:        mov r2,-(sp)    / save sign
        !           602:        ashc $0,r2      / check whole number for zero and sign
        !           603:        beq 3f  / done if zero
        !           604:        bpl 1f  / complement it if it's negative
        !           605:        com r2
        !           606:        com r3
        !           607:        adc r3
        !           608:        adc r2
        !           609: 1:
        !           610:        bit $077400,r2  / shift data bits out of exp
        !           611:        beq 2f
        !           612:        add $200,r0     / incr exponent part
        !           613:        ashc $-1,r2     / divide by two
        !           614:        bne 1b  / always branches
        !           615:        br 6f   / you cant get here, treat as oveflow
        !           616: 2:
        !           617:        bit $200,r2
        !           618:        bne 4f   / make sure there's a data bit for hidden bit
        !           619:        sub $200,r0      / decr exponent
        !           620:        ashc $1,r2       / mul by two
        !           621:        bne 2b   / always branches
        !           622:        br 6f    /  you cant get here
        !           623: 4:
        !           624:        bit $100177,r0
        !           625:        bne 6f  / exponent under or over flow; don't know which
        !           626:        bic $200,r2     / hide hidden bit
        !           627:        bis r0,r2       / move exp into number
        !           628:        tst (sp)+       / okay, what sign was it
        !           629:        bpl 5f
        !           630:        bis $100000,r2  / set minus
        !           631: 5:
        !           632:        rts pc
        !           633: /
        !           634: 6:
        !           635: 3:
        !           636:        clr r2
        !           637:        clr r3
        !           638:        tst (sp)+
        !           639:        rts pc
        !           640: //
        !           641: fmp:
        !           642:        jsr r0,saver    / was: jsr pc,*$tryflt
        !           643:        mov sp,r5
        !           644:        add $18.,r5     / r5 points to arg1 hi part (h1)
        !           645:        jsr pc,fxt      / busy it out
        !           646:        cmp -(r5),-(r5) / goto arg2
        !           647:        mov r0,r1       / save exp
        !           648:        jsr pc,fxt
        !           649:        sub $[200]*200,r0       / sub $40000,r0 / subtr excess 200
        !           650:        add r1,r0
        !           651:        mov $2,r4
        !           652: 1:
        !           653:        mov (r5)+,r2    / prenormalize a little
        !           654:        mov (r5)+,r3
        !           655:        ashc $4,r2
        !           656:        mov r3,-(sp)
        !           657:        mov r2,-(sp)
        !           658:        sob r4,1b       / two ints copied to stack
        !           659:        jsr pc,dmul     / multiply and be fruitful
        !           660:        mov (sp)+,r2
        !           661:        mov (sp)+,r3    / copy high two wrds of answer
        !           662:        cmp (sp)+,(sp)+ / bump past other two
        !           663:        cmp -(r5),-(r5) / r5 to hi
        !           664: mexit:
        !           665:        jsr pc,dfxt     / cnvt to flt pt
        !           666:        mov r2,(r5)+
        !           667:        mov r3,(r5)
        !           668:        jmp exit1       / done!
        !           669: /
        !           670: / divide
        !           671: /
        !           672: fdv:
        !           673:        jsr r0,saver    / was: jsr pc,*$tryflt
        !           674:        mov sp,r5       / this code same as mul and fad
        !           675:        add $14.,r5     / except we pick up arg2 first
        !           676:        jsr pc,fxt
        !           677:        mov r0,r1
        !           678:        cmp (r5)+,(r5)+ / back to arg 1
        !           679:        jsr pc,fxt
        !           680:        sub r1,r0       / exps subtract
        !           681:        add $[200+1]*200,r0     / add $40200,r0 / add exc 200 and shift
        !           682:        mov (r5)+,r2
        !           683:        mov (r5),r3
        !           684:        ashc $7,r2      / get full bits from 3-word numerator
        !           685:        clr -(sp)       / trailing zeroes
        !           686:        mov r3,-(sp)
        !           687:        mov r2,-(sp)
        !           688:        mov $3,-(sp)    / 3-words
        !           689:        cmp -(r5),-(r5) / to arg2 l2
        !           690:        mov (r5),-(sp)
        !           691:        mov -(r5),-(sp) / denom
        !           692:        mov $2,-(sp)    / 2-words
        !           693:        jsr pc,ddiv     / divide and conquer
        !           694:        add $10.,sp     / past remainder and counts
        !           695:        mov (sp)+,r2    / middle word of quotient
        !           696:        mov (sp)+,r3    / low word
        !           697:        cmp (r5)+,(r5)+ / p5 to h1
        !           698:        jmp mexit       / use fmp exit code. r5 in right place.
        !           699: ///
        !           700: / ***  The following from NORGEN code not being used  ***
        !           701: / try hardware floating point operation to see if option installed
        !           702: /
        !           703: /      tryflt:
        !           704: /              mov $nohdw,*$10
        !           705: /              clr *$12
        !           706: /              clr -(sp)
        !           707: /              clr -(sp)
        !           708: /              clr -(sp)
        !           709: /              clr -(sp)
        !           710: /              075006   / fadd sp
        !           711: /              cmp (sp)+,(sp)+ / is installed. set up calls to hdw.
        !           712: /              mov jump,fad
        !           713: /              mov jump,fsb
        !           714: /              mov jump,fmp
        !           715: /              mov jump,fdv
        !           716: /              mov $hfad,fad+2
        !           717: /              mov $hfsb,fsb+2
        !           718: /              mov $hfmp,fmp+2
        !           719: /              mov $hfdv,fdv+2
        !           720: /              sub $4,(sp)     / bump ret addr back 4.
        !           721: /              rts pc
        !           722: /      /
        !           723: /      nohdw:
        !           724: /              mov $saver,fad+2
        !           725: /              mov $saver,fmp+2
        !           726: /              mov $saver,fdv+2
        !           727: /              mov test,fsb
        !           728: /              mov test+2,fsb+2
        !           729: /              mov jsr0,fad
        !           730: /              mov jsr0,fmp
        !           731: /              mov jsr0,fdv
        !           732: /              add $12.,sp     / bump past 8 flt pt, 4 interrupt
        !           733: /              sub $4,(sp)     / bump ret addr back to jsr
        !           734: /              rts pc
        !           735: /      /
        !           736: /      test:
        !           737: /              tst 2(sp)
        !           738: /      jsr0:
        !           739: /              jsr r0,*$saver
        !           740: /      /
        !           741: /      hfad:   sub $2,(sp)
        !           742: /              mov $240,*(sp)
        !           743: /              sub $2,(sp)
        !           744: /              mov $75006,*(sp)
        !           745: /              rts pc
        !           746: /      hfsb:   sub $2,(sp)
        !           747: /              mov $240,*(sp)
        !           748: /              sub $2,(sp)
        !           749: /              mov $75016,*(sp)
        !           750: /              rts pc
        !           751: /      hfmp:   sub $2,(sp)
        !           752: /              mov $240,*(sp)
        !           753: /              sub $2,(sp)
        !           754: /              mov $75026,*(sp)
        !           755: /              rts pc
        !           756: /      hfdv:   sub $2,(sp)
        !           757: /              mov $240,*(sp)
        !           758: /              sub $2,(sp)
        !           759: /              mov $75036,*(sp)
        !           760: /              rts pc
        !           761: /      /
        !           762: /      jump:   jmp *$0

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.