6955 lines
158 KiB
NASM
6955 lines
158 KiB
NASM
TITLE BASIC M6502 8K VER 1.1 BY MICRO-SOFT
|
|
SEARCH M6502
|
|
SALL
|
|
RADIX 10 ;THROUGHOUT ALL BUT MATH-PAK.
|
|
|
|
$Z:: ;STARTING POINT FOR M6502 SIMULATOR
|
|
ORG 0 ;START OFF AT LOCATION ZERO.
|
|
SUBTTL SWITCHES,MACROS.
|
|
|
|
REALIO=4 ;5=STM
|
|
;4=APPLE.
|
|
;3=COMMODORE.
|
|
;2=OSI
|
|
;1=MOS TECH,KIM
|
|
;0=PDP-10 SIMULATING 6502
|
|
INTPRC==1 ;INTEGER ARRAYS.
|
|
ADDPRC==1 ;FOR ADDITIONAL PRECISION.
|
|
LNGERR==0 ;LONG ERROR MESSAGES.
|
|
TIME== 0 ;CAPABILITY TO SET AND READ A CLK.
|
|
EXTIO== 0 ;EXTERNAL I/O.
|
|
DISKO== 0 ;SAVE AND LOAD COMMANDS
|
|
NULCMD==1 ;FOR THE "NULL" COMMAND
|
|
GETCMD==1
|
|
RORSW==1
|
|
ROMSW==1 ;TELLS IF THIS IS ON ROM.
|
|
CLMWID==14
|
|
LONGI==1 ;LONG INITIALIZATION SWITCH.
|
|
STKEND=511
|
|
BUFPAG==0
|
|
LINLEN==72 ;TERMINAL LINE LENGTH.
|
|
BUFLEN==72 ;INPUT BUFFER SIZE.
|
|
ROMLOC= ^O20000 ;ADDRESS OF START OF PURE SEGMENT.
|
|
KIMROM=1
|
|
IFE ROMSW,<KIMROM==0>
|
|
IFN REALIO-1,<KIMROM==0>
|
|
IFN ROMSW,<
|
|
RAMLOC= ^O40000 ;USED ONLY IF ROMSW=1
|
|
IFE REALIO,<ROMLOC= ^O20000 ;START AT 8K.
|
|
RAMLOC=^O1400>>
|
|
IFE REALIO-3,<
|
|
DISKO==1
|
|
RAMLOC==^O2000
|
|
ROMLOC=^O140000
|
|
NULCMD==0
|
|
GETCMD==1
|
|
linlen==40
|
|
BUFLEN==81
|
|
CQOPEN=^O177700
|
|
CQCLOS=^O177703
|
|
CQOIN= ^O177706 ;OPEN CHANNEL FOR INPUT
|
|
CQOOUT=^O177711 ;FILL FOR COMMO.
|
|
CQCCHN=^O177714
|
|
CQINCH=^O177717 ;INCHR'S CALL TO GET A CHARACTER
|
|
OUTCH= ^O177722
|
|
CQLOAD=^O177725
|
|
CQSAVE=^O177730
|
|
CQVERF=^O177733
|
|
CQSYS= ^O177736
|
|
ISCNTC=^O177741
|
|
CZGETL=^O177744 ;CALL POINT FOR "GET"
|
|
CQCALL=^O177747 ;CLOSE ALL CHANNELS
|
|
CQTIMR=^O215
|
|
BUFPAG==2
|
|
BUF==256*BUFPAG
|
|
STKEND==507
|
|
CQSTAT=^O226
|
|
CQHTIM=^O164104
|
|
EXTIO==1
|
|
TIME==1
|
|
GETCMD==1
|
|
CLMWID==10
|
|
PI=255 ;VALUE OF PI CHARACTER FOR COMMODORE.
|
|
ROMSW==1
|
|
RORSW==1
|
|
TRMPOS=^O306>
|
|
IFE REALIO-1,<GETCMD==1
|
|
DISKO==1
|
|
OUTCH=^O17240 ;1EA0
|
|
ROMLOC==^O20000
|
|
RORSW==0
|
|
CZGETL=^O17132>
|
|
IFE REALIO-2,<
|
|
RORSW==0
|
|
RAMLOC==^O1000
|
|
IFN ROMSW,<
|
|
RORSW==0
|
|
RAMLOC==^O100000>
|
|
OUTCH==^O177013>
|
|
IFE REALIO-4,<
|
|
RORSW==1
|
|
NULCMD==0
|
|
GETCMD==1
|
|
CQINLN==^O176547
|
|
CQPRMP==^O63
|
|
CQINCH==^O176414
|
|
CQCOUT==^O177315
|
|
CQCSIN==^O177375
|
|
BUFPAG==2
|
|
BUF=BUFPAG*256
|
|
ROMLOC=^O4000
|
|
RAMLOC=^O25000 ;PAGE 2A
|
|
OUTCH=^O176755
|
|
CZGETL=^O176414
|
|
LINLEN==40
|
|
BUFLEN==240
|
|
RORSW==1
|
|
STKEND=507>
|
|
IFE RORSW,<
|
|
DEFINE ROR (WD),<
|
|
LDAI 0
|
|
BCC .+4
|
|
LDAI ^O200
|
|
LSR WD
|
|
ORA WD
|
|
STA WD>>
|
|
|
|
DEFINE ACRLF,<
|
|
13
|
|
10>
|
|
DEFINE SYNCHK (Q),<
|
|
LDAI <Q>
|
|
JSR SYNCHR>
|
|
DEFINE DT(Q),<
|
|
IRPC Q,<IFDIF <Q><">,<EXP "Q">>>
|
|
DEFINE LDWD (WD),<
|
|
LDA WD
|
|
LDY <WD>+1>
|
|
DEFINE LDWDI (WD),<
|
|
LDAI <<WD>&^O377>
|
|
LDYI <<WD>/^O400>>
|
|
DEFINE LDWX (WD),<
|
|
LDA WD
|
|
LDX <WD>+1>
|
|
DEFINE LDWXI (WD),<
|
|
LDAI <<WD>&^O377>
|
|
LDXI <<WD>/^O400>>
|
|
DEFINE LDXY (WD),<
|
|
LDX WD
|
|
LDY <WD>+1>
|
|
DEFINE LDXYI (WD),<
|
|
LDXI <<WD>&^O377>
|
|
LDYI <<WD>/^O400>>
|
|
DEFINE STWD (WD),<
|
|
STA WD
|
|
STY <WD>+1>
|
|
DEFINE STWX (WD),<
|
|
STA WD
|
|
STX <WD>+1>
|
|
DEFINE STXY (WD),<
|
|
STX WD
|
|
STY <WD>+1>
|
|
DEFINE CLR (WD),<
|
|
LDAI 0
|
|
STA WD>
|
|
DEFINE COM (WD),<
|
|
LDA WD
|
|
EORI ^O377
|
|
STA WD>
|
|
DEFINE PULWD (WD),<
|
|
PLA
|
|
STA WD
|
|
PLA
|
|
STA <WD>+1>
|
|
DEFINE PSHWD (WD),<
|
|
LDA <WD>+1
|
|
PHA
|
|
LDA WD
|
|
PHA>
|
|
DEFINE JEQ (WD),<
|
|
BNE .+5
|
|
JMP WD>
|
|
DEFINE JNE (WD),<
|
|
BEQ .+5
|
|
JMP WD>
|
|
DEFINE BCCA(Q),< BCC Q> ;BRANCHES THAT ALWAYS BRANCH
|
|
DEFINE BCSA(Q),< BCS Q> ;THESE ARE USED ON THE 6502 BECAUSE
|
|
DEFINE BEQA(Q),< BEQ Q> ;THERE IS NO UNCONDITIONAL BRANCH
|
|
DEFINE BNEA(Q),< BNE Q>
|
|
DEFINE BMIA(Q),< BMI Q>
|
|
DEFINE BPLA(Q),< BPL Q>
|
|
DEFINE BVCA(Q),< BVC Q>
|
|
DEFINE BVSA(Q),< BVS Q>
|
|
DEFINE INCW(R),<
|
|
INC R
|
|
BNE %Q
|
|
INC R+1
|
|
%Q:>
|
|
DEFINE SKIP1, <XWD ^O1000,^O044> ;BIT ZERO PAGE TRICK.
|
|
DEFINE SKIP2, <XWD ^O1000,^O054> ;BIT ABS TRICK.
|
|
IF1,<
|
|
IFE REALIO,<PRINTX/SIMULATE/>
|
|
IFE REALIO-1,<PRINTX KIM>
|
|
IFE REALIO-2,<PRINTX OSI>
|
|
IFE REALIO-3,<PRINTX COMMODORE>
|
|
IFE REALIO-4,<PRINTX APPLE>
|
|
IFE REALIO-5,<PRINTX STM>
|
|
IFN ADDPRC,<PRINTX ADDITIONAL PRECISION>
|
|
IFN INTPRC,<PRINTX INTEGER ARRAYS>
|
|
IFN LNGERR,<PRINTX LONG ERRORS>
|
|
IFN DISKO,<PRINTX SAVE AND LOAD>
|
|
IFE ROMSW,<PRINTX RAM>
|
|
IFN ROMSW,<PRINTX ROM>
|
|
IFE RORSW,<PRINTX NO ROR>
|
|
IFN RORSW,<PRINTX ROR ASSUMED>>
|
|
PAGE
|
|
SUBTTL INTRODUCTION AND COMPILATION PARAMETERS.
|
|
COMMENT *
|
|
|
|
--------- ---- -- ---------
|
|
COPYRIGHT 1976 BY MICROSOFT
|
|
--------- ---- -- ---------
|
|
7/27/78 FIXED BUG WHERE FOR VARIABLE AT BYTE FF MATCHED RETURN SEARCHING
|
|
FOR GOSUB ENTRY ON STACK IN FNDFOR CALL BY CHANGING STA FORPNT
|
|
TO STA FORPNT+1. THIS IS A SERIOUS BUG IN ALL VERSIONS.
|
|
7/27/78 FIXED BUG AT NEWSTT UNDER IFN BUFPAG WHEN CHECK OF CURLIN
|
|
WAS DONE BEFORE CURLIN SET UP SO INPUT RETRIES OF FIRST STATEMENT
|
|
WAS GIVING SYNTAX ERROR INSTEAD OF REDO FROM START (CODE WAS 12/1/77 FIX)
|
|
7/1/78 SAVED A FEW BYTES IN INIT FOR COMMODORE (14)
|
|
7/1/78 FIXED BUG WHERE REPLACING A LINE OVERFLOWING MEMORY LEFT LINKS
|
|
IN A BAD STATE. (CODE AT NODEL AND FINI) BUG#4
|
|
7/1/78 FIXED BUG WHERE GARBAGE COLLECTION NEVER(!) COLLECTS TEMPS
|
|
(STY GRBPNT AT FNDVAR, LDA GRBPNT ORA GRBPNT+1 AT GRBPAS)
|
|
THIS WAS COMMODORE BUG #2
|
|
7/1/78 FIXED BUG WHERE DELETE/INSERT OF LINE COULD CAUSE A GARBAGE COLLECTION WITH BAD VARTAB IF OUT OF MEMORY
|
|
(LDWD MEMSIZ STWD FRETOP=JSR RUNC CLC ALSO AT NODEL)
|
|
3/9/78 EDIT TO FIX COMMO TRMPOS AND CHANGE LEFT$ AND RIGHT$ TO ALLOW A SECOND ARGUMENT OF 0 AND RETURN A NULL STRING
|
|
2/25/78 FIXED BUG THAT INPFLG WAS SET WRONG WHEN BUFPAG.NE.0
|
|
INCREASED NUMLEV FROM 19 TO 23
|
|
2/11/78 DISALLOWED SPACES IN RESERVED WORDS. PUT IN SPECIAL CHECK FOR "GO TO"
|
|
2/11/78 FIXED BUG WHERE ROUNDING OF THE FAC BEFORE PUSHING COULD CAUSE A STRING POINTER
|
|
IN THE FAC TO BE INCREMENTED
|
|
1/24/78 fixed problem where user defined function undefined check fix was smashing error number in [x]
|
|
12/1/77 FIXED PROBLEM WHERE PEEK WAS SMASHING (POKER) CAUSING POKE OF PEEK TO FAIL
|
|
12/1/77 FIXED PROBLEM WHERE PROBLEM WITH VARTXT=LINNUM=BUF-2 CAUSING BUF-1 COMMA TO DISAPPEAR
|
|
12/1/77 FIXED BUFPAG.NE.0 PROBLEM AT NEWSTT AND STOP : CODE WAS STILL
|
|
ASSUMING TXTPTR+1.EQ.0 IFF STATEMENT WAS DIRECT
|
|
*
|
|
NUMLEV==23 ;NUMBER OF STACK LEVELS RESERVED
|
|
;BY AN EXPLICIT CALL TO "GETSTK".
|
|
STRSIZ==3 ;# OF LOCS PER STRING DESCRIPTOR.
|
|
NUMTMP==3 ;NUMBER OF STRING TEMPORARIES.
|
|
CONTW==15 ;CHARACTER TO SUPPRESS OUTPUT.
|
|
|
|
PAGE
|
|
SUBTTL SOME EXPLANATION.
|
|
COMMENT *
|
|
|
|
M6502 BASIC CONFIGURES BASIC AS FOLLOWS
|
|
|
|
LOW LOCATIONS
|
|
PAGE ZERO
|
|
|
|
STARTUP:
|
|
INITIALLY A JMP TO INITIALIZATION CODE BUT
|
|
CHANGED TO A JMP TO "READY".
|
|
RESTARTING THE MACHINE AT LOC 0 DURING PROGRAM
|
|
EXECUTION CAN LEAVE THINGS MESSED UP.
|
|
|
|
LOC OF FAC TO INTEGER AND INTEGER TO FAC
|
|
ROUTINES.
|
|
|
|
"DIRECT" MEMORY:
|
|
THESE ARE THE MOST COMMONLY USED LOCATIONS.
|
|
THEY HOLD BOOKKEEPING INFO AND ALL OTHER
|
|
FREQUENTLY USED INFORMATION.
|
|
ALL TEMPORARIES, FLAGS, POINTERS, THE BUFFER AREA,
|
|
THE FLOATING ACCUMULATOR, AND ANYTHING ELSE THAT
|
|
IS USED TO STORE A CHANGING VALUE SHOULD BE LOCATED
|
|
IN THIS AREA. CARE MUST BE MADE IN MOVING LOCATIONS
|
|
IN THIS AREA SINCE THE JUXTAPOSITION OF TWO LOCATIONS
|
|
IS OFTEN DEPENDED UPON.
|
|
|
|
STILL IN RAM WE HAVE THE BEGINNING OF THE "CHRGET"
|
|
SUBROUTINE. IT IS HERE SO [TXTPTR] CAN BE THE
|
|
EXTENDED ADDRESS OF A LOAD INSTRUCTION.
|
|
THIS SAVES HAVING TO BOTHER ANY REGISTERS.
|
|
|
|
PAGE ONE
|
|
THE STACK.
|
|
|
|
STORAGE PAGE TWO AND ON
|
|
IN RAM VERSIONS THESE DATA STRUCTURES COME AT THE
|
|
END OF BASIC. IN ROM VERSON THEY ARE AT RAMLOC WHICH
|
|
CAN EITHER BE ABOVE OR BELOW ROMLOC, WHICH IS WHERE
|
|
BASIC ITSELF RESIDES.
|
|
|
|
A ZERO.
|
|
[TXTTAB] POINTER TO NEXT LINE'S POINTER.
|
|
LINE # OF THIS LINE (2 BYTES).
|
|
CHARACTERS ON THIS LINE.
|
|
ZERO.
|
|
POINTER AT NEXT LINE'S POINTER
|
|
(POINTED TO BY THE ABOVE POINTER).
|
|
... REPEATS ...
|
|
LAST LINE: POINTER AT ZERO POINTER.
|
|
LINE # OF THIS LINE.
|
|
CHARACTERS ON THIS LINE.
|
|
ZERO.
|
|
DOUBLE ZERO (POINTED TO BY THE ABOVE POINTER).
|
|
[VARTAB] SIMPLE VARIABLES. 6 BYTES PER VALUE.
|
|
2 BYTES GIVE THE NAME, 4 BYTES THE VALUE.
|
|
... REPEATS ...
|
|
[ARYTAB] ARRAY VARIABLES. 2 BYTES NAME, 2 BYTE
|
|
LENGTH, NUMBER OF DIMENSIONS , EXTENT OF
|
|
EACH DIMENSION (2BYTES/), VALUES
|
|
... REPEATS ...
|
|
[STREND] FREE SPACE.
|
|
... REPEATS ...
|
|
[FRETOP] STRING SPACE IN USE.
|
|
... REPEATS ...
|
|
[MEMSIZ] HIGHEST MACHINE LOCATION.
|
|
UNUSED EXCEPT BY THE VAL FUNCTION.
|
|
|
|
ROM -- CONSTANTS AND CODE.
|
|
|
|
FUNCTION DISPATCH ADDRESSES (AT ROMLOC)
|
|
"FUNDSP" CONTAINS THE ADDRESSES OF THE
|
|
FUNCTION ROUTINES IN THE ORDER OF THE
|
|
FUNCTION NAMES IN THE CRUNCH LIST.
|
|
THE FUNCTIONS THAT TAKE MORE THAN ONE ARGUMENT
|
|
ARE AT THE END. SEE THE EXPLANATION AT "ISFUN".
|
|
|
|
THE OPERATOR LIST
|
|
THE "OPTAB" LIST CONTAINS AN OPERATOR'S PRECEDENCE
|
|
FOLLOWED BY THE ADDRESS OF THE ROUTINE TO PERFORM
|
|
THE OPERATION. THE INDEX INTO THE
|
|
OPERATOR LIST IS MADE BY SUBTRACTING OFF THE CRUNCH VALUE
|
|
OF THE LOWEST NUMBERED OPERATOR. THE ORDER
|
|
OF OPERATORS IN THE CRUNCH LIST AND IN "OPTAB" IS IDENTICAL.
|
|
THE PRECEDENCES ARE ARBITRARY EXCEPT FOR THEIR
|
|
COMPARATIVE SIZES. NOTE THAT THE PRECEDENCE FOR
|
|
UNARY OPERATORS SUCH AS "NOT" AND NEGATION ARE
|
|
SETUP SPECIALLY WITHOUT USING THE LIST.
|
|
|
|
THE RESERVED WORD OR CRUNCH LIST
|
|
WHEN A COMMAND OR PROGRAM LINE IS TYPED IN
|
|
IT IS STORED IN "BUF". AS SOON AS THE WHOLE LINE
|
|
HAS BEEN TYPED IN ("INLIN" RETURNS) "CRUNCH" IS
|
|
CALLED TO CONVERT ALL RESERVED WORDS TO THEIR
|
|
CRUNCHED VALUES. THIS REDUCES THE SIZE OF THE
|
|
PROGRAM AND SPEEDS UP EXECUTION BY ALLOWING
|
|
LIST DISPATCHES TO PERFORM FUNCTIONS, STATEMENTS,
|
|
AND OPERATIONS. THIS IS BECAUSE ALL THE STATEMENT
|
|
NAMES ARE STORED CONSECUTIVELY IN THE CRUNCH LIST.
|
|
WHEN A MATCH IS FOUND BETWEEN A STRING
|
|
OF CHARACTERS AND A WORD IN THE CRUNCH LIST
|
|
THE ENTIRE TEXT OF THE MATCHED WORD IS TAKEN OUT OF
|
|
THE INPUT LINE AND A RESERVED WORD TOKEN IS PUT
|
|
IN ITS PLACE. A RESERVED WORD TOKEN IS ALWAYS EQUAL
|
|
TO OCTAL 200 PLUS THE POSITION OF THE MATCHED WORD
|
|
IN THE CRUNCH LIST.
|
|
|
|
STATEMENT DISPATCH ADDRESSES
|
|
WHEN A STATEMENT IS TO BE EXECUTED, THE FIRST
|
|
CHARACTER OF THE STATEMENT IS EXAMINED
|
|
TO SEE IF IT IS LESS THAN THE RESERVED
|
|
WORD TOKEN FOR THE LOWEST NUMBERED STATEMENT NAME.
|
|
IF SO, THE "LET" CODE IS CALLED TO
|
|
TREAT THE STATEMENT AS AN ASSIGNMENT STATEMENT.
|
|
OTHERWISE A CHECK IS MADE TO MAKE SURE THE
|
|
RESERVED WORD NUMBER IS NOT TOO LARGE TO BE A
|
|
STATEMENT TYPE NUMBER. IF NOT THE ADDRESS
|
|
TO DISPATCH TO IS FETCHED FROM "STMDSP" (THE STATEMENT
|
|
DISPATCH LIST) USING THE RESERVED WORD
|
|
NUMBER FOR THE STATEMENT TO CALCULATE AN INDEX INTO
|
|
THE LIST.
|
|
|
|
ERROR MESSAGES
|
|
WHEN AN ERROR CONDITION IS DETECTED,
|
|
[ACCX] MUST BE SET UP TO INDICATE WHICH ERROR
|
|
MESSAGE IS APPROPRIATE AND A BRANCH MUST BE MADE
|
|
TO "ERROR". THE STACK WILL BE RESET AND ALL
|
|
PROGRAM CONTEXT WILL BE LOST. VARIABLES
|
|
VALUES AND THE ACTUAL PROGRAM REMAIN INTACT.
|
|
ONLY THE VALUE OF [ACCX] IS IMPORTANT WHEN
|
|
THE BRANCH IS MADE TO ERROR. [ACCX] IS USED AS AN
|
|
INDEX INTO "ERRTAB" WHICH GIVES THE TWO
|
|
CHARACTER ERROR MESSAGE THAT WILL BE PRINTED ON THE
|
|
USER'S TERMINAL.
|
|
|
|
|
|
TEXTUAL MESSAGES
|
|
CONSTANT MESSAGES ARE STORED HERE. UNLESS
|
|
THE CODE TO CHECK IF A STRING MUST BE COPIED
|
|
IS CHANGED THESE STRINGS MUST BE STORED ABOVE
|
|
PAGE ZERO, OR ELSE THEY WILL BE COPIED BEFORE
|
|
THEY ARE PRINTED.
|
|
|
|
FNDFOR
|
|
MOST SMALL ROUTINES ARE FAIRLY SIMPLE
|
|
AND ARE DOCUMENTED IN PLACE. "FNDFOR" IS
|
|
USED FOR FINDING "FOR" ENTRIES ON
|
|
THE STACK. WHENEVER A "FOR" IS EXECUTED, A
|
|
16-BYTE ENTRY IS PUSHED ONTO THE STACK.
|
|
BEFORE THIS IS DONE, HOWEVER, A CHECK
|
|
MUST BE MADE TO SEE IF THERE
|
|
ARE ANY "FOR" ENTRIES ALREADY ON THE STACK
|
|
FOR THE SAME LOOP VARIABLE. IF SO, THAT "FOR" ENTRY
|
|
AND ALL OTHER "FOR" ENTRIES THAT WERE MADE AFTER IT
|
|
ARE ELIMINATED FROM THE STACK. THIS IS SO A
|
|
PROGRAM THAT JUMPS OUT OF THE MIDDLE
|
|
OF A "FOR" LOOP AND THEN RESTARTS THE LOOP AGAIN
|
|
AND AGAIN WON'T USE UP 18 BYTES OF STACK
|
|
SPACE EVERY TIME. THE "NEXT" CODE ALSO
|
|
CALLS "FNDFOR" TO SEARCH FOR A "FOR" ENTRY WITH
|
|
THE LOOP VARIABLE IN
|
|
THE "NEXT". AT WHATEVER POINT A MATCH IS FOUND
|
|
THE STACK IS RESET. IF NO MATCH IS FOUND A
|
|
"NEXT WITHOUT FOR" ERROR OCCURS. GOSUB EXECUTION
|
|
ALSO PUTS A 5-BYTE ENTRY ON STACK.
|
|
WHEN A RETURN IS EXECUTED "FNDFOR" IS
|
|
CALLED WITH A VARIABLE POINTER THAT CAN'T
|
|
BE MATCHED. WHEN "FNDFOR" HAS RUN
|
|
THROUGH ALL THE "FOR" ENTRIES ON THE STACK
|
|
IT RETURNS AND THE RETURN CODE MAKES
|
|
SURE THE ENTRY THAT WAS STOPPED
|
|
ON IS A GOSUB ENTRY. THIS ASSURES THAT
|
|
IF YOU GOSUB TO A SECTION OF CODE
|
|
IN WHICH A FOR LOOP IS ENTERED BUT NEVER
|
|
EXITED THE RETURN WILL STILL BE
|
|
ABLE TO FIND THE MOST RECENT
|
|
GOSUB ENTRY. THE "RETURN" CODE ELIMINATES THE
|
|
"GOSUB" ENTRY AND ALL "FOR" ENTRIES MADE AFTER
|
|
THE GOSUB ENTRY.
|
|
|
|
NON-RUNTIME STUFF
|
|
THE CODE TO INPUT A LINE, CRUNCH IT, GIVE ERRORS,
|
|
FIND A SPECIFIC LINE IN THE PROGRAM,
|
|
PERFORM A "NEW", "CLEAR", AND "LIST" ARE
|
|
ALL IN THIS AREA. GIVEN THE EXPLANATION OF
|
|
PROGRAM STORAGE SET FORTH ABOVE, THESE ARE
|
|
ALL STRAIGHTFORWARD.
|
|
|
|
NEWSTT
|
|
WHENEVER A STATEMENT FINISHES EXECUTION IT
|
|
DOES A "RTS" WHICH TAKES
|
|
EXECUTION BACK TO "NEWSTT". STATEMENTS THAT
|
|
CREATE OR LOOK AT SEMI-PERMANENT STACK ENTRIES
|
|
MUST GET RID OF THE RETURN ADDRESS OF "NEWSTT" AND
|
|
JMP TO "NEWSTT" WHEN DONE. "NEWSTT" ALWAYS
|
|
CHRGETS THE FIRST CHARACTER AFTER THE STATEMENT
|
|
NAME BEFORE DISPATCHING. WHEN RETURNING
|
|
BACK TO "NEWSTT" THE ONLY THING THAT
|
|
MUST BE SET UP IS THE TEXT POINTER IN
|
|
"TXTPTR". "NEWSTT" WILL CHECK TO MAKE SURE
|
|
"TXTPTR" IS POINTING TO A STATEMENT TERMINATOR.
|
|
IF A STATEMENT SHOULDN'T BE PERFORMED UNLESS
|
|
IT IS PROPERLY FORMATTED (I.E. "NEW") IT CAN
|
|
SIMPLY DO A RETURN AFTER READING ALL OF
|
|
ITS ARGUMENTS. SINCE THE ZERO FLAG
|
|
BEING OFF INDICATES THERE IS NOT
|
|
A STATEMENT TERMINATOR "NEWSTT" WILL
|
|
DO THE JMP TO THE "SYNTAX ERROR"
|
|
ROUTINE. IF A STATEMENT SHOULD BE STARTED
|
|
OVER IT CAN DO LDWD OLDTXT, STWD TXTPTR RTS SINCE THE TEXT PNTR
|
|
AT "NEWSTT" IS ALWAYS STORED IN "OLDTXT".
|
|
THE ^C CODE STORES [CURLIN] (THE
|
|
CURRENT LINE NUMBER) IN "OLDLIN" SINCE THE ^C CHECK
|
|
IS MADE BEFORE THE STATEMENT POINTED TO IS
|
|
EXECUTED. "STOP" AND "END" STORE THE TEXT POINTER
|
|
FROM "TXTPTR", WHICH POINTS AT THEIR TERMINATING
|
|
CHARACTER, IN "OLDTXT".
|
|
|
|
STATEMENT CODE
|
|
THE INDIVIDUAL STATEMENT CODE COMES
|
|
NEXT. THE APPROACH USED IN EXECUTING EACH
|
|
STATEMENT IS DOCUMENTED IN THE STATEMENT CODE
|
|
ITSELF.
|
|
|
|
FRMEVL, THE FORMULA EVALUATOR
|
|
GIVEN A TEXT POINTER POINTING TO THE STARTING
|
|
CHARACTER OF A FORMULA, "FRMEVL"
|
|
EVALUATES THE FORMULA AND LEAVES
|
|
THE VALUE IN THE FLOATING ACCUMULATOR (FAC).
|
|
"TXTPTR" IS RETURNED POINTING TO THE FIRST CHARACTER
|
|
THAT COULD NOT BE INTERPRETED AS PART OF THE
|
|
FORMULA. THE ALGORITHM USES THE STACK
|
|
TO STORE TEMPORARY RESULTS:
|
|
|
|
0. PUT A DUMMY PRECEDENCE OF ZERO ON
|
|
THE STACK.
|
|
1. READ LEXEME (CONSTANT,FUNCTION,
|
|
VARIABLE,FORMULA IN PARENS)
|
|
AND TAKE THE LAST PRECEDENCE VALUE
|
|
OFF THE STACK.
|
|
2. SEE IF THE NEXT CHARACTER IS AN OPERATOR.
|
|
IF NOT, CHECK PREVIOUS ONE. THIS MAY CAUSE
|
|
OPERATOR APPLICATION OR AN ACTUAL
|
|
RETURN FROM "FRMEVL".
|
|
3. IF IT IS, SEE WHAT PRECEDENCE IT HAS
|
|
AND COMPARE IT TO THE PRECEDENCE
|
|
OF THE LAST OPERATOR ON THE STACK.
|
|
4. IF = OR LESS REMEMBER THE OPERATOR
|
|
POINTER OF THIS OPERATOR
|
|
AND BRANCH TO "QCHNUM" TO CAUSE
|
|
APPLICATION OF THE LAST OPERATOR.
|
|
EVENTUALLY RETURN TO STEP 2
|
|
BY RETURNING TO JUST AFTER "DOPREC".
|
|
5. IF GREATER PUT THE LAST PRECEDENCE
|
|
BACK ON, SAVE THE OPERATOR ADDRESS,
|
|
CURRENT TEMPORARY RESULT,
|
|
AND PRECEDENCE AND RETURN TO STEP 1.
|
|
|
|
RELATIONAL OPERATORS ARE ALL HANDLED THROUGH
|
|
A COMMON ROUTINE. SPECIAL
|
|
CARE IS TAKEN TO DETECT TYPE MISMATCHES SUCH AS 3+"F".
|
|
|
|
EVAL -- THE ROUTINE TO READ A LEXEME
|
|
"EVAL" CHECKS FOR THE DIFFERENT TYPES OF
|
|
ENTITIES IT IS SUPPOSED TO DETECT.
|
|
LEADING PLUSES ARE IGNORED,
|
|
DIGITS AND "." CAUSE "FIN" (FLOATING INPUT)
|
|
TO BE CALLED. FUNCTION NAMES CAUSE THE
|
|
FORMULA INSIDE THE PARENTHESES TO BE EVALUATED
|
|
AND THE FUNCTION ROUTINE TO BE CALLED. VARIABLE
|
|
NAMES CAUSE "PTRGET" TO BE CALLED TO GET A POINTER
|
|
TO THE VALUE, AND THEN THE VALUE IS PUT INTO
|
|
THE FAC. AN OPEN PARENTHESIS CAUSES "FRMEVL"
|
|
TO BE CALLED (RECURSIVELY), AND THE ")" TO
|
|
BE CHECKED FOR. UNARY OPERATORS (NOT AND
|
|
NEGATION) PUT THEIR PRECEDENCE ON THE STACK
|
|
AND ENTER FORMULA EVALUATION AT STEP 1, SO
|
|
THAT EVERYTHING UP TO AN OPERATOR GREATER THAN
|
|
THEIR PRECEDENCE OR THE END OF THE FORMULA
|
|
WILL BE EVALUATED.
|
|
|
|
DIMENSION AND VARIABLE SEARCHING
|
|
SPACE IS ALLOCATED FOR VARIABLES AS THEY ARE
|
|
ENCOUNTERED. THUS "DIM" STATEMENTS MUST BE
|
|
EXECUTED TO HAVE EFFECT. 6 BYTES ARE ALLOCATED
|
|
FOR EACH SIMPLE VARIABLE, WHETHER IT IS A STRING,
|
|
NUMBER OR USER DEFINED FUNCTION. THE FIRST TWO
|
|
BYTES GIVE THE NAME OF THE VARIABLE AND THE LAST FOUR
|
|
GIVE ITS VALUE. [VARTAB] GIVES THE FIRST LOCATION
|
|
WHERE A SIMPLE VARIABLE NAME IS FOUND AND [ARYTAB]
|
|
GIVES THE LOCATION TO STOP SEARCHING FOR SIMPLE
|
|
VARIABLES. A "FOR" ENTRY HAS A TEXT POINTER
|
|
AND A POINTER TO A VARIABLE VALUE SO NEITHER
|
|
THE PROGRAM OR THE SIMPLE VARIABLES CAN BE
|
|
MOVED WHILE THERE ARE ACTIVE "FOR" ENTRIES ON THE STACK.
|
|
USER DEFINED FUNCTION VALUES ALSO CONTAIN
|
|
POINTERS INTO SIMPLE VARIABLE SPACE SO NO USER-DEFINED
|
|
FUNCTION VALUES CAN BE RETAINED IF SIMPLE VARIABLES
|
|
ARE MOVED. ADDING A SIMPLE VARIABLE IS JUST
|
|
ADDING SIX TO [ARYTAB] AND [STREND], BLOCK TRANSFERING
|
|
THE ARRAY VARIABLES UP BY SIX AND MAKING SURE THE
|
|
NEW [STREND] IS NOT TOO CLOSE TO THE STRINGS.
|
|
THIS MOVEMENT OF ARRAY VARIABLES MEANS
|
|
THAT NO POINTER TO AN ARRAY WILL STAY VALID WHEN
|
|
NEW SIMPLE VARIABLES CAN BE ENCOUNTERED. THIS IS
|
|
WHY ARRAY VARIABLES ARE NOT ALLOWED FOR "FOR"
|
|
LOOP VARIABLES. SETTING UP A NEW ARRAY VARIABLE
|
|
MERELY INVOLVES BUILDING THE DESCRIPTOR,
|
|
UPDATING [STREND], AND MAKING SURE THERE IS
|
|
STILL ENOUGH ROOM BETWEEN [STREND] AND STRING SPACE.
|
|
"PTRGET", THE ROUTINE WHICH RETURNS A POINTER
|
|
TO A VARIABLE VALUE, HAS TWO IMPORTANT FLAGS. ONE IS
|
|
"DIMFLG" WHICH INDICATES WHETHER "DIM" CALLED "PTRGET"
|
|
OR NOT. IF SO, NO PRIOR ENTRY FOR THE VARIABLE IN
|
|
QUESTION SHOULD BE FOUND, AND THE INDEX INDICATES
|
|
HOW MUCH SPACE TO SET ASIDE. SIMPLE VARIABLES CAN
|
|
BE "DIMENSIONED", BUT THE ONLY EFFECT WILL BE TO
|
|
SET ASIDE SPACE FOR THE VARIABLE IF IT HASN'T BEEN
|
|
ENCOUNTERED YET. THE OTHER IMPORTANT FLAG IS "SUBFLG"
|
|
WHICH INDICATES WHETHER A SUBSCRIPTED VARIABLE SHOULD BE
|
|
ALLOWED IN THE CURRENT CONTEXT. IF [SUBFLG] IS NON-ZERO
|
|
THE OPEN PARENTHESIS FOR A SUBSCRIPTED VARIABLE
|
|
WILL NOT BE SCANNED BY "PTRGET", AND "PTRGET" WILL RETURN
|
|
WITH A TEXT POINTER POINTING TO THE "(", IF
|
|
THERE WAS ONE.
|
|
STRINGS
|
|
IN THE VARIABLE TABLES STRINGS ARE STORED JUST LIKE
|
|
NUMERIC VARIABLES. SIMPLE STRINGS HAVE THREE VALUE
|
|
BYTES WHICH ARE INITIALIZED TO ALL ZEROS (WHICH
|
|
REPRESENTS THE NULL STRING). THE ONLY DIFFERENCE
|
|
IN HANDLING IS THAT WHEN "PTRGET" SEES A "$" AFTER THE
|
|
NAME OF A VARIABLE, "PTRGET" SETS [VALTYP]
|
|
TO NEGATIVE ONE AND TURNS
|
|
ON THE MSB (MOST-SIGNIFIGANT-BIT) OF THE VALUE OF
|
|
THE FIRST CHARACTER OF THE VARIABLE NAME.
|
|
HAVING THIS BIT ON IN THE NAME OF THE VARIABLE ENSURES
|
|
THAT THE SEARCH ROUTINE WILL NOT MATCH
|
|
'A' WITH 'A$' OR 'A$' WITH 'A'. THE MEANING OF
|
|
THE THREE VALUE BYTES ARE:
|
|
LOW
|
|
LENGTH OF THE STRING
|
|
LOW 8 BITS
|
|
HIGH 8 BITS OF THE ADDRESS
|
|
OF THE CHARACTERS IN THE
|
|
STRING IF LENGTH.NE.0.
|
|
MEANINGLESS OTHERWISE.
|
|
HIGH
|
|
THE VALUE OF A STRING VARIABLE (THESE 3 BYTES)
|
|
IS CALLED THE STRING DESCRIPTOR TO DISTINGUISH
|
|
IT FROM THE ACTUAL STRING DATA. WHENEVER A
|
|
STRING CONSTANT IS ENCOUNTERED IN A FORMULA OR AS
|
|
PART OF AN INPUT STRING, OR AS PART OF DATA, "STRLIT"
|
|
IS CALLED, CAUSING A DESCRIPTOR TO BE BUILT FOR
|
|
THE STRING. WHEN ASSIGNMENT IS MADE TO A STRING POINTING INTO
|
|
"BUF" THE VALUE IS COPIED INTO STRING SPACE SINCE [BUF]
|
|
IS ALWAYS CHANGING.
|
|
|
|
STRING FUNCTIONS AND THE ONE STRING OPERATOR "+"
|
|
ALWAYS RETURN THEIR VALUES IN STRING SPACE.
|
|
ASSIGNING A STRING A CONSTANT VALUE IN A PROGRAM
|
|
THROUGH A "READ" OR ASSIGNMENT STATEMENT
|
|
WILL NOT USE ANY STRING SPACE SINCE
|
|
THE STRING DESCRIPTOR WILL POINT INTO THE
|
|
PROGRAM ITSELF. IN GENERAL, COPYING IS DONE
|
|
WHEN A STRING VALUE IS IN "BUF", OR IT IS IN STRING
|
|
SPACE AND THERE IS AN ACTIVE POINTER TO IT.
|
|
THUS F$=G$ WILL CAUSE COPYING IF G$ HAS ITS
|
|
STRING DATA IN STRING SPACE. F$=CHR$(7)
|
|
WILL USE ONE BYTE OF STRING SPACE TO STORE THE
|
|
NEW ONE CHARACTER STRING CREATED BY "CHR$", BUT
|
|
THE ASSIGNMENT ITSELF WILL CAUSE NO COPYING SINCE
|
|
THE ONLY POINTER AT THE NEW STRING IS A
|
|
TEMPORARY DESCRIPTOR CREATED BY "FRMEVL" WHICH WILL
|
|
GO AWAY AS SOON AS THE ASSIGNMENT IS DONE.
|
|
IT IS THE NATURE OF GARBAGE COLLECTION THAT
|
|
DISALLOWS HAVING TWO STRING DESCRIPTORS POINT TO THE SAME
|
|
AREA IN STRING SPACE. STRING FUNCTIONS AND OPERATORS
|
|
MUST PROCEED AS FOLLOWS:
|
|
1) FIGURE OUT THE LENGTH OF THEIR RESULT.
|
|
|
|
2) CALL "GETSPA" TO FIND SPACE FOR THEIR
|
|
RESULT. THE ARGUMENTS TO THE FUNCTION
|
|
OR OPERATOR MAY CHANGE SINCE GARBAGE COLLECTION
|
|
MAY BE INVOKED. THE ONLY THING THAT CAN
|
|
BE SAVED DURING THE CALL TO "GETSPA" IS A POINTER
|
|
TO THE DESCRIPTORS OF THE ARGUMENTS.
|
|
3) CONSTRUCT THE RESULT DESCRIPTOR IN "DSCTMP".
|
|
"GETSPA" RETURNS THE LOCATION OF THE AVAILABLE
|
|
SPACE.
|
|
4) CREATE THE NEW VALUE BY COPYING PARTS
|
|
OF THE ARGUMENTS OR WHATEVER.
|
|
5) FREE UP THE ARGUMENTS BY CALLING "FRETMP".
|
|
6) JUMP TO "PUTNEW" TO GET THE DESCRIPTOR IN
|
|
"DSCTMP" TRANSFERRED INTO A NEW STRING TEMPORARY.
|
|
|
|
THE REASON FOR STRING TEMPORARIES IS THAT GARBAGE
|
|
COLLECTION HAS TO KNOW ABOUT ALL ACTIVE STRING DESCRIPTORS
|
|
SO IT KNOWS WHAT IS AND ISN'T IN USE. STRING TEMPORARIES ARE
|
|
USED TO STORE THE DESCRIPTORS OF STRING EXPRESSIONS.
|
|
|
|
INSTEAD OF HAVING AN ACTUAL VALUE STORED IN THE
|
|
FAC, AND HAVING THE VALUE OF A TEMPORARY RESULT
|
|
BEING SAVED ON THE STACK, AS HAPPENS WITH NUMERIC
|
|
VARIABLES, STRINGS HAVE THE POINTER TO A STRING DESCRIPTOR
|
|
STORED IN THE FAC, AND IT IS THIS POINTER
|
|
THAT GETS SAVED ON THE STACK BY FORMULA EVALUATION.
|
|
STRING FUNCTIONS CANNOT FREE THEIR ARGUMENTS UP RIGHT
|
|
AWAY SINCE "GETSPA" MAY FORCE
|
|
GARBAGE COLLECTION AND THE ARGUMENT STRINGS
|
|
MAY BE OVER-WRITTEN SINCE GARBAGE COLLECTION
|
|
WILL NOT BE ABLE TO FIND AN ACTIVE POINTER TO
|
|
THEM. FUNCTION AND OPERATOR RESULTS ARE BUILT IN
|
|
"DSCTMP" SINCE STRING TEMPORARIES ARE ALLOCATED
|
|
(PUTNEW) AND DEALLOCATED (FRETMP) IN A FIFO ORDERING
|
|
(I.E. A STACK) SO THE NEW TEMPORARY CANNOT
|
|
BE SET UP UNTIL THE OLD ONE(S) ARE FREED. TRYING
|
|
TO BUILD A RESULT IN A TEMPORARY AFTER
|
|
FREEING UP THE ARGUMENT TEMPORARIES COULD RESULT
|
|
IN ONE OF THE ARGUMENT TEMPORARIES BEING OVERWRITTEN
|
|
TOO SOON BY THE NEW RESULT.
|
|
|
|
STRING SPACE IS ALLOCATED AT THE VERY TOP
|
|
OF MEMORY. "MEMSIZ" POINTS BEYOND THE LAST LOCATION OF
|
|
STRING SPACE. STRINGS ARE STORED IN HIGH LOCATIONS
|
|
FIRST. WHENEVER STRING SPACE IS ALLOCATED (GETSPA).
|
|
[FRETOP], WHICH IS INITIALIZED TO [MEMSIZ], IS UPDATED
|
|
TO GIVE THE HIGHEST LOCATION IN STRING SPACE
|
|
THAT IS NOT IN USE. THE RESULT IS THAT
|
|
[FRETOP] GETS SMALLER AND SMALLER, UNTIL SOME
|
|
ALLOCATION WOULD MAKE [FRETOP] LESS THAN OR EQUAL TO
|
|
[STREND]. THIS MEANS STRING SPACE HAS RUN INTO THE
|
|
THE ARRAYS AND THAT GARBAGE COLLECTION MUST BE CALLED.
|
|
|
|
GARBAGE COLLECTION:
|
|
0. [MINPTR]=[STREND] [FRETOP]=[MEMSIZ]
|
|
1. [REMMIN]=0
|
|
2. FOR EACH STRING DESCRIPTOR
|
|
(TEMPORARIES, SIMPLE STRINGS, STRING ARRAYS)
|
|
IF THE STRING IS NOT NULL AND ITS POINTER IS
|
|
.GT.MINPTR AND .LT.FRETOP,
|
|
[MINPTR]=THIS STRING DESCRIPTOR'S POINTER,
|
|
[REMMIN]=POINTER AT THIS STRING DESCRIPTOR.
|
|
END.
|
|
3. IF REMMIN.NE.0 (WE FOUND AN UNCOLLECTED STRING),
|
|
BLOCK TRANSFER THE STRING DATA POINTED
|
|
TO IN THE STRING DESCRIPTOR POINTED TO BY "REMMIN"
|
|
SO THAT THE LAST BYTE OF STRING DATA IS AT
|
|
[FRETOP]. UPDATE [FRETOP] SO THAT IT
|
|
POINTS TO THE LOCATION JUST BELOW THE ONE
|
|
THE STRING DATA WAS MOVED INTO. UPDATE
|
|
THE POINTER IN THE DESCRIPTOR SO IT POINTS
|
|
TO THE NEW LOCATION OF THE STRING DATA.
|
|
GO TO STEP 1.
|
|
|
|
AFTER CALLING GARBAGE COLLECTION "GETSPA" AGAIN CHECKS
|
|
TO SEE IF [ACCA] CHARACTERS ARE AVAILABLE BETWEEN
|
|
[STREND] AND [FRETOP]; IF NOT, AN "OUT OF STRING"
|
|
ERROR IS INVOKED.
|
|
|
|
MATH PACKAGE
|
|
THE MATH PACKAGE CONTAINS FLOATING INPUT (FIN),
|
|
FLOATING OUTPUT (FOUT), FLOATING COMPARE (FCOMP)
|
|
... AND ALL THE NUMERIC OPERATORS AND FUNCTIONS.
|
|
THE FORMATS, CONVENTIONS AND ENTRY POINTS ARE ALL
|
|
DESCRIBED IN THE MATH PACKAGE ITSELF.
|
|
|
|
INIT -- THE INITIALIZATION ROUTINE
|
|
THE AMOUNT OF MEMORY,
|
|
TERMINAL WIDTH, AND WHICH FUNCTIONS TO BE RETAINED
|
|
ARE ASCERTAINED FROM THE USER. A ZERO IS PUT DOWN
|
|
AT THE FIRST LOCATION NOT USED BY THE MATH-PACKAGE
|
|
AND [TXTTAB] IS SET UP TO POINT AT THE NEXT LOCATION.
|
|
THIS DETERMINES WHERE PROGRAM STORAGE WILL START.
|
|
SPECIAL CHECKS ARE MADE TO MAKE SURE
|
|
ALL QUESTIONS IN "INIT" ARE ANSWERED REASONABLY, SINCE
|
|
ONCE "INIT" FINISHES, THE LOCATIONS IT USES ARE
|
|
USED FOR PROGRAM STORAGE. THE LAST THING "INIT" DOES IS
|
|
CHANGE LOCATION ZERO TO BE A JUMP TO "READY" INSTEAD
|
|
OF "INIT". ONCE THIS IS DONE THERE IS NO WAY TO RESTART
|
|
"INIT".
|
|
HIGH LOCATIONS
|
|
|
|
*
|
|
PAGE
|
|
SUBTTL PAGE ZERO.
|
|
IFN REALIO-3,<
|
|
START: JMP INIT ;INITIALIZE - SETUP CERTAIN LOCATIONS
|
|
;AND DELETE FUNCTIONS IF NOT NEEDED,
|
|
;AND CHANGE THIS TO "JMP READY"
|
|
;IN CASE USER RESTARTS AT LOC ZERO.
|
|
RDYJSR: JMP INIT ;CHANGED TO "JMP STROUT" BY "INIT"
|
|
;TO HANDLE ERRORS.
|
|
ADRAYI: ADR(AYINT) ;STORE HERE THE ADDR OF THE
|
|
;ROUTINE TO TURN THE FAC INTO A
|
|
;TWO BYTE SIGNED INTEGER IN [Y,A]
|
|
ADRGAY: ADR(GIVAYF)> ;STORE HERE THE ADDR OF THE
|
|
;ROUTINE TO CONVERT [Y,A] TO A FLOATING
|
|
;POINT NUMBER IN THE FAC.
|
|
IFN ROMSW,<
|
|
USRPOK: JMP FCERR> ;SET UP ORIG BY INIT.
|
|
;
|
|
; THIS IS THE "VOLATILE" STORAGE AREA AND NONE OF IT
|
|
; CAN BE KEPT IN ROM. ANY CONSTANTS IN THIS AREA CANNOT
|
|
; BE KEPT IN A ROM, BUT MUST BE LOADED IN BY THE
|
|
; PROGRAM INSTRUCTIONS IN ROM.
|
|
;
|
|
; --- GENERAL RAM ---:
|
|
CHARAC: BLOCK 1 ;A DELIMITING CHARACTER.
|
|
INTEGR= CHARAC ;A ONE-BYTE INTEGER FROM "QINT".
|
|
ENDCHR: BLOCK 1 ;THE OTHER DELIMITING CHARACTER.
|
|
COUNT: BLOCK 1 ;A GENERAL COUNTER.
|
|
|
|
; --- FLAGS ---:
|
|
DIMFLG: BLOCK 1 ;IN GETTING A POINTER TO A VARIABLE
|
|
;IT IS IMPORTANT TO REMEMBER WHETHER IT
|
|
;IS BEING DONE FOR "DIM" OR NOT.
|
|
;DIMFLG AND VALTYP MUST BE
|
|
;CONSECUTIVE LOCATIONS.
|
|
KIMY= DIMFLG ;PLACE TO PRESERVE Y DURING OUT.
|
|
VALTYP: BLOCK 1 ;THE TYPE INDICATOR.
|
|
;0=NUMERIC 1=STRING.
|
|
IFN INTPRC,<
|
|
INTFLG: BLOCK 1> ;TELLS IF INTEGER.
|
|
DORES: BLOCK 1 ;WHETHER CAN OR CAN'T CRUNCH RES'D WORDS.
|
|
;TURNED ON WHEN "DATA"
|
|
;BEING SCANNED BY CRUNCH SO UNQUOTED
|
|
;STRINGS WON'T BE CRUNCHED.
|
|
GARBFL= DORES ;WHETHER TO DO GARBAGE COLLECTION.
|
|
SUBFLG: BLOCK 1 ;FLAG WHETHER SUB'D VARIABLE ALLOWED.
|
|
;"FOR" AND USER-DEFINED FUNCTION
|
|
;POINTER FETCHING TURN
|
|
;THIS ON BEFORE CALLING "PTRGET"
|
|
;SO ARRAYS WON'T BE DETECTED.
|
|
;"STKINI" AND "PTRGET" CLEAR IT.
|
|
;ALSO DISALLOWS INTEGERS THERE.
|
|
INPFLG: BLOCK 1 ;FLAGS WHETHER WE ARE DOING "INPUT"
|
|
;OR "READ".
|
|
TANSGN: BLOCK 1 ;USED IN DETERMINING SIGN OF TANGENT.
|
|
IFN REALIO,<
|
|
CNTWFL: BLOCK 1> ;SUPPRESS OUTPUT FLAG.
|
|
;NON-ZERO MEANS SUPPRESS.
|
|
;RESET BY "INPUT", READY AND ERRORS.
|
|
;COMPLEMENTED BY INPUT OF ^O.
|
|
|
|
IFE REALIO-4,<ORG 80> ;ROOM FOR APPLE PAGE 0 STUFF.
|
|
; --- RAM DEALING WITH TERMINAL HANDLING ---:
|
|
IFN EXTIO,<
|
|
CHANNL: BLOCK 1> ;HOLDS CHANNEL NUMBER.
|
|
IFN NULCMD,<
|
|
NULCNT: 0> ;NUMBER OF NULLS TO PRINT.
|
|
IFN REALIO-3,<
|
|
TRMPOS: BLOCK 1> ;POSITION OF TERMINAL CARRIAGE.
|
|
LINWID: LINLEN ;LENGTH OF LINE (WIDTH).
|
|
NCMWID: NCMPOS ;POSITION BEYOND WHICH THERE ARE
|
|
;NO MORE FIELDS.
|
|
LINNUM: 0 ;LOCATION TO STORE LINE NUMBER BEFORE BUF
|
|
;SO THAT "BLTUC" CAN STORE IT ALL AWAY AT ONCE.
|
|
44 ;A COMMA (PRELOAD OR FROM ROM)
|
|
;USED BY INPUT STATEMENT SINCE THE
|
|
;DATA POINTER ALWAYS STARTS ON A
|
|
;COMMA OR TERMINATOR.
|
|
IFE BUFPAG,<
|
|
BUF: BLOCK BUFLEN> ;TYPE IN STORED HERE.
|
|
;DIRECT STATEMENTS EXECUTE OUT OF
|
|
;HERE. REMEMBER "INPUT" SMASHES BUF.
|
|
;MUST BE ON PAGE ZERO
|
|
;OR ASSIGNMENT OF STRING
|
|
;VALUES IN DIRECT STATEMENTS WON'T COPY
|
|
;INTO STRING SPACE -- WHICH IT MUST.
|
|
;N.B. TWO NONZERO BYTES MUST PRECEDE "BUFLNM".
|
|
|
|
; --- STORAGE FOR TEMPORARY THINGS ---:
|
|
TEMPPT: BLOCK 1 ;POINTER AT FIRST FREE TEMP DESCRIPTOR.
|
|
;INITIALIZED TO POINT TO TEMPST.
|
|
LASTPT: BLOCK 2 ;POINTER TO LAST-USED STRING TEMPORARY.
|
|
TEMPST: BLOCK STRSIZ*NUMTMP ;STORAGE FOR NUMTMP TEMP DESCRIPTORS.
|
|
INDEX1: BLOCK 2 ;INDEXES.
|
|
INDEX= INDEX1
|
|
INDEX2: BLOCK 2
|
|
RESHO: BLOCK 1 ;RESULT OF MULTIPLIER AND DIVIDER.
|
|
IFN ADDPRC,<
|
|
RESMOH: BLOCK 1> ;ONE MORE BYTE.
|
|
RESMO: BLOCK 1
|
|
RESLO: BLOCK 1
|
|
ADDEND= RESMO ;TEMPORARY USED BY "UMULT".
|
|
0 ;OVERFLOW FOR RES.
|
|
|
|
; --- POINTERS INTO DYNAMIC DATA STRUCTURES ---;
|
|
TXTTAB: BLOCK 2 ;POINTER TO BEGINNING OF TEXT.
|
|
;DOESN'T CHANGE AFTER BEING
|
|
;SETUP BY "INIT".
|
|
VARTAB: BLOCK 2 ;POINTER TO START OF SIMPLE
|
|
;VARIABLE SPACE.
|
|
;UPDATED WHENEVER THE SIZE OF THE
|
|
;PROGRAM CHANGES, SET TO [TXTTAB]
|
|
;BY "SCRATCH" ("NEW").
|
|
ARYTAB: BLOCK 2 ;POINTER TO BEGINNING OF ARRAY
|
|
;TABLE.
|
|
;INCREMENTED BY 6 WHENEVER
|
|
;A NEW SIMPLE VARIABLE IS FOUND, AND
|
|
;SET TO [VARTAB] BY "CLEARC".
|
|
STREND: BLOCK 2 ;END OF STORAGE IN USE.
|
|
;INCREASED WHENEVER A NEW ARRAY
|
|
;OR SIMPLE VARIABLE IS ENCOUNTERED.
|
|
;SET TO [VARTAB] BY "CLEARC".
|
|
FRETOP: BLOCK 2 ;TOP OF STRING FREE SPACE.
|
|
FRESPC: BLOCK 2 ;POINTER TO NEW STRING.
|
|
MEMSIZ: BLOCK 2 ;HIGHEST LOCATION IN MEMORY.
|
|
|
|
; --- LINE NUMBERS AND TEXTUAL POINTERS ---:
|
|
CURLIN: BLOCK 2 ;CURRENT LINE #.
|
|
;SET TO 0,255 FOR DIRECT STATEMENTS.
|
|
OLDLIN: BLOCK 2 ;OLD LINE NUMBER (SETUP BY ^C,"STOP"
|
|
;OR "END" IN A PROGRAM).
|
|
POKER= LINNUM ;SET UP LOCATION USED BY POKE.
|
|
;TEMPORARY FOR INPUT AND READ CODE
|
|
OLDTXT: BLOCK 2 ;OLD TEXT POINTER.
|
|
;POINTS AT STATEMENT TO BE EXEC'D NEXT.
|
|
DATLIN: BLOCK 2 ;DATA LINE # -- REMEMBER FOR ERRORS.
|
|
DATPTR: BLOCK 2 ;POINTER TO DATA. INITIALIZED TO POINT
|
|
;AT THE ZERO IN FRONT OF [TXTTAB]
|
|
;BY "RESTORE" WHICH IS CALLED BY "CLEARC".
|
|
;UPDATED BY EXECUTION OF A "READ".
|
|
INPPTR: BLOCK 2 ;THIS REMEMBERS WHERE INPUT IS COMING FROM.
|
|
|
|
; --- STUFF USED IN EVALUATIONS ---:
|
|
VARNAM: BLOCK 2 ;VARIABLE'S NAME IS STORED HERE.
|
|
VARPNT: BLOCK 2 ;POINTER TO VARIABLE IN MEMORY.
|
|
FDECPT= VARPNT ;POINTER INTO POWER OF TENS OF "FOUT".
|
|
FORPNT: BLOCK 2 ;A VARIABLE'S POINTER FOR "FOR" LOOPS
|
|
;AND "LET" STATEMENTS.
|
|
LSTPNT= FORPNT ;PNTR TO LIST STRING.
|
|
ANDMSK= FORPNT ;THE MASK USED BY WAIT FOR ANDING.
|
|
EORMSK= FORPNT+1 ;THE MASK FOR EORING IN WAIT.
|
|
OPPTR: BLOCK 2 ;POINTER TO CURRENT OP'S ENTRY IN "OPTAB".
|
|
VARTXT= OPPTR ;POINTER INTO LIST OF VARIABLES.
|
|
OPMASK: BLOCK 1 ;MASK CREATED BY CURRENT OPERATOR.
|
|
DOMASK=TANSGN ;MASK IN USE BY RELATION OPERATIONS.
|
|
DEFPNT: BLOCK 2 ;POINTER USED IN FUNCTION DEFINITION.
|
|
GRBPNT= DEFPNT ;ANOTHER USED IN GARBAGE COLLECTION.
|
|
DSCPNT: BLOCK 2 ;POINTER TO A STRING DESCRIPTOR.
|
|
IFN ADDPRC,<BLOCK 1> ;FOR TEMPF3.
|
|
FOUR6: EXP STRSIZ ;VARIABLE CONSTANT USED BY GARB COLLECT.
|
|
|
|
; --- ET CETERA ---:
|
|
JMPER: JMP 60000
|
|
SIZE= JMPER+1
|
|
OLDOV= JMPER+2 ;THE OLD OVERFLOW.
|
|
TEMPF3= DEFPNT ;A THIRD FAC TEMPORARY (4 BYTES).
|
|
TEMPF1:
|
|
IFN ADDPRC,<0> ;FOR TEMPF1S EXTRA BYTE.
|
|
HIGHDS: BLOCK 2 ;DESINATION OF HIGHEST ELEMENT IN BLT.
|
|
HIGHTR: BLOCK 2 ;SOURCE OF HIGHEST ELEMENT TO MOVE.
|
|
TEMPF2:
|
|
IFN ADDPRC,<0> ;FOR TEMPF2S EXTRA BYTE.
|
|
LOWDS: BLOCK 2 ;LOCATION OF LAST BYTE TRANSFERRED INTO.
|
|
LOWTR: BLOCK 2 ;LAST THING TO MOVE IN BLT.
|
|
ARYPNT= HIGHDS ;A POINTER USED IN ARRAY BUILDING.
|
|
GRBTOP= LOWTR ;A POINTER USED IN GARBAGE COLLECTION.
|
|
DECCNT= LOWDS ;NUMBER OF PLACES BEFORE DECIMAL POINT.
|
|
TENEXP= LOWDS+1 ;HAS A DPT BEEN INPUT?
|
|
DPTFLG= LOWTR ;BASE TEN EXPONENT.
|
|
EXPSGN= LOWTR+1 ;SIGN OF BASE TEN EXPONENT.
|
|
|
|
; --- THE FLOATING ACCUMULATOR ---:
|
|
FAC:
|
|
FACEXP: 0
|
|
FACHO: 0 ;MOST SIGNIFICANT BYTE OF MANTISSA.
|
|
IFN ADDPRC,<
|
|
FACMOH: 0> ;ONE MORE.
|
|
FACMO: 0 ;MIDDLE ORDER OF MANTISSA.
|
|
FACLO: 0 ;LEAST SIG BYTE OF MANTISSA.
|
|
FACSGN: 0 ;SIGN OF FAC (0 OR -1) WHEN UNPACKED.
|
|
SGNFLG: 0 ;SIGN OF FAC IS PRESERVED BERE BY "FIN".
|
|
DEGREE= SGNFLG ;A COUNT USED BY POLYNOMIALS.
|
|
DSCTMP= FAC ;THIS IS WHERE TEMP DESCS ARE BUILT.
|
|
INDICE= FACMO ;INDICE IS SET UP HERE BY "QINT".
|
|
BITS: 0 ;SOMETHING FOR "SHIFTR" TO USE.
|
|
|
|
; --- THE FLOATING ARGUMENT (UNPACKED) ---:
|
|
ARGEXP: 0
|
|
ARGHO: 0
|
|
IFN ADDPRC,<ARGMOH: 0>
|
|
ARGMO: 0
|
|
ARGLO: 0
|
|
ARGSGN: 0
|
|
|
|
ARISGN: 0 ;A SIGN REFLECTING THE RESULT.
|
|
FACOV: 0 ;OVERFLOW BYTE OF THE FAC.
|
|
STRNG1= ARISGN ;POINTER TO A STRING OR DESCRIPTOR.
|
|
|
|
FBUFPT: BLOCK 2 ;POINTER INTO FBUFFR USED BY FOUT.
|
|
BUFPTR= FBUFPT ;POINTER TO BUF USED BY "CRUNCH".
|
|
STRNG2= FBUFPT ;POINTER TO STRING OR DESC.
|
|
POLYPT= FBUFPT ;POINTER INTO POLYNOMIAL COEFFICIENTS.
|
|
CURTOL= FBUFPT ;ABSOLUTE LINEAR INDEX IS FORMED HERE.
|
|
PAGE
|
|
SUBTTL RAM CODE.
|
|
; THIS CODE GETS CHANGED THROUGHOUT EXECUTION.
|
|
; IT IS MADE TO BE FAST THIS WAY.
|
|
; ALSO, [X] AND [Y] ARE NOT DISTURBED
|
|
;
|
|
; "CHRGET" USING [TXTPTR] AS THE CURRENT TEXT PNTR
|
|
; FETCHES A NEW CHARACTER INTO ACCA AFTER INCREMENTING [TXTPTR]
|
|
; AND SETS CONDITION CODES ACCORDING TO WHAT'S IN ACCA.
|
|
; NOT C= NUMERIC ("0" THRU "9")
|
|
; Z= ":" OR END-OF-LINE (A NULL)
|
|
;
|
|
; [ACCA] = NEW CHAR.
|
|
; [TXTPTR]=[TXTPTR]+1
|
|
;
|
|
; THE FOLLOWING EXISTS IN ROM IF ROM EXISTS AND IS LOADED
|
|
; DOWN HERE BY INIT. OTHERWISE IT IS JUST LOADED INTO THIS
|
|
; RAM LIKE ALL THE REST OF RAM IS LOADED.
|
|
;
|
|
CHRGET: INC CHRGET+7 ;INCREMENT THE WHOLE TXTPTR.
|
|
BNE CHRGOT
|
|
INC CHRGET+8
|
|
CHRGOT: LDA 60000 ;A LOAD WITH AN EXT ADDR.
|
|
TXTPTR= CHRGOT+1
|
|
CMPI " " ;SKIP SPACES.
|
|
BEQ CHRGET
|
|
QNUM: CMPI ":" ;IS IT A ":"?
|
|
BCS CHRRTS ;IT IS .GE. ":"
|
|
SEC
|
|
SBCI "0" ;ALL CHARS .GT. "9" HAVE RET'D SO
|
|
SEC
|
|
SBCI 256-"0" ;SEE IF NUMERIC.
|
|
;TURN CARRY ON IF NUMERIC.
|
|
;ALSO, SETZ IF NULL.
|
|
CHRRTS: RTS ;RETURN TO CALLER.
|
|
|
|
RNDX: 128 ;LOADED OR FROM ROM.
|
|
79 ;THE INITIAL RANDOM NUMBER.
|
|
199
|
|
82
|
|
IFN ADDPRC,<89> ;ONE MORE BYTE.
|
|
|
|
ORG 255 ;PAGE 1 STUFF COMING UP.
|
|
LOFBUF: BLOCK 1 ;THE LOW FAC BUFFER. COPYABLE.
|
|
;--- PAGE ZERO/ONE BOUNDARY ---.
|
|
;MUST HAVE 13 CONTIGUOUS BYTES.
|
|
FBUFFR: BLOCK 3*ADDPRC+13 ;BUFFER FOR "FOUT".
|
|
;ON PAGE 1 SO THAT STRING IS NOT COPIED.
|
|
|
|
;STACK IS LOCATED HERE. IE FROM THE END OF FBUFFR TO STKEND.
|
|
PAGE
|
|
SUBTTL DISPATCH TABLES, RESERVED WORDS, AND ERROR TEXTS.
|
|
|
|
ORG ROMLOC
|
|
|
|
STMDSP: ADR(END-1)
|
|
ADR(FOR-1)
|
|
ADR(NEXT-1)
|
|
ADR(DATA-1)
|
|
IFN EXTIO,<
|
|
ADR(INPUTN-1)>
|
|
ADR(INPUT-1)
|
|
ADR(DIM-1)
|
|
ADR(READ-1)
|
|
ADR(LET-1)
|
|
ADR(GOTO-1)
|
|
ADR(RUN-1)
|
|
ADR(IF-1)
|
|
ADR(RESTORE-1)
|
|
ADR(GOSUB-1)
|
|
ADR(RETURN-1)
|
|
ADR(REM-1)
|
|
ADR(STOP-1)
|
|
ADR(ONGOTO-1)
|
|
IFN NULCMD,<
|
|
ADR(NULL-1)>
|
|
ADR(FNWAIT-1)
|
|
IFN DISKO,<
|
|
IFE REALIO-3,<
|
|
ADR(CQLOAD-1)
|
|
ADR(CQSAVE-1)
|
|
ADR(CQVERF-1)>
|
|
IFN REALIO,<
|
|
IFN REALIO-2,<
|
|
IFN REALIO-3,<
|
|
IFN REALIO-5,<
|
|
ADR(LOAD-1)
|
|
ADR(SAVE-1)>>>>
|
|
IFN REALIO-1,<
|
|
IFN REALIO-3,<
|
|
IFN REALIO-4,<
|
|
ADR(511) ;ADDRESS OF LOAD
|
|
ADR(511)>>>> ;ADDRESS OF SAVE
|
|
ADR(DEF-1)
|
|
ADR(POKE-1)
|
|
IFN EXTIO,<
|
|
ADR(PRINTN-1)>
|
|
ADR(PRINT-1)
|
|
ADR(CONT-1)
|
|
IFE REALIO,<
|
|
ADR(DDT-1)>
|
|
ADR(LIST-1)
|
|
ADR(CLEAR-1)
|
|
IFN EXTIO,<
|
|
ADR(CMD-1)
|
|
ADR(CQSYS-1)
|
|
ADR(CQOPEN-1)
|
|
ADR(CQCLOS-1)>
|
|
IFN GETCMD,<
|
|
ADR(GET-1)> ;FILL W/ GET ADDR.
|
|
ADR(SCRATH-1)
|
|
|
|
FUNDSP: ADR(SGN)
|
|
ADR(INT)
|
|
ADR(ABS)
|
|
IFE ROMSW,<
|
|
USRLOC: ADR(FCERR)> ;INITIALLY NO USER ROUTINE.
|
|
IFN ROMSW,<
|
|
USRLOC: ADR(USRPOK)>
|
|
ADR(FRE)
|
|
ADR(POS)
|
|
ADR(SQR)
|
|
ADR(RND)
|
|
ADR(LOG)
|
|
ADR(EXP)
|
|
IFN KIMROM,<
|
|
REPEAT 4,<
|
|
ADR(FCERR)>>
|
|
IFE KIMROM,<
|
|
COSFIX: ADR(COS)
|
|
SINFIX: ADR(SIN)
|
|
TANFIX: ADR(TAN)
|
|
ATNFIX: ADR(ATN)>
|
|
ADR(PEEK)
|
|
ADR(LEN)
|
|
ADR(STR)
|
|
ADR(VAL)
|
|
ADR(ASC)
|
|
ADR(CHR)
|
|
ADR(LEFT)
|
|
ADR(RIGHT)
|
|
ADR(MID)
|
|
OPTAB: 121
|
|
ADR(FADDT-1)
|
|
121
|
|
ADR(FSUBT-1)
|
|
123
|
|
ADR(FMULTT-1)
|
|
123
|
|
ADR(FDIVT-1)
|
|
127
|
|
ADR(FPWRT-1)
|
|
80
|
|
ADR(ANDOP-1)
|
|
70
|
|
ADR(OROP-1)
|
|
NEGTAB: 125
|
|
ADR(NEGOP-1)
|
|
NOTTAB: 90
|
|
ADR(NOTOP-1)
|
|
PTDORL: 100 ;PRECEDENCE.
|
|
ADR (DOREL-1) ;OPERATOR ADDRESS.
|
|
;
|
|
; TOKENS FOR RESERVED WORDS ALWAYS HAVE THE MOST
|
|
; SIGNIFICANT BIT ON.
|
|
; THE LIST OF RESERVED WORDS:
|
|
;
|
|
Q=128-1
|
|
DEFINE DCI(A),<Q=Q+1
|
|
DC(A)>
|
|
RESLST: DCI"END"
|
|
ENDTK==Q
|
|
DCI"FOR"
|
|
FORTK==Q
|
|
DCI"NEXT"
|
|
DCI"DATA"
|
|
DATATK==Q
|
|
IFN EXTIO,<
|
|
DCI"INPUT#">
|
|
DCI"INPUT"
|
|
DCI"DIM"
|
|
DCI"READ"
|
|
DCI"LET"
|
|
DCI"GOTO"
|
|
GOTOTK==Q
|
|
DCI"RUN"
|
|
DCI"IF"
|
|
DCI"RESTORE"
|
|
DCI"GOSUB"
|
|
GOSUTK=Q
|
|
DCI"RETURN"
|
|
DCI"REM"
|
|
REMTK=Q
|
|
DCI"STOP"
|
|
DCI"ON"
|
|
IFN NULCMD,<
|
|
DCI"NULL">
|
|
DCI"WAIT"
|
|
IFN DISKO,<
|
|
DCI"LOAD"
|
|
DCI"SAVE"
|
|
IFE REALIO-3,<
|
|
DCI"VERIFY">>
|
|
DCI"DEF"
|
|
DCI"POKE"
|
|
IFN EXTIO,<
|
|
DCI"PRINT#">
|
|
DCI"PRINT"
|
|
PRINTK==Q
|
|
DCI"CONT"
|
|
IFE REALIO,<
|
|
DCI"DDT">
|
|
DCI"LIST"
|
|
IFN REALIO-3,<
|
|
DCI"CLEAR">
|
|
IFE REALIO-3,<
|
|
DCI"CLR">
|
|
IFN EXTIO,<
|
|
DCI"CMD"
|
|
DCI"SYS"
|
|
DCI"OPEN"
|
|
DCI"CLOSE">
|
|
IFN GETCMD,<
|
|
DCI"GET">
|
|
DCI"NEW"
|
|
SCRATK=Q
|
|
; END OF COMMAND LIST.
|
|
"T"
|
|
"A"
|
|
"B"
|
|
"("+128
|
|
Q=Q+1
|
|
TABTK=Q
|
|
DCI"TO"
|
|
TOTK==Q
|
|
DCI"FN"
|
|
FNTK==Q
|
|
"S"
|
|
"P"
|
|
"C"
|
|
"("+128 ;MACRO DOESNT LIKE ('S IN ARGUMENTS.
|
|
Q=Q+1
|
|
SPCTK==Q
|
|
DCI"THEN"
|
|
THENTK=Q
|
|
DCI"NOT"
|
|
NOTTK==Q
|
|
DCI"STEP"
|
|
STEPTK=Q
|
|
DCI"+"
|
|
PLUSTK=Q
|
|
DCI"-"
|
|
MINUTK=Q
|
|
DCI"*"
|
|
DCI"/"
|
|
DCI"^"
|
|
DCI"AND"
|
|
DCI"OR"
|
|
190 ;A GREATER THAN SIGN
|
|
Q=Q+1
|
|
GREATK=Q
|
|
DCI"="
|
|
EQULTK=Q
|
|
188
|
|
Q=Q+1 ;A LESS THAN SIGN
|
|
LESSTK=Q
|
|
;
|
|
; NOTE DANGER OF ONE RESERVED WORD BEING A PART
|
|
; OF ANOTHER:
|
|
; IE . . IF 2 GREATER THAN F OR T=5 THEN...
|
|
; WILL NOT WORK!!! SINCE "FOR" WILL BE CRUNCHED!!
|
|
; IN ANY CASE MAKE SURE THE SMALLER WORD APPEARS
|
|
; SECOND IN THE RESERVED WORD TABLE ("INP" AND "INPUT")
|
|
; ANOTHER EXAMPLE: IF T OR Q THEN ... "TO" IS CRUNCHED
|
|
;
|
|
DCI"SGN"
|
|
ONEFUN=Q
|
|
DCI"INT"
|
|
DCI"ABS"
|
|
DCI"USR"
|
|
DCI"FRE"
|
|
DCI"POS"
|
|
DCI"SQR"
|
|
DCI"RND"
|
|
DCI"LOG"
|
|
DCI"EXP"
|
|
DCI"COS"
|
|
DCI"SIN"
|
|
DCI"TAN"
|
|
DCI"ATN"
|
|
DCI"PEEK"
|
|
DCI"LEN"
|
|
DCI"STR$"
|
|
DCI"VAL"
|
|
DCI"ASC"
|
|
DCI"CHR$"
|
|
LASNUM==Q ;NUMBER OF LAST FUNCTION
|
|
;THAT TAKES ONE ARG
|
|
DCI"LEFT$"
|
|
DCI"RIGHT$"
|
|
DCI"MID$"
|
|
DCI"GO"
|
|
GOTK==Q
|
|
0 ;MARKS END OF RESERVED WORD LIST
|
|
|
|
IFE LNGERR,<
|
|
Q=0-2
|
|
DEFINE DCE(X),<Q=Q+2
|
|
DC(X)>
|
|
ERRTAB: DCE"NF"
|
|
ERRNF==Q ;NEXT WITHOUT FOR.
|
|
DCE"SN"
|
|
ERRSN==Q ;SYNTAX
|
|
DCE"RG"
|
|
ERRRG==Q ;RETURN WITHOUT GOSUB.
|
|
DCE"OD"
|
|
ERROD==Q ;OUT OF DATA.
|
|
DCE"FC"
|
|
ERRFC==Q ;ILLEGAL QUANTITY.
|
|
DCE"OV"
|
|
ERROV==Q ;OVERFLOW.
|
|
DCE"OM"
|
|
ERROM==Q ;OUT OF MEMORY.
|
|
DCE"US"
|
|
ERRUS==Q ;UNDEFINED STATEMENT.
|
|
DCE"BS"
|
|
ERRBS==Q ;BAD SUBSCRIPT.
|
|
DCE"DD"
|
|
ERRDD==Q ;REDIMENSIONED ARRAY.
|
|
DCE"/0"
|
|
ERRDV0==Q ;DIVISION BY ZERO.
|
|
DCE"ID"
|
|
ERRID==Q ;ILLEGAL DIRECT.
|
|
DCE"TM"
|
|
ERRTM==Q ;TYPE MISMATCH.
|
|
DCE"LS"
|
|
ERRLS==Q ;STRING TOO LONG.
|
|
IFN EXTIO,<
|
|
DCE"FD" ;FILE DATA.
|
|
ERRBD==Q>
|
|
DCE"ST"
|
|
ERRST==Q ;STRING FORMULA TOO COMPLEX.
|
|
DCE"CN"
|
|
ERRCN==Q ;CAN'T CONTINUE.
|
|
DCE"UF"
|
|
ERRUF==Q> ;UNDEFINED FUNCTION.
|
|
|
|
IFN LNGERR,<
|
|
Q=0
|
|
; NOTE: THIS ERROR COUNT TECHNIQUE WILL NOT WORK IF THERE ARE MORE
|
|
; THAN 256 CHARACTERS OF ERROR MESSAGES
|
|
ERRTAB: DC"NEXT WITHOUT FOR"
|
|
ERRNF==Q
|
|
Q=Q+16
|
|
DC"SYNTAX"
|
|
ERRSN==Q
|
|
Q=Q+6
|
|
DC"RETURN WITHOUT GOSUB"
|
|
ERRRG==Q
|
|
Q=Q+20
|
|
DC"OUT OF DATA"
|
|
ERROD==Q
|
|
Q=Q+11
|
|
DC"ILLEGAL QUANTITY"
|
|
ERRFC==Q
|
|
Q=Q+16
|
|
DC"OVERFLOW"
|
|
ERROV==Q
|
|
Q=Q+8
|
|
DC"OUT OF MEMORY"
|
|
ERROM==Q
|
|
Q=Q+13
|
|
DC"UNDEF'D STATEMENT"
|
|
ERRUS==Q
|
|
Q=Q+17
|
|
DC"BAD SUBSCRIPT"
|
|
ERRBS==Q
|
|
Q=Q+13
|
|
DC"REDIM'D ARRAY"
|
|
ERRDD==Q
|
|
Q=Q+13
|
|
DC"DIVISION BY ZERO"
|
|
ERRDV0==Q
|
|
Q=Q+16
|
|
DC"ILLEGAL DIRECT"
|
|
ERRID==Q
|
|
Q=Q+14
|
|
DC"TYPE MISMATCH"
|
|
ERRTM==Q
|
|
Q=Q+13
|
|
DC"STRING TOO LONG"
|
|
ERRLS==Q
|
|
Q=Q+15
|
|
IFN EXTIO,<
|
|
DC"FILE DATA"
|
|
ERRBD==Q
|
|
Q=Q+9>
|
|
DC"FORMULA TOO COMPLEX"
|
|
ERRST==Q
|
|
Q=Q+19
|
|
DC"CAN'T CONTINUE"
|
|
ERRCN==Q
|
|
Q=Q+14
|
|
DC"UNDEF'D FUNCTION"
|
|
ERRUF==Q>
|
|
|
|
;
|
|
; NEEDED FOR MESSAGES IN ALL VERSIONS.
|
|
;
|
|
ERR: DT" ERROR"
|
|
0
|
|
INTXT: DT" IN "
|
|
0
|
|
REDDY: ACRLF
|
|
IFE REALIO-3,<
|
|
DT"READY.">
|
|
IFN REALIO-3,<
|
|
DT"OK">
|
|
ACRLF
|
|
0
|
|
BRKTXT: ACRLF
|
|
DT"BREAK"
|
|
0
|
|
PAGE
|
|
SUBTTL GENERAL STORAGE MANAGEMENT ROUTINES.
|
|
;
|
|
; FIND A "FOR" ENTRY ON THE STACK VIA "VARPNT".
|
|
;
|
|
FORSIZ==2*ADDPRC+16
|
|
FNDFOR: TSX ;LOAD XREG WITH STK PNTR.
|
|
REPEAT 4,<INX> ;IGNORE ADR(NEWSTT) AND RTS ADDR.
|
|
FFLOOP: LDA 257,X ;GET STACK ENTRY.
|
|
CMPI FORTK ;IS IT A "FOR" TOKEN?
|
|
BNE FFRTS ;NO, NO "FOR" LOOPS WITH THIS PNTR.
|
|
LDA FORPNT+1 ;GET HIGH.
|
|
BNE CMPFOR
|
|
LDA 258,X ;PNTR IS ZERO, SO ASSUME THIS ONE.
|
|
STA FORPNT
|
|
LDA 259,X
|
|
STA FORPNT+1
|
|
CMPFOR: CMP 259,X
|
|
BNE ADDFRS ;NOT THIS ONE.
|
|
LDA FORPNT ;GET DOWN.
|
|
CMP 258,X
|
|
BEQ FFRTS ;WE GOT IT! WE GOT IT!
|
|
ADDFRS: TXA
|
|
CLC ;ADD 16 TO X.
|
|
ADCI FORSIZ
|
|
TAX ;RESULT BACK INTO X.
|
|
BNE FFLOOP
|
|
FFRTS: RTS ;RETURN TO CALLER.
|
|
|
|
;
|
|
; THIS IS THE BLOCK TRANSFER ROUTINE.
|
|
; IT MAKES SPACE BY SHOVING EVERYTHING FORWARD.
|
|
;
|
|
; ON ENTRY:
|
|
; [Y,A]=[HIGHDS] (FOR REASON).
|
|
; [HIGHDS]= DESTINATION OF [HIGH ADDRESS].
|
|
; [LOWTR]= LOWEST ADDR TO BE TRANSFERRED.
|
|
; [HIGHTR]= HIGHEST ADDR TO BE TRANSFERRED.
|
|
;
|
|
; A CHECK IS MADE TO ASCERTAIN THAT A REASONABLE
|
|
; AMOUNT OF SPACE REMAINS BETWEEN THE BOTTOM
|
|
; OF THE STRINGS AND THE HIGHEST LOCATION TRANSFERRED INTO.
|
|
;
|
|
; ON EXIT:
|
|
; [LOWTR] ARE UNCHANGED.
|
|
; [HIGHTR]=[LOWTR]-200 OCTAL.
|
|
; [HIGHDS]=LOWEST ADDR TRANSFERRED INTO MINUS 200 OCTAL.
|
|
;
|
|
BLTU: JSR REASON ;ASCERTAIN THAT STRING SPACE WON'T
|
|
;BE OVERRUN.
|
|
STWD STREND
|
|
BLTUC: SEC ;PREPARE TO SUBTRACT.
|
|
LDA HIGHTR
|
|
SBC LOWTR ;COMPUTE NUMBER OF THINGS TO MOVE.
|
|
STA INDEX ;SAVE FOR LATER.
|
|
TAY
|
|
LDA HIGHTR+1
|
|
SBC LOWTR+1
|
|
TAX ;PUT IT IN A COUNTER REGISTER.
|
|
INX ;SO THAT COUNTER ALGORITHM WORKS.
|
|
TYA ;SEE IF LOW PART OF COUNT IS ZERO.
|
|
BEQ DECBLT ;YES, GO START MOVING BLOCKS.
|
|
LDA HIGHTR ;NO, MUST MODIFY BASE ADDR.
|
|
SEC
|
|
SBC INDEX ;BORROW IS OFF SINCE [HIGHTR].GT.[LOWTR].
|
|
STA HIGHTR ;SAVE MODIFIED BASE ADDR.
|
|
BCS BLT1 ;IF NO BORROW, GO SHOVE IT.
|
|
DEC HIGHTR+1 ;BORROW IMPLIES SUB 1 FROM HIGH ORDER.
|
|
SEC
|
|
BLT1: LDA HIGHDS ;MOD BASE OF DEST ADDR.
|
|
SBC INDEX
|
|
STA HIGHDS
|
|
BCS MOREN1 ;NO BORROW.
|
|
DEC HIGHDS+1 ;DECREMENT HIGH ORDER BYTE.
|
|
BCC MOREN1 ;ALWAYS SKIP.
|
|
BLTLP: LDADY HIGHTR ;FETCH BYTE TO MOVE
|
|
STADY HIGHDS ;MOVE IT IN, MOVE IT OUT.
|
|
MOREN1: DEY
|
|
BNE BLTLP
|
|
LDADY HIGHTR ;MOVE LAST OF THE BLOCK.
|
|
STADY HIGHDS
|
|
DECBLT: DEC HIGHTR+1
|
|
DEC HIGHDS+1 ;START ON NEW BLOCKS.
|
|
DEX
|
|
BNE MOREN1
|
|
RTS ;RETURN TO CALLER.
|
|
|
|
;
|
|
; THIS ROUTINE IS USED TO ASCERTAIN THAT A GIVEN
|
|
; NUMBER OF LOCS REMAIN AVAILABLE FOR THE STACK.
|
|
; THE CALL IS:
|
|
; LDAI NUMBER OF 2-BYTE ENTRIES NEEDED.
|
|
; JSR GETSTK
|
|
;
|
|
; THIS ROUTINE MUST BE CALLED BY ANY ROUTINE WHICH PUTS
|
|
; AN ARBITRARY AMOUNT OF STUFF ON THE STACK,
|
|
; I.E., ANY RECURSIVE ROUTINE LIKE "FRMEVL".
|
|
; IT IS ALSO CALLED BY ROUTINES SUCH AS "GOSUB" AND "FOR"
|
|
; WHICH MAKE PERMANENT ENTRIES ON THE STACK.
|
|
;
|
|
; ROUTINES WHICH MERELY USE AND FREE UP THE GUARANTEED
|
|
; NUMLEV LOCATIONS NEED NOT CALL THIS.
|
|
;
|
|
;
|
|
; ON EXIT:
|
|
; [A] AND [X] HAVE BEEN MODIFIED.
|
|
;
|
|
GETSTK: ASL A, ;MULT [A] BY 2. NB, CLEARS C BIT.
|
|
ADCI 2*NUMLEV+<3*ADDPRC>+13 ;MAKE SURE 2*NUMLEV+13 LOCS
|
|
;(13 BECAUSE OF FBUFFR)
|
|
BCS OMERR ;WILL REMAIN IN STACK.
|
|
STA INDEX
|
|
TSX ;GET STACKED.
|
|
CPX INDEX ;COMPARE.
|
|
BCC OMERR ;IF STACK.LE.INDEX1, OM.
|
|
RTS
|
|
|
|
;
|
|
; [Y,A] IS A CERTAIN ADDRESS. "REASON" MAKES SURE
|
|
; IT IS LESS THAN [FRETOP].
|
|
;
|
|
REASON: CPY FRETOP+1
|
|
BCC REARTS
|
|
BNE TRYMOR ;GO GARB COLLECT.
|
|
CMP FRETOP
|
|
BCC REARTS
|
|
TRYMOR: PHA
|
|
LDXI 8+ADDPRC ;IF TEMPF2 HAS ZERO IN BETWEEN.
|
|
TYA
|
|
REASAV: PHA
|
|
LDA HIGHDS-1,X ;SAVE HIGHDS ON STACK.
|
|
DEX
|
|
BPL REASAV ;PUT 8 OF THEM ON STK.
|
|
JSR GARBA2 ;GO GARB COLLECT.
|
|
LDXI 256-8-ADDPRC
|
|
REASTO: PLA
|
|
STA HIGHDS+8+ADDPRC,X ;RESTORE AFTER GARB COLLECT.
|
|
INX
|
|
BMI REASTO
|
|
PLA
|
|
TAY
|
|
PLA ;RESTORE A AND Y.
|
|
CPY FRETOP+1 ;COMPARE HIGHS
|
|
BCC REARTS
|
|
BNE OMERR ;HIGHER IS BAD.
|
|
CMP FRETOP ;AND THE LOWS.
|
|
BCS OMERR
|
|
REARTS: RTS
|
|
|
|
PAGE
|
|
SUBTTL ERROR HANDLER, READY, TERMINAL INPUT, COMPACTIFY, NEW, REINIT.
|
|
OMERR: LDXI ERROM
|
|
ERROR:
|
|
IFN REALIO,<
|
|
LSR CNTWFL> ;FORCE OUTPUT.
|
|
IFN EXTIO,<
|
|
LDA CHANNL ;CLOSE NON-TERMINAL CHANNEL.
|
|
BEQ ERRCRD
|
|
JSR CQCCHN ;CLOSE IT.
|
|
LDAI 0
|
|
STA CHANNL>
|
|
ERRCRD: JSR CRDO ;OUTPUT CRLF.
|
|
JSR OUTQST ;PRINT A QUESTION MARK
|
|
IFE LNGERR,<
|
|
LDA ERRTAB,X, ;GET FIRST CHR OF ERR MSG.
|
|
JSR OUTDO ;OUTPUT IT.
|
|
LDA ERRTAB+1,X, ;GET SECOND CHR.
|
|
JSR OUTDO> ;OUTPUT IT.
|
|
IFN LNGERR,<
|
|
GETERR: LDA ERRTAB,X
|
|
PHA
|
|
ANDI 127 ;GET RID OF HIGH BIT.
|
|
JSR OUTDO ;OUTPUT IT.
|
|
INX
|
|
PLA ;LAST CHAR OF MESSAGE?
|
|
BPL GETERR> ;NO. GO GET NEXT AND OUTPUT IT.
|
|
TYPERR: JSR STKINI ;RESET THE STACK AND FLAGS.
|
|
LDWDI ERR ;GET PNTR TO " ERROR".
|
|
ERRFIN: JSR STROUT ;OUTPUT IT.
|
|
LDY CURLIN+1
|
|
INY ;WAS NUMBER 64000?
|
|
BEQ READY ;YES, DON'T TYPE LINE NUMBER.
|
|
JSR INPRT
|
|
READY:
|
|
IFN REALIO,<
|
|
LSR CNTWFL> ;TURN OUTPUT BACK ON IF SUPRESSED
|
|
LDWDI REDDY ;SAY "OK".
|
|
IFN REALIO-3,<
|
|
JSR RDYJSR> ;OR GO TO INIT IF INIT ERROR.
|
|
IFE REALIO-3,<
|
|
JSR STROUT> ;NO INIT ERRORS POSSIBLE.
|
|
MAIN: JSR INLIN ;GET A LINE FROM TERMINAL.
|
|
STXY TXTPTR
|
|
JSR CHRGET
|
|
TAX ;SET ZERO FLAG BASED ON [A]
|
|
;THIS DISTINGUISHES ":" AND 0
|
|
BEQ MAIN ;IF BLANK LINE, GET ANOTHER.
|
|
LDXI 255 ;SET DIRECT LINE NUMBER.
|
|
STX CURLIN+1
|
|
BCC MAIN1 ;IS A LINE NUMBER. NOT DIRECT.
|
|
JSR CRUNCH ;COMPACTIFY.
|
|
JMP GONE ;EXECUTE IT.
|
|
MAIN1: JSR LINGET ;READ LINE NUMBER INTO "LINNUM".
|
|
JSR CRUNCH
|
|
STY COUNT ;RETAIN CHARACTER COUNT.
|
|
JSR FNDLIN
|
|
BCC NODEL ;NO MATCH, SO DON'T DELETE.
|
|
LDYI 1
|
|
LDADY LOWTR
|
|
STA INDEX1+1
|
|
LDA VARTAB
|
|
STA INDEX1
|
|
LDA LOWTR+1 ;SET TRANSFER TO.
|
|
STA INDEX2+1
|
|
LDA LOWTR
|
|
DEY
|
|
SBCDY LOWTR ;COMPUTE NEGATIVE LENGTH.
|
|
CLC
|
|
ADC VARTAB ;COMPUTE NEW VARTAB.
|
|
STA VARTAB
|
|
STA INDEX2 ;SET LOW OF TRANS TO.
|
|
LDA VARTAB+1
|
|
ADCI 255
|
|
STA VARTAB+1 ;COMPUTE HIGH OF VARTAB.
|
|
SBC LOWTR+1 ;COMPUTE NUMBER OF BLOCKS TO MOVE.
|
|
TAX
|
|
SEC
|
|
LDA LOWTR
|
|
SBC VARTAB ;COMPUTE OFFSET.
|
|
TAY
|
|
BCS QDECT1 ;IF VARTAB.LE.LOWTR,
|
|
INX ;DECR DUE TO CARRY, AND
|
|
DEC INDEX2+1 ;DECREMENT STORE SO CARRY WORKS.
|
|
QDECT1: CLC
|
|
ADC INDEX1
|
|
BCC MLOOP
|
|
DEC INDEX1+1
|
|
CLC ;FOR LATER ADCQ
|
|
MLOOP: LDADY INDEX1
|
|
STADY INDEX2
|
|
INY
|
|
BNE MLOOP ;BLOCK DONE?
|
|
INC INDEX1+1
|
|
INC INDEX2+1
|
|
DEX
|
|
BNE MLOOP ;DO ANOTHER BLOCK. ALWAYS.
|
|
NODEL: JSR RUNC ;RESET ALL VARIABLE INFO SO GARBAGE
|
|
;COLLECTION CAUSED BY REASON WILL WORK
|
|
JSR LNKPRG ;FIX UP THE LINKS
|
|
LDA BUF ;SEE IF ANYTHNG THERE
|
|
BEQ MAIN
|
|
CLC
|
|
LDA VARTAB
|
|
STA HIGHTR ;SETUP HIGHTR.
|
|
ADC COUNT ;ADD LENGTH OF LINE TO INSERT.
|
|
STA HIGHDS ;THIS GIVES DEST ADDR.
|
|
LDY VARTAB+1
|
|
STY HIGHTR+1 ;SAME FOR HIGH ORDERS.
|
|
BCC NODELC
|
|
INY
|
|
NODELC: STY HIGHDS+1
|
|
JSR BLTU
|
|
IFN BUFPAG,<
|
|
LDWD LINNUM ;POSITION THE BINARY LINE NUMBER
|
|
STWD BUF-2> ;IN FRONT OF BUF
|
|
LDWD STREND
|
|
STWD VARTAB
|
|
LDY COUNT
|
|
DEY
|
|
STOLOP: LDA BUF-4,Y
|
|
STADY LOWTR
|
|
DEY
|
|
BPL STOLOP
|
|
FINI: JSR RUNC ;DO CLEAR & SET UP STACK.
|
|
;AND SET [TXTPTR] TO [TXTTAB]-1.
|
|
JSR LNKPRG ;FIX UP PROGRAM LINKS
|
|
JMP MAIN
|
|
LNKPRG: LDWD TXTTAB ;SET [INDEX] TO [TXTTAB].
|
|
STWD INDEX
|
|
CLC
|
|
;
|
|
; CHEAD GOES THROUGH PROGRAM STORAGE AND FIXES
|
|
; UP ALL THE LINKS. THE END OF EACH LINE IS FOUND
|
|
; BY SEARCHING FOR THE ZERO AT THE END.
|
|
; THE DOUBLE ZERO LINK IS USED TO DETECT THE END OF THE PROGRAM.
|
|
;
|
|
CHEAD: LDYI 1
|
|
LDADY INDEX ;ARRIVED AT DOUBLE ZEROES?
|
|
BEQ LNKRTS
|
|
LDYI 4
|
|
CZLOOP: INY ;THERE IS AT LEAST ONE BYTE.
|
|
LDADY INDEX
|
|
BNE CZLOOP ;NO, CONTINUE SEARCHING.
|
|
INY ;GO ONE BEYOND.
|
|
TYA
|
|
ADC INDEX
|
|
TAX
|
|
LDYI 0
|
|
STADY INDEX
|
|
LDA INDEX+1
|
|
ADCI 0
|
|
INY
|
|
STADY INDEX
|
|
STX INDEX
|
|
STA INDEX+1
|
|
BCCA CHEAD ;ALWAYS BRANCHES.
|
|
LNKRTS: RTS
|
|
;
|
|
; THIS IS THE LINE INPUT ROUTINE.
|
|
; IT READS CHARACTERS INTO BUF USING BACKARROW (UNDERSCORE, OR
|
|
; SHIFT O) AS THE DELETE CHARACTER AND @ AS THE
|
|
; LINE DELETE CHARACTER. IF MORE THAN BUFLEN CHARACTERS
|
|
; ARE TYPED, NO ECHOING IS DONE UNTIL A BACKARROW OR @ OR CR
|
|
; IS TYPED. CONTROL-G WILL BE TYPED FOR EACH EXTRA CHARACTER.
|
|
; THE ROUTINE IS ENTERED AT INLIN.
|
|
;
|
|
IFE REALIO-4,<
|
|
INLIN: LDXI 128 ;NO PROMPT CHARACTER
|
|
STX CQPRMP
|
|
JSR CQINLN ;GET A LINE ONTO PAGE 2
|
|
CPXI BUFLEN-1
|
|
BCS GDBUFS ;NOT TOO MANY CHARACTERS
|
|
LDXI BUFLEN-1
|
|
GDBUFS: LDAI 0 ;PUT A ZERO AT THE END
|
|
STA BUF,X
|
|
TXA
|
|
BEQ NOCHR
|
|
LOPBHT: LDA BUF-1,X
|
|
ANDI 127
|
|
STA BUF-1,X
|
|
DEX
|
|
BNE LOPBHT
|
|
NOCHR: LDAI 0
|
|
LDXYI <BUF-1> ;POINT AT THE BEGINNING
|
|
RTS>
|
|
IFN REALIO-4,<
|
|
IFN REALIO-3,<
|
|
LINLIN: IFE REALIO-2,<
|
|
JSR OUTDO> ;ECHO IT.
|
|
DEX ;BACKARROW SO BACKUP PNTR AND
|
|
BPL INLINC ;GET ANOTHER IF COUNT IS POSITIVE.
|
|
INLINN: IFE REALIO-2,<
|
|
JSR OUTDO> ;PRINT THE @ OR A SECOND BACKARROW
|
|
;IF THERE WERE TOO MANY.
|
|
JSR CRDO>
|
|
INLIN: LDXI 0
|
|
INLINC: JSR INCHR ;GET A CHARACTER.
|
|
IFN REALIO-3,<
|
|
CMPI 7 ;IS IT BOB ALBRECHT RINGING THE BELL
|
|
;FOR SCHOOL KIDS?
|
|
BEQ GOODCH>
|
|
CMPI 13 ;CARRIAGE RETURN?
|
|
BEQ FININ1 ;YES, FINISH UP.
|
|
IFN REALIO-3,<
|
|
CMPI 32 ;CHECK FOR FUNNY CHARACTERS.
|
|
BCC INLINC
|
|
CMPI 125 ;IS IT TILDA OR DELETE?
|
|
BCS INLINC ;BIG BAD ONES TOO.
|
|
CMPI "@" ;LINE DELETE?
|
|
BEQ INLINN ;YES.
|
|
CMPI "_" ;CHARACTER DELETE?
|
|
BEQ LINLIN> ;YES.
|
|
GOODCH:
|
|
IFN REALIO-3,<
|
|
CPXI BUFLEN-1 ;LEAVE ROOM FOR NULL.
|
|
;COMMO ASSURES US NEVER MORE THAN BUFLEN.
|
|
BCS OUTBEL>
|
|
STA BUF,X
|
|
INX
|
|
IFE REALIO-2,<SKIP2>
|
|
IFN REALIO-2,<BNE INLINC>
|
|
IFN REALIO-3,<
|
|
OUTBEL: LDAI 7
|
|
IFN REALIO,<
|
|
JSR OUTDO> ;ECHO IT.
|
|
BNE INLINC> ;CYCLE ALWAYS.
|
|
FININ1: JMP FININL> ;GO TO FININL FAR, FAR AWAY.
|
|
INCHR:
|
|
IFE REALIO-3,<
|
|
JSR CQINCH> ;FOR COMMODORE.
|
|
IFE REALIO-2,<
|
|
INCHRL: LDA ^O176000
|
|
REPEAT 4,<NOP>
|
|
LSR A,
|
|
BCC INCHRL
|
|
LDA ^O176001 ;GET THE CHARACTER.
|
|
REPEAT 4,<NOP>
|
|
ANDI 127>
|
|
IFE REALIO-1,<
|
|
JSR ^O17132> ;1E5A FOR MOS TECH.
|
|
IFE REALIO-4,<
|
|
JSR CQINCH ;FD0C FOR APPLE COMPUTER.
|
|
ANDI 127>
|
|
IFE REALIO,<
|
|
TJSR INSIM##> ;GET A CHARACTER FROM SIMULATOR
|
|
|
|
IFN REALIO,<
|
|
IFN EXTIO,<
|
|
LDY CHANNL ;CNT-O HAS NO EFFECT IF NOT FROM TERM.
|
|
BNE INCRTS>
|
|
CMPI CONTW ;SUPPRESS OUTPUT CHARACTER (^W).
|
|
BNE INCRTS ;NO, RETURN.
|
|
PHA
|
|
COM CNTWFL ;COMPLEMENT ITS STATE.
|
|
PLA>
|
|
INCRTS: RTS ;END OF INCHR.
|
|
|
|
;
|
|
; ALL "RESERVED" WORDS ARE TRANSLATED INTO SINGLE
|
|
; BYTES WITH THE MSB ON. THIS SAVES SPACE AND TIME
|
|
; BY ALLOWING FOR TABLE DISPATCH DURING EXECUTION.
|
|
; THEREFORE ALL STATEMENTS APPEAR TOGETHER IN THE
|
|
; RESERVED WORD LIST IN THE SAME ORDER THEY
|
|
; APPEAR IN STMDSP.
|
|
;
|
|
BUFOFS=0 ;THE AMOUNT TO OFFSET THE LOW BYTE
|
|
;OF THE TEXT POINTER TO GET TO BUF
|
|
;AFTER TXTPTR HAS BEEN SETUP TO POINT INTO BUF
|
|
IFN BUFPAG,<
|
|
BUFOFS=<BUF/256>*256>
|
|
CRUNCH: LDX TXTPTR ;SET SOURCE POINTER.
|
|
LDYI 4 ;SET DESTINATION OFFSET.
|
|
STY DORES ;ALLOW CRUNCHING.
|
|
KLOOP: LDA BUFOFS,X
|
|
IFE REALIO-3,<
|
|
BPL CMPSPC ;GO LOOK AT SPACES.
|
|
CMPI PI ;PI??
|
|
BEQ STUFFH ;GO SAVE IT.
|
|
INX ;SKIP NO PRINTING.
|
|
BNE KLOOP> ;ALWAYS GOES.
|
|
CMPSPC: CMPI " " ;IS IT A SPACE TO SAVE?
|
|
BEQ STUFFH ;YES, GO SAVE IT.
|
|
STA ENDCHR ;IF IT'S A QUOTE, THIS WILL
|
|
;STOP LOOP WHEN OTHER QUOTE APPEARS.
|
|
CMPI 34 ;QUOTE SIGN?
|
|
BEQ STRNG ;YES, DO SPECIAL STRING HANDLING.
|
|
BIT DORES ;TEST FLAG.
|
|
BVS STUFFH ;NO CRUNCH, JUST STORE.
|
|
CMPI "?" ;A QMARK?
|
|
BNE KLOOP1
|
|
LDAI PRINTK ;YES, STUFF A "PRINT" TOKEN.
|
|
BNE STUFFH ;ALWAYS GO TO STUFFH.
|
|
KLOOP1: CMPI "0" ;SKIP NUMERICS.
|
|
BCC MUSTCR
|
|
CMPI 60 ;":" AND ";" ARE ENTERED STRAIGHTAWAY.
|
|
BCC STUFFH
|
|
MUSTCR: STY BUFPTR ;SAVE BUFFER POINTER.
|
|
LDYI 0 ;LOAD RESLST POINTER.
|
|
STY COUNT ;ALSO CLEAR COUNT.
|
|
DEY
|
|
STX TXTPTR ;SAVE TEXT POINTER FOR LATER USE.
|
|
DEX
|
|
RESER: INY
|
|
RESPUL: INX
|
|
RESCON: LDA BUFOFS,X
|
|
SEC ;PREPARE TO SUBSTARCT.
|
|
SBC RESLST,Y ;CHARACTERS EQUAL?
|
|
BEQ RESER ;YES, CONTINUE SEARCH.
|
|
CMPI 128 ;NO BUT MAYBE THE END IS HERE.
|
|
BNE NTHIS ;NO, TRULY UNEQUAL.
|
|
ORA COUNT
|
|
GETBPT: LDY BUFPTR ;GET BUFFER PNTR.
|
|
STUFFH: INX
|
|
INY
|
|
STA BUF-5,Y
|
|
LDA BUF-5,Y
|
|
BEQ CRDONE ;NULL IMPLIES END OF LINE.
|
|
SEC ;PREPARE TO SUBSTARCT.
|
|
SBCI ":" ;IS IT A ":"?
|
|
BEQ COLIS ;YES, ALLOW CRUNCHING AGAIN.
|
|
CMPI DATATK-":" ;IS IT A DATATK?
|
|
BNE NODATT ;NO, SEE IF IT IS REM TOKEN.
|
|
COLIS: STA DORES ;SETUP FLAG.
|
|
NODATT: SEC ;PREP TO SBCQ
|
|
SBCI REMTK-":" ;REM ONLY STOPS ON NULL.
|
|
BNE KLOOP ;NO, CONTINUE CRUNCHING.
|
|
STA ENDCHR ;REM STOPS ONLY ON NULL, NOT : OR ".
|
|
STR1: LDA BUFOFS,X
|
|
BEQ STUFFH ;YES, END OF LINE, SO DONE.
|
|
CMP ENDCHR ;END OF GOBBLE?
|
|
BEQ STUFFH ;YES, DONE WITH STRING.
|
|
STRNG: INY ;INCREMENT BUFFER POINTER.
|
|
STA BUF-5,Y
|
|
INX
|
|
BNE STR1 ;PROCESS NEXT CHARACTER.
|
|
NTHIS: LDX TXTPTR ;RESTORE TEXT POINTER.
|
|
INC COUNT ;INCREMENT RES WORD COUNT.
|
|
NTHIS1: INY
|
|
LDA RESLST-1,Y, ;GET RES CHARACTER.
|
|
BPL NTHIS1 ;END OF ENTRY?
|
|
LDA RESLST,Y, ;YES. IS IT THE END?
|
|
BNE RESCON ;NO, TRY THE NEXT WORD.
|
|
LDA BUFOFS,X ;YES, END OF TABLE. GET 1ST CHR.
|
|
BPL GETBPT ;STORE IT AWAY (ALWAYS BRANCHES).
|
|
CRDONE: STA BUF-3,Y, ;SO THAT IF THIS IS A DIR STATEMENT
|
|
;ITS END WILL LOOK LIKE END OF PROGRAM.
|
|
IFN <<BUF+BUFLEN>/256>-<<BUF-1>/256>,<
|
|
DEC TXTPTR+1>
|
|
LDAI <BUF&255>-1 ;MAKE TXTPTR POINT TO
|
|
STA TXTPTR ;CRUNCHED LINE.
|
|
LISTRT: RTS ;RETURN TO CALLER.
|
|
;
|
|
; FNDLIN SEARCHES THE PROGRAM TEXT FOR THE LINE
|
|
; WHOSE NUMBER IS PASSED IN "LINNUM".
|
|
; THERE ARE TWO POSSIBLE RETURNS:
|
|
;
|
|
; 1) CARRY SET.
|
|
; LOWTR POINTS TO THE LINK FIELD IN THE LINE
|
|
; WHICH IS THE ONE SEARCHED FOR.
|
|
;
|
|
; 2) CARRY NOT SET.
|
|
; LINE NOT FOUND. [LOWTR] POINTS TO THE LINE IN THE
|
|
; PROGRAM GREATER THAN THE ONE SOUGHT AFTER.
|
|
;
|
|
FNDLIN: LDWX TXTTAB ;LOAD [X,A] WITH [TXTTAB]
|
|
FNDLNC: LDYI 1
|
|
STWX LOWTR ;STORE [X,A] INTO LOWTR
|
|
LDADY LOWTR ;SEE IF LINK IS 0
|
|
BEQ FLINRT
|
|
INY
|
|
INY
|
|
LDA LINNUM+1 ;COMP HIGH ORDERS OF LINE NUMBERS.
|
|
CMPDY LOWTR
|
|
BCC FLNRTS ;NO SUCH LINE NUMBER.
|
|
BEQ FNDLO1
|
|
DEY
|
|
BNE AFFRTS ;ALWAYS BRANCH.
|
|
FNDLO1: LDA LINNUM
|
|
DEY
|
|
CMPDY LOWTR ;COMPARE LOW ORDERS.
|
|
BCC FLNRTS ;NO SUCH NUMBER.
|
|
BEQ FLNRTS ;GO TIT.
|
|
AFFRTS: DEY
|
|
LDADY LOWTR ;FETCH LINK.
|
|
TAX
|
|
DEY
|
|
LDADY LOWTR
|
|
BCS FNDLNC ;ALWAYS BRANCHES.
|
|
FLINRT: CLC ;C MAY BE HIGH.
|
|
FLNRTS: RTS ;RETURN TO CALLER.
|
|
;
|
|
; THE "NEW" COMMAND CLEARS THE PROGRAM TEXT AS WELL
|
|
; AS VARIABLE SPACE.
|
|
;
|
|
SCRATH: BNE FLNRTS ;MAKE SURE THERE IS A TERMINATOR.
|
|
SCRTCH: LDAI 0 ;GET A CLEARER.
|
|
TAY ;SET UP INDEX.
|
|
STADY TXTTAB ;CLEAR FIRST LINK.
|
|
INY
|
|
STADY TXTTAB
|
|
LDA TXTTAB
|
|
CLC
|
|
ADCI 2
|
|
STA VARTAB ;SETUP [VARTAB].
|
|
LDA TXTTAB+1
|
|
ADCI 0
|
|
STA VARTAB+1
|
|
RUNC: JSR STXTPT
|
|
LDAI 0 ;SET ZERO FLAG
|
|
;
|
|
; THIS CODE IS FOR THE CLEAR COMMAND.
|
|
;
|
|
CLEAR: BNE STKRTS ;SYNTAX ERROR IF NO TERMINATOR.
|
|
;
|
|
; CLEAR INITIALIZES THE VARIABLE AND
|
|
; ARRAY SPACE BY RESETING ARYTAB (THE END OF SIMPLE VARIABLE SPACE)
|
|
; AND STREND (THE END OF ARRAY STORAGE). IT FALLS INTO "STKINI"
|
|
; WHICH RESETS THE STACK.
|
|
;
|
|
CLEARC: LDWD MEMSIZ ;FREE UP STRING SPACE.
|
|
STWD FRETOP
|
|
IFN EXTIO,<
|
|
JSR CQCALL> ;CLOSE ALL OPEN FILES.
|
|
LDWD VARTAB ;LIBERATE THE
|
|
STWD ARYTAB ;VARIABLES AND
|
|
STWD STREND ;ARRAYS.
|
|
FLOAD: JSR RESTOR ;RESTORE DATA.
|
|
;
|
|
; STKINI RESETS THE STACK POINTER ELIMINATING
|
|
; GOSUB AND FOR CONTEXT. STRING TEMPORARIES ARE FREED
|
|
; UP, SUBFLG IS RESET. CONTINUING IS PROHIBITED.
|
|
; AND A DUMMY ENTRY IS LEFT AT THE BOTTOM OF THE STACK SO "FNDFOR" WILL ALWAYS
|
|
; FIND A NON-"FOR" ENTRY AT THE BOTTOM OF THE STACK.
|
|
;
|
|
STKINI: LDXI TEMPST ;INITIALIZE STRING TEMPORARIES.
|
|
STX TEMPPT
|
|
PLA ;SETUP RETURN ADDRESS.
|
|
TAY
|
|
PLA
|
|
LDXI STKEND-257
|
|
TXS
|
|
PHA
|
|
TYA
|
|
PHA
|
|
LDAI 0
|
|
STA OLDTXT+1 ;DISALLOWING CONTINUING
|
|
STA SUBFLG ;ALLOW SUBSCRIPTS.
|
|
STKRTS: RTS
|
|
|
|
STXTPT: CLC
|
|
LDA TXTTAB
|
|
ADCI 255
|
|
STA TXTPTR
|
|
LDA TXTTAB+1
|
|
ADCI 255
|
|
STA TXTPTR+1 ;SETUP TEXT POINTER.
|
|
RTS
|
|
PAGE
|
|
SUBTTL THE "LIST" COMMAND.
|
|
|
|
LIST: BCC GOLST ;IT IS A DIGIT.
|
|
BEQ GOLST ;IT IS A TERMINATOR.
|
|
CMPI MINUTK ;DASH PRECEDING?
|
|
BNE STKRTS ;NO, SO SYNTAX ERROR.
|
|
GOLST: JSR LINGET ;GET LINE NUMBER INTO NUMLIN.
|
|
JSR FNDLIN ;FIND LINE .GE. [NUMLIN].
|
|
JSR CHRGOT ;GET LAST CHARACTER.
|
|
BEQ LSTEND ;IF END OF LINE, # IS THE END.
|
|
CMPI MINUTK ;DASH?
|
|
BNE FLNRTS ;IF NOT, SYNTAX ERROR.
|
|
JSR CHRGET ;GET NEXT CHAR.
|
|
JSR LINGET ;GET END #.
|
|
BNE FLNRTS ;IF NOT TERMINATOR, ERROR.
|
|
LSTEND: PLA
|
|
PLA ;GET RID OF "NEWSTT" RTS ADDR.
|
|
LDA LINNUM ;SEE IF IT WAS EXISTENT.
|
|
ORA LINNUM+1
|
|
BNE LIST4 ;IT WAS TYPED.
|
|
LDAI 255
|
|
STA LINNUM
|
|
STA LINNUM+1 ;MAKE IT HUGE.
|
|
LIST4: LDYI 1
|
|
IFE REALIO-3,<
|
|
STY DORES>
|
|
LDADY LOWTR ;IS LINK ZERO?
|
|
BEQ GRODY ;YES, GO TO READY.
|
|
IFN REALIO,<
|
|
JSR ISCNTC> ;LISTEN FOR CONT-C.
|
|
JSR CRDO ;PRINT CRLF TO START WITH.
|
|
INY
|
|
LDADY LOWTR
|
|
TAX
|
|
INY
|
|
LDADY LOWTR ;GET LINE NUMBER.
|
|
CMP LINNUM+1 ;SEE IF BEYOND LAST.
|
|
BNE TSTDUN ;GO DETERMINE RELATION.
|
|
CPX LINNUM ;WAS EQUAL SO TEST LOW ORDER.
|
|
BEQ TYPLIN ;EQUAL, SO LIST IT.
|
|
TSTDUN: BCS GRODY ;IF LINE IS GR THAN LAST, THEN DUNE.
|
|
TYPLIN: STY LSTPNT
|
|
JSR LINPRT ;PRINT AS INT WITHOUT LEADING SPACE.
|
|
LDAI " " ;ALWAYS PRINT SPACE AFTER NUMBER.
|
|
PRIT4: LDY LSTPNT ;GET POINTER TO LINE BACK.
|
|
ANDI 127
|
|
PLOOP: JSR OUTDO ;PRINT CHAR.
|
|
IFE REALIO-3,<
|
|
CMPI 34
|
|
BNE PLOOP1
|
|
COM DORES> ;IF QUOTE, COMPLEMENT FLAG.
|
|
PLOOP1: INY
|
|
BEQ GRODY ;IF WE HAVE PRINTED 256 CHARACTERS
|
|
;THE PROGRAM MUST BE MISFORMATED IN
|
|
;MEMORY DUE TO A BAD LOAD OR BAD
|
|
;HARDWARE. LET THE GUY RECOVER
|
|
LDADY LOWTR ;GET NEXT CHAR. IS IT ZERO?
|
|
BNE QPLOP ;YES. END OF LINE.
|
|
TAY
|
|
LDADY LOWTR
|
|
TAX
|
|
INY
|
|
LDADY LOWTR
|
|
STX LOWTR
|
|
STA LOWTR+1
|
|
BNE LIST4 ;BRANCH IF SOMETHING TO LIST.
|
|
GRODY: JMP READY
|
|
;IS IT A TOKEN?
|
|
QPLOP: BPL PLOOP ;NO, HEAD FOR PRINTER.
|
|
IFE REALIO-3,<
|
|
CMPI PI
|
|
BEQ PLOOP
|
|
BIT DORES ;INSIDE QUOTE MARKS?
|
|
BMI PLOOP> ;YES, JUST TYPE THE CHARACTER.
|
|
SEC
|
|
SBCI 127 ;GET RID OF SIGN BIT AND ADD 1.
|
|
TAX ;MAKE IT A COUNTER.
|
|
STY LSTPNT ;SAVE POINTER TO LINE.
|
|
LDYI 255 ;LOOK AT RES'D WORD LIST.
|
|
RESRCH: DEX ;IS THIS THE RES'D WORD?
|
|
BEQ PRIT3 ;YES, GO TOSS IT UP..
|
|
RESCR1: INY
|
|
LDA RESLST,Y, ;END OF ENTRY?
|
|
BPL RESCR1 ;NO, CONTINUE PASSING.
|
|
BMI RESRCH
|
|
PRIT3: INY
|
|
LDA RESLST,Y
|
|
BMI PRIT4 ;END OF RESERVED WORD.
|
|
JSR OUTDO ;PRINT IT.
|
|
BNE PRIT3 ;END OF ENTRY? NO, TYPE REST.
|
|
PAGE
|
|
SUBTTL THE "FOR" STATEMENT.
|
|
;
|
|
; A "FOR" ENTRY ON THE STACK HAS THE FOLLOWING FORMAT:
|
|
;
|
|
; LOW ADDRESS
|
|
; TOKEN (FORTK) 1 BYTE
|
|
; A POINTER TO THE LOOP VARIABLE 2 BYTES
|
|
; THE STEP 4+ADDPRC BYTES
|
|
; A BYTE REFLECTING THE SIGN OF THE INCREMENT 1 BYTE
|
|
; THE UPPER VALUE 4+ADDPRC BYTES
|
|
; THE LINE NUMBER OF THE "FOR" STATEMENT 2 BYTES
|
|
; A TEXT POINTER INTO THE "FOR" STATEMENT 2 BYTES
|
|
; HIGH ADDRESS
|
|
;
|
|
; TOTAL 16+2*ADDPRC BYTES.
|
|
;
|
|
|
|
FOR: LDAI 128 ;DON'T RECOGNIZE
|
|
STA SUBFLG ;SUBSCRIPTED VARIABLES.
|
|
JSR LET ;READ THE VARIABLE AND ASSIGN IT
|
|
;THE CORRECT INITIAL VALUE AND STORE
|
|
;A POINTER TO THE VARIABLE IN VARPNT.
|
|
JSR FNDFOR ;PNTR IS IN VARPNT, AND FORPNT.
|
|
BNE NOTOL ;IF NO MATCH, DON'T ELIMINATE ANYTHING.
|
|
TXA ;MAKE IT ARITHMETICAL.
|
|
ADCI FORSIZ-3 ;ELIMINATE ALMOST ALL.
|
|
TAX ;NOTE C=1, THEN PLA, PLA.
|
|
TXS ;MANIFEST.
|
|
NOTOL: PLA ;GET RID OF NEWSTT RETURN ADDRESS
|
|
PLA ;IN CASE THIS IS A TOTALLY NEW ENTRY.
|
|
LDAI 8+ADDPRC
|
|
JSR GETSTK ;MAKE SURE 16 BYTES ARE AVAILABLE.
|
|
JSR DATAN ;GET A COUNT IN [Y] OF THE NUMBER OF
|
|
;CHACRACTERS LEFT IN THE "FOR" STATEMENT
|
|
;[TXTPTR] IS UNAFFECTED.
|
|
CLC ;PREP TO ADD.
|
|
TYA ;SAVE IT FOR PUSHING.
|
|
ADC TXTPTR
|
|
PHA
|
|
LDA TXTPTR+1
|
|
ADCI 0
|
|
PHA
|
|
PSHWD CURLIN ;PUT LINE NUMBER ON STACK.
|
|
SYNCHK TOTK ;"TO" IS NECESSARY.
|
|
JSR CHKNUM ;VALUE MUST BE A NUMBER.
|
|
JSR FRMNUM ;GET UPPER VALUE INTO FAC.
|
|
LDA FACSGN ;PACK FAC.
|
|
ORAI 127
|
|
AND FACHO
|
|
STA FACHO ;SET PACKED SIGN BIT.
|
|
LDWDI LDFONE
|
|
STWD INDEX1
|
|
JMP FORPSH ;PUT FAC ONTO STACK, PACKED.
|
|
LDFONE: LDWDI FONE ;PUT 1.0 INTO FAC.
|
|
JSR MOVFM
|
|
JSR CHRGOT
|
|
CMPI STEPTK ;A STEP IS GIVEN?
|
|
BNE ONEON ;NO. ASSUME 1.0.
|
|
JSR CHRGET ;YES. ADVANCE POINTER.
|
|
JSR FRMNUM ;READ THE STEP.
|
|
ONEON: JSR SIGN ;GET SIGN IN ACCA.
|
|
JSR PUSHF ;PUSH FAC ONTO STACK (THRU A).
|
|
PSHWD FORPNT ;PUT PNTR TO VARIABLE ON STACK.
|
|
NXTCON: LDAI FORTK ;PUT A FORTK ONTO STACK.
|
|
PHA
|
|
; BNEA NEWSTT ;SIMULATE BNE TO NEWSTT. JUST FALL IN.
|
|
PAGE
|
|
SUBTTL NEW STATEMENT FETCHER.
|
|
;
|
|
; BACK HERE FOR NEW STATEMENT. CHARACTER POINTED TO BY TXTPTR
|
|
; IS ":" OR END-OF-LINE. THE ADDRESS OF THIS LOC IS LEFT
|
|
; ON THE STACK WHEN A STATEMENT IS EXECUTED SO THAT
|
|
; IT CAN MERELY DO A RTS WHEN IT IS DONE.
|
|
;
|
|
NEWSTT: IFN REALIO,<
|
|
JSR ISCNTC> ;LISTEN FOR CONTROL-C.
|
|
LDWD TXTPTR ;LOOK AT CURRENT CHARACTER.
|
|
IFN BUFPAG,<
|
|
CPYI BUFPAG> ;SEE IF IT WAS DIRECT BY CHECK FOR BUF'S PAGE NUMBER
|
|
BEQ DIRCON
|
|
STWD OLDTXT ;SAVE IN CASE OF RESTART BY INPUT.
|
|
IFN BUFPAG,<DIRCON:>
|
|
LDYI 0
|
|
IFE BUFPAG,<DIRCON:>
|
|
LDADY TXTPTR
|
|
BNE MORSTS ;NOT NULL -- CHECK WHAT IT IS
|
|
LDYI 2 ;LOOK AT LINK.
|
|
LDADY TXTPTR ;IS LINK 0?
|
|
CLC ;CLEAR CARRY FOR ENDCON AND MATH THAT FOLLOWS
|
|
JEQ ENDCON ;YES - RAN OFF THE END.
|
|
INY ;PUT LINE NUMBER IN CURLIN.
|
|
LDADY TXTPTR
|
|
STA CURLIN
|
|
INY
|
|
LDADY TXTPTR
|
|
STA CURLIN+1
|
|
TYA
|
|
ADC TXTPTR
|
|
STA TXTPTR
|
|
BCC GONE
|
|
INC TXTPTR+1
|
|
GONE: JSR CHRGET ;GET THE STATEMENT TYPE.
|
|
JSR GONE3
|
|
JMP NEWSTT
|
|
GONE3: BEQ ISCRTS ;IF TERMINATOR, TRY AGAIN.
|
|
;NO NEED TO SET UP CARRY SINCE IT WILL
|
|
;BE ON IF NON-NUMERIC AND NUMERICS
|
|
;WILL CAUSE A SYNTAX ERROR LIKE THEY SHOULD
|
|
GONE2: SBCI ENDTK ;" ON ... GOTO AND GOSUB" COME HERE.
|
|
BCC GLET
|
|
CMPI SCRATK-ENDTK+1
|
|
BCS SNERRX ;SOME RES'D WORD BUT NOT
|
|
;A STATEMENT RES'D WORD.
|
|
ASL A, ;MULTIPLY BY TWO.
|
|
TAY ;MAKE AN INDEX.
|
|
LDA STMDSP+1,Y
|
|
PHA
|
|
LDA STMDSP,Y
|
|
PHA ;PUT DISP ADDR ONTO STACK.
|
|
JMP CHRGET
|
|
GLET: JMP LET ;MUST BE A LET
|
|
MORSTS: CMPI ":"
|
|
BEQ GONE ;IF A ":" CONTINUE STATEMENT
|
|
SNERR1: JMP SNERR ;NEITHER 0 OR ":" SO SYNTAX ERROR
|
|
SNERRX: CMPI GOTK-ENDTK
|
|
BNE SNERR1
|
|
JSR CHRGET ;READ IN THE CHARACTER AFTER "GO "
|
|
SYNCHK TOTK
|
|
JMP GOTO
|
|
PAGE
|
|
SUBTTL RESTORE,STOP,END,CONTINUE,NULL,CLEAR.
|
|
|
|
RESTOR: SEC
|
|
LDA TXTTAB
|
|
SBCI 1
|
|
LDY TXTTAB+1
|
|
BCS RESFIN
|
|
DEY
|
|
RESFIN: STWD DATPTR ;READ FINISHES COME TO "RESFIN".
|
|
ISCRTS: RTS
|
|
|
|
IFE REALIO-1,<
|
|
ISCNTC: LDAI 1
|
|
BIT ^O13500
|
|
BMI ISCRTS
|
|
LDXI 8
|
|
LDAI 3
|
|
CMPI 3>
|
|
IFE REALIO-2,<
|
|
ISCNTC: LDA ^O176000
|
|
REPEAT 4,<NOP>
|
|
LSR A,
|
|
BCC ISCRTS
|
|
JSR INCHR ;EAT CHAR THAT WAS TYPED
|
|
CMPI 3> ;WAS IT A CONTROL-C??
|
|
|
|
IFE REALIO-4,<
|
|
ISCNTC: LDA ^O140000 ;CHECK THE CHARACTER
|
|
CMPI ^O203
|
|
BEQ ISCCAP
|
|
RTS
|
|
ISCCAP: JSR INCHR
|
|
CMPI ^O203>
|
|
STOP: BCS STOPC ;MAKE [C] NONZERO AS A FLAG.
|
|
END: CLC
|
|
STOPC: BNE CONTRT ;RETURN IF NOT CONT-C OR
|
|
;IF NO TERMINATOR FOR STOP OR END.
|
|
;[C]=0 SO WILL NOT PRINT "BREAK".
|
|
LDWD TXTPTR
|
|
IFN BUFPAG,<
|
|
LDX CURLIN+1
|
|
INX>
|
|
BEQ DIRIS
|
|
STWD OLDTXT
|
|
STPEND: LDWD CURLIN
|
|
STWD OLDLIN
|
|
DIRIS: PLA ;POP OFF NEWSTT ADDR.
|
|
PLA
|
|
ENDCON: LDWDI BRKTXT
|
|
IFN REALIO,<
|
|
LDXI 0
|
|
STX CNTWFL>
|
|
BCC GORDY ;CARRY CLEAR SO DON'T PRINT "BREAK".
|
|
JMP ERRFIN
|
|
GORDY: JMP READY ;TYPE "READY".
|
|
|
|
IFE REALIO,<
|
|
DDT: PLA ;GET RID OF NEWSTT RETURN.
|
|
PLA
|
|
HRRZ 14,.JBDDT##
|
|
JRST 0(14)>
|
|
CONT: BNE CONTRT ;MAKE SURE THERE IS A TERMINATOR.
|
|
LDXI ERRCN ;CONTINUE ERROR.
|
|
LDY OLDTXT+1 ;A STORED TXTPTR OF ZERO IS SETUP
|
|
;BY STKINI AND INDICATES THERE IS
|
|
;NOTHING TO CONTINUE.
|
|
JEQ ERROR ;"STOP", "END", TYPING CRLF TO
|
|
;"INPUT" AND ^C SETUP OLDTXT.
|
|
LDA OLDTXT
|
|
STWD TXTPTR
|
|
LDWD OLDLIN
|
|
STWD CURLIN
|
|
CONTRT: RTS ;RETURN TO CALLER.
|
|
|
|
IFN NULCMD,<
|
|
NULL: JSR GETBYT
|
|
BNE CONTRT ;MAKE SURE THERE IS TERMINATOR.
|
|
INX
|
|
CPXI 240 ;IS THE NUMBER REASONABLE?
|
|
BCS FCERR1 ;"FUNCTION CALL" ERROR.
|
|
DEX ;BACK -1
|
|
STX NULCNT
|
|
RTS
|
|
FCERR1: JMP FCERR>
|
|
PAGE
|
|
SUBTTL LOAD AND SAVE SUBROUTINES.
|
|
|
|
IFE REALIO-1,< ;KIM CASSETTE I/O
|
|
SAVE: TSX ;SAVE STACK POINTER
|
|
STX INPFLG
|
|
LDAI STKEND-256-200
|
|
STA ^O362 ;SETUP DUMMY STACK FOR KIM MONITOR
|
|
LDAI 254 ;MAKE ID BYTE EQUAL TO FF HEX
|
|
STA ^O13771 ;STORE INTO KIM ID
|
|
LDWD TXTTAB ;START DUMPING FROM TXTTAB
|
|
STWD ^O13765 ;SETUP SAL,SAH
|
|
LDWD VARTAB ;STOP AT VARTAB
|
|
STWD ^O13767 ;SETUP EAL,EAH
|
|
JMP ^O14000
|
|
RETSAV: LDX INPFLG ;RESORE THE REAL STACK POINTER
|
|
TXS
|
|
LDWDI TAPMES ;SAY IT WAS DONE
|
|
JMP STROUT
|
|
GLOAD: DT"LOADED"
|
|
0
|
|
TAPMES: DT"SAVED"
|
|
ACRLF
|
|
0
|
|
PATSAV: BLOCK 20
|
|
LOAD: LDWD TXTTAB ;START DUMPING IN AT TXTTAB
|
|
STWD ^O13765 ;SETUP SAL,SAH
|
|
LDAI 255
|
|
STA ^O13771
|
|
LDWDI RTLOAD
|
|
STWD ^O1 ;SET UP RETURN ADDRESS FOR LOAD
|
|
JMP ^O14163 ;GO READ THE DATA IN
|
|
RTLOAD: LDXI STKEND-256 ;RESET THE STACK
|
|
TXS
|
|
LDWDI READY
|
|
STWD ^O1
|
|
LDWDI GLOAD ;TELL HIM IT WORKED
|
|
JSR STROUT
|
|
LDXY ^O13755 ;GET LAST LOCATION
|
|
TXA ;ITS ONE TOO BIG
|
|
BNE DECVRT ;DECREMENT [X,Y]
|
|
NOP
|
|
DECVRT: NOP
|
|
STXY VARTAB ;SETUP NEW VARIABLE LOCATION
|
|
JMP FINI> ;RELINK THE PROGRAM
|
|
IFE REALIO-4,<
|
|
SAVE: SEC ;CALCLUATE PROGRAM SIZE IN POKER
|
|
LDA VARTAB
|
|
SBC TXTTAB
|
|
STA POKER
|
|
LDA VARTAB+1
|
|
SBC TXTTAB+1
|
|
STA POKER+1
|
|
JSR VARTIO
|
|
JSR CQCOUT ;WRITE PROGRAM SIZE [POKER]
|
|
JSR PROGIO
|
|
JMP CQCOUT ;WRITE PROGRAM.
|
|
|
|
LOAD: JSR VARTIO
|
|
JSR CQCSIN ;READ SIZE OF PROGRAM INTO POKER
|
|
CLC
|
|
LDA TXTTAB ;CALCULATE VARTAB FROM SIZE AND
|
|
ADC POKER ;TXTTAB
|
|
STA VARTAB
|
|
LDA TXTTAB+1
|
|
ADC POKER+1
|
|
STA VARTAB+1
|
|
JSR PROGIO
|
|
JSR CQCSIN ;READ PROGRAM.
|
|
LDWDI TPDONE
|
|
JSR STROUT
|
|
JMP FINI
|
|
|
|
TPDONE: DT"LOADED"
|
|
0
|
|
|
|
VARTIO: LDWDI POKER
|
|
STWD ^O74
|
|
LDAI POKER+2
|
|
STWD ^O76
|
|
RTS
|
|
PROGIO: LDWD TXTTAB
|
|
STWD ^O74
|
|
LDWD VARTAB
|
|
STWD ^O76
|
|
RTS>
|
|
PAGE
|
|
SUBTTL RUN,GOTO,GOSUB,RETURN.
|
|
RUN: JEQ RUNC ;IF NO LINE # ARGUMENT.
|
|
JSR CLEARC ;CLEAN UP -- RESET THE STACK.
|
|
JMP RUNC2 ;MUST REPLACE RTS ADDR.
|
|
;
|
|
; A GOSUB ENTRY ON THE STACK HAS THE FOLLOWING FORMAT:
|
|
;
|
|
; LOW ADDRESS:
|
|
; THE GOSUTK ONE BYTE
|
|
; THE LINE NUMBER OF THE GOSUB STATEMENT TWO BYTES
|
|
; A POINTER INTO THE TEXT OF THE GOSUB TWO BYTES
|
|
;
|
|
; HIGH ADDRESS.
|
|
;
|
|
; TOTAL FIVE BYTES.
|
|
;
|
|
GOSUB: LDAI 3
|
|
JSR GETSTK ;MAKE SURE THERE IS ROOM.
|
|
PSHWD TXTPTR ;PUSH ON THE TEXT POINTER.
|
|
PSHWD CURLIN ;PUSH ON THE CURRENT LINE NUMBER.
|
|
LDAI GOSUTK
|
|
PHA ;PUSH ON A GOSUB TOKEN.
|
|
RUNC2: JSR CHRGOT ;GET CHARACTER AND SET CODES FOR LINGET.
|
|
JSR GOTO ;USE RTS SCHEME TO "NEWSTT".
|
|
JMP NEWSTT
|
|
|
|
GOTO: JSR LINGET ;PICK UP THE LINE NUMBER IN "LINNUM".
|
|
JSR REMN ;SKIP TO END OF LINE.
|
|
LDA CURLIN+1
|
|
CMP LINNUM+1
|
|
BCS LUK4IT
|
|
TYA
|
|
SEC
|
|
ADC TXTPTR
|
|
LDX TXTPTR+1
|
|
BCC LUKALL
|
|
INX
|
|
BCSA LUKALL ;ALWAYS GOES.
|
|
LUK4IT: LDWX TXTTAB
|
|
LUKALL: JSR FNDLNC ;[X,A] ARE ALL SET UP.
|
|
QFOUND: BCC USERR ;GOTO LINE IS NONEXISTANT.
|
|
LDA LOWTR
|
|
SBCI 1
|
|
STA TXTPTR
|
|
LDA LOWTR+1
|
|
SBCI 0
|
|
STA TXTPTR+1
|
|
GORTS: RTS ;PROCESS THE STATEMENT.
|
|
;
|
|
; "RETURN" RESTORES THE LINE NUMBER AND TEXT PNTR FROM THE STACK
|
|
; AND ELIMINATES ALL THE "FOR" ENTRIES IN FRONT OF THE "GOSUB" ENTRY.
|
|
;
|
|
RETURN: BNE GORTS ;NO TERMINATOR=BLOW HIM UP.
|
|
LDAI 255
|
|
STA FORPNT+1 ;MAKE SURE THE VARIABLE'S PNTR
|
|
;NEVER GETS MATCHED.
|
|
JSR FNDFOR ;GO PAST ALL THE "FOR" ENTRIES.
|
|
TXS
|
|
CMPI GOSUTK ;RETURN WITHOUT GOSUB?
|
|
BEQ RETU1
|
|
LDXI ERRRG
|
|
SKIP2
|
|
USERR: LDXI ERRUS ;NO MATCH SO "US" ERROR.
|
|
JMP ERROR ;YES.
|
|
SNERR2: JMP SNERR
|
|
RETU1: PLA ;REMOVE GOSUTK.
|
|
PULWD CURLIN ;GET LINE NUMBER "GOSUB" WAS FROM.
|
|
PULWD TXTPTR ;GET TEXT PNTR FROM "GOSUB".
|
|
DATA: JSR DATAN ;SKIP TO END OF STATEMENT,
|
|
;SINCE WHEN "GOSUB" STUCK THE TEXT PNTR
|
|
;ONTO THE STACK, THE LINE NUMBER ARG
|
|
;HADN'T BEEN READ YET.
|
|
ADDON: TYA
|
|
CLC
|
|
ADC TXTPTR
|
|
STA TXTPTR
|
|
BCC REMRTS
|
|
INC TXTPTR+1
|
|
REMRTS: RTS ;"NEWSTT" RTS ADDR IS STILL THERE.
|
|
|
|
DATAN: LDXI ":" ;"DATA" TERMINATES ON ":" AND NULL.
|
|
SKIP2
|
|
REMN: LDXI 0 ;THE ONLY TERMINATOR IS NULL.
|
|
STX CHARAC ;PRESERVE IT.
|
|
LDYI 0 ;THIS MAKES CHARAC=0 AFTER SWAP.
|
|
STY ENDCHR
|
|
EXCHQT: LDA ENDCHR
|
|
LDX CHARAC
|
|
STA CHARAC
|
|
STX ENDCHR
|
|
REMER: LDADY TXTPTR
|
|
BEQ REMRTS ;NULL ALWAYS TERMINATES.
|
|
CMP ENDCHR ;IS IT THE OTHER TERMINATOR?
|
|
BEQ REMRTS ;YES, IT'S FINISHED.
|
|
INY ;PROGRESS TO NEXT CHARACTER.
|
|
CMPI 34 ;IS IT A QUOTE?
|
|
BNE REMER ;NO, JUST CONTINUE.
|
|
BEQA EXCHQT ;YES, TIME TO TRADE.
|
|
PAGE
|
|
SUBTTL "IF ... THEN" CODE.
|
|
IF: JSR FRMEVL ;EVALUATE A FORMULA.
|
|
JSR CHRGOT ;GET CURRENT CHARACTER.
|
|
CMPI GOTOTK ;IS TERMINATING CHARACTER A GOTOTK?
|
|
BEQ OKGOTO ;YES.
|
|
SYNCHK THENTK ;NO, IT MUST BE "THEN".
|
|
OKGOTO: LDA FACEXP ;0=FALSE. ALL OTHERS TRUE.
|
|
BNE DOCOND ;TRUE !
|
|
REM: JSR REMN ;SKIP REST OF STATEMENT.
|
|
BEQA ADDON ;WILL ALWAYS BRANCH.
|
|
DOCOND: JSR CHRGOT ;TEST CURRENT CHARACTER.
|
|
BCS DOCO ;IF A NUMBER, GOTO IT.
|
|
JMP GOTO
|
|
DOCO: JMP GONE3 ;INTERPRET NEW STATEMENT.
|
|
PAGE
|
|
SUBTTL "ON ... GO TO ..." CODE.
|
|
ONGOTO: JSR GETBYT ;GET VALUE IN FACLO.
|
|
PHA ;SAVE FOR LATER.
|
|
CMPI GOSUTK ;AN "ON ... GOSUB" PERHAPS?
|
|
BEQ ONGLOP ;YES.
|
|
SNERR3: CMPI GOTOTK ;MUST BE "GOTOTK".
|
|
BNE SNERR2
|
|
ONGLOP: DEC FACLO
|
|
BNE ONGLP1 ;SKIP ANOTHER LINE NUMBER.
|
|
PLA ;GET DISPATCH CHARACTER.
|
|
JMP GONE2
|
|
ONGLP1: JSR CHRGET ;ADVANCE AND SET CODES.
|
|
JSR LINGET
|
|
CMPI 44 ;IS IT A COMMA?
|
|
BEQ ONGLOP
|
|
PLA ;REMOVE STACK ENTRY (TOKEN).
|
|
ONGRTS: RTS ;EITHER END-OF-LINE OR SYNTAX ERROR.
|
|
PAGE
|
|
SUBTTL LINGET -- READ A LINE NUMBER INTO LINNUM
|
|
;
|
|
; "LINGET" READS A LINE NUMBER FROM THE CURRENT TEXT POSITION.
|
|
;
|
|
; LINE NUMBERS RANGE FROM 0 TO 64000-1.
|
|
;
|
|
; THE ANSWER IS RETURNED IN "LINNUM".
|
|
; "TXTPTR" IS UPDATED TO POINT TO THE TERMINATING CHARCTER
|
|
; AND [A] = THE TERMINATING CHARACTER WITH CONDITION
|
|
; CODES SET UP TO REFLECT ITS VALUE.
|
|
;
|
|
LINGET: LDXI 0
|
|
STX LINNUM ;INITIALIZE LINE NUMBER TO ZERO.
|
|
STX LINNUM+1
|
|
MORLIN: BCS ONGRTS ;IT IS NOT A DIGIT.
|
|
SBCI "0"-1 ;-1 SINCE C=0.
|
|
STA CHARAC ;SAVE CHARACTER.
|
|
LDA LINNUM+1
|
|
STA INDEX
|
|
CMPI 25 ;LINE NUMBER WILL BE .LT. 64000?
|
|
BCS SNERR3
|
|
LDA LINNUM
|
|
ASL A, ;MULTIPLY BY 10.
|
|
ROL INDEX
|
|
ASL A
|
|
ROL INDEX
|
|
ADC LINNUM
|
|
STA LINNUM
|
|
LDA INDEX
|
|
ADC LINNUM+1
|
|
STA LINNUM+1
|
|
ASL LINNUM
|
|
ROL LINNUM+1
|
|
LDA LINNUM
|
|
ADC CHARAC ;ADD IN DIGIT.
|
|
STA LINNUM
|
|
BCC NXTLGC
|
|
INC LINNUM+1
|
|
NXTLGC: JSR CHRGET
|
|
JMP MORLIN
|
|
|
|
PAGE
|
|
SUBTTL "LET" CODE.
|
|
LET: JSR PTRGET ;GET PNTR TO VARIABLE INTO "VARPNT".
|
|
STWD FORPNT ;PRESERVE POINTER.
|
|
SYNCHK EQULTK ;"=" IS NECESSARY.
|
|
IFN INTPRC,<
|
|
LDA INTFLG ;SAVE FOR LATER.
|
|
PHA>
|
|
LDA VALTYP ;RETAIN THE VARIABLE'S VALUE TYPE.
|
|
PHA
|
|
JSR FRMEVL ;GET VALUE OF FORMULA INTO "FAC".
|
|
PLA
|
|
ROL A, ;CARRY SET FOR STRING, OFF FOR
|
|
;NUMERIC.
|
|
JSR CHKVAL ;MAKE SURE "VALTYP" MATCHES CARRY.
|
|
;AND SET ZERO FLAG FOR NUMERIC.
|
|
BNE COPSTR ;IF NUMERIC, COPY IT.
|
|
COPNUM:
|
|
IFN INTPRC,<
|
|
PLA ;GET NUMBER TYPE.
|
|
QINTGR: BPL COPFLT ;STORE A FLTING NUMBER.
|
|
JSR ROUND ;ROUND INTEGER.
|
|
JSR AYINT ;MAKE 2-BYTE NUMBER.
|
|
LDYI 0
|
|
LDA FACMO ;GET HIGH.
|
|
STADY FORPNT ;STORE IT.
|
|
INY
|
|
LDA FACLO ;GET LOW.
|
|
STADY FORPNT
|
|
RTS>
|
|
COPFLT: JMP MOVVF ;PUT NUMBER @FORPNT.
|
|
|
|
COPSTR:
|
|
IFN INTPRC,<PLA> ;IF STRING, NO INTFLG.
|
|
INPCOM:
|
|
IFN TIME,<
|
|
LDY FORPNT+1 ;TI$?
|
|
CPYI ZERO/256 ;ONLY TI$ CAN BE THIS ON ASSIG.
|
|
BNE GETSPT ; WAS NOT TI$.
|
|
JSR FREFAC ;WE WONT NEEDIT.
|
|
CMPI 6 ;LENGTH CORRECT?
|
|
BNE FCERR2
|
|
LDYI 0 ;YES. DO SETUP.
|
|
STY FACEXP ;ZERO FAC TO START WITH.
|
|
STY FACSGN
|
|
TIMELP: STY FBUFPT ;SAVE POSOTION.
|
|
JSR TIMNUM ;GET A DIGIT.
|
|
JSR MUL10 ;WHOLE QTY BY 10.
|
|
INC FBUFPT
|
|
LDY FBUFPT
|
|
JSR TIMNUM
|
|
JSR MOVAF
|
|
TAX ;IF NUM=0 THEN NO MULT.
|
|
BEQ NOML6 ;IF =0, GO TIT.
|
|
INX ;MULT BY TWO.
|
|
TXA
|
|
JSR FINML6 ;ADD IN AND MULT BY 2 GIVES *6.
|
|
NOML6: LDY FBUFPT
|
|
INY
|
|
CPYI 6 ;DONE ALL SIX?
|
|
BNE TIMELP
|
|
JSR MUL10 ;ONE LAST TIME.
|
|
JSR QINT ;SHIFT IT OVER TO THE RIGHT.
|
|
LDXI 2
|
|
SEI ;DISALLOW INTERRUPTS.
|
|
TIMEST: LDA FACMOH,X
|
|
STA CQTIMR,X
|
|
DEX
|
|
BPL TIMEST ;LOOP 3 TIMES.
|
|
CLI ;TURN ON INTS AGAIN.
|
|
RTS
|
|
TIMNUM: LDADY INDEX ;INDEX SET UP BY FREFAC.
|
|
JSR QNUM
|
|
BCC GOTNUM
|
|
FCERR2: JMP FCERR ;MUST BE NUMERIC STRING.
|
|
GOTNUM: SBCI "0"-1 ;C IS OFF.
|
|
JMP FINLOG> ;ADD IN DIGIT TO FAC.
|
|
|
|
GETSPT: LDYI 2 ;GET PNTR TO DESCRIPTOR.
|
|
LDADY FACMO
|
|
CMP FRETOP+1 ;SEE IF IT POINTS INTO STRING SPACE.
|
|
BCC DNTCPY ;IF [FRETOP],GT.[2&3,FACMO], DON'T COPY.
|
|
BNE QVARIA ;IT IS LESS.
|
|
DEY
|
|
LDADY FACMO
|
|
CMP FRETOP ;COMPARE LOW ORDERS.
|
|
BCC DNTCPY
|
|
QVARIA: LDY FACLO
|
|
CPY VARTAB+1 ;IF [VARTAB].GT.[FACMO], DON'T COPY.
|
|
BCC DNTCPY
|
|
BNE COPY ;IT IS LESS.
|
|
LDA FACMO
|
|
CMP VARTAB ;COMPARE LOW ORDERS.
|
|
BCS COPY
|
|
DNTCPY: LDWD FACMO
|
|
JMP COPYZC
|
|
COPY: LDYI 0
|
|
LDADY FACMO
|
|
JSR STRINI ;GET ROOM TO COPY STRING INTO.
|
|
LDWD DSCPNT ;GET POINTER TO OLD DESCRIPTOR, SO
|
|
STWD STRNG1 ;MOVINS CAN FIND STRING.
|
|
JSR MOVINS ;COPY IT.
|
|
LDWDI DSCTMP ;GET POINTER TO OLD DESCRIPTOR.
|
|
COPYZC: STWD DSCPNT ;REMEMBER POINTER TO DESCRIPTOR.
|
|
JSR FRETMS ;FREE UP THE TEMPORARY WITHOUT
|
|
;FREEING UP ANY STRING SPACE.
|
|
LDYI 0
|
|
LDADY DSCPNT
|
|
STADY FORPNT
|
|
INY ;POINT TO STRING PNTR.
|
|
LDADY DSCPNT
|
|
STADY FORPNT
|
|
INY
|
|
LDADY DSCPNT
|
|
STADY FORPNT
|
|
RTS
|
|
PAGE
|
|
SUBTTL PRINT CODE.
|
|
IFN EXTIO,<
|
|
PRINTN: JSR CMD ;DOCMD
|
|
JMP IODONE ;RELEASE CHANNEL.
|
|
CMD: JSR GETBYT
|
|
BEQ SAVEIT
|
|
SYNCHK 44 ;COMMA?
|
|
SAVEIT: PHP
|
|
JSR CQOOUT ;CHECK AND OPEN OUTPUT CHANNL.
|
|
STX CHANNL ;CHANNL TO OUTPUT ON.
|
|
PLP ;GET STATUS BACK.
|
|
JMP PRINT>
|
|
STRDON: JSR STRPRT
|
|
NEWCHR: JSR CHRGOT ;REGET LAST CHARACTER.
|
|
PRINT: BEQ CRDO ;TERMINATOR SO TYPE CRLF.
|
|
PRINTC: BEQ PRTRTS ;HERE AFTER SEEING TAB(X) OR , OR ;
|
|
;IN WHICH CASE A TERMINATOR DOES NOT
|
|
;MEAN TYPE A CRLF BUT JUST RTS.
|
|
CMPI TABTK ;TAB FUNCTION?
|
|
BEQ TABER ;YES.
|
|
CMPI SPCTK ;SPACE FUNCTION?
|
|
CLC
|
|
BEQ TABER
|
|
CMPI 44 ;A COMMA?
|
|
BEQ COMPRT ;YES.
|
|
CMPI 59 ;A SEMICOLON?
|
|
BEQ NOTABR ;YES.
|
|
JSR FRMEVL ;EVALUATE THE FORMULA.
|
|
BIT VALTYP ;A STRING?
|
|
BMI STRDON ;YES.
|
|
JSR FOUT
|
|
JSR STRLIT ;BUILD DESCRIPTOR.
|
|
IFN REALIO-3,<
|
|
LDYI 0 ;GET THE POINTER.
|
|
LDADY FACMO
|
|
CLC
|
|
ADC TRMPOS ;MAKE SURE LEN+POS.LT.WIDTH.
|
|
CMP LINWID ;GREATER THAN LINE LENGTH?
|
|
;REMEMBER SPACE PRINTED AFTER NUMBER.
|
|
BCC LINCHK ;GO TYPE.
|
|
JSR CRDO> ;YES, TYPE CRLF FIRST.
|
|
LINCHK: JSR STRPRT ;PRINT THE NUMBER.
|
|
JSR OUTSPC ;PRINT A SPACE
|
|
BNEA NEWCHR ;ALWAYS GOES.
|
|
IFN REALIO-4,<
|
|
IFN BUFPAG,<
|
|
FININL: LDAI 0
|
|
STA BUF,X
|
|
LDXYI BUF-1>
|
|
IFE BUFPAG,<
|
|
FININL: LDYI 0 ;PUT A ZERO AT END OF BUF.
|
|
STY BUF,X
|
|
LDXI BUF-1> ;SETUP POINTER.
|
|
IFN EXTIO,<
|
|
LDA CHANNL ;NO CRDO IF NOT TERMINAL.
|
|
BNE PRTRTS>>
|
|
CRDO:
|
|
IFE EXTIO,<
|
|
LDAI 13 ;MAKE TRMPOS LESS THAN LINE LENGTH.
|
|
STA TRMPOS>
|
|
IFN EXTIO,<
|
|
IFN REALIO-3,<
|
|
LDA CHANNL
|
|
BNE GOCR
|
|
STA TRMPOS>
|
|
GOCR: LDAI 13> ;X AND Y MUST BE PRESERVED.
|
|
JSR OUTDO
|
|
LDAI 10
|
|
JSR OUTDO
|
|
CRFIN:
|
|
IFN EXTIO,<
|
|
IFN REALIO-3,<
|
|
LDA CHANNL
|
|
BNE PRTRTS>>
|
|
IFE NULCMD,<
|
|
IFN REALIO-3,<
|
|
LDAI 0
|
|
STA TRMPOS>
|
|
EORI 255>
|
|
IFN NULCMD,<
|
|
TXA ;PRESERVE [ACCX]. SOME NEED IT.
|
|
PHA
|
|
LDX NULCNT ;GET NUMBER OF NULLS.
|
|
BEQ CLRPOS
|
|
LDAI 0
|
|
PRTNUL: JSR OUTDO
|
|
DEX ;DONE WITH NULLS?
|
|
BNE PRTNUL
|
|
CLRPOS: STX TRMPOS
|
|
PLA
|
|
TAX>
|
|
PRTRTS: RTS
|
|
|
|
COMPRT: LDA TRMPOS
|
|
NCMPOS==<<<LINLEN/CLMWID>-1>*CLMWID> ;CLMWID BEYOND WHICH THERE ARE
|
|
IFN REALIO-3,<
|
|
;NO MORE COMMA FIELDS.
|
|
CMP NCMWID ;SO ALL COMMA DOES IS "CRDO".
|
|
|
|
BCC MORCOM
|
|
JSR CRDO ;TYPE CRLF.
|
|
JMP NOTABR> ;AND QUIT IF BEYOND LAST FIELD.
|
|
MORCOM: SEC
|
|
MORCO1: SBCI CLMWID ;GET [A] MODULUS CLMWID.
|
|
BCS MORCO1
|
|
EORI 255 ;FILL PRINT POS OUT TO EVEN CLMWID SO
|
|
ADCI 1
|
|
BNE ASPAC ;PRINT [A] SPACES.
|
|
|
|
TABER: PHP ;REMEMBER IF SPC OR TAB FUNCTION.
|
|
JSR GTBYTC ;GET VALUE INTO ACCX.
|
|
CMPI 41
|
|
BNE SNERR4
|
|
PLP
|
|
BCC XSPAC ;PRINT [X] SPACES.
|
|
TXA
|
|
SBC TRMPOS
|
|
BCC NOTABR ;NEGATIVE, DON'T PRINT ANY.
|
|
ASPAC: TAX
|
|
XSPAC: INX
|
|
XSPAC2: DEX ;DECREMENT THE COUNT.
|
|
BNE XSPAC1
|
|
NOTABR: JSR CHRGET ;REGET LAST CHARACTER.
|
|
JMP PRINTC ;DON'T CALL CRDO.
|
|
XSPAC1: JSR OUTSPC
|
|
BNEA XSPAC2
|
|
;
|
|
; PRINT THE STRING POINTED TO BY [Y,A] WHICH ENDS WITH A ZERO.
|
|
; IF THE STRING IS BELOW DSCTMP IT WILL BE COPIED INTO STRING SPACE.
|
|
;
|
|
STROUT: JSR STRLIT ;GET A STRING LITERAL.
|
|
;
|
|
; PRINT THE STRING WHOSE DESCRIPTOR IS POINTED TO BY FACMO.
|
|
;
|
|
STRPRT: JSR FREFAC ;RETURN TEMP POINTER.
|
|
TAX ;PUT COUNT INTO COUNTER.
|
|
LDYI 0
|
|
INX ;MOVE ONE AHEAD.
|
|
STRPR2: DEX
|
|
BEQ PRTRTS ;ALL DONE.
|
|
LDADY INDEX ;PNTR TO ACT STRNG SET BY FREFAC.
|
|
JSR OUTDO
|
|
INY
|
|
CMPI 13
|
|
BNE STRPR2
|
|
JSR CRFIN ;TYPE REST OF CARRIAGE RETURN.
|
|
JMP STRPR2 ;AND ON AND ON.
|
|
;
|
|
; OUTDO OUTPUTS THE CHARACTER IN ACCA, USING CNTWFL
|
|
; (SUPPRESS OR NOT), TRMPOS (PRINT HEAD POSITION),
|
|
; TIMING, ETCQ. NO REGISTERS ARE CHANGED.
|
|
;
|
|
OUTSPC:
|
|
IFN REALIO-3,<
|
|
LDAI " ">
|
|
IFE REALIO-3,<
|
|
LDA CHANNL
|
|
BEQ CRTSKP
|
|
LDAI " "
|
|
SKIP2
|
|
CRTSKP: LDAI 29> ;COMMODORE'S SKIP CHARACTER.
|
|
SKIP2
|
|
OUTQST: LDAI "?"
|
|
OUTDO: IFN REALIO,<
|
|
BIT CNTWFL ;SHOULDN'T AFFECT CHANNEL I/O!
|
|
BMI OUTRTS>
|
|
IFN REALIO-3,<
|
|
PHA
|
|
CMPI 32 ;IS THIS A PRINTING CHAR?
|
|
BCC TRYOUT ;NO, DON'T INCLUDE IT IN TRMPOS.
|
|
LDA TRMPOS
|
|
CMP LINWID ;LENGTH = TERMINAL WIDTH?
|
|
BNE OUTDO1
|
|
JSR CRDO ;YES, TYPE CRLF
|
|
OUTDO1:
|
|
IFN EXTIO,<
|
|
LDA CHANNL
|
|
BNE TRYOUT>
|
|
INCTRM: INC TRMPOS ;INCREMENT COUNT.
|
|
TRYOUT: PLA> ;RESTORE THE A REGISTER
|
|
|
|
IFE REALIO-1,<
|
|
STY KIMY> ;PRESERVE Y.
|
|
IFE REALIO-4,<ORAI ^O200> ;TURN ON B7 FOR APPLE.
|
|
IFN REALIO,<
|
|
OUTLOC: JSR OUTCH> ;OUTPUT THE CHARACTER.
|
|
IFE REALIO-1,<
|
|
LDY KIMY> ;GET Y BACK.
|
|
IFE REALIO-2,<REPEAT 4,<NOP>>
|
|
IFE REALIO-4,<ANDI ^O177> ;GET [A] BACK FROM APPLE.
|
|
|
|
IFE REALIO,<
|
|
TJSR OUTSIM##> ;CALL SIMULATOR OUTPUT ROUTINE
|
|
OUTRTS: ANDI 255 ;SET Z=0.
|
|
GETRTS: RTS
|
|
|
|
PAGE
|
|
SUBTTL INPUT AND READ CODE.
|
|
;
|
|
; HERE WHEN THE DATA THAT WAS TYPED IN OR IN "DATA" STATEMENTS
|
|
; IS IMPROPERLY FORMATTED. FOR "INPUT" WE START AGAIN.
|
|
; FOR "READ" WE GIVE A SYNTAX ERROR AT THE DATA LINE.
|
|
;
|
|
TRMNOK: LDA INPFLG
|
|
BEQ TRMNO1 ;IF INPUT TRY AGAIN.
|
|
IFN GETCMD,<
|
|
BMI GETDTL
|
|
LDYI 255 ;MAKE IT LOOK DIRECT.
|
|
BNEA STCURL ;ALWAYS GOES.
|
|
GETDTL:>
|
|
LDWD DATLIN ;GET DATA LINE NUMBER.
|
|
STCURL: STWD CURLIN ;MAKE IT CURRENT LINE.
|
|
SNERR4: JMP SNERR
|
|
TRMNO1:
|
|
IFN EXTIO,<
|
|
LDA CHANNL ;IF NOT TERMINAL, GIVE BAD DATA.
|
|
BEQ DOAGIN
|
|
LDXI ERRBD
|
|
JMP ERROR>
|
|
DOAGIN: LDWDI TRYAGN
|
|
JSR STROUT ;PRINT "?REDO FROM START".
|
|
LDWD OLDTXT ;POINT AT START
|
|
STWD TXTPTR ;OF THIS CURRENT LINE.
|
|
RTS ;GO TO "NEWSTT".
|
|
IFN GETCMD,<
|
|
GET: JSR ERRDIR ;DIRECT IS NOT OK.
|
|
IFN EXTIO,<
|
|
CMPI "#" ;SEE IF "GET#".
|
|
BNE GETTTY ;NO, JUST GET TTY INPUT.
|
|
JSR CHRGET ;MOVE UP TO NEXT BYTE.
|
|
JSR GETBYT ;GET CHANNEL INTO X
|
|
SYNCHK 44 ;COMMA?
|
|
JSR CQOIN ;GET CHANNEL OPEN FOR INPUT.
|
|
STX CHANNL>
|
|
GETTTY: LDXYI BUF+1 ;POINT TO 0.
|
|
IFN BUFPAG,<
|
|
LDAI 0 ;TO STUFF AND TO POINT.
|
|
STA BUF+1>
|
|
IFE BUFPAG,<
|
|
STY BUF+1> ;ZERO IT.
|
|
LDAI 64 ;TURN ON V-BIT.
|
|
JSR INPCO1 ;DO THE GET.
|
|
IFN EXTIO,<
|
|
LDX CHANNL
|
|
BNE IORELE> ;RELEASE.
|
|
RTS>
|
|
|
|
IFN EXTIO,<
|
|
INPUTN: JSR GETBYT ;GET CHANNEL NUMBER.
|
|
SYNCHK 44 ;A COMMA?
|
|
JSR CQOIN ;GO WHERE COMMODORE CHECKS IN OPEN.
|
|
STX CHANNL
|
|
JSR NOTQTI ;DO INPUT TO VARIABLES.
|
|
IODONE: LDA CHANNL ;RELEASE CHANNEL.
|
|
IORELE: JSR CQCCHN
|
|
LDXI 0 ;RESET CHANNEL TO TERMINAL.
|
|
STX CHANNL
|
|
RTS>
|
|
INPUT: IFN REALIO,<
|
|
LSR CNTWFL> ;BE TALKATIVE.
|
|
CMPI 34 ;A QUOTE?
|
|
BNE NOTQTI ;NO MESSAGE.
|
|
JSR STRTXT ;LITERALIZE THE STRING IN TEXT
|
|
SYNCHK 59 ;MUST END WITH SEMICOLON.
|
|
JSR STRPRT ;PRINT IT OUT.
|
|
NOTQTI: JSR ERRDIR ;USE COMMON ROUTINE SINCE DEF DIRECT
|
|
LDAI 44 ;GET COMMA.
|
|
STA BUF-1
|
|
;IS ALSO ILLEGAL.
|
|
GETAGN: JSR QINLIN ;TYPE "?" AND INPUT A LINE OF TEXT.
|
|
IFN EXTIO,<
|
|
LDA CHANNL
|
|
BEQ BUFFUL
|
|
LDA CQSTAT ;GET STATUS BYTE.
|
|
ANDI 2
|
|
BEQ BUFFUL ;A-OK.
|
|
JSR IODONE ;BAD. CLOSE CHANNEL.
|
|
JMP DATA ;SKIP REST OF INPUT.
|
|
BUFFUL:>
|
|
LDA BUF ;ANYTHING INPUT?
|
|
BNE INPCON ;YES, CONTINUE.
|
|
IFN EXTIO,<
|
|
LDA CHANNL ;BLANK LINE MEANS GET ANOTHER.
|
|
BNE GETAGN> ;IF NOT TERMINAL.
|
|
CLC ;MAKE SURE DONT PRINT BREAK
|
|
JMP STPEND ;NO, STOP.
|
|
QINLIN:
|
|
IFN EXTIO,<
|
|
LDA CHANNL
|
|
BNE GINLIN>
|
|
JSR OUTQST
|
|
JSR OUTSPC
|
|
GINLIN: JMP INLIN
|
|
READ: LDXY DATPTR ;GET LAST DATA LOCATION.
|
|
XWD ^O1000,^O251 ;LDAI TYA TO MAKE IT NONZERO.
|
|
IFE BUFPAG,<
|
|
INPCON: >
|
|
TYA
|
|
IFN BUFPAG,<
|
|
SKIP2
|
|
INPCON: LDAI 0> ;SET FLAG THAT THIS IS INPUT
|
|
INPCO1: STA INPFLG ;STORE THE FLAG.
|
|
;
|
|
; IN THE PROCESSING OF DATA AND READ STATEMENTS:
|
|
; ONE POINTER POINTS TO THE DATA (IE, THE NUMBERS BEING FETCHED)
|
|
; AND ANOTHER POINTS TO THE LIST OF VARIABLES.
|
|
;
|
|
; THE POINTER INTO THE DATA ALWAYS STARTS POINTING TO A
|
|
; TERMINATOR -- A , : OR END-OF-LINE.
|
|
;
|
|
; AT THIS POINT TXTPTR POINTS TO LIST OF VARIABLES AND
|
|
; [Y,X] POINTS TO DATA OR INPUT LINE.
|
|
;
|
|
STXY INPPTR
|
|
INLOOP: JSR PTRGET ;READ VARIABLE LIST.
|
|
STWD FORPNT ;SAVE POINTER FOR "LET" STRING STUFFING.
|
|
;RETURNS PNTR TOP VAR IN VARPNT.
|
|
LDWD TXTPTR ;SAVE TEXT PNTR.
|
|
STWD VARTXT
|
|
LDXY INPPTR
|
|
STXY TXTPTR
|
|
JSR CHRGOT ;GET IT AND SET Z IF TERM.
|
|
BNE DATBK1
|
|
BIT INPFLG
|
|
IFN GETCMD,<
|
|
BVC QDATA
|
|
JSR CZGETL ;DON'T WANT INCHR. JUST ONE.
|
|
IFE REALIO-4,<
|
|
ANDI 127>
|
|
STA BUF ;MAKE IT FIRST CHARACTER.
|
|
LDXYI <BUF-1> ;POINT JUST BEFORE IT.
|
|
IFE BUFPAG,<
|
|
BEQA DATBK>
|
|
IFN BUFPAG,<
|
|
BNEA DATBK>> ;GO PROCESS.
|
|
QDATA: BMI DATLOP ;SEARCH FOR ANOTHER DATA STATEMENT.
|
|
IFN EXTIO,<
|
|
LDA CHANNL
|
|
BNE GETNTH>
|
|
JSR OUTQST
|
|
GETNTH: JSR QINLIN ;GET ANOTHER LINE.
|
|
DATBK: STXY TXTPTR ;SET FOR "CHRGET".
|
|
DATBK1: JSR CHRGET
|
|
BIT VALTYP ;GET VALUE TYPE.
|
|
BPL NUMINS ;INPUT A NUMBER IF NUMERIC.
|
|
IFN GETCMD,<
|
|
BIT INPFLG ;GET?
|
|
BVC SETQUT ;NO, GO SET QUOTE.
|
|
INX
|
|
STX TXTPTR
|
|
LDAI 0 ;ZERO TERMINATORS.
|
|
STA CHARAC
|
|
BEQA RESETC>
|
|
SETQUT: STA CHARAC ;ASSUME QUOTED STRING.
|
|
CMPI 34 ;TERMINATORS OK?
|
|
BEQ NOWGET ;YES.
|
|
LDAI ":" ;SET TERMINATORS TO ":" AND
|
|
STA CHARAC
|
|
LDAI 44 ;COMMA.
|
|
RESETC: CLC
|
|
NOWGET: STA ENDCHR
|
|
LDWD TXTPTR
|
|
ADCI 0 ;C IS SET PROPERLY ABOVE.
|
|
BCC NOWGE1
|
|
INY
|
|
NOWGE1: JSR STRLT2 ;MAKE A STRING DESCRIPTOR FOR THE VALUE
|
|
;AND COPY IF NECESSARY.
|
|
JSR ST2TXT ;SET TEXT POINTER.
|
|
JSR INPCOM ;DO ASSIGNMENT.
|
|
JMP STRDN2
|
|
NUMINS: JSR FIN
|
|
IFE INTPRC,<
|
|
JSR MOVVF>
|
|
IFN INTPRC,<
|
|
LDA INTFLG ;SET CODES ON FLAG.
|
|
JSR QINTGR> ;GO DECIDE ON FLOAT.
|
|
STRDN2: JSR CHRGOT ;READ LAST CHARACTER.
|
|
BEQ TRMOK ;":" OR EOL IS OK.
|
|
CMPI 44 ;A COMMA?
|
|
JNE TRMNOK
|
|
TRMOK: LDWD TXTPTR
|
|
STWD INPPTR ;SAVE FOR MORE READS.
|
|
LDWD VARTXT
|
|
STWD TXTPTR ;POINT TO VARIABLE LIST.
|
|
JSR CHRGOT ;LOOK AT LAST VARIABLE LIST CHARACTER.
|
|
BEQ VAREND ;THAT'S THE END OF THE LIST.
|
|
JSR CHKCOM ;NOT END. CHECK FOR COMMA.
|
|
JMP INLOOP
|
|
;
|
|
; SUBROUTINE TO FIND DATA
|
|
; THE SEARCH IS MADE BY USING THE EXECUTION CODE FOR DATA TO
|
|
; SKIP OVER STATEMENTS. THE START WORD OF EACH STATEMENT
|
|
; IS COMPARED WITH "DATATK". EACH NEW LINE NUMBER
|
|
; IS STORED IN "DATLIN" SO THAT IF AN ERROR OCCURS
|
|
; WHILE READING DATA THE ERROR MESSAGE CAN GIVE THE LINE
|
|
; NUMBER OF THE ILL-FORMATTED DATA.
|
|
;
|
|
DATLOP: JSR DATAN ;SKIP SOME TEXT.
|
|
INY
|
|
TAX ;END OF LINE?
|
|
BNE NOWLIN ;SHO AIN'T.
|
|
LDXI ERROD ;YES = "NO DATA" ERROR.
|
|
INY
|
|
LDADY TXTPTR
|
|
BEQ ERRGO5
|
|
INY
|
|
LDADY TXTPTR ;GET HIGH BYTE OF LINE NUMBER.
|
|
STA DATLIN
|
|
INY
|
|
LDADY TXTPTR ;GET LOW BYTE.
|
|
INY
|
|
STA DATLIN+1
|
|
NOWLIN: LDADY TXTPTR ;HOW IS IT?
|
|
TAX
|
|
JSR ADDON ;ADD [Y] TO [TXTPTR].
|
|
CPXI DATATK ;IS IT A "DATA" STATEMENT.
|
|
BNE DATLOP ;NOT QUITE RIGHT. KEEP LOOKING.
|
|
JMP DATBK1 ;THIS IS THE ONE !
|
|
VAREND: LDWD INPPTR ;PUT AWAY A NEW DATA PNTR MAYBE.
|
|
LDX INPFLG
|
|
BPL VARY0
|
|
JMP RESFIN
|
|
VARY0: LDYI 0
|
|
LDADY INPPTR ;LAST DATA CHR COULD HAVE BEEN
|
|
;COMMA OR COLON BUT SHOULD BE NULL.
|
|
BEQ INPRTS ;IT IS NULL.
|
|
IFN EXTIO,<
|
|
LDA CHANNL ;IF NOT TERMINAL, NO TYPE.
|
|
BNE INPRTS>
|
|
LDWDI EXIGNT
|
|
JMP STROUT ;TYPE "?EXTRA IGNORED"
|
|
INPRTS: RTS ;DO NEXT STATEMENT.
|
|
EXIGNT: DT"?EXTRA IGNORED"
|
|
ACRLF
|
|
0
|
|
TRYAGN: DT"?REDO FROM START"
|
|
ACRLF
|
|
0
|
|
PAGE
|
|
SUBTTL THE NEXT CODE IS THE "NEXT CODE"
|
|
;
|
|
; A "FOR" ENTRY ON THE STACK HAS THE FOLLOWING FORMAT:
|
|
;
|
|
; LOW ADDRESS
|
|
; TOKEN (FORTK) 1 BYTE
|
|
; A POINTER TO THE LOOP VARIABLE 2 BYTES
|
|
; THE STEP 4+ADDPRC BYTES
|
|
; A BYTE REFLECTING THE SIGN OF THE INCREMENT 1 BYTE
|
|
; THE UPPER VALUE (PACKED) 4+ADDPRC BYTES
|
|
; THE LINE NUMBER OF THE "FOR" STATEMENT 2 BYTES
|
|
; A TEXT POINTER INTO THE "FOR" STATEMENT 2 BYTES
|
|
; HIGH ADDRESS
|
|
;
|
|
; TOTAL 16+2*ADDPRC BYTES.
|
|
;
|
|
NEXT: BNE GETFOR
|
|
LDYI 0 ;WITHOUT ARG CALL "FNDFOR" WITH
|
|
BEQA STXFOR ;[FORPNT]=0.
|
|
GETFOR: JSR PTRGET ;GET A POINTER TO LOOP VARIABLE
|
|
STXFOR: STWD FORPNT ;INTO "FORPNT".
|
|
JSR FNDFOR ;FIND THE MATCHING ENTRY IF ANY.
|
|
BEQ HAVFOR
|
|
LDXI ERRNF ;"NEXT WITHOUT FOR".
|
|
ERRGO5: BEQ ERRGO4
|
|
HAVFOR: TXS ;SETUP STACK. CHOP FIRST.
|
|
TXA
|
|
CLC
|
|
ADCI 4 ;POINT TO INCREMENT
|
|
PHA ;SAVE THIS POINTER TO RESTORE TO [A]
|
|
ADCI 5+ADDPRC ;POINT TO UPPER LIMIT
|
|
STA INDEX2 ;SAVE AS INDEX
|
|
PLA ;RESTORE POINTER TO INCREMENT
|
|
LDYI 1 ;SET HI ADDR OF THING TO MOVE.
|
|
JSR MOVFM ;GET QUANTITY INTO THE FAC.
|
|
TSX
|
|
LDA 257+7+ADDPRC,X, ;SET SIGN CORRECTLY.
|
|
STA FACSGN
|
|
LDWD FORPNT
|
|
JSR FADD ;ADD INC TO LOOP VARIABLE.
|
|
JSR MOVVF ;PACK THE FAC INTO MEMORY.
|
|
LDYI 1
|
|
JSR FCOMPN ;COMPARE FAC WITH UPPER VALUE.
|
|
TSX
|
|
SEC
|
|
SBC 257+7+ADDPRC,X, ;SUBTRACT SIGN OF INC FROM SIGN OF
|
|
;OF (CURRENT VALUE-FINAL VALUE).
|
|
BEQ LOOPDN ;IF SIGN (FINAL-CURRENT)-SIGN STEP=0
|
|
;THEN LOOP IS DONE.
|
|
LDA 2*ADDPRC+12+257,X
|
|
STA CURLIN ;STORE LINE NUMBER OF "FOR" STATEMENT.
|
|
LDA 257+13+<2*ADDPRC>,X
|
|
STA CURLIN+1
|
|
LDA 2*ADDPRC+15+257,X
|
|
STA TXTPTR ;STORE TEXT PNTR INTO "FOR" STATEMENT.
|
|
LDA 2*ADDPRC+14+257,X
|
|
STA TXTPTR+1
|
|
NEWSGO: JMP NEWSTT ;PROCESS NEXT STATEMENT.
|
|
LOOPDN: TXA
|
|
ADCI 2*ADDPRC+15 ;ADDS 16 WITH CARRY.
|
|
TAX
|
|
TXS ;NEW STACK PNTR.
|
|
JSR CHRGOT
|
|
CMPI 44 ;COMMA AT END?
|
|
BNE NEWSGO
|
|
JSR CHRGET
|
|
JSR GETFOR ;DO NEXT BUT DON'T ALLOW BLANK VARIABLE
|
|
;PNTR. [VARPNT] IS THE STK PNTR WHICH
|
|
;NEVER MATCHES ANY POINTER.
|
|
;JSR TO PUT ON DUMMY NEWSTT ADDR.
|
|
SUBTTL FORMULA EVALUATION CODE.
|
|
;
|
|
; THESE ROUTINES CHECK FOR CERTAIN "VALTYP".
|
|
; [C] IS NOT PRESERVED.
|
|
;
|
|
FRMNUM: JSR FRMEVL
|
|
CHKNUM: CLC
|
|
SKIP1
|
|
CHKSTR: SEC ;SET CARRY.
|
|
CHKVAL: BIT VALTYP ;WILL NOT F UP "VALTYP".
|
|
BMI DOCSTR
|
|
BCS CHKERR
|
|
CHKOK: RTS
|
|
DOCSTR: BCS CHKOK
|
|
CHKERR: LDXI ERRTM
|
|
ERRGO4: JMP ERROR
|
|
;
|
|
; THE FORMULA EVALUATOR STARTS WITH
|
|
; [TXTPTR] POINTING TO THE FIRST CHARACTER OF THE FORMULA.
|
|
; AT THE END [TXTPTR] POINTS TO THE TERMINATOR.
|
|
; THE RESULT IS LEFT IN THE FAC.
|
|
; ON RETURN [A] DOES NOT REFLECT THE TERMINATOR.
|
|
;
|
|
; THE FORMULA EVALUATOR USES THE OPERATOR LIST (OPTAB)
|
|
; TO DETERMINE PRECEDENCE AND DISPATCH ADDRESSES FOR
|
|
; EACH OPERATOR.
|
|
; A TEMPORARY RESULT ON THE STACK HAS THE FOLLOWING FORMAT.
|
|
; THE ADDRESS OF THE OPERATOR ROUTINE.
|
|
; THE FLOATING POINT TEMPORARY RESULT.
|
|
; THE PRECEDENCE OF THE OPERATOR.
|
|
;
|
|
FRMEVL: LDX TXTPTR
|
|
BNE FRMEV1
|
|
DEC TXTPTR+1
|
|
FRMEV1: DEC TXTPTR
|
|
LDXI 0 ;INITIAL DUMMY PRECEDENCE IS 0.
|
|
SKIP1
|
|
LPOPER: PHA ;SAVE LOW PRECEDENCE. (MASK.)
|
|
TXA
|
|
PHA ;SAVE HIGH PRECEDENCE.
|
|
LDAI 1
|
|
JSR GETSTK ;MAKE SURE THERE IS ROOM FOR
|
|
;RECURSIVE CALLS.
|
|
JSR EVAL ;EVALUATE SOMETHING.
|
|
CLR OPMASK ;PREPARE TO BUILD MASK MAYBE.
|
|
TSTOP: JSR CHRGOT ;REGET LAST CHARACTER.
|
|
LOPREL: SEC ;PREP TO SUBTRACT.
|
|
SBCI GREATK ;IS CURRENT CHARACTER A RELATION?
|
|
BCC ENDREL ;NO. RELATIONS ALL THROUGH.
|
|
CMPI LESSTK-GREATK+1 ;REALLY RELATIONAL?
|
|
BCS ENDREL ;NO -- JUST BIG.
|
|
CMPI 1 ;RESET CARRY FOR ZERO ONLY.
|
|
ROL A, ;0 TO 1, 1 TO 2, 2 TO 4.
|
|
EORI 1
|
|
EOR OPMASK ;BRING IN THE OLD BITS.
|
|
CMP OPMASK ;MAKE SURE THE NEW MASK IS BIGGER.
|
|
BCC SNERR5 ;SYNTAX ERROR. BECAUSE TWO OF THE SAME.
|
|
STA OPMASK ;SAVE MASK.
|
|
JSR CHRGET
|
|
JMP LOPREL ;GET THE NEXT CANDIDATE.
|
|
ENDREL: LDX OPMASK ;WERE THERE ANY?
|
|
BNE FINREL ;YES, HANDLE AS SPECIAL OP.
|
|
BCS QOP ;NOT AN OPERATOR.
|
|
ADCI GREATK-PLUSTK
|
|
BCC QOP ;NOT AN OPERATOR.
|
|
ADC VALTYP ;[C]=1.
|
|
JEQ CAT ;ONLY IF [A]=0 AND [VALTYP]=-1 (A STR).
|
|
ADCI ^O377 ;GET BACK ORIGINAL [A].
|
|
STA INDEX1
|
|
ASL A, ;MULTIPLY BY 2.
|
|
ADC INDEX1 ;BY THREE.
|
|
TAY ;SET UP FOR LATER.
|
|
QPREC: PLA ;GET PREVIOUS PRECEDENCE.
|
|
CMP OPTAB,Y ;IS OLD PRECEDENCE GREATER OR EQUAL?
|
|
BCS QCHNUM ;YES, GO OPERATE.
|
|
JSR CHKNUM ;CAN'T BE STRING HERE.
|
|
DOPREC: PHA ;SAVE OLD PRECEDENCE.
|
|
NEGPRC: JSR DOPRE1 ;SET A RETURN ADDRESS FOR OP.
|
|
PLA ;PULL OFF PREVIOUS PRECEDENCE.
|
|
LDY OPPTR ;GET POINTER TO OP.
|
|
BPL QPREC1 ;THAT'S A REAL OPERATOR.
|
|
TAX ;DONE ?
|
|
BEQ QOPGO ;DONE !
|
|
BNE PULSTK
|
|
FINREL: LSR VALTYP ;GET VALUE TYPE INTO "C".
|
|
TXA
|
|
ROL A, ;PUT VALTYP INTO LOW ORDER BIT OF MASK.
|
|
LDX TXTPTR ;DECREMENT TEXT POINTER.
|
|
BNE FINRE2
|
|
DEC TXTPTR+1
|
|
FINRE2: DEC TXTPTR
|
|
LDYI PTDORL-OPTAB ;MAKE [YREG] POINT AT OPERATOR ENTRY.
|
|
STA OPMASK ;SAVE THE OPERATION MASK.
|
|
BNE QPREC ;SAVE IT ALL. BR ALWAYS.
|
|
;NOTE B7(VALTYP)=0 SO CHKNUM CALL IS OK.
|
|
QPREC1: CMP OPTAB,Y ;LAST PRECEDENCE IS GREATER?
|
|
BCS PULSTK ;YES, GO OPERATE.
|
|
BCC DOPREC ;NO SAVE ARGUMENT AND GET OTHER OPERAND.
|
|
DOPRE1: LDA OPTAB+2,Y
|
|
PHA ;DISP ADDR GOES ONTO STACK.
|
|
LDA OPTAB+1,Y
|
|
PHA
|
|
JSR PUSHF1 ;SAVE FAC ON STACK UNPACKED.
|
|
LDA OPMASK ;[ACCA] MAY BE MASK FOR REL.
|
|
JMP LPOPER
|
|
SNERR5: JMP SNERR ;GO TO AN ERROR.
|
|
PUSHF1: LDA FACSGN
|
|
LDX OPTAB,Y, ;GET HIGH PRECEDENCE.
|
|
PUSHF: TAY ;GET POINTER INTO STACK.
|
|
PLA
|
|
STA INDEX1
|
|
INC INDEX1
|
|
PLA
|
|
STA INDEX1+1
|
|
TYA
|
|
;STORE FAC ON STACK UNPACKED.
|
|
PHA ;START WITH SIGN SET UP.
|
|
FORPSH: JSR ROUND ;PUT ROUNDED FAC ON STACK.
|
|
LDA FACLO ;ENTRY POINT TO SKIP STORING SIGN.
|
|
PHA
|
|
LDA FACMO
|
|
PHA
|
|
IFN ADDPRC,<
|
|
LDA FACMOH
|
|
PHA>
|
|
LDA FACHO
|
|
PHA
|
|
LDA FACEXP
|
|
PHA
|
|
JMPD INDEX1 ;RETURN.
|
|
QOP: LDYI 255
|
|
PLA ;GET HIGH PRECEDENCE OF LAST OP.
|
|
QOPGO: BEQ QOPRTS ;DONE !
|
|
QCHNUM: CMPI 100 ;RELATIONAL OPERATOR?
|
|
BEQ UNPSTK ;YES, DON'T CHECK OPERAND.
|
|
JSR CHKNUM ;MUST BE NUMBER.
|
|
UNPSTK: STY OPPTR ;SAVE OPERATOR'S POINTER FOR NEXT TIME.
|
|
PULSTK: PLA ;GET MASK FOR REL OP IF IT IS ONE.
|
|
LSR A, ;SETUP [C] FOR DOREL'S "CHKVAL".
|
|
STA DOMASK ;SAVE FOR "DOCMP".
|
|
PLA ;UNPACK STACK INTO ARG.
|
|
STA ARGEXP
|
|
PLA
|
|
STA ARGHO
|
|
IFN ADDPRC,<
|
|
PLA
|
|
STA ARGMOH>
|
|
PLA
|
|
STA ARGMO
|
|
PLA
|
|
STA ARGLO
|
|
PLA
|
|
STA ARGSGN
|
|
EOR FACSGN ;GET PROBABLE RESULT SIGN.
|
|
STA ARISGN ;ARITHMETIC SIGN. USED BY
|
|
;ADD, SUB, MULT, DIV.
|
|
QOPRTS: LDA FACEXP ;GET IT AND SET CODES.
|
|
UNPRTS: RTS ;RETURN.
|
|
|
|
EVAL: CLR VALTYP ;ASSUME VALUE WILL BE NUMERIC.
|
|
EVAL0: JSR CHRGET ;GET A CHARACTER.
|
|
BCS EVAL2
|
|
EVAL1: JMP FIN ;IT IS A NUMBER.
|
|
EVAL2: JSR ISLETC ;VARIABLE NAME?
|
|
BCS ISVAR ;YES.
|
|
IFE REALIO-3,<
|
|
CMPI PI
|
|
BNE QDOT
|
|
LDWDI PIVAL
|
|
JSR MOVFM ;PUT VALUE IN FOR PI.
|
|
JMP CHRGET
|
|
PIVAL: ^O202
|
|
^O111
|
|
^O017
|
|
^O332
|
|
^O241>
|
|
QDOT: CMPI "." ;LEADING CHARACTER OF CONSTANT?
|
|
BEQ EVAL1
|
|
CMPI MINUTK ;NEGATION?
|
|
BEQ DOMIN ;SHO IS.
|
|
CMPI PLUSTK
|
|
BEQ EVAL0
|
|
CMPI 34 ;A QUOTE? A STRING?
|
|
BNE EVAL3
|
|
STRTXT: LDWD TXTPTR
|
|
ADCI 0 ;TO INC, ADD C=1.
|
|
BCC STRTX2
|
|
INY
|
|
STRTX2: JSR STRLIT ;YES. GO PROCESS IT.
|
|
JMP ST2TXT
|
|
EVAL3: CMPI NOTTK ;CHECK FOR "NOT" OPERATOR.
|
|
BNE EVAL4
|
|
LDYI NOTTAB-OPTAB ;"NOT" HAS PRECEDENCE 90.
|
|
BNE GONPRC ;GO DO ITS EVALUATION.
|
|
NOTOP: JSR AYINT ;INTEGERIZE.
|
|
LDA FACLO ;GET THE ARGUMENT.
|
|
EORI 255
|
|
TAY
|
|
LDA FACMO
|
|
EORI 255
|
|
JMP GIVAYF ;FLOAT [Y,A] AS RESULT IN FAC.
|
|
;AND RETURN.
|
|
EVAL4: CMPI FNTK ;USER-DEFINED FUNCTION?
|
|
JEQ FNDOER
|
|
CMPI ONEFUN ;A FUNCTION NAME?
|
|
BCC PARCHK ;FUNCTIONS ARE THE HIGHEST NUMBERED
|
|
JMP ISFUN ;CHARACTERS SO NO NEED TO CHECK
|
|
;AN UPPER-BOUND.
|
|
PARCHK: JSR CHKOPN ;ONLY POSSIBILITY LEFT IS
|
|
JSR FRMEVL ;A FORMULA IN PARENTHESIS.
|
|
;RECURSIVELY EVALUATE THE FORMULA.
|
|
CHKCLS: LDAI 41 ;CHECK FOR A RIGHT PARENTHESE
|
|
SKIP2
|
|
CHKOPN: LDAI 40
|
|
SKIP2
|
|
CHKCOM: LDAI 44
|
|
;
|
|
; "SYNCHK" LOOKS AT THE CURRENT CHARACTER TO MAKE SURE IT
|
|
; IS THE SPECIFIC THING LOADED INTO ACCA JUST BEFORE THE CALL TO
|
|
; "SYNCHK". IF NOT, IT CALLS THE "SYNTAX ERROR" ROUTINE.
|
|
; OTHERWISE IT GOBBLES THE NEXT CHAR AND RETURNS,
|
|
;
|
|
; [A]=NEW CHAR AND TXTPTR IS ADVANCED BY "CHRGET".
|
|
;
|
|
SYNCHR: LDYI 0
|
|
CMPDY TXTPTR ;CHARACTERS EQUAL?
|
|
BNE SNERR
|
|
CHRGO5: JMP CHRGET
|
|
SNERR: LDXI ERRSN ;"SYNTAX ERROR"
|
|
JMP ERROR
|
|
DOMIN: LDYI NEGTAB-OPTAB ;A PRECEDENCE BELOW "^".
|
|
GONPRC: PLA ;GET RID OF RTS ADDR.
|
|
PLA
|
|
JMP NEGPRC ;EVALUTE FOR NEGATION.
|
|
|
|
ISVAR: JSR PTRGET ;GET A PNTR TO VARIABLE.
|
|
ISVRET: STWD FACMO
|
|
IFN TIME!EXTIO,<
|
|
LDWD VARNAM> ;CHECK TIME,TIME$,STATUS.
|
|
LDX VALTYP
|
|
BEQ GOOO ;THE STRING IS SET UP.
|
|
LDXI 0
|
|
STX FACOV
|
|
IFN TIME,<
|
|
BIT FACLO ;AN ARRAY?
|
|
BPL STRRTS ;YES.
|
|
CMPI "T" ;TI$?
|
|
BNE STRRTS
|
|
CPYI "I"+128
|
|
BNE STRRTS
|
|
JSR GETTIM ;YES. PUT TIME IN FACMOH-LO.
|
|
STY TENEXP ;Y=0.
|
|
DEY
|
|
STY FBUFPT
|
|
LDYI 6 ;SIX DIGITS TO PRINT.
|
|
STY DECCNT
|
|
LDYI FDCEND-FOUTBL
|
|
JSR FOUTIM ;CONVERT TO ASCII.
|
|
JMP TIMSTR>
|
|
STRRTS: RTS
|
|
GOOO:
|
|
IFN INTPRC,<
|
|
LDX INTFLG
|
|
BPL GOOOOO
|
|
LDYI 0
|
|
LDADY FACMO ;FETCH HIGH.
|
|
TAX
|
|
INY
|
|
LDADY FACMO
|
|
TAY ;PUT LOW IN Y.
|
|
TXA ;GET HIGH IN A.
|
|
JMP GIVAYF> ;FLOAT AND RETURN.
|
|
GOOOOO:
|
|
IFN TIME,<
|
|
BIT FACLO ;AN ARRAY?
|
|
BPL GOMOVF ;YES.
|
|
CMPI "T"
|
|
BNE QSTATV
|
|
CPYI "I"
|
|
BNE GOMOVF
|
|
JSR GETTIM
|
|
TYA ;FOR FLOATB.
|
|
LDXI 160 ;SET EXPONNENT.
|
|
JMP FLOATB
|
|
GETTIM: LDWDI <CQTIMR-2>
|
|
SEI ;TURN OF INT SYS.
|
|
JSR MOVFM
|
|
CLI ;BACK ON.
|
|
STY FACHO ;ZERO HIGHEST.
|
|
RTS>
|
|
QSTATV:
|
|
IFN EXTIO,<
|
|
CMPI "S"
|
|
BNE GOMOVF
|
|
CPYI "T"
|
|
BNE GOMOVF
|
|
LDA CQSTAT
|
|
JMP FLOAT
|
|
GOMOVF:>
|
|
IFN TIME!EXTIO,<
|
|
LDWD FACMO>
|
|
JMP MOVFM ;MOVE ACTUAL VALUE IN.
|
|
;AND RETURN.
|
|
|
|
ISFUN: ASL A, ;MULTIPLY BY TWO.
|
|
PHA
|
|
TAX
|
|
JSR CHRGET ;SET UP FOR SYNCHK.
|
|
CPXI 2*LASNUM-256+1 ;IS IT PAST "LASNUM"?
|
|
BCC OKNORM ;NO, MUST BE NORMAL FUNCTION.
|
|
;
|
|
; MOST FUNCTIONS TAKE A SINGLE ARGUMENT.
|
|
; THE RETURN ADDRESS OF THESE FUNCTIONS IS "CHKNUM"
|
|
; WHICH ASCERTAINS THAT [VALTYP]=0 (NUMERIC).
|
|
; NORMAL FUNCTIONS THAT RETURN STRING RESULTS
|
|
; (E.G., CHR$) MUST POP OFF THAT RETURN ADDR AND
|
|
; RETURN DIRECTLY TO "FRMEVL".
|
|
;
|
|
; THE SO-CALLED "FUNNY" FUNCTIONS CAN TAKE MORE THAN ONE ARGUMENT,
|
|
; THE FIRST OF WHICH MUST BE STRING AND THE SECOND OF WHICH
|
|
; MUST BE A NUMBER BETWEEN 0 AND 255.
|
|
; THE CLOSED PARENTHESIS MUST BE CHECKED AND RETURN IS DIRECTLY
|
|
; TO "FRMEVL" WITH THE TEXT PNTR POINTING BEYOND THE ")".
|
|
; THE POINTER TO THE DESCRIPTOR OF THE STRING ARGUMENT
|
|
; IS STORED ON THE STACK UNDERNEATH THE VALUE OF THE
|
|
; INTEGER ARGUMENT.
|
|
;
|
|
JSR CHKOPN ;CHECK FOR AN OPEN PARENTHESE
|
|
JSR FRMEVL ;EAT OPEN PAREN AND FIRST ARG.
|
|
JSR CHKCOM ;TWO ARGS SO COMMA MUST DELIMIT.
|
|
JSR CHKSTR ;MAKE SURE FIRST WAS STRING.
|
|
PLA ;GET FUNCTION NUMBER.
|
|
TAX
|
|
PSHWD FACMO ;SAVE POINTER AT STRING DESCRIPTOR
|
|
TXA
|
|
PHA ;RESAVE FUNCTION NUMBER.
|
|
;THIS MUST BE ON STACK SINCE RECURSIVE.
|
|
JSR GETBYT ;[X]=VALUE OF FORMULA.
|
|
PLA ;GET FUNCTION NUMBER.
|
|
TAY
|
|
TXA
|
|
PHA
|
|
JMP FINGO ;DISPATCH TO FUNCTION.
|
|
OKNORM: JSR PARCHK ;READ A FORMULA SURROUNDED BY PARENS.
|
|
PLA ;GET DISPATCH FUNCTION.
|
|
TAY
|
|
FINGO: LDA FUNDSP-2*ONEFUN+256,Y, ;MODIFY DISPATCH ADDRESS.
|
|
STA JMPER+1
|
|
LDA FUNDSP-2*ONEFUN+257,Y
|
|
STA JMPER+2
|
|
JSR JMPER ;DISPATCH!
|
|
;STRING FUNCTIONS REMOVE THIS RET ADDR.
|
|
JMP CHKNUM ;CHECK IT FOR NUMERICNESS AND RETURN.
|
|
|
|
OROP: LDYI 255 ;MUST ALWAYS COMPLEMENT..
|
|
SKIP2
|
|
ANDOP: LDYI 0
|
|
STY COUNT ;OPERATOR.
|
|
JSR AYINT ;[FACMO&LO]=INT VALUE AND CHECK SIZE.
|
|
LDA FACMO ;USE DEMORGAN'S LAW ON HIGH
|
|
EOR COUNT
|
|
STA INTEGR
|
|
LDA FACLO ;AND LOW.
|
|
EOR COUNT
|
|
STA INTEGR+1
|
|
JSR MOVFA
|
|
JSR AYINT ;[FACMO&LO]=INT OF ARG.
|
|
LDA FACLO
|
|
EOR COUNT
|
|
AND INTEGR+1
|
|
EOR COUNT ;FINISH OUT DEMORGAN.
|
|
TAY ;SAVE HIGH.
|
|
LDA FACMO
|
|
EOR COUNT
|
|
AND INTEGR
|
|
EOR COUNT
|
|
JMP GIVAYF ;FLOAT [A.Y] AND RET TO USER.
|
|
|
|
;
|
|
; TIME TO PERFORM A RELATIONAL OPERATOR.
|
|
; [DOMASK] CONTAINS THE BITS AS TO WHICH RELATIONAL
|
|
; OPERATOR IT WAS. CARRY BIT ON=STRING COMPARE.
|
|
;
|
|
DOREL: JSR CHKVAL ;CHECK FOR MATCH.
|
|
BCS STRCMP ;IT IS A STRING.
|
|
LDA ARGSGN ;PACK ARG FOR FCOMP.
|
|
ORAI 127
|
|
AND ARGHO
|
|
STA ARGHO
|
|
LDWDI ARGEXP
|
|
JSR FCOMP
|
|
TAX
|
|
JMP QCOMP
|
|
STRCMP: CLR VALTYP ;RESULT WILL BE NUMERIC.
|
|
DEC OPMASK ;TURN OFF VALTYP WHICH WAS STRING.
|
|
JSR FREFAC ;FREE THE FACLO STRING.
|
|
STA DSCTMP ;SAVE FOR LATER.
|
|
STXY DSCTMP+1
|
|
LDWD ARGMO ;GET POINTER TO OTHER STRING.
|
|
JSR FRETMP ;FREES FIRST DESC POINTER.
|
|
STXY ARGMO
|
|
TAX ;COPY COUNT INTO X.
|
|
SEC
|
|
SBC DSCTMP ;WHICH IS GREATER. IF 0, ALL SET UP.
|
|
BEQ STASGN ;JUST PUT SIGN OF DIFFERENCE AWAY.
|
|
LDAI 1
|
|
BCC STASGN ;SIGN IS POSITIVE.
|
|
LDX DSCTMP ;LENGTH OF FAC IS SHORTER.
|
|
LDAI ^O377 ;GET A MINUS 1 FOR NEGATIVES.
|
|
STASGN: STA FACSGN ;KEEP FOR LATER.
|
|
LDYI 255 ;SET POINTER TO FIRST STRING. (ARG.)
|
|
INX ;TO LOOP PROPERLY.
|
|
NXTCMP: INY
|
|
DEX ;ANY CHARACTERS LEFT TO COMPARE?
|
|
BNE GETCMP ;NOT DONE YET.
|
|
LDX FACSGN ;USE SIGN OF LENGTH DIFFERENCE
|
|
;SINCE ALL CHARACTERS ARE THE SAME.
|
|
QCOMP: BMI DOCMP ;C IS ALWAYS SET THEN.
|
|
CLC
|
|
BCC DOCMP ;ALWAYS BRANCH.
|
|
GETCMP: LDADY ARGMO ;GET NEXT CHAR TO COMPARE.
|
|
CMPDY DSCTMP+1 ;SAME?
|
|
BEQ NXTCMP ;YEP. TRY FURTHER.
|
|
LDXI ^O377 ;SET A POSITIVE DIFFERENCE.
|
|
BCS DOCMP ;PUT STACK BACK TOGETHER.
|
|
LDXI 1 ;SET A NEGATIVE DIFFERENCE.
|
|
DOCMP: INX ;-1 TO 1, 0 TO 2, 1 TO 4.
|
|
TXA
|
|
ROL A
|
|
AND DOMASK
|
|
BEQ GOFLOT
|
|
LDAI ^O377 ;MAP 0 TO 0. ALL OTHERS TO -1.
|
|
GOFLOT: JMP FLOAT ;FLOAT THE ONE-BYTE RESULT INTO FAC.
|
|
|
|
PAGE
|
|
SUBTTL DIMENSION AND VARIABLE SEARCHING.
|
|
;
|
|
; THE "DIM" CODE SETS [DIMFLG] AND THEN FALLS INTO THE VARIABLE SEARCH
|
|
; ROUTINE, WHICH LOOKS AT DIMFLG AT THREE DIFFERENT POINTS.
|
|
; 1) IF AN ENTRY IS FOUND, "DIMFLG" BEING ON INDICATES
|
|
; A "DOUBLY" DIMENSIONED VARIABLE.
|
|
; 2) WHEN A NEW ENTRY IS BEING BUILT "DIMFLG" BEING ON
|
|
; INDICTAES THE INDICES SHOULD BE USED FOR THE
|
|
; SIZE OF EACH INDEX. OTHERWISE THE DEFAULT OF TEN
|
|
; IS USED.
|
|
; 3) WHEN THE BUILD ENTRY CODE FINISHES, ONLY IF "DIMFLG" IS OFF
|
|
; WILL INDEXING BE DONE.
|
|
;
|
|
DIM3: JSR CHKCOM ;MUST BE A COMMA
|
|
DIM: TAX ;SET [ACCX] NONZERO.
|
|
;[ACCA] MUST BE NONZERO TO WORK RIGHT.
|
|
DIM1: JSR PTRGT1
|
|
DIMCON: JSR CHRGOT ;GET LAST CHARACTER.
|
|
BNE DIM3
|
|
RTS
|
|
;
|
|
; ROUTINE TO READ THE VARIABLE NAME AT THE CURRENT TEXT POSITION
|
|
; AND PUT A POINTER TO ITS VALUE IN VARPNT. [TXTPTR]
|
|
; POINTS TO THE TERMINATING CHARCTER.. NOT THAT EVALUATING SUBSCRIPTS
|
|
; IN A VARIABLE NAME CAN CAUSE RECURSIVE CALLS TO "PTRGET" SO AT
|
|
; THAT POINT ALL VALUES MUST BE STORED ON THE STACK.
|
|
;
|
|
PTRGET: LDXI 0 ;MAKE [ACCX]=0.
|
|
JSR CHRGOT ;RETRIEVE LAST CHARACTER.
|
|
PTRGT1: STX DIMFLG ;STORE FLAG AWAY.
|
|
PTRGT2: STA VARNAM
|
|
JSR CHRGOT ;GET CURRENT CHARACTER
|
|
;MAYBE WITH FUNCTION BIT OFF.
|
|
JSR ISLETC ;CHECK FOR LETTER.
|
|
BCS PTRGT3 ;MUST HAVE A LETTER.
|
|
INTERR: JMP SNERR
|
|
PTRGT3: LDXI 0 ;ASSUME NO SECOND CHARACTER.
|
|
STX VALTYP ;DEFAULT IS NUMERIC.
|
|
IFN INTPRC,<
|
|
STX INTFLG> ;ASSUME FLOATING.
|
|
JSR CHRGET ;GET FOLLOWING CHARACTER.
|
|
BCC ISSEC ;CARRY RESET BY CHRGET IF NUMERIC.
|
|
JSR ISLETC ;SET CARRY IF NOT ALPHABETIC.
|
|
BCC NOSEC ;ALLOW ALPHABETICS.
|
|
ISSEC: TAX ;IT IS A NUMBER -- SAVE IN ACCX.
|
|
EATEM: JSR CHRGET ;LOOK AT NEXT CHARACTER.
|
|
BCC EATEM ;SKIP NUMERICS.
|
|
JSR ISLETC
|
|
BCS EATEM ;SKIP ALPHABETICS.
|
|
NOSEC: CMPI "$" ;IS IT A STRING?
|
|
BNE NOTSTR ;IF NOT, [VALTYP]=0.
|
|
LDAI ^O377 ;SET [VALTYP]=255 (STRING !).
|
|
STA VALTYP
|
|
IFN INTPRC,<
|
|
BNEA TURNON ;ALWAYS GOES.
|
|
NOTSTR: CMPI "%" ;INTEGER VARIABLE?
|
|
BNE STRNAM ;NO.
|
|
LDA SUBFLG
|
|
BNE INTERR
|
|
LDAI 128
|
|
STA INTFLG ;SET FLAG.
|
|
ORA VARNAM ;TURN ON BOTH HIGH BITS.
|
|
STA VARNAM>
|
|
TURNON: TXA
|
|
ORAI 128 ;TURN ON MSB OF SECOND CHARACTER.
|
|
TAX
|
|
JSR CHRGET ;GET CHARACTER AFTER $.
|
|
IFE INTPRC,<
|
|
NOTSTR:>
|
|
STRNAM: STX VARNAM+1 ;STORE AWAY SECOND CHARACTER.
|
|
SEC
|
|
ORA SUBFLG ;ADD FLAG WHETHER TO ALLOW ARRAYS.
|
|
SBCI 40 ;(CHECK FOR "(") WON'T MATCH IF SUBFLG SET.
|
|
JEQ ISARY ;IT IS!
|
|
CLR SUBFLG ;ALLOW SUBSCRIPTS AGAIN.
|
|
LDA VARTAB ;PLACE TO START SEARCH.
|
|
LDX VARTAB+1
|
|
LDYI 0
|
|
STXFND: STX LOWTR+1
|
|
LOPFND: STA LOWTR
|
|
CPX ARYTAB+1 ;AT END OF TABLE YET?
|
|
BNE LOPFN
|
|
CMP ARYTAB
|
|
BEQ NOTFNS ;YES. WE COULDN'T FIND IT.
|
|
LOPFN: LDA VARNAM
|
|
CMPDY LOWTR ;COMPARE HIGH ORDERS.
|
|
BNE NOTIT ;NO COMPARISON.
|
|
LDA VARNAM+1
|
|
INY
|
|
CMPDY LOWTR ;AND THE LOW PART?
|
|
BEQ FINPTR ;THAT'S IT ! THAT'S IT !
|
|
DEY
|
|
NOTIT: CLC
|
|
LDA LOWTR
|
|
ADCI 6+ADDPRC ;MAKES NO DIF AMONG TYPES.
|
|
BCC LOPFND
|
|
INX
|
|
BNEA STXFND ;ALWAYS BRANCHES.
|
|
|
|
;
|
|
; TEST FOR A LETTER. / CARRY OFF= NOT A LETTER.
|
|
; CARRY ON= A LETTER.
|
|
;
|
|
ISLETC: CMPI "A"
|
|
BCC ISLRTS ;IF LESS THAN "A", RET.
|
|
SBCI "Z"+1
|
|
SEC
|
|
SBCI 256-"Z"-1 ;RESET CARRY IF [A] .GT. "Z".
|
|
ISLRTS: RTS ;RETURN TO CALLER.
|
|
|
|
NOTFNS: PLA ;CHECK WHO'S CALLING.
|
|
PHA ;RESTORE IT.
|
|
CMPI ISVRET-1-<ISVRET-1>/256*256 ;IS EVAL CALLING?
|
|
BNE NOTEVL ;NO, CARRY ON.
|
|
IFN REALIO-3,<
|
|
TSX
|
|
LDA 258,X
|
|
CMPI <<ISVRET-1>/256>
|
|
BNE NOTEVL>
|
|
LDZR: LDWDI ZERO ;SET UP PNTR TO SIMULATED ZERO.
|
|
RTS ;FOR STRINGS OR NUMERIC.
|
|
;AND FOR INTEGERS TOO.
|
|
NOTEVL:
|
|
IFN TIME!EXTIO,<
|
|
LDWD VARNAM>
|
|
IFN TIME,<
|
|
CMPI "T"
|
|
BNE QSTAVR
|
|
CPYI "I"+128
|
|
BEQ LDZR
|
|
CPYI "I"
|
|
BNE QSTAVR>
|
|
IFN EXTIO!TIME,<
|
|
GOBADV: JMP SNERR>
|
|
QSTAVR:
|
|
IFN EXTIO,<
|
|
CMPI "S"
|
|
BNE VAROK
|
|
CPYI "T"
|
|
BEQ GOBADV>
|
|
VAROK: LDWD ARYTAB
|
|
STWD LOWTR ;LOWEST THING TO MOVE.
|
|
LDWD STREND ;GET HIGHEST ADDR TO MOVE.
|
|
STWD HIGHTR
|
|
CLC
|
|
ADCI 6+ADDPRC
|
|
BCC NOTEVE
|
|
INY
|
|
NOTEVE: STWD HIGHDS ;PLACE TO STUFF IT.
|
|
JSR BLTU ;MOVE IT ALL.
|
|
;NOTE [Y,A] HAS [HIGHDS] FOR REASON.
|
|
LDWD HIGHDS ;AND SET UP
|
|
INY
|
|
STWD ARYTAB ;NEW START OF ARRAY TABLE.
|
|
LDYI 0 ;GET ADDR OF VARIABLE ENTRY.
|
|
LDA VARNAM
|
|
STADY LOWTR
|
|
INY
|
|
LDA VARNAM+1
|
|
STADY LOWTR ;STORE NAME OF VARIABLE.
|
|
LDAI 0
|
|
INY
|
|
STADY LOWTR
|
|
INY
|
|
STADY LOWTR
|
|
INY
|
|
STADY LOWTR
|
|
INY
|
|
STADY LOWTR ;FOURTH ZERO FOR DEF FUNC.
|
|
IFN ADDPRC,<
|
|
INY
|
|
STADY LOWTR>
|
|
FINPTR: LDA LOWTR
|
|
CLC
|
|
ADCI 2
|
|
LDY LOWTR+1
|
|
BCC FINNOW
|
|
INY
|
|
FINNOW: STWD VARPNT ;THIS IS IT.
|
|
RTS
|
|
PAGE
|
|
SUBTTL MULTIPLE DIMENSION CODE.
|
|
FMAPTR: LDA COUNT
|
|
ASL A,
|
|
ADCI 5 ;POINT TO ENTRIES. C CLR'D BY ASL.
|
|
ADC LOWTR
|
|
LDY LOWTR+1
|
|
BCC JSRGM
|
|
INY
|
|
JSRGM: STWD ARYPNT
|
|
RTS
|
|
|
|
N32768: EXP 144,128,0,0 ;-32768.
|
|
|
|
;
|
|
; INTIDX READS A FORMULA FROM THE CURRENT POSITION AND
|
|
; TURNS IT INTO A POSITIVE INTEGER
|
|
; LEAVING THE RESULT IN FACMO&LO. NEGATIVE ARGUMENTS
|
|
; ARE NOT ALLOWED.
|
|
;
|
|
INTIDX: JSR CHRGET
|
|
JSR FRMEVL ;GET A NUMBER
|
|
POSINT: JSR CHKNUM
|
|
LDA FACSGN
|
|
BMI NONONO ;IF NEGATIVE, BLOW HIM OUT.
|
|
AYINT: LDA FACEXP
|
|
CMPI 144 ;FAC .GT. 32767?
|
|
BCC QINTGO
|
|
LDWDI N32768 ;GET ADDR OF -32768.
|
|
JSR FCOMP ;SEE IF FAC=[[Y,A]].
|
|
NONONO: BNE FCERR ;NO, FAC IS TOO BIG.
|
|
QINTGO: JMP QINT ;GO TO QINT AND SHOVE IT.
|
|
;
|
|
; FORMAT OF ARRAYS IN CORE.
|
|
;
|
|
; DESCRIPTOR:
|
|
; LOWBYTE = FIRST CHARACTER.
|
|
; HIGHBYTE = SECOND CHARACTER (200 BIT IS STRING FLAG).
|
|
; LENGTH OF ARRAY IN CORE IN BYTES (INCLUDES EVERYTHING).
|
|
; NUMBER OF DIMENSIONS.
|
|
; FOR EACH DIMENSION STARTING WITH THE FIRST A LIST
|
|
; (2 BYTES EACH) OF THE MAX INDICE+1
|
|
; THE VALUES
|
|
;
|
|
ISARY: LDA DIMFLG
|
|
IFN INTPRC,<
|
|
ORA INTFLG>
|
|
PHA ;SAVE [DIMFLG] FOR RECURSION.
|
|
LDA VALTYP
|
|
PHA ;SAVE [VALTYP] FOR RECURSION.
|
|
LDYI 0 ;SET NUMBER OF DIMENSIONS TO ZERO.
|
|
INDLOP: TYA ;SAVE NUMBER OF DIMS.
|
|
PHA
|
|
PSHWD VARNAM ;SAVE LOOKS.
|
|
JSR INTIDX ;EVALUATE INDICE INTO FACMO&LO.
|
|
PULWD VARNAM ;GET BACK ALL... WE'RE HOME.
|
|
PLA ;(# OF DIMS).
|
|
TAY
|
|
TSX
|
|
LDA 258,X
|
|
PHA ;PUSH DIMFLG AND VALTYP FURTHER.
|
|
LDA 257,X
|
|
PHA
|
|
LDA INDICE ;PUT INDICE ONTO STACK.
|
|
STA 258,X, ;UNDER DIMFLG AND VALTYP.
|
|
LDA INDICE+1
|
|
STA 257,X
|
|
INY ;INCREMENT # OF DIMS.
|
|
JSR CHRGOT ;GET TERMINATING CHARACTER.
|
|
CMPI 44 ;A COMMA?
|
|
BEQ INDLOP ;YES.
|
|
STY COUNT ;SAVE COUNT OF DIMS.
|
|
JSR CHKCLS ;MUST BE CLOSED PAREN.
|
|
PLA
|
|
STA VALTYP ;GET VALTYP AND
|
|
PLA
|
|
IFN INTPRC,<
|
|
STA INTFLG
|
|
ANDI 127>
|
|
STA DIMFLG ;DIMFLG OFF STACK.
|
|
LDX ARYTAB ;PLACE TO START SEARCH.
|
|
LDA ARYTAB+1
|
|
LOPFDA: STX LOWTR
|
|
STA LOWTR+1
|
|
CMP STREND+1 ;END OF ARRAYS?
|
|
BNE LOPFDV
|
|
CPX STREND
|
|
BEQ NOTFDD ;A FINE THING! NO ARRAY!.
|
|
LOPFDV: LDYI 0
|
|
LDADY LOWTR
|
|
INY
|
|
CMP VARNAM ;COMPARE HIGH ORDERS.
|
|
BNE NMARY1 ;NO WAY IS IT THIS. GET OUT OF HERE.
|
|
LDA VARNAM+1
|
|
CMPDY LOWTR ;LOW ORDERS?
|
|
BEQ GOTARY ;WELL, HERE IT IS !!
|
|
NMARY1: INY
|
|
LDADY LOWTR ;GET LENGTH.
|
|
CLC
|
|
ADC LOWTR
|
|
TAX
|
|
INY
|
|
LDADY LOWTR
|
|
ADC LOWTR+1
|
|
BCC LOPFDA ;ALWAYS BRANCHES.
|
|
BSERR: LDXI ERRBS ;GET BAD SUB ERROR NUMBER.
|
|
SKIP2
|
|
FCERR: LDXI ERRFC ;TOO BIG. "FUNCTION CALL" ERROR.
|
|
ERRGO3: JMP ERROR
|
|
GOTARY: LDXI ERRDD ;PERHAPS A "RE-DIMENSION" ERROR
|
|
LDA DIMFLG ;TEST THE DIMFLG
|
|
BNE ERRGO3
|
|
JSR FMAPTR
|
|
LDA COUNT ;GET NUMBER OF DIMS INPUT.
|
|
LDYI 4
|
|
CMPDY LOWTR ;# OF DIMS THE SAME?
|
|
BNE BSERR ;SAME SO GO GET DEFINITION.
|
|
JMP GETDEF
|
|
|
|
;
|
|
; HERE WHEN VARIABLE IS NOT FOUND IN THE ARRAY TABLE.
|
|
;
|
|
; BUILDING AN ENTRY.
|
|
;
|
|
; PUT DOWN THE DESCRIPTOR.
|
|
; SETUP NUMBER OF DIMENSIONS.
|
|
; MAKE SURE THERE IS ROOM FOR THE NEW ENTRY.
|
|
; REMEMBER "VARPNT".
|
|
; TALLY=4.
|
|
; SKIP 2 LOCS FOR LATER FILL IN OF SIZE.
|
|
; LOOP: GET AN INDICE
|
|
; PUT DOWN NUMBER+1 AND INCREMENT VARPTR.
|
|
; TALLY=TALLY*NUMBER+1.
|
|
; DECREMENT NUMBER-DIMS.
|
|
; BNE LOOP
|
|
; CALL "REASON" WITH [Y,A] REFLECTING LAST LOC OF VARIABLE.
|
|
; UPDATE STREND.
|
|
; ZERO ALL.
|
|
; MAKE TALLY INCLUDE MAXDIMS AND DESCRIPTOR.
|
|
; PUT DOWN TALLY.
|
|
; IF CALLED BY DIMENSION, RETURN.
|
|
; OTHERWISE INDEX INTO THE VARIABLE AS IF IT
|
|
; WERE FOUND ON THE INITIAL SEARCH.
|
|
;
|
|
NOTFDD: JSR FMAPTR ;FORM ARYPNT.
|
|
JSR REASON
|
|
LDAI 0
|
|
TAY
|
|
STA CURTOL+1
|
|
IFE ADDPRC,<
|
|
LDXI 4>
|
|
IFN ADDPRC,<
|
|
LDXI 5>
|
|
LDA VARNAM ;THIS CODE ONLY WORKS FOR INTPRC=1
|
|
STADY LOWTR ;IF ADDPRC=1.
|
|
IFN ADDPRC,<
|
|
BPL NOTFLT
|
|
DEX>
|
|
NOTFLT: INY
|
|
LDA VARNAM+1
|
|
STADY LOWTR
|
|
BPL STOMLT
|
|
DEX
|
|
IFN ADDPRC,<
|
|
DEX>
|
|
STOMLT: STX CURTOL
|
|
LDA COUNT
|
|
REPEAT 3,<INY>
|
|
STADY LOWTR ;SAVE NUMBER OF DIMENSIONS.
|
|
LOPPTA: LDXI 11 ;DEFAULT SIZE.
|
|
LDAI 0
|
|
BIT DIMFLG
|
|
BVC NOTDIM ;NOT IN A DIM STATEMENT.
|
|
PLA ;GET LOW ORDER OF INDICE.
|
|
CLC
|
|
ADCI 1
|
|
TAX
|
|
PLA ;GET HIGH PART OF INDICE.
|
|
ADCI 0
|
|
NOTDIM: INY
|
|
STADY LOWTR ;STORE HIGH PART OF INDICE.
|
|
INY
|
|
TXA
|
|
STADY LOWTR ;STORE LOW ORDER OF INDICE.
|
|
JSR UMULT ;[X,A]=[CURTOL]*[LOWTR,Y]
|
|
STX CURTOL ;SAVE NEW TALLY.
|
|
STA CURTOL+1
|
|
LDY INDEX
|
|
DEC COUNT ;ANY MORE INDICES LEFT?
|
|
BNE LOPPTA ;YES.
|
|
ADC ARYPNT+1
|
|
BCS OMERR1 ;OVERFLOW.
|
|
STA ARYPNT+1 ;COMPUTE WHERE TO ZERO.
|
|
TAY
|
|
TXA
|
|
ADC ARYPNT
|
|
BCC GREASE
|
|
INY
|
|
BEQ OMERR1
|
|
GREASE: JSR REASON ;GET ROOM.
|
|
STWD STREND ;NEW END OF STORAGE.
|
|
LDAI 0 ;STORING [ACCA] IS FASTER THAN CLEAR.
|
|
INC CURTOL+1
|
|
LDY CURTOL
|
|
BEQ DECCUR
|
|
ZERITA: DEY
|
|
STADY ARYPNT
|
|
BNE ZERITA ;NO. CONTINUE.
|
|
DECCUR: DEC ARYPNT+1
|
|
DEC CURTOL+1
|
|
BNE ZERITA ;DO ANOTHER BLOCK.
|
|
INC ARYPNT+1 ;BUMP BACK UP. WILL USE LATER.
|
|
SEC
|
|
LDA STREND ;RESTORE [ACCA].
|
|
SBC LOWTR ;DETERMINE LENGTH.
|
|
LDYI 2
|
|
STADY LOWTR ;LOW.
|
|
LDA STREND+1
|
|
INY
|
|
SBC LOWTR+1
|
|
STADY LOWTR ;HIGH.
|
|
LDA DIMFLG
|
|
BNE DIMRTS ;BYE.
|
|
INY
|
|
;
|
|
; AT THIS POINT [LOWTR,Y] POINTS BEYOND THE SIZE TO THE NUMBER OF
|
|
; DIMENSIONS. STRATEGY:
|
|
; NUMDIM=NUMBER OF DIMENSIONS.
|
|
; CURTOL=0.
|
|
; INLPNM:GET A NEW INDICE.
|
|
; MAKE SURE INDICE IS NOT TOO BIG.
|
|
; MULTIPLY CURTOL BY CURMAX.
|
|
; ADD INDICE TO CURTOL.
|
|
; NUMDIM=NUMDIM-1.
|
|
; BNE INLPNM.
|
|
; USE [CURTOL]*4 AS OFFSET.
|
|
;
|
|
GETDEF: LDADY LOWTR
|
|
STA COUNT ;SAVE A COUNTER.
|
|
LDAI 0 ;ZERO [CURTOL].
|
|
STA CURTOL
|
|
INLPNM: STA CURTOL+1
|
|
INY
|
|
PLA ;GET LOW INDICE.
|
|
TAX
|
|
STA INDICE
|
|
PLA ;AND THE HIGH PART
|
|
STA INDICE+1
|
|
CMPDY LOWTR ;COMPARE WITH MAX INDICE.
|
|
BCC INLPN2
|
|
BNE BSERR7 ;IF GREATER, "BAD SUBSCRIPT" ERROR.
|
|
INY
|
|
TXA
|
|
CMPDY LOWTR
|
|
BCC INLPN1
|
|
BSERR7: JMP BSERR
|
|
OMERR1: JMP OMERR
|
|
INLPN2: INY
|
|
INLPN1: LDA CURTOL+1 ;DON'T MULTIPLY IF CURTOL=0.
|
|
ORA CURTOL
|
|
CLC ;PREPARE TO GET INDICE BACK.
|
|
BEQ ADDIND ;GET HIGH PART OF INDICE BACK.
|
|
JSR UMULT ;MULTIPLY [CURTOL] BY [LOWTR,Y,Y+1].
|
|
TXA
|
|
ADC INDICE ;ADD IN [INDICE].
|
|
TAX
|
|
TYA
|
|
LDY INDEX1
|
|
ADDIND: ADC INDICE+1
|
|
STX CURTOL
|
|
DEC COUNT ;ANY MORE?
|
|
BNE INLPNM ;YES.
|
|
STA CURTOL+1 ;FIX ARRAY BUG ****
|
|
IFE ADDPRC,<
|
|
LDXI 4>
|
|
IFN ADDPRC,<
|
|
LDXI 5 ;THIS CODE ONLY WORKS FOR INTPRC=1
|
|
LDA VARNAM ;IF ADDPRC=1.
|
|
BPL NOTFL1
|
|
DEX>
|
|
NOTFL1: LDA VARNAM+1
|
|
BPL STOML1
|
|
DEX
|
|
IFN ADDPRC,<
|
|
DEX>
|
|
STOML1: STX ADDEND
|
|
LDAI 0
|
|
JSR UMULTD ;ON RTS, A&Y=HI . X=LO.
|
|
TXA
|
|
ADC ARYPNT
|
|
STA VARPNT
|
|
TYA
|
|
ADC ARYPNT+1
|
|
STA VARPNT+1
|
|
TAY
|
|
LDA VARPNT
|
|
DIMRTS: RTS ;RETURN TO CALLER.
|
|
SUBTTL INTEGER ARITHMETIC ROUTINES.
|
|
;TWO BYTE UNSIGNED INTEGER MULTIPLY.
|
|
;THIS IS FOR MULTIPLY DIMENSIONED ARRAYS.
|
|
; [X,Y]=[X,A]=[CURTOL]*[LOWTR,Y,Y+1].
|
|
UMULT: STY INDEX
|
|
LDADY LOWTR
|
|
STA ADDEND ;LOW, THEN HIGH.
|
|
DEY
|
|
LDADY LOWTR ;PUT [LOWTR,Y,Y+1] IN FASTER MEMORY.
|
|
UMULTD: STA ADDEND+1
|
|
LDAI 16
|
|
STA DECCNT
|
|
LDXI 0 ;CLR THE ACCS.
|
|
LDYI 0 ;RESULT INITIALLY ZERO.
|
|
UMULTC: TXA
|
|
ASL A, ;MULTIPLY BY TWO.
|
|
TAX
|
|
TYA
|
|
ROL A,
|
|
TAY
|
|
BCS OMERR1 ;TWO MUCH !
|
|
ASL CURTOL
|
|
ROL CURTOL+1
|
|
BCC UMLCNT ;NOTHING IN THIS POSITION TO MULTIPLY.
|
|
CLC
|
|
TXA
|
|
ADC ADDEND
|
|
TAX
|
|
TYA
|
|
ADC ADDEND+1
|
|
TAY
|
|
BCS OMERR1 ;MAN, JUST TOO MUCH !
|
|
UMLCNT: DEC DECCNT ;DONE?
|
|
BNE UMULTC ;KEEP IT UP.
|
|
UMLRTS: RTS ;YES, ALL DONE.
|
|
PAGE
|
|
SUBTTL FRE FUNCTION AND INTEGER TO FLOATING ROUTINES.
|
|
FRE: LDA VALTYP
|
|
BEQ NOFREF
|
|
JSR FREFAC
|
|
NOFREF: JSR GARBA2
|
|
SEC
|
|
LDA FRETOP ;WE WANT
|
|
SBC STREND ;[FRETOP]-[STREND].
|
|
TAY
|
|
LDA FRETOP+1
|
|
SBC STREND+1
|
|
|
|
GIVAYF: LDXI 0
|
|
STX VALTYP
|
|
STWD FACHO
|
|
LDXI 144 ;SET EXPONENT TO 2^16.
|
|
JMP FLOATS ;TURN IT TO A FLOATING PNT #.
|
|
|
|
POS: LDY TRMPOS ;GET POSITION.
|
|
SNGFLT: LDAI 0
|
|
BEQA GIVAYF ;FLOAT IT.
|
|
PAGE
|
|
SUBTTL SIMPLE-USER-DEFINED-FUNCTION CODE.
|
|
;
|
|
; NOTE ONLY SINGLE ARGUMENTS ARE ALLOWED TO FUNCTIONS
|
|
; AND FUNCTIONS MUST BE OF THE SINGLE LINE FORM:
|
|
; DEF FNA(X)=X^2+X-2
|
|
; NO STRINGS CAN BE INVOLVED WITH THESE FUNCTIONS.
|
|
;
|
|
; IDEA: CREATE A SIMPLE VARIABLE ENTRY
|
|
; WHOSE FIRST CHARACTER HAS THE 200 BIT SET.
|
|
; THE VALUE WILL BE:
|
|
;
|
|
; A TEXT PNTR TO THE FORMULA.
|
|
; A PNTR TO THE ARGUMENT VARIABLE.
|
|
;
|
|
; FUNCTION NAMES CAN BE LIKE "FNA4".
|
|
;
|
|
;
|
|
; SUBROUTINE TO SEE IF WE ARE IN DIRECT MODE.
|
|
; AND COMPLAIN IF SO.
|
|
;
|
|
ERRDIR: LDX CURLIN+1 ;DIR MODE HAS [CURLIN]=0,255
|
|
INX ;SO NOW, IS RESULT ZERO?
|
|
BNE DIMRTS ;YES.
|
|
LDXI ERRID ;INPUT DIRECT ERROR CODE.
|
|
SKIP2
|
|
ERRGUF: LDXI ERRUF ;USER DEFINED FUNCTION NEVER DEFINED
|
|
ERRGO1: JMP ERROR
|
|
|
|
DEF: JSR GETFNM ;GET A PNTR TO THE FUNCTION.
|
|
JSR ERRDIR
|
|
JSR CHKOPN ;MUST HAVE "(".
|
|
LDAI 128
|
|
STA SUBFLG ;PROHIBIT SUBSCRIPTED VARIABLES.
|
|
JSR PTRGET ;GET PNTR TO ARGUMENT.
|
|
JSR CHKNUM ;IS IT A NUMBER?
|
|
JSR CHKCLS ;MUST HAVE ")"
|
|
SYNCHK EQULTK ;MUST HAVE "=".
|
|
IFN ADDPRC,<PHA> ;PUT CRAZY BYTE ON.
|
|
PSHWD VARPNT
|
|
PSHWD TXTPTR
|
|
JSR DATA
|
|
JMP DEFFIN
|
|
;
|
|
; SUBROUTINE TO GET A PNTR TO A FUNCTION NAME.
|
|
;
|
|
GETFNM: SYNCHK FNTK ;MUST START WITH FN.
|
|
ORAI 128 ;PUT FUNCTION BIT ON.
|
|
STA SUBFLG
|
|
JSR PTRGT2 ;GET POINTER TO FUNCTION OR CREATE ANEW.
|
|
STWD DEFPNT
|
|
JMP CHKNUM ;MAKE SURE IT'S NOT A STRING AND RETURN.
|
|
|
|
FNDOER: JSR GETFNM ;GET THE FUNCTION'S NAME.
|
|
PSHWD DEFPNT
|
|
JSR PARCHK ;EVALUATE PARAMETER.
|
|
JSR CHKNUM
|
|
PULWD DEFPNT
|
|
LDYI 2
|
|
LDADY DEFPNT ;GET POINTER TO VARIABLE.
|
|
STA VARPNT ;SAVE VARIABLE POINTER.
|
|
TAX
|
|
INY
|
|
LDADY DEFPNT
|
|
BEQ ERRGUF
|
|
STA VARPNT+1
|
|
IFN ADDPRC,<INY> ;SINCE DEF USES ONLY 4.
|
|
DEFSTF: LDADY VARPNT
|
|
PHA ;PUSH IT ALL ON STACK.
|
|
DEY ;SINCE WE ARE RECURSING MAYBE.
|
|
BPL DEFSTF
|
|
LDY VARPNT+1
|
|
JSR MOVMF ;PUT CURRENT FAC INTO OUR ARG VARIABLE.
|
|
PSHWD TXTPTR ;SAVE TEXT POINTER.
|
|
LDADY DEFPNT ;PNTR TO FUNCTION.
|
|
STA TXTPTR
|
|
INY
|
|
LDADY DEFPNT
|
|
STA TXTPTR+1
|
|
PSHWD VARPNT ;SAVE VARIABLE POINTER.
|
|
JSR FRMNUM ;EVALUATE FORMULA AND CHECK NUMERIC.
|
|
PULWD DEFPNT
|
|
JSR CHRGOT
|
|
JNE SNERR ;IT DIDN'T TERMINATE. HUH?
|
|
PULWD TXTPTR ;RESTORE TEXT PNTR.
|
|
DEFFIN: LDYI 0
|
|
PLA ;GET OLD ARG VALUE OFF STACK
|
|
STADY DEFPNT ;AND PUT IT BACK IN VARIABLE.
|
|
PLA
|
|
INY
|
|
STADY DEFPNT
|
|
PLA
|
|
INY
|
|
STADY DEFPNT
|
|
PLA
|
|
INY
|
|
STADY DEFPNT
|
|
IFN ADDPRC,<
|
|
PLA
|
|
INY
|
|
STADY DEFPNT>
|
|
DEFRTS: RTS
|
|
PAGE
|
|
SUBTTL STRING FUNCTIONS.
|
|
;
|
|
; THE STR$ FUNCTION TAKES A NUMBER AND GIVES A STRING
|
|
; WITH THE CHARACTERS THE OUTPUT OF THE NUMBER
|
|
; WOULD HAVE GIVEN.
|
|
;
|
|
STR: JSR CHKNUM ;ARG HAS TO BE NUMERIC.
|
|
LDYI 0
|
|
JSR FOUTC ;DO ITS OUTPUT.
|
|
PLA
|
|
PLA
|
|
TIMSTR: LDWDI LOFBUF
|
|
BEQA STRLIT ;SCAN IT AND TURN IT INTO A STRING.
|
|
;
|
|
; "STRINI" GET STRING SPACE FOR THE CREATION OF A STRING AND
|
|
; CREATES A DESCRIPTOR FOR IT IN "DSCTMP".
|
|
;
|
|
STRINI: LDXY FACMO ;GET FACMO TO STORE IN DSCPNT.
|
|
STXY DSCPNT ;RETAIN THE DESCRIPTOR POINTER.
|
|
STRSPA: JSR GETSPA ;GET STRING SPACE.
|
|
STXY DSCTMP+1 ;SAVE LOCATION.
|
|
STA DSCTMP ;SAVE LENGTH.
|
|
RTS ;ALL DONE.
|
|
;
|
|
; "STRLT2" TAKES THE STRING LITERAL WHOSE FIRST CHARACTER
|
|
; IS POINTED TO BY [Y,A] AND BUILDS A DESCRIPTOR FOR IT.
|
|
; THE DESCRIPTOR IS INITIALLY BUILT IN "DSCTMP", BUT "PUTNEW"
|
|
; TRANSFERS IT INTO A TEMPORARY AND LEAVES A POINTER
|
|
; AT THE TEMPORARY IN FACMO&LO. THE CHARACTERS OTHER THAN
|
|
; ZERO THAT TERMINATE THE STRING SHOULD BE SET UP IN "CHARAC"
|
|
; AND "ENDCHR". IF THE TERMINATOR IS A QUOTE, THE QUOTE IS SKIPPED
|
|
; OVER. LEADING QUOTES SHOULD BE SKIPPED BEFORE JSR. ON RETURN
|
|
; THE CHARACTER AFTER THE STRING LITERAL IS POINTED TO
|
|
; BY [STRNG2].
|
|
;
|
|
STRLIT: LDXI 34 ;ASSUME STRING ENDS ON QUOTE.
|
|
STX CHARAC
|
|
STX ENDCHR
|
|
STRLT2: STWD STRNG1 ;SAVE POINTER TO STRING.
|
|
STWD DSCTMP+1 ;IN CASE NO STRCPY.
|
|
LDYI 255 ;INITIALIZE CHARACTER COUNT.
|
|
STRGET: INY
|
|
LDADY STRNG1 ;GET CHARACTER.
|
|
BEQ STRFI1 ;IF ZERO.
|
|
CMP CHARAC ;THIS TERMINATOR?
|
|
BEQ STRFIN ;YES.
|
|
CMP ENDCHR
|
|
BNE STRGET ;LOOK FURTHER.
|
|
STRFIN: CMPI 34 ;QUOTE?
|
|
BEQ STRFI2
|
|
STRFI1: CLC ;NO, BACK UP.
|
|
STRFI2: STY DSCTMP ;RETAIN COUNT.
|
|
TYA
|
|
ADC STRNG1 ;WISHING TO SET [TXTPTR].
|
|
STA STRNG2
|
|
LDX STRNG1+1
|
|
BCC STRST2
|
|
INX
|
|
STRST2: STX STRNG2+1
|
|
LDA STRNG1+1 ;IF PAGE 0, COPY SINCE IT IS EITHER
|
|
;A STRING CONSTANT IN BUF OR A STR$
|
|
;RESULT IN LOFBUF
|
|
IFN BUFPAG,<
|
|
BEQ STRCP
|
|
CMPI BUFPAG>
|
|
BNE PUTNEW
|
|
STRCP: TYA
|
|
JSR STRINI
|
|
LDXY STRNG1
|
|
JSR MOVSTR ;MOVE STRING.
|
|
;
|
|
; SOME STRING FUNCTION IS RETURNING A RESULT IN DSCTMP.
|
|
; SETUP A TEMP DESCRIPTOR WITH DSCTMP IN IT.
|
|
; PUT A POINTER TO THE DESCRIPTOR IN FACMO&LO AND FLAG THE
|
|
; RESULT AS TYPE STRING.
|
|
;
|
|
PUTNEW: LDX TEMPPT ;POINTER TO FIRST FREE TEMP.
|
|
CPXI TEMPST+STRSIZ*NUMTMP
|
|
BNE PUTNW1
|
|
LDXI ERRST ;STRING TEMPORARY ERROR.
|
|
ERRGO2: JMP ERROR ;GO TELL HIM.
|
|
PUTNW1: LDA DSCTMP
|
|
STA 0,X
|
|
LDA DSCTMP+1
|
|
STA 1,X
|
|
LDA DSCTMP+2
|
|
STA 2,X
|
|
LDYI 0
|
|
STXY FACMO
|
|
STY FACOV
|
|
DEY
|
|
STY VALTYP ;TYPE IS "STRING".
|
|
STX LASTPT ;SET POINTER TO LAST-USED TEMP.
|
|
INX
|
|
INX
|
|
INX ;POINT FURTHER.
|
|
STX TEMPPT ;SAVE POINTER TO NEXT TEMP IF ANY.
|
|
RTS ;ALL DONE.
|
|
|
|
;
|
|
; GETSPA - GET SPACE FOR CHARACTER STRING.
|
|
; MAY FORCE GARBAGE COLLECTION.
|
|
;
|
|
; # OF CHARACTERS (BYTES) IN ACCA.
|
|
; RETURNS WITH POINTER IN [Y,X]. OTHERWISE (IF CAN'T GET
|
|
; SPACE) BLOWS OFF TO "OUT OF STRING SPACE" TYPE ERROR.
|
|
; ALSO PRESERVES [ACCA] AND SETS [FRESPC]=[Y,X]=PNTR AT SPACE.
|
|
;
|
|
GETSPA: LSR GARBFL ;SIGNAL NO GARBAGE COLLECTION YET.
|
|
TRYAG2: PHA ;SAVE FOR LATER.
|
|
EORI 255
|
|
SEC ;ADD ONE TO COMPLETE NEGATION.
|
|
ADC FRETOP
|
|
LDY FRETOP+1
|
|
BCS TRYAG3
|
|
DEY
|
|
TRYAG3: CPY STREND+1 ;COMPARE HIGH ORDERS.
|
|
BCC GARBAG ;MAKE ROOM FOR MORE.
|
|
BNE STRFRE ;SAVE NEW FRETOP.
|
|
CMP STREND ;COMPARE LOW ORDERS.
|
|
BCC GARBAG ;CLEAN UP.
|
|
STRFRE: STWD FRETOP ;SAVE NEW [FRETOP].
|
|
STWD FRESPC ;PUT IT THERE OLD MAN.
|
|
TAX ;PRESERVE A IN X.
|
|
PLA ;GET COUNT BACK IN ACCA.
|
|
RTS ;ALL DONE.
|
|
GARBAG: LDXI ERROM ;"OUT OF STRING SPACE"
|
|
LDA GARBFL
|
|
BMI ERRGO2
|
|
JSR GARBA2
|
|
LDAI 128
|
|
STA GARBFL
|
|
PLA ;GET BACK STRING LENGTH.
|
|
BNE TRYAG2 ;ALWAYS BRANCHES.
|
|
GARBA2: ;START FROM TOP DOWN.
|
|
IFE REALIO!DISKO,<
|
|
LDAI 7 ;TYPE "BELL".
|
|
JSR OUTDO>
|
|
LDX MEMSIZ
|
|
LDA MEMSIZ+1
|
|
FNDVAR: STX FRETOP ;LIKE SO.
|
|
STA FRETOP+1
|
|
LDYI 0
|
|
STY GRBPNT+1
|
|
STY GRBPNT ;BOTH BYTES SET TO ZERO (FIX BUG)
|
|
LDWX STREND
|
|
STWX GRBTOP
|
|
LDWXI TEMPST
|
|
STWX INDEX1
|
|
TVAR: CMP TEMPPT ;DONE WITH TEMPS?
|
|
BEQ SVARS ;YEP.
|
|
JSR DVAR
|
|
BEQ TVAR ;LOOP.
|
|
SVARS: LDAI 6+ADDPRC
|
|
STA FOUR6
|
|
LDWX VARTAB ;GET START OF SIMPLE VARIABLES.
|
|
STWX INDEX1
|
|
SVAR: CPX ARYTAB+1 ;DONE WITH SIMPLE VARIABLES?
|
|
BNE SVARGO ;NO.
|
|
CMP ARYTAB
|
|
BEQ ARYVAR ;YEP.
|
|
SVARGO: JSR DVARS ;DO IT , AGAIN.
|
|
BEQ SVAR ;LOOP.
|
|
ARYVAR: STWX ARYPNT ;SAVE FOR ADDITION.
|
|
LDAI STRSIZ
|
|
STA FOUR6
|
|
ARYVA2: LDWX ARYPNT ;GET THE POINTER TO VARIABLE.
|
|
ARYVA3: CPX STREND+1 ;DONE WITH ARRAYS?
|
|
BNE ARYVGO ;NO.
|
|
CMP STREND
|
|
JEQ GRBPAS ;YES, GO FINISH UP.
|
|
ARYVGO: STWX INDEX1
|
|
LDYI 1-ADDPRC
|
|
IFN ADDPRC,<
|
|
LDADY INDEX1
|
|
TAX
|
|
INY>
|
|
LDADY INDEX1
|
|
PHP
|
|
INY
|
|
LDADY INDEX1
|
|
ADC ARYPNT
|
|
STA ARYPNT ;FORM POINTER TO NEXT ARRAY VAR.
|
|
INY
|
|
LDADY INDEX1
|
|
ADC ARYPNT+1
|
|
STA ARYPNT+1
|
|
PLP
|
|
BPL ARYVA2
|
|
IFN ADDPRC,<
|
|
TXA
|
|
BMI ARYVA2>
|
|
INY
|
|
LDADY INDEX1
|
|
LDYI 0 ;RESET INDEX Y.
|
|
ASL A,
|
|
ADCI 5 ;CARRY IS OFF AND OFF AFTER ADD.
|
|
ADC INDEX1
|
|
STA INDEX1
|
|
BCC ARYGET
|
|
INC INDEX1+1
|
|
ARYGET: LDX INDEX1+1
|
|
ARYSTR: CPX ARYPNT+1 ;END OF THE ARRAY?
|
|
BNE GOGO
|
|
CMP ARYPNT
|
|
BEQ ARYVA3 ;YES.
|
|
GOGO: JSR DVAR
|
|
BEQ ARYSTR ;CYCLE.
|
|
DVARS:
|
|
IFN INTPRC,<
|
|
LDADY INDEX1
|
|
BMI DVARTS>
|
|
INY
|
|
LDADY INDEX1
|
|
BPL DVARTS
|
|
INY
|
|
DVAR: LDADY INDEX1 ;IS LENGTH=0?
|
|
BEQ DVARTS ;YES, RETURN.
|
|
INY
|
|
LDADY INDEX1 ;GET LOW(ADR).
|
|
TAX
|
|
INY
|
|
LDADY INDEX1
|
|
CMP FRETOP+1 ;COMPARE HIGHS.
|
|
BCC DVAR2 ;IF THIS STRING'S PNTR .GE. [FRETOP]
|
|
BNE DVARTS ;NO NEED TO MESS WITH IT FURTHER.
|
|
CPX FRETOP ;COMPARE LOWS.
|
|
BCS DVARTS
|
|
DVAR2: CMP GRBTOP+1
|
|
BCC DVARTS ;IF THIS STRING IS BELOW PREVIOUS,
|
|
;FORGET IT.
|
|
BNE DVAR3
|
|
CPX GRBTOP ;COMPARE LOW ORDERS.
|
|
BCC DVARTS ;[X,A] .LE. [GRBTOP].
|
|
DVAR3: STX GRBTOP
|
|
STA GRBTOP+1
|
|
LDWX INDEX1
|
|
STWX GRBPNT
|
|
LDA FOUR6
|
|
STA SIZE
|
|
DVARTS: LDA FOUR6
|
|
CLC
|
|
ADC INDEX1
|
|
STA INDEX1
|
|
BCC GRBRTS
|
|
INC INDEX1+1
|
|
GRBRTS: LDX INDEX1+1
|
|
LDYI 0
|
|
RTS ;DONE.
|
|
;
|
|
; HERE WHEN MADE ONE COMPLETE PASS THROUGH STRING VARIABLES.
|
|
;
|
|
GRBPAS: LDA GRBPNT+1 ;VARIABLE POINTER.
|
|
ORA GRBPNT
|
|
BEQ GRBRTS ;ALL DONE.
|
|
LDA SIZE
|
|
ANDI 4 ;LEAVES C OFF.
|
|
LSR A,
|
|
TAY
|
|
STA SIZE
|
|
LDADY GRBPNT
|
|
;NOTE: GRBTOP=LOWTR SO NO NEED TO SET LOWTR.
|
|
ADC LOWTR
|
|
STA HIGHTR
|
|
LDA LOWTR+1
|
|
ADCI 0
|
|
STA HIGHTR+1
|
|
LDWX FRETOP
|
|
STWX HIGHDS ;WHERE IT ALL GOES.
|
|
JSR BLTUC
|
|
LDY SIZE
|
|
INY
|
|
LDA HIGHDS ;GET POSITION OF START OF RESULT.
|
|
STADY GRBPNT
|
|
TAX
|
|
INC HIGHDS+1
|
|
LDA HIGHDS+1
|
|
INY
|
|
STADY GRBPNT ;CHANGE ADDR OF STRING IN VAR.
|
|
JMP FNDVAR ;GO TO FNDVAR WITH SOMETHING FOR
|
|
;[FRETOP].
|
|
;
|
|
; THE FOLLOWING ROUTINE CONCATENATES TWO STRINGS.
|
|
; THE FAC CONTAINS THE FIRST ONE AT THIS POINT.
|
|
; [TXTPTR] POINTS TO THE + SIGN.
|
|
;
|
|
CAT: LDA FACLO ;PSH HIGH ORDER ONTO STACK.
|
|
PHA
|
|
LDA FACMO ;AND THE LOW.
|
|
PHA
|
|
JSR EVAL ;CAN COME BACK HERE SINCE
|
|
;OPERATOR IS KNOWN.
|
|
JSR CHKSTR ;RESULT MUST BE STRING.
|
|
PLA
|
|
STA STRNG1 ;GET HIGH ORDER OF OLD DESC.
|
|
PLA
|
|
STA STRNG1+1
|
|
LDYI 0
|
|
LDADY STRNG1 ;GET LENGTH OF OLD STRING.
|
|
CLC
|
|
ADCDY FACMO
|
|
BCC SIZEOK ;RESULT IS LESS THAN 256.
|
|
LDXI ERRLS ;ERROR "LONG STRING".
|
|
JMP ERROR
|
|
SIZEOK: JSR STRINI ;INITIALIZE STRING.
|
|
JSR MOVINS ;MOVE IT.
|
|
LDWD DSCPNT ;GET POINTER TO SECOND.
|
|
JSR FRETMP ;FREE IT.
|
|
JSR MOVDO
|
|
LDWD STRNG1
|
|
JSR FRETMP
|
|
JSR PUTNEW
|
|
JMP TSTOP ;"CAT" REENTERS FORM EVAL AT TSTOP.
|
|
|
|
MOVINS: LDYI 0 ;GET ADDR OF STRING.
|
|
LDADY STRNG1
|
|
PHA
|
|
INY
|
|
LDADY STRNG1
|
|
TAX
|
|
INY
|
|
LDADY STRNG1
|
|
TAY
|
|
PLA
|
|
MOVSTR: STXY INDEX
|
|
MOVDO: TAY
|
|
BEQ MVDONE
|
|
PHA
|
|
MOVLP: DEY
|
|
LDADY INDEX
|
|
STADY FRESPC
|
|
QMOVE: TYA
|
|
BNE MOVLP
|
|
PLA
|
|
MVDONE: CLC
|
|
ADC FRESPC
|
|
STA FRESPC
|
|
BCC MVSTRT
|
|
INC FRESPC+1
|
|
MVSTRT: RTS
|
|
;
|
|
; "FRETMP" IS PASSED A STRING DESCRIPTOR PNTR IN [Y,A].
|
|
; A CHECK IS MADE TO SEE IF THE STRING DESCRIPTOR POINTS TO THE LAST
|
|
; TEMPORARY DESCRIPTOR ALLOCATED BY PUTNEW.
|
|
; IF SO, THE TEMPORARY IS FREED UP BY THE UPDATING OF [TEMPPT].
|
|
; IF A TEMP IS FREED UP, A FURTHER CHECK SEES IF THE STRING DATA THAT
|
|
; THAT STRING TEMP PNT'D TO IS THE LOWEST PART OF STRING SPACE IN USE.
|
|
; IF SO, [FRETOP] IS UPDATED TO REFLECT THE FACT THE FACT THAT THE SPACE
|
|
; IS NO LONGER IN USE.
|
|
; THE ADDR OF THE ACTUAL STRING IS RETURNED IN [Y,X] AND
|
|
; ITS LENGTH IN ACCA.
|
|
;
|
|
FRESTR: JSR CHKSTR ;MAKE SURE ITS A STRING.
|
|
FREFAC: LDWD FACMO ;FREE UP STR PNT'D TO BY FAC.
|
|
FRETMP: STWD INDEX ;GET LENGTH FOR LATER.
|
|
JSR FRETMS ;FREE UP THE TEMPORARY DESC.
|
|
PHP ;SAVE CODES.
|
|
LDYI 0 ;PREP TO GET STUFF.
|
|
LDADY INDEX ;GET COUNT AND
|
|
PHA ;SAVE IT.
|
|
INY
|
|
LDADY INDEX
|
|
TAX ;SAVE LOW ORDER.
|
|
INY
|
|
LDADY INDEX
|
|
TAY ;SAVE HIGH ORDER.
|
|
PLA
|
|
PLP ;RETURN STATUS.
|
|
BNE FRETRT
|
|
CPY FRETOP+1 ;STRING IS LAST ONE IN?
|
|
BNE FRETRT
|
|
CPX FRETOP
|
|
BNE FRETRT
|
|
PHA
|
|
CLC
|
|
ADC FRETOP
|
|
STA FRETOP
|
|
BCC FREPLA
|
|
INC FRETOP+1
|
|
FREPLA: PLA ;GET COUNT BACK.
|
|
FRETRT: STXY INDEX ;SAVE FOR LATER USE.
|
|
RTS
|
|
FRETMS: CPY LASTPT+1 ;LAST ENTRY TO TEMP?
|
|
BNE FRERTS
|
|
CMP LASTPT
|
|
BNE FRERTS
|
|
STA TEMPPT
|
|
SBCI STRSIZ ;POINT TO LAST ONE.
|
|
STA LASTPT ;UPDATE TEMP PNTR.
|
|
LDYI 0 ;ALSO CLEARS ZFLG SO WE DO REST OF FRETMP.
|
|
FRERTS: RTS ;ALL DONE.
|
|
;
|
|
; CHR$(#) CREATES A STRING WHICH CONTAINS AS ITS ONLY
|
|
; CHARACTER THE ASCII EQUIVALENT OF THE INTEGER ARGUMENT (#)
|
|
; WHICH MUST BE .LT. 255.
|
|
;
|
|
CHR: JSR CONINT ;GET INTEGER IN RANGE.
|
|
TXA
|
|
PHA
|
|
LDAI 1 ;ONE-CHARACTER STRING.
|
|
JSR STRSPA ;GET SPACE FOR STRING.
|
|
PLA
|
|
LDYI 0
|
|
STADY DSCTMP+1
|
|
PLA ;GET RID OF "CHKNUM" RETURN ADDR.
|
|
PLA
|
|
RLZRET: JMP PUTNEW ;SETUP FAC TO POINT TO DESC.
|
|
;
|
|
; THE FOLLOWING IS THE LEFT$($,#) FUNCTION.
|
|
; IT TAKES THE LEFTMOST # CHARACTERS OF THE STRING.
|
|
; IF # .GT. THE LEN OF THE STRING, IT RETURNS THE WHOLE STRING.
|
|
;
|
|
LEFT: JSR PREAM ;TEST PARAMETERS.
|
|
CMPDY DSCPNT
|
|
TYA
|
|
RLEFT: BCC RLEFT1
|
|
LDADY DSCPNT
|
|
TAX ;PUT LENGTH INTO X.
|
|
TYA ;ZERO A, THE OFFSET.
|
|
RLEFT1: PHA ;SAVE OFFSET.
|
|
RLEFT2: TXA
|
|
RLEFT3: PHA ;SAVE LENGTH.
|
|
JSR STRSPA ;GET SPACE.
|
|
LDWD DSCPNT
|
|
JSR FRETMP
|
|
PLA
|
|
TAY
|
|
PLA
|
|
CLC
|
|
ADC INDEX ;COMPUTE WHERE TO COPY.
|
|
STA INDEX
|
|
BCC PULMOR
|
|
INC INDEX+1
|
|
PULMOR: TYA
|
|
JSR MOVDO ;GO MOVE IT.
|
|
JMP PUTNEW
|
|
RIGHT: JSR PREAM
|
|
CLC ;[LENGTH DES'D]-[LENGTH]-1.
|
|
SBCDY DSCPNT
|
|
EORI 255 ;NEGATE.
|
|
JMP RLEFT
|
|
;
|
|
; MID ($,#) RETURNS STRING WITH CHARS FROM # POSITION
|
|
; ONWARD. IF # .GT. LEN ($) THEN RETURN NULL STRING.
|
|
; MID ($,#,#) RETURNS STRING WITH CHARACTERS FROM
|
|
; # POSITION FOR #2 CHARACTERS. IF #2 GOES PAST END OF STRING
|
|
; RETURN AS MUCH AS POSSIBLE.
|
|
;
|
|
MID: LDAI 255 ;DEFAULT.
|
|
STA FACLO ;SAVE FOR LATER COMPARE.
|
|
JSR CHRGOT ;GET CURRENT CHARACTER.
|
|
CMPI 41 ;IS IT A RIGHT PAREN )?
|
|
BEQ MID2 ;NO THIRD PARAM.
|
|
JSR CHKCOM ;MUST HAVE COMMA.
|
|
JSR GETBYT ;GET THE LENGTH INTO "FACLO".
|
|
MID2: JSR PREAM ;CHECK IT OUT.
|
|
BEQ GOFUC ;THERE IS NO POSTION 0
|
|
DEX ;COMPUTE OFFSET.
|
|
TXA
|
|
PHA ;PRSERVE AWHILE.
|
|
CLC
|
|
LDXI 0
|
|
SBCDY DSCPNT ;GET LENGTH OF WHAT'S LEFT.
|
|
BCS RLEFT2 ;GIVE NULL STRING.
|
|
EORI 255 ;IN SUB C WAS 0 SO JUST COMPLEMENT.
|
|
CMP FACLO ;GREATER THAN WHAT'S DESIRED?
|
|
BCC RLEFT3 ;NO, COPY THAT MUCH.
|
|
LDA FACLO ;GET LENGTH OF WHAT'S DESIRED.
|
|
BCS RLEFT3 ;COPY IT.
|
|
|
|
;
|
|
; USED BY RIGHT$, LEFT$, MID$ FOR PARAMETER CHECKING AND SETUP.
|
|
;
|
|
PREAM: JSR CHKCLS ;PARAM LIST SHOULD END.
|
|
PLA ;GET THE RETURN ADDRESS INTO
|
|
TAY ;[JMPER+1,Y]
|
|
PLA
|
|
STA JMPER+1
|
|
PLA ;GET RID OF FINGO'S JSR RET ADDR.
|
|
PLA
|
|
PLA ;GET LENGTH.
|
|
TAX
|
|
PULWD DSCPNT
|
|
LDA JMPER+1 ;PUT RETURN ADDRESS BACK ON
|
|
PHA
|
|
TYA
|
|
PHA
|
|
LDYI 0
|
|
TXA
|
|
RTS
|
|
;
|
|
; THE FUNCTION LEN($) RETURNS THE LENGTH OF THE STRING
|
|
; PASSED AS AN ARGUMENT.
|
|
;
|
|
LEN: JSR LEN1
|
|
JMP SNGFLT
|
|
LEN1: JSR FRESTR ;FREE UP STRING.
|
|
LDXI 0
|
|
STX VALTYP ;FORCE NUMERIC.
|
|
TAY ;SET CODES ON LENGTH.
|
|
RTS ;DONE.
|
|
;
|
|
; THE FOLLOWING IS THE ASC($) FUNCTION. IT RETURNS
|
|
; AN INTEGER WHICH IS THE DECIMAL ASCII EQUIVALENT.
|
|
;
|
|
ASC: JSR LEN1
|
|
BEQ GOFUC ;NULL STRING, BAD ARG.
|
|
LDYI 0
|
|
LDADY INDEX1 ;GET CHARACTER.
|
|
TAY
|
|
JMP SNGFLT
|
|
GOFUC: JMP FCERR ;YES.
|
|
|
|
GTBYTC: JSR CHRGET
|
|
GETBYT: JSR FRMNUM ;READ FORMULA INTO FAC.
|
|
CONINT: JSR POSINT ;CONVERT THE FAC TO A SINGLE BYTE INT.
|
|
LDX FACMO
|
|
BNE GOFUC ;RESULT MUST BE .LE. 255.
|
|
LDX FACLO
|
|
CHRGO2: JMP CHRGOT ;SET CONDITION CODES ON TERMINATOR.
|
|
;
|
|
; THE "VAL" FUNCTION TAKES A STRING AND TURNS IT INTO
|
|
; A NUMBER BY INTERPRETING THE ASCII DIGITS ETCQ
|
|
; EXCEPT FOR THE PROBLEM THAT A TERMINATOR MUST BE SUPPLIED
|
|
; BY REPLACING THE CHARACTER BEYOND THE STRING, VAL IS MERELY
|
|
; A CALL TO FLOATING POINT INPUT ("FIN").
|
|
;
|
|
VAL: JSR LEN1 ;DO SETUP. SET RESULT=NUMERIC.
|
|
JEQ ZEROFC ;ZERO THE FAC ON A NULL STRING
|
|
LDXY TXTPTR
|
|
STXY STRNG2 ;SAVE FOR LATER.
|
|
LDX INDEX1
|
|
STX TXTPTR
|
|
CLC
|
|
ADC INDEX1
|
|
STA INDEX2
|
|
LDX INDEX1+1
|
|
STX TXTPTR+1
|
|
BCC VAL2 ;NO CARRY, NO INC.
|
|
INX
|
|
VAL2: STX INDEX2+1
|
|
LDYI 0
|
|
LDADY INDEX2 ;PRESERVE CHARACTER.
|
|
PHA
|
|
LDAI 0 ;SET A TERMINATOR.
|
|
STADY INDEX2
|
|
JSR CHRGOT ;GET CHARACTER PNT'D TO AND SET FLAGS.
|
|
JSR FIN
|
|
PLA ;GET PRES'D CHARACTER.
|
|
LDYI 0
|
|
STADY INDEX2 ;STUFF IT BACK.
|
|
ST2TXT: LDXY STRNG2
|
|
STXY TXTPTR
|
|
VALRTS: RTS ;ALL DONE WITH STRINGS.
|
|
PAGE
|
|
SUBTTL PEEK, POKE, AND FNWAIT.
|
|
|
|
GETNUM: JSR FRMNUM ;GET ADDRESS.
|
|
JSR GETADR ;GET THAT LOCATION.
|
|
COMBYT: JSR CHKCOM ;CHECK FOR A COMMA.
|
|
JMP GETBYT ;GET SOMETHING TO STORE AND RETURN.
|
|
GETADR: LDA FACSGN ;EXAMINE SIGN.
|
|
BMI GOFUC ;FUNCTION CALL ERROR.
|
|
LDA FACEXP ;EXAMINE EXPONENT.
|
|
CMPI 145
|
|
BCS GOFUC ;FUNCTION CALL ERROR.
|
|
JSR QINT ;INTEGERIZE IT.
|
|
LDWD FACMO
|
|
STY POKER
|
|
STA POKER+1
|
|
RTS ;IT'S DONE !.
|
|
|
|
PEEK: PSHWD POKER
|
|
JSR GETADR
|
|
LDYI 0
|
|
IFE REALIO-3,<
|
|
CMPI ROMLOC/256 ;IF WITHIN BASIC,
|
|
BCC GETCON
|
|
CMPI LASTWR/256
|
|
BCC DOSGFL> ;GIVE HIM ZERO FOR AN ANSWER.
|
|
GETCON: LDADY POKER ;GET THAT BYTE.
|
|
TAY
|
|
DOSGFL: PULWD POKER
|
|
JMP SNGFLT ;FLOAT IT.
|
|
|
|
POKE: JSR GETNUM
|
|
TXA
|
|
LDYI 0
|
|
STADY POKER ;STORE VALUE AWAY.
|
|
RTS ;SCANNED EVERYTHING.
|
|
|
|
; THE WAIT LOCATION,MASK1,MASK2 STATEMENT WAITS UNTIL THE CONTENTS
|
|
; OF LOCATION IS NONZERO WHEN XORED WITH MASK2
|
|
; AND THEN ANDED WITH MASK1. IF MASK2 IS NOT PRESENT, IT
|
|
; IS ASSUMED TO BE ZERO.
|
|
|
|
FNWAIT: JSR GETNUM
|
|
STX ANDMSK
|
|
LDXI 0
|
|
JSR CHRGOT
|
|
BEQ ZSTORDO
|
|
JSR COMBYT ;GET MASK2.
|
|
STORDO: STX EORMSK
|
|
LDYI 0
|
|
WAITER: LDADY POKER
|
|
EOR EORMSK
|
|
AND ANDMSK
|
|
BEQ WAITER
|
|
ZERRTS: RTS ;GOT A NONZERO.
|
|
SUBTTL FLOATING POINT MATH PACKAGE CONFIGURATION.
|
|
|
|
RADIX 8 ;!!!! ALERT !!!!
|
|
;THROUGHOUT THE MATH PACKAGE.
|
|
COMMENT %
|
|
THE FLOATING POINT FORMAT IS AS FOLLOWS:
|
|
|
|
THE SIGN IS THE FIRST BIT OF THE MANTISSA.
|
|
THE MANTISSA IS 24 BITS LONG.
|
|
THE BINARY POINT IS TO THE LEFT OF THE MSB.
|
|
NUMBER = MANTISSA * 2 ^ EXPONENT.
|
|
THE MANTISSA IS POSITIVE WITH A ONE ASSUMED TO BE WHERE THE SIGN BIT IS.
|
|
THE SIGN OF THE EXPONENT IS THE FIRST BIT OF THE EXPONENT.
|
|
THE EXPONENT IS STORED IN EXCESS 200, I.E. WITH A BIAS OF +200.
|
|
SO, THE EXPONENT IS A SIGNED 8-BIT NUMBER WITH 200 ADDED TO IT.
|
|
AN EXPONENT OF ZERO MEANS THE NUMBER IS ZERO.
|
|
THE OTHER BYTES MAY NOT BE ASSUMED TO BE ZERO.
|
|
TO KEEP THE SAME NUMBER IN THE FAC WHILE SHIFTING,
|
|
TO SHIFT RIGHT, EXP:=EXP+1
|
|
TO SHIFT LEFT, EXP:=EXP-1
|
|
|
|
IN MEMORY THE NUMBER LOOKS LIKE THIS:
|
|
[THE EXPONENT AS A SIGNED NUMBER +200]
|
|
[THE SIGN BIT IN 7, BITS 2-8 OF MANTISSA ARE IN BITS 6-0].
|
|
(REMEMBER BIT 1 OF MANTISSA IS ALWAYS A ONE.)
|
|
[BITS 9-16 OF THE MANTISSA]
|
|
[BITS 17-24] OF THE MANTISSA]
|
|
|
|
ARITHMETIC ROUTINE CALLING CONVENTIONS:
|
|
|
|
FOR ONE ARGUMENT FUNCTIONS:
|
|
THE ARGUMENT IS IN THE FAC.
|
|
THE RESULT IS LEFT IN THE FAC.
|
|
FOR TWO ARGUMENT OPERATIONS:
|
|
THE FIRST ARGUMENT IS IN ARG (ARGEXP,HO,MO,LO AND ARGSGN).
|
|
THE SECOND ARGUMENT IS IN THE FAC.
|
|
THE RESULT IS LEFT IN THE FAC.
|
|
|
|
THE "T" ENTRY POINTS TO THE TWO-ARGUMENT OPERATIONS HAVE BOTH ARGUMENTS
|
|
SETUP IN THE RESPECTIVE REGISTERS. BEFORE CALLING ARG MAY HAVE BEEN
|
|
POPPED OFF THE STACK AND INTO ARG, FOR EXAMPLE.
|
|
THE OTHER ENTRY POINT ASSUMES [Y,A] POINTS TO THE ARGUMENT
|
|
SOMEWHERE IN MEMORY. IT IS UNPACKED INTO ARG BY "CONUPK".
|
|
|
|
ON THE STACK, THE SGN IS PUSHED ON FIRST, THE LO,MO,HO AND FINALLY EXP.
|
|
NOTE ALL THINGS ARE KEPT UNPACKED IN ARG, FAC AND ON THE STACK.
|
|
|
|
IT IS ONLY WHEN SOMETHING IS STORED AWAY THAT IT IS PACKED TO FOUR
|
|
BYTES. THE UNPACKED FORMAT HAS A SGN BYTE REFLECTING THE SIGN OF THE
|
|
NUMBER (POSITIVE=0, NEGATIVE=-1) A HO,MO AND LO WITH THE HIGH BIT
|
|
OF THE HO TURNED ON. THE EXP IS THE SAME AS STORED FORMAT.
|
|
THIS IS DONE FOR SPEED OF OPERATION.
|
|
%
|
|
PAGE
|
|
SUBTTL FLOATING POINT ADDITION AND SUBTRACTION.
|
|
FADDH: LDWDI FHALF ;ENTRY TO ADD 1/2.
|
|
JMP FADD ;UNPACK AND GO ADD IT.
|
|
FSUB: JSR CONUPK ;UNPACK ARGUMENT INTO ARG.
|
|
FSUBT: LDA FACSGN
|
|
EORI 377 ;COMPLEMENT IT.
|
|
STA FACSGN
|
|
EOR ARGSGN ;COMPLEMENT ARISGN.
|
|
STA ARISGN
|
|
LDA FACEXP ;SET CODES ON FACEXP.
|
|
JMP FADDT ;[Y]=ARGEXP..
|
|
XLIST
|
|
.XCREF
|
|
IFN REALIO-3,<ZSTORDO=STORDO>
|
|
IFE REALIO-3,<
|
|
ZSTORD:! LDA POKER
|
|
CMPI 146
|
|
BNE STORDO
|
|
LDA POKER+1
|
|
SBCI 31
|
|
BNE STORDO
|
|
STA POKER
|
|
TAY
|
|
LDAI 200
|
|
STA POKER+1
|
|
MRCHKR: LDXI 12
|
|
IF1,<
|
|
MRCHR: LDA 60000,X,>
|
|
IF2,<
|
|
MRCHR: LDA SINCON+36,X,>
|
|
ANDI 77
|
|
STADY POKER
|
|
INY
|
|
BNE PKINC
|
|
INC POKER+1
|
|
PKINC: DEX
|
|
BNE MRCHR
|
|
DEC ANDMSK
|
|
BNE MRCHKR
|
|
RTS
|
|
IF2,<PURGE ZSTORD>>
|
|
.CREF
|
|
LIST
|
|
FADD5: JSR SHIFTR ;DO A LONG SHIFT.
|
|
BCC FADD4 ;CONTINUE WITH ADDITION.
|
|
FADD: JSR CONUPK
|
|
FADDT: JEQ MOVFA ;IF FAC=0, RESULT IS IN ARG.
|
|
LDX FACOV
|
|
STX OLDOV
|
|
LDXI ARGEXP ;DEFAULT IS SHIFT ARGUMENT.
|
|
LDA ARGEXP ;IF ARG=0, FAC IS RESULT.
|
|
FADDC: TAY ;ALSO COPY ACCA INTO ACCY.
|
|
BEQ ZERRTS ;RETURN.
|
|
SEC
|
|
SBC FACEXP
|
|
BEQ FADD4 ;NO SHIFTING.
|
|
BCC FADDA ;BR IF ARGEXP.LT.FACEXP.
|
|
STY FACEXP ;RESULTING EXPONENT.
|
|
LDY ARGSGN ;SINCE ARG IS BIGGER, IT'S
|
|
STY FACSGN ;SIGN IS SIGN OF RESULT.
|
|
EORI 377 ;SHIFT A NEGATIVE NUMBER OF PLACES.
|
|
ADCI 0 ;COMPLETE NEGATION. W/ C=1.
|
|
LDYI 0 ;ZERO OLDOV.
|
|
STY OLDOV
|
|
LDXI FAC ;SHIFT THE FAC INSTEAD.
|
|
BNE FADD1
|
|
FADDA: LDYI 0
|
|
STY FACOV
|
|
FADD1: CMPI ^D256-7 ;FOR SPEED AND NECESSITY. GETS
|
|
;MOST LIKELY CASE TO SHIFTR FASTEST
|
|
;AND ALLOWS SHIFTING OF NEG NUMS
|
|
;BY "QINT".
|
|
BMI FADD5 ;SHIFT BIG.
|
|
TAY
|
|
LDA FACOV ;SET FACOV.
|
|
LSR 1,X, ;GETS 0 IN MOST SIG BIT.
|
|
JSR ROLSHF ;DO THE ROLLING.
|
|
FADD4: BIT ARISGN ;GET RESULTING SIGN.
|
|
BPL FADD2 ;IF POSITIVE, ADD.
|
|
;CARRY IS CLEAR.
|
|
FADD3: LDYI FACEXP
|
|
CPXI ARGEXP ;FAC IS BIGGER.
|
|
BEQ SUBIT
|
|
LDYI ARGEXP ;ARG IS BIGGER.
|
|
SUBIT: SEC
|
|
EORI 377
|
|
ADC OLDOV
|
|
STA FACOV
|
|
LDA 3+ADDPRC,Y
|
|
SBC 3+ADDPRC,X
|
|
STA FACLO
|
|
LDA 2+ADDPRC,Y
|
|
SBC 2+ADDPRC,X
|
|
STA FACMO
|
|
IFN ADDPRC,<
|
|
LDA 2,Y
|
|
SBC 2,X
|
|
STA FACMOH>
|
|
LDA 1,Y
|
|
SBC 1,X
|
|
STA FACHO
|
|
FADFLT: BCS NORMAL ;HERE IF SIGNS DIFFER. IF CARRY,
|
|
;FAC IS SET OK.
|
|
JSR NEGFAC ;NEGATE [FAC].
|
|
NORMAL: LDYI 0
|
|
TYA
|
|
CLC
|
|
NORM3: LDX FACHO
|
|
BNE NORM1
|
|
LDX FACHO+1 ;SHIFT 8 BITS AT A TIME FOR SPEED.
|
|
STX FACHO
|
|
IFN ADDPRC,<
|
|
LDX FACMOH+1
|
|
STX FACMOH>
|
|
LDX FACMO+1
|
|
STX FACMO
|
|
LDX FACOV
|
|
STX FACLO
|
|
STY FACOV
|
|
ADCI 10
|
|
CMPI 10*ADDPRC+30
|
|
BNE NORM3
|
|
ZEROFC: LDAI 0 ;NOT NEED BY NORMAL BUT BY OTHERS.
|
|
ZEROF1: STA FACEXP ;NUMBER MUST BE ZERO.
|
|
ZEROML: STA FACSGN ;MAKE SIGN POSITIVE.
|
|
RTS ;ALL DONE.
|
|
FADD2: ADC OLDOV
|
|
STA FACOV
|
|
LDA FACLO
|
|
ADC ARGLO
|
|
STA FACLO
|
|
LDA FACMO
|
|
ADC ARGMO
|
|
STA FACMO
|
|
IFN ADDPRC,<
|
|
LDA FACMOH
|
|
ADC ARGMOH
|
|
STA FACMOH>
|
|
LDA FACHO
|
|
ADC ARGHO
|
|
STA FACHO
|
|
JMP SQUEEZ ;GO ROUND IF SIGNS SAME.
|
|
|
|
NORM2: ADCI 1 ;DECREMENT SHIFT COUNT.
|
|
ASL FACOV ;SHIFT ALL LEFT ONE BIT.
|
|
ROL FACLO
|
|
ROL FACMO
|
|
IFN ADDPRC,<
|
|
ROL FACMOH>
|
|
ROL FACHO
|
|
NORM1: BPL NORM2 ;IF MSB=0 SHIFT AGAIN.
|
|
SEC
|
|
SBC FACEXP
|
|
BCS ZEROFC
|
|
EORI 377
|
|
ADCI 1 ;COMPLEMENT.
|
|
STA FACEXP
|
|
SQUEEZ: BCC RNDRTS ;BITS TO SHIFT?
|
|
RNDSHF: INC FACEXP
|
|
BEQ OVERR
|
|
ROR FACHO
|
|
IFN ADDPRC,<
|
|
ROR FACMOH>
|
|
ROR FACMO
|
|
ROR FACLO
|
|
ROR FACOV
|
|
RNDRTS: RTS ;ALL DONE ADDING.
|
|
|
|
NEGFAC: COM FACSGN ;COMPLEMENT FAC ENTIRELY.
|
|
NEGFCH: COM FACHO ;COMPLEMENT JUST THE NUMBER.
|
|
IFN ADDPRC,<
|
|
COM FACMOH>
|
|
COM FACMO
|
|
COM FACLO
|
|
COM FACOV
|
|
INC FACOV
|
|
BNE INCFRT
|
|
INCFAC: INC FACLO
|
|
BNE INCFRT
|
|
INC FACMO
|
|
BNE INCFRT ;IF NO CARRY, RETURN.
|
|
IFN ADDPRC,<
|
|
INC FACMOH
|
|
BNE INCFRT>
|
|
INC FACHO ;CARRY INCREMENT.
|
|
INCFRT: RTS
|
|
|
|
OVERR: LDXI ERROV
|
|
JMP ERROR ;TELL USER.
|
|
;
|
|
; "SHIFTR" SHIFTS [X+1:X+3] [-ACCA] BITS RIGHT.
|
|
; SHIFTS BYTES TO START WITH IF POSSIBLE.
|
|
;
|
|
MULSHF: LDXI RESHO-1 ;ENTRY POINT FOR MULTIPLIER.
|
|
SHFTR2: LDY 3+ADDPRC,X, ;SHIFT BYTES FIRST.
|
|
STY FACOV
|
|
IFN ADDPRC,<
|
|
LDY 3,X
|
|
STY 4,X>
|
|
LDY 2,X, ;GET MO.
|
|
STY 3,X, ;STORE LO.
|
|
LDY 1,X, ;GET HO.
|
|
STY 2,X, ;STORE MO.
|
|
LDY BITS
|
|
STY 1,X, ;STORE HO.
|
|
SHIFTR: ADCI 10
|
|
BMI SHFTR2
|
|
BEQ SHFTR2
|
|
SBCI 10 ;C CAN BE EITHER 1,0 AND IT WORKS.
|
|
TAY
|
|
LDA FACOV
|
|
BCS SHFTRT ;EQUIV TO BEQ HERE.
|
|
IFN RORSW,<
|
|
SHFTR3: ASL 1,X
|
|
BCC SHFTR4
|
|
INC 1,X
|
|
SHFTR4: ROR 1,X
|
|
ROR 1,X> ;YES, TWO OF THEM.
|
|
IFE RORSW,<
|
|
SHFTR3: PHA
|
|
LDA 1,X
|
|
ANDI 200
|
|
LSR 1,X
|
|
ORA 1,X
|
|
STA 1,X
|
|
SKIP1>
|
|
ROLSHF:
|
|
IFN RORSW,<
|
|
ROR 2,X
|
|
ROR 3,X
|
|
IFN ADDPRC,< ROR 4,X> ;ONE MO TIME.
|
|
>
|
|
IFE RORSW,<
|
|
PHA
|
|
LDAI 0
|
|
BCC SHFTR5
|
|
LDAI 200
|
|
SHFTR5: LSR 2,X
|
|
ORA 2,X
|
|
STA 2,X
|
|
LDAI 0
|
|
BCC SHFTR6
|
|
LDAI 200
|
|
SHFTR6: LSR 3,X
|
|
ORA 3,X
|
|
STA 3,X
|
|
IFN ADDPRC,<
|
|
LDAI 0
|
|
BCC SHFT6A
|
|
LDAI 200
|
|
SHFT6A: LSR 4,X
|
|
ORA 4,X
|
|
STA 4,X>>
|
|
IFN RORSW,<ROR A,> ;ROTATE ARGUMENT 1 BIT RIGHT.
|
|
IFE RORSW,<
|
|
PLA
|
|
PHP
|
|
LSR A,
|
|
PLP
|
|
BCC SHFTR7
|
|
ORAI 200>
|
|
SHFTR7: INY
|
|
BNE SHFTR3 ;$$$ ( MOST EXPENSIVE ! )
|
|
SHFTRT: CLC ;CLEAR OUTPUT OF FACOV.
|
|
RTS
|
|
PAGE
|
|
SUBTTL NATURAL LOG FUNCTION.
|
|
;
|
|
; CALCULATION IS BY:
|
|
; LN(F*2^N)=(N+LOG2(F))*LN(2)
|
|
; AN APPROXIMATION POLYNOMIAL IS USED TO CALCULATE LOG2(F).
|
|
; CONSTANTS USED BY LOG:
|
|
FONE: 201 ; 1.0
|
|
000
|
|
000
|
|
000
|
|
IFN ADDPRC,<0>
|
|
IFE ADDPRC,<
|
|
LOGCN2: 2 ; DEGREE-1
|
|
200 ; 0.59897437
|
|
031
|
|
126
|
|
142
|
|
200 ; 0.96147080
|
|
166
|
|
042
|
|
363
|
|
202 ; 2.88539129
|
|
070
|
|
252
|
|
100>
|
|
|
|
IFN ADDPRC,<
|
|
LOGCN2: 3 ;DEGREE-1
|
|
177 ;.43425594188
|
|
136
|
|
126
|
|
313
|
|
171
|
|
200 ; .57658454134
|
|
023
|
|
233
|
|
013
|
|
144
|
|
200 ; .96180075921
|
|
166
|
|
070
|
|
223
|
|
026
|
|
202 ; 2.8853900728
|
|
070
|
|
252
|
|
073
|
|
040>
|
|
SQRHLF: 200 ; SQR(0.5)
|
|
065
|
|
004
|
|
363
|
|
IFN ADDPRC,<064>
|
|
SQRTWO: 201 ; SQR(2.0)
|
|
065
|
|
004
|
|
363
|
|
IFN ADDPRC,<064>
|
|
NEGHLF: 200 ; -1/2
|
|
200
|
|
000
|
|
000
|
|
IFN ADDPRC,<0>
|
|
LOG2: 200 ; LN(2)
|
|
061
|
|
162
|
|
IFE ADDPRC,<030>
|
|
IFN ADDPRC,<027
|
|
370>
|
|
|
|
LOG: JSR SIGN ;IS IT POSITIVE?
|
|
BEQ LOGERR
|
|
BPL LOG1
|
|
LOGERR: JMP FCERR ;CAN'T TOLERATE NEG OR ZERO.
|
|
LOG1: LDA FACEXP ;GET EXPONENT INTO ACCA.
|
|
SBCI 177 ;REMOVE BIAS. (CARRY IS OFF)
|
|
PHA ;SAVE AWHILE.
|
|
LDAI 200
|
|
STA FACEXP ;RESULT IS FAC IN RANGE [0.5,1].
|
|
LDWDI SQRHLF ;GET POINTER TO SQR(0.5).
|
|
|
|
; CALCULATE (F-SQR(.5))/(F+SQR(.5))
|
|
|
|
JSR FADD ;ADD TO FAC.
|
|
LDWDI SQRTWO ;GET SQR(2.).
|
|
JSR FDIV
|
|
LDWDI FONE
|
|
JSR FSUB
|
|
LDWDI LOGCN2
|
|
JSR POLYX ;EVALUATE APPROXIMATION POLYNOMIAL.
|
|
LDWDI NEGHLF ;ADD IN LAST CONSTANT.
|
|
JSR FADD
|
|
PLA ;GET EXPONENT BACK.
|
|
JSR FINLOG ;ADD IT IN.
|
|
MULLN2: LDWDI LOG2 ;MULTIPLY RESULT BY LOG(2.0).
|
|
; JMP FMULT ;MULTIPLY TOGETHER.
|
|
PAGE
|
|
SUBTTL FLOATING MULTIPLICATION AND DIVISION.
|
|
;MULTIPLICATION FAC:=ARG*FAC.
|
|
FMULT: JSR CONUPK ;UNPACK THE CONSTANT INTO ARG FOR USE.
|
|
FMULTT: JEQ MULTRT ;IF FAC=0, RETURN. FAC IS SET.
|
|
JSR MULDIV ;FIX UP THE EXPONENTS.
|
|
LDAI 0 ;TO CLEAR RESULT.
|
|
STA RESHO
|
|
IFN ADDPRC,<
|
|
STA RESMOH>
|
|
STA RESMO
|
|
STA RESLO
|
|
LDA FACOV
|
|
JSR MLTPLY
|
|
LDA FACLO ;MLTPLY ARG BY FACLO.
|
|
JSR MLTPLY
|
|
LDA FACMO ;MLTPLY ARG BY FACMO.
|
|
JSR MLTPLY
|
|
IFN ADDPRC,<
|
|
LDA FACMOH
|
|
JSR MLTPLY>
|
|
LDA FACHO ;MLTPLY ARG BY FACHO.
|
|
JSR MLTPL1
|
|
JMP MOVFR ;MOVE RESULT INTO FAC,
|
|
;NORMALIZE RESULT, AND RETURN.
|
|
MLTPLY: JEQ MULSHF ;SHIFT RESULT RIGHT 1 BYTE.
|
|
MLTPL1: LSR A,
|
|
ORAI 200
|
|
MLTPL2: TAY
|
|
BCC MLTPL3 ;IT MULT BIT=0, JUST SHIFT.
|
|
CLC
|
|
LDA RESLO
|
|
ADC ARGLO
|
|
STA RESLO
|
|
LDA RESMO
|
|
ADC ARGMO
|
|
STA RESMO
|
|
IFN ADDPRC,<
|
|
LDA RESMOH
|
|
ADC ARGMOH
|
|
STA RESMOH>
|
|
LDA RESHO
|
|
ADC ARGHO
|
|
STA RESHO
|
|
MLTPL3: ROR RESHO
|
|
IFN ADDPRC,<
|
|
ROR RESMOH>
|
|
ROR RESMO
|
|
ROR RESLO
|
|
ROR FACOV ;SAVE FOR ROUNDING.
|
|
TYA
|
|
LSR A, ;CLEAR MSB SO WE GET A CLOSER TO 0.
|
|
BNE MLTPL2 ;SLOW AS A TURTLE !
|
|
MULTRT: RTS
|
|
|
|
;ROUTINE TO UNPACK MEMORY INTO ARG.
|
|
CONUPK: STWD INDEX1
|
|
LDYI 3+ADDPRC
|
|
LDADY INDEX1
|
|
STA ARGLO
|
|
DEY
|
|
LDADY INDEX1
|
|
STA ARGMO
|
|
DEY
|
|
IFN ADDPRC,<
|
|
LDADY INDEX1
|
|
STA ARGMOH
|
|
DEY>
|
|
LDADY INDEX1
|
|
STA ARGSGN
|
|
EOR FACSGN
|
|
STA ARISGN
|
|
LDA ARGSGN
|
|
ORAI 200
|
|
STA ARGHO
|
|
DEY
|
|
LDADY INDEX1
|
|
STA ARGEXP
|
|
LDA FACEXP ;SET CODES OF FACEXP.
|
|
RTS
|
|
|
|
;CHECK SPECIAL CASES AND ADD EXPONENTS FOR FMULT, FDIV.
|
|
MULDIV: LDA ARGEXP ;EXP OF ARG=0?
|
|
MLDEXP: BEQ ZEREMV ;SO WE GET ZERO EXPONENT.
|
|
CLC
|
|
ADC FACEXP ;RESULT IS IN ACCA.
|
|
BCC TRYOFF ;FIND [C] XOR [N].
|
|
BMI GOOVER ;OVERFLOW IF BITS MATCH.
|
|
CLC
|
|
SKIP2
|
|
TRYOFF: BPL ZEREMV ;UNDERFLOW.
|
|
ADCI 200 ;ADD BIAS.
|
|
STA FACEXP
|
|
JEQ ZEROML ;ZERO THE REST OF IT.
|
|
LDA ARISGN
|
|
STA FACSGN ;ARISGN IS RESULT'S SIGN.
|
|
RTS ;DONE.
|
|
MLDVEX: LDA FACSGN ;GET SIGN.
|
|
EORI 377 ;COMPLEMENT IT.
|
|
BMI GOOVER
|
|
ZEREMV: PLA ;GET ADDR OFF STACK.
|
|
PLA
|
|
JMP ZEROFC ;UNDERFLOW.
|
|
GOOVER: JMP OVERR ;OVERFLOW.
|
|
|
|
;MULTIPLY FAC BY 10.
|
|
MUL10: JSR MOVAF ;COPY FAC INTO ARG.
|
|
TAX
|
|
BEQ MUL10R ;IF [FAC]=0, GOT ANSWER.
|
|
CLC
|
|
ADCI 2 ;AUGMENT EXP BY 2.
|
|
BCS GOOVER ;OVERFLOW.
|
|
FINML6: LDXI 0
|
|
STX ARISGN ;SIGNS ARE SAME.
|
|
JSR FADDC ;ADD TOGETHER.
|
|
INC FACEXP ;MULTIPLY BY TWO.
|
|
BEQ GOOVER ;OVERFLOW.
|
|
MUL10R: RTS
|
|
|
|
; DIVIDE FAC BY 10.
|
|
TENZC: 204
|
|
040
|
|
000
|
|
000
|
|
IFN ADDPRC,<0>
|
|
DIV10: JSR MOVAF ;MOVE FAC TO ARG.
|
|
LDWDI TENZC ;POINT TO CONSTANT OF 10.0
|
|
LDXI 0 ;SIGNS ARE BOTH POSITIVE.
|
|
FDIVF: STX ARISGN
|
|
JSR MOVFM ;PUT IT INTO FAC.
|
|
JMP FDIVT ;SKIP OVER NEXT TWO BYTES.
|
|
FDIV: JSR CONUPK ;UNPACK CONSTANT.
|
|
FDIVT: BEQ DV0ERR ;CAN'T DIVIDE BY ZERO !
|
|
;(NOT ENOUGH ROOM TO STORE RESULT.)
|
|
JSR ROUND ;TAKE FACOV INTO ACCT IN FAC.
|
|
LDAI 0 ;NEGATE FACEXP.
|
|
SEC
|
|
SBC FACEXP
|
|
STA FACEXP
|
|
JSR MULDIV ;FIX UP EXPONENTS.
|
|
INC FACEXP ;SCALE IT RIGHT.
|
|
BEQ GOOVER ;OVERFLOW.
|
|
LDXI ^D256-3-ADDPRC ;SETUP PROCEDURE.
|
|
LDAI 1
|
|
DIVIDE: ;THIS IS THE BEST CODE IN THE WHOLE PILE.
|
|
LDY ARGHO ;SEE WHAT RELATION HOLDS.
|
|
CPY FACHO
|
|
BNE SAVQUO ;[C]=0,1. N(C=0)=0.
|
|
IFN ADDPRC,<
|
|
LDY ARGMOH
|
|
CPY FACMOH
|
|
BNE SAVQUO>
|
|
LDY ARGMO
|
|
CPY FACMO
|
|
BNE SAVQUO
|
|
LDY ARGLO
|
|
CPY FACLO
|
|
SAVQUO: PHP
|
|
ROL A, ;SAVE RESULT.
|
|
BCC QSHFT ;IF NOT DONE, CONTINUE.
|
|
INX
|
|
STA RESLO,X
|
|
BEQ LD100
|
|
BPL DIVNRM ;NOTE THIS REQ 1 MO RAM THEN NECESS.
|
|
LDAI 1
|
|
QSHFT: PLP ;RETURN CONDITION CODES.
|
|
BCS DIVSUB ;FAC .LE. ARG.
|
|
SHFARG: ASL ARGLO ;SHIFT ARG ONE PLACE LEFT.
|
|
ROL ARGMO
|
|
IFN ADDPRC,<
|
|
ROL ARGMOH>
|
|
ROL ARGHO
|
|
BCS SAVQUO ;SAVE A RESULT OF ONE FOR THIS POSITION
|
|
;AND DIVIDE.
|
|
BMI DIVIDE ;IF MSB ON, GO DECIDE WHETHER TO SUB.
|
|
BPL SAVQUO
|
|
DIVSUB: TAY ;NOTICE C MUST BE ON HERE.
|
|
LDA ARGLO
|
|
SBC FACLO
|
|
STA ARGLO
|
|
LDA ARGMO
|
|
SBC FACMO
|
|
STA ARGMO
|
|
IFN ADDPRC,<
|
|
LDA ARGMOH
|
|
SBC FACMOH
|
|
STA ARGMOH>
|
|
LDA ARGHO
|
|
SBC FACHO
|
|
STA ARGHO
|
|
TYA
|
|
JMP SHFARG
|
|
LD100: LDAI 100 ;ONLY WANT TWO MORE BITS.
|
|
BNE QSHFT ;ALWAYS BRANCHES.
|
|
DIVNRM: REPEAT 6,<ASL A> ;GET LAST TWO BITS INTO MSB AND B6.
|
|
STA FACOV
|
|
PLP ;TO GET GARBAGE OFF STACK.
|
|
JMP MOVFR ;MOVE RESULT INTO FAC, THEN
|
|
;NORMALIZE RESULT AND RETURN.
|
|
DV0ERR: LDXI ERRDV0
|
|
JMP ERROR
|
|
PAGE
|
|
SUBTTL FLOATING POINT MOVEMENT ROUTINES.
|
|
;MOVE RESULT TO FAC.
|
|
MOVFR: LDA RESHO
|
|
STA FACHO
|
|
IFN ADDPRC,<
|
|
LDA RESMOH
|
|
STA FACMOH>
|
|
LDA RESMO
|
|
STA FACMO
|
|
LDA RESLO ;MOVE LO AND SGN.
|
|
STA FACLO
|
|
JMP NORMAL ;ALL DONE.
|
|
|
|
;MOVE MEMORY INTO FAC (UNPACKED).
|
|
MOVFM: STWD INDEX1
|
|
LDYI 3+ADDPRC
|
|
LDADY INDEX1
|
|
STA FACLO
|
|
DEY
|
|
LDADY INDEX1
|
|
STA FACMO
|
|
DEY
|
|
IFN ADDPRC,<
|
|
LDADY INDEX1
|
|
STA FACMOH
|
|
DEY>
|
|
LDADY INDEX1
|
|
STA FACSGN
|
|
ORAI 200
|
|
STA FACHO
|
|
DEY
|
|
LDADY INDEX1
|
|
STA FACEXP ;LEAVE SWITCHES SET ON EXP.
|
|
STY FACOV
|
|
RTS
|
|
|
|
;MOVE NUMBER FROM FAC TO MEMORY.
|
|
MOV2F: LDXI TEMPF2
|
|
SKIP2
|
|
MOV1F: LDXI TEMPF1
|
|
MOVML: LDYI 0
|
|
BEQ MOVMF ;ALWAYS BRANCHES.
|
|
MOVVF: LDXY FORPNT
|
|
MOVMF: JSR ROUND
|
|
STXY INDEX1
|
|
LDYI 3+ADDPRC
|
|
LDA FACLO
|
|
STADY INDEX
|
|
DEY
|
|
LDA FACMO
|
|
STADY INDEX
|
|
DEY
|
|
IFN ADDPRC,<
|
|
LDA FACMOH
|
|
STADY INDEX
|
|
DEY>
|
|
LDA FACSGN ;INCLUDE SIGN IN HO.
|
|
ORAI 177
|
|
AND FACHO
|
|
STADY INDEX
|
|
DEY
|
|
LDA FACEXP
|
|
STADY INDEX
|
|
STY FACOV ;ZERO IT SINCE ROUNDED.
|
|
RTS ;[Y]=0.
|
|
|
|
;MOVE ARG INTO FAC.
|
|
MOVFA: LDA ARGSGN
|
|
MOVFA1: STA FACSGN
|
|
LDXI 4+ADDPRC
|
|
MOVFAL: LDA ARGEXP-1,X
|
|
STA FACEXP-1,X
|
|
DEX
|
|
BNE MOVFAL
|
|
STX FACOV
|
|
RTS
|
|
|
|
;MOVE FAC INTO ARG.
|
|
MOVAF: JSR ROUND
|
|
MOVEF: LDXI 5+ADDPRC
|
|
MOVAFL: LDA FACEXP-1,X
|
|
STA ARGEXP-1,X
|
|
DEX
|
|
BNE MOVAFL
|
|
STX FACOV ;ZERO IT SINCE ROUNDED.
|
|
MOVRTS: RTS
|
|
|
|
ROUND: LDA FACEXP ;ZERO?
|
|
BEQ MOVRTS ;YES. DONE ROUNDING.
|
|
ASL FACOV ;ROUND?
|
|
BCC MOVRTS ;NO. MSB OFF.
|
|
INCRND: JSR INCFAC ;YES, ADD ONE TO LSB(FAC).
|
|
BNE MOVRTS ;NO CARRY MEANS DONE.
|
|
JMP RNDSHF ;SQUEEZ MSB IN AND RTS.
|
|
;NOTE [C]=1 SINCE INCFAC DOESNT TOUCH C.
|
|
PAGE
|
|
SUBTTL SIGN, SGN, FLOAT, NEG, ABS.
|
|
|
|
;PUT SIGN OF FAC IN ACCA.
|
|
SIGN: LDA FACEXP
|
|
BEQ SIGNRT ;IF NUMBER IS ZERO, SO IS RESULT.
|
|
FCSIGN: LDA FACSGN
|
|
FCOMPS: ROL A
|
|
LDAI ^O377 ;ASSUME NEGATIVE.
|
|
BCS SIGNRT
|
|
LDAI 1 ;GET +1.
|
|
SIGNRT: RTS
|
|
|
|
;SGN FUNCTION.
|
|
SGN: JSR SIGN
|
|
|
|
;FLOAT THE SIGNED INTEGER IN ACCA.
|
|
FLOAT: STA FACHO ;PUT [ACCA] IN HIGH ORDER.
|
|
LDAI 0
|
|
STA FACHO+1
|
|
LDXI 210 ;GET THE EXPONENT.
|
|
|
|
;FLOAT THE SIGNED NUMBER IN FAC.
|
|
FLOATS: LDA FACHO
|
|
EORI 377
|
|
ROL A, ;GET COMP OF SIGN IN CARRY.
|
|
FLOATC: LDAI 0 ;ZERO [ACCA] BUT NOT CARRY.
|
|
STA FACLO
|
|
IFN ADDPRC,<
|
|
STA FACMO>
|
|
FLOATB: STX FACEXP
|
|
STA FACOV
|
|
STA FACSGN
|
|
JMP FADFLT
|
|
|
|
;ABSOLUTE VALUE OF FAC.
|
|
ABS: LSR FACSGN
|
|
RTS
|
|
|
|
PAGE
|
|
SUBTTL COMPARE TWO NUMBERS.
|
|
;A=1 IF ARG .LT. FAC.
|
|
;A=0 IF ARG=FAC.
|
|
;A=-1 IF ARG .GT. FAC.
|
|
FCOMP: STA INDEX2
|
|
FCOMPN: STY INDEX2+1
|
|
LDYI 0
|
|
LDADY INDEX2 ;HAS ARGEXP.
|
|
INY ;BUMP PNTR UP.
|
|
TAX ;SAVE A IN X AND RESET CODES.
|
|
BEQ SIGN
|
|
LDADY INDEX2
|
|
EOR FACSGN ;SIGNS THE SAME.
|
|
BMI FCSIGN ;SIGNS DIFFER SO RESULT IS
|
|
;SIGN OF FAC AGAIN.
|
|
FOUTCP: CPX FACEXP
|
|
BNE FCOMPC
|
|
LDADY INDEX2
|
|
ORAI 200
|
|
CMP FACHO
|
|
BNE FCOMPC
|
|
INY
|
|
IFN ADDPRC,<
|
|
LDADY INDEX2
|
|
CMP FACMOH
|
|
BNE FCOMPC
|
|
INY>
|
|
LDADY INDEX2
|
|
CMP FACMO
|
|
BNE FCOMPC
|
|
INY
|
|
LDAI 177
|
|
CMP FACOV
|
|
LDADY INDEX2
|
|
SBC FACLO ;GET ZERO IF EQUAL.
|
|
BEQ QINTRT
|
|
FCOMPC: LDA FACSGN
|
|
BCC FCOMPD
|
|
EORI 377
|
|
FCOMPD: JMP FCOMPS ;A PART OF SIGN SETS ACCA UP.
|
|
|
|
PAGE
|
|
SUBTTL GREATEST INTEGER FUNCTION.
|
|
;QUICK GREATEST INTEGER FUNCTION.
|
|
;LEAVES INT(FAC) IN FACHO&MO&LO SIGNED.
|
|
;ASSUMES FAC .LT. 2^23 = 8388608
|
|
QINT: LDA FACEXP
|
|
BEQ CLRFAC ;IF ZERO, GOT IT.
|
|
SEC
|
|
SBCI 8*ADDPRC+230 ;GET NUMBER OF PLACES TO SHIFT.
|
|
BIT FACSGN
|
|
BPL QISHFT
|
|
TAX
|
|
LDAI 377
|
|
STA BITS ;PUT 377 IN WHEN SHFTR SHIFTS BYTES.
|
|
JSR NEGFCH ;TRULY NEGATE QUANTITY IN FAC.
|
|
TXA
|
|
QISHFT: LDXI FAC
|
|
CMPI ^D256-7
|
|
BPL QINT1 ;IF NUMBER OF PLACES .GE. 7
|
|
;SHIFT 1 PLACE AT A TIME.
|
|
JSR SHIFTR ;START SHIFTING BYTES, THEN BITS.
|
|
STY BITS ;ZERO BITS SINCE ADDER WANTS ZERO.
|
|
QINTRT: RTS
|
|
QINT1: TAY ;PUT COUNT IN COUNTER.
|
|
LDA FACSGN
|
|
ANDI 200 ;GET SIGN BIT.
|
|
LSR FACHO ;SAVE FIRST SHIFTED BYTE.
|
|
ORA FACHO
|
|
STA FACHO
|
|
JSR ROLSHF ;SHIFT THE REST.
|
|
STY BITS ;ZERO [BITS].
|
|
RTS
|
|
|
|
;GREATEST INTEGER FUNCTION.
|
|
INT: LDA FACEXP
|
|
CMPI 8*ADDPRC+230
|
|
BCS INTRTS ;FORGET IT.
|
|
JSR QINT
|
|
STY FACOV ;CLR OVERFLOW BYTE.
|
|
LDA FACSGN
|
|
STY FACSGN ;MAKE FAC LOOK POSITIVE.
|
|
EORI 200 ;GET COMPLEMENT OF SIGN IN CARRY.
|
|
ROL A,
|
|
LDAI 8*ADDPRC+230
|
|
STA FACEXP
|
|
LDA FACLO
|
|
STA INTEGR
|
|
JMP FADFLT
|
|
CLRFAC: STA FACHO ;MAKE IT REALLY ZERO.
|
|
IFN ADDPRC,<STA FACMOH>
|
|
STA FACMO
|
|
STA FACLO
|
|
TAY
|
|
INTRTS: RTS
|
|
PAGE
|
|
SUBTTL FLOATING POINT INPUT ROUTINE.
|
|
;NUMBER INPUT IS LEFT IN FAC.
|
|
;AT ENTRY [TXTPTR] POINTS TO THE FIRST CHARACTER IN A TEXT BUFFER.
|
|
;THE FIRST CHARACTER IS ALSO IN ACCA. FIN PACKS THE DIGITS
|
|
;INTO THE FAC AS AN INTEGER AND KEEPS TRACK OF WHERE THE
|
|
;DECIMAL POINT IS. [DPTFLG] TELL WHETHER A DP HAS BEEN
|
|
;SEEN. [DECCNT] IS THE NUMBER OF DIGITS AFTER THE DP.
|
|
;AT THE END [DECCNT] AND THE EXPONENT ARE USED TO
|
|
;DETERMINE HOW MANY TIMES TO MULTIPLY OR DIVIDE BY TEN
|
|
;TO GET THE CORRECT NUMBER.
|
|
FIN: LDYI 0 ;ZERO FACSGN&SGNFLG.
|
|
LDXI 11+ADDPRC ;ZERO EXP AND HO (AND MOH).
|
|
FINZLP: STY DECCNT,X ;ZERO MO AND LO.
|
|
DEX ;ZERO TENEXP AND EXPSGN
|
|
BPL FINZLP ;ZERO DECCNT, DPTFLG.
|
|
BCC FINDGQ ;FLAGS STILL SET FROM CHRGET.
|
|
CMPI "-" ;A NEGATIVE SIGN?
|
|
BNE QPLUS ;NO, TRY PLUS SIGN.
|
|
STX SGNFLG ;IT'S NEGATIVE. (X=377).
|
|
BEQ FINC ;ALWAYS BRANCHES.
|
|
QPLUS: CMPI "+" ;PLUS SIGN?
|
|
BNE FIN1 ;YES, SKIP IT.
|
|
FINC: JSR CHRGET
|
|
FINDGQ: BCC FINDIG
|
|
FIN1: CMPI "." ;THE DP?
|
|
BEQ FINDP ;NO KIDDING.
|
|
CMPI "E" ;EXPONENT FOLLOWS.
|
|
BNE FINE ;NO.
|
|
;HERE TO CHECK FOR SIGN OF EXP.
|
|
JSR CHRGET ;YES. GET ANOTHER.
|
|
BCC FNEDG1 ;IT IS A DIGIT. (EASIER THAN
|
|
;BACKING UP POINTER.)
|
|
CMPI MINUTK ;MINUS?
|
|
BEQ FINEC1 ;NEGATE.
|
|
CMPI "-" ;MINUS SIGN?
|
|
BEQ FINEC1
|
|
CMPI PLUSTK ;PLUS?
|
|
BEQ FINEC
|
|
CMPI "+" ;PLUS SIGN?
|
|
BEQ FINEC
|
|
BNE FINEC2
|
|
FINEC1: ROR EXPSGN ;TURN IT ON.
|
|
FINEC: JSR CHRGET ;GET ANOTHER.
|
|
FNEDG1: BCC FINEDG ;IT IS A DIGIT.
|
|
FINEC2: BIT EXPSGN
|
|
BPL FINE
|
|
LDAI 0
|
|
SEC
|
|
SBC TENEXP
|
|
JMP FINE1
|
|
FINDP: ROR DPTFLG
|
|
BIT DPTFLG
|
|
BVC FINC
|
|
FINE: LDA TENEXP
|
|
FINE1: SEC
|
|
SBC DECCNT ;GET NUMBER OF PLACES TO SHIFT.
|
|
STA TENEXP
|
|
BEQ FINQNG ;NEGATE?
|
|
BPL FINMUL ;POSITIVE SO MULTIPLY.
|
|
FINDIV: JSR DIV10
|
|
INC TENEXP ;DONE?
|
|
BNE FINDIV ;NO.
|
|
BEQ FINQNG ;YES.
|
|
FINMUL: JSR MUL10
|
|
DEC TENEXP ;DONE?
|
|
BNE FINMUL ;NO
|
|
FINQNG: LDA SGNFLG
|
|
BMI NEGXQS ;IF POSITIVE, RETURN.
|
|
RTS
|
|
NEGXQS: JMP NEGOP ;OTHERWISE, NEGATE AND RETURN.
|
|
|
|
FINDIG: PHA
|
|
BIT DPTFLG
|
|
BPL FINDG1
|
|
INC DECCNT
|
|
FINDG1: JSR MUL10
|
|
PLA ;GET IT BACK.
|
|
SEC
|
|
SBCI "0"
|
|
JSR FINLOG ;ADD IT IN.
|
|
JMP FINC
|
|
|
|
FINLOG: PHA
|
|
JSR MOVAF ;SAVE FAC FOR LATER.
|
|
PLA
|
|
JSR FLOAT ;FLOAT THE VALUE IN ACCA.
|
|
LDA ARGSGN
|
|
EOR FACSGN
|
|
STA ARISGN ;RESULTANT SIGN.
|
|
LDX FACEXP ;SET SIGNS ON THING TO ADD.
|
|
JMP FADDT ;ADD TOGETHER AND RETURN.
|
|
|
|
;HERE PACK IN THE NEXT DIGIT OF THE EXPONENT.
|
|
;MULTIPLY THE OLD EXP BY 10 AND ADD IN THE NEXT
|
|
;DIGIT. NOTE: EXP OVERFLOW IS NOT CHECKED FOR.
|
|
FINEDG: LDA TENEXP ;GET EXP SO FAR.
|
|
CMPI 12 ;WILL RESULT BE .GE. 100?
|
|
BCC MLEX10
|
|
LDAI 144 ;GET 100.
|
|
BIT EXPSGN
|
|
BMI MLEXMI ;IF NEG EXP, NO CHK FOR OVERR.
|
|
JMP OVERR
|
|
MLEX10: ASL A, ;MULT BY 2 TWICE
|
|
ASL A
|
|
CLC ;POSSIBLE SHIFT OUT OF HIGH.
|
|
ADC TENEXP ;LIKE MULTIPLYING BY FIVE.
|
|
ASL A, ;AND NOW BY TEN.
|
|
CLC
|
|
LDYI 0
|
|
ADCDY TXTPTR
|
|
SEC
|
|
SBCI "0"
|
|
MLEXMI: STA TENEXP ;SAVE RESULT.
|
|
JMP FINEC
|
|
PAGE
|
|
SUBTTL FLOATING POINT OUTPUT ROUTINE.
|
|
|
|
IFE ADDPRC,<
|
|
NZ0999: 221 ; 99999.9499
|
|
103
|
|
117
|
|
370
|
|
NZ9999: 224 ; 999999.499
|
|
164
|
|
043
|
|
367
|
|
NZMIL: 224 ; 10^6.
|
|
164
|
|
044
|
|
000>
|
|
IFN ADDPRC,<
|
|
NZ0999: 233 ; 99999999.9499
|
|
076
|
|
274
|
|
037
|
|
375
|
|
NZ9999: 236 ; 999999999.499
|
|
156
|
|
153
|
|
047
|
|
375
|
|
NZMIL: 236 ; 10^9
|
|
156
|
|
153
|
|
050
|
|
000>
|
|
;ENTRY TO LINPRT.
|
|
INPRT: LDWDI INTXT
|
|
JSR STROU2
|
|
LDA CURLIN+1
|
|
LDX CURLIN
|
|
LINPRT: STWX FACHO
|
|
LDXI 220 ;EXPONENT OF 16.
|
|
SEC ;NUMBER IS POSITIVE.
|
|
JSR FLOATC
|
|
JSR FOUT
|
|
STROU2: JMP STROUT ;PRINT AND RETURN.
|
|
|
|
FOUT: LDYI 1
|
|
FOUTC: LDAI " " ;PRINT SPACE IF POSITIVE.
|
|
BIT FACSGN
|
|
BPL FOUT1
|
|
LDAI "-"
|
|
FOUT1: STA FBUFFR-1,Y, ;STORE THE CHARACTER.
|
|
STA FACSGN ;MAKE FAC POS FOR QINT.
|
|
STY FBUFPT ;SAVE FOR LATER.
|
|
INY
|
|
LDAI "0" ;GET ZERO TO TYPE IF FAC=0.
|
|
LDX FACEXP
|
|
JEQ FOUT19
|
|
LDAI 0
|
|
CPXI 200 ;IS NUMBER .LT. 1.0 ?
|
|
BEQ FOUT37 ;NO.
|
|
BCS FOUT7
|
|
FOUT37: LDWDI NZMIL ;MULTIPLY BY 10^6.
|
|
JSR FMULT
|
|
LDAI ^D256-3*ADDPRC-6
|
|
FOUT7: STA DECCNT ;SAVE COUNT OR ZERO IT.
|
|
FOUT4: LDWDI NZ9999
|
|
JSR FCOMP ;IS NUMBER .GT. 999999.499 ?
|
|
;OR 999999999.499?
|
|
BEQ BIGGES
|
|
BPL FOUT9 ;YES. MAKE IT SMALLER.
|
|
FOUT3: LDWDI NZ0999
|
|
JSR FCOMP ;IS NUMBER .GT. 99999.9499 ?
|
|
; OR 99999999.9499?
|
|
BEQ FOUT38
|
|
BPL FOUT5 ;YES. DONE MULTIPLYING.
|
|
FOUT38: JSR MUL10 ;MAKE IT BIGGER.
|
|
DEC DECCNT
|
|
BNE FOUT3 ;SEE IF THAT DOES IT.
|
|
;THIS ALWAYS GOES.
|
|
FOUT9: JSR DIV10 ;MAKE IT SMALLER.
|
|
INC DECCNT
|
|
BNE FOUT4 ;SEE IF THAT DOES IT.
|
|
;THIS ALWAYS GOES.
|
|
|
|
FOUT5: JSR FADDH ;ADD A HALF TO ROUND UP.
|
|
BIGGES: JSR QINT
|
|
LDXI 1 ;DECIMAL POINT COUNT.
|
|
LDA DECCNT
|
|
CLC
|
|
ADCI 3*ADDPRC+7 ;SHOULD NUMBER BE PRINTED IN E NOTATION?
|
|
;IE, IS NUMBER .LT. .01 ?
|
|
BMI FOUTPI ;YES.
|
|
CMPI 3*ADDPRC+10 ;IS IT .GT. 999999 (999999999)?
|
|
BCS FOUT6 ;YES. USE E NOTATION.
|
|
ADCI ^O377 ;NUMBER OF PLACES BEFORE DECIMAL POINT.
|
|
TAX ;PUT INTO ACCX.
|
|
LDAI 2 ;NO E NOTATION.
|
|
FOUTPI: SEC
|
|
FOUT6: SBCI 2 ;EFFECTIVELY ADD 5 TO ORIG EXP.
|
|
STA TENEXP ;THAT IS THE EXPONENT TO PRINT.
|
|
STX DECCNT ;NUMBER OF DECIMAL PLACES.
|
|
TXA
|
|
BEQ FOUT39
|
|
BPL FOUT8 ;SOME PLACES BEFORE DEC PNT.
|
|
FOUT39: LDY FBUFPT ;GET POINTER TO OUTPUT.
|
|
LDAI "." ;PUT IN "."
|
|
INY
|
|
STA FBUFFR-1,Y
|
|
TXA
|
|
BEQ FOUT16
|
|
LDAI "0" ;GET THE ENSUING ZERO.
|
|
INY
|
|
STA FBUFFR-1,Y
|
|
FOUT16: STY FBUFPT ;SAVE FOR LATER.
|
|
FOUT8: LDYI 0
|
|
FOUTIM: LDXI 200 ;FIRST PASS THRU, ACCX HAS MSB SET.
|
|
FOUT2: LDA FACLO
|
|
CLC
|
|
ADC FOUTBL+2+ADDPRC,Y
|
|
STA FACLO
|
|
LDA FACMO
|
|
ADC FOUTBL+1+ADDPRC,Y
|
|
STA FACMO
|
|
IFN ADDPRC,<
|
|
LDA FACMOH
|
|
ADC FOUTBL+1,Y
|
|
STA FACMOH>
|
|
LDA FACHO
|
|
ADC FOUTBL,Y
|
|
STA FACHO
|
|
INX ;IT WAS DONE YET ANOTHER TIME.
|
|
BCS FOUT41
|
|
BPL FOUT2
|
|
BMI FOUT40
|
|
FOUT41: BMI FOUT2
|
|
FOUT40: TXA
|
|
BCC FOUTYP ;CAN USE ACCA AS IS.
|
|
EORI 377 ;FIND 11.-[A].
|
|
ADCI 12 ;C IS STILL ON TO COMPLETE NEGATION.
|
|
;AND WILL ALWAYS BE ON AFTER.
|
|
FOUTYP: ADCI "0"-1 ;GET A CHARACTER TO PRINT.
|
|
REPEAT 3+ADDPRC,<INY> ;BUMP POINTER UP.
|
|
STY FDECPT
|
|
LDY FBUFPT
|
|
INY ;POINT TO PLACE TO STORE OUTPUT.
|
|
TAX
|
|
ANDI 177 ;GET RID OF MSB.
|
|
STA FBUFFR-1,Y
|
|
DEC DECCNT
|
|
BNE STXBUF ;NOT TIME FOR DP YET.
|
|
LDAI "."
|
|
INY
|
|
STA FBUFFR-1,Y, ;STORE DP.
|
|
STXBUF: STY FBUFPT ;STORE PNTR FOR LATER.
|
|
LDY FDECPT
|
|
FOUTCM: TXA ;COMPLEMENT ACCX
|
|
EORI 377 ;COMPLEMENT ACCA.
|
|
ANDI 200 ;SAVE ONLY MSB.
|
|
TAX
|
|
CPYI FDCEND-FOUTBL
|
|
IFN TIME,<
|
|
BEQ FOULDY
|
|
CPYI TIMEND-FOUTBL>
|
|
BNE FOUT2 ;CONTINUE WITH OUTPUT.
|
|
FOULDY: LDY FBUFPT ;GET BACK OUTPUT PNTR.
|
|
FOUT11: LDA FBUFFR-1,Y, ;REMOVE TRAILING ZEROES.
|
|
DEY
|
|
CMPI "0"
|
|
BEQ FOUT11
|
|
CMPI "."
|
|
BEQ FOUT12 ;RUN INTO DP. STOP.
|
|
INY ;SOMETHING ELSE. SAVE IT.
|
|
FOUT12: LDAI "+"
|
|
LDX TENEXP
|
|
BEQ FOUT17 ;NO EXPONENT TO OUTPUT.
|
|
BPL FOUT14
|
|
LDAI 0
|
|
SEC
|
|
SBC TENEXP
|
|
TAX
|
|
LDAI "-" ;EXPONENT IS NEGATIVE.
|
|
FOUT14: STA FBUFFR-1+2,Y, ;STORE SIGN OF EXP
|
|
LDAI "E"
|
|
STA FBUFFR-1+1,Y, ;STORE THE "E" CHARACTER.
|
|
TXA
|
|
LDXI "0"-1
|
|
SEC
|
|
FOUT15: INX ;MOVE CLOSER TO OUTPUT VALUE.
|
|
SBCI 12 ;SUBTRACT 10.
|
|
BCS FOUT15 ;NOT NEGATIVE YET.
|
|
ADCI "0"+12 ;GET SECOND OUTPUT CHARACTER.
|
|
STA FBUFFR-1+4,Y, ;STORE HIGH DIGIT.
|
|
TXA
|
|
STA FBUFFR-1+3,Y, ;STORE LOW DIGIT.
|
|
LDAI 0 ;PUT IN TERMINATOR.
|
|
STA FBUFFR-1+5,Y,
|
|
BEQA FOUT20 ;RETURN. (ALWAYS BRANCHES).
|
|
FOUT19: STA FBUFFR-1,Y, ;STORE THE CHARACTER.
|
|
FOUT17: LDAI 0 ;A TERMINATOR.
|
|
STA FBUFFR-1+1,Y
|
|
FOUT20: LDWDI FBUFFR
|
|
FPWRRT: RTS ;ALL DONE.
|
|
FHALF: 200 ;1/2
|
|
000
|
|
ZERO: 000
|
|
000
|
|
IFN ADDPRC,<0>
|
|
|
|
;POWER OF TEN TABLE
|
|
IFE ADDPRC,<
|
|
FOUTBL: 376 ;-100000
|
|
171
|
|
140
|
|
000 ;10000
|
|
047
|
|
020
|
|
377 ;-1000
|
|
374
|
|
030
|
|
000 ;100
|
|
000
|
|
144
|
|
377 ;-10
|
|
377
|
|
366
|
|
000 ;1
|
|
000
|
|
001>
|
|
|
|
IFN ADDPRC,<
|
|
FOUTBL: 372 ;-100,000,000
|
|
012
|
|
037
|
|
000
|
|
000 ;10,000,000
|
|
230
|
|
226
|
|
200
|
|
377 ;-1,000,000
|
|
360
|
|
275
|
|
300
|
|
000 ;100,000
|
|
001
|
|
206
|
|
240
|
|
377 ;-10,000
|
|
377
|
|
330
|
|
360
|
|
000 ;1000
|
|
000
|
|
003
|
|
350
|
|
377 ;-100
|
|
377
|
|
377
|
|
234
|
|
000 ;10
|
|
000
|
|
000
|
|
012
|
|
377 ;-1
|
|
377
|
|
377
|
|
377>
|
|
FDCEND:
|
|
IFN TIME,<
|
|
377 ; -2160000 FOR TIME CONVERTER.
|
|
337
|
|
012
|
|
200
|
|
000 ; 216000
|
|
003
|
|
113
|
|
300
|
|
377 ; -36000
|
|
377
|
|
163
|
|
140
|
|
000 ; 3600
|
|
000
|
|
016
|
|
020
|
|
377 ; -600
|
|
377
|
|
375
|
|
250
|
|
000 ; 60
|
|
000
|
|
000
|
|
074
|
|
TIMEND:>
|
|
|
|
PAGE
|
|
SUBTTL EXPONENTIATION AND SQUARE ROOT FUNCTION.
|
|
;SQUARE ROOT FUNCTION --- SQR(A)
|
|
;USE SQR(X)=X^.5
|
|
SQR: JSR MOVAF ;MOVE FAC INTO ARG.
|
|
LDWDI FHALF
|
|
JSR MOVFM ;PUT MEMORY INTO FAC.
|
|
;LAST THING FETCHED IS FACEXP. INTO ACCX.
|
|
; JMP FPWRT ;FALL INTO FPWRT.
|
|
|
|
;EXPONENTIATION --- X^Y.
|
|
;N.B. 0^0=1
|
|
;FIRST CHECK IF Y=0. IF SO, THE RESULT IS 1.
|
|
;NEXT CHECK IF X=0. IF SO THE RESULT IS 0.
|
|
;THEN CHECK IF X.GT.0. IF NOT CHECK THAT Y IS AN INTEGER.
|
|
;IF SO, NEGATE X, SO THAT LOG DOESN'T GIVE FCERR.
|
|
;IF X IS NEGATIVE AND Y IS ODD, NEGATE THE RESULT
|
|
;RETURNED BY EXP.
|
|
;TO COMPUTE THE RESULT USE X^Y=EXP((Y*LOG(X)).
|
|
FPWRT: BEQ EXP ;IF FAC=0, JUST EXPONENTIATE THAT.
|
|
LDA ARGEXP ;IS X=0?
|
|
BNE FPWRT1
|
|
JMP ZEROF1 ;ZERO FAC.
|
|
FPWRT1: LDXYI TEMPF3 ;SAVE FOR LATER IN A TEMP.
|
|
JSR MOVMF
|
|
;Y=0 ALREADY. GOOD IN CASE NO ONE CALLS INT.
|
|
LDA ARGSGN
|
|
BPL FPWR1 ;NO PROBLEMS IF X.GT.0.
|
|
JSR INT ;INTEGERIZE THE FAC.
|
|
LDWDI TEMPF3 ;GET ADDR OF COMPERAND.
|
|
JSR FCOMP ;EQUAL?
|
|
BNE FPWR1 ;LEAVE X NEG. LOG WILL BLOW HIM OUT.
|
|
;A=-1 AND Y IS IRRELEVANT.
|
|
TYA ;NEGATE X. MAKE POSITIVE.
|
|
LDY INTEGR ;GET EVENNESS.
|
|
FPWR1: JSR MOVFA1 ;ALTERNATE ENTRY POINT.
|
|
TYA
|
|
PHA ;SAVE EVENNESS FOR LATER.
|
|
JSR LOG ;FIND LOG.
|
|
LDWDI TEMPF3 ;MULTIPLY FAC TIMES LOG(X).
|
|
JSR FMULT
|
|
JSR EXP ;EXPONENTIATE THE FAC.
|
|
PLA
|
|
LSR A, ;IS IT EVEN?
|
|
BCC NEGRTS ;YES. OR X.GT.0.
|
|
;NEGATE THE NUMBER IN FAC.
|
|
NEGOP: LDA FACEXP
|
|
BEQ NEGRTS
|
|
COM FACSGN
|
|
NEGRTS: RTS
|
|
|
|
PAGE
|
|
SUBTTL EXPONENTIATION FUNCTION.
|
|
;FIRST SAVE THE ORIGINAL ARGUMENT AND MULTIPLY THE FAC BY
|
|
;LOG2(E). THE RESULT IS USED TO DETERMINE IF OVERFLOW
|
|
;WILL OCCUR SINCE EXP(X)=2^(X*LOG2(E)) WHERE
|
|
;LOG2(E)=LOG(E) BASE 2. THEN SAVE THE INTEGER PART OF
|
|
;THIS TO SCALE THE ANSWER AT THE END. SINCE
|
|
;2^Y=2^INT(Y)*2^(Y-INT(Y)) AND 2^INT(Y) IS EASY TO COMPUTE.
|
|
;NOW COMPUTE 2^(X*LOG2(E)-INT(X*LOG2(E)) BY
|
|
;P(LN(2)*(INT(X*LOG2(E))+1)-X) WHERE P IS AN APPROXIMATION
|
|
;POLYNOMIAL. THE RESULT IS THEN SCALED BY THE POWER OF 2
|
|
;PREVIOUSLY SAVED.
|
|
|
|
LOGEB2: 201 ;LOG(E) BASE 2.
|
|
070
|
|
252
|
|
073
|
|
IFN ADDPRC,<051>
|
|
|
|
ife addprc,<
|
|
expcon: 6 ; degree -1.
|
|
164 ; .00021702255
|
|
143
|
|
220
|
|
214
|
|
167 ; .0012439688
|
|
043
|
|
014
|
|
253
|
|
172 ; .0096788410
|
|
036
|
|
224
|
|
000
|
|
174 ; .055483342
|
|
143
|
|
102
|
|
200
|
|
176 ; .24022984
|
|
165
|
|
376
|
|
320
|
|
200 ; .69314698
|
|
061
|
|
162
|
|
025
|
|
201 ; 1.0
|
|
000
|
|
000
|
|
000>
|
|
|
|
|
|
IFN ADDPRC,<
|
|
EXPCON: 7 ;DEGREE-1
|
|
161 ; .000021498763697
|
|
064
|
|
130
|
|
076
|
|
126
|
|
164 ; .00014352314036
|
|
026
|
|
176
|
|
263
|
|
033
|
|
167 ; .0013422634824
|
|
057
|
|
356
|
|
343
|
|
205
|
|
172 ; .0096140170119
|
|
035
|
|
204
|
|
034
|
|
052
|
|
174 ; .055505126860
|
|
143
|
|
131
|
|
130
|
|
012
|
|
176 ; .24022638462
|
|
165
|
|
375
|
|
347
|
|
306
|
|
200 ; .69314718608
|
|
061
|
|
162
|
|
030
|
|
020
|
|
201 ; 1.0
|
|
000
|
|
000
|
|
000
|
|
000>
|
|
|
|
EXP:
|
|
LDWDI LOGEB2 ;MULTIPLY BY LOG(E) BASE 2.
|
|
JSR FMULT
|
|
LDA FACOV
|
|
ADCI 120
|
|
BCC STOLD
|
|
JSR INCRND
|
|
STOLD: STA OLDOV
|
|
JSR MOVEF ;TO SAVE IN ARG WITHOUT ROUND.
|
|
LDA FACEXP
|
|
CMPI 210 ;IF ABS(FAC) .GE. 128, TOO BIG.
|
|
BCC EXP1
|
|
GOMLDV: JSR MLDVEX ;OVERFLOW OR OVERFLOW.
|
|
EXP1: JSR INT
|
|
LDA INTEGR ;GET LOW PART.
|
|
CLC
|
|
ADCI 201
|
|
BEQ GOMLDV ;OVERFLOW OR OVERFLOW !!
|
|
SEC
|
|
SBCI 1 ;SUBTRACT 1.
|
|
PHA ;SAVE A WHILE.
|
|
LDXI 4+ADDPRC ;PREP TO SWAP FAC AND ARG.
|
|
SWAPLP: LDA ARGEXP,X
|
|
LDY FACEXP,X
|
|
STA FACEXP,X
|
|
STY ARGEXP,X
|
|
DEX
|
|
BPL SWAPLP
|
|
LDA OLDOV
|
|
STA FACOV
|
|
JSR FSUBT
|
|
JSR NEGOP ;NEGATE FAC.
|
|
LDWDI EXPCON
|
|
JSR POLY
|
|
CLR ARISGN ;MULTIPLY BY POSITIVE 1.0.
|
|
PLA ;GET SCALE FACTOR.
|
|
JSR MLDEXP ;MODIFY FACEXP AND CHECK FOR OVERFLOW.
|
|
RTS ;HAS TO DO JSR DUE TO PULAS IN MULDIV.
|
|
|
|
|
|
PAGE
|
|
SUBTTL POLYNOMIAL EVALUATOR AND THE RANDOM NUMBER GENERATOR.
|
|
;EVALUATE P(X^2)*X
|
|
;POINTER TO DEGREE IS IN [Y,A].
|
|
;THE CONSTANTS FOLLOW THE DEGREE.
|
|
;FOR X=FAC, COMPUTE:
|
|
; C0*X+C1*X^3+C2*X^5+C3*X^7+...+C(N)*X^(2*N+1)
|
|
POLYX: STWD POLYPT ;RETAIN POLYNOMIAL POINTER FOR LATER.
|
|
JSR MOV1F ;SAVE FAC IN FACTMP.
|
|
LDAI TEMPF1
|
|
JSR FMULT ;COMPUTE X^2.
|
|
JSR POLY1 ;COMPUTE P(X^2).
|
|
LDWDI TEMPF1
|
|
JMP FMULT ;MULTIPLY BY FAC AGAIN.
|
|
|
|
;POLYNOMIAL EVALUATOR.
|
|
;POINTER TO DEGREE IS IN [Y,A].
|
|
;COMPUTE:
|
|
; C0+C1*X+C2*X^2+C3*X^3+C4*X^4+...+C(N-1)*X^(N-1)+C(N)*X^N.
|
|
POLY: STWD POLYPT
|
|
POLY1: JSR MOV2F ;SAVE FAC.
|
|
LDADY POLYPT
|
|
STA DEGREE
|
|
LDY POLYPT
|
|
INY
|
|
TYA
|
|
BNE POLY3
|
|
INC POLYPT+1
|
|
POLY3: STA POLYPT
|
|
LDY POLYPT+1
|
|
POLY2: JSR FMULT
|
|
LDWD POLYPT ;GET CURRENT POINTER.
|
|
CLC
|
|
ADCI 4+ADDPRC
|
|
BCC POLY4
|
|
INY
|
|
POLY4: STWD POLYPT
|
|
JSR FADD ;ADD IN CONSTANT.
|
|
LDWDI TEMPF2 ;MULTIPLY THE ORIGINAL FAC.
|
|
DEC DEGREE ;DONE?
|
|
BNE POLY2
|
|
RANDRT: RTS ;YES.
|
|
|
|
;PSUEDO-RANDOM NUMBER GENERATOR.
|
|
;IF ARG=0, THE LAST RANDOM NUMBER GENERATED IS RETURNED.
|
|
;IF ARG .LT. 0, A NEW SEQUENCE OF RANDOM NUMBERS IS
|
|
;STARTED USING THE ARGUMENT.
|
|
; TO FORM THE NEXT RANDOM NUMBER IN THE SEQUENCE,
|
|
;MULTIPLY THE PREVIOUS RANDOM NUMBER BY A RANDOM CONSTANT
|
|
;AND ADD IN ANOTHER RANDOM CONSTANT. THE THEN HO
|
|
;AND LO BYTES ARE SWITCHED, THE EXPONENT IS PUT WHERE
|
|
;IT WILL BE SHIFTED IN BY NORMAL, AND THE EXPONENT IN THE FAC
|
|
;IS SET TO 200 SO THE RESULT WILL BE LESS THAN 1. THIS
|
|
;IS THEN NORMALIZED AND SAVED FOR THE NEXT TIME.
|
|
;THE HO AND LOW BYTES WERE SWITCHED SO THERE WILL BE A
|
|
;RANDOM CHANCE OF GETTING A NUMBER LESS THAN OR GREATER
|
|
;THAN .5 .
|
|
|
|
RMULZC: 230
|
|
065
|
|
104
|
|
172
|
|
RADDZC: 150
|
|
050
|
|
261
|
|
106
|
|
|
|
RND: JSR SIGN ;GET SIGN INTO ACCX.
|
|
IFN REALIO-3,<
|
|
TAX> ;GET INTO ACCX, SINCE "MOVFM" USES ACCX.
|
|
BMI RND1 ;START NEW SEQUENCE IF NEGATIVE.
|
|
IFE REALIO-3,<
|
|
BNE QSETNR
|
|
;TIMERS ARE AT 9044(L0),45(HI),48(LO),49(HI) HEX.
|
|
;FIRST TWO ARE ALWAYS FREE RUNNING.
|
|
;SECOND PAIR IS NOT. LO IS FREER THAN HI THEN.
|
|
;SO ORDER IN FAC IS 44,48,45,49.
|
|
LDA CQHTIM
|
|
STA FACHO
|
|
LDA CQHTIM+4
|
|
STA FACMOH
|
|
LDA CQHTIM+1
|
|
STA FACMO
|
|
LDA CQHTIM+5
|
|
STA FACLO
|
|
JMP STRNEX>
|
|
QSETNR: LDWDI RNDX ;GET LAST ONE INTO FAC.
|
|
JSR MOVFM
|
|
IFN REALIO-3,<
|
|
TXA ;FAC WAS ZERO?
|
|
BEQ RANDRT> ;RESTORE LAST ONE.
|
|
LDWDI RMULZC ;MULTIPLY BY RANDOM CONSTANT.
|
|
JSR FMULT
|
|
LDWDI RADDZC
|
|
JSR FADD ;ADD RANDOM CONSTANT.
|
|
RND1: LDX FACLO
|
|
LDA FACHO
|
|
STA FACLO
|
|
STX FACHO ;REVERSE HO AND LO.
|
|
IFE REALIO-3,<
|
|
LDX FACMOH
|
|
LDA FACMO
|
|
STA FACMOH
|
|
STX FACMO>
|
|
STRNEX: CLR FACSGN ;MAKE NUMBER POSITIVE.
|
|
LDA FACEXP ;PUT EXP WHERE IT WILL
|
|
STA FACOV ;BE SHIFTED IN BY NORMAL.
|
|
LDAI 200
|
|
STA FACEXP ;MAKE RESULT BETWEEN 0 AND 1.
|
|
JSR NORMAL ;NORMALIZE.
|
|
LDXYI RNDX
|
|
GMOVMF: JMP MOVMF ;PUT NEW ONE INTO MEMORY.
|
|
|
|
PAGE
|
|
SUBTTL SINE, COSINE AND TANGENT FUNCTIONS.
|
|
IFE KIMROM,<
|
|
;COSINE FUNCTION.
|
|
;USE COS(X)=SIN(X+PI/2)
|
|
COS: LDWDI PI2 ;PNTR TO PI/2.
|
|
JSR FADD ;ADD IT IN.
|
|
;FALL INTO SIN.
|
|
|
|
|
|
;SINE FUNCTION.
|
|
;USE IDENTITIES TO GET FAC IN QUADRANTS I OR IV.
|
|
;THE FAC IS DIVIDED BY 2*PI AND THE INTEGER PART IS IGNORED
|
|
;BECAUSE SIN(X+2*PI)=SIN(X). THEN THE ARGUMENT CAN BE COMPARED
|
|
;WITH PI/2 BY COMPARING THE RESULT OF THE DIVISION
|
|
;WITH PI/2/(2*PI)=1/4.
|
|
;IDENTITIES ARE THEN USED TO GET THE RESULT IN QUADRANTS
|
|
;I OR IV. AN APPROXIMATION POLYNOMIAL IS THEN USED TO
|
|
;COMPUTE SIN(X).
|
|
SIN: JSR MOVAF
|
|
LDWDI TWOPI ;GET PNTR TO DIVISOR.
|
|
LDX ARGSGN ;GET SIGN OF RESULT.
|
|
JSR FDIVF
|
|
JSR MOVAF ;GET RESULT INTO ARG.
|
|
JSR INT ;INTEGERIZE FAC.
|
|
CLR ARISGN ;ALWAYS HAVE THE SAME SIGN.
|
|
JSR FSUBT ;KEEP ONLY THE FRACTIONAL PART.
|
|
LDWDI FR4 ;GET PNTR TO 1/4.
|
|
JSR FSUB ;COMPUTE 1/4-FAC.
|
|
LDA FACSGN ;SAVE SIGN FOR LATER.
|
|
PHA
|
|
BPL SIN1 ;FIRST QUADRANT.
|
|
JSR FADDH ;ADD 1/2 TO FAC.
|
|
LDA FACSGN ;SIGN IS NEGATIVE?
|
|
BMI SIN2
|
|
COM TANSGN ;QUADRANTS II AND III COME HERE.
|
|
SIN1: JSR NEGOP ;IF POSITIVE, NEGATE IT.
|
|
SIN2: LDWDI FR4 ;POINTER TO 1/4.
|
|
JSR FADD ;ADD IT IN.
|
|
PLA ;GET ORIGINAL QUADRANT.
|
|
BPL SIN3
|
|
JSR NEGOP ;IF NEGATIVE, NEGATE RESULT.
|
|
SIN3: LDWDI SINCON
|
|
GPOLYX: JMP POLYX ;DO APPROXIMATION POLYNOMIAL.
|
|
|
|
|
|
;TANGENT FUNCTION.
|
|
TAN: JSR MOV1F ;MOVE FAC INTO TEMPORARY.
|
|
CLR TANSGN ;REMEMBER WHETHER TO NEGATE.
|
|
JSR SIN ;COMPUTE THE SIN.
|
|
LDXYI TEMPF3
|
|
JSR GMOVMF ;PUT SIGN INTO OTHER TEMP.
|
|
LDWDI TEMPF1
|
|
JSR MOVFM ;PUT THIS MEMORY LOC INTO FAC.
|
|
CLR FACSGN ;START OFF POSITIVE.
|
|
LDA TANSGN
|
|
JSR COSC ;COMPUTE COSINE.
|
|
LDWDI TEMPF3 ;ADDRESS OF SINE VALUE.
|
|
GFDIV: JMP FDIV ;DIVIDE SINE BY COSINE AND RETURN.
|
|
COSC: PHA
|
|
JMP SIN1
|
|
|
|
PI2: 201 ;PI/2
|
|
111
|
|
017
|
|
333-ADDPRC
|
|
IFN ADDPRC,<242>
|
|
TWOPI: 203 ;2*PI.
|
|
111
|
|
017
|
|
333-ADDPRC
|
|
IFN ADDPRC,<242>
|
|
FR4: 177 ;1/4
|
|
000
|
|
000
|
|
0000
|
|
IFN ADDPRC,<0>
|
|
IFE ADDPRC,<SINCON: 4 ;DEGREE-1.
|
|
206 ;39.710899
|
|
036
|
|
327
|
|
373
|
|
207 ;-76.574956
|
|
231
|
|
046
|
|
145
|
|
207 ;81.602231
|
|
043
|
|
064
|
|
130
|
|
206 ;-41.341677
|
|
245
|
|
135
|
|
341
|
|
203 ;6.2831853
|
|
111
|
|
017
|
|
333>
|
|
|
|
IFN ADDPRC,<
|
|
SINCON: 5 ;DEGREE-1.
|
|
204 ; -14.381383816
|
|
346
|
|
032
|
|
055
|
|
033
|
|
206 ; 42.07777095
|
|
050
|
|
007
|
|
373
|
|
370
|
|
207 ; -76.704133676
|
|
231
|
|
150
|
|
211
|
|
001
|
|
207 ; 81.605223690
|
|
043
|
|
065
|
|
337
|
|
341
|
|
206 ; -41.34170209
|
|
245
|
|
135
|
|
347
|
|
050
|
|
203 ; 6.2831853070
|
|
111
|
|
017
|
|
332
|
|
242
|
|
241 ; 7.2362932E7
|
|
124
|
|
106
|
|
217
|
|
23
|
|
217 ; 73276.2515
|
|
122
|
|
103
|
|
211
|
|
315>
|
|
PAGE
|
|
SUBTTL ARCTANGENT FUNCTION.
|
|
;USE IDENTITIES TO GET ARG BETWEEN 0 AND 1 AND THEN USE AN
|
|
;APPROXIMATION POLYNOMIAL TO COMPUTE ARCTAN(X).
|
|
ATN: LDA FACSGN ;WHAT IS SIGN?
|
|
PHA ;(MEANWHILE SAVE FOR LATER.)
|
|
BPL ATN1
|
|
JSR NEGOP ;IF NEGATIVE, NEGATE FAC.
|
|
;USE ARCTAN(X)=-ARCTAN(-X) .
|
|
ATN1: LDA FACEXP
|
|
PHA ;SAVE THIS TOO FOR LATER.
|
|
CMPI 201 ;SEE IF FAC .GE. 1.0 .
|
|
BCC ATN2 ;IT IS LESS THAN 1.
|
|
LDWDI FONE ;GET PNTR TO 1.0 .
|
|
JSR FDIV ;COMPUTE RECIPROCAL.
|
|
;USE ARCTAN(X)=PI/2-ARCTAN(1/X) .
|
|
ATN2: LDWDI ATNCON ;PNTR TO ARCTAN CONSTANTS.
|
|
JSR POLYX
|
|
PLA
|
|
CMPI 201 ;WAS ORIGINAL ARGUMENT .LT. 1 ?
|
|
BCC ATN3 ;YES.
|
|
LDWDI PI2
|
|
JSR FSUB ;SUBTRACT ARCTAGN FROM PI/2.
|
|
ATN3: PLA ;WAS ORIGINAL ARGUMENT POSITIVE?
|
|
BPL ATN4 ;YES.
|
|
JMP NEGOP ;IF NEGATIVE, NEGATE RESULT.
|
|
ATN4: RTS ;ALL DONE.
|
|
|
|
IFE ADDPRC,<
|
|
ATNCON: 10 ;DEGREE-1.
|
|
170 ;.0028498896
|
|
072
|
|
305
|
|
067
|
|
173 ;-.016068629
|
|
203
|
|
242
|
|
134
|
|
174 ;.042691519
|
|
056
|
|
335
|
|
115
|
|
175 ;-.075042945
|
|
231
|
|
260
|
|
036
|
|
175 ;.10640934
|
|
131
|
|
355
|
|
044
|
|
176 ;-.14203644
|
|
221
|
|
162
|
|
000
|
|
176 ;.19992619
|
|
114
|
|
271
|
|
163
|
|
177 ;.-33333073
|
|
252
|
|
252
|
|
123
|
|
201 ;1.0
|
|
000
|
|
000
|
|
000>
|
|
|
|
IFN ADDPRC,<
|
|
ATNCON: 13 ;DEGREE-1.
|
|
166 ; -.0006847939119
|
|
263
|
|
203
|
|
275
|
|
323
|
|
171 ; .004850942156
|
|
036
|
|
364
|
|
246
|
|
365
|
|
173 ; -.01611170184
|
|
203
|
|
374
|
|
260
|
|
020
|
|
174 ; .03420963805
|
|
014
|
|
037
|
|
147
|
|
312
|
|
174 ; -.05427913276
|
|
336
|
|
123
|
|
313
|
|
301
|
|
175 ; .07245719654
|
|
024
|
|
144
|
|
160
|
|
114
|
|
175 ; -.08980239538
|
|
267
|
|
352
|
|
121
|
|
172
|
|
175 ; .1109324134
|
|
143
|
|
060
|
|
210
|
|
176
|
|
176 ; -.1428398077
|
|
222
|
|
104
|
|
231
|
|
072
|
|
176 ; .1999991205
|
|
114
|
|
314
|
|
221
|
|
307
|
|
177 ; -.3333333157
|
|
252
|
|
252
|
|
252
|
|
023
|
|
201 ; 1.0
|
|
000
|
|
000
|
|
000
|
|
000>>
|
|
PAGE
|
|
SUBTTL SYSTEM INITIALIZATION CODE.
|
|
RADIX 10 ;IN ALL NON-MATH-PACKAGE CODE.
|
|
; THIS INITIALIZES THE BASIC INTERPRETER FOR THE M6502 AND SHOULD BE
|
|
; LOCATED WHERE IT WILL BE WIPED OUT IN RAM IF CODE IS ALL IN RAM.
|
|
|
|
IFE ROMSW,<
|
|
BLOCK 1> ;SO ZEROING AT TXTTAB DOESN'T PREVENT
|
|
;RESTARTING INIT
|
|
INITAT: INC CHRGET+7 ;INCREMENT THE WHOLE TXTPTR.
|
|
BNE CHZGOT
|
|
INC CHRGET+8
|
|
CHZGOT: LDA 60000 ;A LOAD WITH AN EXT ADDR.
|
|
CMPI ":" ;IS IT A ":"?
|
|
BCS CHZRTS ;IT IS .GE. ":"
|
|
CMPI " " ;SKIP SPACES.
|
|
BEQ INITAT
|
|
SEC
|
|
SBCI "0" ;ALL CHARS .GT. "9" HAVE RET'D SO
|
|
SEC
|
|
SBCI ^D256-"0" ;SEE IF NUMERIC.
|
|
;TURN CARRY ON IF NUMERIC.
|
|
;ALSO, SETZ IF NULL.
|
|
CHZRTS: RTS ;RETURN TO CALLER.
|
|
|
|
128 ;LOADED OR FROM ROM.
|
|
79 ;THE INITIAL RANDOM NUMBER.
|
|
199
|
|
82
|
|
IFN ADDPRC,<88>
|
|
IFN REALIO-3,<
|
|
IFE KIMROM,<
|
|
TYPAUT: LDWDI AUTTXT
|
|
JSR STROUT>>
|
|
INIT:
|
|
IFN REALIO-3,<
|
|
LDXI 255 ;MAKE IT LOOK DIRECT IN CASE OF
|
|
STX CURLIN+1> ;ERROR MESSAGE.
|
|
IFN STKEND-511,<
|
|
LDXI STKEND-256>
|
|
TXS
|
|
IFN REALIO-3,<
|
|
LDWDI INIT ;ALLOW RESTART.
|
|
STWD START+1
|
|
STWD RDYJSR+1 ;RTS HERE ON ERRORS.
|
|
LDWDI AYINT
|
|
STWD ADRAYI
|
|
LDWDI GIVAYF
|
|
STWD ADRGAY>
|
|
LDAI 76 ;JMP INSTRUCTION.
|
|
IFE REALIO,<HRLI 1,^O1000> ;MAKE AN INST.
|
|
IFN REALIO-3,<
|
|
STA START
|
|
STA RDYJSR>
|
|
STA JMPER
|
|
IFN ROMSW,<
|
|
STA USRPOK
|
|
LDWDI FCERR
|
|
STWD USRPOK+1>
|
|
LDAI LINLEN ;THESE MUST BE NON-ZERO SO CHEAD WILL
|
|
STA LINWID ;WORK AFTER MOVING A NEW LINE IN BUF
|
|
;INTO THE PROGRAM
|
|
LDAI NCMPOS
|
|
STA NCMWID
|
|
LDXI RNDX+4-CHRGET
|
|
MOVCHG: LDA INITAT-1,X,
|
|
STA CHRGET-1,X, ;MOVE TO RAM.
|
|
DEX
|
|
BNE MOVCHG
|
|
LDAI STRSIZ
|
|
STA FOUR6
|
|
TXA ;SET CONST IN RAM.
|
|
STA BITS
|
|
IFN EXTIO,<
|
|
STA CHANNL>
|
|
STA LASTPT+1
|
|
IFN NULCMD,<
|
|
STA NULCNT>
|
|
PHA ;PUT ZERO AT THE END OF THE STACK
|
|
;SO FNDFOR WILL STOP
|
|
IFN REALIO,<
|
|
STA CNTWFL> ;BE TALKATIVE.
|
|
IFN BUFPAG,<
|
|
INX ;MAKE [X]=1
|
|
STX BUF-3 ;SET PRE-BUF BYTES NON-ZERO FOR CHEAD
|
|
STX BUF-4>
|
|
IFN REALIO-3,<
|
|
JSR CRDO> ;TYPE A CR.
|
|
LDXI TEMPST
|
|
STX TEMPPT ;SET UP STRING TEMPORARIES.
|
|
IFN REALIO!LONGI,<
|
|
IFN REALIO-3,<
|
|
LDWDI MEMORY
|
|
JSR STROUT
|
|
JSR QINLIN ;GET A LINE OF INPUT.
|
|
STXY TXTPTR ;READ THIS !
|
|
JSR CHRGET ;GET THE FIRST CHARACTER.
|
|
IFE KIMROM,<
|
|
CMPI "A" ;IS IT AN "A"?
|
|
BEQ TYPAUT> ;YES TYPE AUTHOR'S NAME.
|
|
TAY ;NULL INPUT?
|
|
BNE USEDE9> ;NO.
|
|
IFE REALIO-3,<
|
|
LDYI RAMLOC/^D256>
|
|
IFN REALIO-3,<
|
|
IFE ROMSW,<
|
|
LDWDI LASTWR> ;YES GET PNTR TO LAST WORD.
|
|
IFN ROMSW,<
|
|
LDWDI RAMLOC>>
|
|
IFN ROMSW,<
|
|
STWD TXTTAB> ;SET UP START OF PROGRAM LOCATION
|
|
STWD LINNUM
|
|
IFE REALIO-3,<
|
|
TAY>
|
|
IFN REALIO-3,<
|
|
LDYI 0>
|
|
LOOPMM: INC LINNUM
|
|
BNE LOOPM1
|
|
INC LINNUM+1
|
|
IFE REALIO-3,<
|
|
BMI USEDEC>
|
|
LOOPM1: LDAI 85 ;PUT RANDOM INFO INTO MEM.
|
|
STADY LINNUM
|
|
CMPDY LINNUM ;WAS IT SAVED?
|
|
BNE USEDEC ;NO. THAT IS END OF MEMORY.
|
|
ASL A, ;LOOKS LIKE IT. TRY ANOTHER.
|
|
STADY LINNUM
|
|
CMPDY LINNUM ;WAS IT SAVED?
|
|
IFN REALIO-3,<
|
|
BNE USEDEC> ;NO. THIS IS THE END.
|
|
IFN REALIO-2,<
|
|
BEQ LOOPMM>
|
|
IFE REALIO-2,<
|
|
BNE USEDEC
|
|
CMP 0 ;SEE IF HITTING PAGE 0
|
|
BNE LOOPMM
|
|
LDAI 76
|
|
STA 0
|
|
BNEA USEDEC>
|
|
IFN REALIO-3,<
|
|
USEDE9: JSR CHRGOT ;GET CURRENT CHARACTER.
|
|
JSR LINGET ;GET DECIMAL ARGUMENT.
|
|
TAY ;MAKE SURE A TERMINATOR EXISTS.
|
|
BEQ USEDEC ;IT DOES.
|
|
JMP SNERR> ;IT DOESN'T.
|
|
USEDEC: LDWD LINNUM ;GET SIZE OF MEMORY INPUT.
|
|
USEDEF: > ;HIGHEST ADDRESS.
|
|
IFE REALIO!LONGI,<
|
|
LDWDI 16190> ;A STRANGE NUMBER.
|
|
STWD MEMSIZ ;THIS IS THE SIZE OF MEMORY.
|
|
STWD FRETOP ;TOP OF STRINGS TOO.
|
|
TTYW:
|
|
IFN REALIO-3,<
|
|
IFN REALIO!LONGI,<
|
|
LDWDI TTYWID
|
|
JSR STROUT
|
|
JSR QINLIN ;GET LINE OF INPUT.
|
|
STXY TXTPTR ;READ THIS !
|
|
JSR CHRGET ;GET FIRST CHARACTER.
|
|
TAY ;TEST ACCA BUT DON'T AFFECT CARRY.
|
|
BEQ ASKAGN
|
|
JSR LINGET ;GET ARGUMENT.
|
|
LDA LINNUM+1
|
|
BNE TTYW ;WIDTH MUST BE .LT. 256.
|
|
LDA LINNUM
|
|
CMPI 16 ;WIDTH MUST BE GREATER THAN 16.
|
|
BCC TTYW
|
|
STA LINWID ;THAT IS THE LINE WIDTH.
|
|
MORCPS: SBCI CLMWID ;COMPUTE POSITION BEYOND WHICH
|
|
BCS MORCPS ;THERE ARE NO MORE FIELDS.
|
|
EORI 255
|
|
SBCI CLMWID-2
|
|
CLC
|
|
ADC LINWID
|
|
STA NCMWID>
|
|
ASKAGN:
|
|
IFE ROMSW,<
|
|
IFN REALIO!LONGI,<
|
|
LDWDI FNS
|
|
JSR STROUT
|
|
JSR QINLIN
|
|
STXY TXTPTR ;READ THIS !
|
|
JSR CHRGET
|
|
LDXYI INITAT ;DEFAULT.
|
|
CMPI "Y"
|
|
BEQ HAVFNS ;SAVE ALL FUNCTIONS.
|
|
CMPI "A"
|
|
BEQ OKCHAR ;SAVE ALL BUT ATN.
|
|
CMPI "N"
|
|
BNE ASKAGN ;BAD INPUT.
|
|
;SAVE NOTHING.
|
|
OKCHAR: LDXYI FCERR
|
|
STXY ATNFIX ;GET RID OF ATN FUNCTION.
|
|
LDXYI ATN ;UNTIL WE KNOW THAT WE SHOULD DEL MORE.
|
|
CMPI "A"
|
|
BEQ HAVFNS ;JUST GET RID OF ATN.
|
|
LDXYI FCERR
|
|
STXY COSFIX ;GET RID OF THE REST.
|
|
STXY TANFIX
|
|
STXY SINFIX
|
|
LDXYI COS ;AND GET RID OF ALL BACK TO "COS".
|
|
HAVFNS:>
|
|
IFE REALIO!LONGI,<
|
|
LDXYI INITAT-1>>> ;GET RID OF ALL UP TO "INITAT".
|
|
IFN ROMSW,<
|
|
LDXYI RAMLOC
|
|
STXY TXTTAB>
|
|
LDYI 0
|
|
TYA
|
|
STADY TXTTAB ;SET UP TEXT TABLE.
|
|
INC TXTTAB
|
|
IFN REALIO-3,<
|
|
BNE QROOM
|
|
INC TXTTAB+1>
|
|
QROOM: LDWD TXTTAB ;PREPARE TO USE "REASON".
|
|
JSR REASON
|
|
IFE REALIO-3,<
|
|
LDWDI FREMES
|
|
JSR STROUT>
|
|
IFN REALIO-3,<
|
|
JSR CRDO>
|
|
LDA MEMSIZ ;COMPUTE [MEMSIZ]-[VARTAB].
|
|
SEC
|
|
SBC TXTTAB
|
|
TAX
|
|
LDA MEMSIZ+1
|
|
SBC TXTTAB+1
|
|
JSR LINPRT ;TYPE THIS VALUE.
|
|
LDWDI WORDS ;MORE BULLSHIT.
|
|
JSR STROUT
|
|
JSR SCRTCH ;SET UP EVERYTHING ELSE.
|
|
IFE REALIO-3,<
|
|
JMP READY>
|
|
IFN REALIO-3,<
|
|
LDWDI STROUT
|
|
STWD RDYJSR+1
|
|
LDWDI READY
|
|
STWD START+1
|
|
JMPD START+1
|
|
|
|
IFE ROMSW,<
|
|
FNS: DT"WANT SIN-COS-TAN-ATN"
|
|
0>
|
|
IFE KIMROM,<
|
|
AUTTXT: ACRLF
|
|
12 ;ANOTHER LINE FEED.
|
|
DT"WRITTEN "
|
|
DT"BY WEILAND & GATES"
|
|
ACRLF
|
|
0>
|
|
MEMORY: DT"MEMORY SIZE"
|
|
0
|
|
TTYWID:
|
|
IFE KIMROM,<
|
|
DT"TERMINAL ">
|
|
DT"WIDTH"
|
|
0>
|
|
WORDS: DT" BYTES FREE"
|
|
IFN REALIO-3,<
|
|
ACRLF
|
|
ACRLF>
|
|
IFE REALIO-3,<
|
|
EXP ^O15
|
|
0
|
|
FREMES: >
|
|
IFE REALIO,< DT"SIMULATED BASIC FOR THE 6502 V1.1">
|
|
IFE REALIO-1,< DT"KIM BASIC V1.1">
|
|
IFE REALIO-2,< DT"OSI 6502 BASIC VERSION 1.1">
|
|
IFE REALIO-3,< DT"### COMMODORE BASIC ###"
|
|
EXP ^O15
|
|
EXP ^O15>
|
|
IFE REALIO-4,<DT"APPLE BASIC V1.1">
|
|
IFE REALIO-5,<DT"STM BASIC V1.1">
|
|
IFN REALIO-3,<
|
|
ACRLF
|
|
DT"COPYRIGHT 1978 MICROSOFT"
|
|
ACRLF>
|
|
0
|
|
LASTWR::
|
|
BLOCK 100 ;SPACE FOR TEMP STACK.
|
|
IFE REALIO,<
|
|
TSTACK::BLOCK 13600>
|
|
|
|
IF2,<
|
|
PURGE A,X,Y>
|
|
IFNDEF START,<START==0>
|
|
END $Z+START |