picolisp

Unnamed repository; edit this file to name it for gitweb.
git clone https://logand.com/git/picolisp.git/
Log | Files | Refs | README | LICENSE

commit 19bada56bcdb59f6ff04399318f4bbeadd088079
parent 19b745a8b337b51249448cc249210f5d6423f2d2
Author: Alexander Burger <abu@software-lab.de>
Date:   Fri, 19 Oct 2012 17:09:14 +0200

emu64 continued
Diffstat:
Msrc64/Makefile | 8++++----
Msrc64/arch/emu.l | 138++++++++++++++++++++++++++++++++++++++++----------------------------------------
Msrc64/arch/ppc64.l | 16+++++++---------
Msrc64/arch/x86-64.l | 4++--
Msrc64/lib/asm.l | 5+----
Msrc64/main.l | 4++--
Msrc64/mkAsm.l | 5+++--
7 files changed, 88 insertions(+), 92 deletions(-)

diff --git a/src64/Makefile b/src64/Makefile @@ -1,4 +1,4 @@ -# 16oct12abu +# 17oct12abu # (c) Software Lab. Alexander Burger .SILENT: @@ -102,13 +102,13 @@ $(lib)/ht: $(ARCH)$(SYS).ht.o # Explicit builds for cross-assembly $(ARCH)$(SYS).base$(FMT): sysdefs arch/$(ARCH).l $(baseFiles) sys/$(ARCH)$(SYS).code.l - ./mkAsm $(ARCH) "$(SYS)" $(FMT) $(OS) base $(lib)/map $(baseFiles) sys/$(ARCH)$(SYS).code.l + ./mkAsm $(ARCH) "$(SYS)" $(FMT) $(OS) base "" $(lib)/map $(baseFiles) sys/$(ARCH)$(SYS).code.l $(ARCH)$(SYS).ext$(FMT): sysdefs arch/$(ARCH).l ext.l $(ARCH)$(SYS).base$(FMT) - ./mkAsm $(ARCH) "$(SYS)" $(FMT) $(OS) ext "" -fpic ext.l + ./mkAsm $(ARCH) "$(SYS)" $(FMT) $(OS) ext T "" ext.l $(ARCH)$(SYS).ht$(FMT): sysdefs arch/$(ARCH).l ht.l $(ARCH)$(SYS).base$(FMT) - ./mkAsm $(ARCH) "$(SYS)" $(FMT) $(OS) ht "" -fpic ht.l + ./mkAsm $(ARCH) "$(SYS)" $(FMT) $(OS) ht T "" ht.l sysdefs: sysdefs.c $(CC) -o sysdefs -D_FILE_OFFSET_BITS=64 sysdefs.c diff --git a/src64/arch/emu.l b/src64/arch/emu.l @@ -1,4 +1,4 @@ -# 16oct12abu +# 19oct12abu # (c) Software Lab. Alexander Burger # Byte order @@ -13,7 +13,6 @@ (T (quit "Bad wordsize")) ) ) (off *AlignedCode) -(on *AlignedLabel) # Register assignments (de *Registers @@ -27,12 +26,6 @@ (off *AsmOpcodes *AsmData *AsmCode *Labels *SysFun *BaseData *BaseCode) (zero *AsmPos) -(redef fpic () - (fpic) - (in "emu.symtab" - (setq '*BaseData (read)) - (setq '*BaseCode (read)) ) ) - # Direct address expressions (de directExpr (Str) (let (Lst (str Str "_") A (_aggr)) @@ -65,17 +58,16 @@ (let X (pop 'Lst) (cond ((num? X) X) - ((assoc X *AsmData) - (if *FPic - (cons (cadr @) "Local+@1") - (cons (cadr @) "Data+@1") ) ) - ((and *FPic (assoc X *BaseData)) - (cons (cadr @) "Data+@1") ) + ((get *AsmData X) + (cons (car @) (if *FPic "Local+@1" "Data+@1")) ) + ((and *FPic (get *BaseData X)) + (cons @ "Data+@1") ) ((absCode X) - (if *FPic - (cons @ (pack "(" *Label "+@1)")) - (cons @ "(Code+@1)") ) ) - ((and *FPic (assoc X *BaseCode)) + (cons @ + (if *FPic + (pack "(" *Label "+@1)") + "(Code+@1)" ) ) ) + ((and *FPic (get *BaseCode X)) (cons @ "(Code+@1)") ) ((= "+" X) (_term)) ((= "-" X) (- (_term))) @@ -955,21 +947,25 @@ ### Decoration ### (de prolog (File) - (genCode NIL '(<eval+>) NIL # Code + 0 - "PC = *(uint16_t**)S.p, S.p += 8;" - "L.p = ((ptr)S.p)->p, S.p += 8;" ) - (genCode NIL '(<execX>) NIL # Code + 1 - "PC = *(uint16_t**)S.p, S.p += 8;" ) - (genCode NIL '(<execY>) NIL # Code + 2 - "PC = *(uint16_t**)S.p, S.p += 8;" ) - (genCode NIL '(<execZ>) NIL # Code + 3 - "PC = *(uint16_t**)S.p, S.p += 8;" ) - (genCode NIL '(<progX>) NIL # Code + 4 - "PC = *(uint16_t**)S.p, S.p += 8;" ) - (genCode NIL '(<progY>) NIL # Code + 5 - "PC = *(uint16_t**)S.p, S.p += 8;" ) - (genCode NIL '(<progZ>) NIL # Code + 6 - "PC = *(uint16_t**)S.p, S.p += 8;" ) + (if *FPic + (in "emu.symtab" + (setq *BaseData (read)) + (setq *BaseCode (read)) ) + (genCode NIL '(<eval+>) NIL # Code + 0 + "PC = *(uint16_t**)S.p, S.p += 8;" + "L.p = ((ptr)S.p)->p, S.p += 8;" ) + (genCode NIL '(<execX>) NIL # Code + 1 + "PC = *(uint16_t**)S.p, S.p += 8;" ) + (genCode NIL '(<execY>) NIL # Code + 2 + "PC = *(uint16_t**)S.p, S.p += 8;" ) + (genCode NIL '(<execZ>) NIL # Code + 3 + "PC = *(uint16_t**)S.p, S.p += 8;" ) + (genCode NIL '(<progX>) NIL # Code + 4 + "PC = *(uint16_t**)S.p, S.p += 8;" ) + (genCode NIL '(<progY>) NIL # Code + 5 + "PC = *(uint16_t**)S.p, S.p += 8;" ) + (genCode NIL '(<progZ>) NIL # Code + 6 + "PC = *(uint16_t**)S.p, S.p += 8;" ) ) (mapc prinl (quote NIL @@ -1012,9 +1008,7 @@ (prinl " struct {uint32_t l, h;};") (prinl " struct {uint32_t h, l;};") ) (prinl "} op, *ptr;") - (prinl) ) - -(de epilog (File) + (prinl) (mapc prinl (if *FPic (quote @@ -1134,7 +1128,19 @@ NIL "uint16_t Code[];" NIL - "op Data[] = {" ) ) ) + "op Data[] = {" ) ) ) ) + +(de prOpcode (I X) + (prinl + (align 7 X) + ", // " + (align 7 (dec I)) + ": " + (if (=0 X) + "nop" + (fmtInstruction (get *AsmOpcodes X 1)) ) ) ) + +(de epilog (File) (setq *AsmData (flip *AsmData) *AsmCode (flip *AsmCode) ) @@ -1189,27 +1195,19 @@ (prinl "}}") ) ) (prinl "};") (prinl) - (mapc prinl (flip *SysFun)) - (prinl) + (when *SysFun + (mapc prinl (flip @)) + (prinl) ) (prinl "uint16_t Code[] = {") (for (I . X) *AsmCode - (when (pair X) - (for C (cdr X) - (unless (pre? "." C) # Omit local labels - (prinl " // " C ":") ) ) - (setq X (car X)) ) - (prinl - (align 7 X) - ", // " - (align 7 (dec I)) - ": " - (if (=0 X) - "nop" - (fmtInstruction (get *AsmOpcodes X 1)) ) ) ) + (for C (cdr X) + (unless (pre? "." C) # Omit local labels + (prinl " // " C ":") ) ) + (prOpcode I (car X)) ) (prinl "};") + (prinl) (mapc prinl (quote - NIL "static void run(int i) {" " op tmp;" NIL @@ -1235,23 +1233,25 @@ " !Result, (int64_t)Result<0, Carry," " L.n, S.n );" ) " }" - "}" - NIL - "int main(int ac, char *av[]) {" - " int i;" - NIL - " S.p = (Stack = malloc(STACK)) + STACK;" - " Y.p = malloc((ac + 1) * sizeof(op));" - " i = 0; do" - " ((ptr)Y.p)[i].n = (uint64_t)(unsigned long)av[i];" - " while (++i < ac);" - " ((ptr)Y.p)[i].n = 0;" - " X.p = ((ptr)Y.p)->p, Y.p += 8;" - " Z.p = Y.p + (ac - 2) * sizeof(op);" ) ) - (prinl (pack " run(" (absCode "main") ");")) - (prinl " return 0;") - (prinl "}") + "}" ) ) (unless *FPic + (mapc prinl + (quote + NIL + "int main(int ac, char *av[]) {" + " int i;" + NIL + " S.p = (Stack = malloc(STACK)) + STACK;" + " Y.p = malloc((ac + 1) * sizeof(op));" + " i = 0; do" + " ((ptr)Y.p)[i].n = (uint64_t)(unsigned long)av[i];" + " while (++i < ac);" + " ((ptr)Y.p)[i].n = 0;" + " X.p = ((ptr)Y.p)->p, Y.p += 8;" + " Z.p = Y.p + (ac - 2) * sizeof(op);" ) ) + (prinl (pack " run(" (absCode "main") ");")) + (prinl " return 0;") + (prinl "}") (out "emu.symtab" (println (mapcar '((D) (cons (car D) (cadr D))) diff --git a/src64/arch/ppc64.l b/src64/arch/ppc64.l @@ -1,9 +1,9 @@ -# 15oct12abu +# 19oct12abu # (c) Software Lab. Alexander Burger # Byte order (off *LittleEndian) -(on *AlignedCode *AlignedLabel) +(on *AlignedCode) # Register assignments (de *Registers @@ -38,12 +38,6 @@ (zero *DataPos *CodePos) (off *DataLabels *CodeLabels *DataIndex *CodeIndex) -(redef fpic () - (fpic) - (in "ppc64.symtab" - (balance '*DataIndex (read)) - (balance '*CodeIndex (read)) ) ) - (redef label (Lbl Flg) (ifn *FPic (cond @@ -1566,7 +1560,11 @@ (cons 1 (cons (cons @ (cdar L)))) ) ) ### Decoration ### -(de prolog (File)) +(de prolog (File) + (when *FPic + (in "ppc64.symtab" + (balance '*DataIndex (read)) + (balance '*CodeIndex (read)) ) ) ) (de epilog (File) (unless *FPic diff --git a/src64/arch/x86-64.l b/src64/arch/x86-64.l @@ -1,9 +1,9 @@ -# 13oct12abu +# 19oct12abu # (c) Software Lab. Alexander Burger # Byte order (on *LittleEndian) -(off *AlignedCode *AlignedLabel) +(off *AlignedCode) # Register assignments (de *Registers diff --git a/src64/lib/asm.l b/src64/lib/asm.l @@ -1,4 +1,4 @@ -# 13oct12abu +# 17oct12abu # (c) Software Lab. Alexander Burger # *LittleEndian *AlignedCode *Registers optimize @@ -69,9 +69,6 @@ (de asm Args (def (car Args) 'asm (cdr Args)) ) -(de fpic () - (on *FPic) ) - (de idxTags (Lbl Src) (idx '*Tags (def Lbl 'src Src) T) ) diff --git a/src64/main.l b/src64/main.l @@ -1,4 +1,4 @@ -# 13oct12abu +# 02oct12abu # (c) Software Lab. Alexander Burger (code 'Code) @@ -1353,7 +1353,7 @@ cc dlsym(A Y) # Find dynamic symbol null A # OK? if nz # Yes - ? *AlignedLabel + ? *AlignedCode or A CNT # Make short number = ld (E) A # 'nz' - Set function definition diff --git a/src64/mkAsm.l b/src64/mkAsm.l @@ -1,4 +1,4 @@ -# 08aug12abu +# 17oct12abu # (c) Software Lab. Alexander Burger (setq @@ -6,7 +6,8 @@ *System (opt) *Format (opt) *TargetOS (opt) - *Module (opt) ) + *Module (opt) + *FPic (bool (opt)) ) (load "lib/asm.l" (pack "lib/fmt" *Format ".l")