6502 assembler written in Logo.

Courtesy of the author, Leigh Klotz.

Klotz wrote in https://news.ycombinator.com/item?id=23064346

> The assembler [for Apple II Logo] was already chosen, probably by
> Steve Hain or Gary Drescher.  I believe it was CROSS.  It annoyed me
> that I would get phase errors if I edited during the first pass
> which was like 10 or 15 minutes at night so I wrote a one-pass
> assembler in MacLisp, but it was slower to finish than the first
> pass of CROSS so I translated it to Logo and Hal said to put it on
> the utilities disk.  I can't remember who added .output and .input
> but Logo had had them before the Apple II, I think 11Logo had it.

Makefile

@@ -33,7 +33,8 @@ SRC = syseng sysen1 sysen2 sysen3 sysnet kshack dragon channa	\
       moon teach ken lmio1 llogo a2deh chsgtv clib sys3 lmio turnip \
       mits_s rab stan_k bs cstacy kp dcp2 -pics- victor imlac rjl mb bh \
       lars drnil radia gjd maint bolio cent shrdlu vis cbf digest prs jsf \
-      decus bsg muds54 hello rrs 2500 minsky danny survey librm3 librm4
+      decus bsg muds54 hello rrs 2500 minsky danny survey librm3 librm4 \
+      klotz
 DOC = info _info_ sysdoc sysnet syshst kshack _teco_ emacs emacs1 c kcc \
       chprog sail draw wl pc tj6 share _glpr_ _xgpr_ inquir mudman system \
       xfont maxout ucode moon acount alan channa fonts games graphs humor \

build/timestamps.txt

@@ -916,6 +916,7 @@ klh/dazdrt.122 197604190418.39
 klh/macros.84 198511060813.49
 klh/nuuos.205 198505090937.25
 klh/outdoc.208 198504211929.03
+klotz/logass.19 198105131252.34
 kmp/kmp.teco 198001190455.28
 ksc/fidox.18 197901032240.30
 ksc/ivory.12 198002090455.41

doc/programs.md

@@ -193,6 +193,7 @@
 - LLOGO, Logo implemented in Maclisp.
 - LOADP, displays system load.
 - LOCK, shut down system.
+- LOGASS, 6502 assembler in Logo.
 - LOGO, BBN Logo.
 - LOOKUP, looks up user info in INQUIR database.
 - LORENZ, Edward Lorenz' strange attractor.

src/klotz/logass.19

@@ -0,0 +1,165 @@
+;Logo code for a 6502 assembler.
+
+to assemble :code
+  make "code bf text :code
+  symbols :code :org		;Org is a global containing the starting loc - $ 8000.
+  store :code :org
+end
+
+to symbols :code :dot
+  if :code=[] stop
+  symbols bf :code (symbols.line first :code :dot)	;returns a value of new dot.
+end
+
+to symbols.line :line :dot [token]
+  if :line=[] op :dot
+  make "token first :line
+  if :token="';' op :dot
+  if label? :token assign :token :dot op (symbols.line bf :line :dot) stop
+  if ins? :token op :dot+(inslen :token bf :line)
+  if list? :token run :token op :dot ;side effect only. MAKE, etc.
+  error :token [is not an instruction or pseudo op.]
+end
+
+to store :code :dot
+  if :code=[] stop
+  store bf :code (store.line first :code :dot)
+end
+  
+  
+to store.line :line :dot [token ins mode
+  if :line=[] op 0
+  make "token first :line
+  if :token="';' op 0
+  if label? :token (op store.line bf :line :dot)
+  make "ins ins.alist :token
+;The following two lines could be in store.bytes if amode were
+;given the instruction also, so it could determine relative or implied
+;modes.  Then, inslen and operand would have to know about those
+;modes and return the right thing, too.  Special-casing them is
+;enough, though.
+  if relins? :ins (op do.rel.ins :ins bf :line)
+  if impins? :inse (op do.imp.ins :ins bf :line)
+  make "mode amode bf :line	;Returns name of addressing mode. ABS, INX!, etc.
+  op store.bytes (inslen :mode) (opcode :ins :mode) (operand :mode :line)
+end
+
+
+to inslen :mode			;The value of an addressing mode name is
+  op first thing :mode		;a list of the # of bytes of operand and
+end				;the # telling where to find the operand
+				;in the line.
+
+to operand :mode :stuff
+  make "stuff first nthbf (operand.location :mode) :line
+;The following means that expressions must have dots. [:foo+:bar]
+;maybe fix this by consing up a new list with the values of everything
+;which isn't a number or an infix operator. sleazy.
+  if list? :stuff op run :stuff	;an expression.
+  if number? :stuff op :stuff	;numbers are self-evaluating
+  if thing? :stuff op thing :stuff	;symbol.
+  error :stuff [no such label]
+end
+
+to operand.location :mode
+;the second element of the value of mode is the location of the operand
+;in the line
+  op first bf thing :mode
+end
+
+to opcode :ins :mode
+  op lookup :mode :ins
+end
+
+to relins? :ins
+  op "REL = first bf :ins
+end
+
+to immins? :ins
+  op "IMM = first bf :ins
+end
+
+to amode :args [fpart reg]
+  if :args=[A] op "ACC
+  if bf :args=[] op "ABS
+  make "reg bf bf :args
+  make "fpart first :args
+  if :fpart="# op modelookup :imms :reg
+  if :fpart="! op modelookup :pzs :reg
+  if :fpart="'(' op modelookup :indirs :reg
+  op modelookup :indexes :reg
+end
+  
+to ins? :token
+  op (first thing :token) = "INS
+end
+
+to label? :token
+  op (first :token)="'"'
+end
+
+to modes ins
+  op bf thing :ins
+end
+
+to setup
+  ;patterns
+  make "imms [IMM]
+  make "pzs [[ABS!] [INX! , X] [INY! , Y]]
+  make "indexes [[ABS] [INX , X] [INY , Y]]
+  make "indirs [[IND )] [INDX , X )] [INDY ) , Y]]
+  ;number of bytes of operand, location of operand in line.
+  make ".23 [2 3] make ".32 [3 2]	;hack to save space
+  make "IMM :.23
+  make "ABS! :.23
+  make "INX! :.23
+  make "INY! :.23
+  make "ABS :.32
+  make "INX :.32
+  make "INY :.32
+  make "IND [3 3]
+  make "INDX :.23
+  make "INDY :.23
+end
+
+to modelookup :modes :reg
+  if :modes=[] error [Bad Mode --] :args
+  if :reg=bf first :modes op thing first first :modes
+  op modelookup bf :modes :reg
+end
+
+to pop? thing
+  if list? :thing op not (first :thing="INS ) else op "false
+end
+
+to pop thing
+  op bf thing :thing
+end
+
+to error :thing1 :thing2
+  (print :thing1 :thing2)
+  pause
+end
+
+to $ word
+  op $1 :word 0
+end
+
+to $1 word val
+ if :word="'' op :val
+ if number? first :word op $1 bf :word :val*16+first :word
+ op $1 bf :word :val*16 + (countnth first :word [A B C D E F] 9)
+end
+  
+to countnth :thing :place
+  if :place=[] stop
+  if :thing=first :place op 0 else op 1 + countnth :thing bf :place
+end
+  
+
+Local Modes:
+Mode:Text
+Fill Prefix: "  "
+Paragraph Delimiter: "to "
+	:m.m ^R Indent Nested
+End: