2.9BSD/usr/src/ucb/lisp/v7source/macro.m11
; Copyright (c) 1981 Harvard-Radcliffe Student Timesharing System
; Science Center, Harvard University
.nlist
.page
.sbttl general macro file for lisp-11 fwh
;these macros make the creation of the
;start up state of the language easier and more
;flexible than hand coding
.sbttl lower case ascii macro--asclc
.macro .asclc, str
.nlist meb
.irpc x, ^%str%
.if ge ''x-101
.if le ''x-132
.byte ''x+40
.iff
.byte ''x
.endc
.iff
.byte ''x
.endc
.endm
.byte 0
.list meb
.endm
.macro defobl list
obl'list=anil
.endm
.macro dumphash list
obl'list
.endm
.if ndf,mdef
mdef=1
.macro cons x,y
.psect ddtpr con
ddtpr=.
x
y
.endm
.macro atom name,lab,tlb,plist,fnb,funhsh
.psect datom con
datom=.
.if nb,lab
lab:
.endc
.if nb,plist
.ift
plist
.iff
anil
.endc
.if nb,tlb
.ift
tlb
.iff
anil
.endc
.if nb,fnb
.ift
fnb
.iff
anil
.endc
.asclc name
.even
chash=0
.irpc char,^%name%
atxor char
.endr
chash=chash&hashm
atom1 \chash
.if ne,xfer
.if nb,fnb
.psect bcdmap,con
.word fnb,datom
.endc
.endc
.endm
.macro atxor x
.if ge ''x-101
.if le ''x-132
v= ''x+40
.iff
v= ''x
.endc
.iff
v= ''x
.endc
chash=<chash&<^c v>>!<v&<^c chash>>
.endm
.macro atom1 list
.if eq,hash
.ift
cons datom,oblist
oblist=ddtpr
.iff
cons datom,obl'list
obl'list=ddtpr
.endc
.endm
.macro car x,y ;;leaves car of x in y
mov @x,y
.endm
.macro cdr x,y
.ntype tmp,x
.if eq,tmp&70
mov 2(%<7&tmp>),y
.mexit
.endc
mov x,y
add #2,y
mov @y,y
.endm
.macro subr x,y
atom x,,,,y
.endm
.macro propush x
push x
inc (sp)
.endm
.macro push x
mov x,-(sp) ;;only good for cstk push;not for npush
.endm
.macro pop x
mov (sp)+,x
.endm
.macro call x
jsr pc,x
.endm
.macro ret
rts pc
.endm
.macro pushj x
jsr pc,x
.endm
.macro popj
rts pc
.endm
.macro brifsmalint a,b
.if eq,smlint
.ift
.mexit
.iff
cmp a,#-^d1300 ;add a few for good measure
bhis b
.endc
.endm
.macro unpropop x
.ntype tmp,x
.if eq,tmp&70
.ift
pop x
dec x
.iff
dec (sp)
pop x
.endc
.endm
.macro cmptype s,r,v
.if nb,v
mov s,r
cmpty1 r,v
.mexit
.endc
cmpty1 s,r
.endm
.macro cmpty1 r,v
clrb r
swab r
.if idn,0,v
.ift
tstb qmap(r)
.iff
cmpb qmap(r),v
.endc
.endm
.macro ldtype x,y
.if nb,y
mov x,y
ldtyp1 y
.mexit
.endc
ldtyp1 x
.endm
.macro ldtyp1 x
clrb x
swab x
movb qmap(x),x
.endm
.macro consa
call xconsa
.endm
.macro consb
call xconsb
.endm
.macro consbnil
.if ne,nilas0
call xconsb-2
.iff
call xconsb-4
.endc
.endm
.macro getc
call xgetc
.endm
.macro savec
call xsavec
.endm
.macro jmpifnil x,y,z
.if ne,nilas0
.if b,z
tst x
.endc
.iff
cmp x,#anil
.endc
beq y
.endm
.macro jmpnnil a,bb,c
.if eq,nilas0
cmp a,#anil
.iff
.if b,c
tst a
.endc
.endc
bne bb
.endm
.macro jmpift x,y
cmp x,#atrue
beq y
.endm
.macro loadnil x
.if ne,nilas0
clr x
.iff
mov #anil,x
.endc
.endm
.macro goto x
jmp x
.endm
.macro npush x
cmp np,nplim
blo .+6
call nperror
tst (np)+
.if ne,nilas0
clr (np)+
.iff
mov #anil,(np)+
.endc
.if ne,nilas0
.if idn,x,#anil
clr @np
.iff
mov x,@np
.endc
.iff
mov x,@np
.endc
.endm
.macro npop x
mov @np,x
cmp -(np),-(np)
.endm
.macro numga
call xnum1
.endm
.macro numgj1
call xnum2
.endm
.macro numga0
.globl xnumg0
call xnumg0
.endm
.macro numga1
.globl xnumg1
call xnumg1
.endm
.macro nmstore
call xnums
.endm
.macro retnil
.if ne,nilas0
clr a
ret
.iff
jmp $retnil
.globl $retnil
.endc
.endm
.macro rettrue
jmp $rettrue
.endm
.macro numstac0
.globl xnumsac0
call xnumsac0
.endm
.macro error msg,where
generm <'msg'>
mov #tmp-<^pl errorm>,a
.if b,where
.ift
jmp cantcont
.iff
push #where
jmp errort
.endc
.endm
.macro getca
call xgetca
.endm
.macro dispatch
call xdispa
.endm
.macro outstr x
mov #'x,b
call putstr ;;to port on top of nstk
.endm
.if eq,multiseg
.ift
.macro subrbeg l,a,b,litlist
.rsect dsubr con
l:
.if idn lambda,a
.ift
subtmp=b*1000
.iff
subtmp=100000!<b*1000>
.endc
subloc=.
.if nb,litlist
.word 0,litlist
.iff
.word 0,anil
.endc
.endm
.macro subrend
tmp=.
.=subloc
.word subtmp!<<tmp-subloc>>
.=tmp
.endm
.iff
.macro subrbeg l,ty,arf,litlist
.psect shrcode
tmp=.
.psect dsubr
.if eq,<<.-starbc>&377>-374
.word 0,0
.endc
.if idn ty,lambda
l: .word arf*1000
.iff
l: .word <100000!<arf*1000>>
.endc
.if nb,litlist
.word litlist,tmp
.iff
.word anil,tmp
.endc
.rsect shrcode
.endm
.macro subrend
.endm
.endc
.macro chanl
jsr %7,chanl
.endm
.macro chas
jsr %7,chas
.endm
.macro .rsect sect,con
.if idn,shrcode,sect
remsect=0
.endc
.if idn,shrcod,sect
remsect=0
.endc
.if idn,dsubr,sect
remsect=1
.endc
.if idn,initcd,sect
remsect=2
.endc
.if idn,onepage,sect
remsect=3
.endc
.psect sect con
.endm
.macro rsect
.if eq,remsect
.psect shrcode con
.endc
.if eq,remsect-1
.psect dsubr con
.endc
.if eq,remsect-2
.psect initcd con
.endc
.if eq,remsect-3
.psect onepage con
.endc
.endm
.macro generm msg
.psect errorm con
tmp=* .
.asciz msg
rsect
.endm
;
; ;these should only be used if ctable is not
; ;redifined (as does the system lisp)!!!!!!!!!!!!
;
;;isalph branches to where if r (a register) is a-z,and a few others
;
;
;
;.macro isalph r,where
; bic #177400,r
; bitb #2,ctable(r)
; bne where
;.endm
;
;;isnum branches to where if r is number
;
;.macro isnum r,where
; bic #177400,r
; bitb #10,ctable(r)
; bne where
;.endm
;
;
;;issep branches to where if space, tab, cr, lf, ...
;
;.macro issep r,where
; bic #177400,r
; bitb #4,ctable(r)
; bne where
;.endm
;
;;macro isbrk branches to where if sep of (,),.,[,]
;
;.macro isbrk r,where
; bic #177400,r
; tstb ctable(r)
; blt where
;.endm
;
;
;;macro isalnum branches to where if r is a-z and feq others, or 0-9
;
;.macro isalnum r,where
; bic #177400,r
; bitb #12,ctable(r)
; bne where
;.endm
;
.endc ;match original conditional
.list
.macro save1
call xsave1
.endm
.macro save2
call xsave2
.endm
.macro save3
call xsave3
.endm
.macro save4
call xsave4
.endm
.macro saveret
mov (sp),pc
.endm