! (Intel etc) 8048 family assembler
! (c) 1989 RWT - all rights reserved

! The user source file should be structured as follows:
!
! %begin
! %include "<this file>"
!   program name = "<whatever>"  {optional but recommended}
!   <main body of user program>
!   %end {of DO PASS routine which begins at the end of this file}
! %end {matching the %begin}
!
! The contents of PROGRAM NAME are used to name the listing and code files.

%ownstring(31)program name = "8048"
%externalroutinespec phex4(%integer x)
%externalroutinespec phex2(%integer x)
%constinteger blank = 255 {0 for on-chip rom, 255 for separate eprom}

%bytearray codebuffer(0:4095)
%integer pass,maxpc,pc,errors

! Operand codes:
! Literals in the signed/unsigned byte range stand for themselves.
! Other operands are represented by values greater than 1023.
! 

%constinteger -
  minnum=-128,maxnum=255,
  r0=1024,r1=1025,r2=1026,r3=1027,
  r4=1028,r5=1029,r6=1030,r7=1031,
  ar0=1032,ar1=1033,
  a=1034,p1=1035,p2=1036,bus=1037,
  p4=1038,p5=1039,p6=1040,p7=1041,
  curpage=1042,page3=1043,psw=1044,t=1045

%conststring(11)%array mnemonic(-1:255) =    "DATA  #",-
   "NOP",        "*??*",       "OUTL  BUS,A","ADD   A,#",
   "JMP   ",     "EN    I",    "*??*",       "DEC   A",
   "INS   A,BUS","IN    A,P1", "IN    A,P2", "*??*",
   "MOVD  A,P4", "MOVD  A,P5", "MOVD  A,P6", "MOVD  A,P7",
   "INC   @R0",  "INC   @R1",  "JB0   $",    "ADDC  A,#",
   "CALL  ",     "DIS   I",    "JTF   $",    "INC   A",
   "INC   R0",   "INC   R1",   "INC   R2",   "INC   R3",
   "INC   R4",   "INC   R5",   "INC   R6",   "INC   R7",
   "XCH   A,@R0","XCH   A,@R1","*??*",       "MOV   A,#",
   "JMP   ",     "EN    TCNTI","JNT0  $",    "CLR   A",
   "XCH   A,R0", "XCH   A,R1", "XCH   A,R2", "XCH   A,R3",
   "XCH   A,R4", "XCH   A,R5", "XCH   A,R6", "XCH   A,R7",
   "XCHD  A,@R0","XCHD  A,@R1","JB1   $",    "*??*",
   "CALL  ",     "DIS   TCNTI","JT0   $",    "CPL   A",
   "*??*",       "OUTL  P1,A", "OUTL  P2,A", "*??*",
   "MOVD  P4,A", "MOVD  P5,A", "MOVD  P6,A", "MOVD  P7,A",
   "ORL   A,@R0","ORL   A,@R1","MOV   A,T",  "ORL   A,#",
   "JMP   ",     "STRT  CNT",  "JNT1  $",    "SWAP  A",
   "ORL   A,R0", "ORL   A,R1", "ORL   A,R2", "ORL   A,R3",
   "ORL   A,R4", "ORL   A,R5", "ORL   A,R6", "ORL   A,R7",
   "ANL   A,@R0","ANL   A,@R1","JB2   $",    "ANL   A,#",
   "CALL  ",     "STRT  T",    "JT1   $",    "DA    A",
   "ANL   A,R0", "ANL   A,R1", "ANL   A,R2", "ANL   A,R3",
   "ANL   A,R4", "ANL   A,R5", "ANL   A,R6", "ANL   A,R7",
   "ADD   A,@R0","ADD   A,@R1","MOV   T,A",  "*??*",
   "JMP   ",     "STOP  TCNT", "*??*",       "RRC   A",
   "ADD   A,R0", "ADD   A,R1", "ADD   A,R2", "ADD   A,R3",
   "ADD   A,R4", "ADD   A,R5", "ADD   A,R6", "ADD   A,R7",
   "ADDC  A,@R0","ADDC  A,@R1","JB3   $",    "*??*",
   "CALL  ",     "EN    T0CLK","JF1   $",    "RR    A",
   "ADDC  A,R0", "ADDC  A,R1", "ADDC  A,R2", "ADDC  A,R3",
   "ADDC  A,R4", "ADDC  A,R5", "ADDC  A,R6", "ADDC  A,R7",
   "MOVX  A,@R0","MOVX  A,@R1","*??*",       "RET",
   "JMP   ",     "CLR   F0",   "JNI   $",    "*??*",
   "ORL   BUS,#","ORL   P1,#", "ORL   P2,#", "*??*",
   "ORL   P4,#", "ORL   P5,#", "ORL   P6,#", "ORL   P7,#",
   "MOVX  @R0,A","MOVX  @R1,A","JB4   $",    "RETR",
   "CALL  ",     "CPL   F0",   "JNZ   $",    "CLR   C",
   "ANL   BUS,#","ANL   P1,#", "ANL   P2,#", "*??*",
   "ANL   P4,#", "ANL   P5,#", "ANL   P6,#", "ANL   P7,#",
   "MOV   @R0,A","MOV   @R1,A","*??*",       "MOVP  A,@A",
   "JMP   ",     "CLR   F1",   "*??*",       "CPL   C",
   "MOV   R0,A", "MOV   R1,A", "MOV   R2,A", "MOV   R3,A",
   "MOV   R4,A", "MOV   R5,A", "MOV   R6,A", "MOV   R7,A",
   "MOV   @R0,#","MOV   @R1,#","JB5   $",    "JMPP  @A",
   "CALL  ",     "CPL   F1",   "JF0   $",    "*??*",
   "MOV   R0,#", "MOV   R1,#", "MOV   R2,#", "MOV   R3,#",
   "MOV   R4,#", "MOV   R5,#", "MOV   R6,#", "MOV   R7,#",
   "*??*",       "*??*",       "*??*",       "*??*",
   "JMP   ",     "SEL   RB0",  "JZ    $",    "MOV   A,PSW",
   "DEC   R0",   "DEC   R1",   "DEC   R2",   "DEC   R3",
   "DEC   R4",   "DEC   R5",   "DEC   R6",   "DEC   R7",
   "XRL   A,@R0","XRL   A,@R1","JB6   $",    "XRL   A,#",
   "CALL  ",     "SEL   RB1",  "*??*",       "MOV   PSW,A",
   "XRL   A,R0", "XRL   A,R1", "XRL   A,R2", "XRL   A,R3",
   "XRL   A,R4", "XRL   A,R5", "XRL   A,R6", "XRL   A,R7",
   "*??*",       "*??*",       "*??*",       "MOVP3  A,@A",
   "JMP   ",     "SEL   MB0",  "JNC   $",    "RL    A",
   "DJNZ  R0,$", "DJNZ  R1,$", "DJNZ  R2,$", "DJNZ  R3,$",
   "DJNZ  R4,$", "DJNZ  R5,$", "DJNZ  R6,$", "DJNZ  R7,$",
   "MOV   A,@R0","MOV   A,@R1","JB7   $",    "*??*",
   "CALL  ",     "SEL   MB1",  "JC    $",    "RLC   A",
   "MOV   A,R0", "MOV   A,R1", "MOV   A,R2", "MOV   A,R3",
   "MOV   A,R4", "MOV   A,R5", "MOV   A,R6", "MOV   A,R7"

%routine error(%string(255)s)
! Print error message (NL deferred to allow for error details)
  %routine report
    phex4(pc)
    %if s="" %start
      write(errors,1); printstring(" error")
      printsymbol('s') %unless errors=1
    %else
      printstring("  *****  ")
      printstring(s)
    %finish
  %end
  %returnif pass=1
  selectoutput(0); report; newline
  selectoutput(1); newline; report
  errors = errors+1
%end

%routine put(%integer op,parm)

! Generate either:
! (1) A one-byte instruction (value OP), or
! (2) a two-byte instruction (value OP followed by value PARM),
! (3) a one-byte data value PARM.
! The distinction is made on the following basis:
! if OP<0 (typically -1), this selects case (3);
! if the low nibble of OP is 4 we have case (2) (a JMP or CALL instruction);
! if the mnemonic in the above opcode table ends in '#', we have case (2)
!   (an instruction with an immediate data operand);
! if the mnemonic ends in '$', we have case (2) (a short jump instruction);
! otherwise we have case (1).
! In any case, the one or two bytes are stored in the code buffer.
! During pass 2 the incstruction is disassembled to the listing file.

%string(*)%name mnem == mnemonic(op)
%bytename flag == charno(mnem,length(mnem))
%integer double=0

  %routine dump(%integer x)
    codebuffer(pc) = x&255 %unless pc>=4096  {store X in code buffer if room}
    pc = pc+1                                {advance location counter}
    maxpc = pc %if pc>maxpc                  {maintain high water mark}
  %end

  double = 1 %if op&15=4 %or flag='#' %or flag='$'
  %if pass=1 %start
    dump(op) %if op>=0
    dump(parm) %if double#0
  %else
    newline; phex4(pc); spaces(2)
    %if op<0 %then spaces(2) %elsestart
      dump(op); phex2(op)
    %finish
    %if double=0 %then spaces(2) %elsestart
      dump(parm); phex2(parm)
    %finish
    spaces(2); printstring(mnem)
    %if op&15=4 %start
      phex4(op>>5<<8+parm)
    %elseif flag='#'
      write(parm,0)
    %elseif flag='$'
      printsymbol((pc-1)>>8&7+'0')
      phex2(parm)
    %finish
  %finish
%end

%routine operand(%integer x,min,max)
! Check that operand X lies between bounds MIN and MAX
  error("Invalid operand") %unless min<=x<=max
%end

%predicate literal(%integer n)
! Is N literal, i.e. does it lie between -128 and 255?
  %trueif minnum<=n<=maxnum; %false
%end

%integerfn lit(%integer n)
! Ensure N is literal
  %result = n %if literal(n)
  error("Not literal")
  %result = 0
%end

%routine litop(%integer op,parm)
! Perform operation OP between A and literal PARM.
  put(op,lit(parm))
%end

%integerfn table(%integer start,size)
! Check that the table at START of length SIZE lies
! wholly within either the current page or page 3.
! Result is CURPAGE or PAGE3.
%integer page,end
  size = 1 %if size<=0
  end = (start+size-1)>>8; page=start>>8
  %result = page3 %if (page=3=end) %or pass=1
  %result = curpage %if (pc+1)>>8=page=end
  error("Table not accessible: "); write(start,0)
  %result = page3
%end

%routine find(%integer x)
! Ensure label X has been defined.
  error("Label not declared") %if x=0
%end

%routine reach(%integer x)
! Ensure label X lies in the current page (for short jumps).
  find(x)
  error("Label out of reach") %unless ((pc+1)!!x)>>8=0
%end

%routine condjump(%integer cond,x)
! Plant the short jump instruction COND to reach label X.
  reach(x); put(cond,x)
%end

! Simple 0-operand or non-parameterised 1-operand instructions

%routine nop;       put(16_00,-1); %end
%routine en i;      put(16_05,-1); %end
%routine dec a;     put(16_07,-1); %end
%routine dis i;     put(16_15,-1); %end
%routine inc a;     put(16_17,-1); %end
%routine en tcnti;  put(16_25,-1); %end
%routine clr a;     put(16_27,-1); %end
%routine dis tcnti; put(16_35,-1); %end
%routine cpl a;     put(16_37,-1); %end
%routine strt cnt;  put(16_45,-1); %end
%routine swap a;    put(16_47,-1); %end
%routine strt t;    put(16_55,-1); %end
%routine da a;      put(16_57,-1); %end
%routine stop tcnt; put(16_65,-1); %end
%routine rrc a;     put(16_67,-1); %end
%routine en t0clk;  put(16_75,-1); %end
%routine rr a;      put(16_77,-1); %end
%routine ret;       put(16_83,-1); %end
%routine clr f0;    put(16_85,-1); %end
%routine retr;      put(16_93,-1); %end
%routine cpl f0;    put(16_95,-1); %end
%routine clr c;     put(16_97,-1); %end
%routine clr f1;    put(16_a5,-1); %end
%routine cpl c;     put(16_a7,-1); %end
%routine jmpp a;    put(16_b3,-1); %end
%routine cpl f1;    put(16_b5,-1); %end
%routine rl a;      put(16_e7,-1); %end
%routine rlc a;     put(16_f7,-1); %end
%routine sel rb0;   put(16_c5,-1); %end
%routine sel rb1;   put(16_d5,-1); %end
%routine sel mb0;   put(16_e5,-1); %end
%routine sel mb1;   put(16_f5,-1); %end

! Short jumps

%routine jtf  (%integer l); condjump(16_16,l); %end
%routine jnt0 (%integer l); condjump(16_26,l); %end
%routine jt0  (%integer l); condjump(16_36,l); %end
%routine jnt1 (%integer l); condjump(16_46,l); %end
%routine jt1  (%integer l); condjump(16_56,l); %end
%routine jf1  (%integer l); condjump(16_76,l); %end
%routine jni  (%integer l); condjump(16_86,l); %end
%routine jnz  (%integer l); condjump(16_96,l); %end
%routine jf0  (%integer l); condjump(16_b6,l); %end
%routine jz   (%integer l); condjump(16_c6,l); %end
%routine jnc  (%integer l); condjump(16_e6,l); %end
%routine jc   (%integer l); condjump(16_f6,l); %end
%routine jb0  (%integer l); condjump(16_12,l); %end
%routine jb1  (%integer l); condjump(16_32,l); %end
%routine jb2  (%integer l); condjump(16_52,l); %end
%routine jb3  (%integer l); condjump(16_72,l); %end
%routine jb4  (%integer l); condjump(16_92,l); %end
%routine jb5  (%integer l); condjump(16_b2,l); %end
%routine jb6  (%integer l); condjump(16_d2,l); %end
%routine jb7  (%integer l); condjump(16_f2,l); %end

%routine djnz(%integer r,l)
  operand(r,r0,r7); reach(l); put(r&7+16_e8,l)
%end

! Long jumps

%routine jmp(%integer x);  find(x); put(x>>8<<5+16_04,x); %end
%routine call(%integer x); find(x); put(x>>8<<5+16_14,x); %end

! 1-operand parameterised instructions

%routine inc(%integer x)
  inc a %andreturnif x=a
  put(x&1+16_10,-1) %andreturnif x&-2=ar0
  operand(x,r0,r7); put(x&7+16_18,-1)
%end

%routine dec(%integer x)
  dec a %andreturnif x=a
  operand(x,r0,r7); put(x&7+16_c8,-1)
%end

%routine xch(%integer x)
  put(x&1+16_20,-1) %andreturnif x&-2=ar0
  operand(x,r0,r7); put(x&7+16_28,-1)
%end

%routine xchd(%integer x)
  operand(x,ar0,ar1); put(x&1+16_30,-1)
%end

%routine add(%integer x)
  put(x&7+16_68,-1) %andreturnif x&-8=r0
  put(x&1+16_60,-1) %andreturnif x&-2=ar0
  litop(16_03,x)
%end

%routine addc(%integer x)
  put(x&7+16_78,-1) %andreturnif x&-8=r0
  put(x&1+16_70,-1) %andreturnif x&-2=ar0
  litop(16_13,x)
%end

%routine xor(%integer x)  {instead of XRL}
  put(x&7+16_d8,-1) %andreturnif x&-8=r0
  put(x&1+16_d0,-1) %andreturnif x&-2=ar0
  litop(16_d3,x)
%end

! 2-operand instructions

%routine or(%integer d,s)  {instead of ORL}
  %if d=a %start
    put(s&7+16_48,-1) %andreturnif s&-8=r0
    put(s&1+16_40,-1) %andreturnif s&-2=ar0
    litop(16_43,s)
  %else
    s = lit(s)
    %if p1<=d<=p2 %start
      put(16_89-p1+d,s)
    %elseif p4<=d<=p7
      put(16_8c-p4+d,s)
    %else
      operand(d,bus,bus)
      put(16_88,s)
    %finish
  %finish
%end

%routine and(%integer d,s)  {instead of ANL}
  %if d=a %start
    put(s&7+16_58,-1) %andreturnif s&-8=r0
    put(s&1+16_50,-1) %andreturnif s&-2=ar0
    litop(16_53,s)
  %else
    s = lit(s)
    %if p1<=d<=p2 %start
      put(16_99-p1+d,s)
    %elseif p4<=d<=p7
      put(16_9c-p4+d,s)
    %else
      operand(d,bus,bus)
      put(16_98,s)
    %finish
  %finish
%end

%routine mov(%integer d,s) {extended to include IN/OUT/MOVD}
! This has been extended to obviate the need for IN/OUT/MOVD instructions
! by accepting BUS, P1-2/4-7 as operands.  We also accept those moves
! which cannot be done in one instruction, and in effect carry them out
! as two moves, one from source to A, the other from A to destination.
%switch ld,st(r0:t)
  %if d=a %start
    ->ld(s) %if r0<=s<=t
    litop(16_23,s)
    %return
  %finish
  %if s=a %start
    operand(d,r0,t); ->st(d) %if r0<=d<=t
    %return
  %finish
  %if literal(s) %start
    litop(d&7+16_b8,s) %andreturnif d&-8=r0
    litop(d&1+16_b0,s) %andreturnif d&-2=ar0
  %finish
  mov(a,s); mov(d,a); %return
ld(r0):ld(r1):ld(r2):ld(r3):
ld(r4):ld(r5):ld(r6):ld(r7):  put(s&7+16_f8,-1);  %return
ld(ar0):ld(ar1):              put(s&1+16_f0,-1);  %return
ld(t):                        put(16_42,-1);      %return
ld(psw):                      put(16_c7,-1);      %return
ld(curpage):                  put(16_a3,-1);      %return
ld(page3):                    put(16_e3,-1);      %return
ld(bus):                      put(16_08,-1);      %return
ld(p1):ld(p2):                put(16_09-p1+s,-1); %return
ld(p4):ld(p5):ld(p6):ld(p7):  put(16_0c-p4+s,-1); %return
st(r0):st(r1):st(r2):st(r3):
st(r4):st(r5):st(r6):st(r7):  put(d&7+16_a8,-1);  %return
st(ar0):st(ar1):              put(d&1+16_a0,-1);  %return
st(t):                        put(16_62,-1);      %return
st(psw):                      put(16_d7,-1);      %return
st(bus):                      put(16_02,-1);      %return
st(p1):st(p2):                put(16_39-p1+d,-1); %return
st(p4):st(p5):st(p6):st(p7):  put(16_3c-p4+d,-1); %return
ld(a):st(a):st(curpage):st(page3): error("Invalid operands for MOV")
%end

%routine movx(%integer d,s)
  %if s=a %start
    operand(d,ar0,ar1); put(d&1+16_90,-1)
  %elseif d=a
    operand(s,ar0,ar1); put(s&1+16_80,-1)
  %else
    error("MOVX: Invalid operands")
  %finish
%end

! Optional instructions

%routine in(%integer s)  {(optional) includes INS and MOVD}
  operand(s,p1,p7); mov(a,s)
%end

%routine out(%integer d)  {(optional) instead of OUTL, includes MOVD}
  operand(d,p1,p7); mov(d,a)
%end

%routine movd(%integer d,s)
  %if d=a %then operand(s,p4,p7) %else -
  %if s=a %then operand(d,p4,p7) %else error("MOVD?")
  mov(d,s)
%end

%routine neg a; cpl a; inc a; %end
%routine sub (%integer x); cpl a; add (x); cpl a; %end
%routine subc(%integer x); cpl a; addc(x); cpl a; %end

! Directives

%routine org(%integer x)
! Set location counter to X
  pc = x; newline %if pass=2 %and x#0
%end

%routine data(%integer x)
! Plant in-line data
  put(-1,x)
%end

%routine label(%integername x)
! Declare label
! NB: X should have been declared as a variable, preferably initialised to 0.
  %if pass=1 %start
    x = pc
  %else
    newline
    %unless x=pc %start
      error("Duplicate label "); phex4(x)
    %finish
  %finish
%end

%routinespec do pass

! Main program begins here

  codebuffer(pc) = blank %for pc = 0,1,4095

  openoutput(1,":N"); selectoutput(1)
  pass = 1; do pass
  closeoutput

  openoutput(1,program name.".LIS"); selectoutput(1)
  pass = 2; do pass
  error("Code buffer full") %if maxpc>4096
  newline; error("")
  newline; closeoutput

  openoutput(1,program name.".obj"); selectoutput(1)
  maxpc = 4096 %if maxpc>4096
  printsymbol(codebuffer(pc)) %for pc = 0,1,maxpc-1
  closeoutput

  %routine do pass
    errors = 0; maxpc = 0; pc = 0
{END of include file}