mirror of
https://github.com/jonthomasson/retro1.git
synced 2024-06-01 22:41:44 +00:00
6955 lines
158 KiB
ArmAsm
6955 lines
158 KiB
ArmAsm
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=2 ;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 |