********************************************************************
* Basic09 - BASIC for OS-9
*
* $Id$
*
* Edt/Rev  YYYY/MM/DD  Modified by
* Comment
* ------------------------------------------------------------------
*  22      2002/10/09  Boisy G. Pitre
* Obtained from Curtis Boyle, marked V1.1.0.
*
* BASIC09 - Copyright (C) 1980 by Microware & Motorola
***********
* Basic09 & RunB programs have extended memory module headers. Layout is as
*  follows:
*   Offset  | Name       | Purpose
*   --------+------------+----------
*   $0000   |  M$ID      | Module sync bytes ($87CD)
*   $0002   |  M$Size    | Size of module
*   $0004   |  M$Name    | Offset to module name
*   $0006   |  M$Type    | Type/Language ($22 for RUNB modules)
*   $0007   |  M$Revs    | Attributes/Revision level
*   $0008   |  M$Parity  | Header parity check
*   $0009   |  M$Exec    | Execution offset (start of tokenized RUNB code)
*   $000B   |  ???       | Data area size required
*   $000D   |  ???       | ???
*   $0017   |  ???       | Flags:
*           |            |   x0000000 - 1=Packed, 0=Not packed
*           |            |   0x000000 - ??? but 1 when CRC has just been made
*           |            |   0000000x - 1=Line with compiler error
*           |            |              0=No lines with compiler errors
*   $0018   |  ???       | Size of module name
* NitrOS9 V1.21 mods
* 06/17/94 - Changed intercept routine @ L07B5: Replaced LSL <u0034/COMA/
*            ROR <u0034/RTI with OIM #$80,<u0034/RTI/NOP/NOP 
*          - Changed routine @ start:
*               FROM                TO
*          4   LEAU >$100,u    4   LDW #$100
*          1   CLRA            2   CLR ,-s
*          1   CLRB            3   TFM s,u+
*          2   STD  ,--u       2   LEAS 1,s
*          3   CMPU ,s         1   NOP
*          2   BHI  L07C9      1   NOP
* Bytes:  15                  15
*          - Changed CLRA/LDB #$01 to LDD #$0001 @ end of start
* 06/22/94 - Changed L0DBB (reset temp buffer to empty state) to use PSHS D
*          - LDA #1 / STA <u007D / LDD <u0080 / STD <u0082 / PULS PC,D
*            (saves 5 cycles) ALSO WORKS AS 6809 MOD
*          - Changed BEQ L08E3 to BEQ L08E5 @ L08D3 (Std in for commands)
*          - Changed numerous CLRA/CLRB and COMA/COMB to CLRD & COMD respectiv
*            just to shorten source
* 06/27/94 - Added 2nd TFM to init routine to clear out $400-$4ff
* 06/28/94 - Changed BRA L5632 @ L5614 to PULS PC,U,A (6809 TOO)
* 12/22/94 - BIG TEST: TOOK OUT NOP'D CODE - SEE IF IT STILL WORKS
*          - IT DOESN'T - MOVED ALL NOPS TO JUST BEFORE ICPT ROUTINE TO
*            SEE IF THE SEPARATION OF CODE & DATA MAKES A DIFFERENCE
*          - THIS APPEARS TO WORK...THEREFORE, SOME REFERENCES TO THE DATA
*            AT THE BEGINNING OF BASIC09 IS STILL BEING REFERRED TO BY OFFSETS
*            IN THE CODE, THAT HAVE NOT BEEN FIXED UP YET.
* 12/23/94 - AFTER FIXING L03F0 TABLE, ATTEMPTED TO REMOVE 'TEST'
* 12/28/94 - Worked, changed 16 bit,pc's to 8 bit,pc's @:
*            L0DFC  leax L0E5F,pc  *
*            L1436  leax L1434,pc  *
*            L15B3  leax L15AA,pc  *
*            L1B97  leax L1B93,pc  *  (Doesn't seem to be referenced)
*            L39E0  leax L39DA,pc  *
*            L4751  leax L474D,pc  *
*            L479F  leax L479A,pc  *
*            L4812  leax L4805,pc  *
*            L4B03  leau L4AF4,pc  *
*            L4B0A  leau L4AF9,pc  *
*            L5791  leax L5723,pc  *
* 01/03/95 - Changed a ChgDir @ L397D to do it in READ mode, not UPDATE
* 01/04/95 - Changed L0C18 - 3 CLR ,Y+ to LEAY 3,Y
*            Changed LEAU ,Y / STD ,--U / STA ,-U to LEAU -3,y/STD ,u/
*              STD 2,u
*          - Changed LDA #$02 / LDB #SS.Size to LDD #$02*256+SS.Size @ L0D6B
*              (create output file)
*          - Replaced BEQ L2D17 @ L2D0B with BEQ L2CE1, removed L2D17 altog-
*            ether, change LBSR L2A26 @ L2D0B with LBRA L2A26
* 01/09/95 - Attempted to change both CLRA/CLRB (CLRD)'s @ L0F96 to CLRA for
*            F$Load/F$Link (since neither require B)
*          - Changed L0C83 frm LBSR L12CF to LBSR L1371
*          - Changed L12CF from LDA #C$CR/LBRA L1373 to LBRA L1371
* 01/12/95 - Attempted to remove LDD <U002F / ADDD $F,x @ L1A2E, move TFR
*            D,Y to earlier in code when [u002F]+($F,x) is calculated
* 01/17/95 - Removed useless CMPB #$00 @ L1E9B
*          - Moved L1FF5 label to an earlier RTS, removed original (saves 1 by
*          - Removed useless CMPA #$00 @ L2115
* 01/19/95 - Changed STB <u00A4 / STA <u00A3 to STD <u00A3 @ L236A
*          - Changed LDA <u00A3/CMPA <u00A3 to LDA <u00A3/ORCC #Zero @ L218E
*             (1 cycle faster)
*          - Changed L243F: took out LEAY -1,y, added BRA L2453 (saves 2 cycle
*             from original method)
* 01/20/95 - Changed L1B09 from to auto-inc Y, skip LEAY 1,Y entirely, & chang
*            LEAY 5,Y to LEAY 4,Y (+2 cyc if [,y]=$4F, but -3 cyc on any other
*            value)
*          - Changed L1B6D: changed CLRA / LDB D,X to to ABX / LDB ,X (3 cyc
*            faster on 6809/2 cyc faster on 6309)
*          - Mod @ L233E: Changed LBSR L2430 to LBSR L2432 (just did
*            L245D call, and 2nd call to it will return same Y anyways)
*          - Changed CLR ,Y+ to STB ,Y+ @ L2494
*          - Attempted to move L2368 routine to just before L239D routine to
*            change LBRA L2415 to BRA L2415. Changed L23EC from LBRA L236A to
*            STD <u00A3 / BRA L2415
*          - Changed LBHS L2A0D / BRA L27CE @ L27A3 to BLO L27CE / LBRA L2A0D
*          - Attempted Mod @ L2D2C - Changed LEAX B,X to ABX
* 01/23/95 - Made following mods involving L2E3B routine:
*            Changed CMPA #0 to TSTA, reversed L2EDC's LDA <u00D1 & LEAY 3,Y 
*            so TSTA not needed, changed BRA L2E3B to BRA L2E41 @: L2E89,
*            L2E8F, L2E95, L2E9F. Changed BRA L2E3B to BRA L2E3C @ L2EDC
*          - Changed LDA #1 to INCA @ L2E3B (since A=0 at this point)
*          - Took out CMPA #0, changed LDD #$0060 to LDB #$60 @ L2EE3
*          - Changed TST <u00D0 to LDA <u00D0 (saves 2 cyc) and following 4
*            lines @ L2F5E to version on right (+1 byte, -5 cycles):
*            lda #5             ldd #$ffff
*            sta <u00D1         std <u00D4
*            ldd #$ffff         lda #5
*            bra L2FB9          sta <u00D1
*              (std <u00D4/     rts
*               lda <u00D1/rts
* 01/31/95 - Moved L308D to just before L26CE (eliminates LBRA)
* 02/03/95 - Changed LBRA L1EC9 @ L216B to LBRA L233E (saves extra LBRA, saves
*            5/4 cycles)
* 02/13/95 - Moved JSR <u001B / FCB 8 from L3C29 to just after L4F77 to change
*            LBSR to BSR
* 02/14/95 - Moved 3 text strings that are only referred to once to their res-
*            pective routines in the code: L07AA to near L1882, L078B to near
*            L198A, and L0799 to L1211
*          - Moved JSR <u001E / FCB 4 from L010A to after L090F (called twice
*            from just before here)
*          - Attempted to move JSR <u001E / fcb 2 from L010D to just before
*            L0AC3 (change some LBSR's to BSR's)
*          - Moved L0110 (JSR <u001E / fcb 0) to just before L0DF6
*          - Moved L0113 (JSR <u0021 / fcb 0) to just before L0DF6
* 02/15/95 - Moved L0116 (JSR <u0024 / fcb 0) to just after L082E
*          - Moved L0119 (JSR <u0024 / fcb 0) to just after L0DFC
*          - Moved L011C (JSR <u0024 / fcb 2) to just after L0DFC
*          - Moved L011F (JSR <u002A / fcb 2) to just after L1394
*          - Moved L0122 (JSR <u001E / fcb A) to just before L1606
*          - Moved L0125 (JSR <u001E / fcb 6) to just after L19D1
*          - Moved L0128 (JSR <u001E / fcb 6) to just after L0B51
*          - Moved L012B (JSR <u0021 / fcb 6) to just after L110A
*          - Moved L012E (JSR <u0021 / fcb 4) to just after L119E
*          - REMARKED OUT L0131 JSR VECTOR - NOT CALLED IN BASIC09
*          - Moved L0134 (JSR <u0024 / fcb C) to just after L104E
*          - Moved L0137 (JSR <u0024 / fcb 8) to just after L119E
*          - Moved L013A (JSR <u002A / fcb 0) to just after L175A
*          - Moved L1CC1 (JSR <u001B / fcb 2) to just after L1E1C
*          - Moved L1CC4 (JSR <u001B / fcb 4) to just after L1E1F
*          - Moved L1CC7 (JSR <u001B / fcb 6) to replace LBRA L1CC7 @ L1E1C
*            & embedded JSR <u001B/fcb 4 @ L2428 since LBRA, not LBSR
*          - Moved L1CCA (JSR <u002A / fcb 0) to just after L239D
*          - Moved L1CCD (JSR <u001B / fcb $12) to just after L22C7
*          - Took out 2nd TST <u0035 / BNE L194C @ L191C
*          - Eliminated L2572 since duplicate of L1CC1, & not speed crucial
*          - Eliminated L2575 since duplicate of L1CC7, changed LBRA L2575 @
*            L2A0D to LBRA L1CC7
* 02/16/95 - Moved L2578 (JSR <u001B / fcb $14) to end of L2FDA (replacing
*            LBRA to it)
*          - Moved L257B (JSR <u001E / fcb 8) to end of L3069
*          - Moved L257E (JSR <u001E / fcb 6) to end of L310B
*          - Eliminated L3206 since duplicate of L1CC7, changed 3 LBRA calls
*            to it to go to L1CC7 instead (saves 3 bytes)
*          - Moved L3209 to just after table @ L323F, changed table entry from
*            L35F0 to L3209, eliminated L35F0 LBRA entirely
*          - Moved L320C (JSR <u001B / fcb $E) to end of L39A0
* 02/24/95 - Eliminated L320F since dupe of L1CC1, change appropriate LBSR's @
*            L3A1B & L3A23
*          - Moved L3212 (JSR <u001B / fcb 0) to end of L3A89
* 02/27/95 - Moved L3215 (JSR <u001B / fcb $A) to end of L3BF3
*          - Moved L3218 (JSR <u001B / fcb $10) to end of L3A42
*          - Took out L321B (JSR <u001E/fcb 6), replaced LBRA to it @ L35CA
*            with JSR/fcb
*          - Moved L321E (JSR <u0027/fcb 4) to end of L347E
*          - Moved L3221 (JSR <u0027/fcb $A) to end of L348E
*          - Moved L3224 (JSR <u0027/fcb 2) to before L3A8A, and moved 2 lines
*            from L35BB to here too)
*          - Moved L3227 (JSR <u0027/fcb $C) to after L381C
*          - Moved L322A (JSR <u0027/fcb $E) to after L381C
*          - Moved L322D (JSR <u0027/fcb 0) to after L3BFF
*          - Moved L3230 (JSR <u002A/fcb 2), even though dupe of L011F, to
*            after L3779
* 02/28/95 - Embedded L3233 (JSR <u001B/fcb $18) @ L35F3 & L3A23, changed LBSR
*            @ L3371 to point to L35F3 version
*          - Moved L3236 (JSR <u001B/fcb $16) to after L3391
*          - L3239 (JSR <u001B/fcb $1A) is NEVER CALLED IN BASIC09.
*            Removed L3239 entirely
*          - Embedded L323C (JSR <u001B/fcb $1C) @ L34DC since LBRA
*          - Changed LDB #0 @ L388F to CLRB
*          - Embedded L3C2C (JSR <u0024/fcb 6 (error handler)) @ L3DD5,L3E78,
*            L3F2E,L44C2,L458C,L491C,L4FC7) Moved it to just after L40CC.
*          - Changed LDB #0 @ L4409 to CLRB (part of Boolean routines)
*          - Changed LDB #0 @ L5046 to CLRB
*          - Removed L3C2F (dupe of L011F), changed LBSR's @ L471F & L4FAA to
*            it
*          - Moved L3C32 to after L505E (shorten LEAX)
* 03/01/95 - Modified Integer Multiply to use MULD @ L3EE1
* 03/10/95 - Modified Negate of REAL #'s to use EIM @ L3FA4 (saves 4 cyc)
*          - Changed L3FBB (Real add with dest var=0) to use LDQ/STQ (saves
*            6 cyc)
* 03/13/95 - Changed NEGA/NEGB/SBCA #0 to NEGD @ L4512 & L4591
*          - Changed BPL L451E to BPL L451F @ L4512 (eliminates 2nd useless
*            TSTA)
* 03/15/95 - Changed LDB $B,y/ANDB #$FE/STB $B,y & LDB 5,y/ANDB #$FE/STB $B,y
*            to AIM's @ L3FE5 (Real Add & Subtract)
*          - Changed ADCB 3,y/ADCA 2,y to ADCD 2,y @ L4039 (Real Add/Subtact)
*          - Changed SBCB 3,y/SBCA 2,y TO SBCD 2,y @ L400B (Real Add/Subtact)
*          - Changed LDA 5,y/ANDA #$FE/STA 5,y to AIM #$FE,5,y @ L45AE (ABS
*            for real #'s
*          - Changed NEGA/NEGB/SBCA #0 to NEGD @ L45B5 (ABS for Integers)
*          - Ditched special checks for 0 or 2 in Integer Multiply (L3EC1),
*            since overhead from checks is as slow or slower as straight MULD
*            except in dest. var=0's case
* 03/16/95 - Changed 2 LDD/STD's @ L3F93 to LDQ/STQ
* 03/18/95 - Changed Integer Divide (and MOD) routines to use DIVQ
* 03/20/95 - Changed L3F7C (copy Real # to temp var from inc'd X) to use
*            LDQ/STQ/LDB #4/ABX
*          - Moved Integer MOD routine (L46A2) to nearer divide (changes LBSR
*            to BSR)
* 04/23/95 - Changed Real Add/Subtract mantissa shift (L4082-L40C9) to use
*            <u0014 (unused in BASIC09) to hold shift count instead of stack
*            (saves 2 cyc for STA vs. PSHS, saves 1 cyc per DEC, & saves 5 cyc
*            by eliminating LEAS 1,s) (6809)
* 04/26/95 - Split real add/subtract out & made two versions: 6809 & 6309
* 06/09/95 - Modified 6309 REAL add/subtract routine - now 13-15% faster
* 06/20/95 - Took out useless LDB 2,s @ L412D (Real Multiply)
* 07/18/95 - Changed sign fix in Real Add @ L4071 to use TFR w,d/lsrb/lslb/orb
*            ,y/std $a,y
*          - Split real multiply out & made two versions: 6809 & 6309
* 08/11/95 - Removed useless LEAS 1,s in Init routine
*          - Split real divide out & made two versions: 6809 & 6309
* 08/15/95 - Removed useless: STA <u00BD in start, useless CLR <u0035 @ L07FC,
*            Changed LDD #1 to LDB #1/STD <u002D to STB <u002E in start, and
*            L07FC/L082E routine to use W instead of stack for base address
*          - Changed 'bye <CR>' buffer fill @ L08E5 to use LDQ/STQ
* 11/12/95 - Changed L3405 to use INCD instead of ADDD #1 (NEXT Integer STEP 1
*          - Changed L341E to TFR A,E instead of PSHS A, changed TST ,S+ to
*            TSTE (NEXT Integer STEP <>1)
* 11/16/95 - Changed to L345E (REAL NEXT STEP 1) to do direct call to REAL add
*            routine (changed BSR L321E/BSR L34DC to LBSR L3FB1)
*          - As per above, changed same call @ L34A5 (REAL NEXT STEP <>1), and
*            eliminated L321E completely
*          - @ L347E & L34CC, eliminated L3221 calls, replaced BSR L3221's
*            with LBSR L4449 (Real Compare) (in REAL NEXT, both cases)
* 11/25/95 - Remove L50A1 & L509E (calls to REAL Multiply & REAL divide),
*            changed L529B to call them directly (prints exponents?)
* 11/30/95 - Changed L3AF9 to use SUBR (saves 1 byte/9 cyc on RUN (mlsub)
* 12/05/95 - Changed L3A48 (called by REM) to use ABX instead of CLRA/LEAX D,X
*            (used to jump ahead in I-Code to skip remark text)
*          - Attempted to just move L33DF (NEXT) & L34E5 (FOR) Tables to just
*            after L3446 for 8 bit offsets - also removed LSLB @ L33EA
* 02/12/95 - Changed routines around L57EB to skip ORCC if not necessary (blo&
*            bcs)
*          - Changed LEAX to 8 bit from 16 @ L4B89
********************************

* Version Numbers
B09Vrsn  equ   1         
B09Major equ   1         
B09Minor equ   0         

         NAM   Basic09   
         TTL   BASIC for OS-9

         IFP1            
         USE   defsfile  
         ENDC            

         mod   eom,name,Prgrm+Objct,ReEnt+0,start,size

u0000    rmb   2          Start of data memory / DP pointer
u0002    rmb   2          Size of Data area (including DP)
u0004    rmb   2          Ptr to list of Modules in BASIC09 workspace ($400)
u0006    rmb   1          ??? NEVER REFERENCED (possibly leftover from RUNB)
u0007    rmb   1          ??? NEVER REFERENCED
u0008    rmb   2          Ptr to start of I-code workspace
u000A    rmb   2          # bytes used by all programs for code in user workspace
* Data area sizes are taken from module headers Permanent storage size ($B-$C)
u000C    rmb   2          Bytes free in BASIC09 workspace for user
u000E    rmb   2          Ptr to jump table (L323F only) - Only used from L3D4A
u0010    rmb   2          Inited to L3CB5 (jump table)
u0012    rmb   2          Inited to L3D35 (jump table)
u0014    rmb   1          ??? NEVER REFERENCED
u0015    rmb   1          ??? NEVER REFERENCED
u0016    rmb   1          JMP ($7e) instruction
u0017    rmb   2          Address for above (inited to L3D41)
u0019    rmb   2          Inited to L3C32 (JSR <u001B / FCB $1A)
* The following vectors all contain a JMP >$xxxx set up from the module header
u001B    rmb   3          Jump vector #1  (Inited to L00DC)
u001E    rmb   3          Jump vector #2  (Inited to L1CA5)
u0021    rmb   3          Jump vector #3  (Inited to L255A)
u0024    rmb   3          Jump vector #4  (Inited to L31E8)
u0027    rmb   3          Jump vector #5  (Inited to L3C09)
u002A    rmb   3          Jump vector #6  (Inited to L5084)
u002D    rmb   1          Standard Input path # (Inited to 0)
u002E    rmb   1          Standard Output path # (inited to 1)
u002F    rmb   2          Ptr to start of 'current' module in BASIC09 workspace
u0031    rmb   2          Ptr to start of variable storage
u0033    rmb   1         
u0034    rmb   1          Flag: if high bit set, signal has been receieved
u0035    rmb   1          Last signal received
u0036    rmb   1          Error code
u0037    rmb   2         
u0039    rmb   1         
u003A    rmb   1         
u003B    rmb   1         
u003C    rmb   1         
u003D    rmb   1         
u003E    rmb   1         
u003F    rmb   1         
u0040    rmb   2         
u0042    rmb   1         
u0043    rmb   1         
* Next 2 are variable ptrs of some sort, temporary? Permanent?
u0044    rmb   2          Inited to $300 (some table that is built backwards)
u0046    rmb   2          Inited to $300
u0048    rmb   1         
u0049    rmb   1         
u004A    rmb   2          Ptr to end of currently used I-code workspace+1
u004C    rmb   1         
u004D    rmb   1         
u004E    rmb   2         
u0050    rmb   1          Inited to $0e
u0051    rmb   1          Inited to $12
u0052    rmb   1          Inited to $14
u0053    rmb   1          Inited to $A2
u0054    rmb   1          Inited to $BB
u0055    rmb   1          Inited to $40
u0056    rmb   1          Inited to $E6
u0057    rmb   1          Inited to $2D
u0058    rmb   1          Inited to $36
u0059    rmb   1          Inited to $19
u005A    rmb   2          Inited to $62E9
u005C    rmb   2         
u005E    rmb   2          Absolute exec address of basic09 module in memory
u0060    rmb   2          Absolute address of $F offset in basic09 mod in mem
u0062    rmb   2          Absolute address of $D offset in basic09 mod in mem
u0064    rmb   2          ??? Size of module-$D,x in mod hdr + 3
u0066    rmb   1         
u0067    rmb   1         
u0068    rmb   1         
u0069    rmb   1         
u006A    rmb   1         
u006B    rmb   1         
u006C    rmb   1         
u006D    rmb   1         
u006E    rmb   1         
u006F    rmb   1         
u0070    rmb   2         
u0072    rmb   2         
u0074    rmb   1         
u0075    rmb   1         
u0076    rmb   1         
u0077    rmb   1         
u0078    rmb   1         
u0079    rmb   1         
u007A    rmb   1         
u007B    rmb   1         
u007C    rmb   1         
u007D    rmb   1          Current # chars active in temp buffer ($100-$1ff)
u007E    rmb   1         
u007F    rmb   1         
u0080    rmb   2          Pointer to start of temp buffer ($100)
u0082    rmb   2          Pointer to current position in temp buffer ($100-$1ff)
u0084    rmb   1         
* For u0085, the following applies:
* 0=Integer, 1=Hex, 2=Real, 3=Exponential, 4=String, 5=Boolean, 6=Tab,
* 7=Spaces, 8=Quoted text
u0085    rmb   1          Specifier # for print using
u0086    rmb   1         
u0087    rmb   1         
u0088    rmb   1         
u0089    rmb   1         
u008A    rmb   1         
u008B    rmb   1         
u008C    rmb   2         
u008E    rmb   2         
u0090    rmb   1         
u0091    rmb   1         
u0092    rmb   2         
u0094    rmb   1         
u0095    rmb   1         
u0096    rmb   1         
u0097    rmb   1         
u0098    rmb   1         
u0099    rmb   1         
u009A    rmb   1         
u009B    rmb   1         
u009C    rmb   1         
u009D    rmb   1         
u009E    rmb   2          Ptr to current command table (normally L0140)
u00A0    rmb   1          ??? Flag of some sort?
u00A1    rmb   2         
u00A3    rmb   1          Token # from command table
u00A4    rmb   1          Command type (flags?) from command table
u00A5    rmb   1          Flag type of name string (2=Non variable)
u00A6    rmb   1          Size of current string/variable name (includes '$' on strings)
u00A7    rmb   2          Ptr to end of name string+1
u00A9    rmb   2          ??? Ptr of some sort
u00AB    rmb   2          Ptr to current line I-code end
u00AD    rmb   2          ??? Dupe of above
u00AF    rmb   2          ??? duped from AB @ L1F90
u00B1    rmb   2         
u00B3    rmb   2          # steps to do (debug mode from STEP command)
u00B5    rmb   2         
u00B7    rmb   2         
u00B9    rmb   1         
u00BA    rmb   1         
u00BB    rmb   1          ??? (inited to 0 at during load process)
u00BC    rmb   1         
u00BD    rmb   1          (inited to 0) - Path # of newly opened path
u00BE    rmb   1          I$Dup path # for duplicate of error path
u00BF    rmb   2         
u00C1    rmb   2         
u00C3    rmb   2         
u00C5    rmb   1         
u00C6    rmb   1         
u00C7    rmb   1         
u00C8    rmb   2         
u00CA    rmb   1         
u00CB    rmb   1         
u00CC    rmb   1         
u00CD    rmb   1         
u00CE    rmb   1         
u00CF    rmb   1         
u00D0    rmb   1         
u00D1    rmb   1          Some sort of variable type
u00D2    rmb   2         
u00D4    rmb   2         
u00D6    rmb   2          Size of var in bytes (from u00D1)
u00D8    rmb   1         
u00D9    rmb   1          Inited to 1
u00DA    rmb   1         
u00DB    rmb   1         
u00DC    rmb   1         
u00DD    rmb   1         
u00DE    rmb   1         
u00DF    rmb   1         
u00E0    rmb   1         
u00E1    rmb   1         
u00E2    rmb   2         
u00E4    rmb   1         
u00E5    rmb   1         
u00E6    rmb   2         
u00E8    rmb   2         
u00EA    rmb   1         
u00EB    rmb   4         
u00EF    rmb   3         
u00F2    rmb   1         
u00F3    rmb   6         
u00F9    rmb   1         
u00FA    rmb   4         
u00FE    rmb   1         
u00FF    rmb   1         
u0100    rmb   $100       256 byte temporary buffer for various things
u0200    rmb   $100       ??? ($200-$2ff) built backwards 2 bytes/time
u0300    rmb   $100       BASIC09 stack area ($300-$3ff)
u0400    rmb   $100       List of module ptrs (modules in BASIC09 workspace)
u0500    rmb   $100       I-Code buffer (for running)
u0600    rmb   $2000-.    Default buffer for BASIC09 programs & data
size     equ   .         

* Jump tables installed at $1b in DP: in form of JMP to (address of BASIC09's
* header in memory + 2 byte in table). In other words, jump to LXXXX
L000D    fdb   L00DC      $1b jump vector
         fdb   L1CA5      $1e jump vector
         fdb   L255A      $21 jump vector
         fdb   L31E8      $24 jump vector
         fdb   L3C09      $27 jump vector
         fdb   L5084      $2A jump vector
         fdb   $0000      End of jump vector table marker

name     fcs   /Basic09/ 

L0022    fdb   $1607      Edition #22 ($16)

* Intro screen

L0024    fcb   $0C       
         fcc   '            BASIC09'
         fcb   $0A       
         IFNE  H6309     
         fcc   '     6309 VERSION 0'
         ELSE            
         fcc   '     6809 VERSION 0'
         ENDC            
         fcb   B09Vrsn+$30
         fcc   '.0'      
         fcb   B09Major+$30
         fcc   '.0'      
         fcb   B09Minor+$30
         fcb   $0A       
         fcc   'COPYRIGHT 1980 BY MOTOROLA INC.'
         fcb   $0A       
         fcc   '  AND MICROWARE SYSTEMS CORP.'
         fcb   $0A       
         fcc   '   REPRODUCED UNDER LICENSE'
         fcb   $0A       
         fcc   '       TO TANDY CORP.'
         fcb   $0A       
         fcc   '    ALL RIGHTS RESERVED.'
         fcb   $8A       

* Jump vector @ $1B goes here
L00DC    pshs  x,d        Preserve regs
         ldb   [<$04,s]   Get function offset
         leax  <L00EC,pc  Point to vector table
         ldd   b,x        Get return offset
         leax  d,x        Point to return address
         stx   $4,s       Change RTS address to it
         puls  d,x,pc     restore regs and return to new address

* Vector offsets for above routine ($1B vector)

L00EC    fdb   L0F91-L00EC Function 0
         fdb   L1287-L00EC Function 2   Print error message (B=Error code)
         fdb   L0899-L00EC Function 4
         fdb   L088F-L00EC Function 6
         fdb   L18BE-L00EC Function 8
         fdb   L0E73-L00EC Function A
         fdb   L0E6D-L00EC Function C
         fdb   L0E8F-L00EC Function E
         fdb   L1BA2-L00EC Function 10
         fdb   L12F9-L00EC Function 12
         fdb   L19B1-L00EC Function 14
         fdb   L110C-L00EC Function 16
         fdb   L1026-L00EC Function 18
         fdb   L10AC-L00EC Function 1A (Pointed to by <u0019 & <u0017)
         fdb   L10B1-L00EC Function 1C

* UNUSED IN BASIC09
*L0131    jsr   <u0024
*         fcb   $0A 

* token/command type & command list?
         fdb   114        # entries in table
         fcb   2          # bytes to start text

L0140    fdb   $0101     
L0142    fcs   'PARAM'   
         fdb   $0201     
L0149    fcs   'TYPE'    
         fdb   $0301     
L014F    fcs   'DIM'     
         fdb   $0401     
L0154    fcs   'DATA'    
         fdb   $0501     
L015A    fcs   'STOP'    
         fdb   $0601     
L0160    fcs   'BYE'     
         fdb   $0701     
L0165    fcs   'TRON'    
         fdb   $0801     
L016B    fcs   'TROFF'   
         fdb   $0901     
L0172    fcs   'PAUSE'   
         fdb   $0A01     
L0179    fcs   'DEG'     
         fdb   $0B01     
L017E    fcs   'RAD'     
         fdb   $0C01     
L0183    fcs   'RETURN'  
         fdb   $0D01     
L018B    fcs   'LET'     
         fdb   $0F01     
L0190    fcs   'POKE'    
         fdb   $1001     
L0196    fcs   'IF'      
         fdb   $1101     
L019A    fcs   'ELSE'    
         fdb   $1201     
L01A0    fcs   'ENDIF'   
         fdb   $1301     
L01A7    fcs   'FOR'     
         fdb   $1401     
L01AC    fcs   'NEXT'    
         fdb   $1501     
L01B2    fcs   'WHILE'   
         fdb   $1601     
L01B9    fcs   'ENDWHILE'
         fdb   $1701     
L01C3    fcs   'REPEAT'  
         fdb   $1801     
L01CB    fcs   'UNTIL'   
         fdb   $1901     
L01D2    fcs   'LOOP'    
         fdb   $1A01     
L01D8    fcs   'ENDLOOP' 
         fdb   $1B01     
L01E1    fcs   'EXITIF'  
         fdb   $1C01     
L01E9    fcs   'ENDEXIT' 
         fdb   $1D01     
L01F2    fcs   'ON'      
         fdb   $1E01     
L01F6    fcs   'ERROR'   
         fdb   $1F01     
L01FD    fcs   'GOTO'    
         fdb   $2101     
L0203    fcs   'GOSUB'   
         fdb   $2301     
L020A    fcs   'RUN'     
         fdb   $2401     
L020F    fcs   'KILL'    
         fdb   $2501     
L0215    fcs   'INPUT'   
         fdb   $2601     
L021C    fcs   'PRINT'   
         fdb   $2701     
L0223    fcs   'CHD'     
         fdb   $2801     
L0228    fcs   'CHX'     
         fdb   $2901     
L022D    fcs   'CREATE'  
         fdb   $2A01     
L0235    fcs   'OPEN'    
         fdb   $2B01     
L023B    fcs   'SEEK'    
         fdb   $2C01     
L0241    fcs   'READ'    
         fdb   $2D01     
L0247    fcs   'WRITE'   
         fdb   $2E01     
L024E    fcs   'GET'     
         fdb   $2F01     
L0253    fcs   'PUT'     
         fdb   $3001     
L0258    fcs   'CLOSE'   
         fdb   $3101     
L025F    fcs   'RESTORE' 
         fdb   $3201     
L0268    fcs   'DELETE'  
         fdb   $3301     
L0270    fcs   'CHAIN'   
         fdb   $3401     
L0277    fcs   'SHELL'   
         fdb   $3501     
L027E    fcs   'BASE'    
         fdb   $3701     
L0284    fcs   'REM'     
         fdb   $3901     
L0289    fcs   'END'     
         fdb   $4003     
L028E    fcs   'BYTE'    
         fdb   $4103     
L0294    fcs   'INTEGER' 
         fdb   $4203     
L029D    fcs   'REAL'    
         fdb   $4303     
L02A3    fcs   'BOOLEAN' 
         fdb   $4403     
L02AC    fcs   'STRING'  
         fdb   $4503     
L02B4    fcs   'THEN'    
         fdb   $4603     
L02BA    fcs   'TO'      
         fdb   $4703     
L02BE    fcs   'STEP'    
         fdb   $4803     
L02C4    fcs   'DO'      
         fdb   $4903     
L02C8    fcs   'USING'   
         fdb   $3D03     
L02CF    fcs   'PROCEDURE'
         fdb   $9204     
L02DA    fcs   'ADDR'    
         fdb   $9404     
L02E0    fcs   'SIZE'    
         fdb   $9604     
L02E6    fcs   'POS'     
         fdb   $9704     
L02EB    fcs   'ERR'     
         fdb   $9804     
L02F0    fcs   'MOD'     
         fdb   $9A04     
L02F5    fcs   'RND'     
         fdb   $9C04     
L02FA    fcs   'SUBSTR'  
         fdb   $9B04     
L0302    fcs   'PI'      
         fdb   $9F04     
L0306    fcs   'SIN'     
         fdb   $A004     
L030B    fcs   'COS'     
         fdb   $A104     
L0310    fcs   'TAN'     
         fdb   $A204     
L0315    fcs   'ASN'     
         fdb   $A304     
L031A    fcs   'ACS'     
         fdb   $A404     
L031F    fcs   'ATN'     
         fdb   $A504     
L0324    fcs   'EXP'     
         fdb   $A804     
L0329    fcs   'LOG'     
         fdb   $A904     
L032E    fcs   'LOG10'   
         fdb   $9D04     
L0335    fcs   'SGN'     
         fdb   $A604     
L033A    fcs   'ABS'     
         fdb   $AA04     
L033F    fcs   'SQRT'    
         fdb   $AA04     
L0345    fcs   'SQR'     
         fdb   $AC04     
L034A    fcs   'INT'     
         fdb   $AE04     
L034F    fcs   'FIX'     
         fdb   $B004     
L0354    fcs   'FLOAT'   
         fdb   $B204     
L035B    fcs   'SQ'      
         fdb   $B404     
L035F    fcs   'PEEK'    
         fdb   $B504     
L0365    fcs   'LNOT'    
         fdb   $B604     
L036B    fcs   'VAL'     
         fdb   $B704     
L0370    fcs   'LEN'     
         fdb   $B804     
L0375    fcs   'ASC'     
         fdb   $B904     
L037A    fcs   'LAND'    
         fdb   $BA04     
L0380    fcs   'LOR'     
         fdb   $BB04     
L0385    fcs   'LXOR'    
         fdb   $BC04     
L038B    fcs   'TRUE'    
         fdb   $BD04     
L0391    fcs   'FALSE'   
         fdb   $BE04     
L0398    fcs   'EOF'     
         fdb   $BF04     
L039D    fcs   'TRIM$'   
         fdb   $C004     
L03A4    fcs   'MID$'    
         fdb   $C104     
L03AA    fcs   'LEFT$'   
         fdb   $C204     
L03B1    fcs   'RIGHT$'  
         fdb   $C304     
L03B9    fcs   'CHR$'    
         fdb   $C404     
L03BF    fcs   'STR$'    
         fdb   $C604     
L03C5    fcs   'DATE$'   
         fdb   $C704     
L03CC    fcs   'TAB'     
         fdb   $CD05     
L03D1    fcs   'NOT'     
         fdb   $D005     
L03D6    fcs   'AND'     
         fdb   $D105     
L03DB    fcs   'OR'      
         fdb   $D205     
L03DF    fcs   'XOR'     
         fdb   $F703     
L03E4    fcs   'UPDATE'  
         fdb   $f803     
L03EC    fcs   'EXEC'    
         fdb   $f903     
L03F2    fcs   'DIR'     

* 3 byte packets used by <u001B calls - Function $12
* 1st byte is used for bit tests, bytes 2-3 are offset from 2nd byte (can be
*   jump address, others seem to be ptrs to text)
L03F5    fcb   $40        ???
         fdb   $0000     
* label for reference only - remove after all are verified as correct

         fcb   $00        ???
         fdb   L0142-*    PARAM ($fd49)

         fcb   $00       
         fdb   L0149-*    TYPE  ($fd4d)

         fcb   $00       
         fdb   L014F-*    DIM   ($fd50)

         fcb   $00       
         fdb   L0154-*    DATA  ($fd52)

         fcb   $00       
         fdb   L015A-*    STOP  ($fd55)

         fcb   $00       
         fdb   L0160-*    BYE   ($fd58)

         fcb   $00       
         fdb   L0165-*    TRON  ($fd5a)

         fcb   $00       
         fdb   L016B-*    TROFF ($fd5d)

         fcb   $00       
         fdb   L0172-*    PAUSE ($fd61)

         fcb   $00       
         fdb   L0179-*    DEG   ($fd65)

         fcb   $00       
         fdb   L017E-*    RAD   ($fd67)

         fcb   $00       
         fdb   L0183-*    RETURN ($fd69)

         fcb   $00       
         fdb   L018B-*    LET    ($fd6e)

         fcb   $40        ???
         fdb   $0000     

         fcb   $00       
         fdb   L0190-*    POKE   ($fd6d)

         fcb   $00       
         fdb   L0196-*    IF     ($fd70)

         fcb   $63       
         fdb   L019A-*    ELSE   ($fd71)

         fcb   $02       
         fdb   L01A0-*    ENDIF  ($fd74)

         fcb   $01       
         fdb   L01A7-*    FOR    ($fd78)

         fcb   $22       
         fdb   L1419-*    (something with NEXT in it) ($0fe7)

         fcb   $01       
         fdb   L01B2-*    WHILE ($fd7d)

         fcb   $62       
         fdb   L01B9-*    ENDWHILE ($fd81)

         fcb   $01       
         fdb   L01C3-*    REPEAT ($fd88)

         fcb   $02       
         fdb   L01CB-*    UNTIL ($fd8d)

         fcb   $01       
         fdb   L01D2-*    LOOP ($fd91)

         fcb   $62       
         fdb   L01D8-*    ENDLOOP ($fd94)

         fcb   $02       
         fdb   L01E1-*    EXITIF ($fd9a)

         fcb   $63       
         fdb   L01E9-*    ENDEXIT ($fd9f)

         fcb   $00       
         fdb   L01F2-*    ON ($fda5)

         fcb   $00       
         fdb   L01F6-*    ERROR ($fda6)

         fcb   $20       
         fdb   L13C9-*    Point to something with GOTO ($0f76)

         fcb   $20       
         fdb   L13C9-*    Point to something with GOTO ($0f73)

         fcb   $20       
         fdb   L13C3-*    Point to something with GOSUB ($0f6a)

         fcb   $20       
         fdb   L13C3-*    Point to something with GOSUB ($0f67)

         fcb   $20       
         fdb   L140F-*    Point to something with RUN ($0fb0)

         fcb   $00       
         fdb   L020F-*    KILL ($fdad)

         fcb   $00       
         fdb   L0215-*    INPUT ($fdb0)

         fcb   $00       
         fdb   L021C-*    PRINT ($fdb4)

         fcb   $00       
         fdb   L0223-*    CHD ($fdb8)

         fcb   $00       
         fdb   L0228-*    CHX ($fdba)

         fcb   $00       
         fdb   L022D-*    CREATE ($fdbc)

         fcb   $00       
         fdb   L0235-*    OPEN ($fdc1)

         fcb   $00       
         fdb   L023B-*    SEEK ($fdc4)

         fcb   $00       
         fdb   L0241-*    READ ($fdc7)

         fcb   $00       
         fdb   L0247-*    WRITE ($fdca)

         fcb   $00       
         fdb   L024E-*    GET ($fdce)

         fcb   $00       
         fdb   L0253-*    PUT ($fdd0)

         fcb   $00       
         fdb   L0258-*    CLOSE ($fdd2)

         fcb   $00       
         fdb   L025F-*    RESTORE ($fdd6)

         fcb   $00       
         fdb   L0268-*    DELETE ($fddc)

         fcb   $00       
         fdb   L0270-*    CHAIN ($fde1)

         fcb   $00       
         fdb   L0277-*    SHELL ($fde5)

         fcb   $20       
         fdb   L1402-*    Points to something with BASE ($0f6d)

         fcb   $20       
         fdb   L1402-*    Points to something with BASE ($0f6a)

         fcb   $20       
         fdb   L143C-*    Points to something with REM ($0fa1)

         fcb   $20       
         fdb   L1436-*    Points to something with (* ($0f98)

         fcb   $00       
         fdb   L0289-*    END ($fde8)

         fcb   $20       
         fdb   L13CF-*    ??? end of goto/gosub routine ($0f2b)

         fcb   $20       
         fdb   L13CF-*    ??? end of goto/gosub routine ($0f28)

         fcb   $40        ???
         fdb   $0000     

         fcb   $20       
         fdb   L1443-*    ??? end of REM routine ($0f96)

         fcb   $40       
         fcc   ' \'       Command statement separator literal

         fcb   $20       
         fdb   L12D4-*    ??? ($0e21)

         fcb   $10       
         fdb   L028E-*    BYTE ($fdd8)

         fcb   $10       
         fdb   L0294-*    INTEGER ($fddb)

         fcb   $10       
         fdb   L029D-*    REAL ($fde1)

         fcb   $10       
         fdb   L02A3-*    BOOLEAN ($fde4)

         fcb   $10       
         fdb   L02AC-*    STRING ($fdea)

         fcb   $20       
         fdb   L1424-*    ??? Something that points to 'THEN' ($0f5f)

         fcb   $60       
         fdb   L02BA-*    TO ($fdf2)

         fcb   $60       
         fdb   L02BE-*    STEP ($fdf3)

         fcb   $00       
         fdb   L02C4-*    DO ($fdf6)

         fcb   $00       
         fdb   L02C8-*    USING ($fdf7)

         fcb   $20       
         fdb   L145E-*    ??? Something with file access modes ($0f8a)

         fcb   $40       
         fcc   ','        comma
         fcb   $00       

         fcb   $40       
         fcc   ':'        colon
         fcb   $00       

         fcb   $40       
         fcc   '('        Left parenthesis
         fcb   $00       

         fcb   $40       
         fcc   ')'        Right parenthesis
         fcb   $00       

         fcb   $40       
         fcc   '['        Left bracket
         fcb   $00       

         fcb   $40       
         fcc   ']'        Right bracket
         fcb   $00       

         fcb   $40       
         fcc   '; '       semi-colon with space

         fcb   $40       
         fcc   ':='       := (pascal like equals)

         fcb   $40       
         fcc   '='        Equals sign
         fcb   $00       

         fcb   $40       
         fcc   '#'        number sign
         fcb   $00       

         fcb   $20       
         fdb   L1AE1-*    ??? Bump Y up by 2 & return ($15ec)

* Guess: These following have to do with printing numeric values???
         fcb   $20       
         fdb   L138A-*    ??? ($0E92)

         fcb   $20       
         fdb   L138A-*    ??? ($0E8F)

         fcb   $20       
         fdb   L138A-*    ??? ($0E8c)

         fcb   $20       
         fdb   L138A-*    ??? ($0E89)

         fcb   $20       
         fdb   L138A-*    ??? ($0E86)

         fcb   $20       
         fdb   L138A-*    ??? ($0E83)

         fcb   $21       
         fdb   L138A-*    ??? ($0E80)

         fcb   $22       
         fdb   L138A-*    ??? ($0E7D)

         fcb   $23       
         fdb   L138A-*    ??? ($0E7A)

         fcb   $20       
         fdb   L1386-*    ??? (Appends period, does 138A routine) ($0E73)

         fcb   $21       
         fdb   L1386-*    ??? (Appends period, does 138A routine) ($0E70)

         fcb   $22       
         fdb   L1386-*    ??? (Appends period, does 138A routine) ($0E6d)

         fcb   $23       
         fdb   L1386-*    ??? (Appends period, does 138A routine) ($0E6a)

         fcb   $26       
         fdb   L13BE-*    ??? (print single byte numeric?) ($0E9f)

         fcb   $27       
         fdb   L13CF-*    ??? (print 2 byte integer numeric?) ($0Ead)

         fcb   $24       
         fdb   L13A0-*    ??? (possibly something with reals?) ($0E7b)

         fcb   $24       
         fdb   L13E1-*    ??? (string, puts " in) ($0Eb9)

         fcb   $27       
         fdb   L13F6-*    ??? (string, puts $ in) ($0Ecb)

         fcb   $11       
         fdb   L02DA-*    ADDR ($FDac)

         fcb   $80        ???
         fdb   $0000     

         fcb   $11       
         fdb   L02E0-*    SIZE ($FDAC)

         fcb   $80       
         fdb   $0000      ???

         fcb   $10       
         fdb   L02E6-*    POS ($FDAC)

         fcb   $10       
         fdb   L02EB-*    ERR ($FDAE)

         fcb   $12       
         fdb   L02F0-*    MOD ($FDB0)

         fcb   $12       
         fdb   L02F0-*    MOD ($FDAD)

         fcb   $11       
         fdb   L02F5-*    RND ($FDAF)

         fcb   $10       
         fdb   L0302-*    PI ($FDB9)

         fcb   $12       
         fdb   L02FA-*    SUBSTR ($FDAE)

         fcb   $11       
         fdb   L0335-*    SGN ($FDE6)

         fcb   $11       
         fdb   L0335-*    SGN ($FDE3)

         fcb   $11       
         fdb   L0306-*    SIN ($FDB1)

         fcb   $11       
         fdb   L030B-*    COS ($FDB3)

         fcb   $11       
         fdb   L0310-*    TAN ($FDB5)

         fcb   $11       
         fdb   L0315-*    ASN ($FDB7)

         fcb   $11       
         fdb   L031A-*    ACS ($FDB9)

         fcb   $11       
         fdb   L031F-*    ATN ($FDbb)

         fcb   $11       
         fdb   L0324-*    EXP ($FDBD)

         fcb   $11       
         fdb   L033A-*    ABS ($FDD0)

         fcb   $11       
         fdb   L033A-*    ABS ($FDCD)

         fcb   $11       
         fdb   L0329-*    LOG ($FDB9)

         fcb   $11       
         fdb   L032E-*    LOG10 ($FDBB)

         fcb   $11       
         fdb   L033F-*    SQRT ($FDC9)

         fcb   $11       
         fdb   L033F-*    SQRT ($FDC6)

         fcb   $11       
         fdb   L034A-*    INT ($FDCE)

         fcb   $11       
         fdb   L034A-*    INT ($FDCB)

         fcb   $11       
         fdb   L034F-*    FIX ($FDCD)

         fcb   $11       
         fdb   L034F-*    FIX ($FDCA)

         fcb   $11       
         fdb   L0354-*    FLOAT ($FDCC)

         fcb   $11       
         fdb   L0354-*    FLOAT ($FDC9)

         fcb   $11       
         fdb   L035B-*    SQ ($FDCD)

         fcb   $11       
         fdb   L035B-*    SQ ($FDCA)

         fcb   $11       
         fdb   L035F-*    PEEK ($FDCB)

         fcb   $11       
         fdb   L0365-*    LNOT ($FDCE)

         fcb   $11       
         fdb   L036B-*    VAL ($FDD1)

         fcb   $11       
         fdb   L0370-*    LEN ($FDD3)

         fcb   $11       
         fdb   L0375-*    ASC ($FDD5)

         fcb   $12       
         fdb   L037A-*    LAND ($FDD7)

         fcb   $12       
         fdb   L0380-*    LOR ($FDDA)

         fcb   $12       
         fdb   L0385-*    LXOR ($FDDC)

         fcb   $10       
         fdb   L038B-*    TRUE ($FDDF)

         fcb   $10       
         fdb   L0391-*    FALSE ($FDE2)

         fcb   $11       
         fdb   L0398-*    EOF ($FDE6)

         fcb   $11       
         fdb   L039D-*    TRIM$ ($FDE8)

         fcb   $13       
         fdb   L03A4-*    MID$ ($FDEC)

         fcb   $12       
         fdb   L03AA-*    LEFT$ ($FDEF)

         fcb   $12       
         fdb   L03B1-*    RIGHT$ ($FDF3)

         fcb   $11       
         fdb   L03B9-*    CHR$ ($FDF8)

         fcb   $11       
         fdb   L03BF-*    STR$ ($FDFB)

         fcb   $11       
         fdb   L03BF-*    STR$ ($FDF8)

         fcb   $10       
         fdb   L03C5-*    DATE$ ($FDFB)

         fcb   $11       
         fdb   L03CC-*    TAB ($FDFF)

         fcb   $80       
         fdb   $0000     

         fcb   $80       
         fdb   $0000     

         fcb   $80       
         fdb   $0000     

         fcb   $80       
         fdb   $0000     

         fcb   $80       
         fdb   $0000     

         fcb   $11       
         fdb   L03D1-*    NOT ($FDF2)

         fcb   $51       
         fcc   '-'        ??? (Sign as opposed to subtract?)
         fcb   $00       

         fcb   $51       
         fcc   '-'        ??? (Sign as opposed to subtract?)
         fcb   $00       

         fcb   $0A       
         fdb   L03D6-*    AND ($FDEE)

         fcb   $09       
         fdb   L03DB-*    OR ($FDF0)

         fcb   $09       
         fdb   L03DF-*    XOR ($FDF1)

* Would presume that the different duplicates are for different data types
* It appears that BYTE & INTEGER use the same routines, REAL is different,
* STRING/TYPE use a third, and BOOLEAN would be a rarely used 4th
* Order appears to be : REAL/(INTEGER or BYTE)/STRING/BOOLEAN
* 3 - real/integer/string

         fcb   $4B       
         fcc   '>'        greater than
         fcb   $00       

         fcb   $4B       
         fcc   '>'        greater than
         fcb   $00       

         fcb   $4B       
         fcc   '>'        greater than
         fcb   $00       

* 3 - real/integer/string
         fcb   $4B       
         fcc   '<'        less than
         fcb   $00       

         fcb   $4B       
         fcc   '<'        less than
         fcb   $00       

         fcb   $4B       
         fcc   '<'        less than
         fcb   $00       

* 4 - real/integer/string/boolean
         fcb   $4B       
         fcc   '<>'       not equal to

         fcb   $4B       
         fcc   '<>'       not equal to

         fcb   $4B       
         fcc   '<>'       not equal to

         fcb   $4B       
         fcc   '<>'       not equal to

* 4 - real/integer/string/boolean
         fcb   $4B       
         fcc   '='        equal to
         fcb   $00       

         fcb   $4B       
         fcc   '='        equal to
         fcb   $00       

         fcb   $4B       
         fcc   '='        equal to
         fcb   $00       

         fcb   $4B       
         fcc   '='        equal to
         fcb   $00       

* 3 - real/integer/string
         fcb   $4B       
         fcc   '>='       greater than or equal to

         fcb   $4B       
         fcc   '>='       greater than or equal to

         fcb   $4B       
         fcc   '>='       greater than or equal to

* 3 - real/integer/string
         fcb   $4B       
         fcc   '<='       less than or equal to

         fcb   $4B       
         fcc   '<='       less than or equal to

         fcb   $4B       
         fcc   '<='       less than or equal to

* 3 - real/integer/string
         fcb   $4c       
         fcc   '+'        plus
         fcb   $00       

         fcb   $4c       
         fcc   '+'        plus
         fcb   $00       

         fcb   $4c       
         fcc   '+'        plus
         fcb   $00       

* 2 - real/integer
         fcb   $4C       
         fcc   '-'        minus
         fcb   $00       

         fcb   $4C       
         fcc   '-'        minus
         fcb   $00       

* 2 - real/integer
         fcb   $4D       
         fcc   '*'        multiply
         fcb   $00       

         fcb   $4D       
         fcc   '*'        multiply
         fcb   $00       

* 2 - real/integer
         fcb   $4D       
         fcc   '/'        divide
         fcb   $00       

         fcb   $4D       
         fcc   '/'        divide
         fcb   $00       

* 1 - real
         fcb   $4E       
         fcc   '^'        exponent
         fcb   $00       

* 1 - real
         fcb   $4E       
         fcc   '**'       exponent (2nd version)

         fcb   $20       
         fdb   L138A-*    ??? ($0D3c)

         fcb   $21       
         fdb   L138A-*    ??? ($0D39)

         fcb   $22       
         fdb   L138A-*    ??? ($0D36)

         fcb   $23       
         fdb   L138A-*    ??? ($0D33)

         fcb   $20       
         fdb   L1386-*    ??? (Adds period, does 138A) ($0D2C)

         fcb   $21       
         fdb   L1386-*    ??? (Adds period, does 138A) ($0D29)

         fcb   $22       
         fdb   L1386-*    ??? (Add period, does 138A) ($0D26)

         fcb   $23       
         fdb   L1386-*    ??? (Add period, does 138A) ($0D23)

* System Mode commands
         fdb   2          # commands this table
         fcb   2          # bytes to first command string
L0668    fdb   L09F9-L0668
         fcs   '$'       
L066B    fdb   L094F-L066B
         fcb   C$CR+$80   (Carriage return)

         fdb   14         # commands this table
         fcb   2          # bytes to first command string
L0671    fdb   L0E6D-L0671
         fcs   'BYE'     
L0676    fdb   L094A-L0676
         fcs   'DIR'     
L067B    fdb   L1590-L067B
         fcs   'EDIT'    
L0681    fdb   L1590-L0681
         fcs   'E'       
L0684    fdb   L0D02-L0684
         fcs   'LIST'    
L068A    fdb   L0DC7-L068A
         fcs   'RUN'     
L068F    fdb   L0E98-L068F
         fcs   'KILL'    
L0695    fdb   L0CF4-L0695
         fcs   'SAVE'    
L069B    fdb   L0AC3-L069B
         fcs   'LOAD'    
L06A1    fdb   L0A32-L06A1
         fcs   'RENAME'  
L06A9    fdb   L0B51-L06A9
         fcs   'PACK'    
L06AF    fdb   L0918-L06AF
         fcs   'MEM'     
L06B4    fdb   L0A24-L06B4
         fcs   'CHD'     
L06B9    fdb   L0A28-L06B9
         fcs   'CHX'     

* Debug mode commands (offsets done by current base + offset)
         fdb   2          # of entries this table (-3,x)
         fcb   2          # of bytes to start of next entry (-1,x)
L06C1    fdb   L09F9-L06C1 base ptr goes here (0,x)
         fcs   '$'        base ptr+(-1,x) above points here
L06C4    fdb   L108B-L06C4
         fcb   C$CR+$80   (Carriage return)

L06C7    fdb   14         # of entries this table (but 13?)
         fcb   2          # bytes to next entry
* Debug set #2?
L06CA    fdb   L109A-L06CA
         fcs   'CONT'    
L06D0    fdb   L094A-L06D0
         fcs   'DIR'     
L06D5    fdb   L1068-L06D5
         fcs   'Q'       
L06D8    fdb   L10E4-L06D8
         fcs   'LIST'    
L06DE    fdb   L1195-L06DE
         fcs   'PRINT'   
L06E5    fdb   L120A-L06E5
         fcs   'STATE'   
L06EC    fdb   L1195-L06EC
         fcs   'TRON'    
L06F2    fdb   L1195-L06F2
         fcs   'TROFF'   
L06F9    fdb   L1195-L06F9
         fcs   'DEG'     
L06FE    fdb   L1195-L06FE
         fcs   'RAD'     
L0703    fdb   L1195-L0703
         fcs   'LET'     
L0708    fdb   L107C-L0708
         fcs   'STEP'    
L070E    fdb   L1226-L070E
         fcs   'BREAK'   
* Some edit mode stuff?
         fdb   8          # entries this table
         fcb   2          # bytes to start entry
L0718    fdb   L169E-L0718
         fcs   'L'       
L071B    fdb   L169E-L071B
         fcs   'l'       
L071E    fdb   L199A-L071E
         fcs   'D'       
L0721    fdb   L199A-L0721
         fcs   'd'       
L0724    fdb   L15E7-L0724
         fcs   '+'       
L0727    fdb   L15E7-L0727
         fcs   '-'       
L072A    fdb   L15E7-L072A
         fcb   C$CR+$80  
L072D    fdb   L1601-L072D
         fcb   C$SPAC+$80

         fdb   4          # entries
         fcb   2          # bytes to first entry
L0733    fdb   L175B-L0733
         fcs   'S'       
L0736    fdb   L175E-L0736
         fcs   'C'       
L0739    fdb   L18DF-L0739
         fcs   'R'       
L073C    fdb   L1993-L073C
         fcs   'Q'       

L073F    fcb   $0E       
         fcs   'Ready'   
L0745    fcs   'What?'   
L074A    fcs   ' free'   
L074F    fcs   'Program' 
L0756    fcs   'PROCEDURE'
         fcb   C$CR      
L0760    fcb   C$LF      
         fcs   '  Name      Proc-Size  Data-Size'
L0781    fcc   'Rewrite?: '
L0791    fcb   $0E       
         fcs   'BREAK: ' 
L07A2    fcs   'ok'      
L07A4    fcs   'D:'      
L07A6    fcs   'E:'      
L07A8    fcs   'B:'      

* F$Icpt routine
L07B5    lda   R$DP,s     Get DP register from stack
         tfr   a,dp       Put into real DP
         stb   <u0035     Save signal code

         IFNE  H6309
         oim   #$80,<u0034  Set high bit (flag signal was received)
         ELSE            
         lsl   <u0034     Set high bit (flag signal was received)
         coma            
         ror   <u0034    
         ENDC            

         rti              Return to normal BASIC09

* BASIC09 INIT
start                    
         IFNE  H6309
         tfr   u,d        Save start of data mem into D
         ldw   #$100      Size of DP area to clear
         clr   ,-s        Clear byte on stack
         tfm   s,u+       clear out DP
         ELSE            
         pshs  u          Save start of data mem on stack
         leau  >$100,u    Point to end of DP
         clra             Clear all of DP to $00
         clrb            
L07C9    std   ,--u      
         cmpu  ,s        
         bhi   L07C9     
         puls  d          Get start of data mem into D
         ENDC            

         leau  ,x         Point U to Start of parameter area
         std   <u0000     Preserve Start of Data memory ptr
         inca             Point to $100 in data area
         sta   <u00D9     Preserve the 1
         std   <u0080     Initialize ptr to start of temp buffer
         std   <u0082     Initialize current pos. in temp buffer
         adda  #$02       D=$300
         std   <u0046     Save subroutine stack ptr
         std   <u0044     Save top of string space ptr
         inca             D=$400
         tfr   d,s        Point stack to $400 ($300-$3ff)
         std   <u0004     Save ptr to ptr list of modules in workspace
         pshs  x          Preserve start of param area

         IFNE  H6309
         pshs  b          Put 0 byte on stack
         ldw   #$100      Size of area to clear ($400-$4ff)
         tfm   s,d+       Clear out list of module ptrs (D=$500 at end)
         leas  1,s        Eat stack byte
         ELSE            
         tfr   d,x        x=$400
         clra             d=$0000
ClrLp    sta   ,x+        Clear byte
         incb             Inc counter
         bne   ClrLp      Do until it wraps
         tfr   x,d        Move $500 to D
         ENDC            

         std   <u0008     Save ptr to start of I-Code workspace
         std   <u004A     Save ptr to end of used I-Code workspace
         tfr   u,d        Move start of param area ptr to D
         subd  <u0000     Calculate size for entire data area
         std   <u0002     Preserve size of Data area
         ldb   #01        Std Out path
         stb   <u002E     Save as std output path
         lda   #$03       Close all paths past the standard 3
L07FC    os9   I$Close   
         inca            
         cmpa  #$10       Do until 3-15 are closed
         blo   L07FC     
         lda   #$02       Create duplicate path for error path
         os9   I$Dup     
         sta   <u00BE     Preserve duplicate's path #
         leax  <L07B5,pc  Point to intercept routine and set it up with
         os9   F$Icpt     it's memory area @ start of param area
         leax  >L000D-$d,pc Point to beginning of module header
         IFNE  H6309
         tfr   x,w        Move it to W
         ELSE
         pshs  x
         ENDC
         ldx   <u0000     Point X to start of data mem
* Set up some JMP tables from the module header
         leax  <$1B,x     Point $1b bytes into it
         leay  >L000D,pc  Point to module header extensions
L082E    lda   #$7E       Opcode for JMP Extended instruction
         sta   ,x+        Store in table
         ldd   ,y++       Get jump offset from module header extension
         IFNE  H6309
         addr  w,d        Add to start of module address
         ELSE
         addd  ,s
         ENDC
         std   ,x++       Store as destination of JMP
         ldd   ,y         Keep installing JMP tables until 0000 found
         bne   L082E     
         IFEQ  H6309
         leas  2,s        eat X on stack
         ENDC
         bsr   L0116      Go init <$50 vars, & some table ptrs
         puls  y          Get parameter ptr
         leax  >L0140,pc  Point to main command token list
         stx   <u009E     Save it
         ldb   ,y         Get char from params
         cmpb  #C$CR      Carriage return?
         beq   L08A6      Yes, go print the title screen
* Optional filename specified when BASIC09 called
         leax  <L0860,pc  No, point to initial entry of routine
         pshs  y          Preserve param ptr
         bsr   L0870     
         lbsr  L0F91     
         bcc   L088F     
         lbsr  L0AC3      Go open path to name (Y=ptr to it)
         bra   L088F     

L0116    jsr   <u0024     JMP to L31E8 (default from module header)
         fcb   $00        Function code 0

L0860    puls  y          Get original contents of <u00B7
         bsr   L086D     
         ldx   <u0004     Get ptr to module list
         ldd   ,x         Get ptr to 1st module (initially 0 (none))
         std   <u002F     Save it
         lbsr  L0DC7     
L086D    leax  <L08B2,pc  Get ptr >1st entry into routine
L0870    puls  u          Get RTS address
         bsr   L0899      Push 2 bytes from <B7 onto stack, RTS=L0860
         pshs  u          Save RTS address from BSR L0870
         clr   <u0034     Clear out signal recieved flag
         ldd   <u0000     Get start of data mem
         addd  <u0002     Add size of data mem
         subd  <u0008     Subtract all BASIC09 reserved stuff ($500 bytes)
         subd  <u000A     Subtract # bytes used by user's programs (not Data)
         std   <u000C     Save # bytes free in workspace for user's programs
         leau  2,s        Point U to L0860 ptr on stack
         stu   <u0046     Save ptr to it
         stu   <u0044     And again
         leas  -$FE,s     Bump stack ptr back 254 bytes
         jmp   [<-2,u]    Jump to L0860 address on stack

L088F    lds   <u00B7    
         puls  d         
         std   <u00B7    
L0896    lbra  L0DBB      Reset temp buffer size & ptrs to defaults

L0899    ldd   <u00B7     Get some other stack ptr?
         pshs  d          Preserve it
         sts   <u00B7     Save stack ptr
         ldd   2,s        Get RTS address to L0870 or L0860
         stx   2,s        Save ptr to L0860 or L086D on stack
         tfr   d,pc       Return to L0870 (just after BSR L0899)

L08A6    leax  >L0024,pc  Point to intro screen credits
         bsr   L08D0      Copy to temp buffer/print to Std error
         leax  name,pc    Point to 'Basic09'
         bsr   L08D0      Copy to temp buffer/print to Std error

L08B2    bsr   L086D     
         leax  >L073F+1,pc  Point to 'Ready'
         bsr   L08D0      Copy to temp buffer/print to Std error
         leax  >L07A8,pc  Point to 'B:' prompt
         leay  >L0668,pc  Point to system mode command table
         clr   <u0084    
         bsr   L08D3      Get command & execute it
         bcc   L088F      Did it, no problem
         bsr   L08CC      Unknown command, print 'What?'
         bra   L088F      Resume normal operation

L08CC    leax  >L0745,pc  Point to 'What?'
L08D0    lbra  L125F      Copy to temp buffer/print to Std error

* Get next command from keyboard & execute it
* Entry: Y=Ptr to command table
* Exit: Carry set if command doesn't exist
L08D3    pshs  y,x        Preserve command tbl ptr & ptr to prompt (ex B:)
         clr   <u0035     Clear out last signal received
         lbsr  L126B      Go print a message if we have to to std err
         bsr   L0896      S/B LBSR L0DBB (saves 3 cycles)
         lda   <u00BD     Get current input path #
         beq   L08E5      If Std In, skip ahead
         os9   I$Close    Otherwise, close it
         clr   <u00BD     Force input path # to 0 (Std In)
L08E5    lbsr  L0B2D      ReadLn up to 256 bytes from std in
         bcc   L08F8      No error on read, continue
         cmpb  #E$EOF     <ESC> key?
         bne   L0915      No, exit routine with error
         IFNE  H6309
         ldq   #$6279650d     'bye' <CR>
         stq   ,y         Stick it in the keyboard buffer
         ELSE            
         ldd   #'b*256+'y Stick the word 'bye' <CR> into the keybrd buffer
         std   ,y        
         ldd   #'e*256+C$CR ('e' + CR)
         std   2,y       
         ENDC            
* Keyboard line read, no errors from ReadLn
L08F8    ldx   2,s        Get command tbl ptr back
         lda   #$80       Mask to check for end of entry (high bit set)
         bsr   L010A      Go parse line, y=ptr to offset in command found
         bne   L090F      '$' or <CR> command found, skip ahead
         lbsr  L010D      ???Go check for a procedure name, B=size
         beq   L0915      None, exit with carry set
         leax  $03,x      Point to system mode table 2
         lda   #C$SPAC    ???
         bsr   L010A      Go parse line, y=ptr to offset in command found
         beq   L0915      No command found, exit with carry set
* Command found in table
L090F    ldd   ,x         Get offset
         leas  4,s        Eat stack
         jmp   d,x        Call routine

L010A    jsr   <u001E    
         fcb   $04       

* Command not found
L0915    coma             Set carry & exit
         puls  pc,y,x    

* Entry: Y=Ptr to string of chars
L0918    lbsr  L0A90      Go find 1st non-space/comma char
         bne   L093C      Found one, skip ahead
         leax  ,y         Point X to char
         ldd   <u0008     Get ptr to start of I-Code workspace
         addd  <u000A     Add to size of all programs in workspace
         inca             Bump up by 256 bytes
         subd  <u0000     Subtract start of data mem ptr
         pshs  d          Preserve size
         lbsr  L1748      ??? Check something
         bcs   L0946      Error, exit with carry set
         cmpd  ,s++       Check with previously calculated size
         blo   L0948      Will fit, continue
         os9   F$Mem      Won't fit, request the required data mem size    
         bcs   L093C      Can't get it, skip ahead
         subd  #$0001     Bump gotten size down by 1 byte
         std   <u0002     Save new data mem size
L093C    lbsr  L0DBB      Reset temp buffer size & ptrs
         ldd   <u0002     Get data mem size
         bsr   L09BA      ???
L0943    lbra  L1264      Print temp buff contents to std error

L0946    leas  2,s        Eat something off stack
L0948    coma             Exit with carry set
         rts             

* Debug & System mode - DIR
L094A    leax  ,y        
         lbsr  L0D5F     
* System mode - <CR>
L094F    leax  >L0760,pc  Point to basic09 DIR header
         lbsr  L125F      Print it out to Std err
         ldy   <u0004     Get Ptr to list of modules in BASIC09 workspace
         bra   L099B      Go print directory

* Entry: X=Ptr to module in memory
* Prints module names out of modules in work-space.
* A '*' indicates the current module, a '-' indicates packed or other language
*   module
L095B    pshs  y,x        Preserve ? & module ptr
         lda   #C$SPAC    Space char as default
         tst   M$Type,x   Check type/language
         beq   L0965      If source code in workspace, skip ahead
         lda   #'-        '- char indicates packed or other language code
L0965    lbsr  L1373      Add char in A to temp text buffer
         lda   #C$SPAC    Default to space again
         cmpx  <u002F     Is this the 'current' module?
         bne   L0970      No, skip ahead
         lda   #'*        '*' to indicate current module
L0970    lbsr  L1373      Append that char to temp text buffer
         ldd   M$Name,x   Get offset to name of module
         leax  d,x        Point to name
         lbsr  L135A      ??? Print it out
         ldd   #$11*256+M$Size A=??, B=offset from module ptr to get data
         bsr   L09AD      Go print program size
         ldd   #$1C*256+M$Mem A=??, B=offset from module ptr to get data
         bsr   L09AD      Go print data area size
         ldd   M$Mem,x    Get data area size required by module
         addd  #$0040     Add 64 to it
         cmpd  <u000C     Bigger than bytes free in workspace for user?
         blo   L0993      Legal data area size, continue
         lda   #'?        Data area too big for current buffer space, print
         lbsr  L1373      a '?' beside data area size
L0993    bsr   L0943      Print line out to std error path
         puls  y,x        Get ??? & module ptr back
         tst   <u0035     Any signals pending?
         bne   L099F      Yes, skip ahead
L099B    ldx   ,y++       Get ptr to module
         bne   L095B      There is one, go print it's entry out
L099F    ldd   <u000C     None left, get # bytes free in BASIC09 workspace
         bsr   L09BA      Go convert to ASCII
         leax  >L074A,pc  Point to 'free'
         lbsr  L1261      Print it out to Std err
         lbra  L0D51      Close std err; Dup path @ <BE & return from there

* Entry: A=???, b=offset from module header to get 2 byte # from
L09AD    pshs  b          Preserve B
         ldb   #$10       Sub function (uses table @ L50B2)
         lbsr  L011F      Call <2A (inited to L5084), function 2
         puls  b          Restore B
         ldx   2,s        Get module ptr back
         ldd   b,x        Get size to print

* Convert # in D to ASCII version (decimal)
L09BA    pshs  y,x,d      Preserve End of data mem ptr,?,Data mem size
         pshs  d          Preserve data mem size again
         leay  <L09ED,pc  Point to decimal table (for integers)
L09C1    ldx   #$2F00    
L09C4    puls  d          Get data mem size
L09C6    leax  >$0100,x   Bump X up to $3000
         subd  ,y         Subtract value from table
         bhs   L09C6      No underflow, keep subtracting current power of 10
         addd  ,y++       Restore to before underflow state
         pshs  d          Preserve remainder of this power
         ldd   ,y         Get next lower power of 10
         tfr   x,d        Promptly overwrite it with X (doesn't chg flags)
         beq   L09E6      If finished table, skip ahead
         cmpd  #$3000     Just went through once?
         beq   L09C1      Yes, reset X & do again
         lbsr  L1373      Go save A @ [<u0082]
         ldx   #$2F01     Reset X differently
         bra   L09C4      Go do again

L09E6    lbsr  L1373      Go save A @ [<u0082]
         leas  2,s        Eat stack
         puls  pc,y,x,d   Restore regs & return

* Table of decimal values
L09ED    fdb   $2710      10000
         fdb   $03E8      1000
         fdb   $0064      100
         fdb   $000A      10
         fdb   $0001      1
         fdb   $0000      0

* Debug/System '$' goes here
* Entry: Y=Ptr to line typed in by user?
L09F9    lbsr  L0A90      Go check char @ Y for space or comma
         leau  ,y         Point to start of parameter area
         clrb             Current size of parameter area=0
L09FF    incb             Bump size up by 1
         lda   ,y+        Get char from user's line
         cmpa  #C$CR      Hit end yet?
         bne   L09FF      No, keep looking
         clra             parameter line never >255 chars
         tfr   d,y        Move size of parameter area to Y for Fork
         leax  >L0277,pc  Point to 'SHELL'
         lda   #Objct     ML program
         clrb             Size of data area=0 pages
         os9   F$Fork     Fork shell out
         bcs   L0A86      Error, deal with it
         pshs  a          Save process # of shell
L0A17    os9   F$Wait     Wait for death signal
         cmpa  ,s         Was it our shell process?
         bne   L0A17      No, wait for ours
         leas  1,s        Yes, eat process #
         tstb             Error status from child?
         bne   L0A86      Yes, deal with it
         rts              No, return
* System Mode - CHD (MOD 93/09/20 - CHANGED FROM UPDAT. TO READ.)
L0A24    lda   #DIR.+READ. Open Data directory in Update mode
         bra   L0A2A     

* System Mode - CHX
L0A28    lda   #DIR.+EXEC. Open Execution Directory
L0A2A    leax  ,y         Point to directory we are changing to
         os9   I$ChgDir   Change dir
         bcs   L0A86      Error, exit with it
         rts              No error, return

L0A32    bsr   L0A9D     
         lbsr  L0F6E     
         bcs   L0A8C     
         pshs  x         
         ldx   ,x        
         tst   6,x       
         bne   L0A8C     
         bsr   L0A90      Go check char @ Y for space or comma
         beq   L0A48      It is a space or comma, skip ahead
L0A45    comb             Set carry, restore X & return
         puls  pc,x      

L0A48    bsr   L010D      Call <u001E, function 2
         beq   L0A45     
         pshs  y         
         lbsr  L0F6E     
         bcs   L0A58     
         cmpx  $02,s     
         bne   L0A84     
L0A58    ldx   $02,s     
         lbsr  L1A2E     
         puls  x         
         ldy   <u004A    
L0A62    lda   ,x+       
         sta   ,y+       
         bpl   L0A62     
         sty   <u00AB    
         ldx   [,s++]    
         ldd   $04,x     
         leay  d,x       
         ldb   <$18,x    
         lda   <u00A6    
         sta   <$18,x    
         clra            
         lbsr  L19B1     
         addd  <u005E    
         std   <u005E    
L0A81    lbra  L1995     

L0A84    ldb   #$2C       Multiply-defined procedure error
* Error
L0A86    lbsr  L1287     
L0A89    lbra  L088F     

L0A8C    ldb   #$2B       Unknown procedure error
         bra   L0A86     

* Entry: Y=Ptr to string of chars?
* Exit:  Y=Ptr to char (or up 1 char if space/comma found)
*        B=Char found
L0A90    ldb   ,y+        Get char
         cmpb  #',        Is it a ','?
         beq   L0A9C      Yes, return
         cmpb  #C$SPAC    Is it a space?
         beq   L0A9C      Yes, return
         leay  -1,y       No, normal char, point Y to it
L0A9C    rts              Exit with B=char

* Entry: Y=Ptr to 1st char in possible string name
* Exit:  Y=Ptr to module name (or string name)
L0A9D    bsr   L010D      Call <u001E function 2 (string name search again)
         bne   L0AB0      Size possible name>0, exit
L0AA2    ldy   <u002F     Get ptr to 'current' module
         beq   L0AAC      None, use 'Program' as default
         ldd   M$Name,y   Get offset to module name
         leay  d,y        Point Y to module name & return
         rts             

L0AAC    leay  >L074F,pc  Point Y to 'Program'
L0AB0    rts             

L0AB1    ldb   #$2B       Unknown procedure error
         bra   L0ABD     

L0AB5    ldb   #$20       Memory full error
L0AB7    pshs  b         
         bsr   L0A81     
         puls  b         
L0ABD    cmpb  #E$EOF     End of file error?
         beq   L0A89      Yes, special case
         bra   L0A86      Exit with it

L010D    jsr   <u001E    
         fcb   $02       

* Entry: Y=Ptr to string (path name)
* Exit: Path opened to file, path # @ <u00BD
L0AC3    leax  ,y         Point to path name
         lda   #1         Std out path
         os9   I$Open     Open path
         bcs   L0ABD      Error, check if it is EOF
         sta   <u00BD     Save path #
         bsr   L0B2D      Go read a line into temp input buffer
         bsr   L0B3C      Go check if it starts with 'PROCEDURE'
         bne   L0AB1      No, exit with Unknown Procedure Error
L0AD4    bsr   L010D      Yes, call function
         beq   L0AB1     
         pshs  y         
         lbsr  L0F6E     
         bcs   L0AE8     
         ldy   ,s        
         leay  -$01,y    
         lbsr  L0E98     
L0AE8    ldy   ,s        
         lbsr  L0EFD     
         lbsr  L1A2E     
         puls  x         
         lbsr  L125F     
L0AF6    ldb   <u0035     Get last received signal code
         bne   L0AB7      Got a signal, use it as error code & abort load
         bsr   L0B2D      Go get line of source from file
         bcs   L0AB7      Error on read, exit with it
         lda   <u000C     Get MSB of bytes free in workspace
         cmpa  #$02       At least $2ff (767) bytes free?
         blo   L0AB5      No, exit with memory full error
         bsr   L0B3C      Check for word PROCEDURE
         beq   L0B14      Found it, skip ahead
         ldy   <u0080     Get temp buff ptr
         ldd   <u0060    
         std   <u005C    
         lbsr  L1606     
         bra   L0AF6     

L0B14    ldx   <u0080     Get ptr to start of temp buffer
         pshs  y,x        Save ??? & temp buffer start ptr
L0B18    lda   ,x+        Get char
         cmpa  #C$CR      Carriage return?
         bne   L0B18      No, keep looking for CR
         stx   <u0080     Save CR+1 position as start of temp buffer
         stx   <u0082     And as current position in temp buffer
* Is this function to read in a source listing (single procedure) not including
*   PROCEDURE line itself?
         bsr   L0128      JSR <$21, function 2
         puls  y,x        Restore ??? & temp buffer start ptr
         stx   <u0080     Save temp buffer start ptr again
         stx   <u0082     And save current position in temp buffer
         bra   L0AD4      Loop back

* Read line from source code file
L0B2D    lda   <u00BD     Get path # to file
         ldx   <u0080     Get address to get data into
         ldy   #$0100     Up to 256 bytes to be read
         os9   I$ReadLn   Go read a line
         ldy   <u0080     Get ptr to line read & return
         rts             

* Entry: Y=ptr to input buffer
* Exit: Carry clear if word 'PROCEDURE' was found
*       Y=Ptr to 1 byte past 'procedure' in buffer
L0B3C    bsr   L010D      Call function
         leax  >L0756,pc  Point to 'PROCEDURE'
L0B43    lda   ,x+        Get byte from 'procedure'
         eora  ,y+        Check (with case conversion) if it matches buffer
         anda  #$DF      
         bne   L0B50      No, exit
* NOTE: SHOULD MAKE LDA -1,X SINCE FASTER
         tst   -1,x       Was that the last letter of 'procedure'?
         bpl   L0B43      No, keep checking
         clra             Yes, no error & return
L0B50    rts             

L0B51    lbsr  L0C83     
         ldu   <u0046    
         bra   L0B79     

L0128    jsr   <u0021    
         fcb   $02       

* Entry: X=Ptr to possible filename
L0B58    ldy   ,y         Get module header ptr from somewhere
         tst   6,y        Check type of module
         lbne  L0E68      If anything but 0, exit with Line with Compiler error
         lda   <$17,y     Get flag byte
         rora             Shift out Line with compiler error bit
         lbcs  L0E68      Has error, exit with it
         ldd   $0D,y      ???
         leay  d,y        Point to that offset in module
         ldd   -3,y      
         lslb             Multiply by 2
         rola            
         inca             Add $100
         cmpd  <u000C     Compare with bytes free in workspace
         lbhi  L0F69      If higher, exit with memory full error
L0B79    ldy   ,--u      
         bne   L0B58     
         ldd   #(EXEC.+WRITE.)*256+UPDAT.+EXEC. Exec. dir & rd/wt/ex attribs
         lbsr  L0D6B      Go create file (0 byte length)
         ldy   <u0046    
         stu   <u0046    
         lbra  L0C7A     

L0B8C    pshs  y         
         lbsr  L1A2E     
         clr   <u00D9    
         bsr   L0128      JSR <u0021, function 2 (L255A)
         inc   <u00D9    
         ldx   <u0062    
         leay  ,x        
* NOTE: <u0000 UNECESSARY FOR LEVEL II
         ldd   <u0000     Get start of data area ptr
         addd  <u0002     Get ptr to end of data area
         tfr   d,u        Move to U
         ldd   -3,x      
         beq   L0C18     
         pshs  u          Save size of data area
L0BA8    pshs  d         
         leax  1,x       
         ldd   ,x        
         pshu  d         
         clr   ,x+       
         clr   ,x+       
L0BB4    lda   ,x+        Find hi-bit set char
         bpl   L0BB4     
         puls  d         
         subd  #1        
         bne   L0BA8     
         ldy   <u005E    
         bra   L0BD1     

L0BC4    ldd   ,y        
         ldx   <u0062    
         leax  d,x       
         ldd   1,x       
         sty   1,x       
         std   ,y++      
L0BD1    lbsr  L1BC2     
         bcc   L0BC4     
         puls  u         
         ldx   <u0062    
         ldd   -3,x      
         leay  ,x        
L0BDE    leau  -2,u      
         pshs  u,d       
         clra            
         ldu   1,x       
         beq   L0C04     
         pshs  x         
         tfr   y,d       
         subd  <u0062    
         bra   L0BF3     

L0BEF    std   ,u        
         leau  ,x        
L0BF3    ldx   ,u        
         bne   L0BEF     
         std   ,u        
         puls  x         
         lda   ,x        
         sta   ,y+       
         ldu   [<2,s]    
         stu   ,y++      
L0C04    leax  3,x       
L0C06    ldb   ,x+       
         cmpa  #$A0      
         bne   L0C0E     
         stb   ,y+       
L0C0E    tstb            
         bpl   L0C06     
         puls  u,d       
         subd  #1        
         bne   L0BDE     
L0C18    ldx   <u002F     Get ptr to start of current module
         ldd   M$Size,x   Get size of module
         pshs  d          Save it
         leay  3,y        Add size of 24 bit CRC
         tfr   y,d        Move ptr to end of module (including CRC bytes)
         subd  <u002F     Calculate size of module including CRC
         std   M$Size,x   Save it
         ldd   ,s         Get original size of module
         subd  M$Size,x   Subtract new size
         std   ,s         Save size difference
         addd  <u000C     Add to bytes free in workspace
         std   <u000C     Save new # bytes free
         ldd   <u000A     Get # bytes used by all programs in workspace
         subd  ,s++       Subtract size difference
         std   <u000A     Save new # bytes used by all programs in workspace
         addd  <u0008     Add to start ptr of I-code workspace (calculate end)
         std   <u004A     Save ptr to 1st free byte in I-code workspace
         ldb   #Sbrtn+ICode Subroutine module/I-Code type byte
         stb   M$Type,x   Save in module header
         ldb   #%10000000 Packed flag
         stb   <$17,x     Save flags
         leau  -3,y       Point Y to end of module - CRC bytes
         ldd   #$FFFF     Init CRC to $FF's
         std   ,u         (Header parity too)
         sta   2,u       
         ldb   #7         Bytes 0-7 used to calculate header parity
L0C52    eora  b,x        Calculate header parity
         decb            
         bpl   L0C52      Do all of header
         sta   M$Parity,x Save header parity
         ldy   M$Size,x   Get module size
         leay  -3,y       Minus CRC bytes themselves
         os9   F$CRC      Calculate module CRC
* If u not used after this, could change to com ,u/com 1,u/com 2,u
         com   ,u+        Last stage of CRC calc: Complement all 3 bytes
         com   ,u+       
         com   ,u+       
         ldy   M$Size,x   Get module size again (including CRC)
         lda   #2         Path 2 for file
         os9   I$Write    Write out entire module
         lda   #%11000000 Packed & CRC just made flags
         sta   <$17,x     Save them
         lbcs  L0DB6      If error on write, go deal with it
         puls  y         
L0C7A    ldx   ,--y      
         lbne  L0B8C     
         lbra  L0D51      Go close file, reopen path from <BE, rts from there

L0C83    bsr   L0C9D     
         lda   ,y         Get char
         cmpa  #C$CR      Is it CR?
         bne   L0C9A      No, point X to it & return
         ldx   <u0046     Get ???
         ldx   [<-2,x]   
         ldd   M$Name,x   Get offset to module name
         leax  d,x        Point X to module name
         lbsr  L135A      Go set up temp buffer with name
         lbsr  L1371      Append CR to end of temp buffer
L0C9A    leax  ,y        
         rts             

L0C9D    ldu   <u0046     Get table end ptr
         stu   <u0044     Save as current table ptr
         lbsr  L0A90      Go get char (bump y past it if , or space)
         beq   L0CC6      If comma or space, skip ahead
         cmpb  #'*        Is it a '*'?
         bne   L0CCB      No, skip ahead
         ldx   <u0004     Get ptr to workspace module ptr list
L0CAC    ldd   ,x         Get 1st possible entry
         beq   L0CB4      Empty, skip ahead
         tfr   x,d        Move ptr to D
         leax  2,x        Bump ptr up to next entry
L0CB4    std   ,--u       Save entry
         bne   L0CAC     
         stu   <u0044     Save new ptr
         lda   ,y         Get char from temp buffer
         cmpa  #C$CR      CR?
         beq   L0CC2      Yes, save ptr & return
         leay  1,y        No, bump ptr up by 1        
L0CC2    sty   <u0082     Save current pos in temp buffer & return
         rts             

L0CC6    lbsr  L010D      JSR <u001E, function 2
         bne   L0CD9     
L0CCB    sty   <u0082     Save current pos in temp buffer
         lbsr  L0AA2      Point Y to Name of current module (or 'Program')
         lbsr  L0F6E      Go check if module exists in BASIC09 workspace
         bcc   L0CE1      Yes, skip ahead
L0CD6    lbra  L0A8C      No, return with Unknown Procedure error

L0CD9    lbsr  L0F6E      Check if module exists in BASIC09 workspace
         bcs   L0CD6      No, return Unknown Procedure error
         sty   <u0082     Save Ptr to end of fname as current pos in tmp buf
L0CE1    stx   ,--u       Save ptr to start of module name
         ldy   <u0082     Get Ptr to end of filename
         lbsr  L0A90      Point Y to next char (or past ',' or space)
         bne   L0CF0      Not comma or space, skip ahead
         lbsr  L010D      JSR <u001E, function 2
         bne   L0CD9     
L0CF0    clra            
         clrb            
         bra   L0CB4     

L0CF4    tst   <u000C     >256 bytes free for user?
         lbeq  L0F69      No, exit with Memory Full error
         lda   #$80       Set hi-bit flag
         sta   <u0084    
         bsr   L0C83     
         bra   L0D06     

L0D02    bsr   L0C9D     
         leax  ,y        
L0D06    stx   <u005C    
         bsr   L0D5F     
         ldy   <u0046    
         stu   <u0046    
         bra   L0D49     

L0D11    pshs  y         
         ldy   [,y]      
         sty   <u002F     Save as current module ptr
         ldd   M$Exec,y   Get exec offset
         addd  <u002F     Add to start of current module
         std   <u005E     Save absolute exec address of current module
         ldd   $0F,y      Get ???
         addd  <u002F     Add to start of current module
         std   <u0060     Save this absolute address
         ldd   $0D,y      Get ???
         addd  <u002F     Add to start of module
         std   <u0062     Save this absolute address
         tst   M$Type,y   Check type of module
         bne   L0D47      If anything but unpacked BASIC09, skip ahead
         leax  <L0D3B,pc  Point to routine
         lbsr  L0899      ??? The <u00B7 stack swap
         lbsr  L10E4      ??? DEBUG list command
L0D38    lbra  L088F      Restore <u00B7, reset temp buff

L0D3B    tst   <u0084     Test flags
         bmi   L0D47     
         ldx   [,s]      
         lbsr  L1A2E     
         lbsr  L0128     
L0D47    puls  y         
L0D49    ldx   ,--y      
         bne   L0D11     
L0D4D    bsr   L0D51     
         bra   L0D38     

L0D51    pshs  b          Preserve B
         lda   #2        
         os9   I$Close    Close path #2 (error)
         lda   <u00BE     Get Duplicate error path #
         os9   I$Dup      Dupe the path
         puls  pc,b       Restore B & return

L0D5F    lbsr  L0A90      Point Y to next char (or past ',' or space)
         cmpb  #C$CR      Was it a CR?
         beq   L0DB5      Yes, skip ahead
         stx   <u0082     Save current pos in temp buffer
         ldd   #$020B     Write access mode & pr r w attributes
* Create output file
* Entry: A=access mode
*        B=file attributes
*        X=Ptr to filename to create
L0D6B    pshs  u,x,d      Preserve regs
         lda   #$02       Close std error path
         os9   I$Close   
         ldd   ,s         Get access mode & file attributes back
         os9   I$Create   Attempt to create the file
         bcc   L0DB3      Did it, skip ahead
         cmpb  #E$CEF     File already exists error?
         bne   L0DB6      No, skip ahead
         ldd   ,s         Get access modoe & file attributes again
         ldx   2,s        Get ptr to filename again
         os9   I$Open     Attempt to open the file
         bcs   L0DB6      User not allowed to access, skip ahaead
         leax  >L0781,pc  Point to 'Rewrite?:'
         ldy   #10        Size of rewrite string
         lda   <u00BE     Get error path #
         os9   I$WritLn   Prompt user
         clra            
         leax  ,--s       Make 2 byte buffer on stack
         ldy   #2         Get up to 2 chars from user
         os9   I$ReadLn  
         puls  d          Get chars from read buffer
         eora  #$59       Check for Y
         anda  #$DF       Force case
         bne   L0D4D      User didn't hit Y or y, exit
         ldd   #2*256+SS.Size Path #2, set file size call
         ldx   #0         Set size to 0 bytes
         leau  ,x        
         os9   I$SetStt   Truncate file size to 0 bytes
         bcs   L0DB6      If error, skip ahead
L0DB3    puls  pc,u,y,d   Restore regs & return

L0DB5    rts             

L0DB6    bsr   L0D51      Close & dupe error path
         lbra  L0A86      Print error

* Reset temp buffer to empty state
L0DBB    pshs  d          Preserve D
         lda   #1         # chars in buffer to 1
         sta   <u007D     Save it
         ldd   <u0080     Get ptr to temp buffer
         std   <u0082     Save it as current pos in temp buffer
         puls  pc,d       Restore D & return

* Get program name (with hi-bit on last char set + CR), pointed to by Y
*   Will be one of following:
*     1) Name pointed to by Y on entry
*     2) Name of 'current' module in BASIC09 workspace
*     3) 'Program' if neither of the above
L0DC7    lbsr  L010D      <1E,func. 2 (Get string size/make FCS type if var name)
         bne   L0DDF      There is >0 chars that qualify as name, skip ahead
         pshs  y          Save ptr to string name in question
* NOTE: MAY WANT TO CHANGE ENTRY POINT, SINCE L0A9D CALLS L010D AGAIN
         lbsr  L0A9D      Get ptr & size of name, or use current (or 'Program')
         ldx   ,s         Get ptr to string name in question again
L0DD3    lda   ,y+        Get char from name we _will_ use
         sta   ,x+        Save over top of string name in question
         bpl   L0DD3      Copy whole string (including last hi-bit byte)
         lda   #C$CR      Append CR to end
         sta   ,x        
         puls  y          Point to beginning of new string
L0DDF    lbsr  L0F91      Y=Ptr to end of string+1, X=Ptr to module ptr entry
         lbcs  L0A8C      Module not in workspace, exit with Unknown Procedure
         ldx   ,x         Get ptr to module
         stx   <u002F     Save as 'current module'
         lda   M$Type,x   Get type/language byte
         beq   L0DF6      If type & language are 0, skip ahead
         anda  #LangMask  Just want language type
         cmpa  #ICode     BASIC09 I-Code?
         bne   L0E68      No, Line With Compiler Error
         bra   L0DFC      Yes, skip ahead

L0110    jsr   <u001E    
         fcb   $00       

L0113    jsr   <u0021    
         fcb   $00       

* Type/Language byte of 0
L0DF6    lda   <$17,x     Get flags from module
         rora             Shift out Line with Compiler error flag
         bcs   L0E68      There is an error, report it
* Current module has no obvious errors
L0DFC    bsr   L0110      <1E, fnc. 0 (1F9E normally) (do token?)
         ldy   <u004A     Get ptr to end of currently used I-code workspace
         ldb   ,y         Get last char/token in workspace
         cmpb  #'=        Is it an = sign?
         beq   L0E68     
         sty   <u005E    
         sty   <u005C    
         ldx   <u00AB     Get ptr to current I-code line end
         stx   <u0060    
         stx   <u004A     Make it ptr to end of in use I-code workspace
         ldd   <u000C     Get # bytes free in workspace for user
         pshs  y,d       
         bsr   L0113     
         puls  y,d       
         std   <u000C     Save # bytes now free in workspace for user
         sty   <u004A     Save updated end of I-code workspace ptr
         ldx   <u002F     Get ptr to current module
         lda   <$17,x     Get flag byte
         rora             Shift out Line with Compiler error flag bit
         bcs   L0E68      Compiled line has error, report it
         leas  >$0102,s   Eat 258 bytes from stack ???
         ldd   <u0000     Get start of data mem ptr
         addd  <u0002     Add to Size of data area
         tfr   d,y        Move end of data area ptr to Y
         std   <u0046     Save it
         std   <u0044    
         ldu   #$0000    
         stu   <u0031    
         stu   <u00B3     # steps per run through program (0=continuous)
         inc   <u00B3+1   Set # steps to 1
         clr   <u0036     Clear out last error code
         ldd   <u004A     Get ptr to next free byte in I-code workspace
         ldx   <u000C     Get # bytes free in workspace for user
         pshs  x,d        Save them
         leax  <L0E5F,pc  Point to routine
         lbsr  L0899     
         ldx   <u004A     Get ptr to next free byte in I-code workspace
         bsr   L0119     
         lbsr  L0DBB     
         ldx   <u002F     Get ptr to start of current module
         bsr   L011C     
         bra   L0E65     

L0119    jsr   <u0024    
         fcb   $04       

L011C    jsr   <u0024    
         fcb   $02       

L0E5F    puls  x,d        Restore bytes free in workspace & ptr to next free
         std   <u004A     Save old next free byte in I-code workspace
         stx   <u000C     Save old # bytes free in workspace for user
L0E65    lbra  L088F     

L0E68    ldb   #$33       Line with compiler error
         lbra  L0A86      Go report it

* System mode - BYE
L0E6D    bsr   L0E8F     
         clrb             Exit without error
         os9   F$Exit    

L0E73    lbsr  L010D     
         beq   L0E8B     
         lbsr  L0F6E     
         bcs   L0E8B     
         ldu   <u0046    

         IFNE  H6309
         clrd            
         ELSE            
         clra            
         clrb            
         ENDC            

         pshu  x,d       
         inca            
         sta   <u0035    
         bsr   L0E9F     
         clr   <u0035    
         rts             

L0E8B    comb             Set carry for error
         ldb   #$2B       Divide by 0 error
         rts             

L0E8F    ldy   <u0082     Get ptr to current pos in temp buffer
         lda   #$2A       '*'
         sta   ,y         Save in temp buffer
         sta   <u0035     Save as last signal received
L0E98    lbsr  L0C9D     
         clr   <u002F     Clear out ptr to start of 'current' module
         clr   <u002F+1  
L0E9F    ldu   <u0046     Get default ??? tbl ptr
         stu   <u0044     Save as current ??? tbl ptr
         bra   L0EE3     

L0EA5    ldx   ,x         Get ptr to module
         ldb   M$Type,x   Get module type
         beq   L0EC0      If nothing (un-compiled or errors?), skip ahead
         cmpb  #Sbrtn+ICode Basic09 I-Code?           
         bne   L0EB5      No, skip ahead
         ldb   <$17,x     Get I-Code flag byte
         lslb             Shift out the packed bit
         bmi   L0EC0      If (CRC just made?) flag set, skip ahead
L0EB5    pshs  u          Preserved U
         leau  ,x         Point U to module start
         os9   F$UnLink   Unlink the I-Code module
         puls  u          Restore U
         bra   L0EDE     

L0EC0    tst   <u0035     Any signal code?
         bne   L0EE3      Yes, skip ahead
         ldx   ,u         No, get ptr to module
         lbsr  L0FB6      Go remove it from workspace pointers (?)
         ldy   ,x         Get ptr to module again
         ldd   <u000A     Get current total size of used I-Code space
         subd  M$Size,y   Subtract deleted module's size
         std   <u000A     Save new size of used I-Code space
         ldd   M$Size,y   Get size of module being removed
         addd  <u000C     Add to bytes free in I-Code space
         std   <u000C     Save new # bytes free in I-Code space
         ldd   <u004A     Get ptr to end of used I-Code space+1
         subd  M$Size,y   Bump it back to not include the deleted module
         std   <u004A     Save new ptr to where next added I-Code goes
L0EDE    ldd   #$FFFF     Module ptr unused marker
         std   [,u]       Mark it
* Compress list of modules in I-Code workspace (get rid of all deleted ones)
L0EE3    ldx   ,--u       Get previous module ptr
         bne   L0EA5      There is one, go remove it too
         ldx   <u0004     Get ptr to list of modules is I-Code workspace
         tfr   x,y        Move it to Y
L0EEB    ldd   ,x++       Get module ptr
         cmpd  #$FFFF     Unused one?
         beq   L0EEB      Yes, try next
L0EF3    std   ,y++       Save it 
         bne   L0EEB      Until a $0000 is hit
         cmpd  ,y         Is the next entry a 0 too?
         bne   L0EF3      No, keep Storing until we hit a 0
         rts              Otherwise, return

L0EFD    bsr   L0F6E     
         bcs   L0F02     
         rts             

* Set up module header info?
L0F02    pshs  u,x       
         tfr   x,d       
         cmpb  #$FE      
         beq   L0F69     
         ldx   <u000C     Get # bytes free in I-Code workspace for user
         cmpx  #$00FF     <255 bytes left free?
         blo   L0F69      Yes, skip ahead
         leax  <-$1C,x    Bump # bytes free down by 28 bytes
         ldu   <u004A     Get ptr to current I-code line start
* Clear out entire header of packed RUNB module
* 6809/6309 mod: should use sta (after clra) instead of clr b,u
* Wait until L0F69 is checked-does it need A?
         ldb   #$FF       Pre-init B for loop below
L0F18    incb             Next position
         clr   b,u        Clear byte
         cmpb  #$18       Done all $18 bytes?
         bne   L0F18      No, keep going
* Copy module name to $19
L0F1F    incb             Bump B to $19
         leax  -1,x       Bump X back
         beq   L0F69      If hit 0, exit with memory full error
         inc   $18,u      Bump up module name size to 1
         lda   ,y+        Get char from source (module name)
         sta   b,u        Save it
         bpl   L0F1F      Do until hi-bit terminated
         incb             Bump B to 1 byte past module name (start of I-code)
         stx   <u000C     Save # bytes left free in I-Code workspace
         clra             MSB of D=0
         std   $15,u      ???
         std   M$Exec,u   Save ptr to execution offset
         std   $F,u       ???
         stu   [,s]      
         pshs  b         
         addd  #$0003     Add 3 to size of module so far (for CRC)
         std   M$Size,u   Save as current size of module
         std   $D,u       ??? (Size of I-code ???)
         addd  <u000A     Add size to total # bytes used by I-Code
         std   <u000A     Save new # bytes used by I-Code
         ldd   #M$ID12    Module header code
         std   M$ID,u     Save as module header
         ldd   #$0019     Ptr to where module name will be
         std   M$Name,u   Save as module name ptr
         ldd   #$0081     Type/Lang.=0 (internal to BASIC09)/Sharbl Rev.1
         std   M$Type,u  
         ldd   #$0016     Minimum data area size=22 bytes
         std   M$Mem,u   
         puls  b          Get offset to just past module name back
         leax  d,u        Point X to just after filename
         ldb   #$03       Add $000003 to end
         sta   ,x+       
         std   ,x++      
         stx   <u004A     ??? Save end of module ptr?
         puls  pc,u,x     Restore regs & return

L0F69    ldb   #$20       BASIC09 memory full error (or too many modules)
         lbra  L0A86     

* Entry: Y=Ptr to module name
* Exit:  D=Ptr to string/file name
*          Carry set if adding new module to module list
*          Carry clear if replacing existing module in module list
*        X=Ptr to module directory entry we are adding/changing
*        Y=Ptr to end of filename+1
L0F6E    pshs  u,y        Preserve regs
         ldx   <u0004     Get ptr to list of modules in BASIC09 workspace
L0F72    ldy   ,s         Get ptr to string we are checking for
         ldu   ,x++       Get ptr to module in workspace
         beq   L0F8E      None left to check, exit with carry set
         ldd   M$Name,u   Get offset to name
         leau  d,u        Point to name of module
L0F7D    lda   ,y+        Get char from name we are looking for
         eora  ,u+       
         anda  #$DF       Force case
         bne   L0F72      Doesn't match, try next module
         clra             Clear carry (module found)
         tst   -1,u       Was it the last char in existing module name?
         bpl   L0F7D      No, keep checking
L0F8A    leax  -2,x       Point X to module ptr entry change (or add from F8E)
         puls  pc,u,d     Restore U, get string ptr into D & exit

L0F8E    coma             Set carry (flag new module being added)
         bra   L0F8A      Point to module ptr entry we are going to add

* Check if module is in BASIC09 workspace, try to add if it isn't
* Entry: Y=Ptr to module name to look for (hi-bit terminated with CR on end)
* Exit:  Carry clear if module in workspace
*        Carry set if module NOT in workspace
*        X=Ptr to module ptr entry ($400-$4FF) where module was found
*        D=Ptr to module name
*        Y=Ptr to last char of module name+1
L0F91    bsr   L0F6E      Go see if we should add or replace module
         bcs   L0F96      Adding new module, skip ahead
         rts              Replacing, exit

* Module not found currently in BASIC09 workspace... try to F$Link or F$Load
*   it in.
* Entry: X=Ptr to 1st free module directory entry in BASIC09 workspace
*        Y=Ptr to module name to add
* Exit:  Carry set & B=error code if still can't link module into workspace
*        Carry clear if linked in
*        Module ptr directory updated with new module
*        Y=Ptr to end of module name+1
*        X=Ptr to module directory entry
L0F96    pshs  u,y,x      Preserve regs
         ldb   1,s        Get LSB of module directory ptr
         cmpb  #$FE       At end of table?
         beq   L0F69      Yes, exit with Memory full error (too many modules)
         leax  ,y         Point X to module name
         clra             Type/language=wildcard (don't care)
         os9   F$Link     See if it's already in memory & map it in
         bcc   L0FB0      Yes, mapped in so skip ahead
         ldx   2,s        Get ptr to Module name again
         clra             Type/language=wildcard (don't care)
         os9   F$Load     Try loading it & linking it in
         bcs   L0FB4      Error, exit with it
L0FB0    stx   2,s        Save ptr to last byte of module name+1 in Y
         stu   [,s]       Save ptr to module in module ptr entry
L0FB4    puls  pc,u,y,x   Restore regs & return

* Entry: X=Ptr to module copy we are putting in I-Code workspace (at end of it)
*        Y=???
* Exit:  X=Ptr to where module was moved to
L0FB6    pshs  y,x        Preserve regs
         ldd   <u0008     Get ptr to start of I-Code workspace
         addd  <u000A     Add to total size of used I-Code workspace
         tfr   d,y        Move ptr to end of I-Code workspace to Y
         ldx   ,x         Get ptr to module we are adding to I-Code workspace
         sty   [,s]       Save ptr to where it is going over old one on stck
         ldd   M$Size,x   Get size of module we are adding
         bsr   L0FE3     
         pshs  y,x,d     
         ldx   <u0004     Get ptr to list of modules in BASIC09 workspace
         bra   L0FDB     

L0FCD    cmpd  2,s       
         blo   L0FDB     
         cmpd  4,s       
         bhi   L0FDB     
         subd  ,s        
         std   -2,x      
L0FDB    ldd   ,x++       Get possible module ptr
         bne   L0FCD      Found one, process
         leas  6,s        No more modules, eat stack
         puls  pc,y,x     Restore & return

* Entry: D=Size of module being added to I-Code workspace
*        X=Ptr to source of I-code module being added into I-Code workspace
*        Y=Ptr to destination of new I-Code module
*        U=???
* After PSHS below, stack is thus:
*  0,s = Size of module being added to I-Code buffer
*  2,s = Ptr to current location of I-Code
*  4,s = Ptr to destination of I-Code
*  6,s = Old U ???
*  8,s = RTS address
L0FE3    pshs  u,y,x,d    Preserve regs
         ldu   #$0000     Init counter to 0
         tfr   x,d        Move source ptr to D
         subd  4,s        D=distance between source & destination
         pshs  x,d        Preserve Source ptr & distance
*  0,s = Distance between source & destination (signed)
*  2,s = Work copy of ptr to current location of I-Code
*  4,s = Size of module being added to I-Code buffer
*  6,s = Ptr to current location of I-Code
*  8,s = Ptr to destination of I-Code
* 10,s = Old U ???
* 12,s = RTS address
         addd  4,s        D=distance between src & dest + size of module
         beq   L1022      If result=0 then restore regs & return
L0FF2    lda   ,x         Get 1st byte of source copy
         pshs  a          Save on stack
*  0,s = 1st byte from source copy
*  1,s = Distance between source & destination (signed)
*  3,s = Work copy of ptr to current location of I-Code
*  5,s = Size of module being added to I-Code buffer
*  7,s = Ptr to current location of I-Code
*  9,s = Ptr to destination of I-Code
* 11,s = Old U ???
* 13,s = RTS address
         bra   L1000     

L0FF8    lda   ,y         Get byte from source location
         sta   ,x         Save in destination location
         leau  1,u        Bump counter up
         tfr   y,x        Move source location to dest location
L1000    tfr   x,d        ??? Move src ptr to D
         addd  5,s        Add to size of module
         cmpd  9,s        Compare with dest. address
         blo   L100B      Fits, skip ahead
         addd  1,s        Won't, add to distance between src/dest
L100B    tfr   d,y        Move end address (?) to Y
         cmpd  3,s        Same as current location?
         bne   L0FF8      No, go bck
         puls  a         
         sta   ,x        
         leax  1,y       
         stx   2,s       
         leau  1,u       
         tfr   u,d       
         addd  ,s        
         bne   L0FF2     
L1022    leas  4,s        Eat temp vars
         puls  pc,u,y,x,d Restore regs & return

* Enter Debug mode?
L1026    pshs  u,y,x,d   
         lda   <u0036     Get last error code
         cmpa  #$39       System stack overflow error?
         beq   L1068      Yes, skip ahead
         tst   <u00A0     ??? Some flag set?
         bne   L10AA      Yes, skip ahead
         inc   <u00A0     Set flag
         lda   <u0035     Get last signal received
         bne   L1064      Was a signal, skip ahead
         ldd   <u00B3     Get # steps to do @ a time for trace
         subd  #1         Bump down by 1
         bhi   L1089      Was >1, skip ahead
         bmi   L104E      Was 0 or lower, skip ahead
L1041    lbsr  L0DBB     
         leax  >L0791,pc  Force to Alpha mode (if VDG window) & print BREAK
         lbsr  L135A     
         lbsr  L124D     
* Debug mode command loop
L104E    leax  >L07A4,pc  Point to 'D:'
         leay  >L06C1,pc  Point to start of debug command table
         lbsr  L08D3      Go process debug mode command
         bcc   L104E      Legit cmd executed, get next debug mode cmd
         lda   <u0035     Get last signal received
         bne   L1064      There was one, go check for abort
         lbsr  L08CC      None, print 'What?'
         bra   L104E      Go process next debug mode command

L0134    jsr   <u0024    
         fcb   $0C       

L1064    cmpa  #S$Abort   <CTRL>-<E> signal?
         bne   L1041      No, enter debug mode
* Debug 'Q' command (quite debug)
L1068    bsr   L0134     
         lda   #$03       Error path #3 we will check for
L106D    cmpa  <u00BE     Compare with I$Dup error path #
         beq   L1074      If not path we are looking for, skip ahead
         os9   I$Close    Same path, close it
L1074    inca             Next path
         cmpa  #16        Done all 16 possible?
         blo   L106D      No, keep going
         lbra  L088F      Done, reset temp buffers & ptrs to defaults

* Debug STEP command
* Entry: Y=Ptr to next char on line entered by user
L107C    lbsr  L0A90      Go check next char in STEP command
         bne   L108E      If anything but space or comma, STEP 1
         leax  ,y         Otherwise, point X to ASCII of steps specified
         lbsr  L1748      Go get # steps to do into D
         bcc   L1091      No error, continue
         rts              Else exit

L1089    bsr   L1091     
* Debug mode <CR> goes here (single step)
L108B    clrb            
         bra   L1090     

L108E    ldb   #1         Step rate of 1
L1090    clra            
L1091    std   <u00B3     Save # steps to do
         lsl   <u0034     Set high bit of signal flag
         coma            
         ror   <u0034    
         bra   L10A6      Continue

* Debug mode CONT command (continuous run)
L109A    lbsr  L0DBB      Reset temp buffer stuff
         lsl   <u0034     Clear high bit of signal flag
         lsr   <u0034    
         ldd   #$0001     1 step till we print out
         std   <u00B3     Save it
L10A6    leas  2,s       
         clr   <u00A0    
L10AA    puls  pc,u,y,x,d

L10AC    ldy   <u0019    
         jsr   ,y        
L10B1    pshs  u,y,x,d   
         cmpy  <u0046     ?? Get current pos in some table
         beq   L10E2      If no entries, exit
         ldb   <u007D     Get size of temp buff
         ldx   <u0080     Get ptr to start of temp buff
         ldu   <u0082     Get ptr to end of temp buff+1
         pshs  u,x,b      Preserve
         stu   <u0080     Temporarily set up temp buff to append to current
         lbsr  L0DBB     
         lda   #'=        Append '=' to temp buff
         lbsr  L1373     
         ldb   ,y        
         addb  #$01      
         cmpb  #$06      
         bhs   L10D7     
         leax  ,y        
         lbsr  L13AA     
L10D7    lbsr  L1264     
         puls  u,x,b      Get back temp buff stats
         stb   <u007D     Restore temp buff to normal
         stx   <u0080    
         stu   <u0082    
L10E2    puls  pc,u,y,x,d Restore regs & return

* Debug LIST command
L10E4    lbsr  L124B      Go print PROCEDURE & name
         tst   <$17,x     Is procedure packed?
         bmi   L110A      Yes, exit without error
         ldx   <u005E    
L10EE    clr   <u0074    
* List out each line loop
L10F0    tst   <u0035     Any signals?
         bne   L110A      Yes, exit without error (Can't list packed modules)
         leay  ,x         Point Y to beginning of I-Code module
         lbsr  L1BC9     
         bsr   L110C     
         exg   x,y       
         cmpx  <u0060    
         blo   L10F0     
         cmpx  <u005C    
         bne   L110A     
         cmpy  <u0060    
         blo   L10F0     
L110A    clra             No error & return
         rts             

L012B    jsr   <u0021    
         fcb   $06       

L110C    pshs  u,y,x      Preserve regs
         lbsr  L0DBB      Reset temp buffer to empty
         ldx   <u002F     Get current module ptr
         tst   <$17,x     Is it packed?
         bmi   L1193      Yes,  restore regs & exit
         ldx   ,s         Get original X back
         tfr   y,d       
         subd  ,s        
         bmi   L1190      Wrap to negative?
         pshs  x,d       
         addd  #40        If we needed 64 bytes...
         cmpd  <u000C     would it fit in BASIC09 workspace?
         lbhs  L0F69      No, return with BASIC09 memory full error
         tst   <u0084    
         bmi   L1158     
         lda   #C$SPAC   
         cmpx  <u005C    
         bhi   L113F     
         beq   L113D     
         cmpy  <u005C    
         bls   L113F     
L113D    lda   #'*        Append '*' to temp buffer
L113F    lbsr  L1373      Go append it
         cmpx  <u0060    
         bhs   L1158     
         tfr   x,d       
         subd  <u005E    
         ldx   <u0082     Get current pos. in temp buffer
         bsr   L012B      JSR <u0021 / function 6
         lda   #C$SPAC    Append space to temp buffer
         sta   ,x+       
         stx   <u0082     Save update temp buff ptr
         lbsr  L1270      Print message out
L1158    puls  y,d       
         cmpy  <u0060    
         bhs   L1190     
         ldu   <u004A    
         lbsr  L19EF     
         lbsr  L11F2     
         stu   <u005C    
         leax  d,u       
         stx   <u0060    
         stx   <u004A    
         leay  ,u        
         tst   <u0084    
         bmi   L1183     
         leax  ,y        
         lbsr  L1677     
         bne   L1183     
         leax  >L02EB,pc  Point to 'ERR' in basic09 commands
         lbsr  L126B      Print it out??
L1183    lbsr  L0DBB     
         lbsr  L1AC6     
         lbsr  L128B     
         bsr   L11D5     
         dec   <u0082+1  
L1190    lbsr  L1264     
L1193    puls  pc,u,y,x  

* Debug mode - PRINT/TRON/TROFF/DEG/RAD/LET commands
L1195    ldx   <u002F     Get ptr to start of 'current' module
         tst   <$17,x     Is it packed?
         bpl   L119E      No, skip ahead
         coma             Yes, set carry & return
         rts             

L119E    ldy   <u0080     Get ptr to start of temporary buffer
         lbsr  L0122      JSR <1E, function $A
         bsr   L11F2     
         ldx   <u004A    
         lbsr  L1677     
         beq   L11D5     
         stx   <u005E    
         stx   <u005C    
         leay  ,x        
         ldx   <u00AB    
         stx   <u0060    
         stx   <u004A    
         bsr   L012E     
         ldx   <u002F     Get ptr to current module
         lda   <$17,x     Get original flags
         clr   <$17,x     Clear flags out
         tsta             Were the flags special in any way?
         bne   L11D5      Yes, skip ahead
         leax  <L11D5,pc  No, point to the routine instead
         lbsr  L0899     
         ldx   <u005E    
         bsr   L0137      JSR <$24, function 8
         lbra  L088F      Swap stacks, reset temp buffer, return from there

L012E    jsr   <u0021    
         fcb   $04       

L0137    jsr   <u0024    
         fcb   $08       

L11D5    pshs  u,y,x,d    Preserve regs
         ldu   <u0046     Get reset value ($300) table ptr
         pulu  y,x,d      Get regs from there
         sty   <u000A     Save # bytes used by all code in workspace
         stx   <u000C     Save # bytes free in workspace
         std   <u004A     Save ptr to next free byte in workspace
         pulu  y,x,d      Get 6 more bytes
         sty   <u0060    
         stx   <u005E    
         std   <u005C    
L11EB    stu   <u0046    
         stu   <u0044    
         clra             No error,restore regs & return
         puls  pc,u,y,x,d

L11F2    pshs  u,y,x,d   
         ldu   <u0046    
         ldd   <u005C    
         ldx   <u005E    
         ldy   <u0060    
         pshu  y,x,d     
         ldd   <u004A    
         ldx   <u000C    
         ldy   <u000A    
         pshu  y,x,d     
         bra   L11EB     

* Debug mode - STATE command
L120A    ldy   <u0031    
         leax  >L0756,pc  Point to 'PROCEDURE'
L1211    bsr   L1223     
         lbsr  L135A     
         ldx   3,y       
         bsr   L1256     
         leax  <L0799,pc  Point to 'called by'
         ldy   7,y       
         bne   L1211     
L1223    lbra  L0DBB     

L0799    fcs   'called by'

* Debug mode - BREAK command
L1226    lbsr  L010D      JSR <1E, function 2
         beq   L1249     
         lbsr  L0F6E     
         bcs   L1249     
         ldx   ,x        
         ldy   <u0031    
L1235    ldy   7,y       
         beq   L1249     
         cmpx  3,y       
         bne   L1235     
* 6309, change to OIM #1,,y
         lsl   ,y         Set hi bit @ Y
         coma            
         ror   ,y        
         leax  >L07A2,pc  Point to 'ok'
         bra   L125F     

L1249    coma            
         rts             

L124B    bsr   L1223     
L124D    leax  >L0756,pc  Point to 'PROCEDURE'
         lbsr  L135A     
         ldx   <u002F     Get ptr to current module
L1256    pshs  x          Save it
         leax  <$19,x     Point to main code area
         bsr   L1261     
         puls  pc,x      

* Copy string pointed to by X to temp buffer & print it to std error
L125F    bsr   L1223      Set output txt size to 1, curr. temp buff pos=start
L1261    lbsr  L1392      Copy text string to temp buffer @ [u0080]
L1264    lbsr  L1371      Append a CR on the end of output buffer
         bsr   L1270      Print out the buffer to std error
         bra   L1223      Reset temp buffer size & ptrs to defaults & return

L126B    bsr   L1223     
         lbsr  L1392     
* Print message in temp buffer to std error path
* NOTE: MAY WANT TO CHECK INTO USING <7D FOR SIZE
L1270    pshs  y,x,d      Preserve regs
         ldd   <u0082     Get ptr to end of temp buffer+1
         subd  <u0080     Calculate size of temp buffer
         bls   L1285      If 0 or >32k, restore regs & exit
         tfr   d,y        Move size to proper reg for WritLn
         ldx   <u0080     Point to start of text
         lda   #$02       Std error path
         os9   I$WritLn   Write out the temporary buffer
         bcc   L1285      No error, restore regs & exit
         bsr   L1287      Print the error message out
L1285    puls  pc,y,x,d   Restore regs & exit

L1287    os9   F$PErr     Print error message
         rts             

L128B    ldy   <u005C    
         cmpy  <u0060    
         bhs   L12CF     
         ldb   ,y        
         cmpb  #$3A      
         bne   L12A3     
         leay  1,y       
         lbsr  L13CF     
         lbsr  L135C     
         ldb   ,y        
L12A3    tst   <u0084    
         bmi   L12B8     
         bsr   L12F9     
         ldb   <u0074    
         pshs  b         
         bsr   L12D8     
         puls  a         
         sta   <u0074    
         tfr   b,a       
         lbsr  L134E     
L12B8    ldb   ,y+       
         bmi   L12C4     
         bsr   L12F9     
         bsr   L12D8     
         bsr   L130C     
         bra   L12C7     

L12C4    lbsr  L1489     
L12C7    cmpy  <u0060    
         blo   L12B8     
L12CC    sty   <u005C    
L12CF    lbra  L1371     

L12D4    leas  2,s       
         bra   L12CC     

L12D8    sta   ,-s       
         bmi   L12F6     
         anda  #3        
         beq   L12F6     
         cmpa  #1        
         bne   L12E8     
         inc   <u0074    
         bra   L12F6     

L12E8    decb            
         bpl   L12EC     
         clrb            
L12EC    cmpa  #3        
         beq   L12F6     
         dec   <u0074    
         bpl   L12F6     
         clr   <u0074    
L12F6    lda   ,s+       
         rts             

L12F9    leax  >L03F5,pc  Point to 3 byte packets for <u001B calls - $12
         tstb             If positive, skip ahead
         bpl   L1302     
         subb  #$2A       Otherwise, bump down by 42
L1302    lda   #$03       Multiply by size of each entry
         mul             
         leax  d,x        Point to entry
         lda   ,x         Get 1st byte & return
         rts             

L130A    bsr   L12F9     
L130C    leax  1,x       
         anda  #$60      
         beq   L1318     
         cmpa  #$60      
         bne   L132A     
         leay  2,y       
L1318    lda   -1,x      
         pshs  a         
         ldd   ,x        
         leax  d,x       
         puls  a         
         anda  #$18      
         cmpa  #$10      
         beq   L1392     
         bra   L1358     

L132A    cmpa  #$20      
         bne   L1332     
         ldd   ,x        
         jmp   d,x       

L1332    bsr   L133A     
         bsr   L1336     
L1336    lda   ,x+       
         bne   L1373     
L133A    lda   <u007D    
         cmpa  #$41      
         bcs   L1357     
         lda   #$0A      
         bsr   L1373     
         clr   <u007D    
         tst   <u0084    
         bmi   L1357     
         lda   <u0074    
         adda  #3        
L134E    lsla            
         adda  #6        
         ldb   #$10      
         bsr   L011F     
         clra            
L1357    rts             

L1358    bsr   L135C     
L135A    bsr   L1392     
L135C    pshs  u,d       
         bsr   L133A     
         bcc   L136F     
         ldu   <u0082    
         lda   #C$SPAC   
         cmpa  -1,u      
         beq   L136F     
         cmpu  <u0080    
         bne   L1377     
L136F    puls  pc,u,d    

* Append byte in A to temp buffer, check for overflow
L1371    lda   #C$CR     
* Entry: A=Char (hi-bit stripped)
L1373    pshs  u,d        Preserve regs
         ldu   <u0082     ??? Get ptr to temp buffer
L1377    sta   ,u+        Save char in buffer
         ldd   <u0082     Get current pos in temp buffer
         subd  <u0080     Calc. current size of temp buffer
         tsta             Past our max (255 bytes)?
         bne   L1384      Yes, exit
         inc   <u007D     No, bump up char count
         stu   <u0082     Save current pos. in temp buffer+1
L1384    puls  pc,u,d     Restore & return

L1386    lda   #$2E      
         bsr   L1373     
L138A    ldx   ,y++      
         ldd   <u0062    
         leax  d,x       
         leax  3,x       

* Entry: X=ptr to text to output
* Exit: text output is in temp buffer from [u0080] to [u0082]-1
*       size of output string is in u007D
L1392    pshs  x          Preserve ptr to text to output
L1394    lda   ,x         Get 1st char from X
         anda  #$7F       Strip hi bit
         bsr   L1373      Add byte to temp buffer; check if full
         tst   ,x+        Was the high bit set? (last char flag)
         bpl   L1394      No, keep building output buffer
         puls  pc,x       Done, restore original text ptr & return

L011F    jsr   <u002A    
         fcb   $02       

* Called from Debug mode (?) -something with REAL #'s?
L13A0    ldb   #3        
         ldx   <u0044    
         pshs  y,b       
         leay  -1,y      
         bra   L13AC     

L13AA    pshs  y,b       
* on 6309, use LDQ/STQ, on 6809, uses std -2/-4/-6,x leay -6,x (saves 5 cycles)
L13AC    ldd   4,y       
         std   ,--x      
         ldd   2,y       
         std   ,--x      
         ldd   ,y        
         std   ,--x      
         leay  ,x        
         puls  b         
         bra   L13DC     

L13BE    ldb   ,y        
         clra            
         bra   L13D1     

L13C3    leax  >L0203,pc  Point to 'GOSUB'
         bra   L13CD     

L13C9    leax  >L01FD,pc  Point to 'GOTO'
L13CD    bsr   L1358     
L13CF    ldd   ,y++      
L13D1    pshs  y         
         ldy   <u0044    
         leay  -6,y      
         std   1,y       
         ldb   #2        
L13DC    bsr   L011F      JSR <$2A, function 2, sub-function 2
         puls  pc,y      

L13E1    bsr   L13F1     
L13E3    lda   ,y+        Get char
         cmpa  #$FF       EOS?
         beq   L13F1      Yes, add " to temp buffer
         bsr   L1373      No, add char to buffer
         cmpa  #'"        Was it a ?
         bne   L13E3      No, keep printing chars
         bra   L13E1      Yes, add " & continue

L13F1    lda   #'"        Add " to temp buffer
L13F3    lbra  L1373     

L13F6    lda   #'$        Add $ to temp buffer
         bsr   L13F3     
         ldb   #$14      
         bsr   L011F      JSR <$2A, function 2, sub-function $14
         leay  2,y       
         rts             

L1402    leax  >L027E,pc  Point to 'BASE'
         lbsr  L135A     
         lda   -1,y      
         adda  #$FB      
         bra   L13F3     

L140F    leax  >L020A,pc  Point to 'RUN'
L1413    lbsr  L135A     
         lbra  L138A     

L1419    leax  >L01AC,pc  Point to 'NEXT'
         leay  1,y       
         bsr   L1413     
         leay  6,y       
         rts             

L1424    leax  >L02B4,pc  Point to 'THEN'
         lbsr  L1358     
         lda   ,y        
         cmpa  #$3A      
         beq   L1433     
         inc   <u0074    
L1433    rts             

L1434    fcs   '(*'      

L1436    leax  <L1434,pc  Point to alternative REM statement
         bra   L1440     

L143C    leax  >L0284,pc  Point to 'REM'
L1440    lbsr  L135A     
L1443    ldb   ,y+       
L1445    decb            
         beq   L1433     
         lda   ,y+       
         bsr   L13F3     
         bra   L1445     

* File opening mode table: 3 bytes per entry
* Byte 1   : Actual mode bit pattern
* Bytes 2&3: Offset (from itself) to keyword describing mode
*   NOTE: keywords are high bit terminated
L144E    fcb   UPDAT.    
L144F    fdb   L03E4-*    Points to 'Update' string
L1451    fcb   READ.     
L1452    fdb   L0241-*    Points to 'Read' string
L1454    fcb   WRITE.    
L1455    fdb   L0247-*    Points to 'Write' string
L1457    fcb   EXEC.     
L1458    fdb   L03EC-*    Points to 'Exec' string
L145A    fcb   DIR.      
L145B    fdb   L03F2-*    Points to 'Dir' string
L145D    fcb   $00        End of table marker

L145E    lda   ,y+        Get requested file access mode
         pshs  a          Preserve on stack
         lda   #':        Separator that starts modes
L1464    bsr   L13F3      Parse for char?
         leax  <L144E-2,pc Point early for reentry point of loop
L1469    leax  2,x        Bump to next entry
         lda   ,s         Get requested mode
         anda  ,x         AND with mode in table
         cmpa  ,x+        Match so far?
         bne   L1469      No, check next entry
         tsta             Matched cuz we are at end of table?
         beq   L1487      Yes, exit routine
         eora  ,s         Mask out bits that are part of token, not mode
         sta   ,s         Preserve raw mode
         ldd   ,x         Get offset to text equivalent of mode
         leax  d,x        Point to it
         lbsr  L1392     
         lda   #'+        Now check for additional modes
         tst   ,s        
         bne   L1464      Go check them  & update accordingly
L1487    puls  pc,a       Restore A and exit

L1489    pshs  u         
         ldu   <u0044    
         clr   ,-u        Clear two bytes on stack
         clr   ,-u       
         leay  -1,y      
L1493    ldb   ,y        
         bpl   L14C4     
         lbsr  L12F9     
         tfr   a,b       
         lda   ,y+       
         bitb  #$80      
         bne   L1493     
         orb   #$80      
         pshu  d         
         bitb  #$18      
         bne   L1493     
         andb  #$7F      
         pshu  d         
         bitb  #$04      
         bne   L14B8     
         ldd   ,y++      
         std   2,u       
         bra   L1493     

L14B8    leay  -1,y      
         sty   2,u       
         ldb   ,y+       
         lbsr  L1B68     
         bra   L1493     

L14C4    sty   <u005C    
         leay  ,u        
         clra            
         clrb            
         std   ,--y      
         pshs  d         
         sta   <u00BF    
         sta   <u00B1    
L14D3    ldd   ,u++      
         bitb  #$08      
         beq   L14FE     
         andb  #$07      
         cmpb  <u00BF    
         bhi   L14F2     
         bne   L14EF     
         cmpb  #$06      
         bne   L14EB     
         tst   <u00B1    
         beq   L14EF     
         bra   L14F2     

L14EB    tst   <u00B1    
         beq   L14F2     
L14EF    lbsr  L1581     
L14F2    stb   <u00BF    
         orb   #$80      
         std   ,--y      
         lda   #$01      
         sta   <u00B1    
         bra   L14D3     

L14FE    clr   <u00B1    
         bitb  #$03      
         beq   L152D     
         bitb  #$04      
         bne   L152D     
         bitb  #$10      
         bne   L1510     
         pulu  x         
         stx   ,--y      
L1510    std   ,--y      
         andb  #$03      
         bsr   L1581     
         cmpa  #$BE      
         bne   L151F     
         ldx   #$54FF    
         stx   ,--y      
L151F    ldx   #$4B80    
         bra   L1526     

L1524    stx   ,--y      
L1526    decb            
         bne   L1524     
         stb   <u00BF    
L152B    bra   L14D3     

L152D    bitb  #$10      
         bne   L1535     
         pulu  x         
L1533    pshs  x         
L1535    pshs  d         
         cmpa  #$89      
         blo   L153F     
         cmpa  #$8C      
         bls   L14D3     
L153F    ldd   ,y++      
         tstb            
         bmi   L154A     
         beq   L1558     
         ldx   ,y++      
         bra   L1533     

L154A    pshs  d         
         clr   $01,s     
         bitb  #$10      
         bne   L153F     
         andb  #$07      
         stb   <u00BF    
         bra   L152B     

L1558    ldx   ,u++      
         beq   L1569     
         pshu  x         
         std   ,--y      
         bra   L152B     

L1562    puls  y         
         ldb   ,y+       
         lbsr  L130A     
L1569    ldd   ,s++      
         beq   L157C     
         bitb  #$04      
         bne   L1562     
         leay  ,s        
         exg   a,b       
         lbsr  L130A     
         leas  ,y        
         bra   L1569     

L157C    ldy   <u005C    
         puls  pc,u      

L1581    ldx   ,s        
         pshs  x         
         ldx   #$4E00    
         stx   $02,s     
         ldx   #$4DFF    
         stx   ,--y      
         rts             

L1590    lbsr  L0A9D     
         lbsr  L0EFD     
         ldy   ,x        
         tst   $06,y     
         bne   L15E5     
         pshs  x         
         lbsr  L1A2E     
         lbsr  L124B     
         ldy   <u005E    
         bsr   L15F3     
L15AA    lda   <u0035     Get last signal code received
         cmpa  #S$Abort   <CTRL>-<E>?
         bne   L15B3      No, skip ahead
         lbsr  L1993      Yes, ???
L15B3    leax  >L07A6,pc  Point to 'E:'
         leay  >L0718,pc  Point to EDIT mode command table
         lbsr  L08D3      Get next command from keyboard & execute it
         bcc   L15AA      Legit command done, get next one
         tst   <u0035     Signal received?
         bne   L15AA      Yes, go process it
         leax  <L15AA,pc  Point to routine (loop)
         pshs  x          Save it (for possible rts address?)
         ldx   <u0080     Get ptr to start of temp buffer
         lsl   ,x         Clear out hi bit in 1st char in temp buffer
         lsr   ,x        
         lbsr  L1748      ???
         lbcs  L08CC      If carry set, print 'What?'
         lbsr  L1A0D     
         lda   ,x        
         cmpa  #C$CR     
         beq   L15F3     
         ldy   <u0080     Get temp buffer ptr
         bra   L1601      Skip ahead

L15E5    coma            
         rts             

L15E7    leax  -1,y      
         lsl   ,x        
         asr   ,x        
         lbsr  L16F2     
         lbsr  L16BD     
L15F3    sty   <u005C    
         lbsr  L1682     
         leax  ,y        
         lbsr  L1BC9     
         lbra  L16AD     

L1601    bsr   L1606     
         bcc   L15F3     
         rts             

L0122    jsr   <u001E    
         fcb   $0A       

L1606    tst   <u000C    
         beq   L1670     
         clr   <u00A0    
         bsr   L0122     
         ldx   <u004A    
         lda   ,x        
         cmpa  #$3A      
         bne   L165E     
         clra            
         clrb            
         sta   ,-s       
         ldy   <u005C    
         lbsr  L1A10     
         cmpy  <u0060    
         bcc   L162F     
         ldd   $01,x     
         cmpd  $01,y     
         bls   L162F     
         inc   ,s        
L162F    ldy   <u005E    
         ldd   1,x       
         lbsr  L1A0D     
         tst   ,s+       
         bne   L1642     
         bhs   L1642     
         cmpy  <u005C    
         bhs   L165E     
L1642    sty   <u005C    
         cmpy  <u0060    
         bhs   L165E     
         ldx   <u004A    
         ldd   1,x       
         cmpd  1,y       
         bne   L165E     
         pshs  y         
         lbsr  L1BC9     
         tfr   y,d       
         subd  ,s++      
         bra   L1660     

L165E    clra            
         clrb            
L1660    ldy   <u005C    
         lbsr  L19B1     
         ldx   <u005C    
         bsr   L1677     
         bne   L166E     
         leay  ,x        
L166E    clra            
         rts             

L1670    ldb   #$20       Memory full error
         lbsr  L1287      Print error message
         coma             Return with carry set
         rts             

L1677    lda   ,x        
         cmpa  #$3A      
         bne   L167F     
         lda   3,x       
L167F    cmpa  #$3D      
         rts             

L1682    ldx   #$0000    
         ldy   <u005E    
L1688    cmpy  <u005C    
         bhs   L1697     
         leax  1,x       
         lbsr  L1BC9     
         cmpy  <u0060    
         blo   L1688     
L1697    sty   <u005C    
         stx   <u00B5    
         clra            
         rts             

L169E    bsr   L16CE     
         bsr   L16BD     
         cmpx  <u005E    
         bhi   L16AD     
         pshs  y,x       
         lbsr  L124B     
         puls  y,x       
L16AD    ldd   <u0060    
         pshs  d         
         sty   <u0060    
         lbsr  L10EE     
         puls  d         
         std   <u0060    
         clra            
         rts             

L16BD    pshs  x,b        Preserve regs
         ldx   <u0082     Get ptr to current pos in temp buffer
         ldb   ,x         Get char
         cmpb  #C$CR      Carriage return?
         bne   L16C9      No, skip ahead
         puls  pc,x,b     Yes, restore regs & return

L16C9    leas  5,s        Eat stack
         lbra  L08CC      Print 'What?' & return from there

L16CE    lda   ,y+        Get char
         cmpa  #C$SPAC    Space?
         beq   L16CE      Yes, keep looking
         cmpa  #'*        '*'?
         bne   L16E1      No, skip ahead
         sty   <u0082     Found star, save ptr as current pos in temp bffr
         ldx   <u005E     Get absolute exec address of basic module
         ldy   <u0060     Get absolute address of $F offest in basic module
         rts             

L16E1    leax  -1,y      
         bsr   L16F2     
         bcs   L16F1     
         ldx   <u005C    
         cmpy  <u005C    
         bhs   L16F1     
         exg   x,y       
         clra            
L16F1    rts             

L16F2    clr   ,-s        Clear flag?
         ldd   ,x         Get 2 chars
         cmpa  #'+        1st char a plus?
         bne   L1707      No, skip ahead
         ldy   <u0060     Get address of $F offset for basic module
L16FD    cmpb  #'*        2nd char='*'?
         bne   L1712      No, skip ahead
         leax  2,x        Yes, bump ptr up 2 chars
         stx   <u0082     Save as new current pos in temp buffer
         puls  pc,a      

L1707    cmpa  #'-        1st char dash?
         bne   L1714      No, skip ahead
         inc   ,s         Yes, set flag
         ldy   <u005E     Get address of $F offset for basic module
         bra   L16FD      Go check for '*'

L1712    leax  1,x        Bump ptr up
L1714    lda   ,x         Get char from there
         cmpa  #'0        Is it numeric?
         blo   L171E      No, skip ahead
         cmpa  #'9        Totally numeric?
         bls   L1723      Yes, skip ahead
L171E    ldd   #$0001    
         bra   L1727     

L1723    bsr   L1748     
         bcs   L1742     
L1727    stx   <u0082     Save current ptr into temp buff
         ldy   <u005C    
         tst   ,s+        Check flag
         beq   L173D     
         ldy   <u005E    
         pshs  d         
         ldd   <u00B5    
         subd  ,s++      
         bhs   L173D     
         clra            
         clrb            
L173D    lbsr  L1BCF     
         clra            
         rts             

L1742    ldy   <u005C    
         com   ,s+        Eat stack & set carry
         rts             

L1748    ldy   <u0046     ??? Get some sort of variable ptr
         bsr   L013A      JSR <2A, function 0 (Some temp var thing)
         lda   ,y+        ??? Get var type?
         cmpa  #2         Real?
         beq   L1759      Yes, set carry & exit
         clra             Clear carry
         ldd   ,y         Get integer
         bne   L175A      <>0, return with carry clear
L1759    coma             Set carry & return
L175A    rts             

L013A    jsr   <u002A    
         fcb   $00       

L175B    clrb            
         bra   L1760     

L175E    ldb   #1        
L1760    leas  -$F,s     
         stb   ,s        
         lda   ,y        
         clr   1,s       
         cmpa  #'*       
         bne   L1770     
         sta   1,s       
         leay  1,y       
L1770    ldb   ,y+        Find first non-space char
         cmpb  #C$SPAC   
         beq   L1770     
         tfr   b,a        Move char to A
         sty   <u0082     Save as next free pos in temp buffer
         lbsr  L18AA     
         stu   2,s       
         lbmi  L1985     
         tst   ,s        
         beq   L1791     
         lbsr  L18AA     
         stu   4,s       
         lbmi  L1985     
L1791    cmpa  #C$CR     
         beq   L179D     
         lda   ,y+       
         cmpa  #C$CR     
         lbne  L1985     
L179D    ldu   <u0046    
         stu   $D,s      
* TFM (W=entry (Y-1)-<u0082)
L17A1    lda   ,-y       
         sta   ,-u       
         cmpy  <u0082     ??? Back to beginning of temp buffer yet?
         bhi   L17A1      No, keep copying
         stu   <u0046    
         stu   <u0044    
         ldd   2,s       
         leau  d,u       
         leau  1,u       
         stu   6,s       
         ldy   <u005C    
         sty   $B,s      
         clr   $A,s      
         lbra  L1878     

L17C1    lbsr  L0DBB     
         sty   <u005C    
         lbsr  L128B     
         ldy   <u0080     Get ptr to start of temp buffer
         leay  5,y       
         lsl   $A,s       Dupe most sig bit into 2nd most sig bit???
         asr   $A,s      
L17D3    tst   <u0035     Any signals received?
         bne   L183A      Yes, skip ahead
         ldd   <u0082    
         subd  $02,s     
         ldx   <u0046    
         lbsr  L18BE     
         bcs   L182F     
         lda   #$81      
         sta   $A,s      
         tst   ,s        
         beq   L182F     
         ldd   <u0082    
         addd  4,s       
         subd  2,s       
         subd  <u0080    
         cmpd  #230      
         bhi   L182F     
         ldx   <u0082    
         exg   x,y       
         ldd   2,s       
         lbsr  L0FE3     
         tfr   y,d       
         subd  2,s       
         tfr   d,y       
         ldu   6,s       
         pshs  x,d       
L180B    lda   ,u+        Get byte
         sta   ,y+        Copy it
         cmpa  #$FF       Hit EOS marker?
         bne   L180B      No, keep copying until we do
         leay  -1,y      
         ldd   ,s++      
         subd  ,s        
         puls  x         
         lbsr  L0FE3     
         sty   <u0082    
         ldd   4,s       
         leay  d,x       
         ldd   2,s       
         bne   L182B     
         leay  1,y       
L182B    tst   1,s       
         bne   L17D3     
L182F    tst   $A,s      
         bpl   L1872     
         ldy   8,s       
         ldd   ,s        
         bne   L1845     
L183A    ldx   $D,s      
         stx   <u0046    
         stx   <u0044    
         leas  $F,s      
         lbra  L15F3     

L1845    lbsr  L1270     
         sty   $B,s      
         tst   ,s        
         beq   L1872     
         leax  ,y        
         lbsr  L1BC9     
         lbsr  L19A5     
         sty   <u005C    
         ldy   <u0080    
         lbsr  L1606     
         sty   <u005C    
         ldy   8,s       
         lbsr  L1BC9     
         cmpy  <u005C    
         bne   L1882     
         tst   1,s       
         beq   L1882     
L1872    ldy   8,s       
         lbsr  L1BC9     
L1878    sty   8,s       
         cmpy  <u0060    
         lbcs  L17C1     
L1882    lbsr  L0DBB     
         tst   $A,s      
         bne   L1899     
         leax  <L07AA,pc  Point to "can't find"
         lbsr  L135A     
         ldy   <u0046    
         lbsr  L13E1     
         lbsr  L1264     
L1899    ldy   $B,s      
         sty   <u005C    
         ldx   $D,s      
         stx   <u0046    
         stx   <u0044    
         leas  $F,s       Eat temp stack
         lbra  L1682     

L07AA    fcs   /can't find:/

L18AA    ldu   #-1        Pre-init counter to -1
L18AD    cmpa  #C$CR      Char a CR?
         beq   L18B9      Yes, set -1,y to a $FF, set carry & return
         leau  1,u        Bump counter up
         lda   ,y+        Get next char
         cmpb  -1,y       Match char in B?
         bne   L18AD      No, continue double checking
L18B9    clr   -1,y       Set -1,y to $FF
         com   -1,y       & set carry & return
         rts             

* CMPR Y,D for this with 18D2
L18BE    pshs  d         
         bra   L18D2     

L18C2    pshs  y,x       
L18C4    lda   ,x+       
         cmpa  #$FF      
         beq   L18DA     
         cmpa  ,y+       
         beq   L18C4     
         puls  y,x       
         leay  1,y       
L18D2    cmpy  ,s        
         bls   L18C2     
         coma            
         puls  pc,d      

L18DA    puls  y,x       
         clra            
         puls  pc,d      

L18DF    ldd   #100      
         ldx   #10       
         pshs  x,d       
         leax  ,y        
         ldy   <u00B5    
         lda   ,x        
         cmpa  #'*       
         bne   L18FA     
* 6309 MOD - use TFR 0,Y - same speed, 2 bytes shorter
         ldy   #$0000    
L18F6    leax  1,x       
         lda   ,x        
L18FA    cmpa  #C$SPAC   
         beq   L18F6     
         pshs  y         
         cmpa  #C$CR     
         beq   L191C     
         lbsr  L1748     
         bcs   L1981     
         std   2,s       
         lda   ,x+       
         cmpa  #C$CR     
         beq   L191C     
         lbsr  L1748     
         bcs   L1981     
         std   4,s       
         bmi   L1981     
         lda   ,x        
L191C    cmpa  #C$CR     
         bne   L1981     
         bsr   L1995     
         ldd   ,s++      
         ldy   <u005E    
         lbsr  L1BCF     
         sty   <u005C    
         ldd   ,s        
         lbsr  L1A0D     
         clr   ,-s       
         cmpy  <u005C    
         bcs   L198A     
         bsr   L1960     
         cmpx  #$0000    
         ble   L198A     
         tst   <u0035    
         bne   L194C     
         inc   ,s        
         bsr   L1960     
L194C    leas  5,s       
         ldx   2,s       
         lbsr  L1A2E     
         ldy   <u005E    
         ldd   <u00B5    
         lbsr  L1BCF     
         sty   <u005C    
         clra            
         rts             

L1960    ldy   <u005C    
         ldx   3,s       
L1965    clra            
         clrb            
         lbsr  L1A10     
         cmpy  <u0060    
         bhs   L1980     
         tst   2,s       
         beq   L1975     
         stx   1,y       
L1975    lbsr  L1BC9     
         tfr   x,d       
         addd  5,s       
         tfr   d,x       
         bpl   L1965     
L1980    rts             

L1981    leas  6,s       
         bra   L1987     

L1985    leas  $F,s      
L1987    lbra  L08CC     

L198A    leax  <L078B,pc  Point to 'RANGE'
         lbsr  L125F      Print it out to std error (From temp buffer)
         bra   L194C     

L078B    fcc   'RANGE'   
         fcb   $87        Hit bit set- Bell

L1993    leas  4,s       
L1995    lbsr  L0128      JSR <21, function 2 (dick around with module stuff?)
         clra            
         rts             

L199A    lbsr  L16CE     
         lbsr  L16BD     
         bsr   L19A5     
         lbra  L15F3     

L19A5    ldd   <u004A    
         std   <u00AB    
         tfr   y,d       
         pshs  x         
         subd  ,s++      
         leay  ,x        
L19B1    pshs  u,y,x,d   
         leax  d,y       
         pshs  x         
         ldy   <u00AB    
         ldd   <u004A    
         subd  ,s        
         beq   L19C3     
         lbsr  L0FE3     
L19C3    ldd   <u00AB    
         ldu   ,s        
         subd  ,s++      
         bls   L19D1     
         ldy   4,s       
         bsr   L0125     
L19D1    ldd   <u00AB    
         subd  <u004A    
         ldy   4,s       
         leay  d,y       
         sty   4,s       
         subd  ,s++      
         pshs  d         
         addd  <u0060    
         std   <u0060    
         std   <u004A    
         ldd   <u000C     Get # bytes free in workspace for user
         subd  ,s         Subtract ?
         std   <u000C     Save new # bytes free for user
         puls  pc,u,y,x,d Restore regs & return

L0125    jsr   <u001E    
         fcb   $06       

L19EF    pshs  y,x,d     
         leay  d,y       
         leau  d,u       
         andb  #$03      
L19F7    beq   L1A06     
         lda   ,-y       
         sta   ,-u       
         decb            
         bra   L19F7     

L1A00    ldx   ,--y      
         ldd   ,--y      
         pshu  x,d       
L1A06    cmpy  4,s       
         bne   L1A00     
         puls  pc,y,x,d  

L1A0D    ldy   <u005E    
L1A10    pshs  d         
         bra   L1A17     

L1A14    lbsr  L1BC9     
L1A17    cmpy  <u0060    
         bhs   L1A2B     
         lda   ,y        
         cmpa  #':       
         bne   L1A14     
         ldd   ,s        
         cmpd  1,y       
         bhi   L1A14     
         puls  pc,d      

L1A2B    coma            
         puls  pc,d      

* Part of RENAME (?)
L1A2E    pshs  u,y,x,d    Preserve regs
         lbsr  L0FB6      ??? Go move module in workspace?
         ldx   ,x         Get some sort of module ptr
         stx   <u002F     Save as ptr to current procedure
         ldd   M$Exec,x   Get exec offset
         addd  <u002F     Calculate exec address in memory
         std   <u005E     Save it
         ldd   $F,x       Get ???
         addd  <u002F     Add to current mod start
         tfr   d,y        Move to Y
         std   <u0060     Save ???
         std   <u004A    
         ldd   M$Size,x   Get size of module
         subd  $F,x       Subtract ???
         pshs  d          Save on stack
* 6809/6309 NOTE: LDD <U0000 IS UNECESSARY ON LEVEL II OS9
         ldd   <u0000     Get start of BASIC09 data mem ptr
         addd  <u0002     Add size of data area
         subd  ,s         Subtract calculated size
         tfr   d,u        Copy ??? size to U
         std   <u0066    
         puls  d          Get ??? calculated size
         bsr   L19EF     
         ldd   $D,x      
         subd  $F,x      
         subd  #3        
         std   <u0068    
         addd  <u0066    
         addd  #3        
         std   <u0062    
         ldd   M$Size,x   Get module size
         subd  $D,x       Subtract ???
         addd  #3         ??? Add CRC bytes?
         std   <u0064    
         ldy   <u005E    
         bsr   L1AC6     
         ldx   <u0062    
         ldd   -3,x      
         beq   L1A9E     
L1A83    pshs  d         
         leau  ,x        
         leax  3,x       
L1A89    ldb   ,x+       
         bpl   L1A89     
         lda   #2        
         cmpb  #$A4      
         bne   L1A95     
         lda   #4        
L1A95    sta   ,u        
         puls  d         
         subd  #1        
         bgt   L1A83     
L1A9E    ldx   <u0066    
         ldd   <u0068    
         leax  d,x       
         stx   <u00DA    
         stx   <u0066    
         addd  <u000C     Add to bytes free in workspace for user
         std   <u000C     Save new # bytes free in workspace for user
         clr   <u0068    
         clr   <u0069    
         puls  pc,u,y,x,d

* NOTE: CHECK IF ROUTINE CAN BE MOVED TO NEARER TABLE/SUBROUTINE
* L1AB2 & L1AB8 are only called within routine itself
* L1AC6 is called from way early in the code, and just before L1A83
L1AB2    ldb   ,y+       
         bpl   L1AB8     
         subb  #$2A      
L1AB8    clra            
         leax  >L1BD5,pc  Point to some sort of table
         ldb   d,x        Get entry
         lsrb             Divide by 16
         lsrb            
         lsrb            
         lsrb            
         lbsr  L1B75     
L1AC6    cmpy  <u0060    
         blo   L1AB2     
         rts             

* 8 bit offset jump table (base of JMP is L1ACC)
L1ACC    fcb   L1AE5-L1ACC
         fcb   L1AE3-L1ACC
         fcb   L1AE1-L1ACC
         fcb   L1B0F-L1ACC
         fcb   L1B00-L1ACC
         fcb   L1B12-L1ACC
         fcb   L1AFA-L1ACC
         fcb   L1B19-L1ACC
         fcb   L1B09-L1ACC
         fcb   L1AED-L1ACC
         fcb   L1B1F-L1ACC
         fcb   L1AEA-L1ACC
         fcb   L1AE8-L1ACC
         fcb   L1AE6-L1ACC
         fcb   L1ADB-L1ACC

* Routines called by above table follow here         
L1ADB    lda   -1,y      
         adda  #$93      
         sta   -1,y      
L1AE1    leay  1,y       
L1AE3    leay  1,y       
L1AE5    rts             

L1AE6    dec   -1,y      
L1AE8    dec   -1,y      
L1AEA    dec   -1,y      
         rts             

L1AED    ldd   ,y        
         addd  <u005E    
         tfr   d,x       
         ldd   -2,x      
         std   ,y++      
         dec   -3,y      
         rts             

L1AFA    lda   ,y+       
         cmpa  #$85      
         bne   L1B03     
L1B00    leay  9,y       
         rts             

L1B03    clrb            
         bsr   L1B23     
         leay  7,y       
         rts             

L1B09    lda   ,y+       
         cmpa  #$4F      
         bne   L1B11     
         leay  4,y       
L1B11    rts             

L1B0F    leay  5,y       
         rts             

L1B12    lda   ,y+       
         cmpa  #$FF      
         bne   L1B12     
         rts             

L1B19    ldb   ,y        
         clra            
         leay  d,y       
         rts             

L1B1F    ldb   -1,y      
L1B21    andb  #$04      
L1B23    lda   #$60      
         pshs  d         
         lda   #$85      
         sta   -1,y      
         ldx   <u0062    
         ldd   -3,x      
         ldu   ,y        
         bra   L1B40     

L1B33    puls  d         
L1B35    subd  #$0001    
         beq   L1B65     
         leax  3,x       
L1B3C    tst   ,x+       
         bpl   L1B3C     
L1B40    cmpu  1,x       
         bne   L1B35     
         pshs  d         
         lda   ,x        
         anda  #$E0      
         cmpa  2,s       
         bne   L1B33     
         lda   ,x        
         anda  #$18      
         bne   L1B33     
         lda   ,x        
         anda  #$04      
         eora  3,s       
         bne   L1B33     
         tfr   x,d       
         subd  <u0062    
         std   ,y++      
         leas  2,s       
L1B65    leas  2,s       
         rts             

L1B68    tstb             High bit set?
         bpl   L1B6D      No, skip ahead
         subb  #$2A       Adjust it down if it was
L1B6D    leax  <L1BD5,pc  Point to table
         abx              Point X to offset
         ldb   ,x         Get single byte
         andb  #$0F       Mask off high nibble
L1B75    leax  >L1ACC,pc  Point to vector offset table
         ldb   b,x        Point to routine that is close
         jmp   b,x        Go do it

L1B7D    pshs  u          Preserve U
         ldb   ,y+        Get byte
L1B81    cmpb  ,u+        If higher than byte in table, keep going
         bhi   L1B81     
         puls  u          Get U back
         beq   L1B91      If byte matches table entry, return
         bsr   L1B68      If not, go somewhere else

L1B8B    cmpy  <u0060    
         blo   L1B7D     
         coma            
L1B91    puls  pc,u,x,d   Restore regs & return

* 1 byte/entry table
L1B93    fcb   $1f       
         fcb   $21       
         fcb   $3a       
         fcb   $ff        End of table marker

L1B97    pshs  u,x,d     
         leau  <L1B93,pc  Point to table
         bra   L1B8B     

* 1 byte/entry table
L1B9F    fcb   $3E       
L1BA0    fcb   $3f       
L1BA1    fcb   $FF        End of table marker

L1BA2    pshs  u,x,d     
         leau  <L1B9F,pc  Point to table
         bra   L1B8B     

L1BA9    pshs  u,x,d     
         leau  <L1BA0,pc  Point to 2nd entry in table
         bra   L1B8B     

* Table: 1 byte entries
L1BB0    fcb   $23,$85,$86,$87,$88,$89,$8A,$8B,$8C
         fcb   $f2,$f3,$f4,$f5,$f6,$f7,$f8,$f9,$ff

L1BC2    pshs  u,x,d     
         leau  <L1BB0,pc  Point to table
         bra   L1B8B     

         IFNE  H6309
L1BC9    clrd            
         ELSE            
L1BC9    clra            
         clrb            
         ENDC            

L1BCB    bsr   L1BA9     
         bcs   L1BD4     
L1BCF    subd  #$0001    
         bhs   L1BCB     
L1BD4    rts             

* Table - single byte entries - one routine uses it to reference another
* table (1ACC), but divides it by 16 to determine which of that table to use
* Table goes from 1BD5 to 1CA4
L1BD5    fcb   $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00
         fcb   $00,$22,$00,$00,$64,$00,$22,$00,$00,$00,$22,$00,$22,$00,$00,$22
         fcb   $92,$22,$92,$22,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00
         fcb   $00,$00,$00,$00,$00,$00,$00,$77,$77,$00,$22,$92,$77,$77,$00,$00
         fcb   $00,$00,$00,$00,$80,$00,$22,$22,$00,$00,$11,$00,$00,$00,$00,$00
         fcb   $00,$00,$00,$00,$00,$22,$a2,$a2,$a2,$a2,$a2,$22,$22,$22,$22,$22
         fcb   $22,$22,$22,$11,$22,$33,$55,$22,$00,$00,$00,$00,$00,$00,$00,$b0
         fcb   $00,$00,$00,$00,$b0,$00,$00,$00,$00,$00,$00,$00,$00,$b0,$00,$00
         fcb   $00,$b0,$00,$b0,$00,$b0,$00,$b0,$00,$b0,$00,$00,$00,$00,$00,$00
         fcb   $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$b0,$00,$00,$00,$00
         fcb   $00,$00,$00,$00,$00,$b0,$00,$00,$00,$00,$b0,$c0,$00,$b0,$c0,$00
         fcb   $b0,$c0,$d0,$00,$b0,$c0,$d0,$00,$b0,$c0,$00,$b0,$c0,$00,$b0,$c0
         fcb   $00,$b0,$00,$b0,$00,$b0,$00,$00,$e2,$e2,$e2,$e2,$e2,$e2,$e2,$e2

L1CA5    pshs  x,d        Preserve regs
         ldb   [<4,s]     Get function code
L1CAA    leax  <L1CB5,pc  Point to table
         ldd   b,x        Make offset vector
         leax  d,x       
         stx   4,s        Modify RTS address
         puls  pc,x,d     restore X & D and RTS to new address

* 2 byte/entry vector table (JMP >$1E calls have there function byte after
*  the JMP containing the offset to which of these entries to uses)
L1CB5    fdb   L1F9E-L1CB5 $00 function
         fdb   L2430-L1CB5 $02 function
         fdb   L252A-L1CB5 $04 function
         fdb   L2508-L1CB5 $06 function
         fdb   L24BD-L1CB5 $08 function
         fdb   L1E29-L1CB5 $0A function

* Data of some sort: Appears to be special symbols
L1CD0    fdb   33         (# of entries-33)
         fcb   $03        (# bytes to skip to start of next?)

L1CD3    fcb   L2368-L239D
         fcb   $d9,$0a    (token & type of operator???)
         fcs   '<>'      

         fcb   L2368-L239D
         fcb   $d9,$0a   
         fcs   '><'      

         fcb   L2368-L239D
         fcb   $e4,$0a   
         fcs   '<='      

         fcb   L2368-L239D
         fcb   $e4,$0a   
         fcs   '=<'      

         fcb   L2368-L239D
         fcb   $e1,$0a   
         fcs   '>='      

         fcb   L2368-L239D
         fcb   $e1,$0a   
         fcs   '=>'      

         fcb   L2368-L239D
         fcb   $52,$08   
         fcs   ':='      

         fcb   L2368-L239D
         fcb   $f1,$05   
         fcs   '**'      

         fcb   L2368-L239D
         fcb   $38,$01   
         fcs   '(*'      

         fcb   L2368-L239D
         fcb   $3e,$02   
         fcs   '\'       

         fcb   L2368-L239D
         fcb   $d3,$0a   
         fcs   '>'       

         fcb   L2368-L239D
         fcb   $d6,$0a   
         fcs   '<'       

         fcb   L2368-L239D
         fcb   $dd,$09   
         fcs   '='       

         fcb   L2368-L239D
         fcb   $e7,$05   
         fcs   '+'       

         fcb   L2368-L239D
         fcb   $ea,$05   
         fcs   '-'       

         fcb   L2368-L239D
         fcb   $ec,$05   
         fcs   '*'       

         fcb   L2368-L239D
         fcb   $ee,$05   
         fcs   '/'       

         fcb   L2368-L239D
         fcb   $f0,$05   
         fcs   '^'       

         fcb   L2368-L239D
         fcb   $4c,$0c   
         fcs   ':'       

         fcb   L2368-L239D
         fcb   $4f,$0c   
         fcs   '['       

         fcb   L2368-L239D
         fcb   $50,$0c   
         fcs   ']'       

         fcb   L2368-L239D
         fcb   $51,$0c   
         fcs   ';'       

         fcb   L2368-L239D
         fcb   $54,$0b   
         fcs   '#'       

         fcb   L2368-L239D
         fcb   $26,$01   
         fcs   '?'       

         fcb   L2368-L239D
         fcb   $37,$01   
         fcs   '!'       

         fcb   L233E-L239D Recurse to the search routine again (eat LF)
         fcb   $00,$0c   
         fcb   $80+C$LF   Line feed

         fcb   L2368-L239D
         fcb   $4b,$0c   
         fcs   ','       

         fcb   L2368-L239D
         fcb   $4d,$0c   
         fcs   '('       

         fcb   L2368-L239D
         fcb   $4e,$0c   
         fcs   ')'       

         fcb   L2371-L239D
         fcb   $89,$0c   
         fcs   '.'       

         fcb   L23BE-L239D
         fcb   $90,$06   
         fcs   '"'       

         fcb   L239D-L239D
         fcb   $91,$06   
         fcs   '$'       

         fcb   L2368-L239D
         fcb   $3f,$02   
         fcb   $80+C$CR   Carriage return

* Jump table for type 1 commands (see L0140)
*                           Command  Token
L1D60    fdb   L211B-L1D60 ???      0   Illegal statement construction error
         fdb   L1E82-L1D60 PARAM    1
         fdb   L1E72-L1D60 TYPE     2
         fdb   L1E82-L1D60 DIM      3
         fdb   L1ED3-L1D60 DATA     4
         fdb   L2029-L1D60 STOP     5
         fdb   L210B-L1D60 BYE      6
         fdb   L210B-L1D60 TRON     7 
         fdb   L210B-L1D60 TROFF    8
         fdb   L2029-L1D60 PAUSE    9
         fdb   L210B-L1D60 DEG      A
         fdb   L210B-L1D60 RAD      B
         fdb   L210B-L1D60 RETURN   C
         fdb   L2123-L1D60 LET      D
         fdb   L211B-L1D60 ???      E   Illegal Statement Construction err
         fdb   L1EE1-L1D60 POKE     F
         fdb   L1EEA-L1D60 IF       10
         fdb   L1EFF-L1D60 ELSE     11
         fdb   L210B-L1D60 ENDIF    12
         fdb   L1F03-L1D60 FOR      13
         fdb   L1F24-L1D60 NEXT     14
         fdb   L1F2E-L1D60 WHILE    15
         fdb   L1F3D-L1D60 ENDWHILE 16
         fdb   L210B-L1D60 REPEAT   17
         fdb   L1F39-L1D60 UNTIL    18
         fdb   L210B-L1D60 LOOP     19
         fdb   L1F3D-L1D60 ENDLOOP  1A
         fdb   L1F41-L1D60 EXITIF   1B
         fdb   L1F3D-L1D60 ENDEXIT  1C
         fdb   L1F4C-L1D60 ON       1D
         fdb   L213C-L1D60 ERROR    1E
         fdb   L1F87-L1D60 GOTO     1F
         fdb   L211B-L1D60 ???      20  Illegal Statement Construction err
         fdb   L1F87-L1D60 GOSUB    21
         fdb   L211B-L1D60 ???      22  Illegal Statement Construction err
         fdb   L1FB4-L1D60 RUN      23
         fdb   L213C-L1D60 KILL     24
         fdb   L1FF6-L1D60 INPUT    25
         fdb   L2029-L1D60 PRINT    26 (Also '?')
         fdb   L213C-L1D60 CHD      27
         fdb   L213C-L1D60 CHX      28
         fdb   L2093-L1D60 CREATE   29
         fdb   L2093-L1D60 OPEN     2A
         fdb   L2083-L1D60 SEEK     2B
         fdb   L205A-L1D60 READ     2C
         fdb   L2067-L1D60 WRITE    2D
         fdb   L2071-L1D60 GET      2E
         fdb   L2071-L1D60 PUT      2F
         fdb   L20D2-L1D60 CLOSE    30
         fdb   L20DC-L1D60 RESTORE  31
         fdb   L213C-L1D60 DELETE   32
         fdb   L213C-L1D60 CHAIN    33
         fdb   L213C-L1D60 SHELL    34
         fdb   L20E0-L1D60 BASE     35
         fdb   L20E0-L1D60 ???      36
         fdb   L20F8-L1D60 REM      37 (Also '!')
         fdb   L20F8-L1D60 (*       38
         fdb   L2029-L1D60 END      39

L1DD4    lda   <u000A+1   Get LSB of # bytes used by all programs (not data)
L1DD6    pshs  a          Save it
         ldx   <u00A7    
         lda   #C$CR      Byte to look for
L1DDC    lsl   ,x         Clear out high bit? (if so, use AIM instead)
         lsr   ,x        
         cmpa  ,x+        Find byte we want?
         bne   L1DDC      No, keep looking
         ldx   <u00A7     Get ptr to end of string name+1
         bsr   L1E1F      Print string out
         ldd   <u00B9    
         subd  <u00A7    
         pshs  b         
         ldx   <u00AF    
         stx   <u00AB    
         ldy   <u00A7    
         lda   #$3D      
         lbsr  L2415     
         lbsr  L20F8     
         lbsr  L2415     
         lda   #C$SPAC    Block copy Spaces (TFM)
         ldx   <u0080     Get start address
L1E04    sta   ,x+        Fill with spaces
         dec   ,s        
         bpl   L1E04     
         ldd   #$5E0D     Add ^ (CR) (part of debug?)
         std   -$01,x    
         ldx   <u0080     Get start ptr again
         bsr   L1E1F      Go print the debug line
         puls  d         
         bsr   L1CC1     
         ldx   <u0046    
         stx   <u0044    
L1CC7    jsr   <u001B     ??? Reset temp buff to defaults, SP restore from B7
         fcb   $06       

L1CC1    jsr   <u001B     Print error code to screen
         fcb   $02       

L1E1F    ldy   #$0100     Size=256 bytes
         lda   <u002E     Get path
         os9   I$WritLn   Write it & return
         rts             

L1CC4    jsr   <u001B     ??? Save SP @ <u00B7, muck around
         fcb   $04       

L1E29    puls  x         
         bsr   L1CC4     
         lbsr  L1F90     
         lbsr  L214C     
         sty   <u00A7    
         ldx   <u00AB    
         stx   <u00AF    
L1E3B    bsr   L1E4C      Go process command/variable/constant
         lda   <u00A3     Get token
         lbsr  L2415      Add to I-code line bffr & make sure no overflow
         cmpa  #$3E       Was it a $3E?
         beq   L1E3B      Yes, go get next one
         cmpa  #$3F       Was it a $3F?
         bne   L1DD4      No, do something
         bra   L1CC7      Yes, Call <u001B, function 6

L1E4C    lbsr  L233E      Go find command (or variable/constant name)
         lda   <u00A4     Get command type
         cmpa  #$01       (Is it a normal command?)
         bne   L1E62      No, check next
* Command type 1 goes here
         ldb   <u00A3     Get entry # (token) into JMP offset table
         clra             Make 16 bit for signed jump
         IFNE  H6309
         lsld             Multiply by 2 (2 bytes/entry)
         ELSE            
         lslb            
         rola            
         ENDC            
         leax  >L1D60,pc  Point to Basic09 COMMANDS vector table
         ldd   d,x        Get offset
         jmp   d,x        Execute command's routine

L1E62    cmpa  #$02       Command type 2?
         lbne  L2126      No, go process functions, etc.
* Command type 2 goes here
L1E68    pshs  x         
         ldx   <u00AB    
         leax  -$01,x    
         stx   <u00AB    
         puls  pc,x      

L1E72    lbsr  L2167     
         cmpa  #$DD      
         lbne  L211F     
         bsr   L1E68     
         lda   #$53      
         lbsr  L2415     

L1E82    lbsr  L2167     
         cmpa  #$4D      
         bne   L1E9B     
         lbsr  L216E     
         bne   L1E96     
         lbsr  L216E     
         bne   L1E96     
         lbsr  L216E     
L1E96    lbsr  L22BF     
         bsr   L1EC9     
L1E9B    lbsr  L21A1     
         beq   L1E82     
         cmpa  #$4C      
         bne   L1EC3     
         bsr   L1EC9     
         ldb   <u00A4     Get token
         beq   L1EC1      If 0, skip ahead
         cmpb  #$03      
         bne   L1ECC     
         cmpa  #$44      
         bne   L1EC1     
         bsr   L1EC9     
         cmpa  #$4F      
         bne   L1EC3     
         lbsr  L216E     
         cmpa  #$50      
         bne   L1ECC     
L1EC1    bsr   L1EC9     
L1EC3    cmpa  #$51      
         beq   L1E82     
         bra   L1E68     

L1EC9    lbra  L233E     

L1ECC    lda   #$18      
         bra   L1F36     

L1ED0    lbsr  L2415     
L1ED3    bsr   L1F1D     
         lbsr  L21A1     
         beq   L1ED0     
L1EDA    lda   #$55      
L1EDC    lbsr  L2415     
         bra   L1F2B     

L1EE1    lbsr  L213C     
         lbsr  L21A6     
         lbra  L2139     

L1EEA    bsr   L1F39     
         cmpa  #$45      
         bne   L1EFB     
         lbsr  L2415     
         lbsr  L214C     
         bcc   L1F3F     
         lbra  L1E4C     

L1EFB    lda   #$26      
         bra   L1F36     

L1EFF    bsr   L1F2B     
         bra   L1F49     

L1F03    lbsr  L2193     
         lbsr  L212D     
         lda   <u00A3    
         cmpa  #$46      
         bne   L1F20     
         bsr   L1F1B     
         lda   <u00A3    
         cmpa  #$47      
         bne   L1EDA     
         bsr   L1F1B     
         bra   L1EDA     

L1F1B    bsr   L1EDC     
L1F1D    lbra  L213C     

L1F20    lda   #$27      
         bra   L1F36     

L1F24    lbsr  L2193     
         bsr   L1F2B     
         bsr   L1F2B     
L1F2B    lbra  L2176     

L1F2E    bsr   L1F39     
         cmpa  #$48      
         beq   L1F47     
         lda   #$1F      
L1F36    lbra  L1DD6     

L1F39    bsr   L1F1D     
         bra   L1EDA     

L1F3D    bsr   L1F2B     
L1F3F    bra   L1F8D     

L1F41    bsr   L1F39     
         cmpa  #$45      
         bne   L1EFB     
L1F47    bsr   L1FB1     
L1F49    lbra  L1E4C     

L1F4C    ldd   <u00AB    
         pshs  y,d       
         lbsr  L233E     
         cmpa  #$1E      
         bne   L1F60     
         leas  $04,s     
         bsr   L1F8D     
         cmpa  #$1F      
         beq   L1F8A     
         rts             

L1F60    puls  y,d       
         std   <u00AB    
         bsr   L1F39     
         ldx   <u00AB    
         leax  -1,x      
         pshs  x         
         cmpa  #$1F      
         beq   L1F7C     
         cmpa  #$21      
         beq   L1F7C     
         lda   #$21      
         bra   L1F36     

L1F78    bsr   L1FB1     
         lda   #$3A      
L1F7C    inc   [,s]      
         bsr   L1F8A     
         lbsr  L21A1     
         beq   L1F78     
         puls  pc,x      

L1F87    lbsr  L210E     
L1F8A    lbsr  L2156     
L1F8D    lbra  L210B     

L1F90    sty   <u00A7     Save ptr to end of string name
         ldx   <u004A     ??? Get ptr to start of I-code
         stx   <u00AF     Save it
         stx   <u00AB     And again as current I-code line end ptr
         clr   <u00BB     Clear <u00BB & <u00BC
         clr   <u00BC    
L1FF5    rts             

* Entry: Y=Ptr to end of string name+1
L1F9E    bsr   L1F90      Set up some ptrs
         inc   <u00A0     ??? Set flag? (think it is 3-way flag)
         lbsr  L210B      ??? Go process source line? (A returns token)
         bsr   L1FC0      Go check for "(" command grouping start
         clr   <u00A0     ??? Clear flag?
         lda   <u00A3     Get 1st byte from command table (token)?
         cmpa  #$3F       Was it a carriage return token?
         lbne  L1DD4      No, go process token
L1FB1    lbra  L2415      Add token to I-code buffer, check for overflow

L1FB4    lbsr  L210E     
         pshs  x         
         lbsr  L2193     
         ldb   #$23      
         stb   [,s++]    
* Check for "(" token (start of group of operations)
L1FC0    cmpa  #$4D       Token $4D  - "(" group start token?
         bne   L1FF5      No, return
* Process "( )" command grouping
L1FC4    bsr   L1FB1      No, go call L2415 (X=Tble ptr, D=Token/type bytes?)
         ldd   <u00AB     Get ptr to current I-code line end
         pshs  y,d        Save with source ptr(?)
         lbsr  L233E      Process next command/line #/variable name
         ldd   #$0005     Token types 0 & 5
         cmpa  <u00A4     Just processed command token type 0?
         beq   L1FD8      Yes, skip ahead
         stb   <u00A4     No, replace with type 5 (AND,OR,XOR,NOT)
         bra   L1FDB      Skip ahead

L1FD8    lbsr  L2182      Go check for Illegal Statement Construction
L1FDB    puls  y,d        Get ptr to last char+1 & current I-code line end
         std   <u00AB     Save original I-code line end ptr
         ldb   <u00A4     Get token type
         cmpb  #$05       Type 5 (AND,OR,XOR,NOT)?
         beq   L1FE8      Yes, skip ahead
         lbsr  L225D      No, go force token $E & check for I-code overflow
L1FE8    lbsr  L2314     
         lbsr  L21A1     
         beq   L1FC4     
         pshs  a         
         lbra  L22F7     

L1FF6    sty   <u00A9    
         lbsr  L2186     
         bne   L2007     
         sty   <u00A9    
         bsr   L2022     
         bsr   L1FB1     
         bsr   L1F8D     
L2007    ldy   <u00A9    
         cmpa  #$90      
         bne   L201A     
         lbsr  L233E     
         lbsr  L1F8D     
L2014    bsr   L2022     
L2016    lda   #$4B      
         bsr   L2080     
L201A    bsr   L2073     
         lbsr  L219B     
         beq   L2016     
L2021    rts             

L2022    lbsr  L219B     
         beq   L2021     
         bra   L207D     

L2029    sty   <u00A9    
         lbsr  L2186     
         beq   L203A     
         cmpa  #$49      
         beq   L203E     
L2035    ldy   <u00A9    
         bra   L2045     

L203A    cmpa  #$49      
         bne   L2054     
L203E    lbsr  L2139     
         bra   L2054     

L2043    bsr   L2080     
L2045    lbsr  L245D     
         cmpa  #C$CR     
L204A    lbeq  L210B     
         cmpa  #'\       
         beq   L204A     
         bsr   L2085     
L2054    lbsr  L219B     
         beq   L2043     
         rts             

L205A    sty   <u00A9    
         lbsr  L2186     
         beq   L2014     
         ldy   <u00A9    
         bra   L201A     

L2067    sty   <u00A9    
         lbsr  L2186     
         beq   L2054     
         bra   L2035     
L2071    bsr   L2078     
L2073    inc   <u00BC    
         lbra  L2180     

L2078    lbsr  L2186     
         bne   L20D7     
L207D    lbsr  L21A6     
L2080    lbra  L2415     

L2083    bsr   L2078     
L2085    lbra  L213C     

* Data table for file access modes?
L2088    fcb   $2c,%00000001 Read mode?
         fcb   $2d,%00000010 Write mode?
         fcb   $f7,%00000011 Update mode?
         fcb   $f8,%00000100 Execution dir mode?
         fcb   $f9,%10000000 Directory mode?
         fcb   $00        End of table marker

L2093    lbsr  L233E     
         cmpa  #$54      
         bne   L20D7     
         bsr   L2073     
         bsr   L207D     
         bsr   L2085     
         lda   <u00A3     Get token
         cmpa  #$4C      
         bne   L2114     
         lda   #$4A      
         bsr   L2080     
         clr   ,-s       
L20AC    bsr   L210B     
         leax  <L2088,pc  Point to table (modes?)
L20B1    cmpa  ,x++      
         bhi   L20B1      We need higher entry #, keep looking
         bne   L20C7      Illegal, return error
         ldb   -1,x       Get mode (read/write/update)???
         orb   ,s         Merge with mode on stack???
         stb   ,s         Save new mode???
         bsr   L210B     
         cmpa  #$E7      
         beq   L20AC     
         lda   ,s+       
         bne   L2080     
L20C7    lda   #$0F       Illegal mode error?
         bra   L20D9     

L20CB    lbsr  L21A1     
         bne   L2114     
         bsr   L2080     
L20D2    lbsr  L2186     
         beq   L20CB     
L20D7    lda   #$1C       Missing Path Number error
L20D9    lbra  L1DD6     

L20DC    bsr   L214C     
         bra   L210B     

L20E0    lbsr  L245D     
         leay  1,y       
         suba  #$30       Convert ASCII digit to binary
         beq   L210B      If 0, skip ahead
         cmpa  #1        
         lbne  L21C9      If anything but 0 or 1, Illegal operand error
         bsr   L210E      If 1, skip ahead
         lda   #$36      
         lbsr  L2415     
         bra   L210B     

L20F8    ldx   <u00AB     Get ptr to current I-Code end
         lbsr  L245D     
         clra            
L20FE    lbsr  L2415     
         inc   ,x        
         lda   ,y+        Get char
         cmpa  #C$CR      CR?
         bne   L20FE      Nope, keep going
         leay  -1,y       Bump ptr back to CR

L210B    lbsr  L233E      Check for command/constant/variable names
L210E    ldx   <u00AD     Get ptr to end of I-code line
         stx   <u00AB     Make it the current end ptr
         lda   <u00A3     Get token & return
L2114    rts             

L2115    lda   <u00A4     Get token type
         beq   L2114      If 0, return
L211B    lda   #12        Exit with Illegal Statement Construction error
         bra   L20D9     

L211F    lda   #$1B       Missing Assignment Statement error
L2121    bra   L20D9     

L2123    lbsr  L233E     

* Token types >2 go here
L2126    bsr   L2115     
         inc   <u00BC    
         lbsr  L21FC     
L212D    lda   <u00A3     Get token
         cmpa  #$52       ??? Is it ':='?
         beq   L2139      Yes, skip ahead
         cmpa  #$DD       ??? Is it '='?
         bne   L211F      No, exit with Missing Assignment statement error
         lda   #$53       Token=$53
L2139    lbsr  L2415      Go append to I-Code buffer
L213C    lda   #$39      
L213E    ldx   <u0044    
         clrb            
         lbsr  L22BA     
L2144    bsr   L21B4     
         lbsr  L2262     
         bcc   L2144     
L214B    rts             

L214C    lbsr  L245D     
         lbsr  L246E     
         bcs   L214B     
         lda   #$3A       Go append $3A token to I-Code buffer
L2156    bsr   L217D     
         lbsr  L23A6     
         beq   L2163     
         ldd   ,x        
         lbgt  L240C     
L2163    lda   #$10       Illegal Number error
         bra   L2121     

L2167    bsr   L216B     
         bsr   L2115     
L216B    lbra  L233E     

L216E    lda   #$8E      
         bsr   L2156     
         bsr   L216B     
         bra   L21A1     

L2176    clra            
         bsr   L217D     
         bsr   L217D     
         bra   L218E     

L217D    lbra  L2415     

L2180    bsr   L216B     
L2182    bsr   L2115     
         bra   L21FC     

L2186    bsr   L210B     
         cmpa  #$54      
         bne   L2192     
         bsr   L2139     
* 6809/6309 MOD: If A not required, CLRA
L218E    lda   <u00A3    
         orcc  #Zero     
L2192    rts             

L2193    bsr   L216B     
         lbsr  L2115     
L2198    lbra  L210B     

L219B    lda   <u00A3    
         cmpa  #$51      
         beq   L21A5     
L21A1    lda   <u00A3    
         cmpa  #$4B      
L21A5    rts             

L21A6    bsr   L21A1     
         beq   L21A5     
         lda   #$1D      
         bra   L21CB     

L21AE    clrb            
         bsr   L21F5     
         lbsr  L210E     
L21B4    bsr   L21EA     
         bsr   L21CE     
         cmpa  #$4D      
         beq   L21AE     
         ldb   <u00A4    
         cmpb  #$06      
         beq   L2198     
         cmpb  #$04      
         bne   L2182     
         lbra  L22CA     

L21C9    lda   #$12       Illegal operand error
L21CB    lbra  L1DD6     

L21CE    cmpa  #$CD      
         beq   L21E3     
         cmpa  #$EA      
         bne   L21A5     
         lda   ,y        
         lbsr  L246E     
         bcc   L21ED     
         cmpa  #$2E      
         beq   L21ED     
         lda   #$CE      
L21E3    ldb   #$07      
         bsr   L21F5     
         lbsr  L210E     
L21EA    lbra  L233E     

L21ED    leay  -1,y      
         lbsr  L1E68     
         lbra  L237A     

L21F5    ldx   <u0044    
         std   ,--x      
         stx   <u0044    
         rts             

L21FC    ldd   #$8500    
L21FF    pshs  d         
         ldd   <u00A1    
         bsr   L21F5     
         puls  d         
         bsr   L21F5     
         lbsr  L210E     
         lbsr  L210B     
         clrb            
         cmpa  #$4D      
         beq   L2226     
L2214    cmpa  #$89      
         bne   L2247     
         bsr   L2257     
         bsr   L2247     
         bsr   L21EA     
         lbsr  L2115     
         ldd   #$8900    
         bra   L21FF     

L2226    bsr   L2257     
         incb            
         pshs  b         
         lbsr  L2314     
         lbsr  L21A1     
         bne   L223E     
         ldb   ,s+       
         cmpb  #$03      
         blo   L2226     
         lda   #$2A      
         lbra  L1DD6     

L223E    bsr   L22BF     
         lbsr  L210B     
         puls  b         
         bra   L2214     

L2247    clr   <u00BC    
         ldx   <u0044    
         addb  ,x++      
         lbsr  L2413     
         ldd   ,x++      
         stx   <u0044    
         lbra  L240C     

L2257    tst   <u00BC    
         beq   L228A     
         clr   <u00BC    
L225D    lda   #$0E      
L225F    lbra  L2415     

L2262    ldb   <u00A3     Get token
         clra            
         cmpb  #$4E      
         beq   L228B     
         tstb            
         bpl   L2273     
         bsr   L1CCD     
         bita  #$08      
         bne   L228B     
L2273    ldx   <u0044    
L2275    ldd   ,x++      
         cmpa  #$4D      
         beq   L22C5     
         bsr   L225F     
         tstb            
         bne   L2275     
         cmpa  #$39      
         bne   L2287     
         lbsr  L1E68     
L2287    stx   <u0044    
         coma            
L228A    rts             

L228B    anda  #$07      
         tfr   a,b       
         ldx   <u0044    
         bra   L2297     

L2293    lda   ,x++      
         bsr   L230F     
L2297    cmpb  1,x       
         blo   L2293     
         bhi   L22B8     
         cmpb  #6        
         beq   L22B8     
         tstb            
         bne   L2293     
         lda   ,x++      
         cmpa  #$4D      
         bne   L22B0     
         stx   <u0044    
         bsr   L22FE     
         bra   L2262     

L22B0    cmpa  #$39      
         beq   L2307     
         bsr   L230F     
         bra   L2287     

L22B8    lda   <u00A3     Get token
L22BA    std   ,--x      
         stx   <u0044    
L22BE    rts             

L22BF    lda   <u00A3     Get token
         cmpa  #$4E       ??? ^ or ** (power)?
         beq   L22BE      Yes, return
L22C5    lda   #$25      
L22C7    lbra  L1DD6     

L1CCD    jsr   <u001B    
         fcb   $12       

L22CA    lbsr  L1E68     
         lda   <u00A3     Get token
         pshs  a          Save it
         bsr   L22FE     
         ldb   ,s        
         bsr   L1CCD     
         leax  <L22F7,pc  Point to routine
         pshs  x         
         anda  #$03      
         beq   L230B     
         cmpa  #2        
         beq   L231B     
         bhi   L2322     
         ldb   2,s       
         cmpb  #$92      
         beq   L2331     
         cmpb  #$94      
         beq   L2331     
         cmpb  #$BE      
         beq   L2326     
         bra   L2312     

L22F7    bsr   L22BF     
         puls  a         
         lbsr  L2415     
L22FE    lbra  L210B     

L2301    lda   <u00A3    
         cmpa  #$4D      
         beq   L22BE     
L2307    lda   #$22      
         bra   L22C7     

L230B    leas  2,s       
         puls  a         
L230F    lbra  L2415     

L2312    bsr   L2301     
L2314    clra            
         lbsr  L213E     
         lbra  L1E68     

L231B    bsr   L2312     
L231D    lbsr  L21A6     
         bra   L2314     

L2322    bsr   L231B     
         bra   L231D     

L2326    bsr   L2301     
         bsr   L22FE     
         cmpa  #$54      
         beq   L2314     
         lbra  L20D7     

L2331    bsr   L2301     
         incb            
         lbsr  L2413     
         lbra  L2180     

L233A    lda   #$0A       Unrecognized symbol error
         bra   L22C7     

* Search for operator's loop? (An LF is eaten and it returns here)
L233E    ldd   <u00AB     Get current I-code line's end ptr
         std   <u00AD     Dupe it here
         lbsr  L245D      Find first non-space/LF char
         sty   <u00B9     Save ptr to it
         lbsr  L2432      Check for variable name
         lbne  L23E1      None, check for command names
         lda   ,y         Get first char of possible variable name
         lbsr  L246E      Does it start with a number (0-9)?
         bcc   L237A      Yes, skip ahead
         leax  >L1CD0+3,pc No, point to Operator's table
         lda   #$80       Get high bit mask to check for end of entry
         lbsr  L252A      Go find entry
         beq   L233A      None, exit with Unrecognized symbol error
         ldb   ,x         Get offset
         leau  <L239D,pc  Point to base routine
         jmp   b,u        Go to subroutine

* '.' goes here
L2371    lda   ,y         Get char from source
         lbsr  L246E     
         bcs   L2368     
         leay  -1,y      
* Starts with numeric (0-9) value
L237A    bsr   L23A6     
         bne   L238F     
         ldd   #$8F05     Token=$85, count=5
L2381    sta   <u00A3    
L2383    bsr   L23D6     
         lda   ,x+       
         decb            
         bpl   L2383     
         lda   #6        
         sta   <u00A4     Save type (?) as 6
         rts             

L238F    ldd   #$8E02    
         tst   ,x        
         bne   L2381     
         ldd   #$8D01    
         leax  1,x       
         bra   L2381     

* Almost all operators come here
L2368    ldd   1,x        Get the 2 mystery bytes
* Command found comes here with D=2 byte # in command table
L236A    std   <u00A3     Save token & type byte
         bra   L2415     

* '$' goes here
L239D    leay  -1,y       Bump source ptr back by 1
         bsr   L23A6     
         ldd   #$9102    
         bra   L2381     

L23A6    lbsr  L245D      Find 1st non-space/lf char
         leax  ,y         Point x to the char
         ldy   <u0044    
         bsr   L1CCA      Call vector <2A, function 00
         exg   x,y       
         bcs   L23BA      If error from vector, illegal literal error
         lda   ,x+       
         cmpa  #2        
         rts             

L1CCA    jsr   <u002A    
         fcb   $00       

L23BA    lda   #$16       Illegal literal error
         bra   L23DA     

* '"' goes here
L23BE    bsr   L2368     
         bra   L23C4     

L23C2    bsr   L2415     
L23C4    lda   ,y+        Get char from source
         cmpa  #C$CR      End of line already?
         beq   L23D8      Yes, no ending quote error
         cmpa  #'"        Is it the quote?
         bne   L23C2      No, keep looking
         cmpa  ,y+        Double quote?
         beq   L23C2      Yes, do something
         leay  -1,y       No, set src ptr back to next char
         lda   #$FF       Go save $FF at this point in I-code line
L23D6    bra   L2415     

L23D8    lda   #$29       No Ending Quote error
L23DA    lbra  L1DD6      Deal with error

L23DD    lda   #$31       Undefined Variable error
         bra   L23DA     

* Check for command names
L23E1    ldx   <u009E     Get ptr to commmands token list
         lbsr  L2528      Go find command
         beq   L23EF      No command found, skip ahead
         stx   <u00A1     Save ptr to command's 2 byte # in table
         ldd   ,x         Get 2 byte # from command's entry in table
L23EC    std   <u00A3     Save token & type bytes
         bra   L2415      Go check size of I-code line

L23EF    tst   <u00A0    
         bmi   L23DD     
         ldx   <u0062    
         lbsr  L2528     
         bne   L2401     
         tst   <u00A0    
         bne   L23DD     
         lbsr  L2494     
L2401    ldd   #$8500    
         bsr   L23EC      Go append token $85, type 0 & check for overflow
         tfr   x,d       
         subd  <u0062    
         std   <u00A1    
L240C    bsr   L2415     
         bsr   L2413     
         lda   <u00A3     Get token & return
         rts             

L2413    tfr   b,a       
L2415    pshs  x,d        Preserve Table ptr & 2 mystery bytes
         ldx   <u00AB     Get ptr to end of current I-code line
         sta   ,x+        Save token for operator
         stx   <u00AB     Save new end of current I-code line ptr
         ldd   <u00AB     Get it again
         subd  <u004A     Calculate current I-code line size
         cmpb  #255       Past maximum size?
         bhs   L2428      Yes, generate error
         clra             No, no error
         puls  pc,x,d     Restore regs & return

L2428    lda   #$0d       I-Code Overflow error
         lbsr  L1CC1      Print error message
         jsr   <u001B     ??? Reset temp buff to defaults, SP restore from B7
         fcb   $06       

L2430    bsr   L245D      Search for 1st non-space/LF char
L2432    pshs  y          Save ptr to it on stack
         ldb   #2         ??? Flag to indicate non-variable name
         stb   <u00A5    
         clrb             Set variable name size to 0
         bsr   L2478      Check if it is an alphabetic char or underscore
         bcs   L2459      Nope, skip ahead
         leay  1,y        Yes, point to next char
L243F    incb             Bump up variable name size
         lda   ,y+        Get next char
         bsr   L246A      Check if it is a letter, number or _
         bcc   L243F      Yes, check next one
         cmpa  #'$        Is it a string indicator?
         bne   L2451      No, skip ahead
         incb             Bump up variable name size to include '$'
         lda   #4         ??? Flag to indicate variable name?
         sta   <u00A5    
         bra   L2453      Skip ahead

L2451    leay  -1,y       Bump source ptr back by 1
L2453    lda   #$80       Get high bit (OIM on 6309)
         ora   -1,y       Set high bit on last char of variable name
         sta   -1,y       Save it back
L2459    stb   <u00A6     Save size of variable name
         puls  pc,y       Restore source ptr & return

* Find first non-space / non-LF char, and point Y to it
L245D    lda   ,y+        Get char from source
         cmpa  #C$SPAC    Is it a space?
         beq   L245D      Yes, get next char
         cmpa  #C$LF      Is it a line feed?
         beq   L245D      Yes, get next char
         leay  -1,y       Found legitimate char, point Y to it
         rts             

* Check if char is letter, number or _
L246A    bsr   L2478      Check if next char is letter or _
         bcc   L2493      Yes, exit with carry clear
L246E    cmpa  #'0        Is it a number?
         blo   L2493      No, return with carry set
         cmpa  #'9        Is it a number?
         bls   L2491      Yes, exit with carry clear
         bra   L248E      No, exit with carry set

* Check if char is a letter (or underscore)
* Entry: A=last char gotten (non-space/Lf)
* Exit: Carry clear if A-Z, a-z or '_'
*       Carry set if anything else
L2478    anda  #$7F       Take out any high bit that might exist
         cmpa  #'A        Is it lower than a 'A'
         blo   L2493      Yes, skip ahead (carry set)
         cmpa  #'Z        Is it an uppercase letter?
         bls   L2491      Yes, clear carry & exit
         cmpa  #'_        Is it an underscore?
         beq   L2493      Yes, exit (carry is clear)
         cmpa  #'a        Is it a [,\,],^ or inverted quote ($60)?
         blo   L2493      Yes, skip ahead (carry set)
         cmpa  #'z        Is it a lowercase letter?
         bls   L2491      Yes, exit
L248E    orcc  #$01       Error, non-alpha char
         rts             

L2491    andcc  #$FE       No error, alphabetic char
L2493    rts             

L2494    ldx   <u0062    
         ldd   -3,x      
         addd  #1         INCD
         std   -3,x      
         ldb   <u00A6     Get size of var name/ (or string?)
         clra             D=Size
         addd  #3         Add 3 to size
         sty   <u00A9    
         bsr   L24EE     
         pshs  y         
         lda   <u00A5    
         clrb            
         std   ,y++      
         stb   ,y+       
         ldx   <u00A9    
L24B3    lda   ,x+       
         sta   ,y+       
         bpl   L24B3     
         leay  ,x        
         puls  pc,x      

L24BD    pshs  u,d       
         ldd   <u000C    
         subd  ,s        
         bcc   L24CA     
         lda   #$20      
         lbra  L1DD6     

L24CA    std   <u000C    
         ldd   <u0066    
         subd  ,s        
         std   <u0066    
         ldu   <u00DA    
         ldd   <u00DA    
         subd  ,s        
         std   <u00DA    
         tfr   d,y       
         ldd   <u0066    
         subd  <u00DA    
         addd  <u0068    
         bsr   L2508     
         ldd   <u0068    
         addd  ,s++      
         std   <u0068    
         leax  ,u        
         puls  pc,u      

L24EE    pshs  u,d       
         bsr   L24BD     
         subd  ,s        
         std   <u0068    
         leau  ,x        
         leax  $03,y     
         stx   <u0062    
         ldd   <u0064    
         bsr   L2508     
         addd  ,s++      
         std   <u0064    
         leax  ,u        
         puls  pc,u      

L2508    pshs  x,d       
         leax  d,u       
         pshs  x         
L250E    bitb  #$03      
         beq   L251F     
         lda   ,u+       
         sta   ,y+       
         decb            
         bra   L250E     

L2519    pulu  x,d       
         std   ,y++      
         stx   ,y++      
L251F    cmpu  ,s        
         blo   L2519     
         clr   ,s++      
         puls  pc,x,d    

* Entry point from L23E1
L2528    lda   #%00100000 Bit pattern to test for end of entry
* Entry: X=Table ptr (ex. command table)
*        Y=Source ptr
*        A=Mask to check for end of entry (%10000000)
*        U=??? (just preserved)
* Exit:  X=Ptr to 2 byte # before matching text string
*        Y=Ptr to byte after matching entry in source
*        Zero flag set if no matching entry found
L252A    pshs  u,y,x,a    Save everything on stack
         ldu   -3,x       Get # of entries in table
         ldb   -1,x       Get # bytes to skip to next entry
* Loop to find entry (or until table runs out)
L2530    stx   1,s        Save new table ptr
         cmpu  #$0000     Done all entries?
         beq   L2558      Yes, exit
         leau  -1,u       Bump # entries left down
         ldy   3,s        Get source ptr
         leax  b,x        Point to next entry
L253F    lda   ,x+        Get byte from table
         eora  ,y+        Match byte from source?
         beq   L2551      Yes, skip ahead
         cmpa  ,s         Just high bit set (end of entry marker)?
         beq   L2551      Yes, skip ahead
         leax  -1,x       No, bump table ptr back by 1
L254B    lda   ,x+        Get byte
         bpl   L254B      Keep reading until high bit found (end of entry)
         bra   L2530      Go loop to check this entry

* Found a byte match (with or w/o high bit)
L2551    tst   -1,x       Check the byte
         bpl   L253F      If not at end of entry, keep looking
         sty   3,s        Entry matched, save new source ptr
L2558    puls  pc,u,y,x,a Restore regs & return

L255A    pshs  x,d        Preserve regs
         ldb   [<$04,s]   Get table entry #
         leax  <L256A,pc  Point to vector table
         ldd   b,x        Get vector offset
         leax  d,x        Calculate vector
         stx   4,s        Replace original RTS address with vector
         puls  pc,x,d     Restore regs and go to new routine

* Jump table
L256A    fdb   L2C50-L256A $06e6
         fdb   L30A0-L256A $0b36
         fdb   L2692-L256A $0128
         fdb   L26FD-L256A $0193

* Jump table
L2581    fdb   L2D07-L2581 $0786
         fdb   L277F-L2581 $01fe
         fdb   L2728-L2581 $01a7
         fdb   L2783-L2581 $0202
         fdb   L292A-L2581 $03a9
         fdb   L2C88-L2581 $0707
         fdb   L2D20-L2581 $079f
         fdb   L2D20-L2581 $079f
         fdb   L2D20-L2581 $079f
         fdb   L2C88-L2581 $0707
         fdb   L2D20-L2581 $079f
         fdb   L2D20-L2581 $079f
         fdb   L2D20-L2581 $079f
         fdb   L2954-L2581 $03D3
         fdb   L2952-L2581 $03D1
         fdb   L29A4-L2581 $0423
         fdb   L2A30-L2581 $04AF
         fdb   L2A4B-L2581 $04CA
         fdb   L2A62-L2581 $04E1
         fdb   L2A74-L2581 $04F3
         fdb   L2B0C-L2581 $058B
         fdb   L2B5B-L2581 $05DA
         fdb   L2B69-L2581 $05E8
         fdb   L2B81-L2581 $0600
         fdb   L2B88-L2581 $0607
         fdb   L2B9C-L2581 $061b
         fdb   L2BA0-L2581 $061f
         fdb   L2BA4-L2581 $0623
         fdb   L2BC1-L2581 $0640
         fdb   L29AB-L2581 $042a
         fdb   L2A1A-L2581 $0499
         fdb   L29CC-L2581 $044b
         fdb   L308D-L2581 $0b0c
         fdb   L29CC-L2581 $044b
         fdb   L308D-L2581 $0b0c
         fdb   L2C1F-L2581 $069e
         fdb   L2D07-L2581 $0786
         fdb   L2C65-L2581 $06e4
         fdb   L2C88-L2581 $0707
         fdb   L2D07-L2581 $0786
         fdb   L2D07-L2581 $0786
         fdb   L2CC6-L2581 $0745
         fdb   L2CC6-L2581 $0745
         fdb   L2CE2-L2581 $0761
         fdb   L2C65-L2581 $06e4
         fdb   L2C88-L2581 $0707
         fdb   L2CF0-L2581 $076f
         fdb   L2CF0-L2581 $076f
         fdb   L2CFA-L2581 $0779
         fdb   L2D18-L2581 $0797
         fdb   L2D07-L2581 $0786
         fdb   L2D07-L2581 $0786
         fdb   L2D07-L2581 $0786
         fdb   L2D20-L2581 $079f
         fdb   L2D20-L2581 $079f
         fdb   L26C8-L2581 $0147
         fdb   L26C8-L2581 $0147
         fdb   L2C88-L2581 $0707
         fdb   L265D-L2581 $00dc
         fdb   L308D-L2581 $0b0c
         fdb   L308D-L2581 $0b0c
         fdb   L26C1-L2581 $0140
         fdb   L2718-L2581 $0197
         fdb   L2718-L2581 $0197

* Table (called from L2D2C) - If 0, does something @ L308D, otherwise, AND's
*   with $1F, multiplies by 2, and uses result as offset to branch table @
*   L2DA2
L2601    fcb   $20,$20,$06,$00,$43,$40,$28,$25,$00,$43,$43,$43,$43,$43,$43,$43
         fcb   $05,$00,$43,$43,$43,$00,$45,$00,$25,$00,$45,$00,$05,$00,$21,$21
         fcb   $47,$27,$27,$22,$22,$22,$60,$60,$61,$87,$8a,$89,$89,$81,$85,$00
         fcb   $80,$81,$e0,$e0,$e0,$e0,$e0,$6b,$05,$00,$6c,$6c,$6c,$6d,$00,$00
         fcb   $6d,$00,$00,$6e,$00,$00,$00,$6e,$00,$00,$00,$6d,$00,$00,$6d,$00
         fcb   $00,$0d,$00,$00,$06,00,$06,$00,$06,$00,$44,$44

L265D    ldd   ,y        
         tst   <u00D9    
         bne   L2675     
         pshs  d         
         leay  -1,y      
         ldd   <u0060    
L2669    std   <u00AB    
         ldd   #3        
         lbsr  L2578     
         puls  d         
         bra   L2677     

L2675    leay  2,y       
L2677    lbsr  L29DE     
         bcc   L268E     
         std   ,x        
         tfr   y,d       
         subd  <u005E    
         leax  2,x       
L2684    ldu   ,x        
         std   ,x        
L2688    leax  ,u        
         bne   L2684     
         bra   L2692     

L268E    lda   #$4B       Multiply-defined Line Number error
         bsr   L26CE      Go print (Y-<u005E) to std err in hex
L2692    leax  >L2581,pc  Point to table
         ldb   ,y+        Get byte
         bpl   L269F      If high bit off, go get offset from table
         ldd   #L2952-L2581 Otherwise force to use L2952 offset
         bra   L26A9      Skip ahead

L269F    lslb             Multiply by 2
         clra             16 bit offset required
         ldd   d,x        Get offset
         cmpd  #L2952-L2581 Is it the special case one?
         blo   L26BF      If it or any lower offset, go execute it
L26A9    tst   <u00C7     ??? If ?? set, go execute routine
         bne   L26BF     
         inc   <u00C7     Set flag
         pshs  d          Preserve offset
         tfr   y,d        ??? Move current location to D
         subd  <u005E     Subtract something
         subd  #$0001     Subtract 1 more
         ldu   <u002F     Get 'current' module ptr
         std   $15,u      ??? Save some sort of size into module header?
         puls  d          Get offset back
L26BF    jmp   d,x        Jump to routine

L26C1    ldx   <u002F     Get ptr to current module
         lda   #$01       Flag for Line with Compiler error
         sta   <$17,x     Save in flag header byte
L26C8    ldb   ,y+        Get offset byte
         clra             Make 16 bit
         leay  d,y        Point Y to it & return
         rts             

L308D    ldy   <u0060    
         lda   #$30       Unimplemented Routine error
* ERROR MESSAGE REPORT:
* Prints Hex # address of where error occurs, & error message on screen
* Entry: Y=# to convert to hex after subtracting <u005E
* Exit: Writes out 4 digit hex # & space
L26CE    pshs  y,x,d      Preserve regs
         ldx   <u002F     Get Ptr to current module
         lda   #$01       Set Line with compiler error flag in mod. header
         sta   <$17,x    
         lda   <u0084     Get flag???
         bmi   L26FB      If high bit set, don't print address
         ldd   4,s        Get # to convert (current addr?)
         subd  <u005E     ??? Subtract start?
         leas  -5,s       Make 5 byte buffer
         leax  ,s         Point X to it
         bsr   L26FD      Convert D to 4 digit HEX characters
         lda   #C$SPAC    Add Space
         sta   ,x+       
         lda   #2         Std error path
         leax  ,s         Point to buffer
         ldy   #5         Write out the hex number
         os9   I$Write   
         leas  5,s        Eat temporary buffer
         ldb   ,s         Get error code
         lbsr  L1CC1      Print error message
L26FB    puls  pc,y,x,d   Restore regs & return

* Convert 16 bit number to ASCII Hex equivalent (Addresses in LIST?)
* Result is stored at ,X
L26FD    bsr   L2701      Convert A to hex
         tfr   b,a        Convert B to hex
L2701    pshs  a          Preserve byte
         lsra             Do high nibble first
         lsra            
         lsra            
         lsra            
         bsr   L270D      Convert to ASCII Hex equivalent
         puls  a          Get back original byte
         anda  #$0F       Do low nibble now
L270D    adda  #$30       Make ASCII
         cmpa  #'9        Past legal numeric?
         bls   L2715      Yes, save ASCII version
         adda  #$07       Bump >9 up to A-F for Hex
L2715    sta   ,x+        Save Hex ASCII version & return
         rts             

L2718    ldb   ,y         Get char(?)
         bsr   L2721      Check if it is $3E or $3F > or ?
         bne   L2720      Neither, return
L271E    leay  1,y        Yes, bump Y up & return
L2720    rts             

L2721    cmpb  #$3F      
         beq   L2727     
         cmpb  #$3E      
L2727    rts             

L2728    lbsr  L2F43     
         ldb   <u00CF    
         beq   L2733     
         lda   #$4C       Multiply-defined Variable error
         bsr   L26CE      Go print hex version of (Y-<u005E)
L2733    leay  4,y        Bump ptr up by 4
         lda   #$40      
         sta   <u00CE    
         ldd   <u00C1    
         pshs  d         
         clra            
         clrb            
         std   <u00C1    
         bsr   L2787     
         ldd   <u00CC    
         subd  <u0060    
         beq   L277A     
         addd  #3        
         cmpd  <u000C    
         lbcc  L2A0D     
         pshs  y,x       
         lbsr  L257B     
         ldd   <u00C1    
         leau  ,y        
         std   ,y++      
         clr   ,y+       
         ldx   <u0060     Get address of $F offset in header
L2762    ldd   ,x++       Get value there
         subd  <u0062    
         std   ,y++      
         inc   2,u       
         cmpx  <u00CC    
         blo   L2762     
         tfr   u,d       
         puls  y,x       
         subd  <u0066    
         std   1,x       
         lda   #$25      
         sta   ,x        
L277A    puls  d         
         std   <u00C1    
         rts             

L277F    lda   #$80      
         bra   L2785     

L2783    lda   #$60      
L2785    sta   <u00CE    
L2787    ldd   <u0060    
         pshs  x,d       
         std   <u00CC    
L278D    bsr   L27E0     
         ldb   ,y+       
         cmpb  #$4B      
         beq   L278D     
         cmpb  #$4C      
         beq   L279F     
         leay  -1,y      
         ldb   #$01      
         bra   L27A3     

L279F    lbsr  L283A     
         clrb            
L27A3    pshs  y,b       
         ldx   3,s       
         ldd   <u00CC    
         std   3,s       
         stx   <u00CC    
         subd  <u00CC    
         lslb             D=D*2
         rola            
         addd  3,s       
         cmpd  <u00DA    
         blo   L27CE     
         lbra  L2A0D     

L27BC    ldu   ,x++       Get some sort of var ptr
         tst   ,s        
         beq   L27CB     
         lda   ,u         Get var type
         sta   <u00D1     Save it
         lbsr  L3083      D=size of var in bytes
         std   <u00D6     Save size
L27CB    lbsr  L2878     
L27CE    cmpx  3,s       
         blo   L27BC     
         ldd   <u00CC    
         std   3,s       
         puls  y,b       
         ldb   ,y+       
         cmpb  #$51      
         beq   L278D     
         puls  pc,x,d    

L27E0    lbsr  L2F43     
         ldb   <u00CF    
         beq   L27FF     
         lda   #$4C       Multiply-defined Variable error
         lbsr  L26CE     
         leay  3,y       
         ldb   ,y        
         cmpb  #$4D      
         bne   L27FE     
         leay  1,y       
L27F6    bsr   L282E     
         ldb   ,y+       
         cmpb  #$4B      
         beq   L27F6     
L27FE    rts             

L27FF    ldd   <u00CC    
         addd  #$000A    
         cmpd  <u00DA    
         lbhs  L2A0D     
         ldx   <u00CC    
         ldd   <u00D2    
         std   ,x++      
         leau  ,x        
         clr   ,x+       
         leay  3,y       
         ldb   ,y        
         cmpb  #$4D      
         bne   L282B     
         leay  1,y       
L281F    bsr   L282E     
         std   ,x++      
         inc   ,u        
         ldb   ,y+       
         cmpb  #$4B      
         beq   L281F     
L282B    stx   <u00CC    
         rts             

L282E    ldb   ,y+       
         clra            
         cmpb  #$8D      
         beq   L2837     
         lda   ,y+       
L2837    ldb   ,y+       
         rts             

L283A    lda   ,y+       
         cmpa  #$85      
         beq   L285B     
         suba  #$40      
         sta   <u00D1     Save var type
         cmpa  #4         String type?
         bne   L2856      No, skip ahead
         ldb   ,y        
         cmpb  #$4F      
         bne   L2856     
         leay  1,y       
         bsr   L282E     
         leay  1,y       
         bra   L2875     

L2856    lbsr  L3083      Go get size of var
         bra   L2875      Go save size @ u00D6

L285B    leay  -1,y      
         lbsr  L2F43     
         leay  3,y       
         ldb   <u00CF    
         cmpb  #$20      
         beq   L286D     
         lda   #$18       Illegal Type suffix error
         lbra  L26CE     

L286D    ldd   1,x       
         std   <u00D2    
         ldx   <u0066    
         ldd   d,x        Get size of var
L2875    std   <u00D6     Save size of var & return
         rts             

L2878    ldb   ,x+       
         beq   L28D0     
         pshs  b         
         lslb            
         lslb            
         lslb            
         stb   <u00D0    
         lsrb            
         lsrb            
         leax  b,x       
         addb  #4        
         pshs  u,x       
         lda   <u00D1     Get var type
         cmpa  #4         Numeric type?
         blo   L2893      Yes, skip ahead
         addb  #2         If string or complex, add 2 to type
L2893    clra            
         cmpd  <u000C    
         lbhi  L2A0D     
         lbsr  L257B     
         ldx   ,s        
         leau  2,y       
         ldd   #$0001    
         std   ,u++      
L28A7    ldd   ,--x      
         std   ,u++      
         bsr   L28F7     
         dec   4,s       
         bne   L28A7     
         lda   <u00D1     Get var type
         cmpa  #4         Numeric or string?
         bls   L28BC      Yes, skip ahead
         ldd   <u00D2     No, (complex?)
* NOTE: Since 28BC only referred to here, should be able to change std ,u/coma
*   to bra L28C0 (std ,u)
         std   ,u         Save ???
         coma             Set carry to indicate complex?
L28BC    ldd   <u00D6     Get size of var in bytes
         bcs   L28C2      If complex, don't save sign again
         std   ,u         Save size
L28C2    bsr   L28F7      ??? Do some multiply testing based on size?
         tfr   y,d       
         puls  u,x       
         subd  <u0066    
         std   1,u       
         leas  1,s       
         bra   L28E0     

L28D0    stb   <u00D0    
         lda   <u00D1     Get var type
         cmpa  #4         Normal type (numeric/string)?
         bhi   L28DC      No, skip ahead
         ldd   <u00D6     Get size of var
         bra   L28DE      Skip ahead

L28DC    ldd   <u00D2     Get ??? (something with complex type?)
L28DE    std   1,u        Save size
L28E0    lda   <u00D1     Get var type
         ora   <u00D0     Keep common bits with ???
         ora   <u00CE     Keep common bits with ???
         sta   ,u         Save ???
         pshs  x         
         leax  ,u        
         lbsr  L2FEE     
         ldx   <u00CC    
         stu   ,x++      
         stx   <u00CC    
         puls  pc,x      

* Check if size of array will be too big
L28F7    pshs  d         
         ldb   2,y       
         mul             
         bne   L2923     
         lda   1,s       
         ldb   2,y       
         mul             
         tsta            
         bne   L2923     
         stb   2,y       
         lda   ,s        
         ldb   3,y       
         mul             
         tsta            
         bne   L2923     
         addb  2,y       
         bcs   L2923     
         stb   2,y       
         lda   1,s       
         ldb   3,y       
         mul             
         adda  2,y       
         bcs   L2923     
         std   2,y       
         puls  pc,d      

L2923    lda   #$49       Array Size Overflow error
         lbsr  L26CE     
         puls  pc,d      

L292A    ldu   <u00CA    
         bne   L2936     
         tfr   y,d       
         subd  <u005E    
         std   <u00C8    
         bra   L293C     

L2936    tfr   y,d       
         subd  <u005E    
         std   ,u        
L293C    lbsr  L2D65     
         lbsr  L2E52     
         ldb   ,y+       
         cmpb  #$4B      
         beq   L293C     
         sty   <u00CA    
         ldd   <u00C8    
         std   ,y++      
         lbra  L271E     

L2952    leay  -1,y      
L2954    bsr   L2984     
         leay  1,y       
         lbsr  L2D65     
         lbsr  L2E52     
         sta   <u00D1     Save var type
         lbsr  L2E52     
         cmpa  <u00D1     Same as var type?
         beq   L2981      Yes, skip ahead
         cmpa  #2         Var type from 2E52=Boolean/string/complex?
         bhi   L297E      Yes, skip ahead (print some hex # out)
         beq   L2971      Real #, skip ahead
         lda   #$C8      
         bra   L2973     

L2971    lda   #$CB      
L2973    ldb   <u00D1     Get var type
         cmpb  #2         Boolean/string/complex?
         bhi   L297E      Yes, skip ahead
         lbsr  L2FBE      Byte/Integer/Real, go do something
         bra   L2981     

L297E    lbsr  L2A26     
L2981    lbra  L2718      ??? Do some checking ,y, return from there

L2984    lda   ,y        
         cmpa  #$0E      
         lbne  L2D65     
         leay  1,y       
         lbsr  L2D65     
L2991    lda   -3,y      
         cmpa  #$85      
         bhs   L299F     
         ldd   <u00D2    
         subd  <u0062    
         std   -2,y      
         lda   #$85      
L299F    adda  #$6D      
         sta   -3,y      
         rts             

L29A4    bsr   L29A6     
L29A6    bsr   L2A1A     
         leay  1,y       
         rts             

L29AB    ldb   ,y+       
         cmpb  #$1E      
         beq   L29C5     
         leay  -1,y      
         bsr   L29A6     
         ldd   ,y++      
L29B7    pshs  d         
         leay  1,y       
         bsr   L29CC     
         puls  d         
         subd  #$0001    
         bne   L29B7     
         rts             

L29C5    ldb   ,y+       
         lbsr  L2721     
         beq   L29DD     
L29CC    ldd   ,y        
         bsr   L29DE     
         ldd   2,x       
         bcc   L29D7     
         sty   2,x       
L29D7    std   ,y        
         inc   -1,y      
         leay  3,y       
L29DD    rts             

L29DE    ldx   <u0066    
         pshs  d         
         bra   L29ED     

L29E4    ldd   ,x        
         anda  #$7F      
         cmpd  ,s        
         beq   L2A08     
L29ED    leax  -4,x      
         cmpx  <u00DA    
         bhs   L29E4     
         ldd   <u000C     Get # bytes free in workspace for user
         subd  #4         Subtract 4
         blo   L2A0D      Not enough mem, exit with Memory full error
         std   <u000C     Save new free space
         ldd   ,s        
         ora   #$80      
         std   ,x        
         clra            
         clrb            
         std   2,x       
         stx   <u00DA    
L2A08    lda   ,x        
         rola            
         puls  pc,d      

L2A0D    lda   #32        Memory full error
         sta   <u0036     Save error code
         lbsr  L26CE     
         lbsr  L30EB     
         lbra  L1CC7     

L2A1A    lbsr  L2D65     
         lbsr  L2E52     
         cmpa  #2         Real?
         beq   L2A2B      Yes, skip ahead
         blo   L29DD      Byte/Integer, return
L2A26    lda   #$47       Illegal Expression Type error
         lbra  L26CE     

L2A2B    lda   #$C8      
         lbra  L2FBE     

L2A30    lbsr  L2BAF     
         lda   3,y       
         cmpa  #$3A      
         beq   L2A3E     
         lda   #$10      
         lbra  L2BA8     

L2A3E    pshs  y         
         leay  4,y       
         bsr   L29CC     
         tfr   y,d       
         subd  <u005E    
         std   [,s++]    
         rts             

L2A4B    ldd   #$1002    
         lbsr  L2BDD     
         ldu   1,x       
         sty   1,x       
         leay  2,y       
         lbsr  L2718     
         tfr   y,d       
         subd  <u005E    
         std   ,u        
         rts             

L2A62    ldd   #$1001    
         lbsr  L2BDD     
         leay  1,y       
L2A6A    tfr   y,d       
         subd  <u005E    
         std   [<1,x]    
         lbra  L2C01     

L2A74    lbsr  L2F43     
         lbsr  L2EE3     
         cmpa  #$60      
         bne   L2A88     
         lda   <u00D1     Get var type
         cmpa  #1         Integer?
         beq   L2A94      Yes, skip ahead
         cmpa  #2         Real?
         beq   L2A94      Yes, skip ahead
L2A88    lda   #$46       Illegal FOR variable
         lbsr  L26CE     
         ldd   #$FFFF    
         std   <u00D2    
         bra   L2AA0     

* FOR variable is numeric but NOT byte, continue
L2A94    ldb   <u00D0    
         bne   L2A88     
         adda  #$80       Set hi bit on var type
         sta   ,y         Save it
         ldd   1,x       
         std   1,y       
L2AA0    ldx   <u0044     Get some sort of var ptr
         leax  -7,x       Make room for 7 more bytes
         stx   <u0044     Save new ptr
         lda   <u00D1     Get var type
         sta   ,x         Save it
         ldd   <u00D2    
         subd  <u0062    
         std   1,x       
         clra            
         clrb            
         std   5,x       
         leay  4,y       
         bsr   L2AF1     
         bsr   L2AD4     
         std   3,x       
         lda   ,y        
         cmpa  #$47      
         bne   L2AC6     
         bsr   L2AD4     
         std   5,x       
L2AC6    leay  1,y       
         sty   ,--x      
         lda   #$13      
         sta   ,-x       
         stx   <u0044    
         leay  3,y       
L2AD3    rts             

L2AD4    ldd   <u00C1    
         pshs  d         
         std   1,y       
         ldx   <u0044    
         lda   ,x        
         leax  >L307E,pc  Point to 5 single bytes table
         ldb   a,x        Get value
         clra             D=value
         addd  <u00C1     Add to value & save result
         std   <u00C1    
         leay  3,y       
         bsr   L2AF1     
         ldx   <u0044    
         puls  pc,d      

L2AF1    lbsr  L2D65     
         lbsr  L2E52     
         cmpa  ,u        
         beq   L2AD3     
         cmpa  #$02      
         bcs   L2B07     
         lbne  L2A26     
         lda   #$C8      
         bra   L2B09     

L2B07    lda   #$CB       ??? Illegal mode error?
L2B09    lbra  L2FBE     

L2B0C    leay  -1,y      
         ldd   #$130B    
         lbsr  L2BDD     
         ldd   2,y       
         cmpd  4,x       
         beq   L2B22     
         lda   #$46       Illegal FOR variable error
         lbsr  L26CE     
         bra   L2B51     

L2B22    addd  <u0062    
         exg   d,x       
         ldx   1,x       
         exg   d,x       
         std   2,y       
         lda   3,x       
         anda  #$02      
         sta   1,y       
         ldd   6,x       
         std   4,y       
         ldd   8,x       
         std   6,y       
         beq   L2B3E     
         inc   1,y       
L2B3E    ldu   1,x       
         tfr   y,d       
         subd  <u005E    
         addd  #$0001    
         std   ,u        
         leau  3,u       
         tfr   u,d       
         subd  <u005E    
         std   8,y       
L2B51    leay  $B,y      
         lbsr  L2C01     
         leax  7,x       
         stx   <u0044    
         rts             

L2B5B    leau  -1,y      
         pshs  u         
         bsr   L2BAF     
         puls  d         
         std   ,y        
         lda   #$15      
         bra   L2BA8     

L2B69    ldd   #$1503    
         bsr   L2BDD     
         ldx   1,x       
         ldd   ,x        
         subd  <u005E    
         std   ,y        
         leay  3,y       
         tfr   y,d       
         subd  <u005E    
         std   ,x        
         lbra  L2C01     

L2B81    lda   #$17      
L2B83    lbsr  L271E     
         bra   L2BD3     

L2B88    bsr   L2BAF     
         lda   #$17      
L2B8C    leay  -1,y      
         ldb   #$03      
         bsr   L2BDD     
         ldd   1,x       
         subd  <u005E    
         std   $01,y     
         leay  $04,y     
         bra   L2C01     

L2B9C    lda   #$19      
         bra   L2B83     

L2BA0    lda   #$19      
         bra   L2B8C     

L2BA4    bsr   L2BAF     
         lda   #$1B      
L2BA8    bsr   L2BD3     
         leay  3,y       
         lbra  L2718     

L2BAF    lbsr  L2D65     
         lbsr  L2E52     
         cmpa  #3         ??? Boolean variable?
         beq   L2BBE      Yes, skip ahead
         lda   #$47       Illegal Expression Type error
         lbsr  L26CE     
L2BBE    leay  1,y       
         rts             

L2BC1    ldd   #$1B03    
         bsr   L2BDD     
         leau  ,y        
         leay  3,y       
         lbsr  L2A6A     
         stu   ,--x      
         lda   #$1C      
         bra   L2BD8     

L2BD3    ldx   <u0044    
         sty   ,--x      
L2BD8    sta   ,-x       
         stx   <u0044    
         rts             

L2BDD    pshs  a         
         ldx   <u0044    
         bra   L2BE5     

L2BE3    leax  3,x       
L2BE5    cmpx  <u0046    
         bhs   L2BF3     
         lda   ,x        
         cmpa  #$1C      
         beq   L2BE3     
         cmpa  ,s        
         beq   L2BFF     
L2BF3    leas  3,s       
         lda   #$45       Unmatched Control Structure error
         lbsr  L26CE     
         leay  b,y       
         lbra  L2718     

L2BFF    puls  pc,a      

L2C01    ldx   <u0044    
         bra   L2C14     

L2C05    lda   ,x        
         cmpa  #$1C      
         bne   L2C1A     
         tfr   y,d       
         subd  <u005E    
         std   [<1,x]    
         leax  3,x       
L2C14    cmpx  <u0046    
         blo   L2C05     
         bra   L2C1C     

L2C1A    leax  3,x       
L2C1C    stx   <u0044    
         rts             

L2C1F    leay  -1,y      
         lbsr  L2F43     
         lda   <u00CF    
         beq   L2C41     
         cmpa  #$A0      
         beq   L2C4E     
         cmpa  #$60      
         bcs   L2C3A     
         lda   <u00D0    
         bne   L2C3A     
         lda   <u00D1    
         cmpa  #$04      
         beq   L2C4E     
L2C3A    lda   #$4C       Multiply-defined Variable error
         lbsr  L26CE     
         bra   L2C4E     

L2C41    lda   #$A0      
         sta   ,x        
         ldd   <u00C5    
         std   1,x       
         addd  #$0002    
         std   <u00C5    
L2C4E    leay  3,y       
L2C50    ldb   ,y+       
         cmpb  #$4D      
         bne   L2C64     
L2C56    lbsr  L2984     
         lbsr  L2E52     
         ldb   ,y+       
         cmpb  #$4B      
         beq   L2C56     
         leay  1,y       
L2C64    rts             

L2C65    bsr   L2CB2     
         leay  -1,y      
         cmpb  #$90      
         bne   L2C72     
         lbsr  L2D0B     
         leay  1,y       
L2C72    lbsr  L2984     
         lbsr  L2E52     
         cmpa  #$05      
         bcs   L2C81     
         lda   #$4D       Illegal Input Variable error
         lbsr  L26CE     
L2C81    lda   ,y+       
         cmpa  #$4B      
         beq   L2C72     
         rts             

L2C88    bsr   L2CB2     
         cmpb  #$49      
         bne   L2C92     
         bsr   L2D0B     
L2C90    ldb   ,y+       
L2C92    cmpb  #$4B      
         beq   L2C90     
         cmpb  #$51      
         beq   L2C90     
         lbsr  L2721     
         beq   L2CC5     
         leay  -1,y      
         lbsr  L2D65     
         lbsr  L2E52     
         cmpa  #$05      
         blo   L2C90     
         lda   #$47       Illegal Expression Type error
         lbsr  L26CE     
         bra   L2C90     

L2CB2    ldb   ,y+       
         cmpb  #$54      
         bne   L2CC5     
         lbsr  L2A1A     
L2CBB    ldb   ,y+       
         cmpb  #$4B      
         beq   L2CBB     
         cmpb  #$51      
         beq   L2CBB     
L2CC5    rts             

L2CC6    leay  1,y       
         lbsr  L2984     
         lbsr  L2E52     
         cmpa  #$01      
         beq   L2CD5     
         lbsr  L2A26     
L2CD5    leay  1,y       
         bsr   L2D0B     
         lda   ,y+       
         cmpa  #$4A      
         bne   L2CE1     
         leay  2,y       
L2CE1    rts             

L2CE2    bsr   L2D02     
         bsr   L2D65     
         lbsr  L2E52     
         cmpa  #$42      
         bls   L2D20     
         lbra  L2A26     

L2CF0    bsr   L2D02     
         lbsr  L2984     
         lbsr  L2E52     
L2CF8    bra   L2D20     

L2CFA    bsr   L2D02     
         cmpb  #$4B      
         beq   L2CFA     
         bra   L2D20     

L2D02    leay  1,y       
         lbra  L29A6     

L2D07    bsr   L2D0B     
         bra   L2D20     

L2D0B    bsr   L2D65     
         lbsr  L2E52     
         cmpa  #4        
         beq   L2CE1      Return
         lbra  L2A26      Return from there

L2D18    ldb   ,y+       
         cmpb  #$3A      
         lbeq  L29CC     
L2D20    lbra  L2718     

L2D23    cmpb  #$96      
         bhs   L2D2C     
         lbsr  L2E5F     
         bra   L2D65     

* B>=$96 goes here
L2D2C    cmpb  #$F2       If >=$F2, skip ahead
         lbhs  L308D     
         subb  #$96       Drop B to $00 - $5B
         leax  >L2601,pc  Point to data table
         abx              Point to entry we want
         ldb   ,x         Get it
         lbeq  L308D      If nothing, skip ahead
         andb  #$1F      
         beq   L2D4A     
         leau  <L2DA2,pc  point to routine
         lslb            
         jsr   b,u       
L2D4A    ldb   ,x         Get byte
         andb  #$E0       Mask out all but hi 3 bits
         beq   L2D60      If hi 3 bits all 0's, skip ahead
         clra             Move hi 3 bits to lo 3 bits in A
         rolb             ROLD
         rola            
         rolb             ROLD
         rola            
         rolb             ROLD
         rola            
         cmpa  #$07       All 3 bits set?
         bne   L2D60      No, skip ahead
         lbsr  L2FD4     
         bra   L2D65     

L2D60    lbsr  L2E3B     
         leay  1,y       
L2D65    ldb   ,y        
         bmi   L2D23     
         rts             

L2D6A    bsr   L2D6F     
         incb            
         bra   L2D71     

L2D6F    ldb   #$C8       (200)
L2D71    lbsr  L2E52     
         cmpa  #$02      
         blo   L2D85     
         beq   L2D7E     
         bsr   L2DC3     
         bra   L2D83     

L2D7E    tfr   b,a       
         lbsr  L2FBE     
L2D83    lda   #$01      
L2D85    rts             

L2D86    bsr   L2D8B     
         incb            
         bra   L2D8D     

L2D8B    ldb   #$CB      
L2D8D    lbsr  L2E52     
         cmpa  #$02      
         beq   L2DA1     
         blo   L2D9A     
         bsr   L2DC3     
         bra   L2D9F     

L2D9A    tfr   b,a       
         lbsr  L2FBE     
L2D9F    lda   #$02      
L2DA1    rts             

L2DA2    bra   L2DC0      (offset 0)
L2DA4    bra   L2D6F      (2)
L2DA6    bra   L2D6A      (4)
L2DA8    bra   L2D8B      (6)
L2DAA    bra   L2D86      (8)
L2DAC    bra   L2DDE      ($a)
L2DAE    bra   L2DC8      ($c)
L2DB0    bra   L2DF4      ($e)
L2DB2    bra   L2DF2      ($10)
L2DB4    bra   L2DFF      ($12)
L2DB6    bra   L2E04      ($14)
L2DB8    bra   L2E30      ($16)
L2DBA    bra   L2E2E      ($18)
L2DBC    bra   L2E13      ($1A)
L2DBE    bra   L2E09      ($1C)
L2DC0    lbra  L308D      ($1F)

L2DC3    lda   #$43       Illegal Argument error
         lbra  L26CE     

L2DC8    bsr   L2DE7     
         pshs  a         
         bsr   L2DE7     
         cmpa  ,s+       
         beq   L2DE0     
         lda   #$CB      
         bcc   L2DD7     
         inca            
L2DD7    lbsr  L2FBE     
         lda   #$02      
         bra   L2DE4     

L2DDE    bsr   L2DE7     
L2DE0    cmpa  #$02      
         bne   L2DE6     
L2DE4    inc   ,y        
L2DE6    rts             

L2DE7    bsr   L2E52     
         cmpa  #$02      
         bls   L2DF1     
         bsr   L2DC3     
         lda   #$02      
L2DF1    rts             

L2DF2    bsr   L2DF4     
L2DF4    bsr   L2E52     
         cmpa  #4        
         beq   L2DFE     
         bsr   L2DC3     
         lda   #4        
L2DFE    rts             

L2DFF    lbsr  L2D6F     
         bra   L2DF4     

L2E04    lbsr  L2D6A     
         bra   L2DF4     

L2E09    lda   #3        
         bsr   L2E20     
         bne   L2E13     
         ldb   #3        
         bra   L2E1B     

L2E13    lda   #4        
         bsr   L2E20     
         bne   L2DC8     
         ldb   #2        
L2E1B    addb  ,y        
         stb   ,y        
         rts             

L2E20    ldu   <u0044    
         cmpa  ,u+       
         bne   L2E2D     
         cmpa  ,u+       
         bne   L2E2D     
         stu   <u0044    
         clrb            
L2E2D    rts             

L2E2E    bsr   L2E30     
L2E30    bsr   L2E52     
         cmpa  #3        
         beq   L2E3A     
         bsr   L2DC3     
         lda   #3        
L2E3A    rts             

* Modified since all routines coming here freshly LDA
L2E3B    tsta             A=0?
L2E3C    bne   L2E41      No, skip ahead
         inca             A=1
L2E41    ldu   <u0044    
         cmpa  #5        
         bne   L2E4D     
         ldd   <u00D4    
         std   ,--u      
         lda   #5        
L2E4D    sta   ,-u       
         stu   <u0044    
         rts             

L2E52    ldu   <u0044    
         lda   ,u+       
         cmpa  #5        
         bne   L2E5C     
         leau  2,u       
L2E5C    stu   <u0044    
         rts             

L2E5F    cmpb  #$85      
         lblo  L308D     
         cmpb  #$89      
         blo   L2EAB     
         subb  #$8D      
         lblo  L2F07      $8a to $8c go here
         leau  <L2E75,pc  Point to list of branches
         lslb             2 bytes/per branch
         jmp   b,u        Call branch

L2E75    bra   L2E87     
L2E77    bra   L2E89     
L2E79    bra   L2E8F     
L2E7B    bra   L2E95     
L2E7D    bra   L2E89     
L2E7F    bra   L2E9F     
L2E81    bra   L2EA8     
L2E83    bra   L2E9F     
L2E85    bra   L2EA8     

L2E87    leay  -1,y      
L2E89    leay  3,y       
         lda   #1        
         bra   L2E41     

L2E8F    leay  6,y       
         lda   #2        
         bra   L2E41     

L2E95    ldb   ,y+       
         cmpb  #$FF      
         bne   L2E95     
         lda   #4        
         bra   L2E41     

L2E9F    lbsr  L2991     
         bsr   L2E52     
         lda   #1        
         bsr   L2E41     
L2EA8    leay  1,y       
         rts             

L2EAB    lbsr  L2F43     
         bsr   L2EE3     
         cmpa  #$60      
         beq   L2EBF     
         cmpa  #$80      
         beq   L2EBF     
         lda   #$12       Illegal Operand error
         lbsr  L26CE     
         bra   L2EDC     

L2EBF    ldb   #$85      
         lbsr  L2F5E     
         ldb   ,y        
         cmpb  #$85      
         bne   L2EDC     
         ldb   <u00CF    
         cmpb  #$60      
         bne   L2EDC     
         cmpa  #5        
         bhs   L2EDC     
         adda  #$80      
         sta   ,y        
         ldd   1,x       
         std   1,y       
L2EDC    leay  3,y       
         lda   <u00D1    
         lbra  L2E3C     

L2EE3    lda   <u00CF    
         bne   L2F06     
         ldb   #$60      
         sta   <u00D0    
         stb   <u00CF    
         lda   #$60       Take out, and change following to B's ?
         ora   <u00D1    
         sta   ,x        
         anda  #$07      
         cmpa  #4        
         bne   L2F01     
         ldd   #$0020    
         std   1,x       
L2F01    lbsr  L2FEE     
         lda   <u00CF    
L2F06    rts             

L2F07    bsr   L2F43     
         ldb   #$89      
         bsr   L2F5E     
         lbsr  L2E52     
         cmpa  #5        
         beq   L2F19     
         ldu   #$FFFF    
         bra   L2F1B     

L2F19    ldu   -2,u      
L2F1B    pshs  u         
         bsr   L2EDC     
         puls  u         
         cmpu  #$FFFF    
         beq   L2F3E     
         ldb   2,u       
         stb   <u00D6    
         ldd   <u00D2    
         subd  <u0062    
         leau  3,u       
L2F31    cmpd  ,u++      
         beq   L2F5D     
         dec   <u00D6    
         bne   L2F31     
         lda   #$14      
         bra   L2F40     

L2F3E    lda   #$42       Non-Record Type Operand error
L2F40    lbra  L26CE     

L2F43    ldd   1,y       
         addd  <u0062    
         std   <u00D2    
         ldx   <u00D2    
L2F4B    lda   ,x        
         anda  #$E0      
         sta   <u00CF    
         lda   ,x        
         anda  #$18      
         sta   <u00D0    
         lda   ,x        
         anda  #$07      
         sta   <u00D1    
L2F5D    rts             

L2F5E    pshs  b         
         ldb   ,y        
         subb  ,s+       
         bne   L2F73     
         lda   <u00D0    
         beq   L2F9D     
         ldd   #$FFFF    
         std   <u00D4    
         lda   #5        
         sta   <u00D1    
         rts             

L2F73    lslb             B=B*8
         lslb            
         lslb            
         cmpb  <u00D0    
         beq   L2F7F     
         lda   #$41       Wrong Number of Subscripts error
         lbsr  L26CE     
L2F7F    lda   #$C8      
         sta   <u00D8    
L2F83    lbsr  L2E52     
         cmpa  #2         Byte or Integer?
         blo   L2F97      Yes, skip ahead
         beq   L2F93      If real, skip ahead
         lda   #$47       Illegal Expression Type error
         lbsr  L26CE     
         bra   L2F97     

* Real comes here
L2F93    lda   <u00D8    
         bsr   L2FBE     
* Byte/Integer come here
L2F97    inc   <u00D8    
         subb  #$08      
         bne   L2F83     
L2F9D    lda   <u00D1    
         cmpa  #$05      
         bne   L2FBD     
         ldd   1,x       
         addd  <u0066    
         tfr   d,u       
         ldb   <u00D0    
         beq   L2FB5     
         lsrb             Divide by 4
         lsrb            
         addb  #4        
         ldd   b,u       
         bra   L2FB7     

L2FB5    ldd   2,u       
L2FB7    addd  <u0066    
L2FB9    std   <u00D4    
         lda   <u00D1    
L2FBD    rts             

L2FBE    pshs  x,b       
         ldx   <u000C    
         cmpx  #$0010    
         lbls  L2A0D     
         ldx   <u0060    
         sta   ,x+       
         stx   <u00AB    
         clrb            
         bsr   L2FDA     
         puls  pc,x,b    

L2FD4    ldd   <u0060    
         std   <u00AB    
         ldb   #$01      
L2FDA    clra            
L2578    jsr   <u001B    
         fcb   $14       

* Jump tables (NOTE:SINCE ALL ARE <$80, USE 8 BIT INSTEAD OF 16 BIT OFFSET)
L2FDE    fdb   L3027-L2FDE $0049
         fdb   L303A-L2FDE $005c
         fdb   L303E-L2FDE $0060
         fdb   L3048-L2FDE $006a

L2FE6    fdb   L304C-L2FE6 $0066
         fdb   L3058-L2FE6 $0072
         fdb   L3058-L2FE6 $0072
         fdb   L305C-L2FE6 $0076

L2FEE    pshs  u,y,x     
         leay  <L2FDE,pc  Point to 1st jump table
         ldb   ,x        
         andb  #$E0       Get rid of lowest 5 bits (b1-b5)
         cmpb  #%01100000 bits 6 & 7 set?
         beq   L3005      Yes, skip ahead
         cmpb  #%01000000 Just bit 7 set?
         beq   L3005      Yes, skip ahead
         cmpb  #%10000000 Just bit 8 set?
         bne   L3025      No, skip way ahead
* NOTE: IF TABLE CHANGED TO 8 BIT OFFSET, CHANGE THIS TO LEAY 4,Y
         leay  8,y        If just bit 8 set, use 2nd jump table
L3005    ldb   ,x         Reload the value
         andb  #%00011000 Just keep bits 4-5
         beq   L300F      Neither set, skip ahead
         ldd   6,y        If either set, use 4th entry
         bra   L3023      Go to subroutine

L300F    ldb   ,x         Reload the value
         andb  #%00000111 Just keep bits 1-3
L3013    cmpb  #%00000100 Just bits 1-2?
         blo   L3021      Yes, skip ahead
         bhi   L301D      Bit 3 + at least 1 more bit, skip ahead
         ldd   2,y        If just bit 3, use 2nd entry
         bra   L3023      Go to subroutine

L301D    ldd   4,y        Bit 3 + (1 or 2), use 3rd entry
         bra   L3023      Go to subroutine

L3021    ldd   ,y         Use 1st entry
L3023    jsr   d,y        Call subroutine
L3025    puls  pc,u,y,x   Restore regs & return

L3027    lda   ,x        
         anda  #$07      
         leay  1,x       
         bsr   L3083     
L302F    pshs  d          USE W
         ldd   <u00C1    
         std   ,y        
         addd  ,s++      
         std   <u00C1    
         rts             

L303A    bsr   L3069     
         bra   L302F     

L303E    bsr   L3069     
         addd  <u0066    
         tfr   d,x       
         ldd   ,x        
         bra   L302F     

L3048    bsr   L3060     
         bra   L302F     

L304C    leay  1,x       
L304E    ldd   <u00C3    
         std   ,y        
         addd  #$0004    
         std   <u00C3    
         rts             

L3058    bsr   L3069     
         bra   L304E     

L305C    bsr   L3060     
         bra   L304E     

L3060    ldd   1,x       
         addd  <u0066    
         tfr   d,y       
         ldd   2,y       
         rts             

L3069    ldd   #$0004     Requesting 4 bytes of memory from workspace
         bsr   L257B      Go see if we can get it & allocate it
         ldx   4,s       
         ldd   1,x       
         std   2,y       
         tfr   y,d       
         subd  <u0066    
         std   1,x       
         ldd   2,y       
         rts             

L257B    jsr   <u001E    
         fcb   $08       

* Table of # bytes/var type
L307E    fcb   1          1 byte =Byte
         fcb   2          2 bytes=Integer
         fcb   5          5 bytes=Real
         fcb   1          1 byte =Boolean
         fcb   $20        ??? Flag String value? (or default size=32 bytes)

* Entry: A=Variable type (0-4)
* Exit : B=# bytes to represent variable
L3083    pshs  x          Preserve X
         leax  <L307E,pc  Point to 5 1-byte entry table
         ldb   a,x        D=#
         clra            
         puls  pc,x      

* Single byte entry table
L3095    fcb   $01,$02,$03,$07,$08,$09,$37,$38,$3e,$3f,$ff

L30A0    ldd   #$0016    
         std   <u00C1    
         clrb            
         std   <u00C3    
         std   <u00C5    
         sta   <u00C7    
         std   <u00C8    
         std   <u00CA    
         ldx   <u002F     Get ptr to current module
         sta   <$17,x     Set flags to unpacked, no errors
         std   <$15,x    
L30B8    ldy   <u005E    
         bra   L30E2     

L30BD    pshs  y         
         lbsr  L2692     
         puls  x         
         ldb   <u00D9    
         bne   L30E2     
         lda   ,x        
         leau  <L3095,pc  Point to 11 entry 1 byte table
L30CD    cmpa  ,u+        Hunt through for range our byte is in
         blo   L30E2      If lower then table entry, skip ahead
         bne   L30CD      If not equal, keep looking
         pshs  x          Equal, preserve X
         tfr   y,d        Move ??? to d
         subd  ,s++      
         leay  ,x        
         ldu   <u004A     Get ptr to next free byte in I-code workspace
         stu   <u00AB     Save as ptr to current line I-code end
         lbsr  L2578     
L30E2    ldx   <u0060    
         clr   ,x        
         cmpy  <u0060    
         blo   L30BD     
L30EB    ldx   <u0066    
         bra   L310B     

L30EF    lda   ,x        
         bpl   L310B     
         anda  #$7F      
         sta   ,x        
         ldy   2,x       
L30FA    ldu   ,y        
         ldd   ,x        
         std   ,y        
         dec   -1,y      
         lda   #$4A       Undefined Line Number error
         lbsr  L26CE     
         leay  ,u        
         bne   L30FA     
L310B    leax  -4,x      
         cmpx  <u00DA    
         bhs   L30EF     
         ldd   <u0066    
         subd  <u00DA    
         addd  <u000C     Add to bytes free to user
         std   <u000C     Save as new # bytes free to user
         ldx   <u0044    
         bra   L3131     

L257E    jsr   <u001E    
         fcb   $06       

L311D    ldy   1,x       
         lda   #$45       Unmatched Control Structure error
         lbsr  L26CE     
         lda   ,x        
         cmpa  #$13      
         bne   L312D     
         leax  7,x       
L312D    leax  3,x       
         stx   <u0044    
L3131    cmpx  <u0046    
         blo   L311D     
         ldu   <u0066    
         ldy   <u0060    
         ldd   <u0064    
         addd  <u0068    
         bsr   L257E     
         ldx   <u002F     Get current module ptr
         ldd   <u00C8    
         std   <$13,x    
         ldd   <u00C1    
         std   <$11,x    
         addd  <u00C5    
         std   <u00C5    
         std   $0B,x      Save in data area size require in module header
         ldb   <$18,x     Get size of module name
         clra            
         addd  #$0019     Add 25 to it (size of BASIC09 header?)
         std   M$Exec,x   Save as execution address
         addd  <u0060    
         subd  <u005E    
         std   $0F,x     
         addd  <u0068    
         addd  #$0003    
         std   $0D,x     
         subd  #$0003    
         addd  <u0064    
         std   M$Size,x   Save as new module size
         addd  <u002F     Add to current module ptr
         std   <u004A    
         subd  <u0008    
         std   <u000A    
         ldd   <u002F     Get current module ptr
         addd  $D,x      
         std   <u0062    
         ldd   <u002F     Get current module ptr
         addd  $0F,x     
         std   <u0066    
         ldu   <u0062    
         bra   L31E2     

L3188    leax  ,u        
         lbsr  L2F4B     
         lda   <u00CF    
         cmpa  #$60      
         bcs   L31BD     
         cmpa  #$A0      
         bne   L319F     
         ldd   1,x       
         addd  <u00C1    
         std   1,x       
         bra   L31DC     

L319F    cmpa  #$80      
         bne   L31BD     
         ldb   <u00D0    
         bne   L31B1     
         lda   <u00D1    
         cmpa  #$04      
         bcc   L31B1     
         leax  1,u       
         bra   L31B7     

L31B1    ldd   1,u       
         addd  <u0066    
         tfr   d,x       
L31B7    ldd   ,x        
         addd  <u00C5    
         std   ,x        
L31BD    lda   <u00D1    
         cmpa  #$05      
         bne   L31DC     
         ldb   <u00D0    
         beq   L31CD      If 0, force to 2
         lsrb             Divide by by 4
         lsrb            
         addb  #4        
         bra   L31CF     

L31CD    ldb   #$02      
L31CF    clra            
         addd  1,u       
         ldx   <u0066    
         leay  d,x       
         ldd   ,y        
         ldd   d,x       
         std   ,y        
L31DC    leau  3,u       
L31DE    lda   ,u+       
         bpl   L31DE     
L31E2    cmpu  <u004A    
         blo   L3188     
         rts             

* Called by <$24 JMP vector
* Entry: X=byte after the last vector installed ($2D)
*        D=Last vector offset from start of BASIC09's module header
* Based on function code following the JMP that came here, this routine
*  modifies the return address to 1 of 7 routines
L31E8    pshs  x,d        Preserve ptr & offset
         ldb   [<4,s]     Get function code-style byte
         leax  <L31F8,pc  Point to vector table
         ldd   b,x        Get vector offset
         leax  d,x        Calculate address
         stx   4,s        Modify RTS address
         puls  pc,x,d     Restore X & D and return to new routine

* Vector table for <$24 calls
L31F8    fdb   L3BFF-L31F8 Function 0 call
         fdb   L32DD-L31F8 Function 1 call
         fdb   L3B5F-L31F8 Function 2 call
         fdb   L39FB-L31F8 Function 3 call  (error message)
         fdb   L33AE-L31F8 Function 4 call
         fdb   L3A69-L31F8 Function 5 call
         fdb   L3A73-L31F8 Function 6 call

* Jump table (from L323F+offset)
L323F    fdb   L3A51-L323F
         fdb   L3A51-L323F
         fdb   L3A51-L323F
         fdb   L3A51-L323F
         fdb   L3A51-L323F
         fdb   L35DF-L323F
         fdb   L3209-L323F Go direct to JSR <1B / fcb $C
         fdb   L3A69-L323F
         fdb   L3A73-L323F
         fdb   L35F3-L323F
         fdb   L3A5D-L323F
         fdb   L3A61-L323F
         fdb   L3619-L323F
         fdb   L33AE-L323F
         fdb   L352D-L323F
         fdb   L35D2-L323F
         fdb   L33BC-L323F
         fdb   L33CC-L323F
         fdb   L33D3-L323F
         fdb   L34ED-L323F
         fdb   L33E7-L323F NEXT routine
         fdb   L33D6-L323F
         fdb   L33CC-L323F
         fdb   L33AE-L323F
         fdb   L33D6-L323F
         fdb   L33AE-L323F
         fdb   L33CC-L323F
         fdb   L33D6-L323F
         fdb   L33CC-L323F
         fdb   L3632-L323F
         fdb   L39F7-L323F
         fdb   L3A59-L323F
         fdb   L33CC-L323F
         fdb   L3A59-L323F
         fdb   L35F9-L323F
         fdb   L3A8A-L323F
         fdb   L3BF3-L323F
         fdb   L36EE-L323F
         fdb   L3856-L323F
         fdb   L397D-L323F
         fdb   L398A-L323F
         fdb   L3688-L323F
         fdb   L3691-L323F
         fdb   L36BF-L323F
         fdb   L37CB-L323F
         fdb   L38E2-L323F
         fdb   L3917-L323F
         fdb   L391E-L323F
         fdb   L394A-L323F
         fdb   L3957-L323F
         fdb   L3970-L323F
         fdb   L39A0-L323F
         fdb   L39BC-L323F
         fdb   L3A3D-L323F
         fdb   L3A40-L323F
         fdb   L3A48-L323F
         fdb   L3A48-L323F
         fdb   L3397-L323F
         fdb   L33AC-L323F
         fdb   L33AC-L323F
         fdb   L3A4E-L323F
         fdb   L3A59-L323F
         fdb   L33AB-L323F
         fdb   L33AB-L323F
         fdb   L3551-L323F
         fdb   L3560-L323F
         fdb   L356F-L323F
         fdb   L3551-L323F
         fdb   L3588-L323F
         fdb   L35BB-L323F

L3209    jsr   <u001B    
         fcb   $0c       

L32CB    fcc   'STOP Encountered'
         fcb   C$LF,$FF  

* Vector #2 from table at L31F8 comes here

L32DD    lda   $17,x      Get something
         bita  #$01       check if 1st bit is set
         beq   L32E8      no, skip ahead
         ldb   #$33      
         bra   L3304     

L32E8    tfr   s,d       
         subd  #$0100    
         cmpd  <u0080    
         bhs   L32F6     
         ldb   #$39      
         bra   L3304     

L32F6    ldd   <u000C    
         subd  $0B,x     
         blo   L3302     
         cmpd  #$0100    
         bhs   L3307     
L3302    ldb   #$20       Memory full error
L3304    lbra  L39FB     

L3307    std   <u000C    
         tfr   y,d       
         subd  $0B,x     
         exg   d,u       
         sts   5,u       
         std   7,u       
         stx   3,u       
L3316    ldd   #$0001    
         std   <u0042    
         sta   1,u       
         sta   <$13,u    
         stu   <$14,u    
         bsr   L3351     
         ldd   <$13,x    
         beq   L332C     
         addd  <u005E    
L332C    std   <u0039    
         ldd   $0B,x     
         leay  d,u       
         pshs  y         
         ldd   <$11,x    
         leay  d,u       
         IFNE  H6309
         clrd            
         ELSE            
         clra            
         clrb            
         ENDC            
         bra   L333F     

L333D    std   ,y++      
L333F    cmpy  ,s        
         blo   L333D     
         leas  2,s       
         ldx   <u002F    
         ldd   <u005E    
         addd  <$15,x    
         tfr   d,x       
         bra   L3391     

L3351    stx   <u002F     Save current module ptr
         stu   <u0031    
         ldd   $0D,x     
         addd  <u002F     Add to start address of module
         std   <u0062    
         ldd   $0F,x     
         addd  <u002F     Add to start address of module
         std   <u0066    
         std   <u0060    
         ldd   M$Exec,x   Get exec offset
         addd  <u002F     Add to start of module address
         std   <u005E     Save exec offset
         ldd   <$14,u    
         std   <u0046    
         std   <u0044    
         rts             

L3371    stx   <u005C    
         lda   <u0034     Get signal received flag
         beq   L338F      Nothing happened, skip ahead
         bpl   L3382      No signal flagged, skip ahead
         anda  #$7F       Mask off signal received bit flag
         sta   <u0034     Save masked version
         lbsr  L3233      JSR <1B, fcb $18
         lda   <u0034     Shift out least sig bit
L3382    rora            
         bcc   L338F      Not set, skip ahead
         leay  ,x        
         lbsr  L3218     
         clr   <u0074    
         bsr   L3236     
L338F    bsr   L33AE     
L3391    cmpx  <u0060    
         blo   L3371     
         bra   L33A1     

L3236    jsr   <u001B    
         fcb   $16       

L3397    ldb   ,x        
         lbsr  L384F     
         beq   L33A1     
         lbsr  L3856     
L33A1    lbsr  L3A73     
         ldu   <u0031    
         lds   5,u       
         ldu   7,u       
L33AB    rts             

L33AC    leax  2,x       
L33AE    ldb   ,x+       
         bpl   L33B4      Hi bit clear, skip ahead
         addb  #$40       ??? Wrap it around
L33B4    lslb             Multiply by 2
         clra             Unsigned D
         ldu   <u000E     Get ptr to L323F
         ldd   d,u        Get offset
         jmp   d,u        Jump to that routine

L33BC    jsr   <u0016    
         tst   2,y       
         beq   L33CC     
         leax  3,x       
         ldb   ,x        
         cmpb  #$3B      
         bne   L33AB     
         leax  1,x       
L33CC    ldd   ,x        
         addd  <u005E    
         tfr   d,x       
         rts             

L33D3    leax  1,x       
         rts             

* UNTIL
L33D6    jsr   <u0016    
         tst   2,y       
         beq   L33CC      False, go back
         leax  3,x       
         rts             

* NEXT routine
L33E7    leay  <L33DF,pc  Point to table
L33EA    ldb   ,x+        Get byte
         ldb   b,y        Get jump offset
         ldu   <u0031     Get Base address for variable storage
         jmp   b,y        Jump to appropriate routine

L33F3    ldd   ,x        
         leay  d,u       
         bra   L3410     

L33F9    ldd   ,x        
         leay  d,u       
         ldd   4,x       
         lda   d,u       
         bpl   L3410     
         bra   L3430     

* Integer STEP 1
L3405    ldd   ,x         Get offset to current FOR/NEXT INTEGER value
         leay  d,u        Point Y to it
         ldd   ,y         Get current FOR/NEXT counter
         IFNE  H6309
         incd             Add 1 to it
         ELSE
         addd  #$0001
         ENDC
         std   ,y         Save it back
L3410    ldd   2,x        Get offset to TO variable
         leax  6,x        Eat temp var
         ldd   d,u        Get TO variable
         cmpd  ,y         We hit it yet?
         bge   L33CC      Yes, do X=[,x]+[u005E] & return
         leax  3,x        Eat 3 bytes from X & return
         rts             

* INTEGER STEP <>1
L341E    ldd   ,x         Y=ptr to current FOR/NEXT INTEGER value
         leay  d,u       
         ldd   4,x        Get STEP value
         ldd   d,u        Get current FOR/NEXT counter
         IFNE  H6309
         tfr   a,e        Preserve Hi byte (for sign)
         ELSE
         pshs  a
         ENDC
         addd  ,y         Add increment value
         std   ,y         Save new current value
         IFNE  H6309
         tste             Was STEP negative value?
         ELSE
         tst   ,s+
         ENDC
         bpl   L3410      No, go use normal compare routine
L3430    ldd   2,x        Get offset to TO value
         leax  6,x        Eat temp var
         ldd   d,u        Get TO value
         cmpd  ,y         Hit TO value yet?
         ble   L33CC      Yes, do X=[,x]+[u005E] & return
         leax  3,x        Eat 3 bytes from X & return
         rts             

L343E    ldy   <u0046    
         clrb            
         bsr   L348E     
         bra   L347E     

L3446    ldy   <u0046    
         clrb            
         bsr   L348E     
         ldd   4,x       
         addd  #4        
         ldu   <u0031    
         lda   d,u       
         lsra            
         bcc   L347E     
         bra   L34CC     

* NEXT table
* IF some of these entry points are moved before this table, 8 bit addressing
* may be used instead of 16
L33DF    equ   *
         fcb   L3405-L33DF Integer STEP 1
         fcb   L341E-L33DF Integer STEP <>1
         fcb   L345A-L33DF Real STEP 1
         fcb   L34A5-L33DF Real STEP <>1

* Jump table for FOR (relative to L34E5) (change to 8 bit if possible)
L34E5    equ   *
         fcb   L33F3-L34E5 $ff0e   INT step 1
         fcb   L33F9-L34E5 $ff14   INT step <>1
         fcb   L343E-L34E5 $ff59   REAL step 1
         fcb   L3446-L34E5 $ff61   REAL step <>1

* REAL NEXT STEP 1
L345A    ldy   <u0046     ??? Get subroutine stack ptr
         clrb            
         bsr   L348E     
         leay  -6,y       Make room for REAL variable
         ldd   #$0180     Initialize it to contain 1.
         std   1,y       
         clra            
         clrb            
         std   3,y       
         sta   5,y       
         lbsr  L3FB1      Increment counter (Do REAL add)
         IFNE  H6309
         ldq   1,y        Copy REAL # from 1,y to ,u
         stq   ,u        
         ELSE            
         ldd   1,y        Copy REAL # from 1,y to ,u
         std   ,u        
         ldd   3,y       
         std   2,u       
         ENDC            
         lda   5,y       
         sta   4,u       
* Incrementing REAL STEP value
L347E    ldb   #2        
         bsr   L348E     
         leax  6,x       
         lbsr  L4449      Do REAL # compare
         lble  L33CC      Loop again if still too small
         leax  3,x       
         rts             

L348E    ldd   b,x       
         addd  <u0031     Add to ptr to start of variable storage
         tfr   d,u       
         leay  -6,y       Make room for variable
         lda   #$02       Force it to REAL type
         ldb   ,u         Copy real # from u to y
         std   ,y        
         IFNE  H6309
         ldq   1,u       
         stq   2,y       
         ELSE            
         ldd   1,u       
         std   2,y       
         ldd   3,u       
         std   4,y       
         ENDC            
         rts             

L34A5    ldy   <u0046    
         clrb            
         bsr   L348E     
         stu   <u00D2    
         ldb   #$04      
         bsr   L348E     
         lda   4,u       
         sta   <u00D1    
         lbsr  L3FB1      Inc current FOR/NEXT value by STEP (Do REAL Add)
         ldu   <u00D2    
         IFNE  H6309
         ldq   1,y       
         stq   ,u        
         ELSE            
         ldd   1,y       
         std   ,u        
         ldd   3,y       
         std   2,u       
         ENDC            
         lda   5,y       
         sta   4,u       
         lsr   <u00D1     Check sign
         bcc   L347E      Positive, use that direction check
* Decrementing REAL STEP value
L34CC    ldb   #$02      
         bsr   L348E     
         leax  6,x       
         lbsr  L4449      Do REAL compare
         lbge  L33CC      Still bigger, keep looping
         leax  3,x       
L34DB    rts             

L34DC    ldb   <u0034     Get flag byte
         bitb  #$01       Least sig bit set?
         beq   L34DB      No, return
         jsr   <u001B    
         fcb   $1c       

L34ED    ldb   ,x+       
         cmpb  #$82      
         beq   L3515     
         bsr   L3560     
         bsr   L3508     
         ldb   -1,x      
         cmpb  #$47      
         bne   L34FF     
         bsr   L3508     
L34FF    lbsr  L33CC     
         leay  >L34E5,pc  Point to table
         lbra  L33EA     

L3508    ldd   ,x++      
         addd  <u0031    
         pshs  d         
         jsr   <u0016    
         ldd   1,y       
         std   [,s++]    
         rts             

L3515    bsr   L356F     
         bsr   L3523     
         ldb   -$01,x    
         cmpb  #$47      
         bne   L34FF     
         bsr   L3523     
         bra   L34FF     

L3523    ldd   ,x++      
         addd  <u0031    
         pshs  d         
         jsr   <u0016    
         bra   L3579     

* LET
L352D    jsr   <u0016     Get var type
L352F    cmpa  #4         Numeric or Boolean?
         blo   L3537      Yes, skip ahead
         pshs  u          Preserve U
         ldu   <u003E     ??? Get max var size for string or array
L3537    pshs  u,a        Save Size or Ptr & var type
         leax  1,x       
         jsr   <u0016    
L353D    puls  a         
         lsla             x2 for offset into branch table
         leau  <L3545,pc  Point to branch table
         jmp   a,u        Jump to routine

L3545    bra   L355B      LET - Byte
         bra   L356A      LET - Integer
         bra   L3579      LET - Real
         bra   L355B      LET - Boolean
         bra   L359C      LET - String
         bra   L35C1      Let - Array

L3551    ldd   ,x        
         addd  <u0031    
         pshs  d         
         leax  3,x       
         jsr   <u0016    
* LET - Byte/Boolean
L355B    ldb   2,y        Get byte/boolean value
         stb   [,s++]     Save at address on stack, eat stack & return
         rts             

L3560    ldd   ,x        
         addd  <u0031    
         pshs  d         
         leax  3,x       
         jsr   <u0016    
* LET - Integer
L356A    ldd   1,y        Get integer value
         std   [,s++]     Save at address on stack, eat stack & return
         rts             

L356F    ldd   ,x        
         addd  <u0031    
         pshs  d         
         leax  3,x       
         jsr   <u0016    
* LET - Real
L3579    puls  u         
         ldd   1,y        Copy 5 bytes from Y+1 to U
         std   ,u        
         ldd   3,y       
         std   2,u       
         lda   5,y       
         sta   4,u       
         rts             

L3588    ldd   ,x        
         addd  <u0066    
         tfr   d,u       
         ldd   ,u        
         addd  <u0031    
         pshs  d         
         ldd   2,u       
         pshs  d         
         leax  3,x       
         jsr   <u0016    
* LET - String
L359C    puls  u,d       
         tstb            
         bne   L35A2     
         deca            
L35A2    sta   <u003E    
         ldy   1,y       
         sty   <u0048    
* Block copy up to $FF (string terminator)
L35AA    lda   ,y+       
         sta   ,u+       
         cmpa  #$FF       End of string?
         beq   L35B9      Yes, skip ahead
         decb             Dec string size counter
         bne   L35AA      More left, continue copying
         dec   <u003E    
         bpl   L35AA     
L35B9    clra            
         rts             

* LET - Array
L35C1    puls  u,d       
         cmpd  3,y       
         bls   L35CA     
         ldd   3,y       
L35CA    ldy   1,y       
         exg   y,u       
         jsr   <u001E     Return from routine
         fcb   $06       

L35D2    jsr   <u0016    
         ldd   1,y       
         pshs  d         
         jsr   <u0016    
         ldb   2,y       
         stb   [,s++]    
         rts             

L35DF    lbsr  L3856     
         lda   <u002E    
         sta   <u007F    
         leax  >L32CB,pc  Point to 'STOP encountered'
         lbsr  L375F     
         lbra  L1CC7     

L35F3    lbsr  L3856     
L3233    jsr   <u001B     Use module header jump vector #1
         fcb   $18       

L35F9    ldd   ,x        
         leax  3,x       
L35FD    ldy   <u0031    
         ldu   <$14,y    
         cmpu  <u004A    
         bhi   L360D     
         ldb   #$35       Subroutine stack overflow error
         lbra  L39FB     

L360D    stx   ,--u      
         stu   <$14,y    
         stu   <u0046    
         addd  <u005E    
         tfr   d,x       
         rts             

L3619    ldy   <u0031    
         cmpy  <$14,y    
         bhi   L3627     
         ldb   #$36       Subroutine stack underflow error
         lbra  L39FB     

L3627    ldu   <$14,y    
         ldx   ,u++      
         stu   <$14,y    
         stu   <u0046    
         rts             

L3632    ldd   ,x        
         cmpa  #$1E      
         beq   L366D     
         jsr   <u0016    
         ldd   ,x        
         IFNE  H6309
         lsld            
         lsld            
         ELSE            
         lslb            
         rola            
         lslb            
         rola            
         ENDC            
         addd  #$0002    
         leau  d,x       
         pshs  u         
         ldd   1,y       
         ble   L366B     
         cmpd  ,x++      
         bhi   L366B     
         subd  #$0001    
         IFNE  H6309
         lsld            
         lsld            
         ELSE            
         lslb            
         rola            
         lslb            
         rola            
         ENDC            
         addd  #$0001    
         ldd   d,x       
* 6809 - Change to PSHS B/PULS X,B
         pshs  d         
         ldb   ,x        
         cmpb  #$22      
         puls  x,d       
         beq   L35FD     
         addd  <u005E    
         tfr   d,x       
L366A    rts             

L366B    puls  pc,x      

L366D    ldu   <u0031    
         cmpb  #$20      
         bne   L3682     
         ldd   2,x       
         addd  <u005E    
         std   <$11,u    
         lda   #$01      
         sta   <$13,u    
         leax  5,x       
         rts             

L3682    clr   <$13,u    
         leax  2,x       
         rts             

L3688    bsr   L36A6     
         ldb   #%00001011 Read/Write/Public Read
         os9   I$Create   Create the file
         bra   L3696     

L3691    bsr   L36A6     
         os9   I$Open    
L3696    lbcs  L39FB     
         puls  u,b       
         cmpb  #$01      
         bne   L36A2     
         clr   ,u+       
L36A2    sta   ,u        
         puls  pc,x      

L36A6    leax  1,x       
         lbsr  L3779     
         leax  1,x       
         jsr   <u0016    
         lda   #$03      
         cmpb  #$4A      
         bne   L36B7     
         lda   ,x++      
L36B7    ldu   3,s       
         stx   3,s       
         ldx   1,y       
         jmp   ,u        

L36BF    lbsr  L37B6     
         jsr   <u0016    
         ldb   #$0E      
         lbsr  L3230     
         lbcs  L39FD     
         rts             

* Input prompt?
L36CE    fcc   '? '      
         fcb   $ff       

* Illegal input error message
L36D1    fcc   '** Input error - reenter **'
         fcb   $0d,$ff   

L36EE    lda   <u002E    
         lbsr  L37B6     
         lda   #$2C      
         sta   <u00DD    
         pshs  x         
L36F9    ldx   ,s        
         ldb   ,x        
         cmpb  #$90      
         bne   L3709     
         jsr   <u0016    
         pshs  x         
         ldx   1,y       
         bra   L370E     

L3709    pshs  x         
         leax  <L36CE,pc  Point to '? '
L370E    bsr   L375F     
         puls  x         
         lda   <u007F    
         cmpa  <u002E    
         bne   L371C     
         lda   <u002D    
         sta   <u007F    
L371C    ldb   #$06      
L371E    bsr   L3230     
         bcc   L3730     
         cmpb  #$03      
         lbne  L39FD     
         lbsr  L3A23     
         clr   <u0036     Clear out error code
         bra   L36F9     

L3730    bsr   L3743     
         bcc   L373B     
         leax  <L36D1,pc  Print 'Input error re-enter'
         bsr   L375F     
         bra   L36F9     

L373B    ldb   ,x+       
         cmpb  #$4B      
         beq   L3730     
         puls  pc,d      

L3743    bsr   L3779     
         ldb   ,s        
         addb  #$07      
         ldy   <u0046    
         bsr   L3230     
         lbcc  L353D     
         lda   ,s        
L3755    cmpa  #$04      
         bcs   L375B     
         leas  2,s       
L375B    leas  3,s       
         coma            
         rts             

L375F    pshs  y         
         leas  -6,s      
         leay  ,s        
         stx   1,y       
         ldd   <u0080    
         std   <u0082    
         ldb   #$05      
         bsr   L3230     
         clrb            
         bsr   L3230      call L5084, function 2, sub-function 0 (B)
         leas  6,s       
         puls  pc,y      

L3230    jsr   <u002A     Use module header jump vector #6
         fcb   $02        Function code

L3779    lda   ,x+       
         cmpa  #$0E      
         bne   L3783     
         jsr   <u0016    
         bra   L37A8     

L3783    suba  #$80      
         cmpa  #$04      
         blo   L379E     
         beq   L3790     
         lbsr  L3224     
         bra   L37A8     

L3790    ldd   ,x++      
         addd  <u0066    
         tfr   d,u       
         ldd   2,u       
         std   <u003E    
         ldd   ,u        
         bra   L37A0     

L379E    ldd   ,x++      
L37A0    addd  <u0031    
         tfr   d,u       
         lda   -3,x      
         suba  #$80      
L37A8    puls  y         
         cmpa  #$04      
         blo   L37B2     
         pshs  u         
         ldu   <u003E    
L37B2    pshs  u,a       
         jmp   ,y        

L37B6    ldb   ,x        
         cmpb  #$54      
         bne   L37C8     
         leax  1,x       
         jsr   <u0016    
         cmpb  #$4B      
         beq   L37C6     
         leax  -1,x      
L37C6    lda   2,y       
L37C8    sta   <u007F    
         rts             

L37CB    ldb   ,x        
         cmpb  #$54      
         bne   L37F5     
         bsr   L37B6     
         clr   <u00DD    
         cmpb  #$4B      
         bne   L37DB     
         leax  -1,x      
L37DB    ldb   #$06       Call L5084, function 2, sub-function 6 (B)
         bsr   L3230      (Do ReadLn into temp buff, max of 256 bytes)
         bcc   L37EE      No error in ReadLn, skip ahead
         cmpb  #E$PrcAbt  ??? Process aborted error?
         beq   L37DB      Yes, try to do ReadLn again
L37E6    lbra  L39FD     

L37E9    lbsr  L3743     
         bcs   L37E6     
L37EE    ldb   ,x+       
         cmpb  #$4B      
         beq   L37E9     
         rts             

L37F5    bsr   L384F     
         beq   L3832     
L37F9    bsr   L3802     
         ldb   ,x+       
         cmpb  #$4B      
         beq   L37F9     
         rts             

L3802    lbsr  L3779     
         bsr   L3834     
         lda   ,s        
         bne   L380C     
         inca            
L380C    cmpa  ,y        
         lbeq  L353D     
         cmpa  #$02      
         blo   L381C     
         beq   L3828     
L3818    ldb   #$47       Illegal Expression Type
         bra   L383C     

L381C    lda   ,y         Get var type
         cmpa  #$02       Real #?
         bne   L3818      No, exit with Illegal Expression Type erro
         bsr   L3227      Call FIX (REAL to INT) routine
         lbra  L353D     

L3227    jsr   <u0027    
         fcb   $0c       
L322A    jsr   <u0027    
         fcb   $0e       

L3828    cmpa  ,y        
         bcs   L3818     
         bsr   L322A     
         lbra  L353D     

L3832    leax  1,x       
L3834    pshs  x         
         ldx   <u0039    
         bne   L383F     
         ldb   #$4F       Missing Data Statement error
L383C    lbra  L39FB     

L383F    jsr   <u0016    
         cmpb  #$4B      
         beq   L384B     
         ldd   ,x        
         addd  <u005E    
         tfr   d,x       
L384B    stx   <u0039    
         puls  pc,x      

L384F    cmpb  #$3F      
         beq   L3855     
         cmpb  #$3E      
L3855    rts             

L3856    lda   <u002E    
         lbsr  L37B6     
         ldd   <u0080    
         std   <u0082    
         ldb   ,x+       
         cmpb  #$49      
         beq   L38A3     
L3865    bsr   L384F     
         beq   L388B     
L3869    cmpb  #$4B      
         beq   L387F     
         cmpb  #$51      
         beq   L3883     
         leax  -1,x      
         jsr   <u0016    
         ldb   ,y        
         addb  #$01      
         bsr   L389B     
         ldb   -1,x      
         bra   L3865     

L387F    ldb   #$0D      
         bsr   L389B     
L3883    ldb   ,x+       
         bsr   L384F     
         bne   L3869     
         bra   L388F     

L388B    ldb   #$0C       L5084, function 2, sub-function C
         bsr   L389B      (WritLn a Carriage return)

L388F    clrb             L5084, function 2, sub-function 0
         bsr   L389B      (WritLn the temp buffer)
         lda   <u00DE    
         clr   <u00DE    
         tsta            
         bne   L38A0     
L389A    rts             

L389B    lbsr  L3230      Call <u002A, function 2
         bcc   L389A      If no error, return
L38A0    lbra  L39FD      Error from WritLn, report it

L38A3    jsr   <u0016    
         ldd   <u004A    
         std   <u008E    
         std   <u008C    
         ldu   <u0046    
         pshs  u,d       
         clr   <u0094    
         ldd   <u0048    
         std   <u004A    
L38B5    ldb   -1,x      
         bsr   L384F     
         beq   L38D7     
         ldb   ,x+       
         bsr   L384F     
         beq   L38D2     
         leax  -1,x      
         ldb   #$11      
         lbsr  L3230     
         bcc   L38B5     
         puls  u,d       
         std   <u004A    
         stu   <u0046    
         bra   L38A0     

L38D2    leay  <L388F,pc  Point to routine
         bra   L38DA     

L38D7    leay  <L388B,pc  Point to routine
L38DA    puls  u,d       
         std   <u004A    
         stu   <u0046    
         jmp   ,y        

L38E2    lda   <u002E    
         lbsr  L37B6     
         ldu   <u0080    
         stu   <u0082    
         ldb   ,x+       
         lbsr  L384F     
         beq   L3914     
         cmpb  #$4B      
         beq   L3902     
         leax  -1,x      
         bra   L3902     

L38FA    clra            
         ldb   #$12      
         lbsr  L3230     
         bcs   L38A0     
L3902    jsr   <u0016    
         ldb   ,y        
         addb  #$01      
         lbsr  L3230     
         bcs   L38A0     
         ldb   -$01,x    
         lbsr  L384F     
         bne   L38FA     
L3914    lbra  L388B     

L3917    bsr   L392A     
         os9   I$Read    
         bra   L3923     

L391E    bsr   L392A     
         os9   I$Write   
L3923    leax  ,u        
         bcc   L3949     
L3927    lbra  L39FB     

L392A    lbsr  L37B6     
         lbsr  L3779     
         leau  ,x        
         puls  a         
         cmpa  #$04      
         bhs   L3943     
         leax  >L3B5B,pc  Point to 4 entry, 1 byte table
         ldb   a,x       
         clra            
         tfr   d,y        Y=table entry
         bra   L3945     

L3943    puls  y         
L3945    puls  x         
         lda   <u007F    
L3949    rts             

L394A    lbsr  L37B6     
         os9   I$Close    Close path
         bcs   L3927      Error,
         cmpb  #$4B      
         beq   L394A     
         rts             

L3957    ldb   ,x+       
         cmpb  #';       
         beq   L3967     
         ldu   <u002F     Get ptr to current procedure
         ldd   $13,u     
L3962    addd  <u005E    
         std   <u0039    
         rts             

L3967    ldd   ,x        
         addd  #$0001    
         leax  3,x       
         bra   L3962     

L3970    jsr   <u0016    
         pshs  x         
         ldx   1,y        Get ptr to full pathlist
         os9   I$Delete   Delete file
L3979    bcs   L3927      Error, deal with it
         puls  pc,x       Restore X & return

L397D    jsr   <u0016    
         lda   #READ.     Open directory in Read mode
L3981    pshs  x          Preserve X
         ldx   1,y        Get ptr to full path list
         os9   I$ChgDir   Change directory
         bra   L3979     

L398A    jsr   <u0016    
         lda   #EXEC.     Execution directory
         bra   L3981      Go change execution directory

L3990    lbsr  L3779     
         ldy   <u0046    
         leay  -6,y      
         ldb   <u007F    
         clra            
         std   1,y       
         lbra  L353D     

L39A0    jsr   <u0016    
         ldy   1,y        Get what will be param area ptr
         pshs  u,y,x     
         bsr   L320C     
         puls  u,y,x     
         bsr   L39E0      Set regs for chain to SHELL
         sts   <u00B1     Save stack ptr
         lds   <u0080     Get other stack ptr
         os9   F$Chain    Chain to other program
         lds   <u00B1     Chain obviously didn't work, get old SP back
         bra   L39FB      Process error code

L320C    jsr   <u001B    
         fcb   $0e       

L39BC    jsr   <u0016    
         pshs  u,x       
         ldy   1,y       
         bsr   L39E0      Do stuff & point X to 'shell'
         os9   F$Fork     Fork a shell
         bcs   L39FB      If error, go to error routine
         pshs  a          Save process #
L39CC    os9   F$Wait     Wait until child process is done
         cmpa  ,s         Got wakeup signal, was it our child?
         bne   L39CC      No, keep waiting
         leas  1,s        Yes, eat process # off of stack
         tstb             Error?
         bne   L39FB      Yes, go to error routine
         puls  pc,u,x     No, restore regs & return

L39DA    fcc   'SHELL'   
         fcb   C$CR      

* Entry: Y=Ptr to parameter area
L39E0    ldx   <u0048    
         lda   #C$CR     
         sta   -1,x      
* Should be SUBR y,x / TFR y,u / TFR x,y / LEAX <L39DA,pc / clrd / RTS
         tfr   x,d       
         leax  <L39DA,pc  Point to 'Shell'
         leau  ,y         Point U to parameter area
         pshs  y         
         subd  ,s++      
         tfr   d,y        Move param area size to Y
         clra             Any language/type
         clrb             Data area size to 0 pages
         rts             

L39F7    jsr   <u0016    
         ldb   2,y       
* Error routine from forking a shell?
L39FB    stb   <u0036     Save error code
L39FD    ldu   <u0031    
         beq   L3A1B     
         tst   <$13,u    
         beq   L3A14     
         lds   5,u       
         ldx   <$11,u    
         ldd   <$14,u    
         std   <u0046    
         lbra  L3371     

L3A14    bsr   L3A23     
         bsr   L3A73     
         lbra  L1CC7     

* Entry: B=Error code
L3A1B    lbsr  L1CC1      Print error message
         lbra  L1CC7     

L3A21    fcb   $0E        Display Alpha code (for VDGInt screen)
         fcb   $ff        String terminator

L3A23    leax  <L3A21,pc  Point to force alpha string code
         lbsr  L375F      Go print it out to shut off any VDGInt gfx screen
         ldx   <u005C    
         leay  ,x        
         bsr   L3218     
         clr   <u0074    
         lbsr  L3236     
         ldb   <u0036     Get error code
         lbsr  L1CC1      Print error message
         jsr   <u001B     Call function & return from there
         fcb   $18       

* BASE 0
L3A3D    clrb             Save 0 in <42, incx, return
         bra   L3A42     

* BASE 1
L3A40    ldb   #1         Save 1 in <42, incx, return
L3A42    clra            
         std   <u0042    
         leax  1,x       
         rts             

L3218    jsr   <u001B    
         fcb   $10       

* REM/TRON/TROFF/PAUSE/RTS
* Skip # bytes used up by REM text
L3A48    ldb   ,x+        Get # bytes to skip ahead
         abx              Point X to next instruction
         rts             

L3A4E    exg   x,pc       Jump to routine pointed to by X
         rts              If EXG X,PC done again, return from here

L3A51    leay  ,x        
         bsr   L3218     
         leax  ,y        
         rts             

L3A59    ldb   #$33       Line with compiler error
         bra   L39FB     

L3A5D    lda   #$01      
         bra   L3A62     

L3A61    clra            
L3A62    ldu   <u0031    
         sta   1,u       
         leax  1,x       
         rts             

L3A69    lda   <u0034     Get signal flags
         bita  #$01       LSb set?
         bne   L3A89      Yes, exit
         ora   #$01       force it on
         bra   L3A7B     

L3A73    lda   <u0034     Get signal flags
         bita  #$01       Least sig set?
         beq   L3A89      Yes, return
         anda  #$FE       Clear least sig
L3A7B    sta   <u0034     Save modified copy
         ldd   <u0017     Swap JMP ptrs between L3C32 & L3D41
         pshs  d         
         ldd   <u0019    
         std   <u0017    
         puls  d         
         std   <u0019    
L3A89    rts             

L3212    jsr   <u001B     Verify/Insert module into workspace
         fcb   $00       

* Copy DIM'd array
L3224    jsr   <u0027    
         fcb   $02       

L35BB    bsr   L3224     
         lbra  L352F     

* Entry: U=source ptr of copy (or L3224 generates U - Look up in string pool)
L3A8A    bsr   L3224     
         pshs  x         
         ldb   <u00CF    
         cmpb  #$A0      
         beq   L3AB6     
         ldy   <u0048     Get destination ptr for copy
         ldx   <u003E     Get max size of copy
L3A9A    lda   ,u+        Get byte
         leax  -1,x       Bump counter down
         beq   L3AA8      Finished, skip ahead
         sta   ,y+        Save char
         cmpa  #$FF       String terminator?
         bne   L3A9A      No, keep copying
         lda   ,--y       Yes, get last char before terminator
L3AA8    ora   #$80       Set hi bit on last char
         sta   ,y         Save it out
         ldy   <u0048    
         bsr   L3212     
         bcs   L3AF4     
         leau  ,x        
L3AB6    ldd   ,u        
         bne   L3AC8     
         ldy   <u00D2    
         leay  3,y       
         bsr   L3212     
         bcs   L3AF4     
         ldd   ,x        
         std   ,u        
L3AC8    ldx   ,s        
         std   ,s        
         ldu   <u0031    
         lda   <u0034     Get flags
         sta   ,u         Save them
         ldb   <u0043    
         stb   2,u       
         ldd   <u004A     Get ptr to 1st free byte in I-code workspace
         std   $D,u       Save it
         ldd   <u0040     Get ptr to end of parm packets being passed
         std   $F,u      
         ldd   <u0039    
         std   9,u       
         bsr   L3B5F     
         stx   $B,u      
         puls  x          Get ptr to module to be called
         lda   M$Type,x   Get module type/language
         beq   L3B23      If 0 (un-packed BASIC09), skip ahead
         cmpa  #$22       Is it a packed RUNB subroutine module?
         beq   L3B23      Yes, skip ahead
         cmpa  #$21       Is it an ML subroutine module?
         beq   L3AF9      Yes, skip ahead
L3AF4    ldb   #$2B       If none of the above, Unknown Procedure Error
L3AF6    lbra  L39FB     

* ML subroutine call goes here
* Entry: X=Ptr to ML subroutine module to be called
L3AF9    ldd   5,u       
         pshs  d         
         sts   5,u        Save old stack ptr
         leas  ,y         Point stack to all the ptr/size packets for parms
         ldd   <u0040     Get ptr to end of parm packets @ Y
* 6309: Change PSHS/SUBD to SUBR Y,D
         IFNE  H6309
         subr  y,d        Calc size of all parm packets being sent
         lsrd             /4 to get # of parms being sent
         lsrd            
         ELSE            
         pshs  y          Put start of parms packets ptr on stack
         subd  ,s++       Calculate size of all parm packets being sent
         lsra             Divide by 4 (to get # parms being sent)
         rorb            
         lsra            
         rorb            
         ENDC            
         pshs  d          Preserve # parms waiting on stack
         ldd   M$Exec,x   Get execution offset
* USELESS-ROUTINE CHECKS FOR LINE WITH COMPILER ERROR & POSSIBLE STACK OVERFLOW
* BUT IT NEVER GETS CALLED - UNLESS MEANT FOR SUBROUTINE MODULE
* MAYBE IT SHOULD CALL ROUTINE, MAY BE PROBLEM WITH SOME CRASHES (LIKE EMULATE)
         leay  >L32DD,pc  Point to routine
         jsr   d,x        Call ML subroutine module
         ldu   <u0031     Get ptr to U block of data from above
         lds   5,u        Get old stack ptr back
         puls  x          Get original 5,u value
         stx   5,u        Save it back
         bcc   L3B3C      If no error, resume program
         bra   L3AF6      Notify user of error from ML subroutine

* BASIC09 or RUNB module subroutine call goes here
L3B23    lbsr  L3A73      If line with compiler err flg set, swap 17/19 vectors
         lda   <u0034     Get flags
         anda  #$7F       Mask out pending signal flag
         sta   <u0034     Save flags back
         lbsr  L32DD      Go check for line with compiler error/stack ovrflw
         lda   ,u        
         bita  #$01      
         beq   L3B3C     
         lbsr  L3A69     
         lda   ,u        
         sta   <u0034    
L3B3C    ldd   $D,u      
         std   <u004A    
         ldd   $F,u      
         std   <u0040     Save end of parm packets ptr
         ldd   9,u       
         std   <u0039    
         ldb   2,u       
         sex             
         std   <u0042    
         ldx   $3,u      
         lbsr  L3351     
         ldx   $B,u      
         ldd   <u0044    
         subd  <u004A     Subtract ptr to next free byte in workspace
         std   <u000C     Save # bytes free for user
         rts             

* Table of size of variables
L3B5B    fcb   1          Byte    (type 0)
         fcb   2          Integer (type 1)
         fcb   5          Real    (type 2)
         fcb   1          Boolean (type 3)

* Vector from $31E8
* Entry: U=
*        X=
L3B5F    pshs  u         
         ldb   ,x+       
         clra             Set flag on stack to 0
         pshs  x,a       
         cmpb  #$4D      
         bne   L3BE1     
         leay  ,s         Point Y to flag byte on stack
L3B6C    pshs  y          Save ptr to flag byte
         ldb   ,x        
         cmpb  #$0E      
         beq   L3BA3     
         jsr   <u0016    
         leax  -1,x      
         cmpa  #2         Real variable?
         beq   L3B86      Yes, skip ahead
         cmpa  #4         String/complex type variable?
         beq   L3B93      Yes, set up string stuff
         ldd   1,y        Byte/Integer/Boolean - Get value from var packet
         std   4,y        Duplicate it later in var packet
         lda   ,y         Get variable type again
L3B86    ldb   #6         Get size of var packet
         leau  <L3B5B,pc  Point to var size table
         subb  a,u        Calculate ptr to beginning of actual var value
         leau  b,y        Bump U to point to first byte of actual var value
         stu   <u0046     ??? Save some sort of variable ptr?
         bra   L3BA7     

* String being passed?
L3B93    ldu   1,y        Get ptr to actual string data
         ldd   <u0048    
         subd  <u004A     Subtract ptr to next free byte in workspace
         std   <u003E     Save result as ptr to string/complex
         ldd   <u0048    
         std   <u004A     Save new ptr to next free byte in workspace
         lda   #4         Variable type=String/complex
         bra   L3BA7     

L3BA3    leax  1,x       
         jsr   <u0016    
L3BA7    puls  y          Get ptr to flag byte
         inc   ,y         Bump up flag
         cmpa  #4         Variable type numeric?
         blo   L3BB3      Yes, skip ahead
         pshs  u          String/complex, save var data ptr
         ldu   <u003E     Get some ptr
L3BB3    pshs  u,a        Save variable ptr, variable type
         ldb   ,x+       
         cmpb  #$4B      
         beq   L3B6C     
         leax  1,x       
         stx   1,y       
         leax  <L3B5B,pc  Point to 4 entry, 1 byte table
         ldu   <u0046    
         stu   <u0040     Save ptr to end of parm packets
L3BC6    puls  b          Get variable type
         cmpb  #4         Is it a numeric type?
         blo   L3BD0      Yes, go process
         puls  d          No, get variable ptr again
         bra   L3BD3      Go handle string/complex

L3BD0    ldb   b,x        Get size of variable
         clra             D=size
L3BD3    std   ,--u       Save size of variable into parm area
         puls  d          Get ptr to variable
         std   ,--u       Save ptr to variable
         dec   ,y         Any vars left to pass?
         bne   L3BC6      ??? Yes, continue building parm area
         leay  ,u         ??? No, point Y to parm area
         bra   L3BE7     

L3BE1    ldy   <u0046    
         sty   <u0040    
L3BE7    tfr   y,d       
         subd  <u004A    
         lblo  L3302     
         std   <u000C    
         puls  pc,u,x,a  

L3BF3    jsr   <u0016    
         ldy   1,y       
         pshs  x         
         bsr   L3215     
         puls  pc,x      

L3215    jsr   <u001B    
         fcb   $0a       

L3BFF    bsr   L322D     
         leax  >L323F,pc  Point to huge jump table
         stx   <u000E     Save as address somewhere
         rts             

L322D    jsr   <u0027     Use module header jump vector #5
         fcb   $00        Function code

L3C09    pshs  x,d        Preserve regs
         ldb   [<4,s]     Get function code
         leax  <L3C19,pc  Point to function code jump table
         ldd   b,x        Get offset
         leax  d,x        Point X to subroutine
         stx   4,s        Save overtop original PC
         puls  pc,x,d     Restore regs & jump to function code routine

L3C19    fdb   L5050-L3C19 0
         fdb   L3D80-L3C19 2 Copy DIM'd arrary to temp var pool
         fdb   L3FB1-L3C19 4 Real # add
         fdb   L40D3-L3C19 6 Real # multiply
         fdb   L4234-L3C19 8 Real # divide
         fdb   L4449-L3C19 A Set flags for Real comparison
         fdb   L453B-L3C19 C FIX (Round & convert REAL to INTEGER)
         fdb   L4503-L3C19 E FLOAT (Convert INTEGER/BYTE to REAL)

* Function routines
* Negative offsets from base of table @ L3CB5
         fdb   L4F1E-L3CB5 MID$
         fdb   L4EE2-L3CB5 LEFT$
         fdb   L4EFA-L3CB5 RIGHT$
         fdb   L4EC7-L3CB5 CHR$
         fdb   L4FA4-L3CB5 STR$ (for INTEGER)
         fdb   L4FA8-L3CB5 STR$ (for REAL)
         fdb   L4FF8-L3CB5 DATE$
         fdb   L4FCC-L3CB5 TAB
         fdb   L453B-L3CB5 FIX (round & convert REAL to INTEGER)
         fdb   L45A0-L3CB5 ??? (calls fix but eats 1 var 1st)
         fdb   L45A7-L3CB5 ??? (calls fix but eats 2 vars 1st)
         fdb   L4503-L3CB5 FLOAT (convert INTEGER to REAL)
         fdb   L4534-L3CB5 ??? (calls float though)
         fdb   L4395-L3CB5 Byte - LNOT
         fdb   L3EA8-L3CB5 Integer - Negate a number
         fdb   L3FA4-L3CB5 Real - Negate a number
         fdb   L4380-L3CB5 Byte - LAND
         fdb   L4386-L3CB5 Byte - LOR
         fdb   L438C-L3CB5 Byte - LXOR
         fdb   L43FF-L3CB5 > : Integer/Byte relational
         fdb   L4443-L3CB5 > : Real relational
         fdb   L43D1-L3CB5 > : String relational
         fdb   L43D7-L3CB5 < : Integer/Byte relational
         fdb   L4425-L3CB5 < : Real relational
         fdb   L43B3-L3CB5 < : String relational
         fdb   L43E7-L3CB5 <> or >< : Integer/Byte relational
         fdb   L4431-L3CB5 <> or >< : Real relational
         fdb   L43C5-L3CB5 <> or >< : String relational
         fdb   L441D-L3CB5 <> or >< : Boolean relational
         fdb   L43EF-L3CB5 = : Integer/Byte relational
         fdb   L4437-L3CB5 = : Real relational
         fdb   L43BF-L3CB5 = : String relational
         fdb   L4415-L3CB5 = : Boolean relational
         fdb   L43F7-L3CB5 >= or => : Integer/Byte relational
         fdb   L443D-L3CB5 >= or => : Real relational
         fdb   L43CB-L3CB5 >= or => : String Relational
         fdb   L43DF-L3CB5 <= or =< : Integer/Byte relational
         fdb   L442B-L3CB5 <= or =< : Real relational
         fdb   L43B9-L3CB5 <= or =< : String Relational
         fdb   L3EAF-L3CB5 Integer - Add
         fdb   L3FB1-L3CB5 Real - Add
         fdb   L44E5-L3CB5 String add
         fdb   L3EB8-L3CB5 Integer - Subtract
         fdb   L3FAB-L3CB5 Real - Subtract
         fdb   L3EC1-L3CB5 Integer - Multiply
         fdb   L40CC-L3CB5 Real Multiply
         fdb   L3F1C-L3CB5 Integer - Divide
         fdb   L422D-L3CB5 Real Divide
         fdb   L4336-L3CB5 Real Exponent\ Probably for both ^ & **
         fdb   L4336-L3CB5 Real Exponent/ Hard coding for 0^x & x^1
         fdb   L3D6C-L3CB5 DIM
         fdb   L3D6C-L3CB5 DIM
         fdb   L3D6C-L3CB5 DIM
         fdb   L3D6C-L3CB5 DIM
         fdb   L3D72-L3CB5 PARAM
         fdb   L3D72-L3CB5 PARAM
         fdb   L3D72-L3CB5 PARAM
         fdb   L3D72-L3CB5 PARAM
         fdb   $0000      Unused function entries (maybe use for LONGINT?)
         fdb   $0000     
         fdb   $0000     
         fdb   $0000     
         fdb   $0000     
         fdb   $0000     

* Jump table (base is L3CB5)
L3CB5    fdb   L3E81-L3CB5 Copy BYTE var to temp pool
         fdb   L3E97-L3CB5 Copy INTEGER var to temp pool
         fdb   L3F8D-L3CB5 Copy REAL var to temp pool
         fdb   L436E-L3CB5 Copy BOOLEAN var to temp pool
         fdb   L44C7-L3CB5 Copy STRING var to temp pool (max 256 chars)
         fdb   L3D59-L3CB5 Copy DIM array
         fdb   L3D59-L3CB5 Copy DIM array
         fdb   L3D59-L3CB5 Copy DIM array
         fdb   L3D59-L3CB5 Copy DIM array
         fdb   L3D68-L3CB5 Copy PARAM array  
         fdb   L3D68-L3CB5 Copy PARAM array
         fdb   L3D68-L3CB5 Copy PARAM array
         fdb   L3D68-L3CB5 Copy PARAM array
         fdb   L3E7D-L3CB5 Copy BYTE constant to temp pool - CHECK IF USED
         fdb   L3E93-L3CB5 Copy INTEGER constant to temp pool
         fdb   L3F7C-L3CB5 Copy REAL constant to temp pool
         fdb   L4497-L3CB5 Copy STRING constant to temp pool
         fdb   L3E93-L3CB5 Copy INTEGER constant to temp pool
         fdb   L473F-L3CB5 ADDR
         fdb   L473F-L3CB5 ADDR
         fdb   L4751-L3CB5 SIZE
         fdb   L4751-L3CB5 SIZE
         fdb   L45F1-L3CB5 POS
         fdb   L45E3-L3CB5 ERR
         fdb   L46A2-L3CB5 MOD for Integer #'s
         fdb   L46AA-L3CB5 MOD for Real #'s
         fdb   L4DDA-L3CB5 RND
         fdb   L4B03-L3CB5 PI
         fdb   L4F77-L3CB5 SUBSTR
         fdb   L45D5-L3CB5 SGN for Integer
         fdb   L45C7-L3CB5 SGN for Real
         fdb   L4A82-L3CB5 Transcendental ???
         fdb   L4AAF-L3CB5 Transcendental ???
         fdb   L4ABD-L3CB5 Transcendental ???
         fdb   L4927-L3CB5 Transcendental ???
         fdb   L4968-L3CB5 Transcendental ???
         fdb   L4A03-L3CB5 Transcendental ???
         fdb   L4864-L3CB5 EXP
         fdb   L45B5-L3CB5 ABS for Integer #'s
         fdb   L45AE-L3CB5 ABS for Real #'s
         fdb   L47AB-L3CB5 LOG
         fdb   L479F-L3CB5 LOG10
         fdb   L45F5-L3CB5 SQR \ Square root
         fdb   L45F5-L3CB5 SQRT/
         fdb   L4503-L3CB5 FLOAT
         fdb   L46C6-L3CB5 INT (of real #)
         fdb   L45F0-L3CB5 ??? RTS
         fdb   L453B-L3CB5 FIX
         fdb   L4503-L3CB5 FLOAT
         fdb   L45F0-L3CB5 ??? RTS
         fdb   L4705-L3CB5 SQuare of integer
         fdb   L470E-L3CB5 SQuare of real
         fdb   L45C0-L3CB5 PEEK
         fdb   L477A-L3CB5 LNOT of Integer
         fdb   L471F-L3CB5 VAL  
         fdb   L4EAB-L3CB5 LEN
         fdb   L4EBD-L3CB5 ASC
         fdb   L477F-L3CB5 LAND of Integer
         fdb   L478F-L3CB5 LOR of Integer
         fdb   L4787-L3CB5 LXOR of Integer
         fdb   L4769-L3CB5 Force Boolean to TRUE
         fdb   L476E-L3CB5 Force Boolean to FALSE
         fdb   L5035-L3CB5 EOF
         fdb   L4F5F-L3CB5 TRIM$

* Jump table, base is L3D35
L3D35    fdb   L3E87-L3D35 Convert Byte to Int (into temp var)
         fdb   L3E9D-L3D35 Copy Int var into temp var
         fdb   L3F93-L3D35 Copy Real var into temp var
         fdb   L4374-L3D35 ??? Copy Boolean into temp var
         fdb   L44D7-L3D35 ??? Copy string to expression stack
         fdb   L44F6-L3D35 ??? Copy D&U regs into temp var type 5

L3D41    ldy   <u0046    
         ldd   <u004A    
         std   <u0048    
         bra   L3D51     

L3D4A    lslb             2 bytes per entry
         ldu   <u0010     Get ptr to jump table (could be L3CB5)
         ldd   b,u        Get offset
         jsr   d,u        Call subroutine
L3D51    ldb   ,x+        Get next byte
         bmi   L3D4A      If high bit set, need to call another subroutine
         clra             Otherwise, clear carry
         lda   ,y        
         rts             

* Copy DIM array to temp var pool
L3D59    bsr   L3D80     

* POSSIBLE MAIN ENTRY POINT FOR MATH & STRING ROUTINES
L3D5B    pshs  pc,u       Save U & PC on stack
         ldu   <u0012     Get ptr to jump table (L3D35)
         lsla             A=A*2 for 2 byte entries (note: 8 bit SIGNED)
         ldd   a,u        Get offset
         leau  d,u        Point to routine
         stu   2,s        Save over PC on stack
         puls  pc,u       Restore U & jump to routine

* Copy PARAM array to temp var pool
L3D68    bsr   L3D78     
         bra   L3D5B     

L3D6C    leas  2,s       
         lda   #$F2      
         bra   L3D82     

L3D72    leas  $02,s     
         lda   #$F6      
         bra   L3D7A     

L3D78    lda   #$89      
L3D7A    sta   <u00A3    
         clr   <u003B    
         bra   L3D86     

L3D80    lda   #$85      
L3D82    sta   <u00A3    
         sta   <u003B    
L3D86    ldd   ,x++      
         addd  <u0062    
         std   <u00D2    
         ldu   <u00D2    
         lda   ,u        
         anda  #$E0      
         sta   <u00CF    
         eora  #$80      
         sta   <u00CE    
         lda   ,u        
         anda  #$07      
         ldb   -$03,x    
         subb  <u00A3    
         pshs  d         
         lda   ,u        
         anda  #$18      
         lbeq  L3E3F     
         ldd   1,u       
         addd  <u0066    
         tfr   d,u       
         ldd   ,u        
         std   <u003C    
         lda   1,s       
         bne   L3DC4     
         lda   #$05      
         sta   ,s        
         ldd   2,u       
         std   <u003E    
         clra            
         clrb            
         bra   L3E17     

L3DC4    leay  -6,y       Make room for temp var
         clra             Force value to 0 (integer)
         clrb            
         std   1,y        Save it
         leau  4,u        Bump U up
         bra   L3DD5     

L3DCE    ldd   ,u         Get value from U
         std   1,y        Save in var space
         lbsr  L3EC1      Call Integer Multiply routine
L3DD5    ldd   7,y       
         subd  <u0042    
         cmpd  ,u++      
         blo   L3DE3     
         ldb   #$37       Subscript out of range error
         jsr   <u0024     Report it
         fcb   $06       

* Array subscript in range, process
L3DE3    addd  1,y       
         std   7,y       
         dec   1,s       
         bne   L3DCE     
* NOTE: IF FOLLOWING COMMENTS ARE ACCURATE, SHOULD USE LDA, DECA TRICK
         lda   ,s         ??? Get variable type?
         beq   L3DFF      If Byte, skip ahead
         cmpa  #$02       Real?
         blo   L3E03      No, integer, skip ahead
         beq   L3E0B      Real, skip ahead
         cmpa  #$04       String?
         blo   L3DFF      No, boolean - treat same as Byte
         ldd   ,u         String - do this
         std   <u003E    
         bra   L3E0E     

* BYTE or BOOLEAN
L3DFF    ldd   7,y        Get offset to entry in array we want
         bra   L3E07     

* INTEGER
L3E03    ldd   7,y        Get offset to entry in array we want
         lslb             x2 since Integers are 2 bytes/entry
         rola            
L3E07    leay  $C,y      
         bra   L3E17     

* REAL
L3E0B    ldd   #5         x5 since Real's are 5 bytes/entry
L3E0E    std   1,y        Save for Integer multiply routine
         lbsr  L3EC1      Go do Integer multiply
         ldd   1,y        Get offset to entry we want
         leay  6,y        Eat temp var.
L3E17    tst   <u00CE    
         bne   L3E33     
         pshs  d         
         ldd   <u003C    
         addd  <u0031    
         cmpd  <u0040    
         bhs   L3E78     
         tfr   d,u       
         puls  d         
         cmpd  2,u       
         bhi   L3E78     
         addd  ,u        
         bra   L3E73     

L3E33    addd  <u003C    
         tst   <u003B    
         bne   L3E71     
L3E39    addd  1,y       
         leay  6,y        Eat temp var.
         bra   L3E73     

L3E3F    lda   ,s         ??? Get var type
         cmpa  #$04       Set CC - Is it string type?
         ldd   1,u       
         blo   L3E51      No, either numeric or boolean, skip ahead
* String or complex
         addd  <u0066    
         tfr   d,u       
         ldd   2,u       
         std   <u003E    
         ldd   ,u        
L3E51    tst   <u003B    
         beq   L3E39     
         addd  <u0031    
         tfr   d,u       
         tst   <u00CE    
         bne   L3E75     
         cmpd  <u0040    
         bhs   L3E78     
         ldd   <u003E    
         cmpd  2,u       
         blo   L3E6D     
         ldd   2,u       
         std   <u003E    
L3E6D    ldu   ,u        
         bra   L3E75     

L3E71    addd  <u0031    
L3E73    tfr   d,u       
L3E75    clra            
         puls  pc,d      

L3E78    ldb   #$38       Parameter error
         jsr   <u0024    
         fcb   $06       

* Copy Byte constant to temp pool
L3E7D    leau  ,x+       
         bra   L3E87     

* Copy Byte variable to temp pool
L3E81    ldd   ,x++       Get offset to variable we want
         addd  <u0031     Add to start of string pool address
         tfr   d,u        Move to indexable register
L3E87    ldb   ,u         Get BYTE value
         clra             Force to integer type
         leay  -6,y       Make room for new variable
         std   1,y        Save integer value
         lda   #1         Save type as integer & return
         sta   ,y        
         rts             

* Copy Integer constant to temp pool
L3E93    leau  ,x++      
         bra   L3E9D     

* Copy integer var into temp var
L3E97    ldd   ,x++       Get offset to var we want
         addd  <u0031     Add to start of variable pool
         tfr   d,u        Point U to entry
L3E9D    ldd   ,u         Get Integer
         leay  -6,y       Make room for variable
         std   1,y        Save integer
         lda   #1         Integer Type
         sta   ,y         Save it & return
         rts             

* INTEGER NEGATE (- IN FRONT OF NUMBER)
         IFNE  H6309
L3EA8    clrd             Number=0-Number (negate it)
         ELSE            
L3EA8    clra            
         clrb            
         ENDC            
         subd  1,y       
         std   1,y        Save & return
         rts             

* INTEGER ADD
L3EAF    ldd   7,y        Get integer
         addd  1,y        Add to temp copy of 2nd #
         leay  6,y        Eat temp
         std   1,y        Save added result & return
         rts             

* INTEGER SUBTRACT
L3EB8    ldd   7,y        Get integer
         subd  1,y        Subtract 2nd #
         leay  6,y        Eat temp copy
         std   1,y        Save result & return
         rts             

* INTEGER MULTIPLY
         IFNE  H6309
L3EC1    ldd   1,y        Get temp var integer
         muld  7,y        Multiply by answer integer
         stw   7,y        Save 16 bit wrapped result
         leay  6,y        Eat temp var
         rts             
         ELSE            
L3EC1    ldd   7,y        Get value that result will go into
         beq   L3EFA      *0, leave result as 0
         cmpd  #2         Special case: times 2?
         bne   L3ECF      No, check other number
         ldd   1,y        Get 2nd number
         bra   L3EDB      Do quick x2

L3ECF    ldd   1,y        Get 2nd number
         beq   L3EDD      *0, go save result as 0
         cmpd  #2         Special case: times 2?
         bne   L3EE1      No, go do regular multiply
         ldd   7,y        Get 1st number
L3EDB    lslb            
         rola            
L3EDD    std   7,y        Save answer
         bra   L3EFA      Eat temp var & return

L3EE1    lda   8,y        Do 16x16 bit signed multiply, MOD 65536
         mul             
         sta   3,y       
         lda   8,y       
         stb   8,y       
         ldb   1,y       
         mul             
         addb  3,y       
         lda   7,y       
         stb   7,y       
         ldb   2,y       
         mul             
         addb  7,y       
         stb   7,y       
L3EFA    leay  6,y        Eat temp var & return
         rts             
         ENDC            
* Integer MOD routine
L46A2    bsr   L3F1C      Go do integer divide
         ldd   3,y        Get "hidden" remainder
         std   1,y        Save as answer & return
         rts             

         IFNE  H6309
L3F1C    ldd   1,y        Get # to divide by
         bne   GoodDiv    <>0, go do divide
         ldb   #$2D       =0, Divide by 0 error
         jsr   <u0024     Report error
         fcb   $06       

GoodDiv  ldw   7,y        Get 16 bit signed dividend
         sexw             Sign-Extend W into Q
Positive divq  1,y        Do 32/16 bit signed division
         tstw             Answer positive?
         ble   CheckD     If <=0, skip ahead
MustPos  tsta             Is remainder positive?
         bmi   NegRem     No, have to fix sign on remainder
SaveRem  std   9,y        Save remainder for MOD
         stw   7,y        Save answer for /
         leay  6,y        Eat temp var & return
         rts             

* Negative answer comes here
CheckD   beq   CheckZ     If answer is zero, need special stuff for remainder
CheckD1  tsta             Is remainder negative?
         bmi   SaveRem    Yes, save remainder
NegRem   negd             Otherwise, negate remainder
         bra   SaveRem    Now save it & return

* Zero answer comes here - W is zero, so we can use it's parts
CheckZ   lde   7,y        Get MSB of dividend
         bpl   CheckZ1    Positive, don't change negative flag
         incf             Negative, bump flag up
CheckZ1  lde   1,y        Get MSB of divisor
         bpl   CheckZ2    If positive, leave flag alone
         incf             Negative, bump up flag
CheckZ2  cmpf  #1         If 1, then remainder must be negative
         beq   CheckZ3    It is negative, go deal with it
         clrw             Zero out answer again
         bra   MustPos   

CheckZ3  clrw             Clear out answer to 0 again
         bra   CheckD1    Go deal with sign of remainder

         ELSE            
* Calculate sign of result of Integer Divide (,y - 0=positive, FF=negative)
L3EFD    clr   ,y         Clear flag (positive result)
         ldd   7,y        Get #
         bpl   L3F0B      If positive or 0, go check other #
         nega             Force it to positive (NEGD)
         negb            
         sbca  #$00      
         std   7,y        Save positive version
         com   ,y         Set flag for negative result
L3F0B    ldd   1,y        Get other #
         bpl   L3F17      If positive or 0, go check if it is a 2
         nega             Force it to positive (NEGD)
         negb            
         sbca  #$00      
         std   1,y        Save positive version
         com   ,y         Flip negative/positive result flag
L3F17    cmpd  #2         Check if dividing by 2
         rts             

* INTEGER DIVIDE
L3F1C    bsr   L3EFD      Go force both numbers to positive, check for /2
         bne   L3F2E      Normal divide, skip ahead
         ldd   7,y        Get # to divide by 2
         beq   L3F3B      If 0, result is 0, so skip divide
         asra            
         rorb            
         std   7,y        Save result
         ldd   #$0000     Remainder=0 (No CLRD since it fries carry)
         rolb             Rotate possible remainder bit into D
         bra   L3F65      Go save remainder, fix sign & return

L3F2E    ldd   1,y        Get divisor (integer)
         bne   L3F37      <>0, skip ahead
         ldb   #$2D       =0, Divide by 0 error
         jsr   <u0024     Report error
         fcb   $06       

L3F37    ldd   7,y        Get dividend (integer)
         bne   L3F40      Have to do divide, skip ahead
L3F3B    leay  6,y        ??? Eat temp var? (divisor)
         std   3,y        Save result
         rts             

* INTEGER DIVIDE MAIN ROUTINE
* 7-8,y = Dividend (already checked for 0)
* 1-2,y = Divisor (already checked for 0)
* 3,y   = # of powers of 2 shifts to do
L3F40    tsta             Dividend>256?
         bne   L3F4B      Yes, skip ahead
         exg   a,b        Swap LSB/MSB of dividend
         std   7,y        Save it
         ldb   #8         # of powers of 2 shifts for 8 bit dividend
         bra   L3F4D     

L3F4B    ldb   #16        # of powers of 2 shifts for 16 bit dividend
L3F4D    stb   3,y        Save # shifts required
         clra            
         clrb            
* Main powers of 2 subtract loop for divide
L3F51    lsl   8,y        Multiply dividend by 2
         rol   7,y       
         rolb             Rotate into D
         rola            
         subd  1,y        Subtract that power of 2 from divisor
         bmi   L3F5F      If wraps, add it back in
         inc   8,y       
         bra   L3F61     

L3F5F    addd  1,y       
L3F61    dec   3,y        Dec # shift/subtracts left to do
         bne   L3F51      Still more, continue
L3F65    std   9,y        Save remainder
         tst   ,y         Positive result?
         bpl   L3F79      Yes, eat temp var & return
         nega             NEGD
         negb            
         sbca  #$00      
         std   9,y        Save negative remainder
         ldd   7,y        Get actual divide result
         nega             NEGD
         negb            
         sbca  #$00      
         std   7,y        Save signed result
L3F79    leay  6,y        Eat temp var & return
         rts             
         ENDC            

* Copy REAL # from X (moving X to after real number) to temp var
L3F7C    leay  -6,y       Make room for temp var
         ldb   ,x+        Get hi-byte of real value
         lda   #2         Force var type to REAL
         std   ,y         Save in temp var
         IFNE  H6309
         ldq   ,x         Copy mantissa to temp var
         stq   2,y       
         ldb   #4         Bump X up to past end of var
         abx             
         ELSE            
         ldd   ,x++       Copy rest of real # to temp var & return
         std   2,y       
         ldd   ,x++      
         std   4,y       
         ENDC            
         rts             

* Copy REAL # from variable pool (pointed to by X) into temp var
L3F8D    ldd   ,x++       Get offset into var space for REAL var
         addd  <u0031     ??? Add to base address for variable storage?
         tfr   d,u        Move ptr to U
* Copy REAL # constant from within BASIC09 (pointed to by U) into temp var
L3F93    leay  -6,y       Make room for temp var
         lda   #2         Set 1st byte to be 2
         ldb   ,u         Get 1st byte of real #
         std   ,y        
         IFNE  H6309
         ldq   1,u        Get mantissa for real #
         stq   2,y        Save in temp var
         ELSE            
         ldd   1,u        Get bytes 2&3 of real #
         std   2,y       
         ldd   3,u        Get bytes 4&5 of real #
         std   4,y       
         ENDC            
         rts              Return

* Negate for REAL #'s
         IFNE  H6309
L3FA4    eim   #1,5,y     Negate sign bit of REAL #
         ELSE            
L3FA4    lda   5,y        Get LSB of mantissa & sign bit
         eora  #$01       Reverse the sign bit
         sta   5,y        Save it back
         ENDC            
         rts              return

* Subtract for REAL #'s
         IFNE  H6309
L3FAB    eim   #1,5,y     Negate sign bit of real #
         ELSE            
L3FAB    ldb   5,y        Reverse sign bit on REAL #
         eorb  #1        
         stb   5,y       
         ENDC            

         IFNE  H6309
         use   basic09.real.add.63.asm
         ELSE            
         use   basic09.real.add.68.asm
         ENDC            

* REAL Multiply?
L40CC    bsr   L40D3      Go do REAL multiply
         bcs   L3C2C      If error, report it
         rts              Return without error

L3C2C    jsr   <u0024     Report error
         fcb   $06       

         IFNE  H6309
         use   basic09.real.mul.63.asm
         ELSE            
         use   basic09.real.mul.68.asm
         ENDC            

* Real divide entry point?
L422D    bsr   L4234     
         bcs   LErr      
L4233    rts             

LErr     jsr   <u0024    
         fcb   $06       

         IFNE  H6309
         use   basic09.real.div.63.asm
         ELSE            
         use   basic09.real.div.68.asm
         ENDC            

* Real exponent
L4336    pshs  x          Preserve X
         ldd   7,y        Is the number to be raised 0?
         beq   L4331      Yes, eat temp & return with 0 as result
         ldx   1,y        Is the exponent 0?
         bne   L434F      No, go do normal exponent calculation
         leay  6,y        Eat temp var
L4342    ldd   #$0180     Save 1 in Real # format (all #'s to the power of
         std   1,y        0 result in 1, except 0 itself, which was trapped
* Possible 6809/6309 Mod: deca/sta 3,y/sta 4,y/sta 5,y (1 byte longer/5 cyc
* faster)
         clr   3,y        above)
         clr   4,y       
         clr   5,y       
         puls  pc,x      

L434F    std   1,y       
         stx   7,y       
         ldd   9,y       
         ldx   3,y       
         std   3,y       
         stx   9,y       
         lda   $B,y      
         ldb   5,y       
         sta   5,y       
         stb   $B,y      
         puls  x         
         lbsr  L47AB     
         lbsr  L40CC      Go do real multiply
         lbra  L4864     

* Copy Boolean value into temp var
L436E    ldd   ,x++       Get offset to var from beginning of var pool
         addd  <u0031     Add to base address for vars
         tfr   d,u        Move to index reg
L4374    ldb   ,u         Get boolean value
         clra             Make into Integer type
         leay  -6,y       Make room for temp var
         std   1,y        Save boolean value
         lda   #3         Type = BOOLEAN
         sta   ,y        
         rts             

L4380    ldb   8,y        Single byte LAND
         andb  2,y       
         bra   L4390     

L4386    ldb   8,y        Single byte LOR
         orb   2,y       
         bra   L4390     

L438C    ldb   8,y        Single byte LXOR
         eorb  2,y       
L4390    leay  6,y        Eat temp var
         std   1,y        Save result in original var & return
         rts             

L4395    com   2,y        Single byte LNOT
         rts             

* Main search loop for String comparison operators
L4398    pshs  y,x       
         ldx   1,y        Get ptr to temp string?
         ldy   7,y        Get ptr to var string?
         sty   <u0048    
L43A2    lda   ,y+        Get char from temp string
         cmpa  ,x+        Same as char from var string?
         bne   L43AC      No, skip ahead
         cmpa  #$FF       EOS marker?
         bne   L43A2      No, keep comparing
L43AC    inca             Inc last char checked
         inc   -1,x       Inc last char in compare string
         cmpa  -1,x       Same as last char checked with inc????
         puls  pc,y,x    

* String compare: < (?)
L43B3    bsr   L4398      Go do string compare
         blo   L4405      If less than, result=TRUE
         bra   L4409      Else, result=False

* String compare: <= or =< (?)
L43B9    bsr   L4398     
         bls   L4405     
         bra   L4409     

* String compare: =
L43BF    bsr   L4398     
         beq   L4405     
         bra   L4409     

* String compare: <> or ><
L43C5    bsr   L4398     
         bne   L4405     
         bra   L4409     

* String compare: >= or => (?)
L43CB    bsr   L4398     
         bhs   L4405     
         bra   L4409     

* String compare: > (?)
L43D1    bsr   L4398     
         bhi   L4405     
         bra   L4409     

* For Integer/Byte compares below: Works for signed Integer as well 
*  as unsigned Byte
* Integer/Byte compare: <
L43D7    ldd   7,y       
         subd  1,y        NOTE: SUBD is faster than CMPD
         blt   L4405     
         bra   L4409     

* Integer/Byte compare: <= or =<
L43DF    ldd   7,y       
         subd  1,y       
         ble   L4405     
         bra   L4409     

* Integer/Byte compare: <> or ><
L43E7    ldd   7,y       
         subd  1,y       
         bne   L4405     
         bra   L4409     

* Integer/Byte compare: =
L43EF    ldd   7,y       
         subd  1,y       
         beq   L4405     
         bra   L4409     

* Integer/Byte compare: >= or =>
L43F7    ldd   7,y       
         subd  1,y       
         bge   L4405     
         bra   L4409     

* Integer/Byte compare: >
L43FF    ldd   7,y        Get original var
         subd  1,y        > than compare var?
         ble   L4409      No, boolean result=FALSE
L4405    ldb   #$FF       Boolean result=TRUE
         bra   L440B     

L4409    clrb             Boolean result=FALSE
L440B    clra             Clear hi byte (since result is 1 byte boolean)
         leay  6,y        Eat temp var packet
         std   1,y        Save result in original var packet
         lda   #3         Save var type as Boolean
         sta   ,y        
         rts             

* BOOLEAN = compare
L4415    ldb   8,y        Get original BOOLEAN value
         cmpb  2,y        Same as comparitive BOOLEAN value?
         beq   L4405      Yes, result=TRUE
         bra   L4409      No, result=FALSE

* BOOLEAN <> or >< compare
L441D    ldb   8,y        Get original BOOLEAN value
         cmpb  2,y        Same as comparitive BOOLEAN value?
         bne   L4405      No, result=TRUE
         bra   L4409      Yes, result=FALSE

* Real < compare
L4425    bsr   L4449      Go compute flags between real #'s
         blt   L4405      If < then, result=TRUE
         bra   L4409      Otherwise, result=FALSE

* Real <= or =< compare
L442B    bsr   L4449     
         ble   L4405     
         bra   L4409     

* Real <> or >< compare
L4431    bsr   L4449     
         bne   L4405     
         bra   L4409     

* Real = compare
L4437    bsr   L4449     
         beq   L4405     
         bra   L4409     

* Real >= or => compare
L443D    bsr   L4449     
         bge   L4405     
         bra   L4409     

* Real > compare
L4443    bsr   L4449     
         bgt   L4405     
         bra   L4409     

* Set flags for Real comparison
L4449    pshs  y          Preserve Y
         andcc  #$F0       Clear out Negative, Zero, Overflow & Carry bits
         lda   8,y        Is original REAL var=0?
         bne   L4461      No, skip ahead
         lda   2,y        Is comparitive REAL var=0?
         beq   L445F      Yes, they are equal so return
L4455    lda   5,y        Get last byte of Mantissa with sign bit
L4457    anda  #$01       Ditch everything but sign bit
         bne   L445F      Sign bit set, negative value, return
L445B    andcc  #$F0       Clear out Negative, Zero, Overflow & carry bits
         orcc  #%00001000 Set Negative flag
L445F    puls  pc,y      

L4461    lda   2,y        Is comparitive REAL var=0?
         bne   L446B      No, go deal with whole exponent/mantissa mess
         lda   $B,y       Get sign bit of original var
         eora  #$01       Invert sign flag
         bra   L4457      Go set Negative bit appropriately

* No zero values in REAL compare-deal with exponent & mantissa
L446B    lda   $B,y       Get sign bit byte from original var
         eora  5,y        Calculate resulting sign from it with temp var
         anda  #$01       Only keep sign bit
         bne   L4455      One of the #'s is neg, other pos, go deal with it
         leau  6,y        Both same sign, point U to original var
         lda   5,y        Get sign byte from temp var
         anda  #$01       Just keep sign bit
         beq   L447D      If positive, skip ahead
         exg   u,y        If negative, swap ptrs to the 2 vars
* POSSIBLE 6309 MOD: DO LDA 1,U / CMPA 1,Y FOR EXPONENT, THEN LDQ / CMPD /
* CMPW FOR MANTISSA
L447D    ldd   1,u        Get exponent & 1st mantissa bytes
         cmpd  1,y        Compare
         bne   L445F      Not equal, exit with appropriate flags set
         ldd   3,u        Match so far, compare 2nd & 3rd mantissa bytes
         cmpd  3,y       
         bne   L4491      Not equal, exit with flags
         lda   5,u        Compare last byte of mantissa
         cmpa  5,y       
         beq   L445F      2 #'s are equal, exit
L4491    blo   L445B      If below, set negative flag & exit
         andcc  #$F0       Clear negative, zero, overflow & carry bits
         puls  pc,y       Restore Y & return

*??? Copy string var of some sort <=256 chars max
L4497    clrb             Max size of string copy=256
         stb   <u003E     Save it
L449A    ldu   <u0048     Get ptr to string of some sort
         leay  -6,y       Make room for temp var
         stu   1,y        Save ptr to it
         sty   <u0044     Save temp var ptr
L44A3    cmpu  <u0044     At end of string stack yet?
         bhs   L44C2      Yes, exit with String stack overflow error
         lda   ,x+        Get char from string
         sta   ,u+        Save it
         cmpa  #$FF       EOS?
         beq   L44BB      Yes, finished copying
         decb             Dec size left
         bne   L44A3      Still room, keep copying
         dec   <u003E     ???
         bpl   L44A3      Still good, keep copying
         lda   #$FF       Append string terminator
         sta   ,u+       
L44BB    stu   <u0048     Save end of string stack ptr
         lda   #4         Force var type to string
         sta   ,y        
         rts             

L44C2    ldb   #$2F       String stack overflow
         jsr   <u0024    
         fcb   $06       

L44C7    ldd   ,x++      
         addd  <u0066    
         tfr   d,u       
L44CD    ldd   ,u        
         addd  <u0031    
         ldu   2,u       
         stu   <u003E    
         tfr   d,u       
L44D7    pshs  x         
         ldb   <u003F    
         bne   L44DF     
         dec   <u003E    
L44DF    leax  ,u        
         bsr   L449A     
         puls  pc,x      

L44E5    ldu   1,y        Get ptr to string contents
         leay  6,y        Eat temp var
L44E9    lda   ,u+        Get char from temp var
         sta   -2,u       Save 1 byte back from original spot
         cmpa  #$FF       EOS?
         bne   L44E9      No, keep copying until EOS is hit
         leau  -1,u       Point U back to EOS
         stu   <u0048     Save string stack ptr & return
         rts             

L44F6    ldd   <u003E    
         leay  -6,y       Make room for temp var
         std   3,y        ???
         stu   1,y        ???
         lda   #5         Var type =5???
         sta   ,y        
         rts             

L4503    clra             Force least 2 sig bytes to 0 (and sign to positive)
         clrb            
         std   4,y       
         ldd   1,y        Get Exponent & 1st byte of mantissa
         bne   L4512      Not 0, skip ahead
         stb   3,y        Save 0 int 2nd byte of mantissa
         lda   #2         Var type=Real
         sta   ,y        
         rts             

L4512    ldu   #$0210     ??? (528)
         tsta             Exponent negative?
         bpl   L451F      No, positive (big number), skip ahead
         IFNE  H6309
         negd            
         ELSE            
         nega            
         negb            
         sbca  #$00      
         ENDC            
         inc   5,y       
         tsta             Check exponent again
L451F    bne   L4526      Exponent <>0, skip ahead
         ldu   #$0208     ??? If exponent=0, 522
         exg   a,b       
L4526    tsta            
         bmi   L452F     
L4529    leau  -1,u       Drop down U counter
         lslb             LSLD
         rola            
         bpl   L4529      Do until hi bit is set
L452F    std   2,y       
         stu   ,y        
         rts             

L4534    leay  6,y        Eat temp var
         bsr   L4503      ??? Something with reals
         leay  -6,y       Make room for temp var & return
         rts             

L453B    ldb   1,y        Get exponent
         bgt   L454E      If exponent >0, skip ahead
         bmi   L454A      If exponent <0, skip ahead
         lda   2,y        Exponent=0, get 1st byte of mantissa
         bpl   L454A      If high bit not set, integer result=0
         ldd   #$0001     High bit set, Integer result=1
         bra   L4591      Go adjust sign if necessary

L454A    clra             Integer result=0
         clrb            
         bra   L4599      Save integer & return

L454E    subb  #$10       Subtract 16 from exponent
         bhi   L458C     
         bne   L4566     
         ldd   2,y       
         ror   5,y       
         bcc   L4599     
         cmpd  #$8000    
         bne   L458C     
         tst   4,y       
         bpl   L4599     
         bra   L458C     

L4566    cmpb  #$F8      
         bhi   L4578     
         pshs  b         
         ldd   2,y       
         std   3,y       
         clr   2,y       
         puls  b         
         addb  #$08      
         beq   L4581     
L4578    lsr   2,y       
         ror   3,y       
         ror   4,y       
         incb            
         bne   L4578     
L4581    ldd   2,y       
         tst   4,y       
         bpl   L4591     
         addd  #$0001    
         bvc   L4591     
L458C    ldb   #$34       Value out of Range for Destination error
         jsr   <u0024    
         fcb   $06       

L4591    ror   5,y        Get sign bit of converted real #
         bcc   L4599      Positive, leave integer result alone
         IFNE  H6309
         negd             Reverse sign of integer
         ELSE            
         nega            
         negb            
         sbca  #$00      
         ENDC            
L4599    std   1,y        Save integer result
         lda   #1         Force type to integer & return
         sta   ,y        
         rts             

L45A0    leay  6,y       
         bsr   L453B     
         leay  -6,y      
         rts             

L45A7    leay  $C,y       Eat 2 temp vars
         bsr   L453B     
         leay  -$C,y      Make room for 2 temp vars & return
         rts             

* ABS for Real #'s
         IFNE  H6309
L45AE    aim   #$fe,5,y   Force sign of real # to positive
         ELSE            
L45AE    lda   5,y        Get sign bit for Real #
         anda  #$FE       Force to positive
         sta   5,y        Save sign bit back & return
         rts             
         ENDC            

* ABS for Integer's
L45B5    ldd   1,y        Get integer
         bpl   L45BF      If positive already, exit
         IFNE  H6309
         negd             Force to positive
         ELSE            
         nega             NEGD (force to positive)
         negb            
         sbca  #$00      
         ENDC            
         std   1,y        Save positive value back
L45BF    rts             

L45C0    clra            
         ldb   [<1,y]    
         std   1,y       
         rts             

L45C7    lda   2,y       
         beq   L45DB     
         lda   5,y        Get sign byte
         anda  #$01       Just keep sign bit
         bne   L45DE      Negative #, skip ahead
L45D1    ldb   #$01      
         bra   L45E0     

L45D5    ldd   $01,y     
         bmi   L45DE     
         bne   L45D1     
L45DB    clrb            
         bra   L45E0     

L45DE    ldb   #$FF      
L45E0    sex             
         bra   L45EA     

L45E3    ldb   <u0036    
         clr   <u0036    
L45E7    clra            
         leay  -6,y       Make room for temp var
L45EA    std   1,y        Save value
         lda   #1         Force type to integer & return
         sta   ,y        
L45F0    rts             

L45F1    ldb   <u007D    
         bra   L45E7     

L45F5    ldb   $05,y     
         asrb            
         lbcs  L4FC7     
         ldb   #$1F      
         stb   <u006E    
         ldd   $01,y     
         beq   L45F0     
         inca            
         asra            
         sta   $01,y     
         ldd   $02,y     
         bcs   L4616     
         lsra            
         rorb            
         std   -$04,y    
         ldd   $04,y     
         rora            
         rorb            
         bra   L461A     

L4616    std   -$04,y    
         ldd   $04,y     
L461A    std   -$02,y    
         clra            
         clrb            
         std   $02,y     
         std   $04,y     
         std   -$06,y    
         std   -$08,y    
         bra   L4638     

L4628    orcc  #$01      
         rol   $05,y     
         rol   $04,y     
         rol   $03,y     
         rol   $02,y     
         dec   <u006E    
         beq   L467A     
         bsr   L468F     
L4638    ldb   -$04,y    
         subb  #$40      
         stb   -$04,y    
         ldd   -$06,y    
         sbcb  $05,y     
         sbca  $04,y     
         std   -$06,y    
         ldd   -$08,y    
         sbcb  $03,y     
         sbca  $02,y     
         std   -$08,y    
         bpl   L4628     
L4650    andcc  #$FE      
         rol   $05,y     
         rol   $04,y     
         rol   $03,y     
         rol   $02,y     
         dec   <u006E    
         beq   L467A     
         bsr   L468F     
         ldb   -$04,y    
         addb  #$C0      
         stb   -$04,y    
         ldd   -$06,y    
         adcb  $05,y     
         adca  $04,y     
         std   -$06,y    
         ldd   -$08,y    
         adcb  $03,y     
         adca  $02,y     
         std   -$08,y    
         bmi   L4650     
         bra   L4628     

L467A    ldd   $02,y     
         bra   L4684     

L467E    dec   $01,y     
         lbvs  L40DD     
L4684    lsl   $05,y     
         rol   $04,y     
         rolb            
         rola            
         bpl   L467E     
         std   $02,y     
         rts             

L468F    bsr   L4691     
L4691    lsl   -$01,y    
         rol   -$02,y    
         rol   -$03,y    
         rol   -$04,y    
         rol   -$05,y    
         rol   -$06,y    
         rol   -$07,y    
         rol   -$08,y    
         rts             

* Real MOD routine (?)
L46AA    leau  -12,y      Make room for 2 temp vars
         pshs  y         
L46AE    ldd   ,y++      
         std   ,u++      
         cmpu  ,s        
         bne   L46AE     
         leas  2,s       
         leay  -12,u     
         lbsr  L422D     
         bsr   L46C6     
         lbsr  L40CC     
         lbra  L3FAB     

L46C6    lda   1,y       
         bgt   L46D3     
         clra            
         clrb            
         std   1,y       
         std   3,y       
         stb   5,y       
L46D2    rts             

L46D3    cmpa  #$1F      
         bcc   L46D2     
         leau  $06,y     
         ldb   -1,u      
         andb  #$01      
         pshs  u,b       
         leau  $01,y     
L46E1    leau  1,u       
         suba  #$08      
         bcc   L46E1     
         beq   L46F5     
         ldb   #$FF      
L46EB    lslb            
         inca            
         bne   L46EB     
         andb  ,u        
         stb   ,u+       
         bra   L46F9     

L46F5    leau  1,u       
L46F7    sta   ,u+       
L46F9    cmpu  $01,s     
         bne   L46F7     
         puls  u,b       
         orb   $05,y     
         stb   $05,y     
         rts             

L4705    leay  -6,y      
         ldd   7,y       
         std   1,y       
         lbra  L3EC1     

L470E    leay  -6,y      
         ldd   $A,y      
         std   4,y       
         ldd   8,y       
         std   2,y       
         ldd   6,y       
         std   ,y        
         lbra  L40CC     

L471F    ldd   <u0080    
         ldu   <u0082    
         pshs  u,d       
         ldd   1,y       
         std   <u0080    
         std   <u0082    
         std   <u0048    
         leay  6,y       
         ldb   #9        
         lbsr  L011F     
         puls  u,d       
         std   <u0080    
         stu   <u0082    
         lbcs  L4FC7     
         rts             

L473F    lbsr  L3D51     
         leay  -6,y       Make room for new variable packet
         stu   1,y        Save size of var
L4746    lda   #$01       ??? Integer type
         sta   ,y         ??? Save in variable packet
         leax  1,x       
         rts             

* Table to numeric variable type sizes in bytes? (duplicates earlier table @
*  L3B5B)
* Can either leave table here, change leau below to 8 bit pc (faster/1 byte
*   shorter), or eliminate table and point to 3B5B table (4 bytes shorter/same
*   speed)
L474D    fcb   $01        Byte             (type=0)
         fcb   $02        Integer size     (type=1)
         fcb   $05        Real size        (type=2)
         fcb   $01        Boolean          (type=3)

L4751    lbsr  L3D51     
         leay  -6,y       ??? Size of variable packets?
         cmpa  #4         String/complex variable?
         bhs   L4763      Yes, skip ahead
         leau  <L474D,pc  Point to numeric type size table
         ldb   a,u        Get size of var in bytes
         clra             D=size
         bra   L4765      Go save it

L4763    ldd   <u003E     ??? Get integer value
L4765    std   1,y        ??? Save integer value
         bra   L4746     

* BOOLEAN - TRUE
L4769    ldd   #$00FF     $FF in boolean is True flag
         bra   L4771     

L476E    ldd   #$0000     CLRD ($00 in boolean is False)
L4771    leay  -6,y       Make room for variable packet
         std   1,y        Save boolean flag value
         lda   #3         Save type as boolean (3)
         sta   ,y        
         rts             

L477A    com   1,y        Leave as LDD 1,y/COMD/STD 1,y is same speed
         com   2,y       
         rts             

L477F    ldd   1,y        Get value to AND with out of integer var.
         anda  7,y        ANDD (with value in variable)
         andb  8,y       
         bra   L4795     

L4787    ldd   1,y       
         eora  7,y        EORD
         eorb  8,y       
         bra   L4795     

L478F    ldd   1,y       
         ora   7,y        ORD
         orb   8,y       
L4795    std   7,y        Save result after logic applied
         leay  6,y        Eat temporary variable packet?
         rts             

L479A    fcb   $ff,$de,$5b,$d8,$aa ??? (.434294482)

L479F    bsr   L47AB     
         leau  <L479A,pc  Point to ???
         lbsr  L3F93     
         lbra  L40CC     

L47AB    pshs  x         
         ldb   5,y       
         asrb            
         lbcs  L4FC7     
         ldd   1,y       
         lbeq  L4FC7     
         pshs  a         
         ldb   #1        
         stb   1,y       
         leay  <-$1A,y   
         leax  <$1B,y    
         leau  ,y        
         lbsr  L4BCC     
         lbsr  L4CC7     
         clra            
         clrb            
         std   <$14,y    
         std   <$16,y    
         sta   <$18,y    
         leax  >L4C7F,pc  Point to routine
         stx   <$19,y    
         lbsr  L4909     
         leax  <$14,y    
         leau  <$1B,y    
         lbsr  L4BCC     
         lbsr  L4CE1     
         leay  <$1A,y    
         ldb   #$02      
         stb   ,y        
         ldb   $05,y     
         orb   #$01      
         stb   $05,y     
         puls  b         
         bsr   L480A     
         puls  x         
         lbra  L3FB1     

L4805    fcb   $00,$b1,$72,$17,$f8 (.693147181) LOG(2) in REAL format

L480A    sex              Convert to 16 bit number
         bpl   L480E      If positive, skip ahead
         negb             Invert sign on LSB
L480E    anda  #$01      
         pshs  d         
L4812    leau  <L4805,pc  Point to Log(2) in REAL format
         lbsr  L3F93     
         ldb   5,y       
         lda   1,s       
         cmpa  #1        
         beq   L485C      If multiplying by 1, don't bother
         mul             
         stb   5,y       
         ldb   4,y       
         sta   4,y       
         lda   1,s       
         mul             
         addb  $04,y     
         adca  #$00      
         stb   $04,y     
         ldb   $03,y     
         sta   $03,y     
         lda   $01,s     
         mul             
         addb  $03,y     
         adca  #$00      
         stb   $03,y     
         ldb   $02,y     
         sta   $02,y     
         lda   $01,s     
         mul             
         addb  $02,y     
         adca  #$00      
         beq   L4858     
L484B    inc   $01,y     
         lsra            
         rorb            
         ror   $03,y     
         ror   $04,y     
         ror   $05,y     
         tsta            
         bne   L484B     
L4858    stb   $02,y     
         ldb   $05,y     
L485C    andb  #$FE      
         orb   ,s        
         stb   $05,y     
         puls  pc,d      

L4864    pshs  x         
         ldb   $01,y     
         beq   L4880     
         cmpb  #$07      
         ble   L4877     
         ldb   $05,y     
         rorb            
         rorb            
         eorb  #$80      
         lbra  L491C     

L4877    cmpb  #$E4      
         lble  L4342     
         tstb            
         bpl   L488A     
L4880    clr   ,-s       
         ldb   $05,y     
         andb  #$01      
         beq   L48CD     
         bra   L48BB     

L488A    lda   #$71      
         mul             
         adda  $01,y     
         ldb   $05,y     
         andb  #$01      
         pshs  b,a       
         eorb  $05,y     
         stb   $05,y     
         ldb   ,s        
L489B    lbsr  L480A     
         lbsr  L3FAB     
         ldb   $01,y     
         ble   L48AD     
         addb  ,s        
         stb   ,s        
         ldb   $01,y     
         bra   L489B     

L48AD    puls  d         
         pshs  a         
         tstb            
         beq   L48CD     
         nega            
         sta   ,s        
         orb   5,y       
         stb   5,y       
L48BB    leau  >L4805,pc  Point to LOG(2) in REAL format
         lbsr  L3F93     
         lbsr  L3FB1     
         dec   ,s        
         ldb   5,y       
         andb  #$01      
         bne   L48BB     
L48CD    leay  <-$1A,y   
         leax  <$1B,y    
         leau  <$14,y    
         lbsr  L4BCC     
         lbsr  L4CC7     
         ldd   #$1000    
         std   ,y        
         clra            
         std   $02,y     
         sta   $04,y     
         leax  >L4C61,pc 
         stx   <$19,y    
         bsr   L4909     
         leax  ,y        
         leau  <$1B,y    
         lbsr  L4BCC     
         lbsr  L4CE1     
         leay  <$1A,y    
         puls  b         
         addb  $01,y     
         bvs   L491C     
         lda   #$02      
         std   ,y        
         puls  pc,x      

L4909    lda   #$01      
         sta   <u009A    
         leax  >L4D6F,pc 
         stx   <u0095    
         leax  >$005F,x  
         stx   <u0097    
         lbra  L4B97     

L491C    leay  -6,y      
         lbpl  L40DD     
         ldb   #$32       Floating Overflow error
         jsr   <u0024    
         fcb   $06       

L4927    pshs  x         
         bsr   L495D     
         ldd   $01,y     
         lbeq  L4A91     
         cmpd  #$0180    
         bgt   L4943     
         bne   L4946     
         ldd   $03,y     
         bne   L4943     
         lda   $05,y     
         lbeq  L4A0E     
L4943    lbra  L4FC7     

L4946    lbsr  L49CB     
         leay  <-$14,y   
         leax  <$15,y    
         leau  ,y        
         lbsr  L4BCC     
         lbsr  L4CC7     
         leax  <$1B,y    
         lbra  L4A3E     

L495D    ldb   $05,y     
         andb  #$01      
         stb   <u006D    
         eorb  $05,y     
         stb   $05,y     
         rts             

L4968    leau  <L49AB,pc 
         pshs  u,x       
         bsr   L495D     
         ldd   $01,y     
         lbeq  L4A0E     
         cmpd  #$0180    
         bgt   L4943     
         bne   L4995     
         ldd   $03,y     
         bne   L4943     
         lda   $05,y     
         bne   L4943     
         lda   <u006D    
         bne   L498E     
         clrb            
         std   $01,y     
         puls  pc,u,x    

L498E    leay  6,y        Eat temp var
         puls  u,x       
         lbra  L4B03     

L4995    bsr   L49CB     
         leay  <-$14,y   
         leax  <$1B,y    
         leau  ,y        
         lbsr  L4BCC     
         lbsr  L4CC7     
         leax  <$15,y    
         lbra  L4A3E     

L49AB    lda   5,y       
         bita  #$01      
         beq   L49C5     
         ldu   <u0031    
         tst   1,u       
         beq   L49BF     
         leau  <L49C6,pc  Point to 180 in FP format
         lbsr  L3F93     
         bra   L49C2     

L49BF    lbsr  L4B03     
L49C2    lbra  L3FB1     

* See if we can move label to RTS above @ L495D, or below @ end of L49CB
L49C5    rts             

L49C6    fcb   $08,$b4,$00,$00,$00 180

L49CB    lda   <u006D    
         pshs  a         
         leay  <-$12,y   
         ldd   #$0201    
         std   $0C,y     
         lda   #$80      
         clrb            
         std   $0E,y     
         clra            
         std   <$10,y    
         ldd   <$12,y    
         std   ,y        
         std   $06,y     
         ldd   <$14,y    
         std   $02,y     
         std   $08,y     
         ldd   <$16,y    
         std   $04,y     
         std   $0A,y     
         lbsr  L40CC     
         lbsr  L3FAB     
         lbsr  L45F5     
         puls  a         
         sta   <u006D    
         rts             

L4A03    pshs  x         
         lbsr  L495D     
         ldb   $01,y     
         cmpb  #$18      
         blt   L4A17     
L4A0E    leay  6,y       
         lbsr  L4B03     
         dec   1,y       
         bra   L4A6A     

L4A17    leay  <-$1A,y   
         ldd   #$1000    
         std   ,y        
         clra            
         std   $02,y     
         sta   $04,y     
         ldb   <$1B,y    
         bra   L4A34     

L4A29    asr   ,y        
         ror   1,y       
         ror   2,y       
         ror   3,y       
         ror   4,y       
         decb            
L4A34    cmpb  #$02      
         bgt   L4A29     
         stb   <$1B,y    
         leax  <$1B,y    
L4A3E    leau  $0A,y     
         lbsr  L4BCC     
         lbsr  L4CC7     
         clra            
         clrb            
         std   <$14,y    
         std   <$16,y    
         sta   <$18,y    
         leax  >L4C2C,pc 
         stx   <$19,y    
         lbsr  L4B89     
         leax  <$14,y    
         leau  <$1B,y    
         lbsr  L4BCC     
         lbsr  L4CE1     
         leay  <$1A,y    
L4A6A    lda   $05,y     
         ora   <u006D    
         sta   $05,y     
         ldu   <u0031    
         tst   1,u       
         beq   L4A91     
         leau  >L4AFE,pc 
         lbsr  L3F93     
         lbsr  L40CC     
         bra   L4A91     

L4A82    pshs  x         
         lbsr  L4B0A     
         leax  $0A,y     
         bsr   L4A97     
         lda   $05,y     
L4A8D    eora  <u009C    
L4A8F    sta   $05,y     
L4A91    lda   #$02      
         sta   ,y        
         puls  pc,x      

L4A97    leau  <$1B,y    
         lbsr  L4BCC     
         lbsr  L4CE1     
         leay  <$14,y    
         leax  >L4D6A,pc  Point to a table of Real #'s
         leau  1,y       
         lbsr  L4BCC     
         lbra  L40CC     

L4AAF    pshs  x         
         bsr   L4B0A     
         leax  ,y        
         bsr   L4A97     
         lda   $05,y     
         eora  <u009B    
         bra   L4A8F     

L4ABD    pshs  x         
         bsr   L4B0A     
         leax  $0A,y     
         leau  <$1B,y    
         lbsr  L4BCC     
         lbsr  L4CE1     
         leax  ,y        
         leay  <$14,y    
         leau  $01,y     
         lbsr  L4BCC     
         lbsr  L4CE1     
         ldd   $01,y     
         bne   L4AEB     
         leay  $06,y     
         ldd   #$7FFF    
L4AE2    std   $01,y     
         lda   #$FF      
         std   $03,y     
         deca            
         bra   L4AF0     

L4AEB    lbsr  L422D     
         lda   $05,y     
L4AF0    eora  <u009B    
         bra   L4A8D     

L4AF4    fcb   $02,$c9,$0f,$da,$a2 PI (3.14159265)

L4AF9    fcb   $fb,$8e,$fa,$35,$12 -1.74532925 E-02  (Degrees)

L4AFE    fcb   $06,$e5,$2e,$e0,$d4 57.2957795 (radians)

L4B03    leau  <L4AF4,pc  Point to PI in FP format
         lbra  L3F93     

L4B0A    ldu   <u0031    
         tst   1,u       
         beq   L4B1A     
         leau  <L4AF9,pc 
         lbsr  L3F93      Copy 5 bytes from u to 1,y (0,y=2)
         lbsr  L40CC     
L4B1A    clr   <u009B    
         ldb   $05,y     
         andb  #$01      
         stb   <u009C    
         eorb  $05,y     
         stb   $05,y     
         bsr   L4B03     
         inc   $01,y     
         lbsr  L4449     
         blt   L4B36     
         lbsr  L46AA     
         bsr   L4B03     
         bra   L4B38     

L4B36    dec   $01,y     
L4B38    lbsr  L4449     
         blt   L4B4A     
         inc   <u009B    
         lda   <u009C    
         eora  #$01      
         sta   <u009C    
         lbsr  L3FAB     
         bsr   L4B03     
L4B4A    dec   $01,y     
         lbsr  L4449     
         ble   L4B64     
         lda   <u009B    
         eora  #$01      
         sta   <u009B    
         inc   $01,y     
         lda   $0B,y     
         ora   #$01      
         sta   $0B,y     
         lbsr  L3FB1     
         leay  -$06,y    
L4B64    leay  <-$14,y   
         leax  >L4C33,pc 
         stx   <$19,y    
         leax  <$1B,y    
         leau  <$14,y    
         bsr   L4BCC     
         lbsr  L4CC7     
         ldd   #$1000    
         std   ,y        
         clra            
         std   $02,y     
         sta   $04,y     
         std   $0A,y     
         std   $0C,y     
         sta   $0E,y     
L4B89    leax  >L4D29,pc  Point to some real # table
         stx   <u0095    
         leax  <L4D6A-L4D29,x Point to further in table
         stx   <u0097    
         clr   <u009A    
L4B97    ldb   #$25      
         stb   <u0099    
         clr   <u009D    
L4B9D    leau  <$1B,y    
         ldx   <u0095    
         cmpx  <u0097    
         bhs   L4BAE     
         bsr   L4BCC     
         leax  5,x        Point to next entry in 5-byte entry table
         stx   <u0095     Save new ptr
         bra   L4BB2     

L4BAE    ldb   #$01      
         bsr   L4C1E     
L4BB2    leax  ,y        
         leau  5,y       
         bsr   L4BDE     
         tst   <u009A    
         bne   L4BC2     
         leax  $0A,y     
         leau  $0F,y     
         bsr   L4BDE     
L4BC2    jsr   [<$19,y]  
         inc   <u009D    
         dec   <u0099    
         bne   L4B9D     
         rts             

L4BCC    pshs  y,x       
         lda   ,x        
         ldy   1,x       
         ldx   3,x       
         sta   ,u        
         sty   1,u       
         stx   3,u       
         puls  pc,y,x    

L4BDE    ldb   ,x        
         sex             
         ldb   <u009D    
         lsrb            
         lsrb            
         lsrb            
         bcc   L4BE9     
         incb            
L4BE9    pshs  b         
         beq   L4BF2     
L4BED    sta   ,u+       
         decb            
         bne   L4BED     
L4BF2    ldb   #$05      
         subb  ,s+       
         beq   L4BFF     
L4BF8    lda   ,x+       
         sta   ,u+       
         decb            
         bne   L4BF8     
L4BFF    leau  -5,u      
         ldb   <u009D    
         andb  #$07      
         beq   L4C2B     
         cmpb  #$04      
         bcs   L4C1E     
         subb  #$08      
         lda   ,x        
L4C0F    lsla            
         rol   4,u       
         rol   3,u       
         rol   2,u       
         rol   1,u       
         rol   ,u        
         incb            
         bne   L4C0F     
         rts             

L4C1E    asr   ,u        
         ror   1,u       
         ror   2,u       
         ror   3,u       
         ror   4,u       
         decb            
         bne   L4C1E     
L4C2B    rts             

L4C2C    lda   $0A,y     
         eora  ,y        
         coma            
         bra   L4C36     

L4C33    lda   <$14,y    
L4C36    tsta            
         bpl   L4C4D     
         leax  ,y        
         leau  $0F,y     
         bsr   L4C8F     
         leax  $0A,y     
         leau  $05,y     
         bsr   L4CAB     
         leax  <$14,y    
         leau  <$1B,y    
         bra   L4C8F     

L4C4D    leax  ,y        
         leau  $0F,y     
         bsr   L4CAB     
         leax  $0A,y     
         leau  $05,y     
         bsr   L4C8F     
         leax  <$14,y    
         leau  <$1B,y    
         bra   L4CAB     

L4C61    leax  <$14,y    
         leau  <$1B,y    
         bsr   L4CAB     
         bmi   L4C8F     
         bne   L4C79     
         ldd   $01,x     
         bne   L4C79     
         ldd   $03,x     
         bne   L4C79     
         ldb   #$01      
         stb   <u0099    
L4C79    leax  ,y        
         leau  5,y       
         bra   L4C8F     

L4C7F    leax  ,y        
         leau  $05,y     
         bsr   L4C8F     
         cmpa  #$20      
         bcc   L4CAB     
         leax  <$14,y    
         leau  <$1B,y    
L4C8F    ldd   3,x       
         addd  3,u       
         std   3,x       
         ldd   1,x       
         bcc   L4CA0     
         addd  #$0001    
         bcc   L4CA0     
         inc   ,x        
L4CA0    addd  1,u       
         std   1,x       
         lda   ,x        
         adca  ,u        
         sta   ,x        
         rts             

L4CAB    ldd   3,x       
         subd  3,u       
         std   3,x       
         ldd   1,x       
         bcc   L4CBC     
         subd  #$0001    
         bcc   L4CBC     
         dec   ,x        
L4CBC    subd  1,u       
         std   1,x       
         lda   ,x        
         sbca  ,u        
         sta   ,x        
         rts             

L4CC7    ldb   ,u        
         clr   ,u        
         addb  #$04      
         bge   L4CDE     
         negb            
         lbra  L4C1E     

* Multiply 5 byte number @ ,u  by 2
* Entry: B=# times to multiply 
L4CD3    lsl   4,u       
         rol   3,u       
         rol   2,u       
         rol   1,u       
         rol   ,u        
         decb            
L4CDE    bne   L4CD3     
         rts             

L4CE1    lda   ,u         Get sign of 5 byte #
         bpl   L4CEE      If positive, skip ahead
         IFNE  H6309
         clrd             Clr 5 bytes @ u
         ELSE            
         clra            
         clrb            
         ENDC            
         std   ,u        
         std   2,u       
         sta   4,u       
         rts             

L4CEE    ldd   #$2004    
L4CF1    decb            
         lsl   4,u       
         rol   3,u       
         rol   2,u       
         rol   1,u       
         rol   ,u        
         bmi   L4D05     
         deca            
         bne   L4CF1     
         clrb            
         std   ,u        
         rts             

L4D05    lda   ,u        
         stb   ,u        
         ldb   1,u       
         sta   1,u       
         lda   2,u       
         stb   2,u       
         ldb   3,u       
         addd  #$0001    
         andb  #$FE      
         std   3,u       
         bcc   L4D28     
         inc   2,u       
         bne   L4D28     
         inc   1,u       
         bne   L4D28     
         ror   1,u       
         inc   ,u        
L4D28    rts             

* Data (all 5 byte entries for real #'s???)
L4D29    fcb   $0c,$90,$fd,$aa,$22 2319.85404
         fcb   $07,$6b,$19,$c1,$58 53.5503032
         fcb   $03,$eb,$6e,$bf,$26 7.35726888
         fcb   $01,$fd,$5b,$a9,$ab -1.97935983
         fcb   $00,$ff,$aa,$dd,$b9
         fcb   $00,$7f,$f5,$56,$ef
         fcb   $00,$3f,$fe,$aa,$b7
         fcb   $00,$1f,$ff,$d5,$56
         fcb   $00,$0f,$ff,$fa,$ab
         fcb   $00,$07,$ff,$ff,$55
         fcb   $00,$03,$ff,$ff,$eb
         fcb   $00,$01,$ff,$ff,$fd
         fcb   $00,$01,$00,$00,$00

L4D6A    fcb   $00,$9b,$74,$ed,$a8 .607252935
L4D6F    fcb   $0b,$17,$21,$7f,$7e 0185.04681
         fcb   $06,$7c,$c8,$fb,$30
         fcb   $03,$91,$fe,$f8,$f3
         fcb   $01,$e2,$70,$76,$e3
         fcb   $00,$f8,$51,$86,$01
         fcb   $00,$7e,$0a,$6c,$3a
         fcb   $00,$3f,$81,$51,$62
         fcb   $00,$1f,$e0,$2a,$6b
         fcb   $00,$0f,$f8,$05,$51
         fcb   $00,$07,$fe,$00,$aa
         fcb   $00,$03,$ff,$80,$15
         fcb   $00,$01,$ff,$e0,$03
         fcb   $00,$00,$ff,$f8,$00
         fcb   $00,$00,$7f,$fe,$00
         fcb   $00,$00,$3f,$ff,$80
         fcb   $00,$00,$1f,$ff,$e0
         fcb   $00,$00,$0f,$ff,$f8
         fcb   $00,$00,$07,$ff,$fe
         fcb   $00,$00,$04,$00,$00

L4DCE    fdb   $0E12,$14A2,$BB40,$E62D,$3619,$62E9

         IFNE  H6309
L4DDA    clrd            
         ELSE            
L4DDA    clra            
         clrb            
         ENDC            
         std   <u004C    
         std   <u004E    
         pshs  a          ??? Save flag (0)
         lda   2,y       
         beq   L4DFC     
         ldb   5,y        ??? Get sign/exponent byte
         bitb  #1         ??? Negative number?
         bne   L4DF0      ??? Yes, skip ahead
         com   ,s         ??? No, set flag
         bra   L4DFC     

L4DF0    addb  #$FE      
         addb  1,y       
         lda   4,y       
         std   <u0052    
         ldd   2,y       
         std   <u0050    
L4DFC    lda   <u0053    
         ldb   <u0057    
         mul             
         std   <u004E    
         lda   <u0052    
         ldb   <u0057    
         mul             
         addd  <u004D    
         bcc   L4E0E     
         inc   <u004C    
L4E0E    std   <u004D    
         lda   <u0053    
         ldb   <u0056    
         mul             
         addd  <u004D    
         bcc   L4E1B     
         inc   <u004C    
L4E1B    std   <u004D    
         lda   <u0051    
         ldb   <u0057    
         mul             
         addd  <u004C    
         std   <u004C    
         lda   <u0052    
         ldb   <u0056    
         mul             
         addd  <u004C    
         std   <u004C    
         lda   <u0053    
         ldb   <u0055    
         mul             
         addd  <u004C    
         std   <u004C    
         lda   <u0050    
         ldb   <u0057    
         mul             
         addb  <u004C    
         stb   <u004C    
         lda   <u0051    
         ldb   <u0056    
         mul             
         addb  <u004C    
         stb   <u004C    
         lda   <u0052    
         ldb   <u0055    
         mul             
         addb  <u004C    
         stb   <u004C    
* NOTE: ON 6809, CHANGE TO LDD <u0053
         lda   <u0053    
         ldb   <u0054    
         mul             
         addb  <u004C    
         stb   <u004C    
         ldd   <u004E    
         addd  <u005A    
         std   <u0052    
         ldd   <u004C    
* NOTE: 6309 ADCD <u0058
         adcb  <u0059    
         adca  <u0058    
         std   <u0050    
         tst   ,s+       
         bne   L4E98     
         ldd   <u0050    
         std   2,y       
         ldd   <u0052    
         std   4,y       
         clr   1,y       
L4E78    lda   #$1F      
         pshs  a         
         ldd   $02,y     
         bmi   L4E8E     
L4E80    dec   ,s        
         beq   L4E8E     
         dec   $01,y     
         lsl   $05,y     
         rol   $04,y     
         rolb            
         rola            
         bpl   L4E80     
L4E8E    std   $02,y     
         ldb   $05,y     
         andb  #$FE      
         stb   $05,y     
         puls  pc,b      

L4E98    ldd   <u0052    
         andb  #$FE       ??? Kill sign bit on real #?
         std   ,--y      
         ldd   <u0050    
         std   ,--y      
         IFNE  H6309
         clrd            
         ELSE            
         clra            
         clrb            
         ENDC            
         std   ,--y      
         bsr   L4E78     
         lbra  L40CC     

L4EAB    ldd   <u0048    
         ldu   1,y       
         subd  1,y       
         subd  #1        
         stu   <u0048    
L4EB6    std   1,y       
         lda   #1        
         sta   ,y        
         rts             

L4EBD    ldd   1,y       
         std   <u0048    
         ldb   [<$01,y]  
         clra            
         bra   L4EB6     

L4EC7    ldd   1,y       
         tsta            
         lbne  L4FC7     
         ldu   <u0048    
         stu   1,y       
         stb   ,u+       
         lbsr  L4FEA     
         sty   <u0044    
         cmpu  <u0044    
         lbhs  L44C2     
         rts             

L4EE2    ldd   1,y       
         ble   L4EF4     
         addd  7,y       
         tfr   d,u       
         cmpd  <u0048    
         bcc   L4EF1     
         bsr   L4F70     
L4EF1    leay  6,y       
         rts             

L4EF4    leay  6,y       
         ldu   1,y       
         bra   L4F70     

L4EFA    ldd   1,y       
         ble   L4EF4     
         pshs  x         
         ldd   <u0048    
         subd  1,y       
         subd  #1        
         cmpd  7,y       
         bls   L4F1A     
         tfr   d,x       
         ldu   7,y       
L4F10    lda   ,x+       
         sta   ,u+       
         cmpa  #$FF      
         bne   L4F10     
         stu   <u0048    
L4F1A    leay  6,y       
         puls  pc,x      

L4F1E    ldd   $01,y     
         ble   L4F26     
         ldd   $07,y     
         bgt   L4F2E     
L4F26    ldd   $01,y     
         leay  $06,y     
         std   $01,y     
         bra   L4EE2     

L4F2E    subd  #$0001    
         beq   L4F26     
         addd  $0D,y     
         cmpd  <u0048    
         bcs   L4F3E     
         leay  $06,y     
         bra   L4EF4     

L4F3E    pshs  x         
         tfr   d,x       
         ldb   $02,y     
         ldu   $0D,y     
L4F46    lda   ,x+       
         sta   ,u+       
         cmpa  #$FF      
         beq   L4F59     
         decb            
         bne   L4F46     
         dec   1,y       
         bpl   L4F46     
         lda   #$FF      
         sta   ,u+       
L4F59    stu   <u0048    
         leay  $0C,y     
         puls  pc,x      

L4F5F    ldu   <u0048    
         leau  -1,u      
L4F63    cmpu  $01,y     
         beq   L4F70     
         lda   ,-u       
         cmpa  #$20      
         beq   L4F63     
         leau  1,u       
L4F70    lda   #$FF      
         sta   ,u+       
         stu   <u0048    
         rts             

L4F77    pshs  y,x       
         ldd   <u0048     ??? Get size of string
         subd  1,y        Subtract ptr to string to search in
         addd  7,y        Add to ptr to string to search for
         addd  #1         +1
         ldx   7,y        Get ptr to string to search for
         ldy   1,y        Get ptr to string to search in
         bsr   L3C29      Call Substr function (should change to direct LBSR
         bcc   L4F90      If sub-string match found, skip ahead
         IFNE  H6309
         clrd            
         ELSE            
         clra            
         clrb            
         ENDC            
         bra   L4F99     

L3C29    jsr   <u001B     Substr string search
         fcb   $08       

L4F90    tfr   y,d       
         ldx   2,s       
         subd  1,x       
         addd  #$0001    
L4F99    puls  y,x       
         std   7,y       
         lda   #1        
         sta   6,y       
         leay  6,y       
         rts             

L4FA4    ldb   #$02      
         bra   L4FAA     

L4FA8    ldb   #$03      
L4FAA    lda   <u007D    
         ldu   <u0082    
         pshs  u,x,a     
         lbsr  L011F     
         bcs   L4FC7     
         ldx   <u0082    
         lda   #$FF      
         sta   ,x        
         ldx   $03,s     
         lbsr  L4497     
         puls  u,x,a     
         sta   <u007D    
         stu   <u0082    
         rts             

L4FC7    ldb   #$43       Illegal Arguement error
         jsr   <u0024    
         fcb   $06       

L4FCC    pshs  x         
         ldd   1,y       
         blt   L4FC7     
         sty   <u0044    
         ldu   <u0048    
         stu   $01,y     
         lda   #$20      
L4FDB    cmpb  <u007D    
         bls   L4FEC     
         sta   ,u+       
         decb            
         cmpu  <u0044    
         blo   L4FDB     
         lbra  L44C2     

L4FEA    pshs  x         
L4FEC    lda   #$FF      
         sta   ,u+       
         stu   <u0048    
         lda   #$04      
         sta   ,y        
         puls  pc,x      

* DATE$ routine
L4FF8    pshs  x         
         leay  -6,y      
         leax  -6,y      
         ldu   <u0048    
         stu   1,y       
         os9   F$Time     Get time packet
         bcs   L4FEC      Error, exit
         bsr   L5021      Start converting
         lda   #'/        Append / 
         bsr   L501F     
         lda   #'/       
         bsr   L501F     
         lda   #$20      
         bsr   L501F     
         lda   #':       
         bsr   L501F     
         lda   #':       
         bsr   L501F     
         bra   L4FEC     

L501F    sta   ,u+       
L5021    lda   ,x+        Get byte from time packet
         ldb   #'/       
L5025    incb            
         suba  #10       
         bcc   L5025     
         stb   ,u+       
         ldb   #':       
L502E    decb            
         inca            
         bne   L502E     
         stb   ,u+       
         rts             

L5035    lda   2,y        Get path #
         ldb   #SS.EOF    Check if we are at end of file
         os9   I$GetStt  
         bcc   L5046      No, skip ahead
         cmpb  #E$EOF     Was the error an EOF error?
         bne   L5046      No, skip ahead
         ldb   #$FF      
         bra   L5048     

L5046    clrb            
L5048    clra            
         std   1,y       
         lda   #$03      
         sta   ,y        
         rts             

L5050    ldb   #$06       6 2-byte entries to copy
         pshs  y,x,b      Preserve regs
         tfr   dp,a       Move DP to MSB of D
         ldb   #$50       Point to [dp]50 (always u0050 in Lvl II)
         tfr   d,y        Move to Y
         leax  >L4DCE,pc  Point to table
L505E    ldd   ,x++       Get 2 bytes
         std   ,y++       Move into DP
         dec   ,s         Do all 6
         bne   L505E      Until done
         leax  >L3CB5,pc  Point to jump table
         stx   <u0010     Save ptr
         leax  >L3D35,pc  Point to another jump table
         stx   <u0012     Save ptr
         lda   #$7E       Get opcode for JMP >xxxx
         sta   <u0016     Save it
         leax  >L3D41,pc  Point to routine
         stx   <u0017     Save as destination for above JMP
         leax  <L3C32,pc  Point to JSR <u001B / FCB $1A
         stx   <u0019     Save it
         puls  pc,y,x,b   Restore regs & return

L3C32    jsr   <u001B    
         fcb   $1a       

* <u002A goes here
L5084    pshs  x,d        Preserve regs
         ldb   [<$04,s]   Get function code
         leax  <L5094,pc  Point to table (only functions 0 & 2)
         ldd   b,x        Get offset
         leax  d,x        Point to routine
         stx   4,s        Save over PC on stack
         puls  pc,x,d     Restore X&D & go to routine

L5094    fdb   L514E-L5094 Function 0
         fdb   L50A4-L5094 Function 2

L5098    jsr   <u0027    
         fcb   $0c       
L509B    jsr   <u0027    
         fcb   $0e       

* <u002A function 2
* Entry: B=Sub-function #
L50A4    pshs  pc,x,d     Make room for new PC, preserve X & Y
         lslb             2 bytes / entry
         leax  <L50B2,pc  Point to jump offset table
L50AA    ldd   b,x        Get offset
L50AC    leax  d,x        Add to base of table
         stx   4,s        Save over PC on stack
         puls  pc,x,d     Restore X&D & JMP to subroutine

* Sub-function jump table (L50B2 is the base)
L50B2    fdb   L5511-L50B2 $045f  0
         fdb   L5675-L50B2 $05c3  1
         fdb   L5675-L50B2 $05c3  2
         fdb   L5569-L50B2 $04b7  3
         fdb   L5665-L50B2 $05b3  4
         fdb   L565C-L50B2 $05aa  5
         fdb   L54FC-L50B2 $044a  6
         fdb   L530A-L50B2 $0258  7
         fdb   L531D-L50B2 $026b  8
         fdb   L52E7-L50B2 $0235  9
         fdb   L5354-L50B2 $02a2  A
         fdb   L5331-L50B2 $027f  B
         fdb   L56AB-L50B2 $05f9  C
         fdb   L569B-L50B2 $05e9  D
         fdb   L552A-L50B2 $0478  E
         fdb   L5AC3-L50B2 $0a11  F    Exit with Unimplemented routine err
         fdb   L568C-L50B2 $05da  10
         fdb   L576C-L50B2 $06ba  11
         fdb   L5614-L50B2 $0562  12
         fdb   L580B-L50B2 $0759  13
L50DA    fdb   L56B4-L50B2 $0602  14

* Table for Integer conversion
L50DC    fdb   10000     
         fdb   1000      
         fdb   100       
         fdb   10        

* Table for REAL conversion
L50E4    fcb   $04,$a0,$00,$00,$00 10
         fcb   $07,$c8,$00,$00,$00 100
         fcb   $0a,$fa,$00,$00,$00 1000
         fcb   $0e,$9c,$40,$00,$00 10 thousand
         fcb   $11,$c3,$50,$00,$00 100 thousand
         fcb   $14,$f4,$24,$00,$00 1 million
         fcb   $18,$98,$96,$80,$00 10 million
         fcb   $1b,$be,$bc,$20,$00 100 million
         fcb   $1e,$ee,$6b,$28,$00 1 billion
         fcb   $22,$95,$02,$f9,$00 10 billion
         fcb   $25,$ba,$43,$b7,$40 100 billion
         fcb   $28,$e8,$d4,$a5,$10 1 trillion
         fcb   $2c,$91,$84,$e7,$2a 10 trillion
         fcb   $2f,$b5,$e6,$20,$f4 100 trillion
         fcb   $32,$e3,$5f,$a9,$32 1 quadrillion
         fcb   $36,$8e,$1b,$c9,$c0 10 quadrillion
         fcb   $39,$b1,$a2,$bc,$2e 100 quadrillion
         fcb   $3c,$de,$0b,$6b,$3a 1 quintillion
L513E    fcb   $40,$8a,$c7,$23,$04 10 quintillion

L5143    fcc   'True'    
         fcb   $ff       

L5148    fcc   'False'   
         fcb   $ff       

* <u0024 function 2
L514E    pshs  u         
         leay  -6,y       Make room for temp var
         clra            
         clrb            
* 6809/6309 MOD: Change following 4 lines to STD <u0075, STD <u0077
         sta   <u0075     ??? Zero out real # in DP?
         sta   <u0076    
         sta   <u0077    
         sta   <u0078    
         sta   <u0079    
         std   4,y        ??? Zero out temp real #
         std   2,y       
         sta   1,y       
         lbsr  L5390     
         bcc   L5172     
         leax  -1,x      
         cmpa  #$2C      
         bne   L51DE     
         lbra  L51FB     

L5172    cmpa  #$24      
         lbeq  L52B2     
         cmpa  #$2B      
         beq   L5182     
         cmpa  #$2D      
         bne   L5184     
         inc   <u0078    
L5182    lda   ,x+       
L5184    cmpa  #$2E      
         bne   L5190     
         tst   <u0077    
         bne   L51DE     
         inc   <u0077    
         bra   L5182     

L5190    lbsr  L57DE     
         bcs   L51E5     
         pshs  a         
         inc   <u0076    
         ldd   4,y       
         ldu   2,y       
         bsr   L51CB     
         std   4,y       
         stu   2,y       
         bsr   L51CB     
         bsr   L51CB     
         addd  4,y       
         exg   d,u       
* 6309 mod: ADCD 2,y
         adcb  3,y       
         adca  2,y       
         bcs   L51D8     
         exg   d,u       
         addb  ,s+       
         adca  #$00      
         bcc   L51BF     
         leau  1,u       
         stu   2,y       
         beq   L51DA     
L51BF    std   4,y       
         stu   2,y       
         tst   <u0077    
         beq   L5182     
         inc   <u0079    
         bra   L5182     

L51CB    lslb            
         rola            
         exg   d,u       
         rolb            
         rola            
         exg   d,u       
         bcs   L51D6     
         rts             

L51D6    leas  2,s       
L51D8    leas  1,s       
L51DA    ldb   #$3C       I/O conversion: Number out of range error
         bra   L51E0     

L51DE    ldb   #$3B      
L51E0    stb   <u0036    
         coma            
         puls  pc,u      

L51E5    eora  #$45      
         anda  #$DF      
         beq   L520E     
         leax  -1,x      
         tst   <u0076    
         bne   L51F3     
         bra   L51DE     

L51F3    tst   <u0077    
         bne   L523C     
         ldd   2,y       
         bne   L523C     
L51FB    ldd   4,y       
         bmi   L523C     
         tst   <u0078    
         beq   L5207     
         nega             NEGD
         negb            
         sbca  #$00      
L5207    std   1,y       
L5209    lda   #$01      
         lbra  L5295     

L520E    lda   ,x        
         cmpa  #$2B      
         beq   L521A     
         cmpa  #$2D      
         bne   L521C     
         inc   <u0075    
L521A    leax  1,x       
L521C    lbsr  L57DC     
         bcs   L51DE     
         tfr   a,b       
         lbsr  L57DC     
         bcc   L522C     
         leax  -1,x      
         bra   L5233     

L522C    pshs  a          Save 1's digit
         lda   #10        Multiply by 10 (for 10's digit)
         mul             
         addb  ,s+       
L5233    tst   <u0075    
         bne   L5238     
         negb            
L5238    addb  <u0079    
         stb   <u0079    
L523C    ldb   #$20      
         stb   1,y       
         ldd   2,y       
         bne   L524D     
         cmpd  4,y       
         bne   L524D     
         clr   1,y       
         bra   L5293     

L524D    tsta            
         bmi   L525A     
L5250    dec   1,y       
         lsl   5,y       
         rol   4,y       
         rolb            
         rola            
         bpl   L5250     
L525A    std   2,y       
         clr   <u0075    
         ldb   <u0079    
         beq   L528B     
         bpl   L5267     
         negb            
         inc   <u0075    
L5267    cmpb  #$13      
         bls   L527B     
         subb  #$13      
         pshs  b         
         leau  >L513E,pc 
         bsr   L529B     
         puls  b         
         lbcs  L51DA     
L527B    decb            
         lda   #5        
         mul             
         leau  >L50E4,pc 
         leau  b,u       
         bsr   L529B     
         lbcs  L51DA     
L528B    lda   5,y       
         anda  #$FE      
         ora   <u0078    
         sta   5,y       
L5293    lda   #2         Real # type
L5295    sta   ,y         Save it in var packet
         andcc  #$FE       Clear carry (no error)
         puls  pc,u      

L529B    leay  -6,y       Make room for temp var
         IFNE  H6309
         ldq   ,u         Copy real # from ,u to 1,y
         stq   1,y       
         ELSE            
         ldd   ,u         Get real # from ,u
         std   1,y        Save into real portion of var packet
         ldd   2,u       
         std   3,y       
         ENDC            
         ldb   4,u       
         stb   5,y       
         lda   <u0075     Get sign of exponent?
         lbeq  L4234      Real Divide
         lbra  L40D3      Real Multiply

L52B2    lbsr  L57DC     
         bcc   L52C7     
         cmpa  #$61      
         blo   L52BD     
         suba  #$20      
L52BD    cmpa  #$41      
         blo   L52DC     
         cmpa  #$46      
         bhi   L52DC     
         suba  #$37      
L52C7    inc   <u0076    
         ldb   #4         Loop counter for shift
L52CB    lsl   2,y       
         rol   1,y       
         lbcs  L51DA      If carried right out of byte, error
         decb            
         bne   L52CB      Do all 4 shifts
         adda  2,y       
         sta   2,y       
         bra   L52B2     

L52DC    leax  -1,x      
         tst   <u0076    
         lbeq  L51DE     
         lbra  L5209     

L52E7    pshs  x          Preserve X
         ldx   <u0082     Get current pos in temp buffer
         lbsr  L514E     
         bcc   L52F2     
L52F0    puls  pc,x      

L52F2    cmpa  #2         Real #?
         beq   L52F9      Yes, continue ahead
         lbsr  L509B      ??? convert to real?
L52F9    lbsr  L5384     
         bcs   L5305     
         ldb   #$3D       Illegal input format error
         stb   <u0036     Save error code
         coma             Set carry
         puls  pc,x       Restore X & return

L5305    stx   <u0082     Save new current pos in temp buffer
         clra             No error
         puls  pc,x       Restore X & return

L530A    pshs  x          Preserve X
         ldx   <u0082     Get current pos in temp buffer
         lbsr  L514E      ??? (returns A=var type)
         bcs   L52F0     
         cmpa  #1         Integer?
         bne   L532A     
         tst   1,y       
         beq   L52F9     
         bra   L532A     

L531D    pshs  x         
         ldx   <u0082     Get current pos in temp buffer
         lbsr  L514E     
         bcs   L52F0     
         cmpa  #1         Integer?
         beq   L52F9      Yes, go back
L532A    ldb   #$3A       I/O Type mismatch error
* TO SAVE ROOM, SINCE ERRORS AREN'T CRUCIAL TO SPEED, MAY WANT THIS TO
* BRANCH TO SAME CODE @ L52F9
         stb   <u0036    
         coma            
         puls  pc,x      

L5331    pshs  u,x       
         leay  -6,y       Make room for temp var
         ldu   <u004A    
         stu   1,y        ??? Save some string ptr
         lda   #4         Type=String/complex
         sta   ,y        
         ldx   <u0082    
L533F    lda   ,x+       
         bsr   L5396     
         bcs   L5349     
         sta   ,u+       
         bra   L533F     

L5349    stx   <u0082    
         lda   #$FF       Flag end of string?
         sta   ,u+       
         stu   <u0048    
         clra            
         puls  pc,u,x    

L5354    pshs  x         
         leay  -6,y      
         lda   #3        
         sta   ,y        
         clr   2,y       
         ldx   <u0082    
         bsr   L5390     
         bcs   L537F     
         cmpa  #'T       
         beq   L5379     
         cmpa  #'t       
         beq   L5379     
         eora  #$46      
         anda  #$DF      
         beq   L537B     
         ldb   #$3A      
         stb   <u0036    
         coma            
         puls  pc,x      

L5379    com   2,y       
L537B    bsr   L5384     
         bcc   L537B     
L537F    stx   <u0082    
         clra            
         puls  pc,x      

L5384    lda   ,x+       
         cmpa  #C$SPAC   
         bne   L5396     
         bsr   L5390     
         bcc   L53A5     
         bra   L53A7     

L5390    lda   ,x+        Get char
         cmpa  #C$SPAC    Space?
         beq   L5390      Yes, ignore & get next char
L5396    cmpa  <u00DD     Char we are looking for?
         beq   L53A7      Yes, set carry & exit
         cmpa  #C$CR      Carriage return?
         beq   L53A5      Yes, point X to it, set carry & exit
         cmpa  #$FF       End of string marker?
         beq   L53A5      Yes, point X to it, set carry & exit
         andcc  #$FE       Clear carry & return
         rts             

L53A5    leax  -1,x      
L53A7    orcc  #$01      
         rts             

L53AA    pshs  u,x       
         clra            
         sta   3,y       
         sta   <u0076    
         sta   <u0078    
         lda   #$04      
         sta   <u007E    
         ldd   1,y       
         bpl   L53C1      If positive, skip ahead
         nega             NEGD
         negb            
         sbca  #$00      
         inc   <u0078     Set flag?
L53C1    leau  >L50DA,pc 
L53C5    clr   <u007A    
         leau  2,u       
L53C9    subd  ,u        
         bcs   L53D1     
         inc   <u007A    
         bra   L53C9     

L53D1    addd  ,u        
         tst   <u007A    
         bne   L53DB     
         tst   $03,y     
         beq   L53E6     
L53DB    inc   $03,y     
         pshs  a         
         lda   <u007A    
         lbsr  L54EA     
         puls  a         
L53E6    dec   <u007E    
         bne   L53C5     
         tfr   b,a       
         lbsr  L54EA     
         leay  $06,y     
         puls  pc,u,x    

* NOTE: 6809/6309 mod
L53F3    pshs  u,x       
         clr   <u0075     Replace with CLRA/CLRB/STD <u0075/STD <u0078/
         clr   <u0078     STD <u007B (smaller & faster)
         clr   <u007C    
         clr   <u007B    
         clr   <u0079    
         clr   <u0076    
         leau  ,x        
         ldd   #$0A30     Store 10 ASCI 0's at U
L5406    stb   ,u+       
         deca            
         bne   L5406     
         ldd   1,y       
         bne   L5413     
         inca            
         lbra  L54E4     

L5413    ldb   5,y       
         bitb  #$01      
         beq   L541F     
         stb   <u0078    
         andb  #$FE      
         stb   5,y       
L541F    ldd   1,y        If this code is legit, why load D? just A?
         bpl   L5426     
         inc   <u0075    
         nega            
L5426    cmpa  #3        
         bls   L5457     
         ldb   #$9A       (154)
         mul             
         lsra            
         nop              WHY ARE THESE HERE?
         nop             
         tfr   a,b       
         tst   <u0075    
         beq   L5437     
         negb            
L5437    stb   <u0079    
         cmpa  #$13      
         bls   L544A     
         pshs  a         
         leau  >L513E,pc 
         lbsr  L529B     
         puls  a         
         suba  #$13      
L544A    leau  >L50E4,pc 
         deca            
         ldb   #$05      
         mul             
         leau  d,u       
         lbsr  L529B     
L5457    ldd   2,y       
         tst   1,y       
         beq   L5483     
         bpl   L546F     
L545F    lsra            
         rorb            
         ror   $04,y     
         ror   $05,y     
         ror   <u007C    
         inc   $01,y     
         bne   L545F     
         std   $02,y     
         bra   L5483     

L546F    lsl   $05,y     
         rol   $04,y     
         rolb            
         rola            
         rol   <u007B    
         dec   $01,y     
         bne   L546F     
         std   $02,y     
         inc   <u0079    
         lda   <u007B    
         bsr   L54EA     
L5483    ldd   $02,y     
         ldu   $04,y     
L5487    clr   <u007B    
         bsr   L54F1     
         std   $02,y     
         stu   $04,y     
         pshs  a         
         lda   <u007B    
         sta   <u007C    
         puls  a         
         bsr   L54F1     
         bsr   L54F1     
         exg   d,u       
         addd  $04,y     
         exg   d,u       
         adcb  $03,y     
         adca  $02,y     
         pshs  a         
         lda   <u007B    
         adca  <u007C    
         bsr   L54EA     
         lda   <u0076    
         cmpa  #$09      
         puls  a         
         beq   L54C1     
         cmpd  #$0000    
         bne   L5487     
         cmpu  #$0000    
         bne   L5487     
L54C1    sta   ,y        
         lda   <u0076    
         cmpa  #$09      
         bcs   L54E2     
         ldb   ,y        
         bpl   L54E2     
L54CD    lda   ,-x       
         inca            
         sta   ,x        
         cmpa  #$39      
         bls   L54E2     
         lda   #$30      
         sta   ,x        
         cmpx  ,s        
         bne   L54CD     
         inc   ,x        
         inc   <u0079    
L54E2    lda   #$09      
L54E4    sta   <u0076    
         leay  6,y       
         puls  pc,u,x    

L54EA    ora   #$30      
         sta   ,x+       
         inc   <u0076    
         rts             

L54F1    exg   d,u       
         lslb            
         rola            
         exg   d,u       
         rolb            
         rola            
         rol   <u007B    
         rts             

L54FC    pshs  y,x       
         ldx   <u0080    
         stx   <u0082    
         lda   #$01      
         sta   <u007D    
         ldy   #$0100    
         lda   <u007F    
         os9   I$ReadLn  
         bra   L5524     

L5511    pshs  y,x       
         ldd   <u0082    
         subd  <u0080    
         beq   L5528     
         tfr   d,y       
         ldx   <u0080    
         stx   <u0082    
         lda   <u007F    
         os9   I$WritLn  
L5524    bcc   L5528     
         stb   <u0036     Save error code
L5528    puls  pc,y,x    

L552A    pshs  u,x       
         lda   ,y        
         cmpa  #$02      
         beq   L5536     
         ldu   $01,y     
         bra   L553D     

L5536    lda   $01,y     
         bgt   L5542     
         ldu   #$0000    
L553D    ldx   #$0000    
         bra   L555E     

L5542    ldx   $02,y     
         ldu   $04,y     
         suba  #$20      
         bcs   L554F     
         ldb   #$4E      
         coma            
         bra   L5565     

L554F    exg   x,d       
         lsra            
         rorb            
         exg   d,u       
         rora            
         rorb            
         exg   d,x       
         exg   x,u       
         inca            
         bne   L554F     
L555E    lda   <u007F    
         os9   I$Seek    
         bcc   L5567     
L5565    stb   <u0036     Save error code
L5567    puls  pc,u,x    

L5569    pshs  u,x       
         leas  -$0A,s    
         leax  ,s        
         lbsr  L53F3     
         pshs  x         
         lda   #$09      
         leax  9,x       
L5578    ldb   ,-x       
         cmpb  #$30      
         bne   L5583     
         deca            
         cmpa  #$01      
         bne   L5578     
L5583    sta   <u0076    
         puls  x         
         ldb   <u0079    
         bgt   L55AC     
         negb            
         tfr   b,a       
         cmpb  #$09      
         bhi   L55C6     
         addb  <u0076    
         cmpb  #$09      
         bhi   L55C6     
         pshs  a         
         lbsr  L5643     
         clra            
         bsr   L5612     
         puls  b         
         tstb            
         beq   L55A8     
         lbsr  L5634     
L55A8    lda   <u0076    
         bra   L55BF     

L55AC    cmpb  #$09      
         bhi   L55C6     
         lbsr  L5643     
         tfr   b,a       
         bsr   L5601     
         bsr   L5612     
         lda   <u0076    
         suba  <u0079    
         bls   L55C1     
L55BF    bsr   L5601     
L55C1    leas  $0A,s     
         clra            
         puls  pc,u,x    

L55C6    bsr   L5643     
         lda   #$01      
         bsr   L5601     
         bsr   L5612     
         lda   <u0076    
         deca            
         bne   L55D4     
         inca            
L55D4    bsr   L5601     
         bsr   L55DA     
         bra   L55C1     

L55DA    lda   #$45      
         bsr   L5614     
         lda   <u0079    
         deca            
         pshs  a         
         bpl   L55EB     
         neg   ,s        
         bsr   L5647     
         bra   L55ED     

L55EB    bsr   L564B     
L55ED    puls  b         
         clra            
L55F0    subb  #$0A      
         bcs   L55F7     
         inca            
         bra   L55F0     

L55F7    addb  #$0A      
         bsr   L55FD     
         tfr   b,a       
L55FD    adda  #$30      
         bra   L5614     

L5601    tfr   a,b       
         tstb            
         beq   L560D     
L5606    lda   ,x+       
         bsr   L5614     
         decb            
         bne   L5606     
L560D    rts             

L560E    lda   #$20      
         bra   L5614     

L5612    lda   #$2E      
L5614    pshs  u,a        Preserve regs
         leau  <-$40,s    Is stack within 64 bytes of curr. pos in temp buff
         cmpu  <u0082    
         bhi   L562A      No, skip ahead
         cmpa  #C$CR      Is char we want added a CR?
         beq   L562A      Yes, skip ahead
         lda   #$50       ??? Error code 80? (internal flag byte?)
         sta   <u0036     ??? Save error code 80?
         sta   <u00DE     Save here too
         puls  pc,u,a     Restore regs & return

L562A    ldu   <u0082     Get current pos in temp buffer
         sta   ,u+        Save char there
         stu   <u0082     Save new current pos in temp buffer
         inc   <u007D     Inc # active chars in temp buffer
L5632    puls  pc,u,a     Restore regs & return

L5634    lda   #$30      
L5636    tstb             Any chars left to do?
         beq   L563E      No, exit
L5639    bsr   L5614      Save char (check for size within 64 of stack?)
         decb             Done all chars?
         bne   L5639      No, keep adding chars
L563E    rts             

L563F    tst   <u0078    
         beq   L560E     
L5643    tst   <u0078    
         beq   L563E     
L5647    lda   #$2D      
         bra   L5614     

L564B    lda   #$2B      
         bra   L5614     

L564F    lda   #C$SPAC    Space is fill char
         bra   L5636      Go add B # of spaces to temp buffer

L5653    bsr   L5614     
L5655    lda   ,x+       
         cmpa  #$FF      
         bne   L5653     
         rts             

L565C    pshs  x         
         ldx   1,y       
L5660    bsr   L5655     
         clra            
         puls  pc,x      

L5665    pshs  x         
         leax  >L5143,pc 
         lda   2,y       
         bne   L5660     
         leax  >L5148,pc 
         bra   L5660     

L5675    pshs  u,x       
         leas  -5,s      
         leax  ,s        
         lbsr  L53AA     
         bsr   L5643     
         lda   <u0076    
         leax  ,s        
         lbsr  L5601     
         leas  5,s       
         clra            
         puls  pc,u,x    

* <u002A Function 2, sub-function $10 - Add B spaces to temp buffer
* Entry: A=# spaces to append to temp buffer
L568C    tfr   a,b        Move byte we are working with to B
L568E    pshs  u          Preserve U
         ldu   <u0082     Get ptr to current pos in temp buffer
         subb  <u007D     Callers # - # chars active in temp buffer
         bls   L5698      If 0 or wraps negative, skip ahead
         bsr   L564F      Go add chars
L5698    clra             No error?
         puls  pc,u       Restore U & return

L569B    lbsr  L560E     
L569E    lda   <u007D    
         anda  #$0F      
         cmpa  #$01      
         beq   L56B2     
         lbsr  L560E     
         bra   L569E     

L56AB    lda   #C$CR     
         clr   <u007D    
         lbsr  L5614     
L56B2    clra            
         rts             

L56B4    pshs  u         
         lda   #$04      
         leau  ,y        
         tst   ,u        
         bne   L56C1     
         asra            
         leau  1,u       
L56C1    sta   <u0086    
         tfr   a,b       
         asrb            
         lbsr  L585D     
         puls  pc,u      

L56CB    clrb            
         stb   <u0087    
         cmpa  #$3C      
         beq   L56DE     
         cmpa  #$3E      
         bne   L56D9     
         incb            
         bra   L56DE     

L56D9    cmpa  #$5E      
         bne   L56E2     
         decb            
L56DE    stb   <u0087    
         lda   ,x+       
L56E2    cmpa  #$2C      
         beq   L571E     
         cmpa  #$FF      
         bne   L56FC     
         lda   <u0094    
         beq   L56F2     
         leax  -$01,x    
         bra   L5707     

L56F2    ldx   <u008E    
         tst   <u00DC    
         beq   L5700     
         clr   <u00DC    
         bra   L571E     

L56FC    cmpa  #$29      
         beq   L5703     
L5700    orcc  #$01      
         rts             

L5703    lda   <u0094    
         beq   L5700     
L5707    dec   <u0092    
         bne   L571C     
         ldu   <u0046    
         pulu  y,a       
         sta   <u0092    
         sty   <u0090    
         stu   <u0046    
         lda   ,x+       
         dec   <u0094    
         bra   L56E2     

L571C    ldx   <u0090    
L571E    stx   <u008C    
         andcc  #$FE      
         rts             

* Print USING format specifiers
L5723    fcc   'I'        Integer
         fdb   L5802-L5723
L5726    fcc   'H'        Hexidecimal
         fdb   L5802-L5726
L5729    fcc   'R'        Real
         fdb   L57F8-L5729
L572C    fcc   'E'        Exponential
         fdb   L57F8-L572C
L572F    fcc   'S'        String
         fdb   L5802-L572F
L5732    fcc   'B'        Boolean
         fdb   L5802-L5732
L5735    fcc   'T'        Tab
         fdb   L573F-L5735
L5738    fcc   'X'        Spaces
         fdb   L574A-L5738
L573B    fcc   "'"        Quoted text
         fdb   L5755-L573B
L573E    fcb   $00        End of table marker

* 'T' (tab)
L573F    bsr   L56E2     
         bcs   L57A7     
         ldb   <u0086    
         lbsr  L568E     
         bra   L5772     

* 'X' (spaces)
L574A    bsr   L56E2     
         bcs   L57A7     
         ldb   <u0086    
         lbsr  L564F     
         bra   L5772     

* '' (quoted text)
L5755    cmpa  #$FF       End of string?
         beq   L57A7      Yes, skip ahead
         cmpa  #$27       A single quote (')?
         bne   L5765      No, skip ahead
         lda   ,x+       
         bsr   L56E2     
         bcs   L57A7     
         bra   L5772     

L5765    lbsr  L5614     
         lda   ,x+       
         bra   L5755     

L576C    pshs  y,x       
         clr   <u00DC    
         inc   <u00DC    
L5772    ldx   <u008C    
         bsr   L57C2     
         bcs   L5791     
         cmpa  #'(        Repeat char?
         bne   L57AB     
         lda   <u0092    
         stb   <u0092    
         beq   L57AB     
         inc   <u0094    
         ldu   <u0046    
         ldy   <u0090    
         pshu  y,a       
         stu   <u0046    
         stx   <u0090    
         lda   ,x+       
L5791    leay  <L5723,pc  Point to start of specifiers table
         clrb             Init Specifier # to 0
L5796    pshs  a          Preserve original char
         eora  ,y         Flip any differing bits
         anda  #$DF       Mask out uppercase bit
         puls  a          Restore original char
         beq   L57B2      If char matches, skip ahead
         leay  3,y        Point to next table entry
         incb             Bump up specifier #
         tst   ,y         Are we at the end?
         bne   L5796      Nope, keep looking
L57A7    ldb   #$3F       I/O Format Syntax Error
         bra   L57AD      Exit with error

L57AB    ldb   #$3E      

L57AD    stb   <u0036     Save error code
         coma             Set carry
         puls  pc,y,x     Restore regs & return

* Found specifier match
L57B2    stb   <u0085     Save specifier #
         ldd   1,y        Get offset
         leay  d,y        Add to base address
         bsr   L57C2      Get up to 3 digit ASCII #'s, convert to binary
         bcc   L57BE      Got it, skip ahead
         ldb   #$01       None found, force to 1
L57BE    stb   <u0086     Save binary version of number
         jmp   ,y         Execute PRINT USING specifier routine

* Convert 3 digit ASCII decimal # @ ,X to binary equivalent. Carry clear if
* done, carry set if not ASCII decimal digits present
L57C2    bsr   L57DC      Go try & get ASCII number 0-9
* NOTE: 6809/6309 MOD, CHANGE TO BCS TO RTS, NOT ORCC/RTS
         bcs   L57ED      None found, Set carry & exit
         tfr   a,b        Move binary digit 0-9 to B
         bsr   L57DC      Try & get another ASCII number 0-9
         bcs   L57E8      Couldn't, exit with carry clear anyways
         bsr   L57EE      Convert 2 digit # into binary version (D)
         bsr   L57DC      Try & get another ASCII number 0-9
         bcs   L57E8      Couldn't, exit with carry clear anyways
         bsr   L57EE      Convert this digit & add to previous total
         tsta             result <255? (useless, ADCA should set flags)
         beq   L57D8      Yes, get next char & exit with carry clear
         clrb             Force result to 256
L57D8    lda   ,x+        Get next char
         bra   L57E8      Exit with carry clear

L57DC    lda   ,x+        Get char
L57DE    cmpa  #'0        If not ASCII 0-9, exit with carry set
         blo   L57ED      (Same as BCS)
         cmpa  #'9       
         bhi   L57EB     
         suba  #$30       If it is 0-9, convert to binary & exit with
L57E8    andcc  #$FE       carry clear
         rts             

L57EB    orcc  #$01      
L57ED    rts             

* Entry: A=LSB of ASCII 0-9 converted to binary, B=MSB
* IF NOT CALLED BY OTHER ROUTINES USING IT, MAY WANT TO USE DP LOCATION 14
* INSTEAD OF STACK
L57EE    pshs  a          Save Low nibble?
         lda   #10        Multiply B by 10
         mul             
         addb  ,s+        Add to saved nibble
         adca  #$00       possible carry into D
         rts             

L57F8    cmpa  #'.       
         bne   L57A7     
         bsr   L57C2     
         bcs   L57A7     
         stb   <u0089    

L5802    lbsr  L56CB     
         bcs   L57A7     
         puls  y,x       
         inc   <u00DC    
L580B    ldb   <u0085    
         lbeq  L58B3     
         decb            
         beq   L5826     
         decb            
         lbeq  L5969     
         decb            
         lbeq  L5A10     
         decb            
         lbeq  L591E     
         lbra  L5904     

L5826    jsr   <u0016    
         cmpa  #4         Numeric?
         blo   L583C      Yes, skip ahead
         ldu   1,y        Get ptr to string data
         clrb             Clear count=0
L582F    lda   ,u+        Get char from string
         cmpa  #$FF       EOS?
         beq   L5838      Yes, skip ahead
         incb             Bump up count
         bne   L582F      Do until EOS or 256 chars
L5838    ldu   1,y        Get string ptr again
         bra   L585D      Skip ahead with U=ptr to string, B=size of string

L583C    leau  1,y       
         lda   ,y         Get var type
         cmpa  #2         Real #?
         bne   L5848      No, skip ahead
         ldb   #5         Yes, force size to 5 bytes
         bra   L585D     

L5848    cmpa  #1         Integer?
         bne   L5852      No, skip ahead
         ldb   #2         Yes, size=2 bytes
         cmpb  <u0086     Same or less than ???
         blo   L5856      Yes, leave as 2
L5852    ldb   #1         Anything else (BYTE/BOOLEAN) is 1 byte
         leau  1,u       
L5856    tfr   b,a       
         lsla            
         cmpa  <u0086    
         bhi   L5893     
L585D    tst   <u0087    
         beq   L5889     
         bmi   L5870     
         pshs  b         
         lslb            
         pshs  b          SUBR
         ldb   <u0086    
         subb  ,s+       
         blo   L5887     
         bra   L587C     

L5870    pshs  b         
         lslb            
         pshs  b         
         ldb   <u0086    
         subb  ,s+       
         bcs   L5887     
         asrb            
L587C    pshs  b         
         lda   <u0086    
         suba  ,s+       
         sta   <u0086    
         lbsr  L564F     
L5887    puls  b         
L5889    lda   ,u        
         lsra            
         lsra            
         lsra            
         lsra            
         bsr   L58A3     
         beq   L58A1     
L5893    lda   ,u+       
         bsr   L58A3     
         beq   L58A1     
         decb            
         bne   L5889     
         ldb   <u0086    
         lbsr  L564F     
L58A1    clra            
         rts             

L58A3    anda  #$0F      
         cmpa  #$09      
         bls   L58AB     
         adda  #$07      
L58AB    lbsr  L55FD     
         dec   <u0086    
         rts             

L58B1    coma            
         rts             

L58B3    jsr   <u0016    
         cmpa  #$02      
         bcs   L58BE     
         bne   L58B1     
         lbsr  L5098     
L58BE    pshs  u,x       
         leas  -5,s      
         leax  ,s        
         lbsr  L53AA     
         ldb   <u0086    
         decb            
         subb  <u0076    
         bpl   L58D5     
         leas  5,s       
         puls  u,x       
         lbra  L5A07     

L58D5    tst   <u0087    
         beq   L58E3     
         bmi   L58F4     
         lbsr  L564F     
         lbsr  L563F     
         bra   L58FA     

L58E3    lbsr  L563F     
         pshs  b         
         lda   <u0076    
         lbsr  L5601     
         puls  b         
         lbsr  L564F     
         bra   L58FF     

L58F4    lbsr  L563F     
         lbsr  L5634     
L58FA    lda   <u0076    
         lbsr  L5601     
L58FF    leas  5,s       
         clra            
         puls  pc,u,x    

L5904    jsr   <u0016     Go get var type
         cmpa  #3         Boolean?
         bne   L58B1      No, set carry & exit
         pshs  u,x        Preserve regs
         leax  >L5143,pc  Point to 'True'
         ldb   #4         Size of 'True'
         lda   2,y        Get boolean value
         bne   L5932      $FF is true, so skip ahead
         leax  >L5148,pc  Point to 'False'
         ldb   #5         Size of 'False'
         bra   L5932      Go deal with it

L591E    jsr   <u0016     Go get var type
         cmpa  #4         String?
         bne   L58B1      No, exit with carry set
         pshs  u,x        Preserve regs
         ldx   1,y        Get ptr to string
         ldd   <u0048    
         subd  1,y       
         subd  #1        
         tsta            
         bne   L5936     
L5932    cmpb  <u0086    
         bls   L5938     
L5936    ldb   <u0086    
L5938    tfr   b,a       
         negb            
         addb  <u0086    
         tst   <u0087    
         beq   L594F     
         bmi   L5953     
         pshs  a         
         lbsr  L564F     
         puls  a         
         lbsr  L5601     
         bra   L5966     

L594F    pshs  b         
         bra   L595E     

L5953    lsrb            
         bcc   L5957     
         incb            
L5957    pshs  d         
         lbsr  L564F     
         puls  a         
L595E    lbsr  L5601     
         puls  b         
         lbsr  L564F     
L5966    clra            
         puls  pc,u,x    

L5969    jsr   <u0016     Go get var type
         cmpa  #2         Real?
         beq   L5976      Yes, skip ahead
         lbcc  L58B1      If carry clear, set carry & exit
         lbsr  L509B      ??? possible convert?
L5976    pshs  u,x       
         leas  -$0A,s    
         leax  ,s        
         lbsr  L53F3     
         lda   <u0079    
         cmpa  #$09      
         bgt   L5996     
         lbsr  L5A6A     
         lda   <u0086    
         suba  #$02      
         bmi   L5996     
         suba  <u0089    
         bmi   L5996     
         suba  <u008A    
         bpl   L599C     
L5996    leas  $0A,s     
         puls  u,x       
         bra   L5A07     

L599C    sta   <u0088    
         leax  ,s        
         ldb   <u0087    
         beq   L59AC     
         bmi   L59B2     
         bsr   L59E9     
         bsr   L59BE     
         bra   L59B9     

L59AC    bsr   L59BE     
         bsr   L59E9     
         bra   L59B9     

L59B2    bsr   L59E9     
         bsr   L59C1     
         lbsr  L563F     
L59B9    leas  $0A,s     
         clra            
         puls  pc,u,x    

L59BE    lbsr  L563F     
L59C1    lda   <u008A    
         lbsr  L5601     
         lbsr  L5612     
         ldb   <u0079    
         bpl   L59F9     
         negb            
         cmpb  <u0089    
         bls   L59D4     
         ldb   <u0089    
L59D4    pshs  b         
         lbsr  L5634     
         ldb   <u0089    
         subb  ,s+       
         stb   <u0089    
         lda   <u008B    
         cmpa  <u0089    
* 6809/6309 MOD: SHOULD BE BLS L59FB
         bls   L59E7     
         lda   <u0089    
L59E7    bra   L59FB     

L59E9    ldb   <u0088    
         lbra  L564F     

L59EE    lbsr  L563F     
         lda   <u008A    
         lbsr  L5601     
         lbsr  L5612     
L59F9    lda   <u008B    
L59FB    lbsr  L5601     
         ldb   <u0089    
         subb  <u008B    
         ble   L5A0F     
         lbra  L5634     

L5A07    ldb   <u0086    
         lda   #$2A       * (?)
         lbsr  L5636     
         clra            
L5A0F    rts             

L5A10    jsr   <u0016     Go get variable type
         cmpa  #2         Real?
         beq   L5A1D      Yes, skip ahead
         lbcc  L58B1      If carry clear, set carry & exit
         lbsr  L509B      ??? Convert to real?
L5A1D    pshs  u,x       
         leas  -$0A,s    
         leax  ,s        
         lbsr  L53F3     
         lda   <u0079    
         pshs  a         
         lda   #1        
         sta   <u0079    
         bsr   L5A6A     
         puls  a         
         ldb   <u0079    
         cmpb  #1        
         beq   L5A39     
         inca            
L5A39    ldb   #1        
         stb   <u008A    
         sta   <u0079    
         lda   <u0086    
         suba  #6        
         bmi   L5A4D     
         suba  <u0089    
         bmi   L5A4D     
         suba  <u008A    
         bpl   L5A53     
L5A4D    leas  $0A,s     
         puls  u,x       
         bra   L5A07     

L5A53    sta   <u0088    
         ldb   <u0087    
         beq   L5A62     
         bsr   L59E9     
         bsr   L59EE     
         lbsr  L55DA     
         bra   L5A67     

L5A62    bsr   L59EE     
         lbsr  L55DA     
L5A67    lbra  L59B9     

L5A6A    pshs  x          Save ptr to beginning of string number
         lda   <u0079    
         adda  <u0089    
         bne   L5A78     
         lda   ,x        
         cmpa  #$35      
         bcc   L5A8F     
L5A78    deca            
         bmi   L5AAB     
         cmpa  #$07      
         bhi   L5AAB     
         leax  a,x       
         ldb   1,x       
         cmpb  #$35      
         blo   L5AAB     
L5A87    inc   ,x         Inc ASCII digit
         ldb   ,x         Get digit
         cmpb  #'9        Past 9?
         bls   L5AAB      No, skip ahead
L5A8F    ldb   #'0        Wrap to 0
         stb   ,x        
         leax  -1,x       Bump ptr back
         cmpx  ,s         Hit beginning of text string yet?
         bhs   L5A87      No, loop back & continue
         ldx   ,s         Get beginning of text string ptr
         leax  8,x        Point 8 bytes past start
L5A9D    lda   ,-x        Block move bytes from 0-6 to 1-7
         sta   1,x       
         cmpx  ,s         Done moving?
         bhi   L5A9D      No, keep going until done
         lda   #'1        Force 1st digit to 1
         sta   ,x        
         inc   <u0079    
L5AAB    puls  x          Get string ptr back
         lda   <u0079    
         bpl   L5AB2     
         clra            
L5AB2    sta   <u008A    
         nega            
         adda  #$09      
         bpl   L5ABA     
         clra            
L5ABA    cmpa  <u0089    
         bls   L5AC0     
         lda   <u0089    
L5AC0    sta   <u008B    
         rts             

L5AC3    ldb   #48        Unimplemented routine error
         stb   <u0036     Save error code
         coma             Exit with error
         rts             

         emod            
eom      equ   *         
         end             
