home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / TURBOPAS / TP / UTL3 / Z80.PZS / Z80.PAS
Pascal/Delphi Source File  |  2000-06-30  |  63KB  |  1,907 lines
  1. PROGRAM z80_assembler; {$V-,R+}
  2.  
  3.   {
  4.     05 April 1985 - Dap
  5.     Z80 Assembler
  6.   }
  7.  
  8.   CONST
  9.     Null    = #00;
  10.     cr      = #13;
  11.     end_ch  = #27;
  12.     space   = ' ';
  13.     tab     = #09;
  14.     version = '[1.01] 10 October 1985';
  15.  
  16.   TYPE
  17.     hex = 0 .. 15;
  18.  
  19.   CONST
  20.     value : ARRAY ['0' .. 'F'] OF Byte =
  21.       ( 0, 1, 2, 3, 4, 5, 6, 7, 8, 9,
  22.         0, 0, 0, 0, 0, 0, 0,           { :;<=>?@ }
  23.         10, 11, 12, 13, 14, 15 );
  24.     digit : ARRAY [hex] OF Char =
  25.       ( '0', '1', '2', '3', '4', '5', '6', '7',
  26.         '8', '9', 'A', 'B', 'C', 'D', 'E', 'F' );
  27.  
  28.   TYPE
  29.     registers =
  30.       (
  31.         A,  B,  C,  D,  E,  F,  H,  L,  R,
  32.         IV, AF, BC, DE, HL, IX, IY, PC, SP,
  33.         null_reg
  34.       );
  35.     mnemonics =
  36.       (
  37.         ADC,  ADD,  AND_, BIT,  CALL, CCF,  CP,   CPD,  CPDR, CPI,  CPIR, CPL,
  38.         DAA,  DEC,  DI,   DJNZ, EI,   EX,   EXX,  HLT,  IM,   IN_,  INC,
  39.         IND,  INDR, INI,  INIR, JP,   JR,   LD,   LDD,  LDDR, LDI,  LDIR,
  40.         NEG,  NOP,  OR_,  OTDR, OTIR, OUT,  OUTD, OUTI, POP,  PUSH, RES,
  41.         RET,  RETI, RETN, RL,   RLA,  RLC,  RLCA, RLD,  RR,   RRA,  RRC,
  42.         RRCA, RRD,  RST,  SBC,  SCF,  SET_, SLA,  SRA,  SRL,  SUB,  XOR_,
  43.         null_op
  44.       );
  45.     OtherSymbols =
  46.       (
  47.         DefineByte, DefineChar, DefineWord, Originate, Macro,
  48.         EndMacro, EndAssembly, TheRadix, Equate, IncludeFile,
  49.         PageSet, TitleSet, TypeSet, NullOther
  50.       );
  51.     symbols   =
  52.       (
  53.         null_sym, identifier, number,    operation, equal,
  54.         str_data, comma,      semicolon, period,    location,
  55.         colon,    left_bp,    right_bp,  end_file,  EndLine
  56.       );
  57.     reg_str   = String[  2];
  58.     mnem_str  = String[  4];
  59.     val_str   = String[ 16];
  60.     file_name = String[ 23];
  61.     _String   = String[ 80];
  62.     big_str   = String[255];
  63.     LabelStr  = String[ 15];
  64.     LabelPtr  = ^LabelType;
  65.     LabelType =
  66.       RECORD
  67.         Name  : LabelStr;
  68.         Loc   : Integer;
  69.         Left  : LabelPtr;
  70.         Right : LabelPtr;
  71.       END;
  72.     PLocPtr   = ^PatchLoc;
  73.     PatchLoc  =
  74.       RECORD
  75.         PLoc     : Integer;
  76.         Oprtion  : Char;
  77.         PAdj     : Integer;
  78.         OSet     : Boolean;
  79.         TwoBytes : Boolean;
  80.         PNext    : PLocPtr
  81.       END;
  82.     PatchPtr  = ^Patch;
  83.     Patch     =
  84.       RECORD
  85.         PName      : LabelStr;
  86.         FixLoc     : PLocPtr;
  87.         LeftPatch  : PatchPtr;
  88.         RightPatch : PatchPtr
  89.       END;
  90.  
  91.   VAR
  92.     ops      : ARRAY [mnemonics] OF mnem_str;
  93.     reg      : ARRAY [registers] OF reg_str;
  94.     line     : big_str;
  95.     ch_pos   : Byte;
  96.     radix    : Byte;
  97.     ch       : Char;
  98.     io_error : Integer;
  99.     PosCnt   : Integer;   { Position Counter }
  100.     GenFile  : FILE OF Byte;
  101.     in_name  : file_name;
  102.     in_file  : Text;
  103.     Labels   : LabelPtr;
  104.     Patches  : PatchPtr;
  105.  
  106.   PROCEDURE init_ops;
  107.  
  108.     BEGIN { init_ops }
  109.       ops[ADC ] := 'ADC';
  110.       ops[ADD ] := 'ADD';
  111.       ops[AND_] := 'AND';
  112.       ops[BIT ] := 'BIT';
  113.       ops[CALL] := 'CALL';
  114.       ops[CCF ] := 'CCF';
  115.       ops[CP  ] := 'CP';
  116.       ops[CPD ] := 'CPD';
  117.       ops[CPDR] := 'CPDR';
  118.       ops[CPI ] := 'CPI';
  119.       ops[CPIR] := 'CPIR';
  120.       ops[CPL ] := 'CPL';
  121.       ops[DAA ] := 'DAA';
  122.       ops[DEC ] := 'DEC';
  123.       ops[DI  ] := 'DI';
  124.       ops[DJNZ] := 'DJNZ';
  125.       ops[EI  ] := 'EI';
  126.       ops[EX  ] := 'EX';
  127.       ops[EXX ] := 'EXX';
  128.       ops[HLT ] := 'HALT';
  129.       ops[IM  ] := 'IM';
  130.       ops[IN_ ] := 'IN';
  131.       ops[INC ] := 'INC';
  132.       ops[IND ] := 'IND';
  133.       ops[INDR] := 'INDR';
  134.       ops[INI ] := 'INI';
  135.       ops[INIR] := 'INIR';
  136.       ops[JP  ] := 'JP';
  137.       ops[JR  ] := 'JR';
  138.       ops[LD  ] := 'LD';
  139.       ops[LDD ] := 'LDD';
  140.       ops[LDDR] := 'LDDR';
  141.       ops[LDI ] := 'LDI';
  142.       ops[LDIR] := 'LDIR';
  143.       ops[NEG ] := 'NEG';
  144.       ops[NOP ] := 'NOP';
  145.       ops[OR_ ] := 'OR';
  146.       ops[OTDR] := 'OTDR';
  147.       ops[OTIR] := 'OTIR';
  148.       ops[OUT ] := 'OUT';
  149.       ops[OUTD] := 'OUTD';
  150.       ops[OUTI] := 'OUTI';
  151.       ops[POP ] := 'POP';
  152.       ops[PUSH] := 'PUSH';
  153.       ops[RES ] := 'RES';
  154.       ops[RET ] := 'RET';
  155.       ops[RETI] := 'RETI';
  156.       ops[RETN] := 'RETN';
  157.       ops[RL  ] := 'RL';
  158.       ops[RLA ] := 'RLA';
  159.       ops[RLC ] := 'RLC';
  160.       ops[RLCA] := 'RLCA';
  161.       ops[RLD ] := 'RLD';
  162.       ops[RR  ] := 'RR';
  163.       ops[RRA ] := 'RRA';
  164.       ops[RRC ] := 'RRC';
  165.       ops[RRCA] := 'RRCA';
  166.       ops[RRD ] := 'RRD';
  167.       ops[RST ] := 'RST';
  168.       ops[SBC ] := 'SBC';
  169.       ops[SCF ] := 'SCF';
  170.       ops[SET_] := 'SET';
  171.       ops[SLA ] := 'SLA';
  172.       ops[SRA ] := 'SRA';
  173.       ops[SRL ] := 'SRL';
  174.       ops[SUB ] := 'SUB';
  175.       ops[XOR_] := 'XOR';
  176.       ops[null_op] := ''
  177.     END;  { init_ops }
  178.  
  179.   PROCEDURE init_reg;
  180.  
  181.     BEGIN { init_reg }
  182.       reg[A ] := 'A';
  183.       reg[B ] := 'B';
  184.       reg[C ] := 'C';
  185.       reg[D ] := 'D';
  186.       reg[E ] := 'E';
  187.       reg[F ] := 'F';
  188.       reg[H ] := 'H';
  189.       reg[L ] := 'L';
  190.       reg[R ] := 'R';
  191.       reg[IV] := 'I';
  192.       reg[AF] := 'AF';
  193.       reg[BC] := 'BC';
  194.       reg[DE] := 'DE';
  195.       reg[HL] := 'HL';
  196.       reg[IX] := 'IX';
  197.       reg[IY] := 'IY';
  198.       reg[PC] := 'PC';
  199.       reg[SP] := 'SP';
  200.       reg[null_reg] := ''
  201.     END;  { init_reg }
  202.  
  203.   PROCEDURE usage;
  204.  
  205.     BEGIN { usage }
  206.       WriteLn;
  207.       WriteLn ('Usage:');
  208.       WriteLn;
  209.       WriteLn ('  Z80 <filename>[.ASM],[filename][.COM],[filename][.LST],[filename][.CRF][;]');
  210.       WriteLn;
  211.       WriteLn ('  ie: Z80 test,,A:test;');
  212.       WriteLn;
  213.       Halt
  214.     END;  { usage }
  215.  
  216.   FUNCTION upper_ch ( ch : Char ) : Char;
  217.  
  218.     BEGIN { upper_ch }
  219.       IF ch IN ['a' .. 'z'] THEN
  220.         ch := Chr (Ord (ch) - Ord ('a') + Ord ('A') );
  221.       upper_ch := ch
  222.     END;  { upper_ch }
  223.  
  224.   FUNCTION upper_str ( s : big_str ) : big_str;
  225.  
  226.     VAR
  227.       i : Byte;
  228.  
  229.     BEGIN { upper_str }
  230.       FOR i := 1 TO Length (s) DO
  231.         s[i] := upper_ch (s[i] );
  232.       upper_str := s
  233.     END;  { upper_str }
  234.  
  235.   PROCEDURE Error ( Message : _String );
  236.  
  237.     BEGIN { Error }
  238.       WriteLn;
  239.       WriteLn (Message);
  240.       Halt
  241.     END;  { Error }
  242.  
  243.   PROCEDURE initialize;
  244.  
  245.     VAR
  246.       i        : Integer;
  247.       GenName  : File_Name;
  248.       ErrorNum : _String;
  249.  
  250.     BEGIN { initialize }
  251.       WriteLn;
  252.       WriteLn ('Z80 Assembler ', version);
  253.       IF ParamCount < 1 THEN
  254.         usage;
  255.       in_name := upper_str (ParamStr (1) );
  256.       IF (Pos ('.ASM', in_name) = 0) AND (Pos ('.', In_Name) = 0) THEN
  257.         in_name := in_name + '.ASM';
  258.       Assign (in_file, in_name);
  259.       {$I-}
  260.       Reset (in_file);
  261.       io_error := IoResult;
  262.       {$I+}
  263.       Str (Io_Error, ErrorNum);
  264.       IF io_error <> 0 THEN
  265.         Error ('Unable to open ' + in_name + ' due to I/O error #' + ErrorNum);
  266.       GenName := Copy (In_Name, 1, Pos ('.', In_Name) ) + 'Bin';
  267.       Assign (GenFile, GenName);
  268.       Rewrite (GenFile);
  269.       init_ops;
  270.       init_reg;
  271.       ch      := ' ';
  272.       line    := '';
  273.       ch_pos  :=  0;
  274.       radix   := 10;
  275.       PosCnt  :=  0;    { Position Counter }
  276.       Labels  := Nil;
  277.       Patches := Nil;
  278.     END;  { initialize }
  279.  
  280.   FUNCTION val_radix ( s   : val_str;
  281.                        rdx : Byte ) : Integer;
  282.  
  283.     VAR
  284.       i : Integer;
  285.  
  286.     BEGIN { val_radix }
  287.       i := 0;
  288.       s := upper_str (s);
  289.       WHILE Length (s) > 0 DO
  290.         BEGIN
  291.           i := i * rdx + value[s[1] ];
  292.           Delete (s, 1, 1)
  293.         END;
  294.       val_radix := i
  295.     END;  { val_radix }
  296.  
  297.   FUNCTION str_radix ( i, wide  : Integer;
  298.                        rdx, pwr : Byte ) : val_str;
  299.  
  300.     VAR
  301.       r : Real;
  302.       s : val_str;
  303.  
  304.     FUNCTION power ( x : Real;
  305.                      y : Byte ) : Real;
  306.  
  307.       BEGIN { power }
  308.         IF y = 0 THEN
  309.           x := 1
  310.         ELSE
  311.           WHILE y > 1 DO
  312.             BEGIN
  313.               x := x * x;
  314.               y := y - 1
  315.             END;
  316.         power := x
  317.       END;  { power }
  318.  
  319.     BEGIN { str_radix }
  320.       s := '';
  321.       IF i < 0 THEN
  322.         BEGIN
  323.           r := power (256.0, pwr) + i;
  324.           WHILE r > 0.0 DO
  325.             BEGIN
  326.               i := Trunc (r - Int (r / rdx) * rdx);
  327.               r := Int (r / rdx);
  328.               s := digit[i] + s
  329.             END
  330.         END
  331.       ELSE
  332.         WHILE i > 0 DO
  333.           BEGIN
  334.             s := digit[i MOD rdx] + s;
  335.             i := i DIV rdx;
  336.           END;
  337.       WHILE Length (s) < wide DO
  338.         s := '0' + s;
  339.       str_radix := s
  340.     END;  { str_radix }
  341.  
  342.   PROCEDURE get_line;
  343.  
  344.     BEGIN { get_line }
  345.       ReadLn (in_file, line);
  346.       ch_pos := 0
  347.     END;  { get_line }
  348.  
  349.   PROCEDURE get_ch;
  350.  
  351.     BEGIN { get_ch }
  352.       ch_pos := ch_pos + 1;
  353.       IF ch_pos <= Length (line) THEN
  354.         ch := line[ch_pos]
  355.       ELSE IF Eof (in_file) THEN
  356.         ch := end_ch
  357.       ELSE
  358.         BEGIN
  359.           get_line;
  360.           ch := cr
  361.         END
  362.     END;  { get_ch }
  363.  
  364.   FUNCTION next_ch : Char;
  365.  
  366.     BEGIN { next_ch }
  367.       IF ch_pos < Length (line) THEN
  368.         next_ch := line[ch_pos + 1]
  369.       ELSE
  370.         next_ch := cr
  371.     END;  { next_ch }
  372.  
  373.   PROCEDURE parser;
  374.  
  375.     VAR
  376.       start_ch : Char;
  377.       TempOpCh : Char;
  378.       chars    : big_str;
  379.       ident    : LabelStr;
  380.       LabelId  : LabelStr;
  381.       num      : String[16];
  382.       p_radix  : Byte;
  383.       CurChPos : Byte;
  384.       sym      : symbols;
  385.  
  386.     PROCEDURE get_symbol;
  387.  
  388.       BEGIN { get_symbol }
  389.         sym   := null_sym;
  390.         chars := '';
  391.         ident := '';
  392.         num   := '';
  393.         REPEAT
  394.           get_ch
  395.         UNTIL NOT (ch IN [space, tab] );
  396.         IF      ch IN ['A' .. 'Z', 'a' .. 'z'] THEN { Identifier }
  397.           BEGIN
  398.             sym   := identifier;
  399.             ident := ch;
  400.             WHILE next_ch IN ['A' .. 'Z', 'a' .. 'z', '0' .. '9', '_'] DO
  401.               BEGIN
  402.                 get_ch;
  403.                 ident := ident + ch
  404.               END
  405.           END
  406.         ELSE IF ch IN ['0' .. '9'] THEN { Number }
  407.           BEGIN
  408.             sym := number;
  409.             num := ch;
  410.             WHILE next_ch IN ['0' .. '9', 'A' .. 'F', 'a' .. 'f'] DO
  411.               BEGIN
  412.                 get_ch;
  413.                 num := num + ch
  414.               END;
  415.             IF next_ch IN ['H', 'O', 'Q', 'h', 'o', 'q'] THEN
  416.               BEGIN
  417.                 get_ch;
  418.                 CASE ch OF
  419.                   'H', 'h' : p_radix := 16; { Hexidecimal }
  420.                   'O', 'o',
  421.                   'Q', 'q' : p_radix :=  8; { Octal }
  422.                 END
  423.               END
  424.             ELSE
  425.               CASE num[Length (num) ] OF
  426.                 'B', 'b' :
  427.                   BEGIN
  428.                     p_radix := 2; { Binary }
  429.                     Delete (num, Length (num), 1)
  430.                   END;
  431.                 'D', 'd' :
  432.                   BEGIN
  433.                     p_radix := 10; { Decimal }
  434.                     Delete (num, Length (num), 1)
  435.                   END
  436.               ELSE
  437.                 p_radix := radix
  438.               END
  439.           END
  440.         ELSE IF ch IN ['/', '+', '-', '*'] THEN { Arith }
  441.           sym := operation
  442.         ELSE IF ch IN ['[', '('] THEN { Memory or parenthesis in expression }
  443.           sym := left_bp
  444.         ELSE IF ch IN [']', ')'] THEN
  445.           sym := right_bp
  446.         ELSE IF ch IN ['''', '"'] THEN { String or Char }
  447.           BEGIN
  448.             sym      := str_data;
  449.             start_ch := ch;
  450.             get_ch;
  451.             WHILE NOT (ch IN [start_ch, cr] ) DO
  452.               BEGIN
  453.                 chars := chars + ch;
  454.                 get_ch
  455.               END;
  456.             IF ch = cr THEN
  457.               Error ('Strings must not exceed current line.')
  458.           END
  459.         ELSE IF ch = ':' THEN { Label }
  460.           sym := colon
  461.         ELSE IF ch = ',' THEN { Seperator }
  462.           sym := comma
  463.         ELSE IF ch = '.' THEN { Special commands }
  464.           sym := period
  465.         ELSE IF ch = ';' THEN { Comment -- ignore rest of line }
  466.           BEGIN
  467.             sym := semicolon;
  468.             WriteLn;
  469.             Write (Copy (Line, Ch_Pos, Length (Line) ) );
  470.             ch_pos := Length (line)
  471.           END
  472.         ELSE IF ch = '$' THEN { Current location value }
  473.           sym := location
  474.         ELSE IF ch = '=' THEN { EQU -- another form }
  475.           sym := equal
  476.         ELSE IF ch = end_ch THEN { End of file }
  477.           sym := end_file
  478.         ELSE IF Ch = Cr THEN { End of line }
  479.           Sym := EndLine
  480.       END;  { get_symbol }
  481.  
  482.     FUNCTION check_op : mnemonics;
  483.  
  484.       VAR
  485.         op_is : mnemonics;
  486.         id    : String[31];
  487.  
  488.       BEGIN { check_op }
  489.         op_is := ADC;
  490.         id    := upper_str (ident);
  491.         WHILE (ops[op_is] <> id) AND (op_is < null_op) DO
  492.           op_is := Succ (op_is);
  493.         check_op := op_is
  494.       END;  { check_op }
  495.  
  496.     FUNCTION check_reg : registers;
  497.  
  498.       VAR
  499.         reg_is : registers;
  500.         id     : String[31];
  501.  
  502.       BEGIN { check_reg }
  503.         reg_is := A;
  504.         id     := upper_str (ident);
  505.         WHILE (reg[reg_is] <> id) AND (reg_is < null_reg) DO
  506.           reg_is := Succ (reg_is);
  507.         check_reg := reg_is
  508.       END;  { check_reg }
  509.  
  510.     FUNCTION Others : OtherSymbols;
  511.  
  512.       VAR
  513.         id : String[31];
  514.  
  515.       BEGIN { Others }
  516.         id := upper_str (ident);
  517.         IF      (id = 'DB') OR (id = 'DEFB') OR (id = 'DEFBYTE') THEN { Define byte data }
  518.           Others := DefineByte
  519.         ELSE IF (id = 'DC') OR (id = 'DEFC') OR (id = 'DEFCHAR') THEN { Define char data }
  520.           Others := DefineChar
  521.         ELSE IF (id = 'DM') OR (id = 'DEFM') OR (id = 'DEFMEM') THEN { Define char data }
  522.           Others := DefineChar
  523.         ELSE IF (id = 'DW') OR (id = 'DEFW') OR (id = 'DEFWORD') THEN { Define word data }
  524.           Others := DefineWord
  525.         ELSE IF id = 'ORG' THEN { Originate code at this address }
  526.           Others := Originate
  527.         ELSE IF id = 'MACRO' THEN { Indicate this is a macro }
  528.           Others := Macro
  529.         ELSE IF id = 'ENDM' THEN { End of macro }
  530.           Others := EndMacro
  531.         ELSE IF id = 'END' THEN { End of assembly text file }
  532.           Others := EndAssembly
  533.         ELSE IF id = 'RADIX' THEN { Default base for all numbers }
  534.           Others := TheRadix
  535.         ELSE IF id = 'EQU' THEN { Set identifier to be equal to this value }
  536.           Others := Equate
  537.         ELSE IF id = 'INCLUDE' THEN { Use the text from the following file name }
  538.           Others := IncludeFile
  539.         ELSE IF id = 'PAGE' THEN { Either force page break or set page height, width }
  540.           Others := PageSet
  541.         ELSE IF id = 'TITLE' THEN { Use the follow as the title line on assembler listing }
  542.           Others := TitleSet
  543.         ELSE IF id = 'TYPE' THEN { Force use of incompatible types, ie. BYTE < WORD }
  544.           Others := TypeSet
  545.         ELSE
  546.           Others := NullOther
  547.       END;  { Others }
  548.  
  549.     PROCEDURE Generate ( Code : _String );
  550.  
  551.       VAR
  552.         Loc : Byte;
  553.         OrV : Byte;
  554.  
  555.       BEGIN { Generate }
  556.         FOR Loc := 1 TO Length (Code) DO
  557.           BEGIN
  558.             OrV := Ord (Code[Loc] );
  559.             Write (GenFile, OrV);
  560.             PosCnt := PosCnt + 1
  561.           END
  562.       END;  { Generate }
  563.  
  564.     PROCEDURE ParseMnemonic ( OpIs : Mnemonics );
  565.  
  566.       CONST
  567.         Skip = #00;
  568.  
  569.       VAR
  570.         Value  : Integer;
  571.         Sym2   : Symbols;
  572.         Ident2 : String[31];
  573.         Num2   : String[16];
  574.  
  575.       PROCEDURE AddLoc ( VAR ALoc : PLocPtr;
  576.                              NLoc : PLocPtr );
  577.  
  578.         BEGIN { AddLoc }
  579.           IF ALoc = Nil THEN
  580.             Aloc := NLoc
  581.           ELSE
  582.             AddLoc (ALoc^.PNext, NLoc)
  583.         END;  { AddLoc }
  584.  
  585.       PROCEDURE AddPatch ( VAR APatch  : PatchPtr;
  586.                                Both    : Boolean;
  587.                                Id      : LabelStr;
  588.                                AOffset : Boolean;
  589.                                OprCh   : Char;
  590.                                PAValue : Integer );
  591.  
  592.         VAR
  593.           TPatch : PatchPtr;
  594.           TPLoc  : PLocPtr;
  595.  
  596.         BEGIN { AddPatch }
  597.           IF APatch = Nil THEN
  598.             BEGIN
  599.               New (TPLoc);
  600.               WITH TPLoc^ DO
  601.                 BEGIN
  602.                   PLoc     := PosCnt;
  603.                   Oprtion  := OprCh;
  604.                   PAdj     := PAValue;
  605.                   OSet     := AOffset;
  606.                   TwoBytes := Both;
  607.                   PNext    := Nil
  608.                 END;
  609.               New (TPatch);
  610.               WITH TPatch^ DO
  611.                 BEGIN
  612.                   PName      := Id;
  613.                   FixLoc     := TPLoc;
  614.                   LeftPatch  := Nil;
  615.                   RightPatch := Nil
  616.                 END;
  617.               APatch := TPatch
  618.             END
  619.           ELSE IF Id < APatch^.PName THEN
  620.             AddPatch (APatch^.LeftPatch, Both, Id, AOffset, OprCh, PAValue)
  621.           ELSE IF Id > APatch^.PName THEN
  622.             AddPatch (APatch^.RightPatch, Both, Id, AOffset, OprCh, PAValue)
  623.           ELSE
  624.             BEGIN
  625.               New (TPLoc);
  626.               WITH TPLoc^ DO
  627.                 BEGIN
  628.                   PLoc     := PosCnt;
  629.                   Oprtion  := OprCh;
  630.                   PAdj     := PAValue;
  631.                   OSet     := AOffset;
  632.                   TwoBytes := Both;
  633.                   PNext    := Nil
  634.                 END;
  635.               AddLoc (APatch^.FixLoc, TPLoc)
  636.             END
  637.         END;  { AddPatch }
  638.  
  639.       PROCEDURE ViaLabel ( LeadIn  : _String;
  640.                            Both    : Boolean;
  641.                            Id      : LabelStr;
  642.                            AOffset : Boolean;
  643.                            OprCh   : Char;
  644.                            PAValue : Integer );
  645.  
  646.         BEGIN { ViaLabel }
  647.           Write (' Via label [', Id, ']');
  648.           Generate (LeadIn);
  649.           AddPatch (Patches, Both, Id, AOffset, OprCh, PAValue);
  650.           Generate (Null);
  651.           IF Both THEN
  652.             Generate (Null)
  653.         END;  { ViaLabel }
  654.  
  655.       PROCEDURE OperLabel ( LeadIn  : _String;
  656.                             Both    : Boolean;
  657.                             Id      : LabelStr;
  658.                             AOffset : Boolean );
  659.  
  660.         BEGIN { OperLabel }
  661.           Get_Symbol; { Operation | ? }
  662.           IF Sym <> Operation THEN
  663.             ViaLabel (LeadIn, Both, Id, AOffset, '+', 0)
  664.           ELSE
  665.             BEGIN
  666.               TempOpCh := Ch;
  667.               Get_Symbol; { Number }
  668.               IF Sym <> Number THEN
  669.                 Write ('Number expected');
  670.               ViaLabel (LeadIn, Both, Id, AOffset, TempOpCh, Val_Radix (Num, P_Radix) )
  671.             END
  672.         END;  { OperLabel }
  673.  
  674.       PROCEDURE DoReg1 ( LeadIn  : Char;
  675.                          StartOp : Byte );
  676.  
  677.         BEGIN { DoReg1 }
  678.           IF LeadIn <> Skip THEN
  679.             Generate (LeadIn);
  680.           CASE Check_Reg OF
  681.             A : Generate (Chr (StartOp - 0) );
  682.             B : Generate (Chr (StartOp - 7) );
  683.             C : Generate (Chr (StartOp - 6) );
  684.             D : Generate (Chr (StartOp - 5) );
  685.             E : Generate (Chr (StartOp - 4) );
  686.             H : Generate (Chr (StartOp - 3) );
  687.             L : Generate (Chr (StartOp - 2) );
  688.           END
  689.         END;  { DoReg1 }
  690.  
  691.       PROCEDURE DoONCR ( StartOp : Byte );
  692.  
  693.         BEGIN { DoONCR }
  694.           CASE Sym OF
  695.             Identifier : DoReg1 (#$CB, StartOp);
  696.             Left_Bp    :
  697.               BEGIN
  698.                 Get_Symbol;
  699.                   IF Sym <> Identifier THEN
  700.                     Error ('Op code expected')
  701.                   ELSE
  702.                     CASE Check_Reg OF
  703.                       HL : Generate (#$CB + Chr (StartOp - 1) );
  704.                       IX :
  705.                         BEGIN
  706.                           Get_Symbol;
  707.                           IF Sym <> Operation THEN
  708.                             Error ('+ Expected')
  709.                           ELSE
  710.                             Get_Symbol;
  711.                           Generate (#$DD + #$CB + Chr (Val_Radix (Num, P_Radix) ) + Chr (StartOp - 1) )
  712.                         END;
  713.                       IY :
  714.                         BEGIN
  715.                           Get_Symbol;
  716.                           IF Sym <> Operation THEN
  717.                             Error ('+ Expected')
  718.                           ELSE
  719.                             Get_Symbol;
  720.                           Generate (#$FD + #$CB + Chr (Val_Radix (Num, P_Radix) ) + Chr (StartOp - 1) )
  721.                         END
  722.                     END;
  723.                 Get_Symbol { Right_BP }
  724.               END
  725.           END
  726.         END;   { DoONCR }
  727.  
  728.       PROCEDURE DoOR;
  729.  
  730.         BEGIN { DoOR }
  731.           Sym   := Sym2;
  732.           Ident := Ident2;
  733.           Num   := Num2;
  734.           CASE OpIs OF
  735.             AND_ :
  736.               IF Check_Reg IN [A .. L] THEN
  737.                 DoReg1 (Skip, $A7)
  738.               ELSE IF Sym = Number THEN
  739.                 Generate (#$E6 + Chr (Val_Radix (Num, P_Radix) ) )
  740.               ELSE
  741.                 ViaLabel (#$E6, False, Ident, False, '+', 0);
  742.             CALL :
  743.               IF Sym = Number THEN
  744.                 Generate (#$CD + Chr (Lo (Val_Radix (Num, P_Radix) ) ) + Chr (Hi (Val_Radix (Num, P_Radix) ) ) )
  745.               ELSE
  746.                 ViaLabel (#$CD, True, Ident, False, '+', 0);
  747.             CP   :
  748.               IF Check_Reg IN [A .. L] THEN
  749.                 DoReg1 (Skip, $BF)
  750.               ELSE IF Sym = Number THEN
  751.                 Generate (#$FE + Chr (Val_Radix (Num, P_Radix) ) )
  752.               ELSE
  753.                 ViaLabel (#$FE, False, Ident, False, '+', 0);
  754.             DEC  :
  755.               CASE Check_Reg OF
  756.                 A  : Generate (#$3D);
  757.                 B  : Generate (#$05);
  758.                 BC : Generate (#$0B);
  759.                 C  : Generate (#$0D);
  760.                 D  : Generate (#$15);
  761.                 DE : Generate (#$1B);
  762.                 E  : Generate (#$1D);
  763.                 H  : Generate (#$25);
  764.                 HL : Generate (#$2B);
  765.                 IX : Generate (#$DD + #$2B);
  766.                 IY : Generate (#$FD + #$2B);
  767.                 L  : Generate (#$2D);
  768.                 SP : Generate (#$3B);
  769.               END;
  770.             IM   :
  771.               CASE Val_Radix (Num, P_Radix) OF
  772.                 0 : Generate (#$ED + #$46);
  773.                 1 : Generate (#$ED + #$56);
  774.                 2 : Generate (#$ED + #$5E);
  775.               END;
  776.             INC  :
  777.               CASE Check_Reg OF
  778.                 A  : Generate (#$3C);
  779.                 B  : Generate (#$04);
  780.                 BC : Generate (#$03);
  781.                 C  : Generate (#$0C);
  782.                 D  : Generate (#$14);
  783.                 DE : Generate (#$13);
  784.                 E  : Generate (#$1C);
  785.                 H  : Generate (#$24);
  786.                 HL : Generate (#$23);
  787.                 IX : Generate (#$DD + #$23);
  788.                 IY : Generate (#$FD + #$23);
  789.                 L  : Generate (#$2C);
  790.                 SP : Generate (#$33);
  791.               END;
  792.             JP   :
  793.               IF Sym = Number THEN
  794.                 Generate (#$C3 + Chr (Lo (Val_Radix (Num, P_Radix) ) ) + Chr (Hi (Val_Radix (Num, P_Radix) ) ) )
  795.               ELSE
  796.                 ViaLabel (#$C3, True, Ident, False, '+', 0);
  797.             JR   :
  798.               IF Sym = Number THEN
  799.                 Generate (#$18 + Chr (Val_Radix (Num, P_Radix) ) )
  800.               ELSE
  801.                 ViaLabel (#$18, False, Ident, True, '+', 0);
  802.             OR_  :
  803.               IF Check_Reg IN [A .. L] THEN
  804.                 DoReg1 (Skip, $B7)
  805.               ELSE IF Sym = Number THEN
  806.                 Generate (#$F6 + Chr (Val_Radix (Num, P_Radix) ) )
  807.               ELSE
  808.                 ViaLabel (#$F6, False, Ident, False, '+', 0);
  809.             POP  :
  810.               CASE Check_Reg OF
  811.                 AF : Generate (#$F1);
  812.                 BC : Generate (#$C1);
  813.                 DE : Generate (#$D1);
  814.                 HL : Generate (#$E1);
  815.                 IX : Generate (#$DD + #$E1);
  816.                 IY : Generate (#$FD + #$E1);
  817.               END;
  818.             PUSH :
  819.               CASE Check_Reg OF
  820.                 AF : Generate (#$F5);
  821.                 BC : Generate (#$C5);
  822.                 DE : Generate (#$D5);
  823.                 HL : Generate (#$E5);
  824.                 IX : Generate (#$DD + #$E5);
  825.                 IY : Generate (#$FD + #$E5);
  826.               END;
  827.             RET  :
  828.               IF      Ident = 'C'  THEN { Carry }
  829.                 Generate (#$D8)
  830.               ELSE IF Ident = 'M'  THEN { Minus }
  831.                 Generate (#$F8)
  832.               ELSE IF Ident = 'NC' THEN { No Carry }
  833.                 Generate (#$D0)
  834.               ELSE IF Ident = 'NZ' THEN { Not Zero }
  835.                 Generate (#$C0)
  836.               ELSE IF Ident = 'P'  THEN { Plus }
  837.                 Generate (#$F0)
  838.               ELSE IF Ident = 'PE' THEN { Plus & Equal }
  839.                 Generate (#$E8)
  840.               ELSE IF Ident = 'PO' THEN
  841.                 Generate (#$E0)
  842.               ELSE IF Ident = 'Z'  THEN { Zero }
  843.                 Generate (#$C8)
  844.               ELSE
  845.                 Error (' Conditional expected for RET');
  846.             RL   :
  847.               IF Check_Reg IN [A .. L] THEN
  848.                 DoReg1 (#$CB, $17);
  849.             RLC  :
  850.               IF Check_Reg IN [A .. L] THEN
  851.                 DoReg1 (#$CB, $07);
  852.             RR   :
  853.               IF Check_Reg IN [A .. L] THEN
  854.                 DoReg1 (#$CB, $1F);
  855.             RRC  :
  856.               IF Check_Reg IN [A .. L] THEN
  857.                 DoReg1 (#$CB, $0F);
  858.             RST  :
  859.               CASE Val_Radix (Num, P_Radix) OF
  860.                 $00 : Generate (#$C7);
  861.                 $08 : Generate (#$CF);
  862.                 $10 : Generate (#$D7);
  863.                 $18 : Generate (#$DF);
  864.                 $20 : Generate (#$E7);
  865.                 $28 : Generate (#$EF);
  866.                 $30 : Generate (#$F7);
  867.                 $38 : Generate (#$FF);
  868.               END;
  869.             SLA  :
  870.               IF Check_Reg IN [A .. L] THEN
  871.                 DoReg1 (#$CB, $27);
  872.             SRA  :
  873.               IF Check_Reg IN [A .. L] THEN
  874.                 DoReg1 (#$CB, $2F);
  875.             SRL  :
  876.               IF Check_Reg IN [A .. L] THEN
  877.                 DoReg1 (#$CB, $3F);
  878.             SUB  :
  879.               IF Check_Reg IN [A .. L] THEN
  880.                 DoReg1 (Skip, $97)
  881.               ELSE IF Sym = Number THEN
  882.                 Generate (#$D6 + Chr (Val_Radix (Num, P_Radix) ) )
  883.               ELSE
  884.                 ViaLabel (#$D6, False, Ident, False, '+', 0);
  885.             XOR_ :
  886.               IF Check_Reg IN [A .. L] THEN
  887.                 DoReg1 (Skip, $AF)
  888.               ELSE IF Sym = Number THEN
  889.                 Generate (#$EE + Chr (Val_Radix (Num, P_Radix) ) )
  890.               ELSE
  891.                 ViaLabel (#$EE, False, Ident, False, '+', 0);
  892.           END
  893.         END;  { DoOR }
  894.  
  895.       PROCEDURE DoOM_Sub ( LeadIn : Char;
  896.                            OpByte : Byte );
  897.  
  898.         BEGIN { DoOM_Sub }
  899.           CASE Check_Reg OF
  900.             HL :
  901.               IF LeadIn = Skip THEN
  902.                 Generate (Chr (OpByte) )
  903.               ELSE
  904.                 Generate (LeadIn + Chr (OpByte) );
  905.             IX :
  906.               BEGIN
  907.                 Get_Symbol; { Operation }
  908.                 Get_Symbol; { Offset }
  909.                 IF Sym = Number THEN
  910.                   IF LeadIn = Skip THEN
  911.                     Generate (#$DD + Chr (OpByte) + Chr (Val_Radix (Num, P_Radix) ) )
  912.                   ELSE
  913.                     Generate (#$DD + LeadIn + Chr (Val_Radix (Num, P_Radix) ) + Chr (OpByte) )
  914.                 ELSE
  915.                   IF LeadIn = Skip THEN
  916.                     ViaLabel (#$DD + Chr (OpByte), False, Ident, True, '+', 0)
  917.                   ELSE
  918.                     BEGIN
  919.                       ViaLabel (#$DD + LeadIn, False, Ident, True, '+', 0);
  920.                       Generate (Chr (OpByte) )
  921.                     END
  922.               END;
  923.             IY :
  924.               BEGIN
  925.                 Get_Symbol; { Operation }
  926.                 Get_Symbol; { Offset }
  927.                 IF Sym = Number THEN
  928.                   IF LeadIn = Skip THEN
  929.                     Generate (#$FD + Chr (OpByte) + Chr (Val_Radix (Num, P_Radix) ) )
  930.                   ELSE
  931.                     Generate (#$FD + LeadIn + Chr (Val_Radix (Num, P_Radix) ) + Chr (OpByte) )
  932.                 ELSE
  933.                   IF LeadIn = Skip THEN
  934.                     ViaLabel (#$DD + Chr (OpByte), False, Ident, True, '+', 0)
  935.                   ELSE
  936.                     BEGIN
  937.                       ViaLabel (#$DD + LeadIn, False, Ident, True, '+', 0);
  938.                       Generate (Chr (OpByte) )
  939.                     END
  940.               END
  941.           END;
  942.           Get_Symbol { Right_BP }
  943.         END;  { DoOM_Sub }
  944.  
  945.       PROCEDURE DoOM;
  946.  
  947.         BEGIN { DoOM }
  948.           CASE OpIs OF
  949.             AND_ : DoOM_Sub (Skip, $A6);
  950.             CALL : Error ('Conditional expected');
  951.             CP   : DoOM_Sub (Skip, $BE);
  952.             DEC  : DoOM_Sub (Skip, $35);
  953.             IM   : Error ('Should be numeric');
  954.             INC  : DoOM_Sub (Skip, $34);
  955.             JP   : DoOM_Sub (Skip, $E9);
  956.             JR   : Error ('Conditional expected');
  957.             OR_  : DoOM_Sub (Skip, $B6);
  958.             POP  : Error ('Word register expected');
  959.             PUSH : Error ('Word register expected');
  960.             RET  : Error ('Conditional expected');
  961.             RL   : DoOM_Sub (#$CB, $16);
  962.             RLC  : DoOM_Sub (#$CB, $06);
  963.             RR   : DoOM_Sub (#$CB, $1E);
  964.             RRC  : DoOM_Sub (#$CB, $0E);
  965.             RST  : Error ('Should be numeric');
  966.             SLA  : DoOM_Sub (#$CB, $26);
  967.             SRA  : DoOM_Sub (#$CB, $2E);
  968.             SRL  : DoOM_Sub (#$CB, $3E);
  969.             SUB  : DoOM_Sub (Skip, $96);
  970.             XOR_ : DoOM_Sub (Skip, $AE)
  971.           END
  972.         END;  { DoOM }
  973.  
  974.       PROCEDURE DoArith;
  975.  
  976.         PROCEDURE DoRegPair ( LeadIn : Char;
  977.                               OpByte : Byte );
  978.  
  979.           BEGIN { DoRegPair }
  980.             IF LeadIn <> Skip THEN
  981.               Generate (LeadIn);
  982.             Get_Symbol; { Comma }
  983.             Get_Symbol; { Register }
  984.             CASE Check_Reg OF
  985.               BC : Generate (Chr (OpByte + $00) );
  986.               DE : Generate (Chr (OpByte + $10) );
  987.               HL : Generate (Chr (OpByte + $20) );
  988.               SP : Generate (Chr (OpByte + $30) );
  989.             END
  990.           END;  { DoRegPair }
  991.  
  992.         BEGIN { DoArith }
  993.           CASE OpIs OF
  994.             ADC :
  995.               CASE Check_Reg OF
  996.                 A  :
  997.                   BEGIN
  998.                     Get_Symbol; { Comma }
  999.                     Get_Symbol; { Reg | data | Memory }
  1000.                      IF     Check_Reg IN [A .. L] THEN
  1001.                       DoReg1 (Skip, $8F)
  1002.                     ELSE IF Sym = Number THEN
  1003.                       Generate (#$CE + Chr (Val_Radix (Num, P_Radix) ) )
  1004.                     ELSE IF Sym = Left_BP THEN
  1005.                       BEGIN
  1006.                         Get_Symbol; { HL | IX | IY }
  1007.                         DoOM_Sub (Skip, $8E)
  1008.                       END
  1009.                     ELSE
  1010.                       ViaLabel (#$CE, False, Ident, False, '+', 0)
  1011.                   END;
  1012.                 HL : DoRegPair (#$ED, $4A)
  1013.               ELSE
  1014.                 Error ('Illegal register')
  1015.               END;
  1016.             ADD :
  1017.               CASE Check_Reg OF
  1018.                 A  :
  1019.                   BEGIN
  1020.                     Get_Symbol; { Comma }
  1021.                     Get_Symbol; { Reg | data | Memory }
  1022.                      IF     Check_Reg IN [A .. L] THEN
  1023.                       DoReg1 (Skip, $87)
  1024.                     ELSE IF Sym = Number THEN
  1025.                       Generate (#$C6 + Chr (Val_Radix (Num, P_Radix) ) )
  1026.                     ELSE IF Sym = Left_BP THEN
  1027.                       BEGIN
  1028.                         Get_Symbol; { HL | IX | IY }
  1029.                         DoOM_Sub (Skip, $86)
  1030.                       END
  1031.                     ELSE
  1032.                       ViaLabel (#$C6, False, Ident, False, '+', 0)
  1033.                   END;
  1034.                 HL : DoRegPair (Skip, $09);
  1035.                 IX : DoRegPair (#$DD, $09);
  1036.                 IY : DoRegPair (#$FD, $09)
  1037.               ELSE
  1038.                 Error ('Illegal register')
  1039.               END;
  1040.             SBC :
  1041.               CASE Check_Reg OF
  1042.                 A  :
  1043.                   BEGIN
  1044.                     Get_Symbol; { Comma }
  1045.                     Get_Symbol; { Reg | data | Memory }
  1046.                      IF     Check_Reg IN [A .. L] THEN
  1047.                       DoReg1 (Skip, $9F)
  1048.                     ELSE IF Sym = Number THEN
  1049.                       Generate (#$DE + Chr (Val_Radix (Num, P_Radix) ) )
  1050.                     ELSE IF Sym = Left_BP THEN
  1051.                       BEGIN
  1052.                         Get_Symbol; { HL | IX | IY }
  1053.                         DoOM_Sub (Skip, $9E)
  1054.                       END
  1055.                     ELSE
  1056.                       ViaLabel (#$DE, False, Ident, False, '+', 0)
  1057.                   END;
  1058.                 HL : DoRegPair (#$ED, $42)
  1059.               ELSE
  1060.                 Error ('Illegal register')
  1061.               END
  1062.           END
  1063.         END;  { DoArith }
  1064.  
  1065.       PROCEDURE DoConditions;
  1066.  
  1067.         VAR
  1068.           DoJRIt : Boolean;
  1069.  
  1070.         PROCEDURE HandleAddress ( OpByte : Byte;
  1071.                                   Adrs   : Char );
  1072.  
  1073.           VAR
  1074.             DoIt : Boolean;
  1075.             I    : Integer;
  1076.  
  1077.           BEGIN { HandleAddress }
  1078.             DoIt := True;
  1079.             IF      Ident = 'C' THEN
  1080.               Generate (Chr (OpByte + $00) )
  1081.             ELSE IF Ident = 'M' THEN
  1082.               Generate (Chr (OpByte + $20) )
  1083.             ELSE IF Ident = 'NC' THEN
  1084.               Generate (Chr (OpByte - $08) )
  1085.             ELSE IF Ident = 'NZ' THEN
  1086.               Generate (Chr (OpByte - $18) )
  1087.             ELSE IF Ident = 'P' THEN
  1088.               Generate (Chr (OpByte + $18) )
  1089.             ELSE IF Ident = 'PE' THEN
  1090.               Generate (Chr (OpByte + $10) )
  1091.             ELSE IF Ident = 'PO' THEN
  1092.               Generate (Chr (OpByte + $08) )
  1093.             ELSE IF Ident = 'Z' THEN
  1094.               Generate (Chr (OpByte - $10) )
  1095.             ELSE
  1096.               BEGIN
  1097.                 Write (' Address ');
  1098.                 DoIt    := False;
  1099.                 LabelId := Ident;
  1100.                 Get_Symbol; { Operation | ? }
  1101.                 IF Sym <> Operation THEN
  1102.                   ViaLabel (Adrs, True, LabelId, False, '+', 0)
  1103.                 ELSE
  1104.                   BEGIN
  1105.                     TempOpCh := Ch;
  1106.                     Get_Symbol; { Number }
  1107.                     ViaLabel (Adrs, True, LabelId, False, Ch, Val_Radix (Num, P_Radix) )
  1108.                   END
  1109.               END;
  1110.             IF DoIt THEN
  1111.               BEGIN
  1112.                 Get_Symbol; { Comma }
  1113.                 Get_Symbol; { Address }
  1114.                 I := Val_Radix (Num, P_Radix);
  1115.                 Generate (Chr (Lo (I) ) + Chr (Hi (I) ) )
  1116.               END
  1117.           END;  { HandleAddress }
  1118.  
  1119.         BEGIN { DoConditions }
  1120.           CASE OpIs OF
  1121.             CALL : HandleAddress ($DC, #$CD);
  1122.             JP   :
  1123.               IF Sym = Left_BP THEN
  1124.                 BEGIN
  1125.                   Get_Symbol;
  1126.                   CASE Check_Reg OF
  1127.                     HL : Generate (#$E9);
  1128.                     IX : Generate (#$DD + #$E9);
  1129.                     IY : Generate (#$FD + #$E9);
  1130.                   END;
  1131.                   Get_Symbol { Right_BP }
  1132.                 END
  1133.               ELSE
  1134.                 HandleAddress ($DA, #$C3);
  1135.             JR   :
  1136.               BEGIN
  1137.                 DoJRIt := True;
  1138.                 IF      Ident = 'C' THEN
  1139.                   Generate (#$38)
  1140.                 ELSE IF Ident = 'NC' THEN
  1141.                   Generate (#$30)
  1142.                 ELSE IF Ident = 'NZ' THEN
  1143.                   Generate (#$20)
  1144.                 ELSE IF Ident = 'Z' THEN
  1145.                   Generate (#$28)
  1146.                 ELSE
  1147.                   BEGIN
  1148.                     DoJRIt := False;
  1149.                     OperLabel (#18, False, Ident, True)
  1150.                   END;
  1151.                 IF DoJRIt THEN
  1152.                   BEGIN
  1153.                     Get_Symbol; { Comma }
  1154.                     Get_Symbol; { Number }
  1155.                     IF Sym = Number THEN
  1156.                       Generate (Chr (Val_Radix (Num, P_Radix) ) )
  1157.                     ELSE
  1158.                       ViaLabel ('', False, Ident, True, '+', 0)
  1159.                   END
  1160.               END
  1161.           END
  1162.         END;  { DoConditions }
  1163.  
  1164.       PROCEDURE DoIN;
  1165.  
  1166.         VAR
  1167.           FinishUp : Boolean;
  1168.  
  1169.         BEGIN { DoIN }
  1170.           FinishUp := True;
  1171.           CASE Check_Reg OF
  1172.             A :
  1173.               BEGIN
  1174.                 FinishUp := False;
  1175.                 Get_Symbol; { Comma }
  1176.                 Get_Symbol; { Number | Label | Left_BP }
  1177.                 IF      Sym = Number THEN
  1178.                   Generate (#$DB + Chr (Val_Radix (Num, P_Radix) ) )
  1179.                 ELSE IF Sym = Left_BP THEN
  1180.                   BEGIN
  1181.                     Generate (#$ED + #$78);
  1182.                     Get_Symbol; { C }
  1183.                     Get_Symbol  { Right_BP }
  1184.                   END
  1185.                 ELSE { Must be a label ! }
  1186.                   BEGIN
  1187.                     Write (' IN ');
  1188.                     ViaLabel (#$DB, False, Ident, False, '+', 0)
  1189.                   END
  1190.               END;
  1191.             B : Generate (#$ED + #$40);
  1192.             C : Generate (#$ED + #$48);
  1193.             D : Generate (#$ED + #$50);
  1194.             E : Generate (#$ED + #$58);
  1195.             H : Generate (#$ED + #$60);
  1196.             L : Generate (#$ED + #$68);
  1197.           END;
  1198.           IF FinishUp THEN
  1199.             BEGIN
  1200.               Get_Symbol; { Comma }
  1201.               Get_Symbol; { Left_BP }
  1202.               Get_Symbol; { C }
  1203.               Get_Symbol  { Right_BP }
  1204.             END
  1205.         END;  { DoIN }
  1206.  
  1207.       PROCEDURE DoOUT;
  1208.  
  1209.         BEGIN { DoOUT }
  1210.           IF      Sym = Number THEN
  1211.             BEGIN
  1212.               Generate (#$D3 + Chr (Val_Radix (Num, P_Radix) ) );
  1213.               Get_Symbol; { Comma }
  1214.               Get_Symbol  { A }
  1215.             END
  1216.           ELSE IF Sym = Left_BP THEN
  1217.             BEGIN
  1218.               Get_Symbol; { C }
  1219.               Get_Symbol; { Right_BP }
  1220.               Get_Symbol; { Comma }
  1221.               Get_Symbol; { Register }
  1222.               CASE Check_Reg OF
  1223.                 A : Generate (#$ED + #$79);
  1224.                 B : Generate (#$ED + #$41);
  1225.                 C : Generate (#$ED + #$49);
  1226.                 D : Generate (#$ED + #$51);
  1227.                 E : Generate (#$ED + #$59);
  1228.                 H : Generate (#$ED + #$61);
  1229.                 L : Generate (#$ED + #$69);
  1230.               END
  1231.             END
  1232.           ELSE
  1233.             BEGIN
  1234.               Write (' OUT ');
  1235.               ViaLabel (#$D3, False, Ident, False, '+', 0);
  1236.               Get_Symbol; { Comma }
  1237.               Get_Symbol  { A }
  1238.             END
  1239.         END;  { DoOUT }
  1240.  
  1241.       PROCEDURE HandleLD;
  1242.  
  1243.         VAR
  1244.           SetPatch : Boolean;
  1245.           I        : Integer;
  1246.           OffValue : Integer;
  1247.  
  1248.         PROCEDURE DoRegs ( Reg1, Reg2 : Byte );
  1249.  
  1250.           BEGIN { DoRegs }
  1251.             Get_Symbol; { Comma }
  1252.             Get_Symbol; { Reg | data | Memory }
  1253.             IF     Check_Reg IN [A .. L] THEN
  1254.               DoReg1 (Skip, Reg1)
  1255.             ELSE IF Sym = Number THEN
  1256.               Generate (Chr (Reg2) + Chr (Val_Radix (Num, P_Radix) ) )
  1257.             ELSE IF Sym = Left_BP THEN
  1258.               BEGIN
  1259.                 Get_Symbol; { HL | IX | IY }
  1260.                 DoOM_Sub (Skip, Reg1 - 1)
  1261.               END
  1262.             ELSE
  1263.               ViaLabel (Chr (Reg2), False, Ident, False, '+', 0)
  1264.           END;  { DoRegs }
  1265.  
  1266.         PROCEDURE DoPairs ( RegIs     : Registers;
  1267.                             Adrs, Dta : Char );
  1268.  
  1269.           VAR
  1270.             CleanUp : Boolean;
  1271.             Send    : _String;
  1272.  
  1273.           BEGIN { DoPairs }
  1274.             CleanUp := False;
  1275.             Send    := Dta;
  1276.             Get_Symbol; { Comma }
  1277.             Get_Symbol; { Number | Left_BP | Label }
  1278.             IF Sym = Left_BP THEN
  1279.               BEGIN
  1280.                 CleanUp := True;
  1281.                 Get_Symbol;      { Number | Label }
  1282.                 CASE RegIs OF
  1283.                   HL : Send := Adrs;
  1284.                   IX : Send := #$DD + Adrs;
  1285.                   IY : Send := #$FD + Adrs;
  1286.                 ELSE
  1287.                   Send := #$ED + Adrs
  1288.                 END
  1289.               END;
  1290.             IF Sym = Number THEN
  1291.               BEGIN
  1292.                 I := Val_Radix (Num, P_Radix);
  1293.                 Generate (Send + Chr (Lo (I) ) + Chr (Hi (I) ) )
  1294.               END
  1295.             ELSE
  1296.               OperLabel (Send, True, Ident, False);
  1297.             IF CleanUp AND (Sym <> EndLine) THEN
  1298.               Get_Symbol     { Right_BP }
  1299.           END;  { DoPairs }
  1300.  
  1301.         PROCEDURE DoHXY ( LeadIn : Char );
  1302.  
  1303.           PROCEDURE HandleSkip ( Ch : Char );
  1304.  
  1305.             BEGIN { HandleSkip }
  1306.               IF LeadIn = Skip THEN
  1307.                 Generate (Ch)
  1308.               ELSE
  1309.                 Generate (Ch + Chr (I) )
  1310.             END;  { HandleSkip }
  1311.  
  1312.           BEGIN { DoHXY }
  1313.             IF LeadIn = Skip THEN
  1314.               BEGIN
  1315.                 Get_Symbol; { Right_BP }
  1316.                 Get_Symbol; { Comma }
  1317.                 Get_Symbol  { Register | Number | Label }
  1318.               END
  1319.             ELSE
  1320.               BEGIN
  1321.                 Generate (LeadIn);
  1322.                 Get_Symbol; { + }
  1323.                 Get_Symbol; { Label | Number }
  1324.                 IF Sym = Number THEN
  1325.                   I := Val_Radix (Num, P_Radix)
  1326.                 ELSE
  1327.                   I := 0;
  1328.                 Get_Symbol; { Right_BP }
  1329.                 Get_Symbol; { Comma }
  1330.                 Get_Symbol  { Register | Number | Label }
  1331.               END;
  1332.             CASE Check_Reg OF
  1333.               A : HandleSkip (#$77);
  1334.               B : HandleSkip (#$70);
  1335.               C : HandleSkip (#$71);
  1336.               D : HandleSkip (#$72);
  1337.               E : HandleSkip (#$73);
  1338.               H : HandleSkip (#$74);
  1339.               L : HandleSkip (#$75)
  1340.             ELSE
  1341.               IF Sym = Number THEN
  1342.                 IF LeadIn = Skip THEN
  1343.                   Generate (#$36 + Chr (Val_Radix (Num, P_Radix) ) )
  1344.                 ELSE
  1345.                   Generate (#$36 + Chr (I) + Chr (Val_Radix (Num, P_Radix) ) )
  1346.               ELSE
  1347.                 IF LeadIn = Skip THEN
  1348.                   OperLabel (#$36, False, Ident, True)
  1349.                 ELSE
  1350.                   OperLabel (#$36 + Chr (I), False, Ident, True)
  1351.             END
  1352.           END;  { DoHXY }
  1353.  
  1354.         BEGIN { HandleLD }
  1355.           IF Sym = Left_BP THEN
  1356.             BEGIN
  1357.               Get_Symbol;        { Register | Label | Number }
  1358.               CASE Check_Reg OF
  1359.                 BC :
  1360.                   BEGIN
  1361.                     Get_Symbol; { Right_BP }
  1362.                     Get_Symbol; { Comma }
  1363.                     Get_Symbol; { A }
  1364.                     Generate (#$02)
  1365.                   END;
  1366.                 DE :
  1367.                   BEGIN
  1368.                     Get_Symbol; { Right_BP }
  1369.                     Get_Symbol; { Comma }
  1370.                     Get_Symbol; { A }
  1371.                     Generate (#$12)
  1372.                   END;
  1373.                 HL : DoHXY (Skip);
  1374.                 IX : DoHXY (#$DD);
  1375.                 IY : DoHXY (#$FD)
  1376.               ELSE
  1377.                 BEGIN
  1378.                   SetPatch := False;
  1379.                   IF Sym = Number THEN
  1380.                     I := Val_Radix (Num, P_Radix)
  1381.                   ELSE
  1382.                     BEGIN
  1383.                       SetPatch := True;
  1384.                       LabelId  := Ident;
  1385.                       I        := 0
  1386.                     END;
  1387.                   Get_Symbol; { Right_BP | Operation }
  1388.                   IF Sym = Operation THEN
  1389.                     BEGIN
  1390.                       TempOpCh := Ch;
  1391.                       Get_Symbol; { Number }
  1392.                       OffValue := Val_Radix (Num, P_Radix);
  1393.                       Get_Symbol  { Right_BP }
  1394.                     END;
  1395.                   Get_Symbol; { Comma }
  1396.                   Get_Symbol; { Reg }
  1397.                   CASE Check_Reg OF
  1398.                     A  : Generate (#$32);
  1399.                     BC : Generate (#$ED + #$43);
  1400.                     DE : Generate (#$ED + #$53);
  1401.                     HL : Generate (#$22);
  1402.                     IX : Generate (#$DD + #$22);
  1403.                     IY : Generate (#$FD + #$22);
  1404.                     SP : Generate (#$ED + #$73);
  1405.                   END;
  1406.                   IF SetPatch THEN
  1407.                     IF OffValue > 0 THEN
  1408.                       ViaLabel ('', True, LabelId, False, TempOpCh, OffValue)
  1409.                     ELSE
  1410.                       ViaLabel ('', True, LabelId, False, '+', 0)
  1411.                   ELSE
  1412.                     Generate (Chr (Lo (I) ) + Chr (Hi (I) ) )
  1413.                 END
  1414.               END
  1415.             END
  1416.           ELSE
  1417.             CASE Check_Reg OF
  1418.               A  :
  1419.                 BEGIN
  1420.                   Get_Symbol; { Comma }
  1421.                   Get_Symbol; { Reg | data | Left_BP | Label }
  1422.                   IF     Check_Reg IN [A .. L] THEN
  1423.                     DoReg1 (Skip, $7F)
  1424.                   ELSE IF Check_Reg = R THEN
  1425.                     Generate (#$ED + #$5F)
  1426.                   ELSE IF Sym = Number THEN
  1427.                     Generate (#$3E + Chr (Val_Radix (Num, P_Radix) ) )
  1428.                   ELSE IF Sym = Left_BP THEN
  1429.                     BEGIN
  1430.                       Get_Symbol; { HL | IX | IY | BC | DE }
  1431.                       IF Check_Reg IN [HL, IX, IY] THEN
  1432.                         DoOM_Sub (Skip, $7E)
  1433.                       ELSE IF Sym = Number THEN
  1434.                         BEGIN
  1435.                           I := Val_Radix (Num, P_Radix);
  1436.                           Generate (#$3A + Chr (Lo (I) ) + Chr (Hi (I) ) )
  1437.                         END
  1438.                       ELSE IF Check_Reg IN [BC, DE] THEN
  1439.                         CASE Check_Reg OF
  1440.                           BC : Generate (#$0A);
  1441.                           DE : Generate (#$1A)
  1442.                         END
  1443.                       ELSE
  1444.                         OperLabel (#$3A, True, Ident, False);
  1445.                       Get_Symbol { Right_BP }
  1446.                     END
  1447.                   ELSE
  1448.                     ViaLabel (#$3E, True, Ident, False, '+', 0)
  1449.                 END;
  1450.               B  : DoRegs ($47, $06);
  1451.               BC : DoPairs (BC, #$4B, #$01);
  1452.               C  : DoRegs ($4F, $0E);
  1453.               D  : DoRegs ($57, $16);
  1454.               DE : DoPairs (DE, #$5B, #$11);
  1455.               E  : DoRegs ($5F, $1E);
  1456.               H  : DoRegs ($67, $26);
  1457.               HL : DoPairs (HL, #$2A, #$21);
  1458.               IV :
  1459.                 BEGIN
  1460.                   Get_Symbol; { Comma }
  1461.                   Get_Symbol; { A }
  1462.                   Generate (#$ED + #$47)
  1463.                 END;
  1464.               IX : DoPairs (IX, #$2A, #$21);
  1465.               IY : DoPairs (IY, #$2A, #$21);
  1466.               L  : DoRegs ($47, $06);
  1467.               R  :
  1468.                 BEGIN
  1469.                   Get_Symbol; { Comma }
  1470.                   Get_Symbol; { A }
  1471.                   Generate (#$ED + #$4F)
  1472.                 END;
  1473.               SP :
  1474.                 BEGIN
  1475.                   Get_Symbol; { Comma }
  1476.                   Get_Symbol; { Reg | Number | Left_BP }
  1477.                   IF Sym = Left_BP THEN
  1478.                     BEGIN
  1479.                       Get_Symbol;
  1480.                       IF Sym = Number THEN
  1481.                         BEGIN
  1482.                           I := Val_Radix (Num, P_Radix);
  1483.                           Generate (#$ED + #$7B + Chr (Lo (I) ) + Chr (Hi (I) ) )
  1484.                         END
  1485.                       ELSE
  1486.                         OperLabel (#$ED + #$7B, True, Ident, False);
  1487.                       Get_Symbol { Right_BP }
  1488.                     END
  1489.                   ELSE IF Sym = Number THEN
  1490.                     BEGIN
  1491.                       I := Val_Radix (Num, P_Radix);
  1492.                       Generate (#$31 + Chr (Lo (I) ) + Chr (Hi (I) ) )
  1493.                     END
  1494.                   ELSE IF Check_Reg IN [HL, IX, IY] THEN
  1495.                     DoOM_Sub (Skip, $F9)
  1496.                   ELSE
  1497.                     ViaLabel (#$31, True, Ident, False, '+', 0)
  1498.                 END
  1499.             END
  1500.         END;  { HandleLD }
  1501.  
  1502.       BEGIN { ParseMnemonic }
  1503.         Get_Symbol;
  1504.         IF OpIs = LD THEN
  1505.           HandleLD
  1506.  4) );
  1507.             ShowLabels (Right)
  1508.           END
  1509.     END;  { ShowPatches }
  1510.  
  1511.   PROCEDURE FixPatches ( APatch : PatchPtr );
  1512.  
  1513.     VAR
  1514.       Value  : Integer; { Address or Data of Label }
  1515.       OValue : Integer;
  1516.  
  1517.     BEGIN { FixPatches }
  1518.       IF APatch <> Nil THEN
  1519.         WITH APatch^ DO
  1520.           BEGIN
  1521.             FixPatches (LeftPatch);
  1522.             IF NOT FoundLabel (Labels, PName, OValue) THEN
  1523.               Error ('Unable to locate label ' + PName)
  1524.             ELSE
  1525.               BEGIN
  1526.                 WriteLn;
  1527.                 Write ('':2, PName);
  1528.                 REPEAT
  1529.                   WITH FixLoc^ DO
  1530.                     BEGIN
  1531.                       Value := OValue;
  1532.                       IF OSet THEN
  1533.                         Value := Value - PLoc - 1;
  1534.                       CASE Oprtion OF
  1535.                         '+' : Value := Value + PAdj;
  1536.                         '-' : Value := Value - PAdj;
  1537.                         '*' : Value := Value * PAdj;
  1538.                         '/' : Value := Value DIV PAdj
  1539.                       END;
  1540.                       SetValue (PLoc, Value, TwoBytes)
  1541.                     END;
  1542.                   FixLoc := FixLoc^.PNext
  1543.                 UNTIL FixLoc = Nil
  1544.               END;
  1545.             FixPatches (RightPatch)
  1546.           END
  1547.     END;  { FixPatches }
  1548.  
  1549.   BEGIN { z80_assembler }
  1550.     initialize;
  1551.     parser;
  1552.     WriteLn;
  1553.     WriteLn;
  1554.     WriteLn ('Labels');
  1555.     ShowLabels (Labels);
  1556.     WriteLn;
  1557.     WriteLn;
  1558.     WriteLn ('Second pass');
  1559.     FixPatches (Patches);
  1560.     WriteLn;
  1561.     WriteLn ('End assembly');
  1562.     Close (GenFile)
  1563.   END   { z80_assembler }.   WriteLn;
  1564.     WriteLn ('Labels');
  1565.     ShowLabels (Labels);
  1566.     WriteLn;
  1567.     WriteLn;
  1568.     WriteLn ('Second pass');
  1569.     FiRRD  : Generate (#$ED + #$67);
  1570.             SCF  : Generate (#$37)
  1571.           ELSE
  1572.             Error ('Extra info on line')
  1573.           END
  1574.         ELSE IF (OpIs IN [BIT, RES, SET_] ) AND
  1575.                 (Sym = Number) THEN  { Op Number Comma Register }
  1576.             number     : Write ('Number     : ', num:4, ' Radix : ', p_radix:2, ' Value : ', val_radix (num, p_radix):5);
  1577.             str_data   : Generate (chars);
  1578.             operation  : Write ('Operation  : ', ch);
  1579.             left_bp    : Write ('Memory go  : ', ch);
  1580.             right_bp   : Write ('Memory end : ', ch);
  1581.             comma      : Write (' Comma');
  1582.             period     : Write ('Directive');
  1583.             colon      : Write (' Label');
  1584.             location   : Write ('Location counter ', PosCnt);
  1585.             equal      : Write ('Equal')
  1586.           END;
  1587.           get_symbol
  1588.         END
  1589.     END;  { parser }
  1590.  
  1591.   FUNCTION FoundLabel (     ALabel : LabelPtr;
  1592.                             AName  : LabelStr;
  1593.                         VAR Value  : Integer ) : Boolean;
  1594.  
  1595.     BEGIN { FoundLabel }
  1596.       IF      ALabel = Nil THEN
  1597.         FoundLabel := False
  1598.       ELSE IF AName < ALabel^.Name THEN
  1599.         FoundLabel := FoundLabel (ALabel^.Left, AName, Value)
  1600.       ELSE IF AName > ALabel^.Name THEN
  1601.         FoundLabel := FoundLabel (ALabel^.Right, AName, Value)
  1602.       ELSE
  1603.         BEGIN
  1604.           Value      := ALabel^.Loc;
  1605.           FoundLabel := True
  1606.         END
  1607.     END;  { FoundLabel }
  1608.  
  1609.   PROCEDURE SetValue ( RecNum : Integer;
  1610.                        Value  : Integer;
  1611.                        Both   : Boolean );
  1612.  
  1613.     VAR
  1614.       LoByte : Byte;
  1615.       HiByte : Byte;
  1616.  
  1617.     BEGIN { SetValue }
  1618.       LoByte := Lo (Value);
  1619.       HiByte := Hi (Value);
  1620.       IF Both THEN
  1621.         Write ('':3, Str_Radix (Value, 4, 16, 4) )
  1622.       ELSE
  1623.         Write ('':3, Str_Radix (LoByte, 2, 16, 4) );
  1624.       Seek (GenFile, RecNum);
  1625.       IF Both THEN
  1626.         Write (GenFile, LoByte, HiByte)
  1627.       ELSE
  1628.         Write (GenFile, LoByte)
  1629.     END;  { SetValue }
  1630.  
  1631.   PROCEDURE ShowLabels ( ALabel : LabelPtr );
  1632.  
  1633.     BEGIN { ShowLabels }
  1634.       IF ALabel <> Nil THEN
  1635.         WITH ALabel^ DO
  1636.           BEGIN
  1637.             ShowLabels (Left);
  1638.             WriteLn ('':2, Name:16, '':2, Str_Radix (Loc, 4, 16, BEGIN
  1639.                 WriteLn;
  1640.                 Write (ident:31);
  1641.                 IF      check_op <> null_op THEN
  1642.                   ParseMnemonic (Check_Op)
  1643.                 ELSE IF check_reg <> null_reg THEN
  1644.                   Write (' Register')
  1645.                 ELSE IF Others <> NullOther THEN
  1646.                   ParseOthers
  1647.                 ELSE
  1648.                   BEGIN
  1649.                     CurChPos := Ch_Pos;
  1650.                     LabelId  := Ident;
  1651.                     Get_Symbol;
  1652.                     IF      Sym = Colon THEN
  1653.                       BEGIN
  1654.                         Write (' Label declared at ', Str_Radix (PosCnt, 4, 16, 4), ' ');
  1655.                         AddLabel (Labels, PosCnt)
  1656.                       END
  1657.                     ELSE IF (Others = Equate) OR (Sym = Equal) THEN
  1658.                       BEGIN
  1659.                         Write (' Label via ');
  1660.                         IF Sym = Equal THEN
  1661.                           Write ('= ')
  1662.                         ELSE
  1663.                           Write ('EQU ');
  1664.                         Get_Symbol;
  1665.                         IF      Sym = Number THEN
  1666.                           BEGIN
  1667.                             Write (Str_Radix (Val_Radix (Num, P_Radix), 4, 16, 4), ' ');
  1668.                             AddLabel (Labels, Val_Radix (Num, P_Radix) )
  1669.                           END
  1670.                         ELSE IF Sym = Location THEN
  1671.                           BEGIN
  1672.                             Write (' $ ');
  1673.                             AddLabel (Labels, PosCnt)
  1674.                           END
  1675.                         ELSE
  1676.                           Error (' Number or $ expected')
  1677.                       END
  1678.                     ELSE
  1679.                       BEGIN
  1680.                         Write (' Location Label at ', Str_Radix (PosCnt, 4, 16, 4), ' ');
  1681.                         AddLabel (Labels, PosCnt);
  1682.                         Ch_Pos := CurChPos;
  1683.                         Sym    := Null_Sym
  1684.                       END
  1685.                   END
  1686.               END;program ziptest;
  1687.  
  1688. (*                                                      *)
  1689. (* Released to the public domain for any use whatsoever *)
  1690. (* By : William L. Mabee, CRNA                          *)
  1691. (*                                                      *)
  1692.  
  1693. type
  1694.   str2   = string[2];
  1695.   str12  = string[12];
  1696.  
  1697. procedure validate_state(state : str2; var good : boolean;
  1698.                    var ziprange : str12; var statenum : byte);
  1699. VAR
  1700.   STATESET : SET OF BYTE;
  1701. BEGIN
  1702.   IF STATE = 'AL' THEN STATENUM := 1;
  1703.   IF STATE = 'AK' THEN STATENUM := 2;   (* Alaska *)
  1704.   IF STATE = 'AZ' THEN STATENUM := 3;
  1705.   IF STATE = 'AR' THEN STATENUM := 4;
  1706.   IF STATE = 'CA' THEN STATENUM := 5;
  1707.   IF STATE = 'CO' THEN STATENUM := 6;
  1708.   IF STATE = 'CT' THEN STATENUM := 7;
  1709.   IF STATE = 'DE' THEN STATENUM := 8;
  1710.   IF STATE = 'DC' THEN STATENUM := 9;
  1711.   IF STATE = 'FL' THEN STATENUM := 10;
  1712.   IF STATE = 'GA' THEN STATENUM := 11;
  1713.   IF STATE = 'HI' THEN STATENUM := 12;
  1714.   IF STATE = 'ID' THEN STATENUM := 13;
  1715.   IF STATE = 'IL' THEN STATENUM := 14;
  1716.   IF STATE = 'IN' THEN STATENUM := 15;
  1717.   IF STATE = 'IA' THEN STATENUM := 16;
  1718.   IF STATE = 'KS' THEN STATENUM := 17;
  1719.   IF STATE = 'KY' THEN STATENUM := 18;
  1720.   IF STATE = 'LA' THEN STATENUM := 19;
  1721.   IF STATE = 'ME' THEN STATENUM := 20;              (* Maine *)
  1722.   IF STATE = 'MD' THEN STATENUM := 21;
  1723.   IF STATE = 'MA' THEN STATENUM := 22;
  1724.   IF STATE = 'MI' THEN STATENUM := 23;              (* Mich  *)
  1725.   IF STATE = 'MN' THEN STATENUM := 24;
  1726.   IF STATE = 'MS' THEN STATENUM := 25;
  1727.   IF STATE = 'MO' THEN STATENUM := 26;
  1728.   IF STATE = 'MT' THEN STATENUM := 27;
  1729.   IF STATE = 'NE' THEN STATENUM := 28;
  1730.   IF STATE = 'NV' THEN STATENUM := 29;
  1731.   IF STATE = 'NH' THEN STATENUM := 30;
  1732.   IF STATE = 'NJ' THEN STATENUM := 31;
  1733.   IF STATE = 'NM' THEN STATENUM := 32;
  1734.   IF STATE = 'NY' THEN STATENUM := 33;
  1735.   IF STATE = 'NC' THEN STATENUM := 34;
  1736.   IF STATE = 'ND' THEN STATENUM := 35;
  1737.   IF STATE = 'OH' THEN STATENUM := 36;
  1738.   IF STATE = 'OK' THEN STATENUM := 37;
  1739.   IF STATE = 'OR' THEN STATENUM  BEGIN
  1740.                 WriteLn;
  1741.                 Write (ident:31);
  1742.                 IF      check_op <> null_op THEN
  1743.                   ParseMnemonic (Check_Op)
  1744.                 ELSE IF check_reg <> null_reg THEN
  1745.                   Write (' Register')
  1746.                 ELSE IF Others <> NullOther THEN
  1747.                   ParseOthers
  1748.                 ELSE
  1749.                   BEGIN
  1750.                     CurChPos := Ch_Pos;
  1751.                     LabelId  := Ident;
  1752.                     Get_Symbol;
  1753.                     IF      Sym = Colon THEN
  1754.                       BEGIN
  1755.                         Write (' Label declared at ', Str_Radix (PosCnt, 4, 16, 4), ' ');
  1756.                         AddLabel (Labels, PosCnt)
  1757.                       END
  1758.                     ELSE IF (Others = Equate) OR (Sym = Equal) THEN
  1759.                       BEGIN
  1760.                         Write (' Label via ');
  1761.                         IF Sym = Equal THEN
  1762.                           Write ('= ')
  1763.                         ELSE
  1764.                           Write ('EQU ');
  1765.                         Get_Symbol;
  1766.                         IF      Sym = Number THEN
  1767.                           BEGIN
  1768.                             Write (Str_Radix (Val_Radix (Num, P_Radix), 4, 16, 4), ' ');
  1769.                             AddLabel (Labels, Val_Radix (Num, P_Radix) )
  1770.                           END
  1771.                         ELSE IF Sym = Location THEN
  1772.                           BEGIN
  1773.                             Write (' $ ');
  1774.                             AddLabel (Labels, PosCnt)
  1775.                           END
  1776.                         ELSE
  1777.                           Error (' Number or $ expected')
  1778.                       END
  1779.                     ELSE
  1780.                       BEGIN
  1781.                         Write (' Location Label at ', Str_Radix (PosCnt, 4, 16, 4), ' ');
  1782.                         AddLabel (Labels, PosCnt);
  1783.                         Ch_Pos := CurChPos;
  1784.                         Sym    := Null_Sym
  1785.                       END
  1786.                   END
  1787.               END;
  1788.             number     : Write ('Number     : ', num:4, ' Radix : ', p_radix:2, ' Value : ', val_radix (num, p_radix):5);
  1789.             str_data   : Generate (chars);
  1790.             operation  : Write ('Operation  : ', ch);
  1791.             left_bp    : Write ('Memory go  : ', ch);
  1792.             right_bp   : Write ('Memory end : ', ch);
  1793.             comma      : Write (' Comma');
  1794.             period     : Write ('Directive');
  1795.             colon      : Write (' Label');
  1796.             location   : Write ('Location counter ', PosCnt);
  1797.             equal      : Write ('Equal')
  1798.           END;
  1799.           get_symbol
  1800.         END
  1801.     END;  { parser }
  1802.  
  1803.   FUNCTION FoundLabel (     ALabel : LabelPtr;
  1804.                             AName  : LabelStr;
  1805.                         VAR Value  : Integer ) : Boolean;
  1806.  
  1807.     BEGIN { FoundLabel }
  1808.       IF      ALabel = Nil THEN
  1809.         FoundLabel := False
  1810.       ELSE IF AName < ALabel^.Name THEN
  1811.         FoundLabel := FoundLabel (ALabel^.Left, AName, Value)
  1812.       ELSE IF AName > ALabel^.Name THEN
  1813.         FoundLabel := FoundLabel (ALabel^.Right, AName, Value)
  1814.       ELSE
  1815.         BEGIN
  1816.           Value      := ALabel^.Loc;
  1817.           FoundLabel := True
  1818.         END
  1819.     END;  { FoundLabel }
  1820.  
  1821.   PROCEDURE SetValue ( RecNum : Integer;
  1822.                        Value  : Integer;
  1823.                        Both   : Boolean );
  1824.  
  1825.     VAR
  1826.       LoByte : Byte;
  1827.       HiByte : Byte;
  1828.  
  1829.     BEGIN { SetValue }
  1830.       LoByte := Lo (Value);
  1831.       HiByte := Hi (Value);
  1832.       IF Both THEN
  1833.         Write ('':3, Str_Radix (Value, 4, 16, 4) )
  1834.       ELSE
  1835.         Write ('':3, Str_Radix (LoByte, 2, 16, 4) );
  1836.       Seek (GenFile, RecNum);
  1837.       IF Both THEN
  1838.         Write (GenFile, LoByte, HiByte)
  1839.       ELSE
  1840.         Write (GenFile, LoByte)
  1841.     END;  { SetValue }
  1842.  
  1843.   PROCEDURE ShowLabels ( ALabel : LabelPtr );
  1844.  
  1845.     BEGIN { ShowLabels }
  1846.       IF ALabel <> Nil THEN
  1847.         WITH ALabel^ DO
  1848.           BEGIN
  1849.             ShowLabels (Left);
  1850.             WriteLn ('':2, Name:16, '':2, Str_Radix (Loc, 4, 16, 4) );
  1851.             ShowLabels (Right)
  1852.           END
  1853.     END;  { ShowPatches }
  1854.  
  1855.   PROCEDURE FixPatches ( APatch : PatchPtr );
  1856.  
  1857.     VAR
  1858.       Value  : Integer; { Address or Data of Label }
  1859.       OValue : Integer;
  1860.  
  1861.     BEGIN { FixPatches }
  1862.       IF APatch <> Nil THEN
  1863.         WITH APatch^ DO
  1864.           BEGIN
  1865.             FixPatches (LeftPatch);
  1866.             IF NOT FoundLabel (Labels, PName, OValue) THEN
  1867.               Error ('Unable to locate label ' + PName)
  1868.             ELSE
  1869.               BEGIN
  1870.                 WriteLn;
  1871.                 Write ('':2, PName);
  1872.                 REPEAT
  1873.                   WITH FixLoc^ DO
  1874.                     BEGIN
  1875.                       Value := OValue;
  1876.                       IF OSet THEN
  1877.                         Value := Value - PLoc - 1;
  1878.                       CASE Oprtion OF
  1879.                         '+' : Value := Value + PAdj;
  1880.                         '-' : Value := Value - PAdj;
  1881.                         '*' : Value := Value * PAdj;
  1882.                         '/' : Value := Value DIV PAdj
  1883.                       END;
  1884.                       SetValue (PLoc, Value, TwoBytes)
  1885.                     END;
  1886.                   FixLoc := FixLoc^.PNext
  1887.                 UNTIL FixLoc = Nil
  1888.               END;
  1889.             FixPatches (RightPatch)
  1890.           END
  1891.     END;  { FixPatches }
  1892.  
  1893.   BEGIN { z80_assembler }
  1894.     initialize;
  1895.     parser;
  1896.     WriteLn;
  1897.     WriteLn;
  1898.     WriteLn ('Labels');
  1899.     ShowLabels (Labels);
  1900.     WriteLn;
  1901.     WriteLn;
  1902.     WriteLn ('Second pass');
  1903.     FixPatches (Patches);
  1904.     WriteLn;
  1905.     WriteLn ('End assembly');
  1906.     Close (GenFile)
  1907.   END   { z80_assembler }.