*
 IF PTDOS
*
*
*     BYE COMMAND
*
CBYE CALL FLCLA  CLOSE ALL FILES
 CALL SYS
 DB RETOP  RETURN TO PTDOS
 ENDF .  PTDOS
*
*     DELETE COMMAND
*
*     DEL N1     DELETE N1
*     DEL N1,N2  DELETE FROM N1 TO N2
*     DEL ,N2    DELETE FROM FIRST LINE TO N2
*     DEL N1,    DELETE FROM N1 TO LAST LINE
*     DEL        DELETE ALL LINES
*
CDEL CALL GLARG  GET ARGUMENTS
 CALL CRLF
*
 LHLD FIRST  DESTINATION
 XCHG
 LHLD LAST  SOURCE
*
 LDAX D
 CPI EOF
 JZ END1
*
 CALL NMOV  BC:=(EOFA)-(HL)
*
 XCHG .  HL=DEST, DE=SOURCE, BC=COUNT
 CALL LMOV  DELETE
*
 MVI M,EOF  NEW END OF FILE
 SHLD EOFA
 CALL CCLEAR  CLEAR OUT SYM. TAB.
 JMP END1
*
*
*     SCRATCH COMMAND
*     CLEAR COMMAND
*
*   THIS COMMAND IS ALSO CALLED FROM THE INIT LOGIC
*
CCLEAR CALL FLCLA  CLOSE ALL FILES
 JMP ZAPER
CSCR CALL FLCLA  CLOSE ALL FILES
*
*
ZAPALL LHLD BOFA
 MVI M,EOF
 SHLD EOFA
 DCX H
 SHLD TXA  IN CASE CSCR IS EXECUTED AS A STATEMENT
*
ZAPER LHLD MEMTOP
 MVI M,ETYPE
 DCX H
 SHLD TSTKA  TOP OF ARG STACK
*
 LHLD EOFA  WIPE OUT DEFINITIONS
 INX H
 SHLD STA
*
 LXI H,0  CLEAR ERRSET TXA
 SHLD ERRLN
*
 XRA A
 STA CONTF  CANT DO A 'CONT' AFTER 'CLEAR'
 STA MENT   CLR MATRIX ENTRY FLAG
*
 CALL CFF  RESET PRINT FORMAT
 CALL DFC
*
 LXI H,26*2  ALLOCATE AND ZERO SYMTAB BUCKETS
 JMP ASTAB
*
*
*     RENUMBER COMMAND
*
CREN LXI H,10
 SHLD BEG  BEGINNING LINE NUMBER
 SHLD DEL  DEFAULT INCREMENT
*
 CALL INTGER
 JC CREN1
 MOV A,H
 ORA L
 JZ OBERR
 SHLD BEG
*
 CALL SCOMA
 JNZ CREN1
*
 CALL INTGER
 JC LNERR
 MOV A,H
 ORA L
 JZ OBERR
 SHLD DEL
*
CREN1 CALL GC
 CPI CR
 JNZ LNERR
*
*   MAKE SURE ARGS WONT CAUSE OVERFLOW
*
 LXI D,177777Q  HIGHEST POSSIBLE LINE NUMBER
 CALL FINDLN  WILL GIVE OBERR IF ARGS TOO BIG FOR PROGRAM
*
*  NOW WE HAVE BEG AND DEL SET UP
*  BEGIN PASS 1 (CHANGING OF LINE NUMBER REFERENCES)
*
 LHLD BOFA
 XRA A
 STA URFLAG  CLEAR UNRESOLVED REF FLAG
*
R0 MOV A,M
 CPI EOF
 JZ R5  GOTO PASS 2
 INX H  PASS LINE LEN BYTE
 INX H
 INX H
 SHLD TXA  SAVE ADDR OF THE TEXT OF THIS LINE
*
R1 CALL GCI  THE FIRST THING ON A LINE CAN'T BE AN LNRW
 CPI CR  CHECK FOR EOL
 JZ R0
R8 CALL LNUM  LN FOUND?
 JC R1  NO, SEARCH
*
* HERE WE HAVE FOUND A LINE NUM (IN HL) AND ADVANCED TXA
* PAST IT
*
 XCHG .  PUT LINE NUMBER IN DE
 CALL FINDLN  FIND THE NEW LINE NUMBER RETURNED IN 'NLN'
 LXI D,0  MAKE A ZERO LN INCASE OF UNRESOLVED REF
 JC R9  LINE NUMBER NOT FOUND, UNRESOLVED
 JNZ R9  EXACT MATCH NOT FOUND, UNRESOLVED
*
 LHLD NLN  THE NEW LINE NUMBER COMPUTED BY FINDLN
 XCHG .  NEW LINE NUMBER TO DE
R9 LHLD TXA  NEW LN IS IN DE, HL <= TXA OF WHERE IT GOES + 2
 DCX H
 DCX H
 CALL DSTOR  UPDATE THE LINE NUMBER IN TEXT
 SHLD TXA
 MOV A,D
 ORA E
 JNZ R8  GOTO R8 IF LN WAS NOT ZERO
 LDA URFLAG
 ORI 1
 STA URFLAG  FLAG SHOWING UNRESOLVED REF
 JMP R8
*
*   PASS 2 OF RENUMBER (UPDATE THE LINE NUMBERS)
*
R5 LHLD DEL
 MOV B,H
 MOV C,L  INCREMENT
 LHLD BEG
 XCHG
 LHLD BOFA
*
R6 MOV A,M  ACCA NOT USED UNTIL CALL TO ADR BELOW
 CPI EOF
 JZ R10  DONE, CHECK FOR UNRESOLVED REF
 PUSH H  SAVE H FOR CALL TO ADR
 INX H  PASS LIN LEN, POINT TO LN
 CALL DSTOR  DE IS NEW LN, STORE IT
 POP H  BACKUP, POINTER TO BEGINNING OF THIS LINE
 CALL ADR  GET TO NEXT LINE, ACCA HAS DISTANCE FROM ABOVE
 XCHG .  LAST LN (DE) TO HL
 DAD B  LINE NUMBER FOR NEXT LINE (LAST LN + DEL)
 XCHG .  LN (HL) TO DE
 JMP R6
*
*
R10 LDA URFLAG
 ORA A
 JNZ URERR
 JMP END1
*
*
URFLAG DS 1  UNRESOLVED REF FLAG FOR REN COMMAND
*
*
*     LIST COMMAND
*
*     LIST N1    LIST LINE N1
*     LIST N1,   LIST FROM N1 TO LAST LINE
*     LIST ,N2   LIST FROM FIRST LINE TO N2
*     LIST N1,N2 LIST FROM N1 TO N2
*     LIST       LIST ALL LINES
*
CLIST CALL GLARG  GET ARGUMENTS
 CALL CRLF
 CALL CRLF
 XRA A
 STA LPHED  INITIALIZE INDENTATION COUNTER
 LHLD FIRST  GET ADDR OF FIRST LINE
*
CL1 MOV A,M
 CPI EOF
 RZ
*
 LXI D,IBUF1
 CALL UPPL  CONVERT LINE INTO TEXT (IN IBUF)
 INX H  POINT TO BEGINING OF NEXT LINE TO LIST
*
 PUSH H
 LXI H,IBUF1+5
 MVI M,'"'  TERMINATE LINE NUMBER
 LXI H,IBUF1
 CALL PRNT  PRINT LINE NUMBER
 INX H  PASS THE "
*
 MVI B,-2
 LDA FORFG  THIS WILL CONTAIN A 2 IF LOGICLY TRUE
 ORA A
 JNZ LPADD
 MOV B,A
LPADD LDA LPHED
 ADD B
 ADI 6
 MOV E,A
 CALL PTAB1
*
 CALL PRNTCR  PRINT THE STATEMENT
 IF SOLOS
 CALL SPDCK  DO SPEED CONTROL
 ENDF
 IF PTDOS
 CALL PCHECK
 ENDF
 CALL CRLF
 POP D
*
 LXI H,LAST  ADDR OF ADDR OF END OF LAST LINE
 CALL DCMP
 XCHG
 RZ
 JMP CL1
*
*
*     EDIT COMMAND
*
*     EDIT        EDIT FIRST LINE
*     EDIT N1     EDIT LINE N1
*     EDIT N1,N2  EDIT LINE N1
*     EDIT N1,    EDIT LINE N1
*     EDIT ,N2    EDIT FIRST LINE
*
CEDIT LDA XOPORT
 ORA A
 JNZ NAERR
*
 CALL GLARG  GET LINE NUMBER ARGUMENTS
 CALL CRLF  LINE FEED, CARRIAGE RETURN
*
 LHLD BOFA
 MOV A,M
 CPI EOF
 JZ NPERR
*
 IF PTDOS
 CALL CLR2L  BACKUP ONE LINE AND CLEAR TWO
 LHLD CURFG  GET PRESENT VALUES
 PUSH H
 LXI H,80H  PUT IN PROPER VALUES
 SHLD CURFG
 ENDF
 CALL READR  GET CURRENT DISPLAY ADDRESS INTO 'VDMAD'
*
 IF PTDOS
 MVI M,' '+80H  TURN ON THE CURSOR FOR SURE
 LXI H,PHEAD
 MVI M,2  MAKE PHEAD NON-ZERO
 ENDF
 LHLD FIRST
 LXI D,IBUF1  PUT LINE IN IBUF1
 CALL UPPL  DECODE LINE TO IBUF1 RETURNS C=# OF CHARS IN BUFFER
 DCR C  GET RID OF THE CARRIAGE RETURN
 DCX D  THAT UPPL PUT ON THE END
*
 LXI H,CEDRP  GET EDIT RETURN POINT
 PUSH H  FOR RETURN FROM 'INLINE'
*
 LXI H,IBUF1  ADDR OF IBUF TO HL
 PUSH H  BECAUSE OF ENTRY POINT USED BELOW
 JMP INST2  ENTRY TO 'INLINE', C HAS CHARACTER COUNT
*
CEDRP EQU $
 IF PTDOS
 POP H  GET BACK THE CURSOR VALUES
 SHLD CURFG
 ENDF
 PUSH PSW  SAVE TERMINATOR
 CALL PP  ENCODE THE LINE
 JC LNERR  ONLY LINES WITH LINE NUMBERS!
 CALL LINE  EDIT LINE IN
*
 POP PSW  GET TERMINATOR
 IF SOLOS
 CPI LF
 JNZ CED07  IF LF THEN CRLF, ELSE LFCR
 CALL CRLF
 JMP CED08
CED07 MVI B,LF  LINE FEED, CARRIAGE RETURN
 CALL CHOUT
 MVI B,CR
 CALL CHOUT
CED08 JMP CCLEAR
 ENDF
 IF PTDOS
 CPI LF
 JNZ CED07
 CALL CRLF
 CALL CRLF
 JMP CCLEAR
CED07 MVI B,LF
 CALL CHOUT
 MVI B,LF
 CALL CHOUT
 MVI B,CR
 CALL CHOUT
 MVI B,CR
 CALL CHOUT
 JMP CCLEAR
 ENDF
*
*
*
*     CONTINUE COMMAND
*
CCONT LDA CONTF
 ORA A
 JZ NCERR
 CALL CRLF
 XRA A
 STA DIRF
 POP H  RETURTN LINK
 POP H  SAVED VALUE OF PROGRAM TXA
 SHLD TXA
 POP H
 POP D
 POP B  SAVED REGISTORS
 MVI A,KCAN  THIS INCASE WE ARE RETURNING TO INLINE
 RET .  RETURN FROM PCHECK
*
*
*    RUN COMMAND
*
CRUN LDA DIRF
 ORA A
 CNZ CRLF  NEW LINE IF NOT RUNNING
*
 LHLD TXA
 PUSH H
 CALL GLARG  GET LINE NUMBER ARG
 POP H
 MOV A,M
 CPI CR  IF THERE WAS AN ARGUMENT THEN...
 PUSH PSW
 CZ CCLEAR  ...DON'T CLEAR
*
 LHLD BOFA
 MOV A,M
 CPI EOF  CHECK FOR NULL PROGRAM
 JZ NPERR
*
 DCX H  PTR TO CR PRECEDING FIRST LINE TO BE EXECUTED
 SHLD TXA  THE PLACE TO START RUNNING AT
 XRA A
 STA DIRF  CLEAR DIRECT MODE FLAG (RUN MODE NOW)
 STA CONTF  CLEAR CONTINUE FLAG
 STA MENT  CLEAR MATRIX ENTRY FLAG
 LXI H,0  CLEAR TIME/COUNT LIMIT
 SHLD ITIM
 SHLD ITIM+1
 POP PSW
 JNZ CRUN4  IF THERE WAS A LN ARG THEN SKIP FUNC DEF
*
 CALL CFF  RESET TO FREE FORM
 CALL DFC
*
 LXI H,0  RESET ERROR TRAPPING
 SHLD ERRLN
*
 LHLD BOFA
 DCX H  POINT TO INITIAL CR WHICH PRECEEDS THE PROG BUFFER
 SHLD RTXA  SET THE READ STATEMENT DATA POINTER (INITIALY)
*
*
*  DEFINE FUNCTIONS, CHECK FOR FNEND BALANCE
*
CRUN1 LXI B,DEFRW*256+FNERW  LOOK FOR DEF OR FNEND
 XRA A
 CALL LSTAT
 JC CRUN4  DONE DEFINING
 CPI FNERW
 JZ FDERR
*
*    NOW WE KNOW IT MUST HAVE BEEN A DEFRW
*
 MVI B,FNRW
 CALL EATC
 CALL FNAME
 CALL STLK
 JNC DDERR  ERROR IF NAME NOT CREATED
 PUSH H  SYMTAB PTR
 LXI H,2
 CALL ASTAB
 CALL EATLP
 XCHG
 POP H
 CALL DSTOR  SAVE TXA IN SYMTAB
*
*     EAT UP DEFINITON
*
 CALL FEND
 JMP CRUN1
*
*
CRUN4 LHLD FIRST  STARTING TXA
 INX H
 INX H
 INX H
 SHLD TXA
*
 LXI H,CRM  DO COPYRIGHT CHECK
 XRA A
 MVI B,CRML
CRUNC ADC M  ONES CHECKSUM IS LEFT CIRCULAR
 INX H
 DCR B  LENGTH
 JNZ CRUNC
*
 LHLD STA  SYMBOLTABLE FREE POINTER (SNIKER...SNIKER)
 LXI D,STKTOP  TOP OF STACK
 XCHG
CKSUM EQU $+1
 CPI 00H  IS IT WHAT IT SHOULD BE??
 JZ CRUNY  YES
 XCHG .  NO, THEN HIS VARS WILL CLOBBER THE STACK
 LXI B,SSIZE-56
CRUNY LXI B,SSIZE  STACK SIZE
 DAD B  BOTTOM OF STACK POINTER
 DCX H  LESS ONE
 SPHL
 SHLD SPTR
*
 MVI A,CR  CLEAR IF TERM
 STA IFTERM
*
 JMP ILOOP  GO TO THE INTERPRETER DRIVER
*
*
*     SET COMMAND
*
CSET CALL GCI  GET THING TO SET
 PUSH PSW
 IF PTDOS
 CPI SE6RW
 JZ CSET2
 ENDF
 CALL PFIXE  GET EXPRESSION AND FIX TO DE
CSET2 POP PSW
 PUSH D  SAVE RESULT
*
 CPI LNRW  ALL 'SET' WORDS ARE BELOW 'LNRW'
 JNC BSERR
 SUI SELRW
 JC BSERR  NOT A 'SET' WORD
*
 RAL .  MUL TIMES 2
 LXI H,STBL  ADDR OF SET TABLE
 CALL ADR  HL=HL+A
CSET1 CALL LHLI  HL=(HL)
 XTHL .  EXPRESSION RESULT TO HL, HL TO STACK
 MOV A,L  A GETS LOW OF EXPRESSION RESULT
 RET .  CALL SETTING ROUTINE, IT WILL RETURN FOR US
*
*
SETLL MOV A,H
 ORA A
 JNZ OBERR  WAY TOO BIG
 MVI A,LINMAX
 CMP L
 JC OBERR
 MOV A,L
 STA LINLEN
 RET
*
*
SETML LDA DIRF
 ORA A
 JZ BSERR
*
 XCHG .  DE HAS NEW LIMIT
 LHLD BOFA
 LXI B,LINMAX+1
 DAD B  LOWEST POSSIBLE MEMORY LIMIT IS BOFA+LINMAX+1
 XCHG .  HL HAS NEW LIMIT, DE HAS MIN LIMIT
 CALL HDCMP  HL-DE TEST
 JC OBERR  TOO SMALL
MEMAX EQU $+1
 LXI D,0000H  THE HIGEST POSSIBLE MEMORY ADDRESS FOR BASIC
 INX D
 CALL HDCMP
 JNC OBERR
 SHLD MEMTOP
 JMP CCLEAR  THIS MAKES TI TAKE EFFECT RIGHT-A'-WAY
*
 IF SOLOS
*
*
SETDS MVI B,8  SET DISPLAY SPEED
 JMP ESCSEQ  DO ESCAPE SEQ AND RETURN
*
*
SETDB MVI B,7  DISPLAY BYTE
 JMP ESCSEQ
*
*
SETIP LHLD XIPORT  SET INPUT PSEUDO PORT
 MOV M,A
 RET
*
*
SETOP LHLD XOPORT  SET OUTPUT PSEUDO PORT
 MOV M,A
 RET
*
*   DO A SOLOS ESCAPE SEQUENCE
*
ESCSEQ PUSH PSW  AN ESCAPE SEQU. JUST LIKE IN THE BOOK
 PUSH B
 MVI B,KESC
 CALL ZOUT
 POP B
 CALL ZOUT
 POP PSW
 MOV B,A
 JMP ZOUT  ...AND RETURN
 ENDF
 IF PTDOS
*
*
*
SETOF LDA XOPORT
 ORA A
 CNZ SEF1  END-FILE AND CLOSE THE OLD FILE
*
 CALL GC
 CPI '#'
 JZ SEF2
*
 CALL GFNX  GET FILE NAME
*
SEF8 LXI D,CFN  OPEN FILE
 LXI H,0
 CALL SYS
 DB OPEOP
 JMP SEF9  IF ERNEX THEN CREATE
*
SEF0 STA XOPORT  NEW OUTPUT FILE NUMBER
 MVI B,VCLEAR
 ORA A
 CZ SYSOT  CLEAR SCREEN IF ON INTERNAL DRIVER
*
 LHLD SYSGLO
 LXI D,GLCOF
 DAD D
 LDA XOPORT
 ORA A
 JNZ SEF4
 MVI A,1
SEF4 MOV M,A  SET GLCOF
 RET
*
SEF1 CALL SYS
 DB EOFOP
 JMP DKERR
 LDA XOPORT
 CALL SYS
 DB CLOOP
 JMP DKERR
 RET
*
SEF2 INX H  PASS THE #
 SHLD TXA
 CALL PFIXE  GET FILE #
 MOV A,D
 ORA A
 JNZ OBERR  TOO BIG
 MOV A,E  WHO KNOWS??
 JMP SEF0
*
SEF9 CPI ERNEX
 JNZ DKERR
*
*  CREATE AN OUTPUT FILE
*
 MVI A,'.'+80H
 STA CFT
 LXI H,04C0H
 SHLD CBLKS
 XRA A
 STA CATTR
 LXI D,CCREB
 CALL SYS
 DB CREOP
 JMP DKERR
 JMP SEF8  TRY TO RE-OPEN
*
*
SETFB MOV A,H
 ORA L
 JZ SFB0
 LXI H,-1
 JMP SFB1
SFB0 LXI H,0
SFB1 SHLD OPEBU
 RET
*
*
SETXI CALL OPEEOF  LOOK UP THE FCB
 JNZ FDERR  NO SUCH, TURKEY!
 CALL DIRT
 LHLD STA  FIND SOME SPACE
 PUSH H
 LXI D,256  SIZE OF AN INDEX BLOCK
 DAD D
 CALL STOV
 SHLD STA
*
 POP H  INDEX'S MEMORY ADDERSS
 LDA CSFID  FILE # FROM FCB
 MVI B,4  LOAD INDEX
 CALL SYS
 DB CTLOP
 JMP DKERR
 RET
*
*
SETDS PUSH PSW
 CALL SCOMA  SYNTAX ','
 JC SEDS0
 CALL PFIXE  GET SPEED CONTROL CODE
 MOV A,D
 ORA A
 JNZ OBERR
 MOV A,E
 CPI 3+1
 JNC OBERR
 STA SPDCTRL  SET THE SPEED CONTROL BYTE
*
SEDS0 POP PSW
 STA SPEED  SET SPEED
 RET
*
*
SETCP LDA XOPORT
 ORA A
 JNZ NAERR
 MOV A,L
*
 LXI H,CHRPO
 MVI M,80H  INVERTED
 ORA A
 RNZ
 MVI M,00H  NORMAL
 RET
*
*
SETCM LDA XOPORT
 ORA A
 JNZ NAERR
*
 MOV B,L  SAVE THE FLAG
 CALL CREM  GET RID OF ANY CURSOR THAT IS ON
 MOV A,B
 ORA A
 JNZ SCMON  GO SET IT ON IF NON-ZERO
 STA CURFG  SET FOR NEXT OFF; ACCA IS ZERO BY TEST
 RET
*
SCMON MVI A,80H  TURN ON THE BIT
 STA CURFG
 XRA M  COMPLEMENT THE CURRENT (HL FROM 'CREM')
 MOV M,A
 RET
 ENDF
*
*
*
*
*     TABLE OF "SET" ROUTINE ADDRESSES
*
STBL DW SETLL  SET LINE LENGTH
 DW SETML  SET MEMORY LIMIT
 IF SOLOS
 DW SETIP
 DW SETOP
 DW SETDS
 DW SETDB
 ENDF
 IF PTDOS
 DW SETDS
 DW SETXI
 DW SETFB
 DW SETCM
 DW SETCP
 DW SETOF
 ENDF
*
*
*     TAPE ON COMMAND
*
CTON CALL PFIXE
 MOV A,D
 ORA A
 JNZ OBERR  WOW!
 ORA E  MOVE E TO A AND TEST
 JZ OBERR
 STA CSFID  FOR TTON
 CPI 2+1
 JC TTON
 JMP OBERR
*
*