Annotation of 43BSDReno/pgrm/lisp/franz/68k/qfuncl.c, revision 1.1

1.1     ! root        1: /*
        !             2:  *$Header: qfuncl.c,v 1.9 84/02/29 17:23:24 sklower Exp $
        !             3:  *$Locker:  $
        !             4:  *
        !             5:  * Copyright (c) 1982, by the Regents, University of California
        !             6:  *
        !             7:  *                     -[Tue Mar 22 15:42:27 1983 by layer]-
        !             8:  *
        !             9:  * "quick" functions file.
        !            10:  *
        !            11:  * This is written in assembler but must be passed through the C preprocessor
        !            12:  * before being assembled.
        !            13:  *
        !            14:  */
        !            15: 
        !            16: #include "ltypes.h"
        !            17: #include "config.h"
        !            18:  
        !            19: /* important offsets within data types for atoms */
        !            20: #define Atomfnbnd 8
        !            21: 
        !            22: /*  for arrays */
        !            23: #define Arrayaccfun 0
        !            24: 
        !            25: /* register defines */
        !            26: #define FIXREG d2
        !            27: 
        !            28: #ifdef NPINREG
        !            29: #define _np a2
        !            30: #define _lbot d3
        !            31: #endif
        !            32: 
        !            33: 
        !            34: #ifdef PROF
        !            35:        .set    indx,0
        !            36: #define Profile \
        !            37:        lea     prbuf+indx,a0 \
        !            38:        .set    indx,indx+4 \
        !            39:        jsr     mcount 
        !            40: #define Profile2 \
        !            41:        movl    a0,sp@-
        !            42:        lea     prbuf+indx,a0 \
        !            43:        .set    indx,indx+4 \
        !            44:        jsr     mcount 
        !            45:        movl    sp@+,a0
        !            46: #else
        !            47: #define Profile
        !            48: #define Profile2
        !            49: #endif
        !            50: 
        !            51: #ifdef PORTABLE
        !            52: #define        NILtest(p)      cmpl    #/**/OFFSET,p
        !            53: #define        NILsub(p)       subl    #/**/OFFSET,p
        !            54: #else
        !            55: #define NILtest(p)
        !            56: #define NILsub(p)
        !            57: #endif
        !            58: 
        !            59: 
        !            60:        .text
        !            61:        
        !            62: /*   transfer  table linkage routine  */
        !            63:        .globl  _qlinker
        !            64: _qlinker:
        !            65:        Profile
        !            66:        link    a6,#-28
        !            67:        tstb    sp@(-132)
        !            68:        moveml  #036000,a6@(-28)                |a(2,3,4,5)
        !            69: 
        !            70:        tstl    _exception                      |any pending exceptions
        !            71:        jeq     noexc
        !            72:        tstl    _sigintcnt                      |is it because of SIGINT
        !            73:        jeq     noexc                           |if not, just leave
        !            74:        movl    #2,sp@-                         |else push SIGINT
        !            75:        jsr     _sigcall
        !            76: noexc:
        !            77:        movl    a6@(4),a4                       |get return pc
        !            78:        movl    a4@(-6),a4                      |get pointer to table
        !            79:        movl    a4@(4),a5                       |get atom pointer
        !            80: retry:                                         |come here after undeffunc err
        !            81:        movl    a5@(8),a0                       |get function binding
        !            82:        cmpl    a0,d7                           |if nil,
        !            83:        jeq     nonex                           |then leave
        !            84:        tstl    2*4+_stattab                    |see if linkin posble (Strans)
        !            85:        jeq     nolink                          |no, it isn't
        !            86:        movl    a0,d0                           |check type of function
        !            87:        NILsub(d0)
        !            88:        moveq   #9,d1
        !            89:        asrl    d1,d0
        !            90:        lea     _typetable+1,a3
        !            91:        movb    a3@(0,d0:L),d1
        !            92:        cmpb    #/**/BCD,d1
        !            93:        jeq     linkin                          |bcd, link it in!
        !            94:        cmpb    #/**/ARRAY,d1                   |how about array?
        !            95:        jeq     doarray                         |yep
        !            96: 
        !            97: nolink:
        !            98:        movl    a5,sp@-                         |non, bcd, call interpreter
        !            99:        jsr     _Ifuncal
        !           100:        moveml  a6@(-28),#036000
        !           101:        unlk    a6
        !           102:        rts
        !           103: 
        !           104: /*
        !           105:  * handle arrays by pushing the array descriptor on the table and checking
        !           106:  * for a bcd array handler
        !           107:  */
        !           108: doarray:
        !           109:        movl    a0@(Arrayaccfun),d0             |get access func addr shifted
        !           110:        NILsub(d0)
        !           111:        movl    #9,d1
        !           112:        asrl    d1,d0
        !           113:        lea     _typetable+1,a3
        !           114:        cmpb    #/**/BCD,a3@(0,d0:L)            |bcd??
        !           115:        jne     nolink                          |no, let funcal handle it
        !           116:        movl    a0,a2@+                         |store array header on stack
        !           117:        movl    a2,_np
        !           118:        movl    a0@,a0                          |movl *(a0),a0 on VAX
        !           119:        movl    a0@,a0
        !           120:        jsr     a0@
        !           121:        subql   #4,_np
        !           122:        moveml  a6@(-28),#036000
        !           123:        unlk    a6
        !           124:        rts
        !           125:        
        !           126:        
        !           127: linkin:        
        !           128:        movl    a0@(4),d0                       |check type of function discipline
        !           129:        NILsub(d0)
        !           130:        movl    #9,d1
        !           131:        asrl    d1,d0
        !           132:        lea     _typetable+1,a3
        !           133:        cmpb    #/**/STRNG,a3@(0,d0:L)          |is it string?
        !           134:        jeq     nolink                          |yes, it is a c call,
        !           135:                                                |so dont link in
        !           136:        movl    a0@,a0                          |get function addr
        !           137:        movl    a0,a4@                          |put fcn addr in table
        !           138:        jbsr    a0@
        !           139:        moveml  a6@(-28),#036000
        !           140:        unlk    a6
        !           141:        rts
        !           142: 
        !           143: 
        !           144: nonex: movl    a4,sp@-                         |preserve table address
        !           145:        movl    a5,sp@-                         |non existant fcn
        !           146:        jsr     _Undeff                         |call processor
        !           147:        movl    d0,a5                           |back in r1
        !           148:        addql   #4,sp
        !           149:        movl    sp@+,a4                         |restore table address
        !           150:        jra     retry                           |for the retry.
        !           151: 
        !           152: 
        !           153:        .data
        !           154:        .globl  __erthrow
        !           155: __erthrow: 
        !           156:        .asciz  "Uncaught throw from compiled code"
        !           157:        .text
        !           158: 
        !           159:        .globl _tynames
        !           160: _tynames:
        !           161:        .long   _nilatom                        |nothing here
        !           162:        .long   20*4+_lispsys                   |str_name
        !           163:        .long   21*4+_lispsys                   |atom_name
        !           164:        .long   19*4+_lispsys                   |int_name
        !           165:        .long   23*4+_lispsys                   |dtpr_name
        !           166:        .long   22*4+_lispsys                   |doub_name
        !           167:        .long   58*4+_lispsys                   |funct_name
        !           168:        .long   103*4+_lispsys                  |port_name
        !           169:        .long   47*4+_lispsys                   |array_name
        !           170:        .long   _nilatom                        |nothing here
        !           171:        .long   50*4+_lispsys                   |sdot_name
        !           172:        .long   53*4+_lispsys                   |val_nam
        !           173: 
        !           174:        .long   _nilatom                        | hunk2_nam
        !           175:        .long   _nilatom                        | hunk4_nam
        !           176:        .long   _nilatom                        | hunk8_nam
        !           177:        .long   _nilatom                        | hunk16_nam
        !           178:        .long   _nilatom                        | hunk32_nam
        !           179:        .long   _nilatom                        | hunk64_nam
        !           180:        .long   _nilatom                        | hunk128_nam
        !           181:        .long   124*4+_lispsys                  |vector_nam
        !           182:        .long   125*4+_lispsys                  |vectori_nam
        !           183: 
        !           184: /*     Quickly allocate small fixnums  */
        !           185: 
        !           186:        .globl  _qnewint
        !           187: _qnewint:
        !           188:        Profile
        !           189:        cmpl    #1024,FIXREG
        !           190:        bge     alloc
        !           191:        cmpl    #-1024,FIXREG
        !           192:        bmi     alloc
        !           193:        movl    FIXREG,d0
        !           194:        asll    #2,d0
        !           195:        addl    #_Fixzero,d0
        !           196:        rts
        !           197: alloc:
        !           198:        movl    _int_str,a0                     |move next cell addr to r0
        !           199:        NILtest(a0)
        !           200:        jmi     callnewi                        |if no space, allocate
        !           201:        movl    4*24+_lispsys,a1
        !           202:        addql   #1,a1@                          |inc count of ints
        !           203:        movl    a0@,_int_str                    |advance free list
        !           204:        movl    FIXREG,a0@                      |put baby to bed.
        !           205:        movl    a0,d0
        !           206:        rts
        !           207: callnewi:
        !           208:        movl    FIXREG,sp@-
        !           209:        movl    a2,_np                          |gc could occur
        !           210:        movl    a2,_lbot
        !           211:        jsr     _newint
        !           212:        movl    d0,a0
        !           213:        movl    sp@+,a0@
        !           214:        rts
        !           215: 
        !           216: /*  _qoneplus adds one to the boxed fixnum in r0
        !           217:  * and returns a boxed fixnum.
        !           218:  */
        !           219: 
        !           220:        .globl  _qoneplus
        !           221: _qoneplus:
        !           222:        Profile
        !           223:        movl    a0@,FIXREG
        !           224:        addql   #1,FIXREG
        !           225:        bra     _qnewint
        !           226: 
        !           227: /* _qoneminus  subtracts one from the boxes fixnum in r0 and returns a
        !           228:  * boxed fixnum
        !           229:  */
        !           230:        .globl  _qoneminus
        !           231: _qoneminus:
        !           232:        Profile
        !           233:        movl    a0@,FIXREG
        !           234:        subql   #1,FIXREG
        !           235:        bra     _qnewint
        !           236: 
        !           237: /*
        !           238:  *     _qnewdoub quick allocation of a initialized double (float) cell.
        !           239:  *     This entry point is required by the compiler for symmetry reasons.
        !           240:  *     Passed to _qnewdoub in d0,d1 is a double precision floating point
        !           241:  *     number.  This routine allocates a new cell, initializes it with
        !           242:  *     the given value and then returns the cell.
        !           243:  */
        !           244: 
        !           245:        .globl  _qnewdoub
        !           246:     
        !           247: _qnewdoub:
        !           248:        Profile
        !           249:        movl    _doub_str,a0                    |move next cell addr to r0
        !           250:        NILtest(a0)
        !           251:        jmi     callnewd                        |if no space, allocate
        !           252:        |incl   *_lispsys+30*4                  |inc count of doubs
        !           253:        lea     30*4+_lispsys,a1
        !           254:        addl    #1,a1@
        !           255:        movl    a0@,_doub_str                   |advance free list
        !           256: strdb:
        !           257:        movl    d0,a0@                          |put baby to bed.
        !           258:        movl    d1,a0@(4)                       |put baby to bed.
        !           259:        rts
        !           260: 
        !           261: callnewd:
        !           262:        movl    d0,sp@-                         |stack initial value
        !           263:        movl    d1,sp@-                         |stack initial value
        !           264:        movl    a2,_np                          |gc could occur
        !           265:        movl    a2,_lbot
        !           266:        jsr     _newdoub
        !           267:        movl    d0,a0
        !           268:        movl    sp@+,d1                         |restore initial value
        !           269:        movl    sp@+,d0                         |restore initial value
        !           270:        bra     strdb
        !           271: 
        !           272: 
        !           273: 
        !           274: /*
        !           275:  * quick cons call, the car and cdr are stacked on the namestack
        !           276:  * and this function is jsb'ed to.
        !           277:  */
        !           278:        .globl  _qcons
        !           279: _qcons:
        !           280:        Profile
        !           281:        movl    _dtpr_str,a0                    |move next cell addr to a0
        !           282:        NILtest(a0)
        !           283:        jmi     getnew                          |if ran out of space jump
        !           284:        movl    28*4+_lispsys,a1                |inc count of dtprs
        !           285:        addql   #1,a1@
        !           286:        movl    a0@,_dtpr_str                   |advance free list
        !           287: storit:        movl    a2@-,a0@                        |store in cdr
        !           288:        movl    a2@-,a0@(4)                     |store in car
        !           289:        movl    a0,d0
        !           290:        rts
        !           291: 
        !           292: getnew:        movl    a2,_np
        !           293:        jsr     _newdot                         |must gc to get one
        !           294:        jra     storit                          |now initialize it.
        !           295: 
        !           296: /*
        !           297:  * Fast equivalent of newdot, entered by jsb
        !           298:  */
        !           299: 
        !           300:        .globl  _qnewdot
        !           301: _qnewdot:
        !           302:        Profile
        !           303:        movl    _dtpr_str,a0                    |mov next cell addr t0 r0
        !           304:        NILtest(a0)
        !           305:        jmi     mustallo                        |if ran out of space
        !           306: 
        !           307:        movl    a0,sp@-
        !           308:        movl    28*4+_lispsys,a0                |inc count of dtprs
        !           309:        addql   #1,a0@
        !           310:        movl    sp@+,a0
        !           311: 
        !           312:        movl    a0@,_dtpr_str                   |advance free list
        !           313:        clrl    a0@                             |clrq (r0)
        !           314:        clrl    a0@(4)
        !           315:        rts
        !           316: mustallo:
        !           317:        movl    a2,_np                          |gc could occur
        !           318:        jsr     _newdot
        !           319:        rts
        !           320: 
        !           321: 
        !           322: /*
        !           323:  * this is called exactly like popnames would be from C
        !           324:  * but has been carefully improved so that it doesn't
        !           325:  * have to alter the stack.
        !           326:  */
        !           327:        .globl  _qpopnames
        !           328: _qpopnames:
        !           329:        movl    _bnp,a1
        !           330:        movl    sp,a0
        !           331:        movl    a0@(4),d0
        !           332:        jra     .L130
        !           333: .L20001:
        !           334:        movl    a1@(4),a0
        !           335:        movl    a1@,a0@
        !           336: .L130:
        !           337:        subql   #8,a1
        !           338:        cmpl    a1,d0
        !           339:        jls     .L20001
        !           340:        movl    a1,_bnp
        !           341:        rts
        !           342: 
        !           343: /*
        !           344:  * _qget : fast get subroutine
        !           345:  *  (get 'atom 'ind)
        !           346:  * called with a2@(-8) equal to the atom
        !           347:  *            a2@(-4) equal to the indicator
        !           348:  * no assumption is made about _lbot
        !           349:  * unfortunately, the atom may not in fact be an atom, it may
        !           350:  * be a list or nil, which are special cases.
        !           351:  * For nil, we grab the nil property list (stored in a special place)
        !           352:  * and for lists we punt and call the C routine since it is  most likely
        !           353:  * and error and we havent put in error checks yet.
        !           354:  */
        !           355: 
        !           356:        .globl  _qget
        !           357: _qget:
        !           358:        Profile
        !           359:        movl    a2@(-4),a1                      |put indicator in a1
        !           360:        movl    a2@(-8),a0                      |and atom into a0
        !           361:        cmpl    a0,d7
        !           362:        jeq     nilpli                          |jump if atom is nil
        !           363:        movl    a0,d0                           |check type
        !           364:        NILsub(d0)
        !           365:        movl    #9,d1
        !           366:        asrl    d1,d0
        !           367:        lea     _typetable+1,a5
        !           368:        cmpb    #/**/ATOM,a5@(0,d0:L)           |is it a symbol??
        !           369:        jne     notsymb                         |nope
        !           370:        movl    a0@(4),a0                       |yes, put prop list in
        !           371:                                                |       a0 to begin scan
        !           372:        cmpl    a0,d7
        !           373:        jeq     fail                            |if no prop list,
        !           374:                                                |       we lose right away
        !           375: lp:    cmpl    a0@(4),a1                       |is car of list = to indicator?
        !           376:        jeq     good                            |jump if so
        !           377:        movl    a0@,a0                          |else cddr
        !           378:        movl    a0@,a0                          |       down list
        !           379:        cmpl    a0,d7
        !           380:        jne     lp                              |and jump if more list to go.
        !           381: 
        !           382: fail:  movl    a0,d0
        !           383:        subql   #8,a2
        !           384:        rts                                     |return with a0 eq to nil
        !           385: 
        !           386: good:  movl    a0@,a0                          |return cadr of list
        !           387:        movl    a0@(4),d0
        !           388:        subql   #8,a2
        !           389:        rts
        !           390: 
        !           391: nilpli:        movl    64*4+_lispsys,a0                |want nil prop list,
        !           392:                                                |       get it specially
        !           393:        cmpl    a0,d7
        !           394:        jne     lp                              |and process if anything there
        !           395:        movl    a0,d0
        !           396:        subql   #8,a2
        !           397:        rts                                     |else fail
        !           398:        
        !           399: notsymb:
        !           400:        lea     a2@(-8),a0                      |set up lbot before callin
        !           401:        movl    a0,_lbot
        !           402:        movl    a2,_np
        !           403:        jsr     _Lget                           |not a symbol, call C routine
        !           404:                                                |       to error check
        !           405:        subql   #8,a2
        !           406:        rts                                     |and return what it returned.
        !           407: 
        !           408: 
        !           409: /*
        !           410:  *  prunel  - return a list of dtpr cells to the free list
        !           411:  * this is called by the pruneb after it has discarded the top bignum 
        !           412:  * the dtpr cells are linked through their cars not their cdrs.
        !           413:  * this returns with an rsb
        !           414:  *
        !           415:  * method of operation: the dtpr list we get is linked by car's so we
        !           416:  * go through the list and link it by cdr's, then have the last dtpr
        !           417:  * point to the free list and then make the free list begin at the
        !           418:  * first dtpr.
        !           419:  */
        !           420: qprunel:
        !           421:        movl    a0,d0                           |remember first dtpr location
        !           422:        movl    28*4+_lispsys,a1                |dec count of dtprs
        !           423: rep:   
        !           424:        subql   #1,a2@
        !           425:        movl    a0@(4),a0@                      |make cdr (forward lnk) == car
        !           426:        jeq     endoflist                       |if nil, then end of list
        !           427:        movl    a0@,a0                          |advance to next dtpr
        !           428:        jra     rep                             |and loop around
        !           429: endoflist:
        !           430:        movl    _dtpr_str,a0@                   |make last 1 pnt to free list
        !           431:        movl    d0,_dtpr_str                    |& free list begin at 1st one
        !           432:        rts
        !           433: 
        !           434: /*
        !           435:  * qpruneb - called by the arithmetic routines to free an sdot and the dtprs
        !           436:  * which hang on it.
        !           437:  * called by
        !           438:  *     pushl   sdotaddr
        !           439:  *     jsb     _qpruneb
        !           440:  */
        !           441:        .globl  _qpruneb
        !           442: _qpruneb:
        !           443:        Profile
        !           444:        movl    48*4+_lispsys,a0                |decr count of used sdots
        !           445:        subql   #1,a0@
        !           446:        movl    sp@(4),a0                       |get address
        !           447:        movl    _sdot_str,a0@                   |have new sdot pnt to free lst
        !           448:        movl    a0,_sdot_str                    |strt free list at new sdot
        !           449:        movl    a0@(4),a0                       |get address of first dtpr
        !           450:        jne     qprunel                         |if exists, prune it
        !           451:        rts                                     |else return.
        !           452: 
        !           453: 
        !           454: /*
        !           455:  * _qprunei     
        !           456:  *     called by the arithmetic routines to free a fixnum cell
        !           457:  * calling sequence
        !           458:  *     pushl   fixnumaddr
        !           459:  *     jsb     _qprunei
        !           460:  */
        !           461: 
        !           462:        .globl  _qprunei
        !           463: _qprunei:
        !           464:        Profile
        !           465:        movl    a1,sp@-
        !           466:        movl    sp@(4),a0                       |get address of fixnum
        !           467:        cmpl    #4*1023+_Fixzero,a0             |is it a small fixnum
        !           468:        jmi     skipit                          |if so, leave
        !           469:        movl    24*4+_lispsys,a1                |decr count of used ints
        !           470:        subql   #1,a1@
        !           471:        movl    _int_str,a0@                    |link the fixnum into the
        !           472:                                                |  free list
        !           473:        movl    a0,_int_str
        !           474: skipit:
        !           475:        movl    sp@+,a1
        !           476:        rts
        !           477: Iclear:
        !           478:        clrl    d0
        !           479:        rts
        !           480:        .text
        !           481:        .globl  _Itstbt
        !           482: _Itstbt:
        !           483:        movl    a5,d1
        !           484:        NILsub(d1)
        !           485:        lsrl    #2,d1
        !           486:        movl    d1,d0
        !           487:        andl    #7,d0
        !           488:        lsrl    #3,d1
        !           489:        lea     _bitmapi,a0
        !           490:        bset    d0,a0@(0,d1:L)
        !           491:        beq     .L14
        !           492:        moveq   #1,d0
        !           493:        bra     .L12
        !           494: .L14:
        !           495:        clrl    d0
        !           496: .L12:  rts
        !           497: 
        !           498: /*
        !           499:  * this routine returns an assembly language entry pt.
        !           500:  * it is put here to match the vax verison.
        !           501:  */
        !           502:        .globl  _gstart
        !           503:        .globl  _proflush
        !           504: _gstart:
        !           505:        movl    #start,d0
        !           506: _proflush:
        !           507:        rts
        !           508: /*
        !           509:  * The definition of mcount must be present even when the C code
        !           510:  * isn't being profiled, since lisp code may reference it.
        !           511:  */
        !           512: .globl _mcount
        !           513: #ifdef SunGotItsActTogetherAboutTakingMcountOutOfCrt0 
        !           514: .globl mcount
        !           515: #endif
        !           516: 
        !           517: _mcount:
        !           518: mcount:
        !           519: #ifdef PROF
        !           520:        movl    a0@,a1
        !           521:        jne     incr
        !           522:        movl    _countbase,a1
        !           523:        jeq     return
        !           524:        addql   #8,_countbase
        !           525:        movl    sp@,a1@+
        !           526:        movl    a1,a0@
        !           527: incr:
        !           528:        addql   #1,a1@
        !           529: return:
        !           530: #endif
        !           531:        rts
        !           532: 
        !           533: /*
        !           534:  * pushframe : stack a frame 
        !           535:  * When this is called, the optional arguments and class have already been
        !           536:  * pushed on the stack as well as the return address (by virtue of the jsb)
        !           537:  * , we push on the rest of the stuff (see h/frame.h)
        !           538:  * for a picture of the save frame
        !           539:  */
        !           540:        .globl  _pushframe
        !           541:        .globl  _qpushframe
        !           542:        .globl  _Pushframe
        !           543: _pushframe:
        !           544: _qpushframe:
        !           545: _Pushframe:
        !           546:        movl    sp@,a0
        !           547:        movl    _errp,sp@-
        !           548:        movl    _bnp,sp@-
        !           549:        movl    _np,sp@-
        !           550:        movl    _lbot,sp@-
        !           551:        movl    sp,d0           | return addr of lbot on stack
        !           552:        subl    #56,sp
        !           553:        moveml  #0x7cfc,sp@(12) | save fp,a5-a2,d7-d2
        !           554:        clrl    _retval         | set retval to C_INITIAL
        !           555: #ifdef SPISFP
        !           556:        subl    #8,sp
        !           557:        movl    _xsp,sp@(16)    
        !           558:        movl    sp,sp@(12)
        !           559: #endif
        !           560:        jmp     a0@             | return through return address
        !           561: 
        !           562: #ifdef SPISFP
        !           563: /*
        !           564:  * This is necessary on the sun-II beta testing version since the C
        !           565:  * compiler makes refence to temporaries and restoring registers relative
        !           566:  * to the stack pointer.  See explicative comments in ../vax/qfuncl.c
        !           567:  * for Iretfrm and Ipushf
        !           568:  */
        !           569:        .globl  _Ipushf
        !           570: _Ipushf:
        !           571:        movl    sp@(16),a0
        !           572:        addl    #96,a0
        !           573:        movl    sp@(12),a0@-
        !           574:        movl    sp@(8),a0@-
        !           575:        movl    sp@(4),a0@-
        !           576:        movl    sp@,a0@-
        !           577:        movl    _errp,a0@-
        !           578:        movl    _bnp,a0@-
        !           579:        movl    _np,a0@-
        !           580:        movl    _lbot,a0@-
        !           581:        movl    a0,d0           | return addr of lbot on stack
        !           582:        moveml  #0x7cfc,a0@(-44)        | save fp,a5-a2,d7-d2
        !           583:        movl    _xsp,a0@(-48)
        !           584:        movl    sp,a0@(-52)
        !           585:        clrl    _retval         | set retval to C_INITIAL
        !           586:        rts
        !           587: #endif
        !           588: 
        !           589: /*
        !           590:  * qretfromfr
        !           591:  * called with frame to ret to in a5.  The popnames has already been done.
        !           592:  * we must restore all registers, and jump to the ret addr. the popping
        !           593:  * must be done without reducing the stack pointer since an interrupt
        !           594:  * could come in at any time and this frame must remain on the stack.
        !           595:  * thus we can't use popr.
        !           596:  */
        !           597: 
        !           598:        .globl  _qretfromfr
        !           599: 
        !           600: _qretfromfr:
        !           601:        movl    a5,d0                   | return error frame location
        !           602:        movl    a5,a0                   | prepare to pop off
        !           603:        moveml  a0@(-44),#0x7cfc        | restore registers
        !           604: #ifndef SPISFP
        !           605:        lea     a0@(-56),sp
        !           606:        movl    a0@+,_lbot
        !           607:        movl    a0@+,_np
        !           608:        movl    a0@(8),a0               | return address
        !           609:        jmp     a0@
        !           610: #else
        !           611:        movl    a0@(-52),sp
        !           612:        movl    a0@(-48),_xsp
        !           613:        movl    a0@+,_lbot
        !           614:        movl    a0@+,_np
        !           615:        movl    a0@(8),sp@              | return address
        !           616:        rts
        !           617: #endif
        !           618: 
        !           619: /*
        !           620:  * Ancillary code for small thunks generated so that
        !           621:  * c routines can be passed the address of something
        !           622:  * to call which will pass onto lisp functions
        !           623:  */
        !           624:        .globl  _thcpy
        !           625: _thcpy:
        !           626:        movl    sp@,a0
        !           627:        movl    a0@+,sp@-
        !           628:        movl    a0@+,sp@-
        !           629:        jsr     _dothunk
        !           630:        lea     sp@(12),sp
        !           631:        rts
        !           632: #ifndef SPISFP
        !           633: /* Copyright (c) 1982, Regents, University of California
        !           634:    This is here because for the sun II beta test version, you
        !           635:    can't do alloca */
        !           636:        .text
        !           637:        .globl  _alloca
        !           638: _alloca:
        !           639:        movl    sp@,d0
        !           640:        movl    sp@(4),d1
        !           641:        subl    #1,d1
        !           642:        orl     #3,d1
        !           643:        addl    #1,d1
        !           644:        subl    d1,sp
        !           645:        tstb    sp@(-132)
        !           646:        movl    d0,sp@
        !           647:        movl    sp,d0
        !           648:        addl    #8,d0
        !           649:        rts
        !           650: 
        !           651: #endif
        !           652:        .globl  _vlsub
        !           653: _vlsub:
        !           654:        movl    sp@(4),a0
        !           655:        addql   #8,a0
        !           656:        movl    sp@(8),a1
        !           657:        addql   #8,a1   | this should clear the carry bit.
        !           658: #if sun_4_1c || sun_4_2beta
        !           659:        subxl   a0@-,a1@-
        !           660:        subxl   a0@-,a1@-
        !           661: #else
        !           662:        subxl   a1@-,a0@-       | This is the correct version
        !           663:        subxl   a1@-,a0@-
        !           664: #endif
        !           665:        rts
        !           666: 
        !           667: /*
        !           668:  * We want to be able to redefine read and write to check
        !           669:  * certain lisp values.  Rather than have 4 variants, we
        !           670:  * put the assembly language (obtained by adb rather than
        !           671:  * violating source) here under ifdef control.
        !           672:  */
        !           673: 
        !           674: 
        !           675: .globl __read
        !           676: .globl __write
        !           677: 
        !           678: #if sun_4_1c || sun_4_2beta || sun_4_2
        !           679: .globl _vadvise
        !           680: __read:
        !           681:        pea     3:w
        !           682:        jmp     _docall
        !           683: __write:
        !           684:        pea     4:w
        !           685: _docall:
        !           686:        trap    #0
        !           687:        bcss   _bad
        !           688: _vadvise:
        !           689: #endif
        !           690: #ifdef os_masscomp
        !           691: __read:
        !           692:        moveq    #0x3,d0
        !           693:        jmp     _docall
        !           694: __write:
        !           695:        moveq    #0x4,d0
        !           696: _docall:
        !           697:        movl    a7@(4),d1
        !           698:        movl    a7@(8),a0
        !           699:        movl    a7@(12),a1
        !           700:        trap    #0
        !           701:        bcss    _bad
        !           702: #endif
        !           703: #ifdef os_unisoft || os_unix_ts
        !           704:        .globl  _vfork
        !           705: _vfork:
        !           706:        jmp     _fork
        !           707: __read:
        !           708:        movw    #0x3,d0
        !           709:        jmp     _docall
        !           710: __write:
        !           711:        movw    #0x4,d0
        !           712: _docall:
        !           713:        movl    a7@(4),a0
        !           714:        movl    a7@(8),d1
        !           715:        movl    a7@(12),a1
        !           716:        trap    #0x0
        !           717:        bcs     _bad
        !           718: #endif
        !           719:        rts
        !           720: _bad:
        !           721:        jmp     cerror
        !           722: 
        !           723: /* This must be at the end of the file.  If we are profiling, allocate
        !           724:  * space for the profile buffer
        !           725:  */
        !           726: #ifdef PROF
        !           727:        .data
        !           728:        .comm   _countbase,4
        !           729:        .lcomm  prbuf,indx+4
        !           730:        .text
        !           731: #endif

unix.superglobalmegacorp.com

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