.TITLE VL9 .psect VL9 ; stored on: VL9.MAC ; last revision: 20-Dec-83 xx1 = version xx2 = options xx3 = eis xx4 = fis xx5 = clock xx6 = i11.04 xx7 = recor .globl abs,addpro,add1,alphle,and,append,appen1,apply,applyn .globl area,ascii,assoc,assq,atom,blki,blki1,blki2,blki3 .globl boundp,bstak,bufin,bufou,caaar,caadr,caar,cadar,caddr .globl cadr,car.p,cascii,catoc,catol,cdaar,cdadr,cdar,cddar .globl cdddr,cddr,cdr.p,cntlc,compl,cond,cons,copy,dcons,de,decr .globl delete,delq,df,differ,dm,dmc,dski,dsko,dvd,dvd1 .globl enarea,eprogn,eq .globl equal,errm,errmp,errp,escape,eval,evalfu,evalhk,evenp .globl evlis,exch.p,exit,explod,false,form .globl frever,ftype,fval,garb .globl gc,gcspk,ge,get,gt,hdato,hlist,hstak,if,ifn,igc,impli,implod .globl inarea,incr,iniitt,iniodk,iniott,ipti,lambdp,last,le .globl length,list,listp,litato,lmargi,logand,logor,logxor,lsh,lt .globl map,mapc,mapcar,mapcon,maplis,mcons,member,memory,memq .globl msetq,mul32,nblki,nblko,nconc,nconc1,neq,nequal,newl,nextl .globl not,nth,null,numbp,oblist,oddp,or .globl ouarea,oubpk,oubpt,outb .globl outbuf,outpos,outs,pbind,pcrlf,peekch,plengt,plus,popj .globl praise,prch,prin,princh,print,prlgn,prlvl,probj,progn,prog1,prstr .globl ptype,put,quo,rdmaq,rdprd,readch,readli,readu,rem,rempro .globl revers,ringur,rmargi,rplaca,rplacb,rplacd,scale,self .globl seltq,set,setq,setqq,status,subst,sub1,synony,teread .globl terpri,times,trnfrt,trnfr2,true,typech .globl until,where,while,xpldi,zerop .iif ne,fis .globl fdiff,fix,float,fplus,fquo,ftimes .iif ne,clock .globl hz50,otime,otime2,time,time2 ; MODULE PAGE CONTENTS ; VL9 10 ****** FICHIERS : radx50. ; 11 ****** FICHIERS : FIC, INPUT, OUTPUT, ect. ; 17 ****** TRUCS RT-11 DEPENDANTS : TYI, TYS, TYO. ; 18 ****** initialisations start, toplevel, reent et ITs. ; 27 ****** zones nombres, atomes, listes. .page ; ****** FICHIERS : radx50 ; ----- radx50 prends : un pointeur sur une chaine dans a1. ; une adresse de mot dans a5. ; la longueur de la chaine dans a2. ; et colle : les 3 caracteres suivant de la chaine ; en format radix50 dans le mot. ; en remettant a jour a2 et a1. ; si a2 = 0 alors padde a 0. ; ; tue a3, a4 radx50: clr a3 ; a3 : accumulateur. call x50 call x50 call x50 mov a3,(a5) ; placer dans le mot dont l'adr. est dans a5. clr a3 ; pour gc. return ; et bye. ; ----- x50 : used by radx50 x50: clr a4 ; caractere si chaine epuisee. tst a2 ; chaine epuisee ? ble 3$ ; oui. caractere dans a4 = 0. movb (a1)+,a4 ; non. ascii dans a4. dec a2 ; R.A.J. longueur de la chaine. cmp a4,#'A ; lettre ? blo 1$ ; non. sub #<'A-1>,a4 ; oui. lettre. a4 = [01:32](8). br 3$ 1$: cmp a4,#'0 ; chiffre ? blo 2$ ; non. sub #<'0-36>,a4 ; oui. chiffre. a4 = [36:47](8). br 3$ 2$: mov #33,a4 ; alors c'est $. a4 = 33(8). 3$: asl a3 asl a3 asl a3 add a3,a4 ; [PM] a4 = a4 + accum*10(8) asl a3 asl a3 ; [PM] a3 = accum*40(8) add a4,a3 ; a3 = a4 + accum*50(8) return ; ****** FICHIERS : FIC, INPUT, OUTPUT, CLOSE, EOF, RECORD. ; ---- FIC used by INPUT, OUTPUT, and RECORD [written by PM] ; assemble a file specification block (blki) based on the arguement list ; (the default extention must be loaded into blki3 by the caller) ; then do a directory lookup using the channel specified by the ; number in area (calling routine must do: mov #chan+^O400,area) ; returns with the carry bit indicating if the file was found FIC: mov #sysdev,blki ; use system device as default push cdr(a1) ; save the rest of the arguments call elist ; evaluate 1st arg if its a list mov #blki1,a5 call radx50 ; on radx50 le nom.1 dans blki1. mov #blki2,a5 call radx50 ; on radx50 le nom.2 dans blki2 pop a1 ; recover rest of arguments jflst a1,1$ ; jump to 1$ if no more args. push cdr(a1) ; save the rest of the arguments call elist ; evaluate 2nd arg if its a list mov #blki3,a5 call radx50 ; on radx50 l'extension dans blki3. pop a1 jflst a1,1$ ; jump to 1$ if no more args. call elist ; evaluate 3rd arg if its a list mov #blki,a5 call radx50 ; on radx50 l'extension dans blki3. 1$: .dstatus #area+2,#blki ; le device existe-t-il ? ; we avoid using area+0 because its holding channel for .lookup bcc 3$ ; branch if device is legal 2$: mov #erdev,a1 ; device error message jmp errp 3$: tst area+6 ; is the device loaded ? beq 2$ ; branch if not ; .lookup #area,,#blki ; do this explicitly to avoid moving mov #area,r0 ; anything into first word of area mov #blki,2(r0) ; since the channel has allready been loaded EMT ^O375 ; end of .lookup request return erdev: .asciz /* device not loaded / ; [PM] .even .page ; ***** (INPUT NAME EXTENTION DEVICE) [FSUBR] ; [modified extensively by PM] input: jflst a1,input2 ; si retour au terminal. push a1 ; save param list mov #extvli,blki3 ; on colle l'extension par defaut. mov #chani+^O400,area ; load channel number for lookup call FIC ; assemble file specification bcs false1 ; jump if file not found call iniitt ; initialiser buffer in. inc dski ; indicateur entree disque a 1. clr nblki ; init. no de bloc in. pop a1 ; sinon ramener le nom-fichier. return ; ----- (INPUT NIL) input2: ; retour au terminal. call iniitt clr dski .close #chani jmp true ; et on ramene T. ; ----- elist used by FIC [written by PM] elist: mov (a1),a1 ; get car jflst a1,elist3 ; jump if the arg is not a list call eval ; non-atomic args are evaluated elist3: add #dplpn,a1 ; a1 pointe sur la p-lengh du nom. movb (a1)+,a2 ; longueur du nom dans a2. return .page ; ***** (OUTPUT NAME EXTENTION DEVICE) [FSUBR] ; [modified extensively by PM] output: jflst a1,outpu3 ; cas (OUTPUT) ? push a1 ; save param list mov #extvll,blki3 ; extension VLL par defaut. mov #chano+^O400,area ; load channel number for lookup call FIC ; assemble file specification bcs 1$ ; non. le creer. ; oui. le detruire. .close #chano ; faut le fermer d'abord. RT11 ... .delete #area,#chano,#blki 1$: movb #chano,enarea mov #enarea,a1 .enter ; creer. bcc outpu4 ; jump if enter was succesfull false1: tst (p)+ ; erreur ouverture du fichier. depiler jmp false ; et ramener NIL. outpu4: call outpu5 ; initialiser buffer sortie TT. and DSK inc dsko ; indicateur disque sortie a 1. clr nblko ; initialiser no bloc out. pop a1 ; restituer nom. wpop: return .page ; ----- (OUTPUT NIL) outpu3: tst oubpt ; buffer out TT vide ? beq 1$ ; oui. mov oubpt,a1 ; non. forcer 0 a la fin. clrb bufou(a1) ; et transferer dans bfodk. call trnfrt 1$: cmp oubpk,#ebfodk ; buffer out DSK vide ? beq 2$ ; oui. call writew ; non. ecrire 256. mots de bfodk sur disque. 2$: clr dsko .close #chano outpu5: call iniott ; reinitialiser les 2 buffers out. call iniodk jmp true ; et ramener T. ; ----- writew [written by PM] writew:: mov #ouarea,a1 writw2: .writw bcc wpop ; return if write ok movb @#errbyt,a1 ; get the error code push a1 mov #erwmsg,a1 jmp errmp erwmsg: .asciz / ** Disk write error : / .even .page ; ***** (COP) [SUBR 0] ; this function was added by [PM] ; copy input file to output device, then close input file copy5: inc nblki ; [PM] increment input block number mov #bufin,a4 ; [PM] input buffer address mov #bfodk,a5 ; [PM] output buffer address copy4: mov (a4)+,(a5)+ ; [PM] move one word cmp a5,#ebfodk ; [PM] end of buffer ? bne copy4 ; [PM] no, go transfer next word call trnfr2 ; [PM] send output buffer to output device ; ----- entry COP cop: mov #inarea,a1 .readw ; [PM] read a block of 256 words bcc copy5 ; [PM] branch if not end of file mov #ebfodk,oubpk ; [PM] indicate we are at the end of buffer jmp input2 ; [PM] close the input file ; ***** (DEL) [SUBR 0] ; ; this function was added by [PM] ; delete the current input file from the directory ; note: the input file must be the last file opened for this to work. ; i.e. there may not be an (OUTPUT ...) between the (INPUT ...) and the (DEL) del: call input2 ; first close the input file .delete #area,#chani,#blki return .page ; ***** (RECORD NAME EXTENTION DEVICE) [FSUBR] ; [modified extensively by PM] record: .if ne,recor jflst a1,recor2 ; on ferme ? push a1 ; save the param list mov #extlog,blki3 ; l'extension LOG. mov #chanre+^O400,area ; load channel number for lookup call FIC ; assemble file specification bcs 1$ .close #chanre .delete #area,#chanre,#blki 1$: movb #chanre,enarea mov #enarea,a1 .enter bcs false1 call iniott ; initialiser buffer sortie TT. call inirdk ; initialiser buffer sortie RECORD. inc flgrcd ; indicateur record a 1. clr nblkre ; initialiser no de bloc record. pop a1 ; restituer nom. return ; ----- (RECORD NIL) recor2: ; on ferme. cmp rcdpt,#bfrdk ; buffer record vide ? beq 1$ ; oui. mov #rearea,a1 ; non. call writw2 ; ecrire. 1$: clr flgrcd .close #chanre call inirdk ; reinitialiser le buffer record. jmp true ; et ramener T. .endc ; ****** TRUCS RT-11 DEPENDANTS : TYI, TYS, TYO ; ***** (TYI) [SUBR 0] tyi: .if ne,rt11 bis #10000,@#jsw ; mode special : bit(12)[jsw] <- 1. .ttyin a1 ; lire le caractere en mode special. mov a1,a2 call outb ; l'echoer (il faut en mode special). bic #10000,@#jsw ; mode normal : bit(12)[jsw] <- 0. .endc return ; ***** (TYS) [SUBR 0] tys: .if ne,rt11 bis #10100,@#jsw ; [PM] mettre a 1 le bit 12 du jsw. special mode. ; mettre a 1 le bit 6 du jsw. no wait .ttinr ; lire dans a1 si ya qqchose a lire. bcc 1$ ; jump if there was a character bic #10100,@#jsw ; restore the job status word jmp false ; no character, return nil 1$: bic #10100,@#jsw ; [PM] razer bit 12 du jsw. normal mode. ; razer bit 6 du jsw. wait. .endc return ; note that the character is not echoed ; ***** (TYO N) [SUBR 1] imprime sur TT le caractere de code ascii N. ; N DOIT etre un INUM. tyo: bic #177600,a1 ; garde les 7 bits low. mov a1,a2 jmp outb ; [PM] impression immediate. ; ****** initialisations start, toplevel, reent et ITs ; ----- start rstart: jmp start1 ; [JER] on rentre ici par un REENTER ; clavier ( start address - 2 ) . bfodk:: ; the 256 word output buffer begins here start: ; and overwrites initialization code mov #bstak+2,p ; initialize stack .close #chani ; dummy. pour charger le handler RT11. ; il est en plus probablement resident. .trpset #area,#trprtn ; [PM] intercept trap to 4 and 10 .scca #area,#cntlc ; [PM] intercept double control-C ; ----- positionnement de hlist. ; %%%%%% a optimiser (en ayant des adresses absolues). ; suffit de reculer et de masquer les 2 bits low. .settop #-2 ; [PM] request all available memory ; [PM] r0 (a1) has result of settop tst -(a1) ; descendre d'une adresse de mot. mov a1,a2 sub #blist,a2 bit #3,a2 ; a1 - #blist ? multiple de 4 ? beq 1$ ; oui. tst -(a1) ; descendre d'une adresse de mot. 1$: mov a1,hlist ; stocker. ; determine line frequency from RT11-monitor configuration word .if ne,clock ; [PM] mov @#sysptr,a1 ; [PM] a1 points to monitor add #config,a1 ; [PM] a1 points to configuration word mov (a1),a1 ; [PM] a1 = configuration word bic #-linfq-1,a1 ; [PM] is it a 50 hz system? beq 2$ ; [PM] branch if not dec hz50 ; [PM] indicate a 50 hz system .endc ; [PM] .page ; ----- autres initialisations. 2$: clr ringur ; raz ringur. mov #69.,rmar ; taille max ligne. [PM] mov #20.,prmdp ; profondeur max d'impression. mov #1000.,prmln ; longueur max d'impression. mov #latom,a1 mov a1,catol mov a1,hdato mov #catom,catoc mov #nil,gcspk clr a1 clr a2 clr a3 call garb ; garbage collecting initial. mov #msgon,a1 ; annonce initiale vlisp winning. call outs .dstatus #area,#blki ; le device existe-t-il ? bcs 3$ ; helas non. .lookup #area,#chani,#blki ; VLISP.INI existe-t-il ? bcs 3$ ; no. mov #msgini,a1 ; [PM] we found vlisp.ini br 4$ ; [PM] 3$: clr dski ; no VLISP.INI entree terminal. mov #absini,a1 4$: call outs ; [PM] jmp start1 absini: .asciz / VLISP.INI is not there/ .even msgon: .ascii / VLISP is running (version=/ .byte version .ascii /, options=/ .byte options .asciz /)/ .even msgini: .asciz / VLISP.INI is now being read / .even . = bfodk+512. ; [PM] give room for the output buffer ebfodk == . ; chien de garde start1: .if ne,rt11 bis #60000,@#jsw ; set bit 13 du jsw pour permettre reent ; [JER] set bit 14 : pour les minuscules .endc .page reent:: mov #bstak+2,p ; init pile clr ipti clr opti clr xpldi ; reinit indicateur explode. clr impli ; reinit indicateur implode. call outpu5 ; initialisation buffer sortie TT and DK call iniitt ; initialisation buffer entree. clr cntlc ; [PM] clear control-C flag. clr lmar ; init marge gauche. clr atevhk ; R.A.Z. evalhook. clr pbind ; init pbind mov #nil,gcspk ; init gc-muet. mov #reemsg,a1 ; Reenter message. call outs reen1: mov #nil,form ; efface la derniere forme. clr rdprd ; raz le bn de ( pour p.p. clr a3 ; pour gc. mov #attopl,a2 ; adresse atome toplevel -> a2. mov #nil,a1 call evalfu ; appel (TOPLEVEL NIL) br reen1 mtrap: .ascii /Trap to / ; [PM] trap message trpnum: .word 0 ; insert trap number here .ascii / from address ??????/ ; replace ? with trap address mtrape: .byte 0 ; end of trap message reemsg: .ASCIZ / To exit type: (S)/ ; reenter message .EVEN trprtn: ; [PM] routine for .trpset request mov #030061,trpnum ; assume trap to 10 bcs 1$ ; jump if assumption correct mov #032060,trpnum ; it was a trap to 4 1$: MOV (P),A1 ; adresse du TRAP MOV #mtrape,A2 ; adresse zone recep adr trap MOV #6,A3 ; nb de caractere de l'adresse 2$: MOV A1,A4 ; recup l'adresse BIC #177770,A4 ; isole le dernier digit ADD #60,A4 ; conversion ASCII MOVB A4,-(A2) ; charge le caractere ASR A1 ; passe au digit suivant ASR A1 ASR A1 SOB A3,2$ ; ca roule .trpset #area,#trprtn ; reset the trap routine mov #mtrap,a1 ; trap message mov #errm,(p) ; error handler rti .page ; ***** (TOPLEVEL) [SUBR 0] toplv: call readu ; (print (eval (read))) .if ne,clock ; [PM] push a1 .gtim #area,#otime pop a1 .endc ; [PM] call eval .if ne,clock ; [PM] push a1 .gtim #area,#time pop a1 .endc ; [PM] tst dski bge 1$ return 1$: mov a1,it ; derniere valeur top-level dans cval(IT). mov #'=,a2 call outb call probj .page ; this section written by PM .if ne,clock ; [PM] mov time,a1 ; on vide et on calcule et convertit le temps. mov time2,a5 sub otime,a1 ; soustraction double-longueur. sbc a5 sub otime2,a5 ; delta ticks dans a1-a5 : high low. mov a1,a2 ; get high order time bis a5,a2 ; is delta time = 0 ? beq 3$ ; if yes, don't print time (clock didnt tick) mov #60.,a2 ; assume 60 hz. tst hz50 ; is it a 50 hz. system? beq 2$ ; jump if not mov #50.,a2 ; 50 ticks/seconde. 2$: call dvd1 ; a3 = seconds, a1 = remainder push a1 ; save the remainder call pcrlf ; go to next line mov #timsg,a1 call prstr ; print time used message mov a3,a1 ; get number of seconds call probj ; print number of seconds mov #'.,a1 ; a1 = ascii for period call prch ; print decimal point pop a1 ; get remainder mov #6,a2 ; divide by 6 for 60 hz system add hz50,a2 ; divide by 5 for 50 hz system call dvd ; a3 = tenths of seconds, a1 = remainder push a1 ; save remainder mov a3,a1 ; get tenths of seconds add #'0,a1 ; convert to ascii call prch ; print tenths of seconds pop a1 ; get remainder asl a1 ; compute offset in table for 60 hz system sub hz50,a1 ; modify the offset if it's a 50 hz system add #sec.01,a1 ; index into .01 seconds table movb (a1),a1 ; get hundreths of a second call prch ; print hundreths of a second .endc 3$: mov it,a1 ; "valeur" de (TOPLEVEL). jmp pcrlf .if ne,clock timsg: .asciz / seconds used =/ .even sec.01: .ascii /00223456788*/ .endc .page ;***** (S at) [SUBR 1] [JER] pour sortir proprement. ; [PM] changed from STOP to S ; peut etre une pseudo-chaine de commande qui est fournie a RT11 stop: JTNIL A1,2$ ; ya pas d'argument ADD #dplpn,A1 ; pointe sur le PLENGTH MOVB (A1)+,A2 ; recupere la taille de la commande. INC A2 ; [PM] send one extra byte (null) MOV #510,A3 ; adresse de rangement de la chaine MOV A2,(A3)+ ; range la taille de la commande. 1$: MOVB (A1)+,(A3)+ ; range les caracteres SOB A2,1$ ; de la commande un a un. CLRB -(A3) ; [PM] change last byte sent to a null BIS #4000,@#JSW ; set bit 11 (Pass line to KMON) du JSW. 2$: .if ne,recor tst flgrcd ; est-on sous record ? beq 3$ ; non. call recor2 ; oui. terminer le record 3$: .endc mov #stopms,a1 ; imprime Bye. call outs CLR A1 ; pour le .SERROR .EXIT ; et voila! STOPMS: .ASCIZ /Bye/ .EVEN ; ****** zones nombres, atomes, listes. ; ----- zone nombres ; pointeur de nombres libres dans freenb en memoire. ; [PM] use boundry feature of linker to advance to boundry of 32 or 64 bytes .psect boxnum bnum:: .blkb npagnb*npage ; [PM] hnum == .- ; [PM] hnum is address of last number ; ----- zone atomes ; noter que les p-names doivent etre en MAJUSCULES. adato = 0 .macro makat cval,fval,ftyp,ptyp,pn adatox = . .nchr lpn,pn .word cval,nil,fval .byte ftyp,ptyp .word adato .ascii /pn/ .even adato = adatox .endm batom:: undef:: ; UNDEF doit etre ici pour (OBLIST). makat undef,0,0,0,UNDEF nil:: makat nil,0,0,0,NIL t:: makat t,0,0,0,T lambda:: makat lambda,lambdp,12.,0,LAMBDA subr0:: makat subr0,0,0,0,0SUBR subr1:: makat subr1,0,0,0,1SUBR subr2:: makat subr2,0,0,0,2SUBR subr3:: makat subr3,0,0,0,3SUBR nsubr:: makat nsubr,0,0,0,NSUBR fsubr:: makat fsubr,0,0,0,FSUBR expr:: makat expr,0,0,0,EXPR fexpr:: makat fexpr,0,0,0,FEXPR macro:: makat macro,0,0,0,MACRO .page hcnst:: atquot:: makat atquot,car.p,12.,0,QUOTE adatox = . ipromt: .word undef,nil,0 .byte 0,0 .word adato .ascii <2>/? / .even adato = adatox prompt:: makat ipromt,0,0,0,PROMPT ; ----- begin type SUBR0 makat undef,rdmaq,2,0,<'> atread:: makat undef,readu,2,0,READ makat undef,cop,2,0,COP makat undef,del,2,0,DEL makat undef,peekch,2,0,PEEKCH makat undef,readch,2,0,READCH makat undef,teread,2,0,TEREAD makat undef,oblist,2,0,OBLIST makat undef,tyi,2,0,TYI makat undef,tys,2,0,TYS ateof:: makat undef,input2,2,0,EOF makat undef,readli,2,0,READLINE makat undef,praise,2,0,PRAISE .page ; ----- begin type SUBR1 makat undef,terpri,4,0,TERPRI makat undef,car.p,4,0,CAR makat undef,cdr.p,4,0,CDR makat undef,ascii,4,0,ASCII makat undef,cascii,4,0,CASCII makat undef,implod,4,0,IMPLODE makat undef,explod,4,0,EXPLODE makat undef,eval,4,0,EVAL makat undef,listp,4,0,LISTP makat undef,numbp,4,0,NUMBP makat undef,add1,4,0,ADD1 makat undef,add1,4,0,1+ makat undef,sub1,4,0,1- makat undef,sub1,4,0,SUB1 makat undef,zerop,4,0,ZEROP makat undef,eprogn,4,0,EPROGN makat undef,null,4,0,NULL makat undef,not,4,0,NOT makat undef,atom,4,0,ATOM prmdp:: ; profondeur d'impression maximum (listes). makat 0,prlvl,4,0,PRINTLEVEL prmln:: ; longueur d'impression maximum (listes). makat 0,prlgn,4,0,PRINTLENGTH makat undef,caar,4,0,CAAR makat undef,cadr,4,0,CADR makat undef,cdar,4,0,CDAR makat undef,cddr,4,0,CDDR makat undef,caaar,4,0,CAAAR makat undef,caadr,4,0,CAADR makat undef,cadar,4,0,CADAR makat undef,caddr,4,0,CADDR makat undef,cdaar,4,0,CDAAR makat undef,cdadr,4,0,CDADR makat undef,cddar,4,0,CDDAR makat undef,cdddr,4,0,CDDDR makat undef,boundp,4,0,BOUNDP lmar:: ; position de la marge gauche (defaut: 0). makat 0,lmargi,4,0,LMARGIN rmar:: ; position de la marge droite (defaut: 69). makat 0,rmargi,4,0,RMARGIN .page makat undef,length,4,0,LENGTH makat undef,outpos,4,0,OUTPOS makat undef,compl,4,0,COMPL makat undef,copy,4,0,COPY makat undef,last,4,0,LAST makat undef,abs,4,0,ABS makat undef,gc,4,0,GC makat undef,evenp,4,0,EVENP makat undef,oddp,4,0,ODDP makat undef,stop,4,0,S ; [JER] 1SUBR [PM] makat undef,tyo,4,0,TYO makat undef,plengt,4,0,PLENGTH makat undef,evlis,4,0,EVLIS makat undef,litato,4,0,LITATOM ; ......... .if ne,fis makat undef,float,4,0,FLOAT makat undef,fix,4,0,FIX ; [PM] changed from subr2 to subr1 ; ----- begin type SUBR2 makat undef,fplus,6,0,<$+> makat undef,fdiff,6,0,<$-> makat undef,ftimes,6,0,<$*> adatox = . .word undef,nil,fquo .byte 6,0 .word adato .byte 2,44,57 ; code ascii du "$/". adato = adatox .even .endc ; ......... .page atcons:: makat undef,cons,6,0,CONS makat undef,rplaca,6,0,RPLACA makat undef,rplacd,6,0,RPLACD makat undef,rplacb,6,0,RPLACB makat undef,typech,6,0,TYPECH makat undef,princh,6,0,PRINCH makat undef,eq,6,0,EQ makat undef,eq,6,0,<=> makat undef,neq,6,0,NEQ makat undef,revers,6,0,REVERSE makat undef,frever,6,0,FREVERSE makat undef,equal,6,0,EQUAL makat undef,nequal,6,0,NEQUAL makat undef,memq,6,0,MEMQ makat undef,member,6,0,MEMBER makat undef,apply,6,0,APPLY makat undef,lt,6,0,LT adatox = . .word undef,nil,lt .byte 6,0 .word adato .byte 1,74 ; code ascii du "<". adato = adatox makat undef,gt,6,0,GT adatox = . .word undef,nil,gt .byte 6,0 .word adato .byte 1,76 ; code ascii du ">". adato = adatox makat undef,le,6,0,LE makat undef,ge,6,0,GE makat undef,differ,6,0,- makat undef,outbuf,6,0,OUTBUF makat undef,logxor,6,0,LOGXOR makat undef,logor,6,0,LOGOR makat undef,logand,6,0,LOGAND makat undef,lsh,6,0,LSH makat undef,quo,6,0,QUO .page adatox = . .word undef,nil,quo .byte 6,0 .word adato .byte 1,57 ; code ascii du "/". adato = adatox makat undef,rem,6,0,REM adatox = . .word undef,nil,rem .byte 6,0 .word adato .byte 1,134 ; code ascii du "\". adato = adatox makat undef,nconc,6,0,NCONC makat undef,nconc1,6,0,NCONC1 makat undef,synony,6,0,SYNONYM makat undef,get,6,0,GET makat undef,rempro,6,0,REMPROP makat undef,appen1,6,0,APPEND1 makat undef,append,6,0,APPEND makat undef,nth,6,0,NTH makat undef,set,6,0,SET makat undef,dcons,6,0,DCONS makat undef,mapc,6,0,MAPC makat undef,map,6,0,MAP makat undef,mapcar,6,0,MAPCAR makat undef,maplis,6,0,MAPLIST makat undef,mapcon,6,0,MAPCONC makat undef,fval,6,0,FVAL makat undef,ptype,6,0,PTYPE makat undef,ftype,6,0,FTYPE makat undef,assq,6,0,ASSQ makat undef,assoc,6,0,ASSOC makat undef,delq,6,0,DELQ makat undef,delete,6,0,DELETE atevhk:: makat 0,evalhk,6,0,EVALHOOK makat undef,popj,6,0,MULTIPLE makat undef,alphle,6,0,ALPHALE makat undef,mul32,6,0,MUL32 ; [PM] .page ; ----- begin type SUBR3 makat undef,memory,8.,0,MEMORY makat undef,put,8.,0,PUT makat undef,addpro,8.,0,ADDPROP makat undef,subst,8.,0,SUBST makat undef,scale,8.,0,SCALE ; ----- begin type SUBRN makat undef,applyn,10.,0,APPLYN ; ----- begin type FSUBR atmcns:: makat undef,mcons,12.,0,MCONS atlist:: makat undef,list,12.,0,LIST makat undef,de,12.,0,DE makat undef,df,12.,0,DF makat undef,dm,12.,0,DM makat undef,if,12.,0,IF makat undef,ifn,12.,0,IFN makat undef,cond,12.,0,COND makat undef,progn,12.,0,PROGN makat undef,prin,12.,0,PRIN atprnt:: opti:: ; indicateur status print. ; bit 0 = 0 impression debute par un espace. ; = 1 non ; bit 1 = 0 si on ne met pas les / . ; bit 2 = 0 pas de "..." en sortie chaines. makat 0,print,12.,0,PRINT .page makat undef,setq,12.,0,SETQ makat undef,setqq,12.,0,SETQQ makat undef,nextl,12.,0,NEXTL makat undef,newl,12.,0,NEWL makat undef,status,12.,0,STATUS makat undef,self,12.,0,SELF makat undef,exit,12.,0,EXIT makat undef,where,12.,0,WHERE atescp:: makat undef,escape,12.,0,ESCAPE makat undef,and,12.,0,AND makat undef,or,12.,0,OR makat undef,while,12.,0,WHILE makat undef,until,12.,0,UNTIL makat undef,prog1,12.,0,PROG1 makat undef,dmc,12.,0,DMC atastr:: makat undef,times,12.,0,* makat undef,plus,12.,0,+ makat undef,exch.p,12.,0,EXCH makat undef,incr,12.,0,INCR makat undef,decr,12.,0,DECR makat undef,seltq,12.,0,SELECTQ makat undef,input,12.,0,INPUT makat undef,output,12.,0,OUTPUT makat undef,record,12.,0,RECORD makat undef,msetq,12.,0,MSETQ .page .IF NE,COLORX ; [JER] ATVISI:: MAKAT UNDEF,VISINI,12.,0,VISINI ATVISP:: MAKAT UNDEF,VISPOT,12.,0,VISPOT ATVISS:: MAKAT UNDEF,VISEGM,12.,0,VISEGM ATVISM:: MAKAT UNDEF,VISMEM,12.,0,VISMEM .ENDC carry:: makat 0,0,0,0,CARRY ; [PM] for + ibase:: makat 8.,0,0,0,IBASE obase:: makat 10.,0,0,0,OBASE it: makat nil,0,0,0,IT latom: attopl: makat undef,toplv,2,0,TOPLEVEL ; --- free atom space follows --- [PM] catom: .blkw atsize hatom == .-2 ; last word in atom space [PM] ; ----- zone listes blist == . ; beginning of list space .end start ; ****** la-fin ******