TOP; TINCMP COPYRIGHT (C) 1981 W.A.GALE

TOP; TINCMP COPYRIGHT (C) 1981 W.A.GALE
PARAMETER KLF=010; CP/M MODIFICATION AND 8080 RECODING
PARAMETER KCR=013; BY A. L. BENDER, M. D.
PARAMETER KEF=026; NEW MODS AND REWORKING COPYRIGHT (C) 1981 A L BENDER, M D
BYTE AA; WORK
BYTE BB; WORK BYTE
BYTE DD; WORK
BYTE EE; WORK BYTE

BYTE BF(080); EXPANSION BUFFER
BYTE BL; BLANK
BYTE BP; POINTER INTO BF
BYTE C0; CONSTANT ZERO
BYTE C1; CONSTANT ONE
BYTE C2; CONSTANT TWO
BYTE C3; CONSTANT 3
BYTE C4; CONSTANT 040
BYTE C8; CONSTANT 080
BYTE C9; CONSTANT 9
BYTE CC; INPUT CHARACTER
BYTE CX; CONSTANT TEN

BYTE DG; DIGIT FROM PARAMTER TREATMENT DEFINITION
BYTE DS(010); DIGIT STACK FOR SUB SD
BYTE EF; END FILE CHARACTER
BYTE F1(00128); INPUT BUFFER
BYTE F2(00128); OUTPUT BUFFER
BYTE HA; 'A'
BYTE HF; 'F'
BYTE LE; END OF LIST
BYTE LF; LINE FEED CHARACTER
BYTE LS(09000); LIST OF MACRO DEFINITIONS
BYTE MF; MACRO REPLACEMENT OPERATOR FLAG
BYTE ML; MACRO LENGTH
BYTE MM; MINIMUM MACRO LENGTH

BYTE ND; NUMBER OF DIGITS USED IN SUB SD FOR NUMBER OUTPUT
BYTE NL; NEW LINE
BYTE O1; FETCH CODE
BYTE O2; INDEX CODE
BYTE O3; DISPOSE CODE
BYTE OA; '+' ADD OPERATOR
BYTE OB; '!' POP STACK OPERATOR
BYTE OC; 'C' CHARACTER DISPOSE
BYTE OD; 'V' DIGIT CONVERSION FETCH
BYTE OE; ESCAPE CHARACTER
BYTE OG; IGNORE CHARACTER
BYTE OH; 'H' HEX CONVERSION FETCH
BYTE OL; 'L' LITERAL FETCH
BYTE OM; '*' MULTIPLY DISPOSE
BYTE ON; 'N' NUMERIC LITERAL FETCH

BYTE OP; 'P' PARAMETER FETCH OR DISPOSE
BYTE OR; '-' REDUCE (SUBTRACT) DISPOSE
BYTE OS; 'S' STACK FETCH OR DISPOSE
BYTE OT; TRACE FLAG TURN ON
BYTE PP; POINTER INTO IPR
BYTE RB; BEGIN DEFINITION FLAG
BYTE RC; (COMMENT) END OF LINE FLAG
BYTE SF; SUBSTITUTION PARAMETER FLAG
BYTE SP; STACK POINTER
BYTE TR; TRUE IF NO TRACE
BYTE UG; USE IGNORE; TRUE UNLESS OG IS 'X'

BYTE UN; NOT X-- FLAG FOR NOT SUPPRESSING NEW LINES ON OUTPUT
BYTE UO; USE OPERATIONS-- TRUE UNLESS MF IS 'X'
BYTE UT; USE TRACE TRACE MODE IS ON
BYTE ZR; CHARACTER ZERO
INT I00; CONSTANT ZERO
INT I01; CONSTANT 1
INT I09; CONSTANT 9
INT I10; CONSTANT 10
INT I16; CONSTANT 16
INT IAA; WORK
INT IBB; WORKING STORAGE
INT IBC; BUCKET NUMBER
INT IDP; DEFINITION POINTER WHILE MATCH
INT IED; POINTS TO END OF DEFINITIONS
INT III; POINTER TO L WHILE READING
INT IJJ; POINTER TO L READING CODE
INT ILM; MAXIMUM LIMIT FOR STORING IN L

INT ILP(01000); POINTERS TO MACROS
INT IMP; MACRO POINTER DURING EXPANSION
INT INM; NUMBER OF MACROS
INT IPR(010); PARAMETER VALUES
INT ISS(040); INT TO HOLD NUMBERS-MAIN STACK
INT ITU; VALUE OF PARAMETER TO USE
INT IUU; SYMBOL GENERATOR(UNIQUE)
INT IXX; WORK
INT IYY; WORK
BEGINMAIN(AC,IAV)
NL=+KCR
LF=+KLF
GOSUB CR

MS 'COPYRIGHT'
MS ' (C) 1981'
MS ' W.A.GALE'
GOSUB CR
MS '8080 TINC'
MS 'MP COMPIL'
MS 'ER CP/M V'
MS 'ERSION 1.'
MS '05/TINCMP'
GOSUB CR
MS 'COPYRIGHT'
MS ' (C) 1981'
MS ' A L BEND'
MS 'ER, MD '
GOSUB CR
GOSUB IN
GOSUB RM
LOC 00
WHILE
READ CC FROM F1
AA=ER==C0
ON AA; THAT IS, UNTIL EOF IS REACHED ON INPUT

IF UG

WHILE
BB=CC==NL
DD=CC==LF
AA=CC==OG
EE=BB?DD
BB=CC==BL
AA=BB?AA
AA=EE?AA
ON AA; IGNORE LEADING CHARACTERS
GOSUB GC; READ CC FROM F1
ENDWHILE
ENDIF
BP=C1; BUF POINTER
BF(C0)=CC
WHILE
GOSUB GC; READ CC FROM F1
AA=CC==NL
IF AA
GOSUB GC; READ CC FROM F1
AA=CC==LF
IF AA
CC=NL
ENDIF
ENDIF
AA=CC!=NL
BB=BP!=C8
AA=AA&BB
ON AA; WHILE LESS THAN 80 CHAR AND NOT NEWLINE
BF(BP)=CC; THEN PUT IT IN BUFFER FOR MULT COMP
BP++

ENDWHILE
WHILE
AA=CC!=NL
ON AA

GOSUB GC; READ CC FROM F1
ENDWHILE; HERE WE ARE DUMPING A LONG INPUT LINE
BF(BP)=RC
BP++
BF(BP)=NL
LE=BP
AA=BP<=MM
IF AA; TOO SHORT TO MATCH
ML=+000
GOTO 17
ELSE
ML=+001
ENDIF
IDP=I00
PP=C0
IJJ=I00
INM=C0
WHILE
AA=IDP<!IED; DEF PTR < END OF DEFINITIONS
ON AA
BP=C0
WHILE
AA=BP<=LE
ON AA
AA=LS(IJJ)
AA=AA==RC
O3=BF(BP)
O3=O3==RC
AA=AA&O3; CHECK EOL MATCH TARG & TEMPLATE
IF AA
GOSUB DM; DO MACRO EXPANSION
GOTO 00
ELSE
AA=BF(BP)
BB=LS(IJJ)
AA=AA==BB
IF AA
GOTO 01; MATCHING
ELSE
AA=BB!=SF; NOT A TEMPLATE PARAMETER FLAG
IF AA
GOTO 10; MISMATCHED
ELSE; THIS IS A PARAMETER
PP++
AA=BF(BP)
IAA=AA
IPR(PP)=IAA
ENDIF
ENDIF
ENDIF
LOC 01

BP++
IJJ++
ENDWHILE
LOC 10
PP=C0
INM++
IDP=ILP(INM)
IJJ=IDP
ENDWHILE
LOC 17
BP=C0
WHILE
CC=BF(BP)
O1=BP+C1
AA=BF(O1)
AA=AA!=NL
ON AA
IF ML; THEN ALSO WRITE
WRITE CC
ENDIF
WRITE CC INTO F2
BP++
ENDWHILE
IF ML
GOSUB CR
ENDIF
IF UN; ONLY IF NOT SUPPRESSING
WRITE NL INTO F2
WRITE LF INTO F2
ENDIF
ENDWHILE
LOC 88; END OF SATISFACTORY COMPILATION
MS 'TINCMP CO'
MS 'MPILATION'
MS ' FINISHED'
GOSUB CR;
CLOSE F1
CLOSE F2
ENDMAIN
SUB GC; GETS THE NEXT CHARACTER INTO CC GOES TO 88 ON END
READ CC FROM F1
AA=ER!=C0
IF AA; IF NOT NORMAL READ OPERATION
GOTO 88; !!!! NOT GOOD PROGRAMMING PRACTICE AT ALL !!!!
ENDIF
AA=CC==EF; IF CHARACTER WAS EOF MARK
IF AA; IN CP/M SYSTEM THIS CAN BE RETURNED TO USER
GOTO 88; !!!! NOT GOOD PROGRAMMING PRACTICE AT ALL !!!!
ENDIF
ENDSUB; GC - GET CHARACTER FROM INPUT FILE
SUB SD; CONVERTS TOUSE TO A NUMBER WITHOUT ZRO LEADING
AA=ITU<!I00
IF AA
BB=+001
ITU=-ITU
ELSE
BB=+000
ENDIF
AA=ITU==I00
IF AA
ND=C1
DS(C0)=ZR
ELSE
ND=C0
WHILE
AA=I00<!ITU
ON AA
IYY=ITU/I10
IAA=I10*IYY
IXX=ITU-IAA
ITU=IYY
AA=IXX

AA=AA+ZR
DS(ND)=AA
ND++
ENDWHILE
ENDIF
DS(ND)=OR
ND=ND+BB; INCR FOR NEG INTEGER ONLY
ENDSUB

SUB WN; WRITE NUMBER INTO F2

GOSUB SD; STACK THE DIGITS
WHILE; NOW WRITE THEM OUT FIRST TO LAST
IAA=ND
AA=I00<!IAA
ON AA
ND--
AA=DS(ND)
WRITE AA INTO F2
ENDWHILE
ENDSUB

SUB PN; WRITE THE NUMBER ON THE TERMINAL

GOSUB SD; STACK THE DIGITS
WHILE
IAA=ND
AA=I00<!IAA
ON AA
ND--
AA=DS(ND)
WRITE AA
ENDWHILE
WRITE BL
ENDSUB

SUB CD; CONVERT AA AS A DECIMAL DIGIT

BB=ZR<=AA
CC=AA<=C9
BB=BB&CC
IF BB

AA=AA-ZR
RETURN
ENDIF
AA=C0
ENDSUB

SUB CH; CONVERT AA AS HEX DIGIT

BB=ZR<=AA
CC=AA<=C9
BB=BB&CC
IF BB
AA=AA-ZR
RETURN
ENDIF
BB=HA<=AA
CC=AA<=HF
BB=BB&CC
IF BB
AA=AA-HA
AA=AA+CX

RETURN
ENDIF
AA=C0
ENDSUB

SUB IN; INITIALIZE

ILM=+08920
I00=+00000
I01=+00001
I10=+00010
I09=+00009
C0=+000
C1=+001
C2=+002
C3=+003
EF=+KEF
C4=+040
C8=+080
I16=+00016
SP=+000
C9='9'
ZR='0'
BL=' '
HF='F'
HA='A'
CX=+010
IBC=I01
TR='R'
CLOSE F1
ASSOCIATE FCB 1 WITH IBC
OPEN F1 FOR TR AT IBC
TR='W'
IBC++
CLOSE F2
ASSOCIATE FCB 2 WITH IBC
OPEN F2 FOR TR AT IBC
READ AA FROM F1; X SUPPRESSES NEW LINE OUTPUT
OT='T'
UT=+000
BB='X'
UN=AA!=BB; UN SAYS CHARACTER WAS NOT X SO DONT SUPPRESS
READ RB FROM F1
READ RC FROM F1; COMMENT AND EOL FLAG
READ SF FROM F1; TEMPLATE PARAMETER FLAG
READ MF FROM F1; EXPANSION OPERATION FLAG
BB='X'
AA=MF==BB
IF AA
UO=C0
ELSE
UO=C1
ENDIF
OP='P'; PARAMETER DESIGNATOR IN OPERATION SEQUENCE
OE='@'; ESCAPE CHARACTER
OD='V'; CONVERT PARAMETER TO DIGIT IN ACTION SEQUENCE
OB='!'; POP STACK DESIGNATOR IN OPERATION SEQUENCE
OS='S'; STACK DESIGNATOR IN OPERATION SEQUENCE
OH='H'; HEX CONSTANT FETCH AND WRITE

ON='N'; LITERAL NUMERIC FETCH
OL='L'; LITERAL BYTE FETCH
OC='C'; CHARACTER OUT DESIGNATION
OA='+'; ADD TO STACK DESIGNATION
OR='-'; SUBTRACT (REDUCE) FROM STACK
OM='*'; MULTIPLY STACK BY BASE AND ADD
READ OG FROM F1; IGNORE CHARACTER
AA='X'
BB=AA==OG
IF BB
UG=+000
ELSE
UG=+001
ENDIF
READ CC FROM F1; NEW LINE
AA=NL!=CC; NL IS NEWLINE
IF AA
MS 'FLAG LINE'
STOP 1
ENDIF
IUU=+00100
ENDSUB; IN
SUB RM; READ MACROS
III=I00
INM=C0
MM=+127
WHILE
READ CC FROM F1
AA=ER==C0

ON AA
CHOOSE ON CC
CASE OE;ACCEPT THE NEXT CHARACTER UNCRITICALLY
READ CC FROM F1
GOTO 77
CASE RB;BEGIN A DEFINITION
ILP(INM)=III
INM++
ML=+000

CASE NL;IGNORE
CASE LF;IGNORE
CASE RC;IGNORE FOLLOWING COMMENTS AND MARK LINE END
LS(III)=RC
III++
AA=ML<!MM
IF AA;THIS LINE IS SHORTEST YET
MM=ML

ENDIF
WHILE
READ CC FROM F1
AA=CC!=LF
ON AA
ENDWHILE
CASE OG;IF USING IGNORE, IGNORE
IF UG
ELSE
GOTO 77

ENDIF
DEFAULT;
LOC 77
LS(III)=CC
III++
AA=ILM<!III
IF AA
MS 'MACMEMXST'
GOSUB CR
CLOSE F1
STOP 5
ENDIF
ML++
ENDCHOOSE
ENDWHILE
AA=CC!=EF
IF AA
MS 'DEFN READ'
STOP 2
ENDIF
CLOSE F1
IBC=+00003
ASSOCIATE FCB 3 WITH IBC
TR='R'
OPEN F1 FOR TR AT IBC
IED=III;END OF DEFINITIONS
MS 'LOADED...'
ITU=III
GOSUB PN
MS '.BYTES FO'
MS 'R DEFINES'
GOSUB CR
ILP(INM)=III
ITU=INM
GOSUB PN
MS '.MACROS..'
ITU=MM
GOSUB PN
MS ' MIN LEN.'
GOSUB CR
ENDSUB; RM
SUB CR; DO CARRIAGE RETURN/LINE FEED SEQUENCE
WRITE NL
WRITE LF
ENDSUB; CR

SUB DM; DO MACRO EXPANSION

IMP=IJJ+I01
INM++
IDP=ILP(INM)
WHILE
AA=IMP<!IDP
ON AA; UNTIL WE HAVE READ UP TO THE NEXT MACRO DEFINITION
AA=LS(IMP)
IF UO
AA=AA==MF
ELSE
AA=C0
ENDIF
IF AA; OPERATION CODE
IMP++
O1=LS(IMP); FROM INDICATOR
IMP++
AA=LS(IMP)
O2=AA
GOSUB CD; FOR DIGIT CONVERSION
DG=AA
IMP++
O3=LS(IMP); DESTAD
IF UT
WRITE O1
WRITE O2
WRITE O3
ENDIF
CHOOSE ON O1
CASE OP; FETCH PARAMETER
ITU=IPR(DG)
CASE OD; CONVERT FROM DIGIT TO CHARACTER
IAA=IPR(DG)
AA=IAA
GOSUB CD
ITU=AA
CASE OB; POP STACK
ITU=ISS(SP)
AA=SP<=C0
IF AA
MS 'S STACKER'
GOSUB CR
SP=C1
ENDIF
SP--
CASE OS; FETCH FROM STACK WITHOUT POPPING IT
ITU=ISS(SP)
CASE OH; FETCH AND WRITE HEX CONSTANT BYTE
AA=O2
GOSUB CH
IAA=AA
IAA=IAA*I16
AA=O3
GOSUB CH
IBB=AA
ITU=IAA+IBB
O3=OC
CASE OL; LITERAL BYTE FETCH
ITU=O2
CASE ON; LITERAL DIGIT FETCH
AA=O2
GOSUB CD
ITU=AA
CASE OT; TURN ON TRACE MODE
UT=+001
DEFAULT; FETCH A UNIQUE NUMBER
ITU=IUU
IUU++
ENDCHOOSE
IF UT
III=ITU
GOSUB PN
ITU=ISS(SP)
GOSUB PN
ITU=SP
GOSUB PN
ITU=III
GOSUB CR
ENDIF
CHOOSE ON O3
CASE OC; CHARACTER OUTPUT
AA=ITU
WRITE AA INTO F2
CASE OS; PUT ON STACK
SP++
AA=C4<=SP
IF AA
MS 'S OVERFLO'
GOSUB CR
SP=C4
ENDIF
ISS(SP)=ITU
CASE OP; PUT INTO PARAMETER LOCATION
IPR(DG)=ITU
CASE OA; ADD TO STACK
IAA=ISS(SP)
IAA=IAA+ITU
ISS(SP)=IAA
CASE OR; REDUCE (SUBTRACT) FROM STACK
IAA=ISS(SP)
IAA=IAA-ITU
ISS(SP)=IAA
CASE OM; MULTIPLY BY BASE AND ADD
IAA=ISS(SP)
IAA=IAA*I10
IAA=IAA+ITU
ISS(SP)=IAA
CASE OH; OUTPUT HIGH BYTE
UNPACK(ITU,AA,BB)
WRITE AA INTO F2
DEFAULT; WRITE OUT AS A DECIMAL NUMBER
GOSUB WN
ENDCHOOSE
ELSE; END OF ACTION SECTION
AA=LS(IMP)
IF UN
BB=AA!=RC
ELSE
BB=C1
ENDIF
IF BB
WRITE AA INTO F2
ELSE
WRITE NL INTO F2
WRITE LF INTO F2
ENDIF
ENDIF
IMP++
ENDWHILE
UT=+000
ENDSUB; DM
BOTTOM; END OF TINCMP 8080 CP/M COMPILER