From eb3a53cdd6a1216f4f7fa53c786c37ae05231006 Mon Sep 17 00:00:00 2001 From: Scott Hanselman Date: Thu, 27 Jul 1978 12:00:00 -0700 Subject: [PATCH] Microsoft BASIC for 6502 --- .gitignore | 418 ++++ LICENSE | 21 + README.md | 136 + SECURITY.md | 14 + m6502.asm | 6955 +++++++++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 7544 insertions(+) create mode 100644 .gitignore create mode 100644 LICENSE create mode 100644 README.md create mode 100644 SECURITY.md create mode 100644 m6502.asm diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..ce89292 --- /dev/null +++ b/.gitignore @@ -0,0 +1,418 @@ +## Ignore Visual Studio temporary files, build results, and +## files generated by popular Visual Studio add-ons. +## +## Get latest from https://github.com/github/gitignore/blob/main/VisualStudio.gitignore + +# User-specific files +*.rsuser +*.suo +*.user +*.userosscache +*.sln.docstates +*.env + +# User-specific files (MonoDevelop/Xamarin Studio) +*.userprefs + +# Mono auto generated files +mono_crash.* + +# Build results +[Dd]ebug/ +[Dd]ebugPublic/ +[Rr]elease/ +[Rr]eleases/ +x64/ +x86/ +[Ww][Ii][Nn]32/ +[Aa][Rr][Mm]/ +[Aa][Rr][Mm]64/ +[Aa][Rr][Mm]64[Ee][Cc]/ +bld/ +[Oo]bj/ +[Oo]ut/ +[Ll]og/ +[Ll]ogs/ + +# Build results on 'Bin' directories +**/[Bb]in/* +# Uncomment if you have tasks that rely on *.refresh files to move binaries +# (https://github.com/github/gitignore/pull/3736) +#!**/[Bb]in/*.refresh + +# Visual Studio 2015/2017 cache/options directory +.vs/ +# Uncomment if you have tasks that create the project's static files in wwwroot +#wwwroot/ + +# Visual Studio 2017 auto generated files +Generated\ Files/ + +# MSTest test Results +[Tt]est[Rr]esult*/ +[Bb]uild[Ll]og.* +*.trx + +# NUnit +*.VisualState.xml +TestResult.xml +nunit-*.xml + +# Approval Tests result files +*.received.* + +# Build Results of an ATL Project +[Dd]ebugPS/ +[Rr]eleasePS/ +dlldata.c + +# Benchmark Results +BenchmarkDotNet.Artifacts/ + +# .NET Core +project.lock.json +project.fragment.lock.json +artifacts/ + +# ASP.NET Scaffolding +ScaffoldingReadMe.txt + +# StyleCop +StyleCopReport.xml + +# Files built by Visual Studio +*_i.c +*_p.c +*_h.h +*.ilk +*.meta +*.obj +*.idb +*.iobj +*.pch +*.pdb +*.ipdb +*.pgc +*.pgd +*.rsp +# but not Directory.Build.rsp, as it configures directory-level build defaults +!Directory.Build.rsp +*.sbr +*.tlb +*.tli +*.tlh +*.tmp +*.tmp_proj +*_wpftmp.csproj +*.log +*.tlog +*.vspscc +*.vssscc +.builds +*.pidb +*.svclog +*.scc + +# Chutzpah Test files +_Chutzpah* + +# Visual C++ cache files +ipch/ +*.aps +*.ncb +*.opendb +*.opensdf +*.sdf +*.cachefile +*.VC.db +*.VC.VC.opendb + +# Visual Studio profiler +*.psess +*.vsp +*.vspx +*.sap + +# Visual Studio Trace Files +*.e2e + +# TFS 2012 Local Workspace +$tf/ + +# Guidance Automation Toolkit +*.gpState + +# ReSharper is a .NET coding add-in +_ReSharper*/ +*.[Rr]e[Ss]harper +*.DotSettings.user + +# TeamCity is a build add-in +_TeamCity* + +# DotCover is a Code Coverage Tool +*.dotCover + +# AxoCover is a Code Coverage Tool +.axoCover/* +!.axoCover/settings.json + +# Coverlet is a free, cross platform Code Coverage Tool +coverage*.json +coverage*.xml +coverage*.info + +# Visual Studio code coverage results +*.coverage +*.coveragexml + +# NCrunch +_NCrunch_* +.NCrunch_* +.*crunch*.local.xml +nCrunchTemp_* + +# MightyMoose +*.mm.* +AutoTest.Net/ + +# Web workbench (sass) +.sass-cache/ + +# Installshield output folder +[Ee]xpress/ + +# DocProject is a documentation generator add-in +DocProject/buildhelp/ +DocProject/Help/*.HxT +DocProject/Help/*.HxC +DocProject/Help/*.hhc +DocProject/Help/*.hhk +DocProject/Help/*.hhp +DocProject/Help/Html2 +DocProject/Help/html + +# Click-Once directory +publish/ + +# Publish Web Output +*.[Pp]ublish.xml +*.azurePubxml +# Note: Comment the next line if you want to checkin your web deploy settings, +# but database connection strings (with potential passwords) will be unencrypted +*.pubxml +*.publishproj + +# Microsoft Azure Web App publish settings. Comment the next line if you want to +# checkin your Azure Web App publish settings, but sensitive information contained +# in these scripts will be unencrypted +PublishScripts/ + +# NuGet Packages +*.nupkg +# NuGet Symbol Packages +*.snupkg +# The packages folder can be ignored because of Package Restore +**/[Pp]ackages/* +# except build/, which is used as an MSBuild target. +!**/[Pp]ackages/build/ +# Uncomment if necessary however generally it will be regenerated when needed +#!**/[Pp]ackages/repositories.config +# NuGet v3's project.json files produces more ignorable files +*.nuget.props +*.nuget.targets + +# Microsoft Azure Build Output +csx/ +*.build.csdef + +# Microsoft Azure Emulator +ecf/ +rcf/ + +# Windows Store app package directories and files +AppPackages/ +BundleArtifacts/ +Package.StoreAssociation.xml +_pkginfo.txt +*.appx +*.appxbundle +*.appxupload + +# Visual Studio cache files +# files ending in .cache can be ignored +*.[Cc]ache +# but keep track of directories ending in .cache +!?*.[Cc]ache/ + +# Others +ClientBin/ +~$* +*~ +*.dbmdl +*.dbproj.schemaview +*.jfm +*.pfx +*.publishsettings +orleans.codegen.cs + +# Including strong name files can present a security risk +# (https://github.com/github/gitignore/pull/2483#issue-259490424) +#*.snk + +# Since there are multiple workflows, uncomment next line to ignore bower_components +# (https://github.com/github/gitignore/pull/1529#issuecomment-104372622) +#bower_components/ + +# RIA/Silverlight projects +Generated_Code/ + +# Backup & report files from converting an old project file +# to a newer Visual Studio version. Backup files are not needed, +# because we have git ;-) +_UpgradeReport_Files/ +Backup*/ +UpgradeLog*.XML +UpgradeLog*.htm +ServiceFabricBackup/ +*.rptproj.bak + +# SQL Server files +*.mdf +*.ldf +*.ndf + +# Business Intelligence projects +*.rdl.data +*.bim.layout +*.bim_*.settings +*.rptproj.rsuser +*- [Bb]ackup.rdl +*- [Bb]ackup ([0-9]).rdl +*- [Bb]ackup ([0-9][0-9]).rdl + +# Microsoft Fakes +FakesAssemblies/ + +# GhostDoc plugin setting file +*.GhostDoc.xml + +# Node.js Tools for Visual Studio +.ntvs_analysis.dat +node_modules/ + +# Visual Studio 6 build log +*.plg + +# Visual Studio 6 workspace options file +*.opt + +# Visual Studio 6 auto-generated workspace file (contains which files were open etc.) +*.vbw + +# Visual Studio 6 auto-generated project file (contains which files were open etc.) +*.vbp + +# Visual Studio 6 workspace and project file (working project files containing files to include in project) +*.dsw +*.dsp + +# Visual Studio 6 technical files +*.ncb +*.aps + +# Visual Studio LightSwitch build output +**/*.HTMLClient/GeneratedArtifacts +**/*.DesktopClient/GeneratedArtifacts +**/*.DesktopClient/ModelManifest.xml +**/*.Server/GeneratedArtifacts +**/*.Server/ModelManifest.xml +_Pvt_Extensions + +# Paket dependency manager +**/.paket/paket.exe +paket-files/ + +# FAKE - F# Make +**/.fake/ + +# CodeRush personal settings +**/.cr/personal + +# Python Tools for Visual Studio (PTVS) +**/__pycache__/ +*.pyc + +# Cake - Uncomment if you are using it +#tools/** +#!tools/packages.config + +# Tabs Studio +*.tss + +# Telerik's JustMock configuration file +*.jmconfig + +# BizTalk build output +*.btp.cs +*.btm.cs +*.odx.cs +*.xsd.cs + +# OpenCover UI analysis results +OpenCover/ + +# Azure Stream Analytics local run output +ASALocalRun/ + +# MSBuild Binary and Structured Log +*.binlog +MSBuild_Logs/ + +# AWS SAM Build and Temporary Artifacts folder +.aws-sam + +# NVidia Nsight GPU debugger configuration file +*.nvuser + +# MFractors (Xamarin productivity tool) working folder +**/.mfractor/ + +# Local History for Visual Studio +**/.localhistory/ + +# Visual Studio History (VSHistory) files +.vshistory/ + +# BeatPulse healthcheck temp database +healthchecksdb + +# Backup folder for Package Reference Convert tool in Visual Studio 2017 +MigrationBackup/ + +# Ionide (cross platform F# VS Code tools) working folder +**/.ionide/ + +# Fody - auto-generated XML schema +FodyWeavers.xsd + +# VS Code files for those working on multiple tools +.vscode/* +!.vscode/settings.json +!.vscode/tasks.json +!.vscode/launch.json +!.vscode/extensions.json +!.vscode/*.code-snippets + +# Local History for Visual Studio Code +.history/ + +# Built Visual Studio Code Extensions +*.vsix + +# Windows Installer files from build outputs +*.cab +*.msi +*.msix +*.msm +*.msp diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..75066a4 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +MIT License + + Copyright (c) Microsoft Corporation. + + Permission is hereby granted, free of charge, to any person obtaining a copy + of this software and associated documentation files (the "Software"), to deal + in the Software without restriction, including without limitation the rights + to use, copy, modify, merge, publish, distribute, sublicense, and/or sell + copies of the Software, and to permit persons to whom the Software is + furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in all + copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE + AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE + SOFTWARE \ No newline at end of file diff --git a/README.md b/README.md new file mode 100644 index 0000000..28f74b0 --- /dev/null +++ b/README.md @@ -0,0 +1,136 @@ +# Microsoft BASIC for 6502 Microprocessor - Version 1.1 + +## Historical Significance + +This assembly language source code represents one of the most historically significant pieces of software from the early personal computer era. It is the complete source code for **Microsoft BASIC Version 1.1 for the 6502 microprocessor**, originally developed and copyrighted by Microsoft in 1976-1978. + +### Why This Document is Historically Important + +#### 1. Foundation of the Personal Computer Revolution + +- This BASIC interpreter was the software foundation that powered many of the most influential early personal computers +- It democratized programming by making it accessible to non-technical users through a simple, English-like programming language +- Without this software, the personal computer revolution might have developed very differently + +#### 2. Microsoft's Early Success + +- This represents some of Microsoft's earliest and most successful software +- The licensing of this BASIC interpreter to multiple computer manufacturers was crucial to Microsoft's early business model +- It established Microsoft as a dominant force in personal computer software before MS-DOS or Windows + +#### 3. Multi-Platform Compatibility + +- This single codebase was designed to run on multiple different computer systems of the era +- The conditional compilation system allowed the same source code to target different hardware platforms +- This approach influenced how software would be developed for decades to come + +## Supported Computer Systems + +The source code includes conditional compilation support for multiple pioneering computer systems: + +- **Apple II** (`REALIO=4`) - Steve Jobs and Steve Wozniak's revolutionary home computer +- **Commodore PET** (`REALIO=3`) - One of the first complete personal computers +- **Ohio Scientific (OSI)** (`REALIO=2`) - Popular among hobbyists and schools +- **MOS Technology KIM-1** (`REALIO=1`) - An influential single-board computer +- **PDP-10 Simulation** (`REALIO=0`) - For development and testing purposes + +## Technical Specifications + +- **Language**: 6502 Assembly Language +- **Target Processor**: MOS Technology 6502 8-bit microprocessor +- **Memory Footprint**: 8KB ROM version +- **Features**: Complete BASIC interpreter with floating-point arithmetic +- **Architecture**: Designed for both ROM and RAM configurations + +## Key Features + +### Programming Language Support + +- Full BASIC language implementation +- Floating-point arithmetic +- String handling and manipulation +- Array support (both integer and string arrays) +- Mathematical functions and operators +- Input/output operations + +### Memory Management + +- Efficient memory utilization for 8-bit systems +- String garbage collection +- Dynamic variable storage +- Stack-based expression evaluation + +### Hardware Abstraction + +- Configurable I/O routines for different computer systems +- Terminal width adaptation +- Character input/output abstraction +- Optional disk storage support + +## Development History + +The source code includes detailed revision history showing active development: + +- **July 27, 1978**: Fixed critical bugs in FOR loop variable handling and statement parsing +- **July 1, 1978**: Memory optimization and garbage collection improvements +- **March 9, 1978**: Enhanced string function capabilities +- **February 25, 1978**: Input flag corrections and numeric precision improvements +- **February 11, 1978**: Reserved word parsing enhancements +- **January 24, 1978**: User-defined function improvements + +## Cultural Impact + +### Educational Influence + +- This BASIC interpreter introduced millions of people to computer programming +- It was the first programming language for countless programmers who later became industry leaders +- The simple, interactive nature of BASIC made computers approachable for non-technical users + +### Industry Standardization + +- Microsoft's BASIC became the de facto standard for personal computer programming +- The design patterns and conventions established here influenced later programming languages and development tools +- The multi-platform approach pioneered techniques still used in modern software development + +### Business Model Innovation + +- The licensing of this software to multiple hardware manufacturers created Microsoft's early business model +- It demonstrated the viability of software as a standalone business, separate from hardware +- This approach became the template for the entire software industry + +## Technical Innovation + +### Compiler Technology + +- Advanced macro system for code generation +- Sophisticated conditional compilation for multi-platform support +- Efficient symbol table management +- Optimized code generation for memory-constrained systems + +### Runtime System + +- Stack-based expression evaluator +- Dynamic memory management +- Real-time garbage collection +- Interactive command processing + +## Legacy + +This source code represents the foundation upon which the modern software industry was built. The techniques, patterns, and business models pioneered in this BASIC interpreter directly influenced: + +- The development of MS-DOS and subsequent Microsoft operating systems +- The standardization of programming language implementations +- The establishment of software licensing as a business model +- The democratization of computer programming + +## File Information + +- **Filename**: `m6502.asm` +- **Lines of Code**: 6,955 lines +- **Copyright**: Microsoft Corporation, 1976-1978 +- **Version**: 1.1 +- **Assembly Format**: Compatible with period assemblers for 6502 development + +--- + +*This document represents a crucial piece of computing history - the source code that helped launch the personal computer revolution and established Microsoft as a software industry leader.* diff --git a/SECURITY.md b/SECURITY.md new file mode 100644 index 0000000..e751608 --- /dev/null +++ b/SECURITY.md @@ -0,0 +1,14 @@ + + +## Security + +Microsoft takes the security of our software products and services seriously, which +includes all source code repositories in our GitHub organizations. + +**Please do not report security vulnerabilities through public GitHub issues.** + +For security reporting information, locations, contact information, and policies, +please review the latest guidance for Microsoft repositories at +[https://aka.ms/SECURITY.md](https://aka.ms/SECURITY.md). + + \ No newline at end of file diff --git a/m6502.asm b/m6502.asm new file mode 100644 index 0000000..51c07c9 --- /dev/null +++ b/m6502.asm @@ -0,0 +1,6955 @@ +TITLE BASIC M6502 8K VER 1.1 BY MICRO-SOFT +SEARCH M6502 +SALL +RADIX 10 ;THROUGHOUT ALL BUT MATH-PAK. + +$Z:: ;STARTING POINT FOR M6502 SIMULATOR + ORG 0 ;START OFF AT LOCATION ZERO. +SUBTTL SWITCHES,MACROS. + +REALIO=4 ;5=STM + ;4=APPLE. + ;3=COMMODORE. + ;2=OSI + ;1=MOS TECH,KIM + ;0=PDP-10 SIMULATING 6502 +INTPRC==1 ;INTEGER ARRAYS. +ADDPRC==1 ;FOR ADDITIONAL PRECISION. +LNGERR==0 ;LONG ERROR MESSAGES. +TIME== 0 ;CAPABILITY TO SET AND READ A CLK. +EXTIO== 0 ;EXTERNAL I/O. +DISKO== 0 ;SAVE AND LOAD COMMANDS +NULCMD==1 ;FOR THE "NULL" COMMAND +GETCMD==1 +RORSW==1 +ROMSW==1 ;TELLS IF THIS IS ON ROM. +CLMWID==14 +LONGI==1 ;LONG INITIALIZATION SWITCH. +STKEND=511 +BUFPAG==0 +LINLEN==72 ;TERMINAL LINE LENGTH. +BUFLEN==72 ;INPUT BUFFER SIZE. +ROMLOC= ^O20000 ;ADDRESS OF START OF PURE SEGMENT. +KIMROM=1 +IFE ROMSW, +IFN REALIO-1, +IFN ROMSW,< +RAMLOC= ^O40000 ;USED ONLY IF ROMSW=1 +IFE REALIO,> +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, +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 + JSR SYNCHR> +DEFINE DT(Q),< +IRPC Q,<">,>> +DEFINE LDWD (WD),< + LDA WD + LDY +1> +DEFINE LDWDI (WD),< + LDAI <&^O377> + LDYI </^O400>> +DEFINE LDWX (WD),< + LDA WD + LDX +1> +DEFINE LDWXI (WD),< + LDAI <&^O377> + LDXI </^O400>> +DEFINE LDXY (WD),< + LDX WD + LDY +1> +DEFINE LDXYI (WD),< + LDXI <&^O377> + LDYI </^O400>> +DEFINE STWD (WD),< + STA WD + STY +1> +DEFINE STWX (WD),< + STA WD + STX +1> +DEFINE STXY (WD),< + STX WD + STY +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 +1> +DEFINE PSHWD (WD),< + LDA +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, ;BIT ZERO PAGE TRICK. +DEFINE SKIP2, ;BIT ABS TRICK. +IF1,< +IFE REALIO, +IFE REALIO-1, +IFE REALIO-2, +IFE REALIO-3, +IFE REALIO-4, +IFE REALIO-5, +IFN ADDPRC, +IFN INTPRC, +IFN LNGERR, +IFN DISKO, +IFE ROMSW, +IFN ROMSW, +IFE RORSW, +IFN RORSW,> +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, ;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, ;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, +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), +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), +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, ;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 ;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, +IFN REALIO-2, +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, + LSR A, + BCC INCHRL + LDA ^O176001 ;GET THE CHARACTER. + REPEAT 4, + 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=*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 </256>-</256>,< + DEC TXTPTR+1> + LDAI -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, + LDYI 0 +IFE BUFPAG, + 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, + 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, ;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==<<-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, ;TURN ON B7 FOR APPLE. +IFN REALIO,< +OUTLOC: JSR OUTCH> ;OUTPUT THE CHARACTER. +IFE REALIO-1,< + LDY KIMY> ;GET Y BACK. +IFE REALIO-2,> +IFE REALIO-4, ;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 ;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 + 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-/256*256 ;IS EVAL CALLING? + BNE NOTEVL ;NO, CARRY ON. +IFN REALIO-3,< + TSX + LDA 258,X + CMPI </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, + 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, ;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, ;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, +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,> +.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, ;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, ;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 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, ;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, + +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, ;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, +IFE REALIO-5, +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, + END $Z+START \ No newline at end of file