2.11BSD#431 - /usr/src/new/OLD/lisp11/macro.m11

   1: ; Copyright (c) 1981 Harvard-Radcliffe Student Timesharing System
   2: ; Science Center, Harvard University
   3:         .nlist
   4: 
   5:         .page
   6:         .sbttl  general macro file for lisp-11          fwh
   7:         ;these macros make the creation of the
   8:         ;start up state of the language easier and more
   9:         ;flexible than hand coding
  10: 
  11: .sbttl  lower case ascii macro--asclc
  12: 
  13: .macro .asclc, str
  14:         .nlist meb
  15: 
  16:         .irpc x, ^%str%
  17: 
  18:         .if ge ''x-101
  19:                 .if le ''x-132
  20:                         .byte ''x+40
  21:                 .iff
  22:                         .byte ''x
  23:                 .endc
  24:         .iff
  25:         .byte ''x
  26:         .endc
  27: 
  28:         .endm
  29: 
  30:         .byte   0
  31:         .list meb
  32: .endm
  33: 
  34: 
  35: 
  36: .macro  defobl  list
  37:         obl'list=anil
  38: .endm
  39: 
  40: .macro  dumphash        list
  41:         obl'list
  42: .endm
  43: 
  44: 
  45: .if     ndf,mdef
  46:         mdef=1
  47: 
  48: 
  49: .macro  cons    x,y
  50:         .psect  ddtpr con
  51:         ddtpr=.
  52:         x
  53:         y
  54: .endm
  55: .macro  atom    name,lab,tlb,plist,fnb,funhsh
  56:         .psect  datom con
  57:         datom=.
  58:         .if     nb,lab
  59:                 lab:
  60:         .endc
  61:         .if     nb,plist
  62:          .ift
  63:                  plist
  64:          .iff
  65:                  anil
  66:         .endc
  67:         .if     nb,tlb
  68:          .ift
  69:                  tlb
  70:          .iff
  71:         anil
  72:         .endc
  73:         .if     nb,fnb
  74:          .ift
  75:                  fnb
  76:          .iff
  77:                  anil
  78:         .endc
  79:         .asclc  name
  80:         .even
  81:         chash=0
  82:         .irpc char,^%name%
  83:                 atxor   char
  84:         .endr
  85:         chash=chash&hashm
  86:         atom1   \chash
  87: .if     ne,xfer
  88:   .if   nb,fnb
  89:         .psect  bcdmap,con
  90: 
  91:         .word   fnb,datom
  92:   .endc
  93: .endc
  94: 
  95: .endm
  96: 
  97: 
  98: .macro  atxor   x
  99:         .if ge ''x-101
 100:                 .if le ''x-132
 101:                         v= ''x+40
 102:                 .iff
 103:                         v= ''x
 104:                 .endc
 105:         .iff
 106:         v= ''x
 107:         .endc
 108: 
 109:         chash=<chash&<^c v>>!<v&<^c chash>>
 110: .endm
 111: 
 112: 
 113: .macro  atom1   list
 114:         .if     eq,hash
 115:          .ift
 116:                 cons    datom,oblist
 117:                 oblist=ddtpr
 118:          .iff
 119:                 cons    datom,obl'list
 120:                 obl'list=ddtpr
 121:         .endc
 122: .endm
 123: 
 124: .macro  car     x,y     ;;leaves car of x in y
 125:         mov     @x,y
 126: .endm
 127: .macro  cdr     x,y
 128:         .ntype  tmp,x
 129:         .if     eq,tmp&70
 130:          mov 2(%<7&tmp>),y
 131:         .mexit
 132:         .endc
 133:         mov     x,y
 134:         add     #2,y
 135:         mov     @y,y
 136: .endm
 137: .macro subr     x,y
 138:         atom    x,,,,y
 139: .endm
 140: .macro propush  x
 141:                  push x
 142:                  inc (sp)
 143: .endm
 144: .macro push     x
 145:         mov     x,-(sp)         ;;only good for cstk push;not for npush
 146: .endm
 147: .macro  pop     x
 148:         mov (sp)+,x
 149: .endm
 150: .macro call     x
 151:         jsr     pc,x
 152: .endm
 153: .macro ret
 154:         rts     pc
 155: .endm
 156: .macro pushj    x
 157:         jsr     pc,x
 158: .endm
 159: .macro popj
 160:         rts     pc
 161: .endm
 162: 
 163: .macro  brifsmalint     a,b
 164:         .if     eq,smlint
 165:                 .ift
 166:                 .mexit
 167:                 .iff
 168:                  cmp    a,#-^d1300      ;add a few for good measure
 169:                  bhis   b
 170:         .endc
 171: .endm
 172: .macro unpropop x
 173:         .ntype  tmp,x
 174:         .if     eq,tmp&70
 175:          .ift
 176:             pop x
 177:             dec x
 178:          .iff
 179:             dec  (sp)
 180:             pop    x
 181:         .endc
 182: .endm
 183: .macro  cmptype s,r,v
 184:         .if     nb,v
 185:          mov    s,r
 186:          cmpty1 r,v
 187:          .mexit
 188:         .endc
 189:         cmpty1  s,r
 190: .endm
 191: 
 192: .macro  cmpty1  r,v
 193:         clrb    r
 194:         swab    r
 195:         .if     idn,0,v
 196:          .ift
 197:           tstb  qmap(r)
 198:          .iff
 199:           cmpb  qmap(r),v
 200:          .endc
 201: .endm
 202: 
 203: .macro  ldtype  x,y
 204:         .if     nb,y
 205:           mov   x,y
 206:           ldtyp1        y
 207:           .mexit
 208:         .endc
 209:         ldtyp1  x
 210: .endm
 211: .macro  ldtyp1  x
 212:         clrb    x
 213:         swab    x
 214:         movb    qmap(x),x
 215: .endm
 216: .macro  consa
 217:         call    xconsa
 218: .endm
 219: .macro  consb
 220:         call    xconsb
 221: .endm
 222: .macro  consbnil
 223: .if     ne,nilas0
 224:         call    xconsb-2
 225:   .iff
 226:         call    xconsb-4
 227: .endc
 228: .endm
 229: .macro  getc
 230:         call    xgetc
 231: .endm
 232: .macro  savec
 233:         call    xsavec
 234: .endm
 235: .macro  jmpifnil        x,y,z
 236: .if     ne,nilas0
 237:    .if  b,z
 238:         tst     x
 239:     .endc
 240: .iff
 241:         cmp     x,#anil
 242: .endc
 243:         beq     y
 244: .endm
 245: 
 246: .macro  jmpnnil a,bb,c
 247: .if     eq,nilas0
 248:         cmp     a,#anil
 249:   .iff
 250:         .if     b,c
 251:         tst     a
 252:         .endc
 253: .endc
 254:         bne     bb
 255: .endm
 256: 
 257: .macro  jmpift  x,y
 258:         cmp     x,#atrue
 259:                    beq  y
 260: .endm
 261: 
 262: .macro  loadnil x
 263:  .if    ne,nilas0
 264:         clr     x
 265:   .iff
 266:         mov     #anil,x
 267: .endc
 268: .endm
 269: .macro  goto    x
 270:         jmp     x
 271: .endm
 272: .macro  npush   x
 273:         cmp     np,nplim
 274:         blo     .+6
 275:         call    nperror
 276:         tst     (np)+
 277: .if     ne,nilas0
 278:         clr     (np)+
 279:  .iff
 280:         mov     #anil,(np)+
 281: .endc
 282: .if     ne,nilas0
 283:   .if   idn,x,#anil
 284:         clr     @np
 285:       .iff
 286:         mov     x,@np
 287:  .endc
 288:   .iff
 289:         mov     x,@np
 290: .endc
 291: .endm
 292: .macro  npop    x
 293:         mov     @np,x
 294:         cmp     -(np),-(np)
 295: .endm
 296: .macro  numga
 297:         call    xnum1
 298: .endm
 299: .macro  numgj1
 300:         call    xnum2
 301: .endm
 302: 
 303: .macro  numga0
 304:         .globl  xnumg0
 305:         call xnumg0
 306: .endm
 307: 
 308: .macro  numga1
 309:         .globl  xnumg1
 310:         call    xnumg1
 311: .endm
 312: 
 313: .macro  nmstore
 314:         call    xnums
 315: .endm
 316: .macro  retnil
 317: .if     ne,nilas0
 318:         clr     a
 319:         ret
 320:   .iff
 321:         jmp     $retnil
 322:         .globl  $retnil
 323: .endc
 324: .endm
 325: .macro  rettrue
 326:         jmp     $rettrue
 327: .endm
 328: 
 329: .macro  numstac0
 330:         .globl  xnumsac0
 331:         call    xnumsac0
 332: .endm
 333: 
 334: .macro  error   msg,where
 335:         generm  <'msg'>
 336:         mov     #tmp-<^pl errorm>,a
 337:         .if     b,where
 338:         .ift
 339:         jmp     cantcont
 340:         .iff
 341:         push    #where
 342:         jmp     errort
 343: .endc
 344: .endm
 345: 
 346: 
 347: .macro  getca
 348:         call    xgetca
 349: .endm
 350: .macro  dispatch
 351:         call    xdispa
 352: .endm
 353: .macro outstr   x
 354:         mov     #'x,b
 355:         call    putstr          ;;to port on top of nstk
 356: .endm
 357: 
 358: 
 359: 
 360: .if     eq,multiseg
 361:  .ift
 362:   .macro        subrbeg l,a,b,litlist
 363:         .rsect  dsubr con
 364:   l:
 365:         .if     idn lambda,a
 366:          .ift
 367:           subtmp=b*1000
 368:          .iff
 369:           subtmp=100000!<b*1000>
 370:          .endc
 371:          subloc=.
 372:          .if    nb,litlist
 373:           .word 0,litlist
 374:          .iff
 375:           .word 0,anil
 376:          .endc
 377:   .endm
 378: 
 379: 
 380:   .macro        subrend
 381:         tmp=.
 382:         .=subloc
 383:         .word   subtmp!<<tmp-subloc>>
 384:         .=tmp
 385: 
 386:   .endm
 387: 
 388: 
 389: .iff
 390: 
 391: 
 392:   .macro        subrbeg l,ty,arf,litlist
 393:         .psect  shrcode
 394:         tmp=.
 395:         .psect  dsubr
 396:         .if     eq,<<.-starbc>&377>-374
 397:          .word  0,0
 398:         .endc
 399:         .if     idn ty,lambda
 400:   l:     .word arf*1000
 401:         .iff
 402:   l:     .word <100000!<arf*1000>>
 403:         .endc
 404:         .if     nb,litlist
 405:           .word litlist,tmp
 406:         .iff
 407:           .word anil,tmp
 408:         .endc
 409:         .rsect  shrcode
 410: .endm
 411: 
 412: .macro  subrend
 413: .endm
 414: 
 415: .endc
 416: 
 417: .macro  chanl
 418:         jsr     %7,chanl
 419: .endm
 420: 
 421: .macro  chas
 422:         jsr     %7,chas
 423: .endm
 424: 
 425: 
 426: 
 427: .macro  .rsect  sect,con
 428:         .if     idn,shrcode,sect
 429:         remsect=0
 430:         .endc
 431:         .if     idn,shrcod,sect
 432:         remsect=0
 433:         .endc
 434:         .if     idn,dsubr,sect
 435:         remsect=1
 436:         .endc
 437:         .if     idn,initcd,sect
 438:         remsect=2
 439:         .endc
 440:         .if     idn,onepage,sect
 441:         remsect=3
 442:         .endc
 443:         .psect  sect    con
 444: .endm
 445: 
 446: .macro  rsect
 447:         .if     eq,remsect
 448:         .psect  shrcode con
 449:         .endc
 450:         .if     eq,remsect-1
 451:         .psect  dsubr   con
 452:         .endc
 453:         .if     eq,remsect-2
 454:         .psect  initcd  con
 455:         .endc
 456:         .if     eq,remsect-3
 457:         .psect  onepage con
 458:         .endc
 459: .endm
 460: 
 461: .macro  generm  msg
 462:         .psect  errorm con
 463:         tmp=* .
 464:         .asciz  msg
 465:         rsect
 466: .endm
 467: ;
 468: ;	;these should only be used if ctable is not
 469: ;	;redifined (as does the system lisp)!!!!!!!!!!!!
 470: ;
 471: ;;isalph branches to where if r (a register) is a-z,and a few others
 472: ;
 473: ;
 474: ;
 475: ;.macro	isalph	r,where
 476: ;	bic	#177400,r
 477: ;	bitb	#2,ctable(r)
 478: ;	bne	where
 479: ;.endm
 480: ;
 481: ;;isnum branches to where if r is number
 482: ;
 483: ;.macro	isnum	r,where
 484: ;	bic	#177400,r
 485: ;	bitb	#10,ctable(r)
 486: ;	bne	where
 487: ;.endm
 488: ;
 489: ;
 490: ;;issep branches to where if space, tab, cr, lf, ...
 491: ;
 492: ;.macro	issep	r,where
 493: ;	bic	#177400,r
 494: ;	bitb	#4,ctable(r)
 495: ;	bne	where
 496: ;.endm
 497: ;
 498: ;;macro isbrk branches to where if sep of (,),.,[,]
 499: ;
 500: ;.macro	isbrk	r,where
 501: ;	bic	#177400,r
 502: ;	tstb	ctable(r)
 503: ;	blt	where
 504: ;.endm
 505: ;
 506: ;
 507: ;;macro isalnum	branches to where if r is a-z and feq others, or 0-9
 508: ;
 509: ;.macro	isalnum	r,where
 510: ;	bic	#177400,r
 511: ;	bitb	#12,ctable(r)
 512: ;	bne	where
 513: ;.endm
 514: ;
 515: .endc                           ;match original conditional
 516: 
 517:         .list
 518: 
 519: .macro  save1
 520:         call    xsave1
 521: .endm
 522: 
 523: .macro  save2
 524:         call    xsave2
 525: .endm
 526: 
 527: .macro  save3
 528:         call    xsave3
 529: .endm
 530: 
 531: .macro  save4
 532:         call    xsave4
 533: .endm
 534: 
 535: .macro saveret
 536:         mov     (sp),pc
 537: .endm