Listing of file='TINYC.SRC;05' on disk='vmedia/chip_10-sector.ccvf'
; TITLE TINY-C VERSION 80-01-03, NOVEMBER 1980
ORG 8200H
TORG EQU $
; ERROR CODES
STATERR EQU 1
CURSERR EQU 2
SYMERR EQU 3
RPARERR EQU 5
RANGERR EQU 6
CLASERR EQU 7
SYNXERR EQU 9
LVALERR EQU 14
PUSHERR EQU 16
TMFUERR EQU 17
TMVRERR EQU 18
TMVLERR EQU 19
LINKERR EQU 20
ARGSERR EQU 21
LBRCERR EQU 22
MCERR EQU 24
SYMERRA EQU 26
KILL EQU 99
VLEN EQU 3 ;ALLOCATION LENGTH OF SYMBOLS
CR EQU 13 ;CARRIAGE RETURN
LF EQU 10 ;LINE-FEED
ERS EQU 11 ;ERASE-LINE (VT)
FF EQU 12 ;ERASE-PAGE (FORM-FEED)
ASCRET EQU CR ;END-OF-LINE CHARACTER
; * ENTRY POINTS
START: JMP COLD
JMP WARM
JMP HOT
; TAILORING VECTOR
ECHO: DB 1 ; 0==SUPPRESSES ECHOING
JMP INCH ; * I/O VECTORS *
JMP OUTCH
JMP CHRDY
JMP FOPEN
JMP FREAD
JMP FWRITE
JMP FCLOSE
JMP MCESET
PRBEGIN:NOP
NOP
RET
STBEGIN:NOP
NOP
RET
PRDONE: NOP
NOP
RET
; MC TOOLS
XMCESET:JMP MCESET
XTOPTOI:JMP TOPTOI
XPUSHK: JMP PUSHK
MCARGS: DB 0
ESCAPE: DB 27 ; ESCAPE CHARACTER
EFREE EQU 0000H ; HIGHEST USABLE RAM +1
BSTACK: DW BFREE ; SPACE ALLOCATION
ESTACK: DW -BFREE-80H+5
BFUN: DW BFREE+80H
EFUN: DW -BFREE-100H+6
BVAR: DW BFREE+100H
EVAR: DW -BFREE-100H-SPACE/8+VLEN+6
BPR: DW BFREE+100H+SPACE/8
EPR: DW -EFREE+100H
MSTACK: DW EFREE
; STANDARD CELLS
ERR: DW 0
ERRAT: DW 0
LEAVE: DB 0
BRAKE: DB 0
TOP: DW 0
NXTVAR: DW 0
CURFUN: DW 0
CURGLBL:DW 0
FNAME: DW 0
LNAME: DW 0
STCURS: DW 0
CURSOR: DW 0
PRUSED: DW 0
PROGEND:DW 0
APPLVL: DB 0
; LITERALS
BALPHS EQU $ ; BEGIN ALPHABETICS
XIF: DB 'IF',0
XELS: DB 'ELSE',0
XINT: DB 'INT',0
XCHAR: DB 'CHAR',0
XWHI: DB 'WHILE',0
XRET: DB 'RETURN',0
XBRK: DB 'BREAK',0
XENDL: DB 'ENDLIBRARY',0
XR: DB 'R'
XG: DB 'G'
XX: DB 'X'
DB 0FFH ; END OF ALPHABETICS
LB: DB '[',0
RB: DB ']',0
LPAR: DB '(',0
RPAR: DB ')',0
COMMA: DB ',',0
NEWLINE:DB CR,0
CMNT: DB '/'
XSTAR: DB '*',0
SEMI: DB ';',0
XPCNT: DB '%',0
XSLASH: DB '/',0
XPLUS: DB '+',0
XMINUS: DB '-',0
LT: DB '<',0
GT: DB '>',0
NOTEQ: DB '!=',0
EQEQ: DB '='
XEQ: DB '=',0
GE: DB '>=',0
LE: DB '<=',0
XNL: DB ASCRET,0
; EQ PERFORMS TOP-1:=TOP
EQ: CALL TOPTOI
PUSH D
CALL POPST
ORA A
JZ EQ2
MVI C,2
EQ2: MOV A,B
CPI 'L'
JNZ EQERR
XCHG
POP D
MOV M,E
DCR C
JZ PUSHK
INX H
MOV M,D
JMP PUSHK
EQERR: CALL ESET
DB LVALERR
POP D
JMP PUSHK
; BC:=-BC
DNEG: MOV A,C
CMA
MOV C,A
MOV A,B
CMA
MOV B,A
INX B
RET
; DIFFERENCE BETWEEN TWO TOP VALUES INTO DE
TOPDIF: CALL POPTWO
; DE:=DE-BC
DSUB: MOV A,E
SUB C
MOV E,A
MOV A,D
SBB B
MOV D,A
ORA E
MOV A,D
RLC
RET
; DE:=BC+DE
DADD: MOV A,C
ADD E
MOV E,A
MOV A,B
ADC D
MOV D,A
ORA E
MOV A,D
RLC
RET
; DE:=BC*DE
DMPY: LXI H,0
DM2: MOV A,C
RRC
JNC DM3
DAD D
DM3: CALL BCRS
JNZ DM4
XCHG
RET
DM4: CALL DELS
JNZ DM2
XCHG
RET
; SHIFT BC RIGHT
BCRS: XRA A
MOV A,B
RAR
MOV B,A
MOV A,C
RAR
MOV C,A
ORA B
RET
; SHIFT DE LEFT
DELS: XRA A
; ROTATE DE LEFT
RDEL: MOV A,E
RAL
MOV E,A
MOV A,D
RAL
MOV D,A
ORA E
RET
; DE,HL:=DE/BC
DREM: MOV A,D
XRA B
PUSH PSW
MOV A,D
ORA A
CM DENEG
MOV A,B
ORA A
CM DNEG
MVI A,16
PUSH PSW
XCHG
LXI D,0
DR2: DAD H
CALL RDEL
JZ DR3
CALL DCMP
JM DR3
MOV A,L
ORI 1
MOV L,A
CALL DSUB
DR3: POP PSW
DCR A
JZ DR4
PUSH PSW
JMP DR2
DR4: POP PSW
RP
CALL DENEG
XCHG
CALL DENEG
XCHG
RET
; DE:=DE/BC
DDIV: CALL DREM
XCHG
RET
; DE:=-DE
DENEG: MOV A,D
CMA
MOV D,A
MOV A,E
CMA
MOV E,A
INX D
RET
; COMPARE DE AND BC
DCMP: MOV A,E
SUB C
MOV A,D
SBB B
RET
; STACK TOOLS
; TOPTOI POPS TOP OF STACK INTO DE
TOPTOI: CALL POPST
STA TPCLASS
MOV A,B
CPI 'A'
JZ TT2
XCHG
MOV E,M
INX H
MOV D,M
TT2: DCR C
RNZ
LDA TPCLASS
ORA A
RNZ
MOV A,E
RLC
SBB A
MOV D,A
RET
TPCLASS:DB 0
; POPS TWO FROM STACK, BC:=TOP,DE:=NEXT
POPTWO: CALL TOPTOI
PUSH D
CALL TOPTOI
POP B
RET
; POPS THE STACK INTO A,B,C,DE. NEW TOP IN HL
POPST: LHLD TOP
MOV A,M
INX H
MOV B,M
INX H
MOV C,M
INX H
MOV E,M
INX H
MOV D,M
PUSH B
LXI B,-9
DAD B
POP B
SHLD TOP
RET
; PUSHES CONSTANT 1.
PONE: LXI D,1
JMP PUSHK
; PUSHES CONSTANT 0.
PZERO: LXI D,0
; PUSHES CONSTANT IN DE
PUSHK: XRA A
MVI B,'A'
MVI C,2
; PUSHES CLASS (A), LVALUE (B), SIZE (C), STUFF (DE)
; ONTO STACK.
PUSHST: LHLD TOP
PUSH D
LXI D,5
DAD D
SHLD TOP
XCHG
LHLD ESTACK
DAD D
XCHG
POP D
JC PERR
MOV M,A
INX H
MOV M,B
INX H
MOV M,C
INX H
MOV M,E
INX H
MOV M,D
RET
PERR: CALL ESET
DB PUSHERR
RET
; ESET SETS ERR UNLESS ONE IS ALREADY SET
ESET: LDA ERR
XTHL
ORA A
JZ ES2
INX H
XTHL
RET
ES2: MOV A,M
INX H
XTHL
STA ERR
LHLD CURSOR
SHLD ERRAT
RET
; STORE 0'S FROM (DE) THRU (HL) INCLUSIVE
ZERO: MVI B,0
; STORE (B) FROM (DE) THRU (HL) INCLUSIVE
BZAP: MOV A,L
SUB E
MOV A,H
SBB D
RC
MOV M,B
DCX H
JMP BZAP
; PRINT STRING STARTING AT (HL), TERMINATED BY NULL BYTE
PS: MOV A,M
ORA A
RZ
CALL OUTCH
INX H
JMP PS
END2 EQU $
; @@@@ SCAN TOOLS @@@@
LITX: LHLD CURSOR ;RSS04
JMP LIT4 ;RSS04
LIT: CALL BLANKS ;RSS01
LIT4: LDAX D
ORA A
JZ MATCH
CMP M
INX D
INX H
JZ LIT4
XRA A
ORA A
RET
MATCH: SHLD CURSOR
CMA
ORA A
RET
; ADVANCES CURSOR OVER BLANKS. PUTS CURSOR IN HL
BLANKS: LHLD CURSOR
LOOP: MOV A,M ;RSS01
INX H ;RSS01
CPI ' ' ;RSS01
JZ LOOP ;RSS01
CPI ' ' ;RSS01
JZ LOOP ;RSS01
DCX H ;RSS01
SHLD CURSOR
RET
; SKIPS OVER BALANCED L-R DELIMITERS, (ASSUMING THE FIRST
; 1 DELIMITER IS ALREADY MATCHED.)
SKIP: MVI D,1
SK2: MOV A,M
CMP B
JZ SKL
CMP C
JNZ SKNEXT
DCR D
JNZ SKNEXT
INX H
SHLD CURSOR
STC
CMC
RET
SKL: INR D
SKNEXT: INX H
XCHG
PUSH H
LHLD PROGEND
DAD D
POP H
XCHG
JNC SK2
CALL ESET
DB CURSERR
STC
RET
; TESTS FOR LEGAL IDENTIFIER CHARACTER
ALEGAL: CPI '_' ;RSS04
RZ ;RSS04
CPI '0'
RM
CPI '9'+1
JM YESA
; TEST IF (A) IS ALPHA. PLUS ON YES
ALPHA: CPI 'A'
RM
CPI 'Z'+1
JM YESA
CPI 'a'
RM
CPI 'z'+1
JM YESA
CMA
ORA A
RET
YESA: XRA A
RET
; MATCHES A VARIABLE OR FUNCTION NAME. SETS FNAME.
SYMNAME:CALL BLANKS
SHLD FNAME
MOV A,M
CALL ALPHA
JM SY3
SY2: INX H
MOV A,M
CALL ALEGAL ;RSS04
JP SY2
SHLD CURSOR
DCX H
SHLD LNAME
RET
SY3: XRA A
RET
; MATCHES 3 KINDS OF CONSTANTS, SETTING FNAME
CONST: CALL BLANKS
MOV A,M
CPI '+'
JZ CN2
CPI '-'
JZ CN2
CPI '0'
JM CN3
CPI '9'+1
JP CN3
CN2: SHLD FNAME
CN4: INX H
MOV A,M
CPI '0'
JM CN5
CPI '9'+1
JM CN4
CN5: SHLD CURSOR
DCX H
SHLD LNAME
MVI A,1
RET
CN3: CPI '"'
JNZ CN6
INX H
SHLD FNAME
CN7: MOV A,M
ORA A
JZ CN8
SBI '"'
JZ CN8
INX H
XCHG
LHLD PROGEND
DAD D
XCHG
JNC CN7
JMP CNERR
CN8: MOV M,A
DCX H
SHLD LNAME
MVI A,2
ORA A
INX H
INX H
SHLD CURSOR
RET
CN6: CPI 27H
JNZ CN9
INX H
SHLD FNAME
CN12: MOV A,M
CPI 27H
JZ CN11
INX H
XCHG
LHLD PROGEND
DAD D
XCHG
JNC CN12
JMP CNERR
CN11: MVI A,3
ORA A
INX H
SHLD CURSOR
RET
CN9: XRA A
RET
CNERR: CALL ESET
DB CURSERR
RET
; SKIPS OVER REMARKS AND/OR END-OF-LINES IN ANY ORDER
REM: LXI D,NEWLINE
CALL LIT
JZ RE2
RE3: MOV A,M
CPI LF
JNZ REM
INX H
SHLD CURSOR
JMP REM
RE2: LXI D,CMNT
CALL LITX ;RSS04
RZ
MVI B,1
MVI C,ASCRET
CALL SKIP
RC
JMP RE3
; HL POINT TO START OF DIGIT STRING
ATON: XCHG
LXI H,0
AN2: LDAX D
SUI 48
JC AN3
CPI 10
JNC AN3
MOV B,H
MOV C,L
DAD H
DAD H
DAD B
DAD H
MOV C,A
MVI B,0
DAD B
INX D
JMP AN2
AN3: XCHG
RET
; HL POINTS TO BEGINNING OF ASCII INTEGER
AISGN: DB 0
ATOI: XRA A
STA AISGN
AI6: MOV A,M
CPI ' '
JNZ AI2
INX H
JMP AI6
AI2: CPI '-'
JNZ AI3
STA AISGN
INX H
AI3: CPI '+'
JNZ AI4
INX H
AI4: CALL ATON
LDA AISGN
ORA A
RZ
JMP DENEG
; @@@@ SYMBOL TOOLS @@@@
; ALLOCATE REFERENCE IN FUNB FOR VARIABLE OF A FUNCTION
NEWFUN: LHLD CURFUN
LXI D,6
DAD D
SHLD CURFUN
XCHG
LHLD EFUN
DAD D
XCHG
JNC NF2
CALL ESET
DB TMFUERR
RET
NF2: LDA NXTVAR
MOV M,A
SUI 6+VLEN
MOV C,A
LDA NXTVAR+1
INX H
MOV M,A
SBI 0
INX H
MOV M,C
INX H
MOV M,A
LDA PRUSED
INX H
MOV M,A
LDA PRUSED+1
INX H
MOV M,A
RET
; DEALLOCATE VARIABLE OF LAST FUNCTION
FUNDONE:LHLD CURFUN
MOV A,M
STA NXTVAR
INX H
MOV A,M
STA NXTVAR+1
INX H
INX H
INX H
MOV A,M
STA PRUSED
INX H
MOV A,M
STA PRUSED+1
LXI D,-11
DAD D
SHLD CURFUN
RET
; ALLOCATE A VARIABLE. CALL IN A, SIZE IN B, LEN IN DE
; PASSED VALUE IN HL
CLASS: DB 0 ; TEMPS USED BY NEWVAR
OBSIZE: DB 0
PASSED: DW 0
LEN: DW 0
FVAL: DW 0
KF: DW 0
NEWVAR: STA CLASS
MOV A,B
STA OBSIZE
SHLD PASSED
XCHG
SHLD LEN
LHLD NXTVAR
CALL CANON
INX H
LDA CLASS
MOV M,A
INX H
LDA OBSIZE
MOV M,A
INX H
LDA LEN
MOV M,A
INX H
LDA LEN+1
MOV M,A
INX H
SHLD FVAL
LDA CLASS
ORA A
JZ NR2
LHLD PASSED
MOV A,L
ORA H
JNZ NR3
NR2: LHLD PRUSED
INX H
SHLD KF
XCHG
LHLD FVAL
MOV M,E
INX H
MOV M,D
LHLD LEN
XCHG
LHLD PRUSED
LDA OBSIZE
DAD D
DCR A
JZ NR7
DAD D
NR7: SHLD PRUSED
XCHG
LHLD EPR
DAD D
XCHG
JNC NR4
CALL ESET
DB TMVLERR
RET
NR4: LHLD KF
XCHG
LHLD PRUSED
CALL ZERO
JMP NR5
NR3: LHLD FVAL
LDA PASSED
MOV M,A
INX H
LDA PASSED+1
MOV M,A
JMP NR6
NR5: LDA CLASS
ORA A
JNZ NR6
LHLD PASSED
MOV A,H
ORA L
JZ NR6
XCHG
LHLD KF
MOV M,E
INX H
MOV M,D
NR6: LHLD CURFUN
INX H
INX H
LDA NXTVAR
MOV M,A
INX H
LDA NXTVAR+1
MOV M,A
LHLD NXTVAR
LXI D,6+VLEN
DAD D
SHLD NXTVAR
XCHG
LHLD EVAR
DAD D
XCHG
LHLD FVAL
RNC
CALL ESET
DB TMVRERR
RET
; ADRVAL LOOKS UP A SYMBOL POINTED TO BY FNAME,LNAME
CSIZE: DB 0 ; CANONICAL STORAGE ;RSS04
CPTR: DW 0 ;RSS04
PVAR: DW 0
AREA: DB 0
SFUN: DW 0
LAST: DW 0
ADDRVAL:LHLD CURFUN
SHLD SFUN
LXI H,CSIZE ;RSS04
CALL CANON
XRA A
STA AREA
AD8: LHLD SFUN
MOV E,M
INX H
MOV D,M
INX H
MOV C,M
INX H
MOV B,M
XCHG
SHLD PVAR
MOV H,B
MOV L,C
SHLD LAST
LHLD PVAR
LDA CSIZE ; B:=CSIZE ;RSS04
MOV B,A ;RSS04
AD2: LDA LAST
SUB L
LDA LAST+1
SBB H
JC AD3
MOV A,B ;RSS04
CMP M ; SIZES MATCH? ;RSS04
JNZ AD5A ; NO ;RSS04
INX H ;RSS04
MOV E,M ; DE:=@HL ;RSS04
INX H ;RSS04
MOV D,M ;RSS04
MOV C,B ; C:=CSIZE ;RSS04
LHLD CPTR ; HL:=CPTR ;RSS04
AD4: LDAX D
CMP M
JNZ AD5
DCR C
INX D
INX H
JNZ AD4
LHLD PVAR ; RESET HL ;RSS04
INX H ;RSS04
INX H ;RSS04
INX H ;RSS04
MOV A,M
INX H
MOV B,M
INX H
MOV E,M
INX H
MOV D,M
INX H
ORA A
JZ AD9
CPI 'E'
RNZ
AD9: PUSH D
MOV E,M
INX H
MOV D,M
XCHG
POP D
RET
AD5: LHLD PVAR
AD5A: LXI D,VLEN+6
DAD D
SHLD PVAR
JMP AD2
AD3: LDA AREA
ORA A
JNZ AD6
LHLD CURGLBL
AD7: SHLD SFUN
INR A
STA AREA
JMP AD8
AD6: CPI 2
JP ADERR
LHLD BFUN
JMP AD7
ADERR: CALL ESET
DB SYMERRA
RET
; CANONICALIZES SYMBOL FROM FNAME TO LNAME INCLUSIVE
CANON: XCHG ; SAVE DESTINATION ;RSS04
LHLD FNAME ;RSS04
XCHG ;RSS04
LDA LNAME ; A:=SIZE ;RSS04
SUB E ;RSS04
INR A ;RSS04
MOV M,A ; SAVE SIZE ;RSS04
INX H ;RSS04
MOV M,E ; SAVE ADDRESS ;RSS04
INX H ;RSS04
MOV M,D ;RSS04
RET
; ASGN IS THE EXPRESSION EVALUATOR.
ASGN: CALL RELN
LXI D,XEQ
CALL LIT
JZ A2
CALL ASGN
LDA ERR
ORA A
CZ EQ
A2: LDA ERR
ORA A
JZ A3
XRA A
RET
A3: DCR A
RET
; A RELN IS AN EXPR OR A COMPARISON OF EXPRS.
RELN: CALL EXPR
LXI D,LE
CALL LIT
JZ R2
CALL EXPR
CALL TOPDIF
JZ PONE
JC PONE
JMP PZERO
R2: LXI D,GE
CALL LITX ;RSS04
JZ R3
CALL EXPR
CALL TOPDIF
JZ PONE
JNC PONE
JMP PZERO
R3: LXI D,EQEQ
CALL LITX ;RSS04
JZ R4
CALL EXPR
CALL TOPDIF
JZ PONE
JMP PZERO
R4: LXI D,NOTEQ
CALL LITX ;RSS04
JZ R5
CALL EXPR
CALL TOPDIF
JNZ PONE
JMP PZERO
R5: LXI D,GT
CALL LITX ;RSS04
JZ R6
CALL EXPR
CALL TOPDIF
JZ PZERO
JC PZERO
JMP PONE
R6: LXI D,LT
CALL LITX ;RSS04
RZ
CALL EXPR
CALL TOPDIF
JC PONE
JMP PZERO
; AN EXPR IS A TERM OR SUM (DIFF) OF TERMS.
EXPR: LXI D,XMINUS
CALL LIT
JZ EX2
CALL TERM
CALL TOPTOI
MOV A,E
CMA
MOV E,A
MOV A,D
CMA
MOV D,A
INX D
CALL PUSHK
JMP EX3
EX2: LXI D,XPLUS
CALL LITX ;RSS04
CALL TERM
EX3: LDA ERR
ORA A
RNZ
LXI D,XPLUS
CALL LIT
JZ EX4
CALL TERM
CALL POPTWO
CALL DADD
CALL PUSHK
JMP EX3
EX4: LXI D,XMINUS
CALL LITX ;RSS04
RZ
CALL TERM
CALL POPTWO
CALL DSUB
CALL PUSHK
JMP EX3
; A TERM IS A FACTOR OR A PRODUCT OF FACTORS
TERM: CALL FACTOR
TE2: LDA ERR
ORA A
RNZ
LXI D,XSTAR
CALL LIT
JZ TE3
CALL FACTOR
CALL POPTWO
CALL DMPY
CALL PUSHK
JMP TE2
TE3: CALL REM
LXI D,XSLASH
CALL LIT
JZ TE4
CALL FACTOR
CALL POPTWO
CALL DDIV
CALL PUSHK
JMP TE2
TE4: LXI D,XPCNT
CALL LITX ;RSS04
RZ
CALL FACTOR
CALL POPTWO
CALL DREM
CALL PUSHK
JMP TE2
; A FACTOR IS A ASGN, CONST., VAR. REF. OR FUN. REF.
FACTOR: LXI D,LPAR
CALL LIT
JZ FA2
CALL ASGN
LXI D,RPAR
CALL LIT
RNZ
CALL ESET
DB RPARERR
RET
FA2: CALL CONST
JZ FA5
CPI 1
JNZ FA3
LHLD FNAME
CALL ATOI
JMP PUSHK
FA3: CPI 2
JNZ FA4
MVI A,1
MVI B,'A'
MVI C,1
LHLD FNAME
XCHG
JMP PUSHST
FA4: XRA A
MVI B,'A'
MVI C,1
LHLD FNAME
MOV E,M
JMP PUSHST
FA5: CALL SYMNAME
JZ FA6
LHLD FNAME
INX H
LDA LNAME
CMP L
JNZ FA7
LDA LNAME+1
CMP H
JNZ FA7
MOV A,M
CPI 'C'
JNZ FA7
DCX H
MOV A,M
CPI 'M'
JNZ FA7
LXI H,0
JMP ENTER
FA7: CALL ADDRVAL
SHLD FWHERE
STA CLASS
MOV A,B
STA OBSIZE
XCHG
SHLD LEN
MOV A,D
ORA E
JZ FA8
LDA CLASS
CPI 'E'
JZ FA9
LXI D,LPAR
CALL LIT
JZ FA10
LDA CLASS
DCR A
STA CLASS
JP FA11
CALL ESET
DB CLASERR
RET
FA11: LHLD FWHERE
MOV E,M
INX H
MOV D,M
PUSH D
LHLD LEN
PUSH H
LHLD CLASS
PUSH H
CALL ASGN
POP H
SHLD CLASS
POP H
SHLD LEN
POP H
SHLD FWHERE
RZ
LXI D,RPAR
CALL LIT
CALL TOPTOI
XCHG
SHLD SUBSCR
XCHG
LHLD LEN
MOV A,L
DCR A
ORA H
JZ FA12
LDA CLASS
ORA A
JNZ FA12
ORA D
JM SUBERR
MOV B,H
MOV C,L
CALL DSUB
JC FA12
SUBERR: CALL ESET
DB RANGERR
FA12: LHLD SUBSCR
XCHG
LHLD FWHERE
LDA OBSIZE
FA13: DCR A
JM FA14
DAD D
JMP FA13
FA14: SHLD FWHERE
FA10: LDA OBSIZE
MOV C,A
LDA CLASS
MVI B,'L'
LHLD FWHERE
XCHG
JMP PUSHST
FA9: LHLD FWHERE
JMP ENTER
FA8: CALL ESET
DB SYMERR
RET
FA6: CALL ESET
DB SYNXERR
RET
FWHERE: DW 0 ; LOCALS USED BY ASGN
SUBSCR: DW 0
; SKIPST SKIPS OVER A (POSSIBLY COMPOUND) STATEMENT
SKIPST: CALL REM
LXI D,LB
CALL LIT
JZ SS2
MVI B,'['
MVI C,']'
CALL SKIP
JMP REM
SS2: LXI D,XIF
CALL LITX ;RSS04
JNZ SS6
LXI D,XWHI
CALL LITX ;RSS04
SS7: JZ SS3
SS6: LXI D,LPAR
CALL LIT
MVI B,'('
MVI C,')'
CALL SKIP
CALL SKIPST
LXI D,XELS
CALL LIT
CNZ SKIPST
JMP REM
SS3: LHLD CURSOR
SS4: MOV A,M
CPI ASCRET
JZ SS8
CPI ']'
JZ SS8
CPI ';'
JZ SS5
INX H
XCHG
LHLD PROGEND
DAD D
XCHG
JNC SS4
JMP REM
SS5: INX H
SS8: SHLD CURSOR
JMP REM
; VALLOC PARSES ONE VARIABLE BEHIND INT OR CHAR AND MAKES
; ALLOCATION AND SYMBOL ENTRY.
TYPE: DB 0
VPASSED:DW 0
VCLASS: DB 0
ALEN: DW 0
VALLOC: STA TYPE
SHLD VPASSED
CALL SYMNAME
JZ V2
XRA A
STA VCLASS
LXI D,LPAR
CALL LIT
JZ V3
LHLD FNAME
PUSH H
LHLD LNAME
PUSH H
LDA VCLASS
INR A
PUSH PSW
CALL ASGN
POP PSW
STA VCLASS
POP H
SHLD LNAME
POP H
SHLD FNAME
LDA ERR
ORA A
RNZ
LXI D,RPAR
CALL LIT
CALL TOPTOI
INX D
XCHG
SHLD ALEN
JMP V5
V3: LXI H,1
SHLD ALEN
V5: LDA TYPE
MVI B,1
CPI 'C'
JZ V7
INR B
V7: LDA VCLASS
LHLD ALEN
XCHG
LHLD VPASSED
JMP NEWVAR
V2: CALL ESET
DB SYMERR
RET
; @@@@ TINY - C INTERPRETER @@@@
; ST INTERPRETS A POSSIBLY COMPOUND STATEMENT
ST: CALL QUIT
LDA ERR
ORA A
RNZ
CALL REM
CALL STBEGIN
ST2: LHLD CURSOR
SHLD STCURS
CALL DECL
JNZ REM
LXI D,LB
CALL LIT
JZ TIF
CALL REM
CMPND: LDA ERR
MOV B,A
LDA LEAVE
ORA B
MOV B,A
LDA BRAKE
ORA B
RNZ
LXI D,RB
CALL LIT
JNZ REM
CALL ST
JMP CMPND
TIF: LXI D,XIF
CALL LITX ;RSS04
JZ TWHI
LXI D,LPAR
CALL LIT
CALL ASGN
RZ
LXI D,RPAR
CALL LIT
CALL TOPTOI
MOV A,D
ORA E
JZ IF2
CALL ST
LXI D,XELS
CALL LIT
CNZ SKIPST
RET
IF2: CALL SKIPST
LXI D,XELS
CALL LIT
CNZ ST
RET
TWHI: LXI D,XWHI
CALL LITX ;RSS04
JZ TSEM
LXI D,LPAR
CALL LIT
CALL ASGN
RZ
LXI D,RPAR
CALL LIT
CALL TOPTOI
MOV A,D
ORA E
JZ WH2
LHLD STCURS
PUSH H
LHLD CURSOR
PUSH H
CALL ST
POP H
SHLD OBJT
POP H
SHLD AGIN
LDA BRAKE
ORA A
JZ WH3
LHLD OBJT
SHLD CURSOR
CALL SKIPST
XRA A
STA BRAKE
RET
WH3: LHLD AGIN
SHLD CURSOR
RET
WH2: CALL SKIPST
RET
TSEM: LXI D,SEMI
CALL LITX ;RSS04
JNZ REM
TRET: LXI D,XRET
CALL LITX ;RSS04
JZ TBRK
LXI D,SEMI
CALL LIT
JNZ TR2
LXI D,XNL
CALL LITX ;RSS04
JNZ TR2
CALL ASGN
JMP TR4
TR2: CALL PZERO
TR4: MVI A,1
STA LEAVE
RET
TBRK: LXI D,XBRK
CALL LITX ;RSS04
JZ TASG
MVI A,1
STA BRAKE
RET
TASG: CALL ASGN
JZ STER
CALL TOPTOI
LXI D,SEMI
CALL LIT
JMP REM
STER: CALL ESET
DB STATERR
RET
OBJT: DW 0
AGIN: DW 0
; DECL TEST FOR AND INTERPRETS DECLARATIONS
DECL: LXI D,XCHAR
CALL LIT
JZ TINT
CH2: MVI A,'C'
LXI H,0
CALL VALLOC
LXI D,COMMA
CALL LIT
JNZ CH2
CH3: LXI D,SEMI
CALL LIT
MVI A,07FH
ORA A
RET
TINT: LXI D,XINT
CALL LITX ;RSS04
RZ
IN2: MVI A,'I'
LXI H,0
CALL VALLOC
LXI D,COMMA
CALL LIT
JNZ IN2
JMP CH3
; QUIT CATCHES INTERRUPTS (ESC KEY) AT APPL LEVEL.
QUIT: LDA APPLVL
ORA A
RZ
CALL CHRDY
RZ
MOV B,A
LDA ESCAPE
CMP B
RNZ
CALL INCH
CALL ESET
DB KILL
RET
; EVALUATE ARGUMENTS OF A FUNCTION.
NARGS: DB 0
WHERE: DW 0
ARG: DW 0
ENTER: SHLD WHERE
XRA A
STA NARGS
LHLD TOP
LXI D,5
DAD D
SHLD ARG
LXI D,LPAR
CALL LIT
LXI D,RPAR
CALL LIT
JNZ ARGSDNE
LHLD CURSOR
MOV A,M
CPI ']'
JZ ARGSDNE
CPI ';'
JZ ARGSDNE
CPI ASCRET
JZ ARGSDNE
CPI '/'
JZ ARGSDNE
EN2: LDA ERR
ORA A
RNZ
LHLD ARG
PUSH H
LHLD WHERE
PUSH H
LHLD NARGS
PUSH H
CALL ASGN
POP H
MOV A,L
POP H
SHLD WHERE
POP H
SHLD ARG
INR A
STA NARGS
LXI D,COMMA
CALL LIT
JNZ EN2
LXI D,RPAR
CALL LITX ;RSS04
ARGSDNE:LDA ERR
ORA A
RNZ
LHLD WHERE
MOV A,H
ORA L
JNZ EN3
LDA NARGS
CALL MC
RET
EN3: LHLD CURSOR
PUSH H
LHLD STCURS
PUSH H
LHLD WHERE
SHLD CURSOR
CALL NEWFUN
EN4: CALL REM
LXI D,XINT
CALL LIT
JZ EN5
EN6: LHLD ARG
MVI B,'I'
CALL SETARG
LHLD ARG
LXI D,5
DAD D
SHLD ARG
LXI D,COMMA
CALL LIT
JNZ EN6
LXI D,SEMI
CALL LITX ;RSS04
JMP EN4
EN5: LXI D,XCHAR
CALL LITX ;RSS04
JZ EN7
EN8: LHLD ARG
MVI B,'C'
CALL SETARG
LHLD ARG
LXI D,5
DAD D
SHLD ARG
LXI D,COMMA
CALL LIT
JNZ EN8
LXI D,SEMI
CALL LITX
JMP EN4
EN7: LHLD TOP
LXI D,5
DAD D
LDA ARG
CMP L
JZ EN9
POP D
POP H
SHLD CURSOR
PUSH H
PUSH D
CALL ESET
DB ARGSERR
EN9: LXI H,NARGS
DCR M
JM EN11
CALL POPST
JMP EN9
EN11: LDA ERR
ORA A
CZ ST
LDA LEAVE
ORA A
CZ PZERO
XRA A
STA LEAVE
POP H
SHLD STCURS
POP H
SHLD CURSOR
CALL FUNDONE
LHLD TOP
INX H
MOV A,M
CPI 'A'
RZ
CALL TOPTOI
JMP PUSHK
; HL POINT INTO STACK TO AN ARG. B IS TYPE.
SETARG: PUSH B
MOV B,M
INX H
MOV A,M
INX H
MOV C,M
INX H
MOV E,M
INX H
MOV D,M
CPI 'A'
JZ SE2
XCHG
MOV E,M
INX H
MOV D,M
SE2: MOV A,C
DCR A
ORA B
JNZ SE3
MOV A,E
RLC
SBB A
MOV D,A
SE3: POP B
MOV A,B
XCHG
JMP VALLOC
; SCANS PROGRAM AND ALLOCATE ALL EXT. IN NEXT FCTN LAYER.
LINK: CALL NEWFUN
LI2: LDA ERR
ORA A
RNZ
LHLD CURSOR
INX H
INX H
XCHG
LHLD PROGEND
DAD D
XCHG
RC
CALL REM
LXI D,LB
CALL LIT
JZ LIDCL
MVI B,'['
MVI C,']'
CALL SKIP
JMP LI2
LIDCL: CALL DECL
JNZ LI2
LXI D,XENDL
CALL LIT
JZ LISYM
CALL NEWFUN
JMP LI2
LISYM: CALL SYMNAME
JZ LIERR
MVI A,'E'
MVI B,2
MVI E,1
MVI D,0
LHLD CURSOR
CALL NEWVAR
LHLD CURSOR
MVI A,'['
LI3: CMP M
JZ LI4
INX H
XCHG
LHLD PROGEND
DAD D
XCHG
JNC LI3
CALL ESET
DB LBRCERR
RET
LI4: SHLD CURSOR
CALL SKIPST
JMP LI2
LIERR: CALL ESET
DB LINKERR
RET
; MOVE -(BC) BYTES FROM (HL) TO (DE)
MOVE: MOV A,M
STAX D
INX D
INX H
INR C
JNZ MOVE
INR B
JNZ MOVE
RET
; @@@@ IT ALL STARTS HERE @@@@
FCSSP: DW 0 ; ORIGINAL SP ;RSS01
COLD: LDA FCSSP+1 ; OLD STACK SET? ;RSS01
ORA A ;RSS01
JNZ CL1 ;RSS01
LXI H,0 ;RSS01
DAD SP ;RSS01
SHLD FCSSP ;RSS01
CL1: LHLD MSTACK
SPHL
CL2: LXI B,-10
LHLD BPR
XCHG
LXI H,INST
CALL MOVE
LHLD BPR
LXI D,9
DAD D
CALL HLNEG
SHLD PROGEND
CL3: MVI A,0C3H ;RSS01
STA HOTVEC ;RSS01
LXI H,HOTSTRT ;RSS01
SHLD HOTVEC+1 ;RSS01
STA KBVEC ;RSS01
LXI H,KBINT ;RSS01
SHLD KBVEC+1 ;RSS01
MVI A,31 ;RSS01
STA KBDFL ;RSS01
LXI H,0 ;RSS01
SHLD KBRPTR ;RSS01
CALL LOGO
WARM: CALL LOADER
HOT: CALL LOGO
LHLD PROGEND
CALL HLNEG
SHLD PRUSED
LHLD BPR
SHLD CURSOR
LHLD BFUN
LXI D,6
DAD D
SHLD CURGLBL
LXI D,-12
DAD D
SHLD CURFUN
LHLD BVAR
SHLD NXTVAR
LHLD BSTACK
LXI D,-5
DAD D
SHLD TOP
XRA A
MOV H,A
MOV L,A
STA ERR
SHLD ERRAT
STA LEAVE
STA BRAKE
CALL LINK
CALL NEWFUN
LHLD BPR
SHLD CURSOR
CALL PRBEGIN
CALL ST ; THIS EXECUTES THE SYSTEM PROGRAM
CALL PRDONE
LDA ERR ;RSS01
ORA A ;RSS01
JNZ DONERR ;RSS01
CALL PX ;RSS01
DB LF,ERS,'DONE',CR,LF,0 ;RSS01
JMP WARM ;RSS01
;RSS01
DONERR: CALL PX ;RSS01
DB LF,ERS,'ERROR ',0 ;RSS01
LHLD ERR ;RSS01
XCHG ;RSS01
CALL PN ;RSS01
CALL PX ;RSS01
DB ' ON LINE ',0 ;RSS01
LHLD BPR ;RSS01
XCHG ;RSS01
LHLD ERRAT ;RSS01
MVI A,ASCRET ;RSS01
PUSH H ;RSS01
PUSH D ;RSS01
CALL COUNTCH ;RSS01
PUSH B ;RSS01
MOV E,C ;RSS01
MOV D,B ;RSS01
INX D ;RSS01
CALL PN ;RSS01
CALL PX ;RSS01
DB LF,ERS,0 ;RSS01
POP B ;RSS01
POP D ;RSS01
POP H ;RSS01
MVI A,ASCRET ;RSS01
CALL SCANN ;RSS01
MOV B,A ;RSS01
DONE1: INX D ;RSS01
CALL CMPHD ;RSS01
JNZ DONE2 ;RSS01
CALL PX ;RSS01
DB ' `',0 ;RSS01
DONE2: LDAX D ;RSS01
ORA A ;RSS01
JNZ DONE3 ;RSS01
MVI A,'"' ;RSS01
DONE3: CALL OUTCH ;RSS01
CMP B ;RSS01
JNZ DONE1 ;RSS01
JMP WARM
INST: DB '[MAIN();]',0
LOADER: LXI H,BUFF
CALL PX ;RSS01
DB LF,ERS,'TC>',0 ;RSS01
D2: CALL INCH
MOV M,A
CPI 26 ;RSS01
JZ D3
CPI 127 ;RSS04
JZ D3 ;RSS04
CALL OUTCH ;RSS01
CPI CR
JZ DOIT
INX H
JMP D2
D3: LXI D,-BUFF-1
PUSH H
DAD D
POP H
JNC D2
DCX H
CALL PX ;RSS01
DB 26,' ',26,0 ;RSS01
JMP D2
DOIT: MVI M,0
LDA BUFF+1
MOV B,A
LDA XR
CMP B
JZ LOAD
LDA XX
CMP B
JZ TCEXIT
LDA XG
CMP B
RZ
CALL PX ;RSS01
DB '???',0 ;RSS01
JMP LOADER
LOAD: LXI H,BUFF+3
LXI D,1
LXI B,LOADUNIT ;RSS01
MVI A,1
CALL FOPEN
JNZ LOADER
LXI H,0 ; START AT BLOCK 0 ;RSS02
SHLD BLOCKN ;RSS02
LHLD PROGEND ; XBC:=ALLOW LEN. ;RSS02
XCHG ;RSS02
LHLD EPR ;RSS02
CALL HLNEG ;RSS02
DAD D ;RSS02
SHLD XBC ;RSS02
XCHG ;RSS02
CALL HLNEG ; BUF:=BASE ADDRESS ;RSS02
SHLD BUF ;RSS02
LXI B,LOADUNIT ;RSS02
CALL BREAD ; READ FILE ;RSS02
DAD D ;RSS02
MVI M,0 ;RSS02
CALL HLNEG ;RSS02
SHLD PROGEND ;RSS02
JMP LOADER
BUFF: DS 40
; PRINT (DE) AS SIGNED INTEGER
PN: LXI H,BUFF
CALL ITOA
MVI M,0
LXI H,BUFF
JMP PS
; CONVERT (DE) TO ASCII SIGNED INTEGER
ITOA: MOV A,D
ORA A
JP NTOA
CALL DENEG
MVI M,'-'
INX H
; CONVERT (DE) TO ASCII UNSIGNED INTEGER
NTOA: MOV A,D
ORA E
JNZ NT2
MVI M,'0'
INX H
RET
NT2: XRA A
PUSH PSW
NT3: LXI B,10
PUSH H
CALL DDIV
MOV A,L
POP H
ADI '0'
PUSH PSW
MOV A,D
ORA E
JNZ NT3
NT4: POP PSW
RZ
MOV M,A
INX H
JMP NT4
; PRINT THE COPYRIGHT MESSAGE ON THE TERMINAL.
LOGO: CALL PX ;RSS01
CPMSG: DB LF,11,'RALFARITHMS TINY-C V2.2',CR,LF,0
RET ;RSS01
; MOVE THE BLOCK (DE)...(HL) INCLUSIVE (BC) BYTES
MOVEBL: MOV A,B
ORA A
JM MOVEDN
ORA C
RZ
MOVEUP: SHLD FROMPTR
DAD B
XCHG
LDA FROMPTR
CMA
ADD L
MOV C,A
LDA FROMPTR+1
CMA
ADC H
MOV B,A
LHLD FROMPTR
MU2: MOV A,M
STAX D
DCX H
DCX D
INR C
JNZ MU2
INR B
JNZ MU2
RET
MOVEDN: XCHG
SHLD FROMPTR
DAD B
LDA FROMPTR
SUB E
MOV C,A
LDA FROMPTR+1
SBB D
MOV B,A
DCX B
XCHG
LHLD FROMPTR
JMP MOVE
FROMPTR:DW 0
; SCAN FOR THE NTH OCCURANCE OF A CHARACTER IN A BLOCK
SCANN: PUSH PSW
XCHG
SC2: MOV A,C
ORA B
JZ SC9
MOV A,E
SUB L
MOV A,D
SBB H
JC SC9
POP PSW
PUSH PSW
CMP M
JNZ SC3
DCX B
SC3: INX H
JMP SC2
SC9: DCX H
XCHG
POP PSW
RET
; COUNT THE OCCURANCES OF A CHARACTER IN A BLOCK.
COUNTCH:LXI B,0
PUSH PSW
CC2: MOV A,L
SUB E
MOV A,H
SBB D
JC CC9
POP PSW
PUSH PSW
CMP M
DCX H
JNZ CC2
INX B
JMP CC2
CC9: POP PSW
RET
; MACHINE CALL ROUTINE TO INTERFACE TO 8080 CODED ROUTINES
MC: STA MCARGS
CALL TOPTOI
LXI H,-1000
DAD D
JC USERMC
MOV A,E
CPI 1
JZ MC1
CPI 2
JZ MC2
CPI 3
JZ MC3
CPI 4
JZ MC4
CPI 5
JZ MC5
CPI 6
JZ MC6
CPI 7
JZ MC7
CPI 8
JZ MC8
CPI 9
JZ MC9
CPI 10
JZ MC10
CPI 11
JZ MC11
CPI 12
JZ MC12
CPI 13
JZ MC13
CPI 14
JZ MC14
MCESET: CALL ESET
DB MCERR
RET
; PUT A CHARACTER TO SCREEN
MC1: CALL TOPTOI
CALL PUSHK
MOV A,E
JMP OUTCH
; GET A CHARACTER FROM KEYBOARD
MC2: CALL INCH
MOV B,A
LDA APPLVL
ORA A
JZ USEIT
LDA ESCAPE
CMP B
JNZ USEIT
CALL ESET
DB KILL
USEIT: LDA ECHO
ORA A
MOV A,B
CNZ OUTCH
MOV E,A
XRA A
MOV D,A
JMP PUSHK
; FILE OPEN(R/W,NAME,FSIZE,UNIT)
MC3: CALL TOPTOI
PUSH D
CALL TOPTOI
PUSH D
CALL TOPTOI
PUSH D
CALL TOPTOI
MOV A,E
ORA D
POP H
POP D
POP B
CALL FOPEN
MC3A: LXI D,0
MOV E,A
JMP PUSHK
; READ BLOCK(WHERE2,UNIT)
MC4: CALL TOPTOI
PUSH D
CALL TOPTOI
XCHG
POP B
CALL FREAD
MC4A: JZ MC4P ;RSS02
LXI D,-1
MOV E,A
MC4P: JMP PUSHK
; WRITE BLOCK(1ST BYTE,LAST BYTE,UNIT)
MC5: CALL TOPTOI
PUSH D
CALL TOPTOI
PUSH D
CALL TOPTOI
XCHG
POP D
POP B
CALL FWRITE
JMP MC3A ;RSS04
; CLOSE FILE(UNIT)
MC6: CALL TOPTOI
MOV C,E
MOV B,D
CALL FCLOSE
JMP PZERO
; MOVE A BLOCK UP OR DOWN(FIRST,LAST,K)
MC7: CALL TOPTOI
PUSH D
CALL TOPTOI
PUSH D
CALL TOPTOI
POP H
POP B
CALL MOVEBL
JMP PZERO
; COUNT # INSTANCES OF CHARACTER IN BLOCK(FIRST,LAST,CH)
MC8: CALL TOPTOI
PUSH D
CALL TOPTOI
PUSH D
CALL TOPTOI
POP H
POP B
MOV A,C
CALL COUNTCH
MOV E,C
MOV D,B
JMP PUSHK
; SCAN FOR NTH OCCURANCE OF CH(FIRST,LAST,CH,CNT ADDRESS)
MC9: CALL TOPTOI
PUSH D
CALL TOPTOI
PUSH D
CALL TOPTOI
PUSH D
CALL TOPTOI
POP H
POP B
MOV A,C
XTHL
MOV C,M
INX H
MOV B,M
DCX H
XTHL
PUSH D
CALL SCANN
POP H
MOV A,E
SUB L
MOV E,A
MOV A,D
SBB H
MOV D,A
POP H
MOV M,C
INX H
MOV M,B
JMP PUSHK
; TRAP TO MONITOR 4.0 FOR DEBUGGING.
MC10: DB 0FFH
RET
; ENTERS AN APPLICATION PROGRAM.
MC11: LHLD CURSOR
PUSH H
LHLD PROGEND
PUSH H
LHLD PRUSED
PUSH H
LHLD CURGLBL
PUSH H
CALL TOPTOI
XCHG
PUSH H
SHLD CURSOR
CALL TOPTOI
XCHG
SHLD PRUSED
CALL HLNEG
SHLD PROGEND
CALL LINK
LHLD CURFUN
SHLD CURGLBL
CALL TOPTOI
XCHG
SHLD CURSOR
CALL NEWFUN
CALL TOPTOI
PUSH D
LXI H,APPLVL
INR M
PUSH H
LDA ERR
ORA A
JNZ DONE
CALL PRBEGIN
CALL ST
CALL PRDONE
DONE: POP H
DCR M
CALL FUNDONE
CALL FUNDONE
LHLD CURSOR
LDA ERR
ORA A
JZ MCEN2
LHLD ERRAT
MCEN2: XCHG
POP H
POP B
MOV A,E
SUB C
MOV E,A
MOV A,D
SBB B
MOV D,A
LDA ERR
MOV M,A
XRA A
INX H
MOV M,A
INX H
MOV M,E
INX H
MOV M,D
POP H
SHLD CURGLBL
POP H
SHLD PRUSED
POP H
SHLD PROGEND
POP H
SHLD CURSOR
XRA A
STA ERR
JMP PZERO
; TEST IF KEYBOARD CHAR READY
MC12: CALL CHRDY
MVI D,0
MOV E,A
JMP PUSHK
; PRINT RAM, FROM AND TO ADDRESSES
MC13: CALL TOPTOI
PUSH D
CALL TOPTOI
XCHG
POP D
LOOP13: MOV A,E
SUB L
MOV A,D
SBB H
JC PZERO
MOV A,M
ORA A
JNZ EC13
MVI A,'"'
EC13: CALL OUTCH
INX H
JMP LOOP13
; PRINT A SIGNED INTEGER
MC14: CALL TOPTOI
PUSH D
CALL PN
POP D
JMP PUSHK
; @@@@ COMPUCOLOR I/O ROUTINES @@@@
HOTVEC EQU 81BFH ; ESC ^ HOT START VECTOR
KBVEC EQU 81C5H ; KEYBOARD INPUT ROUT. VECTOR
KBDFL EQU 81DFH ; KEYBOARD INPUT FLAG BYTE
KBSIZE EQU 32 ; LOOKAHEAD SIZE (POWER OF 2)
FILSIZE EQU 256 ; NORMAL FILE BUFFER SIZE
OUTCH EQU 3392H ; OUTPUT ROUTINE
EMESS EQU 262DH ; FCS ERROR ROUTINE
PFSPC EQU 3077H ; PARSE FILE SPECIFIER
OPEN EQU 2DABH ; OPEN FILE
RWSEQI EQU 30C6H ; REWIND INPUT FILE
INSEQO EQU 30E7H ; INITIALIZE OUTPUT FILE
CLSEQO EQU 3136H ; CLOSE OUTPUT FILE
ADHLA EQU 3518H ; ADD A TO HL
SUBHD EQU 3459H ; HL:=HL-DE
CMPHD EQU 344DH ; COMPARE HL WITH DE UNSIGNED
CMPDH EQU 3453H ; COMPARE DE WITH HL UNSIGNED
NEGH EQU 3524H ; NEGATE HL
HLNEG EQU NEGH ;RSS01
GAREC EQU 3257H ; GET RECORD
PTREC EQU 3285H ; PUT RECORD
RBLKI EQU 31F9H ; READ BLOCK ;RSS02
WBLKI EQU 31F6H ; WRITE BLOCK ;RSS02
GTBYT EQU 322CH ; GET BYTE ;RSS02
FOPT EQU 0
FATR EQU 1
FNAM EQU 2
FTYP EQU 8
FVER EQU 11
FSBK EQU 12
FSIZ EQU 14
FLBC EQU 16
FLAD EQU 17
FSAT EQU 19
FSPR EQU 21
FDBK EQU 22
FDEN EQU 23
FAUX EQU 24
FHAN EQU 26
FFCN EQU 28
FDRV EQU 29
FBLK EQU 30
FBUF EQU 32
FXBC EQU 34
FPTR EQU 36
FPBE EQU 38
; PRINT INLINE STRING
PX: XTHL ; GET STRING POINTER
PUSH PSW ; SAVE REGISTERS
CALL PS ; PRINT OUT STRING
INX H ; JUMP OVER THE 0
POP PSW ; RESTORE REGISTERS
XTHL
RET
HOTSTRT:LHLD MSTACK ; HOT START ADDITION
SPHL
JMP CL3
TCEXIT: MVI B,0 ; SET FOR NO ERROR
LHLD FCSSP ; LOAD ORIGINAL STACK
SPHL
RET ; RETURN TO FCS
; USER MC CALLS
USERMC: MOV A,L ; A:=MC#-1000
CPI 1
JZ MC1001
CPI 2
JZ MC1002
CPI 3
JZ MC1003
CPI 4
JZ MC1004
CPI 5
JZ MC1005
CPI 6
JZ MC1006
JMP MCESET
; OUTPUT(PORT#,VALUE)
MC1001: CALL POPTWO ; GET PORT# AND VALUE
LXI H,MC1001A+1
MOV M,E ; STORE PORT# IN INSTRUCTION
MOV A,C ; OUTPUT C TO PORT
MC1001A:OUT 00
JMP PZERO
; INPUT(PORT#)
MC1002: CALL TOPTOI ; GET PORT#
LXI H,MC1002A+1
MOV M,E ; STORE PORT# IN INSTRUCTION
MC1002A:IN 00 ; INPUT FROM PORT
MVI D,0 ; DE:=VALUE
MOV E,A
JMP PUSHK
; GETBYTE(UNIT)
MC1003: CALL TOPTOI ; BC:=UNIT#
MOV B,D
MOV C,E
CALL GBYTE ; READ BYTE
JMP MC4A
; BREAD(FIRST BYTE,LAST BYTE,BLOCK#,UNIT)
MC1004: CALL POPOFF ; POP ARGUMENTS INTO BLOCKN
CALL BREAD ; READ BLOCKS
JMP MC4A
; BWRITE(FIRST BYTE,LAST BYTE,BLOCK#,UNIT)
MC1005: CALL POPOFF ; POP ARGUMENTS INTO BLOCKN
CALL BWRITE ; WRITE BLOCKS
JMP MC4A
; FPBADR(UNIT)
MC1006: CALL TOPTOI ; * GET FPB ADDRESS *
MOV B,D
MOV C,E
CALL FADDR ; GET ADDRESS
XCHG
JMP PUSHK
INCH: CALL CHRDY ; * INPUT CHARACTER *
JZ INCH
PUSH PSW
LDA KBRPTR
INR A
ANI KBSIZE-1
STA KBRPTR
POP PSW
RET
CHRDY: PUSH H ; * TEST FOR CHARACTER *
LHLD KBRPTR
MOV A,L
SUB H
JZ CHRDY1
MOV A,L
LXI H,KBUFF
CALL ADHLA
MOV A,M
ORA A
JNZ CHRDY1
INR A
CHRDY1: POP H
RET
KBINT: PUSH H ; * KEYBOARD INTERRUPT ROUTINE *
PUSH PSW
LHLD KBRPTR
MOV A,H
INR A
ANI KBSIZE-1
CMP L
JZ KBINT1
STA KBWPTR
MOV A,H
LXI H,KBUFF
CALL ADHLA
MOV M,E
KBINT1: POP PSW
POP H
RET
FOPEN: CALL SETFPB ; * OPEN A FILE *
DCR A
MOV M,A
STA IOFLAG
XCHG ; DE:=#FPB
POP H ; HL:=#FILE SPECIFIER
LXI B,DEFAULT
CALL PFSPC ; PARSE FILE SPEC.
JC FERR ; ERROR?
LHLD FPBCUR ; HL:=#FPB
CALL OPEN ; OPEN FILE
JC FERR ; ERROR?
PUSH H ; SAVE FPB
LXI D,FBUF
DAD D
XCHG
LHLD FPBPTR ; MOVE BUFFER INFO INTO FPB
LXI B,-4
CALL MOVE
POP H ; RESTORE FPB
LDA IOFLAG ; CHECK READ OR WRITE
ORA A ; READ?
JZ FOPEN1 ; YES
CALL INSEQO ; NO, INITIALIZE FOR WRITE
JMP FCHECK
FOPEN1: CALL RWSEQI ; INITIALIZE FOR READ
JMP FCHECK
FREAD: CALL SETFPB ; * READ A RECORD *
POP B ; BC:=#BUFFER
PUSH B
LXI D,256 ; DE:=LENGTH OF BUFFER
CALL GAREC ; READ RECORD
POP H
FREAD1: JNC FOK ; NO ERRORS?
JNZ FERR ; NON-EOF ERROR?
SBB A ; A:=-1
RET
FWRITE: CALL SETFPB ; * WRITE A RECORD *
POP B ; BC:=#BUFFER
CALL DSUB ; DE:=LENGTH
INX D
CALL PTREC ; PUT RECORD
FCHECK: JC FERR ; ERROR?
FOK: XRA A ; A:=0, CARRY:=0
RET
FERR: CALL PX
DB CR,LF,0
CALL EMESS ; CALL FCS ERROR MESSAGE
CALL PX
DB 'ON UNIT ',0
FERR1: LHLD IOUNIT
XCHG
CALL PN
CALL PX
DB CR,LF,0
XRA A
INR A
RET
FCLOSE: CALL SETFPB ; * CLOSE FILE *
MOV A,M
ORA A
CNZ CLSEQO ; CLOSE IF WRITING
POP H
JMP FCHECK
GBYTE: CALL SETFPB ; * GET SINGLE BYTE *
CALL GTBYT
MOV E,A ; STORE BYTE
POP H
JMP FREAD1
BREAD: CALL SETFPB ; * READ BLOCKS *
CALL SETBLK ; SETUP FPB
CALL RBLKI
BREAD1: POP H ; RESTORE HL
JC FERR ; ERROR?
PUSH H ; NO, DE:=ACTUAL TRANSFER SIZE
LHLD FPBCUR
LXI D,FAUX
DAD D
MOV E,M
INX H
MOV D,M
POP H
JMP FOK
BWRITE: CALL SETFPB ; * WRITE BLOCKS *
CALL SETBLK ; SET FPB
CALL WBLKI
JMP BREAD1
FADDR: CALL SETFPB ; * GET FPB ADDR. *
RET
SETFPB: XTHL
PUSH H ; SNEAK HL ONTO STACK
PUSH PSW
MOV A,C
STA IOUNIT ; SAVE I/O UNIT #
DCR A
JM SETERR ; TOO LOW?
CPI NUNITS ; TOO HIGH
JP SETERR ; YES
ADD A ; CONVERT TO 3 WORD RECORD OFFSET
MOV B,A
ADD B
ADD B
LXI H,FPBTBL
CALL ADHLA ; HL:=# OF # OF FPB
PUSH D
MOV E,M
INX H
MOV D,M
INX H
SHLD FPBPTR ; STORE POINTER TO BUFFER INFO
XCHG ; HL:=#FPB
SHLD FPBCUR
POP D
POP PSW
RET ; NORMAL RETURN
SETERR: CALL PX
DB CR,LF,'ILLEGAL UNIT ',0
POP PSW
POP H ; POP RETURN
POP H ; POP THE HIDDEN HL
JMP FERR1
SETBLK: PUSH H ; * SETUP FPB *
LXI D,FBLK
DAD D
LXI D,BLOCKN
XCHG
LXI B,-6
CALL MOVE
POP H
RET
POPOFF: CALL TOPTOI ; * SAVE PARAMS IN BLOCKN *
PUSH D ; UNIT
CALL TOPTOI ; BLOCK #
XCHG
SHLD BLOCKN
CALL TOPTOI ; LAST BYTE
PUSH D
CALL TOPTOI ; FIRST BYTE
POP H
CALL SUBHD
INX H
SHLD XBC ; LENGTH
XCHG
SHLD BUF ; BASE ADDR.
POP B ; UNIT
RET
; DATA STRUCTURES
DEFAULT:DB 'SRC'
FPBCUR: DW 0 ; CURRENT FPB ADDRESS
FPBPTR: DW 0 ; POINTER TO BUFFER INFO.
IOFLAG: DW 0 ; READ/WRITE FLAG
IOUNIT: DW 0 ; I/O UNIT #
BLOCKN: DW 0 ; BLOCK #
BUF: DW 0 ; BLOCK BUFFER
XBC: DW 0 ; BLOCK SIZE
FPBTBL: DW FPB1,FPBF1,FPBF2-FPBF1
DW FPB2,FPBF2,FPBF3-FPBF2
DW FPB3,FPBF3,FPBF4-FPBF3
DW FPB4,FPBF4,FPBF5-FPBF4
DW FPB1,FPBF1,FPBF5-FPBF1
NUNITS EQU ($-FPBTBL)/6
LOADUNIT EQU NUNITS
FPB1: DS FPBE
FPB2: DS FPBE
FPB3: DS FPBE
FPB4: DS FPBE
FPBF1: DS FILSIZE
FPBF2: DS FILSIZE
FPBF3: DS FILSIZE
FPBF4: DS FILSIZE
FPBF5 EQU $
KBRPTR: DB 0 ; KEYBOARD READ POINTER
KBWPTR: DB 0 ; KEYBOARD WRITE POINTER
KBUFF: DS KBSIZE ; KEYBOARD LOOK AHEAD BUFFER
TCEND EQU $
BFREE EQU TCEND
SPACE EQU EFREE-BFREE
END START