; 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=>!> .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! .endc subloc=. .if nb,litlist .word 0,litlist .iff .word 0,anil .endc .endm .macro subrend tmp=. .=subloc .word subtmp!<> .=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!> .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