GROM6000
     LOADER
     USERS
+++++
    TITLE   GROM
***
EDTTOP EQU  >FFD8->8300     TOP MEMORY FOR EDITOR(REAL GROM)
*EDTTOP EQU  >FBF0->8300     TOP MEMORY FOR EDITOR(DEBUGGER)
************************************************************
*   STANDALONE EDITOR & ASSEMBLER FOR 99/4                 *
************************************************************
************************************************************
************************************************************
*   USE GCA COMMAND ON THE FOLLOWING FILES                 *
*   GCA FILE NAME              SD2.ASSM.SRC.GCA
*                                                          *
*   OUT PUT FILE NAME IS       SD2.ASSM.OBJ.GROM           *
*   TO LIST WHOLE GPL CODE     SD2.ASSM.LST.GROM
*                                                          *
*   CONCATINATE LOADER TO THIS GPL OBJECT FILE             *
*                              SD2.ASSM.OBJ.GROM           *
*                              SD2.ASSM.OBJ.ALUTIL         *
*                  OUTPUT FILE SD2.ASSM.OBJ.ASSMBLR        *
*                                                          *
*   AUTHOR SUMIKO ENDO    September 1981                   *
************************************************************
****
*   EQUATES
*
*   XML EQUATES
*
LOADX  EQU  >21       EXECUTE LOADER
SAVEX  EQU  >22       EXECUTE SAVE ROUTINE
EDITX  EQU  >23       EXECUTE EDITOR
*
ASM    EQU  >21       EXECUTE ASSEMBLER
*
ALSUP  EQU  >21       EXECUTE ASSEMBLY LANGUAGE CODE
TGOBLD EQU  >22       TAGGED OBJECT LOADER.
*
*   INTERFACE WITH BASIC
*
RPL    EQU  >0012       RETURN TO BASIC MAIN PROGRAM.
*
*   GENERAL EQUATES
*
OFFSET EQU  >8300       EQUATE FOR ACCESSING E-RAM
RAMTOP EQU  >2000-OFFSET ONE LOCATION IN EXPANSION MEMORY
IDCODE EQU  >2000-OFFSET ID CODE FOR EDITOR, ASSM, LOADER
CURSOR EQU  >1F         CHARACTER NUMBER FOR CURSOR
CHAR2$ EQU  >18         CHARACTER TABLE ADDRESS IN MONITOR
CHAR3$ EQU  >4A         LOWER CASE CHARACTERS
SPACE  EQU  >20         SPACE CHARACTER.
DSRLNK EQU  >10         LINK TO DSR ROUTINE.
*
*   EQUATES FOR PERIPHERAL ACCESS BOCK
*
PABLEN EQU  >0A         PAB LENGTH. STANDARD
SCREEN EQU  >00         SCREEN OFFSET FOR PAB
MAXLEN EQU  60         MAXIMUM LENGTH OF FILE NAME
PAB1   EQU  >1000      PAB ADDRESS USED FOR ALL FILE TRANSITION.
BUF1   EQU  >1080      BUFFER FOR PAB1
PAB2   EQU  >1100      Second PAB
BUF2   EQU  >1180      Second BUFFER
PAB3   EQU  >1200      Third PAB
BUF3   EQU  >1280      Third BUFFER
PAB4   EQU  >1300      Fourth PAB for COPY statement
BUF4   EQU  >1380      Buffer also used to load progrm file
*
*   CPU RAM EQUATES
*
TEMP   EQU  >00         Temporary storage area
TEMP2  EQU  >02
TEMP3  EQU  >03
TEMP4  EQU  >04
*
DSR    EQU  >10         6 bytes temp loc for general load routine.
CHRBUF EQU  >18         Char buffer for blinking cursor
*
SREF   EQU  >1C         Pointing to the PAB start address.
FLG    EQU  01          Flag and status byte
BUF    EQU  02          Buffer address
LEN    EQU  04          Length of record
CHRCNT EQU  05          Character count
RNM    EQU  06          Record number
SCR    EQU  08          SCREEN OFFSET
NLEN   EQU  09          Name length
*
LOC    EQU  >20         Location of a cursor
ERRCOD EQU  >22         Error ID code
STLN   EQU  >24         Original cursor address
ENDLN  EQU  >26         Adress of the end of input
*
FLAG   EQU  >48         Flag bytes
INSRT  EQU  0           Bit 0 for insert mode.
VFLG   EQU  0           Bit 0 for peek or poke to VDP RAM
TP     EQU  1           Bit 1 on = Thermal printer is used
NOTHIN EQU  2           BIT 2 ON = NO INPUT LINE IS ACCEPTED.
BSC    EQU  3           Bit 3 on = Called from BASIC program.
*COMP   EQU  4          Bit for compressed source file
ASRC   EQU  5           Bit 5 on = Source file is specified
AOBJ   EQU  6           Bit 6 on = Object file is specified
ALST   EQU  7           Bit 7 on = list file is specified
*
FLAG2  EQU  >49
LD     EQU  0           Bit 0 on = loader is being executed
VAR    EQU  1           Bit 1 on = save with var 80 format
*EDT    EQU  2           Bit 2 on = Error in editor
OTHR   EQU  3           Bit 3 on = Flag for "other" program
*ETOP   EQU  4           BIT 4 ON = EDITOR MEMORY WRITTEN OVER
GPL    EQU  5           Bit 5 on = GPL program is called from ALC
LDUTIL EQU  6           Bit 6 on = first load during LOAD & RUN
*
FAC    EQU  >4A
FAC2   EQU  FAC+2
FAC4   EQU  FAC+4
FAC6   EQU  FAC+6
FAC10  EQU  FAC+10
FAC12  EQU  FAC+12
ARG    EQU  >5C         Used in conversion of int to float
*
*      STANDARD EQUATES FOR GPL INTERPRETER
*
MEMLEN EQU  >70
SUBSTK EQU  >73         Subroutine stack pointer.
KEYBRD EQU  >74         Keyboard number to scan.
KEY    EQU  >75
ETR    EQU  >0D         key code for enter.
BACK   EQU  >0F         key code for going back.
JOYY   EQU  >76
JOYX   EQU  >77
RANDOM EQU  >78
TIMER  EQU  >79
MPC    EQU  >7A
STATUS EQU  >7C
*
******
*
       GROM    3
       ORG     0
       DATA    >AA
       DATA    1,1,0,#0,#PROG
       DATA    #0,#LINK01,#0,#0
PROG   DATA    #0,#BEGIN
       DATA    16,:EDITOR/ASSEMBLER:
******
***
******
****
***********************************************************
*      USER INTERFACE                                     *
***********************************************************
***********************************************************
*      BEGIN -- First entry point                         *
***********************************************************
BEGIN
       DCLR @IDCODE           CLEAR ALL FILES IN MEMORY
****
*      Initilazation section
*      Color >F5 (color table 0 through 12), blue screen
*      Define VDP registers, load character sets,
*      No motion and no sprites
****
*
BEGIN2
       CALL COLOR            Load color table
       ST   5,@KEYBRD        Scan keyboard 5.
       SCAN                  Enable keyboard for /4A
       $IF @KEYBRD .EQ. 0 THEN  MUST BE 4A KEYBOARD
         DST  >B00,@FAC
         CALL CHAR3$         Load lower case character
       $SELSE
         DST >A00,@FAC
         CALL CHAR2$         Load semi-lower character
         DST >B00,@FAC       First character definition
CHRLP    ST   >C0,RAM(@FAC)  Place two dots for lower case
         DADD 8,@FAC
         $IF @FAC .DL. >C00 GOTO CHRLP  Fix next character
       $END IF
       CLR  @KEYBRD          Scan standard keyboard
*
       DST  >900,@FAC        Load small characters.
       CALL CHAR2$
       CLR  RAM(>800)        Clean up TI logo stuff.
       MOVE >FF FROM RAM(>800) TO RAM(>801)
*
*
       MOVE 7 FROM ROM(#VDPRG2) TO VDP(1)  SET UP VDP REGISTER.
*      CHCEK IF ERAM EXISTS
       CALL BUG1             Fix the bug
*
       MOVE 16 FROM ROM(#CDATA) TO CHAR(>1E) LOAD CURSOR CHARS
*
***********************************************************
*      START -- Second entry point                        *
***********************************************************
START
****
*****
*      Initial screen to select editor, assembler, loader
****
       ST   >7E,@SUBSTK      Adjust subroutine stack pointer
       DCLR @ERRCOD          Clear error code
       DCLR @FLAG            Clear all flags
       UNLM
       ALL  SPACE
       FMT  XPT=2,YPT=1,':* EDITOR/ASSEMBLER * :';
            2^,11<,':PRESS:::',1^,27<;
            ':1 TO EDIT:',1^,23<;
            ':2    ASSEMBLE:',1^,19<;
            ':3    LOAD AND RUN:',1^,15<;
            ':4    RUN:',24<,1^;
            ':5    RUN PROGRAM FILE:',6^,11<;
            '>A',':1981  TEXAS INSTRUMENTS:'
       LISTM
SCAN10 SCAN
       BR   SCAN10
       $IF @KEY .EQ. BACK THEN
         EXIT
       $END
       SUB  >31,@KEY                   Convert from ASCII
       $IF @KEY .HE. 5 GOTO SCAN10     Check input range
       CASE @KEY
       BR   EDIT                       Load a file
       BR   ASSEM                      Save a file
       BR   LOAD                       Temp edit address
       BR   RUN                        assemble a file
       BR   OTHER                      Run other program
       PAGE
*
***********************************************************
*      SCREEN FOR EDITOR                                  *
***********************************************************
****
EDIT
       UNLM
       CALL COLOR       Reload color table
       DCLR @FLAG
       FMT  XPT=2,YPT=2,':* EDITOR *:',1^,22<;
            ':PRESS:::',1^,28<;
            ':1 TO LOAD:',1^,23<;
            ':2    EDIT:',1^,23<;
            ':3    SAVE:',1^,23<;
            ':4    PRINT:',1^,22<;
            ':5    PURGE:',1^,22<
       LISTM
       DCLR  @FLAG           Clear all flags
       ST    >7E,@SUBSTK     Reset subroutine stack
       DST  >C2,@LOC         Put a marker.
*
SCAN70 SCAN
       BR   SCAN70
       $IF @KEY .EQ. BACK GOTO START
       SUB  >31,@KEY
       $IF @KEY .HE. 5 GOTO SCAN70
*                            Put a marker in the right place.
       ST   @KEY,@TEMP
       MUL  >40,@TEMP
       DADD @TEMP,@LOC
       ST   CURSOR,RAM(@LOC)
*
       ST   @KEY,@TEMP4      Keep the key information
**************************************************
*      CODE FOR PURGE INSTRUCTION                *
**************************************************
       $IF @KEY .EQ. 4 THEN
         FMT  2^,':ARE YOU SURE(Y/N)? :'
         CALL YORN
         $IF @KEY .EQ. :Y: THEN
           CALL CLRTOP         Clear top of memory for editor
         $END IF
         BR  EDIT
       $END IF
**************************************************
*      Take care of SAVE, PRINT, EDIT            *
**************************************************
       $IF @KEY .EQ. 3 GOTO OPEN  IF PRINT, DO NOT LOAD EDITOR
*
*   Load editor
*      Check if editor is already there(temporary)
       $IF @IDCODE .DEQ. >55AA GOTO OPEN
*      LOAD EDITOR
       CALL DOWNLD      CALL DOWN LOADER
       DATA #EDNAME
       CALL DOWN10      LOAD IT DOWN.
       CALL CLRTOP            CLEAR EDITOR INFORMATION
*
*
OPEN
       $IF @TEMP4 .EQ. 1 GOTO EEDIT GO TO EDITOR
*      CHECK FOR VARIABLE 80 IN CASE OF SAVE
       $IF @TEMP4 .EQ. 2 THEN          SAVE FILE
         FMT XPT=2,YPT=18,':VAR 80 FORMAT(Y/N)? :'
         CALL YORN      GET YES OR NO ANSWER
         $IF @KEY .EQ. :Y: THEN
           SB  @FLAG2,VAR    SET VARIABLE FORMAT FLAG
         $END IF
         $IF @KEY .EQ. BACK GOTO EDIT  GO BACK TO EDIT SCREEN
         DST  >282,@LOC      ADJUST THE CURSOR
       $SELSE
         DST  >222,@LOC      SPECIFY CURSOR LOCATION
       $END IF
       MOVE 10 FROM ROM(#FLN) TO RAM(@LOC)
       DADD >20,@LOC         CURSOR FOR FILE NAME.
       DST  PAB1,@SREF
       CALL DSR1             Get the file name and PAB
*      PAB is all cleared. so it is in open mode.
       $IF @TEMP4 .EQ. 2 GOTO ESAVE
       $IF @TEMP4 .EQ. 3 GOTO PRINT
       $IF @TEMP4 .EQ. 0 GOTO ELOAD
***
       UNLM
FLN    DATA :FILE NAME?:
       LISTM
*****
       PAGE
****
***********************************************************
*      EDITOR - should be changed later                   *
***********************************************************
EEDIT
       XML  EDITX  Execute editor
       BS   EMSG1  Error from editor
       MOVE 1 FROM ROM(#ON) TO VDP(1)
       BR   EDIT
ON     DATA >E0
*
***********************************************************
*      ELOAD ---- routine to load a file                  *
***********************************************************
ELOAD
       CALL FIXVAR      Try to open in fix and var foramt
*
***********************************************************
*      LOADER FOR SOURCE FILES                            *
***********************************************************
***
* Note:  End of file will be checked when I/O error happens
*        while reading a record passed end-of-file.
*        See ERRIO section to see how load gets finished.
****
READ
*      FIXVAR routine places 02 in PAB area for read.
*      ST   02,RAM(@SREF)  Ready to read a record.
       XML  LOADX  XML to load routine in editor
       BS   EMSG   Loader error
       BR   EDIT   Finished.. go back
****
**************
*  Subroutine to try to oepn in fix or var 80 format
*************
FIXVAR
       ST   &00000100,RAM(FLG(SREF))   Input mode.
       RB   @FLAG2,VAR        Fix format flag is on.
LOAD2
       DST  @SREF,@FAC12
       DADD PABLEN-1,@FAC12  Set pointer to name length
       CALL DSRLNK           Open it.
       DATA 8
       BS   ERRIO            File not found
       CLOG >E0,RAM(FLG(SREF)) Check for error code.
       BR   TRY
       ST   02,RAM(@SREF)    Output mode .
       RTN                   No error, go back to the caller
TRY    ST   RAM(FLG(SREF)),@TEMP Copy flag byte
       AND  >1F,@TEMP          Delete the error code
       $IF @TEMP .EQ. 4 THEN
         ST  &00010100,RAM(FLG(SREF)) Try with variable record.
         SB  @FLAG2,VAR      Variable 80 format now.
         BR  LOAD2
       $END IF
       BR   ERRIO            Otherwise error!!!
******
************************************************************
*      SAVE SOURCE FILE                                    *
************************************************************
ESAVE
       ST   02,RAM(FLG(SREF))          Output mode
       $IF .BIT(VAR) @FLAG2 .EQ. 1 THEN
         ST  >12,RAM(FLG(SREF))        Var 80 output mode
       $END IF
       CALL DSR3                       Open it.
*
       ST   03,RAM(@SREF)    Store OP code for write
       ST   80,RAM(CHRCNT(SREF)) Store character count.
*
*   Write one record at a time.
*
WRITE
       XML  SAVEX       Execute SAVE in editor.
       BS   EMSG        SAVE error
       CALL CLOSE       Close the file
       BR   EDIT        Go back to editor screen
*
*
************************************************************
*      PRINT ROUTINE TO PRINT OUT FILES                    *
************************************************************
PRINT
       CALL FIXVAR             Open with fix or var 80 format.
*      ST   02,RAM(@SREF)      Ready for read!
*
*      Input file is defined. Now get output device
*
       UNLM
       FMT  XPT=2,YPT=21,':DEVICE NAME?:'
       LISTM
       DST  >2C2,@LOC
       DST  PAB2,@SREF         Open next file
       CALL DSR1               Get name and prepare PAB
       ST   80,RAM(CHRCNT(SREF)) Store charcter count
       $IF RAM(@FAC4) .DEQ. :TP: THEN Check which TP
         CLR  RAM(LEN(SREF)) Change logical record length
       $END IF
       ST   >12,RAM(FLG(SREF)) Open as variable 80 dsiplay
       DST  BUF1,RAM(BUF(SREF)) Forse to use same buffer area
       CALL DSR3               Open it!
       $IF RAM(LEN(SREF)) .EQ. >20 THEN Old TP!!!!
         SB  @FLAG,TP          Set a flag
       $END IF
       ST   03,RAM(@SREF)      Ready for print!
*
       $IF .BIT(TP) @FLAG .EQ. 0 GOTO FAST   RS232 case.
PRINT1
       DST  PAB1,@SREF         Now get first file
       CALL CLRBUF             Clean up buffer area
       CALL DSR3               Read one record
       DST  PAB2,@SREF         Prepare for print !!!!
*
*      Next routine checks the buffer and replace characters
*
       DST  BUF1,@TEMP       Check buffer area for CC
       DADD 79,@TEMP         Check from end of record
       ST   80,@TEMP2        Set the counter
LOOP
       ST   RAM(@TEMP),@TEMP3 Get character code.
       $IF @TEMP3 .EQ. SPACE GOTO MORE Skip space
       $IF @TEMP3 .EQ. >0C THEN  If page feed skip lines.
         ST   SPACE,RAM(@TEMP)  Put space in.
         CALL DSR3           Just skip a few lines.
         CALL DSR3
         CALL DSR3
       $END IF
       BR  PRINT2          No need to check. print out.
MORE
       DDEC @TEMP       Decrement the buffer pointer
       DEC  @TEMP2      Decrement counter
       BR   LOOP        Not passed the last loc.
**********
*      DST  PAB2,@SREF       Already specified.
PRINT2
       CALL DSR3             Call to write one line
*
*   The following section takes care of Thermal Printer case
*
       SUB >20,@TEMP2             Find how many more to move
       $IF @TEMP2 .GT. 0 THEN     More bytes to print?
         DADD >20,RAM(BUF(SREF))  Shift buffer address
         ST   @TEMP2,RAM(CHRCNT(SREF)) Put count
         B    PRINT2              Print one more line
       $END IF
       DST BUF1,RAM(BUF(SREF))    Readjust pointer
       ST  >20,RAM(CHRCNT(SREF))  Readjust character count
       BR   PRINT1           Print more line
*****
****
FAST
       DST  PAB1,@SREF        Read a record
       CALL CLRBUF            Cean up buffer
       CALL DSR3
       DST  PAB2,@SREF        Print it out
       CALL DSR3
       BR   FAST              Repeat the process
************************************************************
*      DSR PREPARATION AND CALL ROUTINES                   *
************************************************************
DSR1
       CALL CLRBUF           Clean up the PAB buffer area
DSR2
       CALL CLRPAB           Clean up PAB area
       DST  @SREF,RAM(BUF(SREF))   Find buffer address
       DADD >80,RAM(BUF(SREF))    Buffer address
       ST   SCREEN,RAM(SCR(SREF))   Screen offset
       DST  >5000,RAM(LEN(SREF))    Record length
       CALL NAME                    Get the name
     $IF @FAC6 .DNE. 0 THEN     Do not move 0 bytes.
COPYNM
       MOVE @FAC6 FROM RAM(@FAC4) TO RAM(PABLEN(SREF)) Name length
       ST   @FAC6+1,RAM(NLEN(SREF)) Put name length in PAB
     $END IF
     RTN
****
****
CLRBUF
       DADD >80,@SREF              @SREF= buffer address
       ST   SPACE,RAM(@SREF)      Clean up the PAB buffer.
       MOVE 79 FROM RAM(@SREF) TO RAM(1(SREF))
       DSUB >80,@SREF              @SREF= PAB address
       RTN
******
************************************************************
*      CLOSE A FILE                                        *
************************************************************
*
CLOSE
       ST   1,RAM(@SREF)          Store close op code.
DSR3
       DST  @SREF,@FAC12
       DADD PABLEN-1,@FAC12         Pointer to name length.
       CALL DSRLNK               Call DSR routine
       DATA 8
       BS   ERRIO                File not found
       CLOG >E0,RAM(FLG(SREF))   Any other error?
       BR   ERRIO
       RTN
*
*
****
CLRPAB
       CLR  RAM(@SREF)
       MOVE MAXLEN+9 FROM RAM(@SREF) TO RAM(1(SREF)) Clear PAB.
       RTN
******
****    Get file name from screen
*           FAC4 = points to file name in VDP
*           FAC6 = 2 bytes name length
*
NAME
       CALL SCAN50           Get user input.. file name
       DST  @STLN,@LOC       Relocate to scan file name.
       ST   MAXLEN,@TEMP     Set the counter.
       DCLR @FAC6            Clear length of file name.
SKIPSP
       $IF RAM(@LOC) .EQ. SPACE THEN   Skip spaces
         DINC  @LOC          Check next location.
         DEC   @TEMP         Decrement counter.
         BR    SKIPSP        Not finished scanning.
         DST   @STLN,@LOC    Input file name again.
         $IF .BIT(NOTHIN) @FLAG .EQ. 1 GOTO NAMEND  No input OK.
         BR    NAME          No file name on the line.
       $END IF
       DST  @LOC,@FAC4       Starting address of file name.
COUNT
       $IF RAM(@LOC) .NE. SPACE THEN
         DINC @FAC6          Increment name length.
         DINC @LOC           Look further.
         DEC  @TEMP          Decrement counter.
         BR   COUNT          Check more in the line.
       $END IF
NAMEND
       RTN
       PAGE
*******
***    SCAN ROUTINE TO INPUT FILE NAME
******
SCAN50
       ST   CURSOR,@CHRBUF   Load cursor character
       DST  @LOC,@STLN       Copy start address
       DST  @LOC,@ENDLN      Copy end address
SCAN51
       CLR  @TIMER           Set timer
       EX   RAM(@LOC),@CHRBUF  Alternate chars to blink
       $REPEAT
         SCAN
         BS  GETKEY            Scan uitil key is recongnised
       $UNTIL @TIMER .HE. 15   Wait for 6/60 of a second
       BR   SCAN51
GETKEY
       $IF RAM(@LOC) .EQ. CURSOR THEN  Key is detected
         EX  RAM(@LOC),@CHRBUF         Load cursor char back
       $SEND IF
       DST  @LOC,@TEMP                 Find length to the cursor
       DSUB @STLN,@TEMP
       $IF @KEY .L. >20 GOTO CONT02    Control keys
       TBR  @FLAG,INSRT                Check for insert mode
       BR   INS04                      Insert a character
DSP
       ST   @KEY,RAM(@LOC)      Validate the key
       $IF @LOC .DH. @ENDLN THEN
         DST  @LOC,@ENDLN       Adjust end of line
       $END IF
********
*      Cursor right
*******
RGT
       $IF @TEMP+1 .H. >MAXLEN GOTO SCAN51 No more to the right
       DINC @LOC                Shift cursor to the right
       BR   SCAN51              Go back to scan more
******
*      Handle control keys
******
CONT02
       RB   @FLAG,INSRT        Reset insert flag
       $IF @KEY .EQ. BACK THEN         *** Shift-Z
         $IF .BIT(ASRC) @FLAG .EQ. 1 GOTO ERRIO2  From asembly?
         $IF .BIT(NOTHIN) @FLAG .EQ. 1 GOTO START From exec?
         BR   EDIT
       $END IF
       $IF @KEY .EQ. >09 GOTO RGT      *** Cursor right.
       $IF @KEY .EQ. >08 THEN          *** Cusor left.
         $IF @TEMP+1 .EQ. 0 GOTO SCAN51 Can't go left any more.
         DDEC @LOC                     Move cursor to the left
         BR   SCAN51                   Go back to scan more
       $END IF
       $IF @KEY .EQ. >0D GOTO SCNEND   *** Enter line
       $IF @KEY .EQ. >03 THEN          *** Delete key
         ST  SPACE,RAM(@LOC)           Store blank
         DST @ENDLN,@TEMP              Find how many bytes to move
         DSUB @LOC,@TEMP
         $IF @TEMP+1 .LE. 0 GOTO SCAN51 Nothing to the right to move
         MOVE @TEMP FROM RAM(1(LOC)) TO RAM(@LOC) Move rest of line
         ST   SPACE,RAM(@ENDLN)        Delete last character.
         DDEC @ENDLN                   Adjust end of line
         BR   SCAN51                   Go back to scan again
       $END IF
       $IF @KEY .EQ. >04 THEN          *** Insert key
         SB @FLAG,INSRT                Turn on flag
         BR SCAN51                     Go back to scan
INS04
         DST  @ENDLN,@TEMP             Two lines filled?
         DSUB @STLN,@TEMP              Find length of file name
         $IF @TEMP+1 .H. MAXLEN GOTO SCAN51 No space to insert.
         DST  @ENDLN,@TEMP             Find bytes to move.
         DSUB @LOC,@TEMP
         DINC @TEMP                    Number of bytes to move
         MOVE @TEMP FROM RAM(@LOC) TO RAM(>3C0)  Move to temporary loc
         MOVE @TEMP FROM RAM(>3C0) TO RAM(1(LOC)) Move back.
         DINC @ENDLN                   Adjust end of line
         BR DSP                        Activate the character
       $END IF
       BR   SCAN51                     Ignore other control keys.
SCNEND
       RTN                             Finish entering name.
***
       PAGE
******
******
***
CHKRAM
       ST   @RAMTOP,@TEMP    Save data first
       ST   >FF,@RAMTOP      Try to write to ERAM to see it exists.
       $IF @RAMTOP .NE. >FF GOTO ERRRAM
       CLR  @RAMTOP          Try again with 00 to make sure.
       $IF @RAMTOP .NE. 00 GOTO ERRRAM
       ST   @TEMP,@RAMTOP    Save it back
       RTN
*                            Load UTILITY routines to ERAM.
****
COLOR
       ST   >D0,RAM(>300)    Stop sprites
       ST   >F5,RAM(>380)    LOAD COLOR TABLE
       MOVE 31 FROM RAM(>380) TO RAM(>381)
       ALL  SPACE
       BACK >F5
       RTN
****
COLOR2
       ST  >13,RAM(>380)     Change color to green
       MOVE 31 FROM RAM(>380) TO RAM(>381)
       ALL  SPACE
       BACK >F3
       RTN
****
CLRTOP
       CLR  @EDTTOP      Clear 6 bytes of top of memory in ERAM
       MOVE 5 FROM @EDTTOP TO @EDTTOP+1
       RTN
       PAGE
****
************************************************************
*      RUN OTHER PROGRAMS FROM DISKETTE                    *
************************************************************
***
OTHER
       ALL  SPACE
       FMT  XPT=2,YPT=2,':* RUN PROGRAM FILE *:'
       SB   @FLAG2,OTHR  Set bit for "other" program
*
       DST  >102,@LOC    Put file name? on screen.
       MOVE 10 FROM ROM(#FLN) TO RAM(@LOC)
       DADD >40,@LOC
       SB   @FLAG,NOTHIN
       CALL NAME        Get file name input.
*
       $IF @FAC6 .DEQ. 0 THEN Default file name UTIL
         CALL DOWNLD       Call down load program.
         DATA #UTNAME      Using DSK1.UTIL1
       $SELSE
*
         CALL DOWN02         Prepare PAB area
         CALL COPYNM         Copy name into PAB area.
         $IF RAM(@FAC4) .DEQ. :CS: THEN Cassette interface.
           ALL SPACE      Clear screen for prompt
         $END IF
       $END IF
       CALL DOWN10        Load it.
*  Following branches to >8300(@TEMP) to execute the program
       CALL COLOR2       Color for execution time
       XML  >F0          Get the first address and branch
       BS   ERRXML       In case of error
       BR   EX20         End of execution code
***
************************************************************
*      GENERAL DOWN LOAD PROGRAM                           *
************************************************************
*      First 6 bytes of the program file consists of :     *
*      1st word:  0000 if no more file to load,            *
*                 Non-zero if there is more to load        *
*      2nd word:  length of the program file               *
*      3rd word:  RAM address to load the program          *
*   These information will be stored in CPU at >8310(@DSR) *
************************************************************
*
DOWNLD
       FETCH  @DSR                    Get the file name address
       FETCH  @DSR+1
       MOVE 5 FROM ROM(@DSR) TO RAM(PAB1+15)    Copy name
DOWN02
       DCLR @TEMP               Used as XML branch address
       DST  PAB1,@SREF                          Get PAB address
       MOVE 15 FROM ROM(#LDDATA) TO RAM(@SREF)  Prepare PAB
       MOVE 20 FROM ROM(#LODMSG) TO RAM(>202)   Display message
       RTN
DOWN10
       CALL DSR3                                Load the program
       MOVE 6 FROM RAM(#BUF4) TO @DSR         Copy 6 bytes information
       $IF @TEMP .DEQ. 0 THEN   Copy address of first exec address
         DST @DSR+4,@TEMP
       $END IF
       DSUB OFFSET,@DSR+4                       Take away offset
       MOVE @DSR+2 FROM RAM(#BUF4+6) TO @0(DSR+4) Move to RAM
       $IF @DSR .DNE. 0 THEN    If there are more files to load
         DCLR @TEMP2            TENP2 = points to last char in name
         ST   RAM(PAB1+9),@TEMP2+1 Get the name length first
         DADD PAB1+9,@TEMP2     Add PAB address
         INC RAM(@TEMP2)        Change last char in name
         BR  DOWN10             Load more file
       $END IF
       ST  SPACE,RAM(>202)      Clean up the screen
       MOVE 19 FROM RAM(>202) TO RAM(>203)
       CALL CLRPAB
       RTN
LDDATA DATA 05,0,#BUF4,#0,#>2100,#10,:DSK1.:
EDNAME DATA :EDIT1:
ASNAME DATA :ASSM1:
UTNAME DATA :UTIL1:
       PAGE
****** TITLE    ASSEM
************************************************************
*      July 17, 1981      Author S.Endo                    *
************************************************************
*      ASSEMBLER                                           *
************************************************************
*****
OPTLN  EQU  >20D2-OFFSET   Option line for assembler
******
ASSEM
       ALL  SPACE
       UNLM
       FMT  XPT=2,YPT=2,':* ASSEMBLER *:'
       LISTM
*
       DCLR @FLAG            Clear all flags.
       ST   >7E,@SUBSTK      Reset subroutine stack.
       SB   @FLAG,ASRC  Now we are in assembler
*
       $IF @IDCODE .DEQ. >AA55 GOTO ASM10 It's already loaded
       UNLM
       FMT  19<,1^,':LOAD ASSEMBLER(Y/N)? :'
       LISTM
*
     CALL YORN        Get response. yes or no.
     $IF @KEY .EQ. BACK GOTO START     Back key or :n: key
     $IF @KEY .EQ. :N: GOTO START      will take you back to menu.
*****
*      LOAD ASSEMBLER HERE
*****
       CALL DOWNLD            Down load assembler
       DATA #ASNAME
       CALL DOWN10            Down load it.
************
*  Give additional space for assembler -- COPY needs this
************
ASM10
       DST  >0116,RAM(BUF4)
       DST  BUF4,@FAC12
       ST   4,@FAC2         Number of files disk DSR handles
       CALL DSRLNK          Call files
       DATA 10
************
*  START OPENING FILES HERE
************       Open a source file    ***********
       UNLM
       FMT  XPT=2,YPT=4,':SOURCE FILE NAME?     :'
       LISTM
       DST  #PAB1,@SREF      Put source PAB address.
       DST  >0C2,@LOC        Get loc for source file name.
       CALL DSR2             Prepare PAB area
*
       DST  BUF1,RAM(BUF(SREF))  Source buffer address
*      Next subroutine tries to open with fix and var format
*      ST   04,RAM(FLG(SREF))  Disp, fixed, seq, input
*      ST   >14,RAM(FLG(SREF)) Disp, variable, seq, input
       CALL FIXVAR                 Open it!!!
*
************   Open an object file     ***********
       UNLM
       FMT  XPT=2,YPT=8,':OBJECT FILE NAME?:'
       LISTM
       DST  #PAB2,@SREF      Put obj PAB address
       DST  >142,@LOC        Set file name pointer.
       CALL DSR2             Prepare PAB area
*
       ST   00,RAM(FLG(SREF)) Open with update mode
       DST  BUF2,RAM(BUF(SREF)) Buffer address.
       CALL DSR3             Open output file.
       SB   @FLAG,AOBJ       Flag for obj file open
*
************      Open a list file     **********
       UNLM
       FMT  XPT=2,YPT=12,':LIST FILE NAME?:'
       LISTM
       DST  #PAB3,@SREF      Put list PAB address
       SB   @FLAG,NOTHIN     No file name is OK.
       DST  >1C2,@LOC        Set pointer to name
       CALL DSR2             Prepare PAB area.
*
       $IF @FAC6 .DEQ. 0 GOTO ASKOPT No list file. Skip.
       ST   >12,RAM(FLG(SREF)) Open with output mode
       DST  BUF3,RAM(BUF(SREF)) Buffer address.
       CALL DSR3             Open output file .
       SB   @FLAG,ALST       List file is open
*
**********   Ask for options     ***********
ASKOPT
* Clean up OPTLN beforehand ??????
       FMT  XPT=2,YPT=16,':OPTIONS?:'
       DST  >242,@LOC        Specify cursor location
       CALL NAME
       RB   @FLAG,NOTHIN     No input line was OK so far.
*  Option is transfered to ERAM
       $IF @FAC6 .DEQ. 0 THEN          No option. It's OK
         DST  @LOC,@FAC4
       $END IF
       MOVE 15 FROM RAM(@FAC4) TO @OPTLN   Move to RAM
***
************   Now assemble !!!!!!  *********
***
       CALL CLRTOP      Clear editor information
       ALL  SPACE
       XML  ASM         Assemble the program.
       BS   EMSG        Error routine shared with editor
*********   Close files before going back to menu   ******
*
ASMOUT
       CALL CLRTOP           Clear editor information
       DST  PAB1,@SREF       Close source file
       CALL CLOSE
       DST  PAB2,@SREF       Close object file
       CALL CLOSE
       $IF .BIT(ALST) @FLAG .EQ. 1 THEN
         DST  PAB3,@SREF     Close list file
         CALL CLOSE
       $END
       CLR  @FLAG
*********
       CALL CONT        Issue message and continue.
       BR   START       Go back to menu screen.