/BRTS.PA EXTENDED VERSION /ORIGINALLY: /Commercial Basic Runtime System, V EX / / / / / / / / / / / /COPYRIGHT (C) 1972, 1973, 1974, 1975, 1977, 1978, 1979, 1981, 1982, 1983, 1984 /Digital Equipment Corporation, Maynard, Ma. / / / /This software is furnished under a license for use only on a /single computer system and may be copied only with the inclu- /sion of the above copyright notice. This software, or any other /copies thereof, may not be provided or otherwise made available /to any other person except for use on such system and to one who /agrees to these license terms. Title to and ownership of the /software shall at all times remain in DEC. / / /The information in this software is subject to change without /notice and BUGS / 04-MAY-77 REWROTE FLOATING POINT OUTPUT ROUTINE TO INCREASE ACCURACY / 26-JAN-78 REMOVE TTY RING BUFFER, ADD 8 BIT ASCII / 03-FEB-78 ADD STRING ARITHMETIC INTERFACE / 22-FEB-78 ADD PRINT USING / 28-FEB-78 ADD TEXT ERROR MESSAGES / 22-MAR-78 ADD GENERAL 2 PAGE SYSTEM HANDLER RELOCATION / 28-MAR-78 INSTALL EXTENDED FIELD 1 CODE / 01-APR-78 TIGHTEN UP FILE I/O ROUTINES, RELOCATE TTY HANDLER / 02-APR-78 PUT IN DIRECT ACCESS PRIMITIVES / 09-APR-78 EXTEND OVERLAYS TO 3 BLKS, MOVE JMP TABLES TO OVERLAYS / 14-APR-78 CLEAN UP LOGIC IN FILE OPEN/CLOSE ROUTINES / 15-APR-78 ADD CAP$ FN, MAKE DATE RETURN DD-MMM-YY FORMAT / 18-APR-78 FIXUP LOGIC IN CHAINING ROUTINE / 20-APR-78 ADD IFOPEN STMT, NON FATAL ENTER/LOOKUP ERROR FEATURE / FIX BUG WITH LARGE PRE COMPILED PROGRAMS UNDER BATCH / 07-MAY-78 ADD OCT, BIN, KEY$, CCL$, AND PMT$ FUNCTIONS / PUT IN IN-CORE OVERLAY SHUFFLER, EXPAND TO 7 I/O FILES / 15-MAY-78 ADDED ON-GOTO/GOSUB FEATURE, CLOSE ALL FEATURE / 23-MAY-78 REWROTE FFIN ROUTINE FOR GREATER ACCURACY / 2-FEB-79 CHANGES MADE FOR HANDLER ENHANCEMENT: / 1. VERSION CHANGED TO V7. / 2. FIELD ZERO LOAD CONSTANTS CHANGED / 3. FIELD ONE LOAD CONSTANTS CHANGED / 4. I/O BUFFERS REDUCED TO FIVE (TWO PAGERS) / 5. LINKAGES TO FFXXX INSERTED AND TWO SMALL ROUTINES / MOVED TO FIELD ONE. / 6. PAGE ZERO FIELD 1 REFERENCES RESESTABLISHED / 7. HANDLER BUFFFER AREA INCREASED TO SIX PAGES / 8. MOVED FFOUT, FFIN (FFXXX) TO FIELD ONE / / 5-MAR-79 INSTALL SOURCE FIX FOR INITIALIZ should not be construed as a commitment by Digital /Equipment Corporation. / /DEC assumes no responsibility for the use or reliability of its /software on equipment which is not supplied by DEC. / / / / / / /AUGUST 19, 1972 / 21-APR-77 ADDED EXTENDED DATE CODE, CLEANED UP LISTING / 26-APR-77 TIGHTENED UP STRING ROUTINES / 28-APR-77 ADD SOURCE FIX FOR SEVERAL KNOWN/ SCREEN SETTLING TIME / 07-APR-82 1. FIXED IF OPEN & IF END FOR CMB LINE STATEMENTS / 19-APR-82 1. ADDED ON ERROR GOTO, RESUME, TRAP / 2. RE-WRITE OF ERROR OVERLAY / 3. REMOVED EAE AND VT278 CONDITIONALS / 04-OCT-82 1. MOVED KEY FUNCTION FOR ESC KEY INPUT / 18-JAN-83 WRITE 200 CODE (NULL) AS FILLER FOR REC. / I/O FILED FILLERS TO ALLOW REMOVAL ON GET COMMAND / 27-JAN-83 ADDED CALL COMMAND IN STORE/RECALL / / 16-JUL-84 Fixed CAL, RECALL error if file crash if file not found / Fixed Store error if empty is > 4000 blocks / 30-AUG-84 Add time out loop for KEY$ command / ON ERROR GOTO 0 now realy turns it off / 20-SEP-84 Fix SSI to work on DECmate II VERSON= "B /VERSION OF BRTS LOCATED AT TAG "VERLOC" SUBVER= 0 /SUBVERSION OF BRTS SUBVAF= 0 /SUBVERSION OF MATH FUNCTIONS OVERLAY SUBVSF= 1 /SUBVERSION OF STRING FUNCTIONS OVERLAY SUBVEF= 1 /SUBVERSION OF BASIC ERROR MESSAGE OVERLAY SUBVFF= 1 /SUBVERSION OF FILE FUNCTIONS OVERLAY SUBVEX= 5 /SUBVERSION OF GRAPHIC FUNCTION OVERLAY SUBVSR= 4 /SUBVERSION OF STORE AND RECALL OVERLAY /FIRST WORD OF EACH OVERLAY CONTAINS /6 BIT VERSON IN LEFT HALF AND 60+SUBVERSION OF OVERLAY /IN RIGHT HALF. /OS/8 SYSTEM DEFINES MDATE= 7666 /CONTAINS OS/8 DATE IN FIELD 1 BIPCCL= 7777 /CONTAINS YEAR EXTENSION BITS, BATCH FLAG AND BATCH FIELD JSW= 7746 /OS/8 JSW IN FIELD 0 CDOPT2= 7642 /HIGH ORDER CD = OPTION AND ALTMODE FLAG CDOPT3= 7643 /CD SWITCHES [ABC DEF GHI JKL] CDOPT4= 7644 /CD SWITCHES [MNO PQR STU VWX] ATION BUG / 17-FEB-81 MODIFICATION FOR OS78 V4 (VT278) / 01-JAN-82 CHANGES AND ENHANCEMENTS / 1. ADDED GRAPHIC COMMANDS / ADDED EXIT, AND SLEEP / 2. REMOVED BASIC.UF CAPABILITIES / 3. CREATED BASIC.EX, BASIC.SR OVERLAYS / AND INSTALLED THEM INTO BASIC.OV / 02-APR-82 1. CHANGED THE KEY COMMAND TO TIMED INPUT / ADDED TIME DELAY IN BASIC.EX/SR FOR VT278 IELD 1 LOAD DURING CHAIN BCLOD1= 2000 /BCOMP LOAD ADDR IN FIELD 1 FOR CHAIN STATEMENT CCHAIN= 3201 /ENTRY POINT OF BCOMP IN FIELD 1 FOR CHAIN STATEMENT EDTBGN= 0201 /ENTRY POINT FOR EDITOR RESTART EDTSIZ= 2400 /HANDLER SIZE CONTROL WORD FOR EDITOR READ BUFAREA=5400 /I/O BUFFER AREA IN FIELD 1 (MUST BE ON EVEN BOUNDRY) HAREA= 6200 /BASE ADDR OF HANDLER LOAD AREA IN FIELD 0 MAXFIL= 5 /MAXIMUM FILE NUMBER ALLOWED MAGIC= 1234 /MAGIC CD = OPTION TELLS BASIC .SV PROGRAMS /THEY'RE BEING CHAINED TO FROM BRTS INFO= 7604 /BASIC SYSTEM INFORMATION AREA IN FIELD 1 /INFO STARTING BLOCK +1 OF BASIC.SV /INFO+1 STARTING BLOCK +1 OF BCOMP.SV /INFO+2 STARTING BLOCK +1 OF BLOAD.SV /INFO+3 STARTING BLOCK +1 OF BRTS.SV /INFO+4 STARTING BLOCK +1 OF BASIC.OV /INFO+5 *UNUSED* /INFO+6 *UNUSED* /INFO+7 *UNUSED* /INFO+10 STARTING BLOCK OF BASIC.TM /INFO+11 SIZE IN BLOCKS OF BASIC.TM /INFO+12 INPUT HANDLER ENTRY ADDRESS /INFO+13 SIZE AND DEVICE NUMBER OF INPUT FILE /INFO+14 STARTING BLOCK OF INPUT FILE /INFO+15 THROUGH /INFO+20 NAME OF WORKSPACE RECPAK= 400 /ORIGIN IN FIELD 1 OF RECORD I/O CODE /STRING AR CDOPT5= 7645 /CD SWITCHES [YZ0 123 456 789] CDOPT6= 7646 /LOW ORDER CD = OPTION SCOPWD= 7726 /WORD CONTAINING SCOPE FLAG IN 200 BIT V278WD= 7771 /WORD CONTAINING VT278 FLAG IN 4 BIT - FIELD 1 USRDHT= 0037 /POINTER TO USR DEVICE HANDLER TABLE IN FIELD 1 RESTBL= 7647 /ADDR OF DEVICE RESIDENCY TABLE IN FIELD 1 CCLMAX= 47 /MAX SIZE COMMAND STRING FOR CCL /BRTS SYSTEM DEFINES EDBLK= 7604 /CONTAINS BLOCK NUMBER OF EDITOR WIDTH= 204 /WIDTH OF PRINTER COLWID= 16 /WIDTH OF ONE PRINT COLUMN SACLIM= 205 /DEFINE WIDTH OF STRING ACCUMULATOR SAC= 200 /DEFINE ADDR OF SAC IN FIELD 1 OVERLAY=3400 /ADDRESS OF START OF 6 PAGE OVERLAY BUFFER BRTSZ0= 3100 /HANDLER SIZE CONTROL WORD FOR FIELD 0 OF BRTS BCSIZ1= 1000 /BCOMP SIZE CONTROL WORD FOR F RECALL ARE AT 35000-36377 / /TO CREATE SAVE IMAGE FILES PRIOR TO RUNNING BASIC, /ASSEMBLE THIS SOURCE IN A 16K OR MORE MACHINE,THEN /PERFORM THE FOLLOWING SEQUENCE OF OS/8 COMMANDS / / / ASSEMBLY INSTRUCTIONS /.PAL BRTS.BN 80,000 /.STRING FETCH WHEN COUNT IS IN ONE FLD & / TEXT IS IN THE NEXT AC4000= CLA STL RAR AC2000= CLA STL RTR AC0002= CLA STL RTL AC7775= CLL STA RTL AC7776= CLL STA RAL AC3777= CLL STA RAR AC5777= CLL STA RTR /PAGE 0 LOCATIONS *1 ERRNUM, 0 ERLINL, 0 ERLINH, 0 ERRCOD, 0 ERRFLD, 0 *6 USECON, 0 /USE CONSTANT GENERATED BY "USE" STATEMENT FSTOP1, CCTRAP /POINTER TO RTS EXIT ROUTINE USED /BY ^C HOOKS IN SYSTEM HANDLER. *10 SACXR, 0 /INDEX REGISTER FOR STRING ROUTINES XR1, 0 XR2, 0 XR3, 0 XR4, 0 /INDEX REGISTERS XR5, 0 DATAXR, 0 /POINTER FOR IN-CORE DATA LIST LWIDTH, -WIDTH /COMMON WIDTH FOR PRINTER *20 /COMPILER-INTERITHMETIC LINKAGES STPACK= 2000 /ORIGIN IN FIELD 1 OF STRING ARITHMETIC PACKAGE ABUF= STPACK+2001 BBUF= STPACK+2023 SBUF= STPACK+2103 FMTBUF= STPACK+2142 SADD= STPACK SSUB= STPACK+2 SISUB= STPACK+4 SMUL= STPACK+6 SDIV= STPACK+10 SIDIV= STPACK+12 USING= STPACK+1232 SINTEG= STPACK+707 UINIT= STPACK+2000 DI= STPACK+242 DP= STPACK+245 DM= STPACK+250 OVS= STPACK+326 DVS= STPACK+1011 /WHEN ASSEMBLED AND LOADED VIA THE ABS. LOADER,THE /CORE LAYOUT IS AS FOLLOWS: / /BRTS IS AT 0-6177,10000-15377 / / OVERLAY BREAKDOWN / /MATH FUNCTIONS ARE AT 03400-04777 /STRING FUNCTIONS ARE AT 22000-23377 /ERROR MESSAGES ARE AT 23400-24777 /GRAPHIC FUNCTIONS ARE AT 32000-33377 /FILE FUNCTIONS ARE AT 33400-34777 /STORE ANDPORARY AC1, 0 /VOLATILE TEMPORARY AC2, 0 /VOLATILE TEMPORARY TM, 0 ACX, 0 /FAC EXPONENT ACH, 0 /FAC HIGH ORDER FRACTION ACL, 0 /FAC LOW ORDER FRACTION OPX, 0 /OPERAND EXPONENT OPH, 0 /OPERAND HIGH ORDER FRACTION OPL, 0 /OPERAND LOW ORDER FRACTION CHAR, 0 /LAST CHAR READ FROM ASCII FILE /SYSTEM REGISTERS USED OFTEN BY INTERPRETER CODE MODESW, 0 /0 FOR ARTHIMETIC MODE,1 FOR STRING MODE INSAV, 0 /CURRENT PSEUDO-INSTRUCTION BEING EXECUTED LINEHI, 0 /HI ORDER BITS OF LINE # CURRENTLY BEING EXECUTED LINELO, 0 /LOW ORDER BITS OF CURRENT LINE NUMBER STRMAX, 0 /MAXIMUM # OF CHARS ALLOWED IN CURRENT STRING STRCNT, 0 /- # OF CHARACTERS IN CURRENT STRING STRPTR, 0 /POINTER TO SIZE WORD OF CURRENT OPERAND STRING IOMASK, 177 /MASK PRETER CONTROL BLOCK. LOCATIONS MARKED BY /A /* ARE EXPECTED TO CONTAIN VALUES SUPPLIED BY THE COMPILER PRIOR /TO THE BRTS LOAD CDFIO, 0 /* CDF FOR I/O TABLE AND SYMBOL TABLES SCSTRT, 0 /* POINTER TO START OF SCALAR SYMBOL TABLE ARSTRT, 0 /* POINTER TO START OF ARRAY SYMBOL TABLE-1 STSTRT, 0 /* POINTER TO START OF STRING SYMBOL TABLE-1 SASTRT, 0 /* POINTER TO START OF STRING ARRAY TABLE-1 CDFPS, 0 /* CDF FOR START OF PSEUDO-CODE PSSTRT, 0 /* POINTER TO START OF PSEUDO CODE-1 DLSTOP, 0 /* POINTER TO TOP OF DATA LIST DLSTRT, 0 /* POINTER TO BOTTOM OF INCORE DATA LIST-1 PSFLAG, 0 /* OS/8 SWAPPING FLAGS WORD /BIT 0 SET IF OS/8 SAVED IN N7400 INSTEAD OF N7600 / FOR 2 PAGE SYSTEM HANDLER /BIT 11 SET IF 17600 IS IN 17600. BIT 11 TOGGLED BY /PSWAP ROUTINE /SYSTEM REGISTERS SACLEN, 0 /LENGTH OF STRING IN SAC S1, 0 /SUBSCRIPT 1 (MUST BE FOLLOWED BY S2!) S2, 0 /SUBSCRIPT 2 (MUST BE PRECEDED BY S1!) DMAP, 0 /MAP OF DRIVER PAGES BUFSTK, BSTACK /STACK OF FREE I/O BUFFERS *37 /FLOATING POINT PACKAGE LOCATIONS, CONSIDERED VOLATILE FF, 0 /SPECIAL MODE FLIP-FLOP AC0, 0 /VOLATILE TEM ACCESS IOTSUB, TTYF+10 /POINTER TO CURRENT RECORD FIELD LENGTH IOTNRH, TTYF+11 /HIGH ORDER MAX RECORD SO FAR IOTNRL, TTYF+12 /LOW ORDER MAX (NUMBER LT 384*2**12) IOTMAX, TTYF+13 / DEVICE / (FILE MAXIMUM LENGTH) IOTPOS, TTYF+14 / NAME / (POSITION OF PRINT HEAD) IOTFIL, TTYF+15 / / TTYF+16 / FILE / TTYF+17 / NAME / TTYF+20 / .EX IOTDEV= IOTMAX IOTEND= IOTFIL+4 /END OF FILENAME AND LAST WORD IN IOTABLE IOTSIZ= IOTEND+1-IOTHDR /CURRENT SIZE OF IO TABLE SAVCHR, 0 /CHARACTER SAVE BUFFER V278FG, 0 /VT278 FLAG K4, 4 K60, 60 KBRACK, "[&177 /BRACKET KESC, "[&77 /ESCAPE KSEMI, ";&177 /SEMICOLON CUR4K, CUR4 PVH52, JMS I CUR4K /VT52 CURSOR POSITIONING LOADOV, OVLOAD /INDIRECT TO 'OVLOAD' FIX23I, FIX23 /INDIRECT TO 'FIX23' SCWORD FOR 7 OR 8 BIT I/O TEMP1, 0 TEMP2, 0 DECEXP= TM /I/O TABLE POINTER AREA-THIS BLOCK HOLDS POINTERS TO THE I/O TABLE /ENTRY FOR THE CURRENT FILE.THE POINTERS ARE CHANGED EVERY TIME AN /SFN IS EXECUTED. A TAD I OFF ONE OF THE POINTERS WILL GET THE INFORMATION /NOTED IN THE COMMENT FOR THE CURRENT I/O DEVICE /THIS BLOCK IS INITIALIZED FOR TTY /THE FORMAT OF THE HEADER WORD IS AS FOLLOWS /BITS USAGE /0-3 OS/8 DEVICE NUMBER /4 FLAG SET IF NEXT CHAR IS 3RD CHAR IN PREV DOUBLEWORD /5 UNUSED /6 SET IF BUFFER HAS BEEN MODIFIED AND NEEDS TO BE WRITTEN /7 SET IF NOT FILE STRUCTURED DEVICE /8 SET IF HANDLER IS 2 PAGES LONG /9 SET IF VARIABLE LENGTH (OUTPUT) FILE /10 SET IF EOF /11 SET IF ASCII FILE, CLEAR IF NUMERIC IMAGE FILE ENTNO, 0 /ENTRY NUMBER NOW IN AREA IOTHDR, TTYF /HEADER WORD IOTBUF, TTYF+1 /BUFFER ADDRESS IOTBLK, TTYF+2 /CURRENT BLOCK IN BUFFER IOTPTR, TTYF+3 /READ\WRITE POINTER IOTHND, TTYF+4 /HANDLER ENTRY POINT IOTLOC, TTYF+5 /FILE STARTING BLOCK # IOTLEN, TTYF+6 /ACTUAL FILE LENGTH IOTRSZ, TTYF+7 /PHYSICAL RECORD LENGTH (INCLUDES CR/LF, ETC) /ZERO IF NOT RANDOM DCA .+1 HLT /JUMP TO APPROPRIATE ROUTINE JMSI, JMS I SEP1 /JMS USED FOR CALLS TO FPP BY AMODE INST JMPI, JMP I SEP1 /JMP USED TO CALL ROUTINES COMMON TO AMODE AND SMODE /JUMP TABLE FOR AMODE INSTRUCTIONS AJTAB, FFADD /FAC_C(A)+FAC OPCODE 0000 FFSUB /FAC_FAC-C(A) OPCODE 0400 FFMPY /FAC_FAC*C(A) OPCODE 1000 FFDIV /FAC_FAC/C(A) OPCODE 1400 FFGET /FAC_CSLOC, 0 /GRAPHICS TYPE INDICATOR FOR SCD, LCD. CURROW, 0 /ROW POSITION OF LAST CUR COMMAND CURCOL, 0 /LAST COL POSITION OF LAST CUR COMMAND ERRFLG, 0 RESCOD, 0 RESFLD, 0 TRPCHR, 0 /TWO'S COMP OF CHARACTER TO BE TRAPED *200 /FETCH NEXT PSEUDO WORD PWFECH, 0 ISZ INTPC /BUMP PSEUDO-CODE PROGRAM COUNTER JMP CDFPSU /NO-SKIP;JUST GET NEXT PSEUDO-CODE WORD TAD CDFPSU /SKIP MEANS WE HAVE TO INCREMENT PS-CODE FIELD TAD [10 DCA CDFPSU CDFPSU, HLT /SET DF TO FIELD OF PSEUDO-CODE TAD I INTPC /GET NEXT WORD OF CODE CDF 0 /SET DATA FIELD BACK TO INTERPRETER FIELD JMP I PWFECH /RETURN SSMODE, IAC /SET INTERPRETER TO STRING MODE AMODE, DCA MODESW /SET INTERPRETER TO ARITH MODE /FALL BACK INTO I-LOOP /BRTS I-LOOP ILOOP, CLA CLL /FLUSH DCA FF /PUT FPP IN SI MODE JMS PWFECH /GET NEXT PSEUDO-INSTRUCTION DCA INSAV /SAVE FOR LATER JMS I (CTCCHK /TEST IF ^C STRUCK TAD INSAV AND [7400 /STRIP TO OPCODE BITS CLL RTL RTL RAL /OPCODE NOW IN BITS 8-11 TAD (7770 /SUBTRACT 10 SMA /IS OPCODE <10? JMP SCASE /CALL TO INSTRUCTION COMMON TO SMODE AND AMODE DCA AC0 /YES-SAVE THE OFFSET TAD MODESW /WHICH MODE? SZA CLA JMP SMODE /STRING MODE TAD AC0 /ARITHMETIC MODE-GET OFFSET TAD JMSI /MAKE JMS TO FP PACKAGE ROUTINE DCA .+2 /PUT IN LINE JMS ARGPRE /SET UP ARGUMENT FROM SYMBOL TABLE ILOOPF, HLT /JMS TO THE FLOATING POINT PACKAGE ROUTINE NOP /FPP SOMETIMES RETURNS TO CALL+2 JMP ILOOP /DONE SCASE, TAD JMPI /JUST DISPATCH TO ROUTINE CALLED FOR7403 RETRNI /GOSUB RETURN OPCODE 7404 FUNC7I /CALL STORE&RECALL OPCODE 7405 LSUB1I /LOAD S1 FROM FAC OPCODE 7406 LSUB2I /LOAD S2 FROM FAC OPCODE 7407 FUNC6I /CALL FIELD 1 FUNCTIONS OPCODE 7410 READI /READ DEVICE OPCODE 7411 WRITEI /WRITE DEVICE OPCODE 7412 SWRITE /STRING WRITE OPCODE 7413 FUNC5I /CALL FILE FUNCTION OPCODE 7414 FUNC4I /CALL EXTENDED(A) OPCODE 2000 FFPUT /C(A)_FAC OPCODE 2400 FFSUB1 /FAC_C(A)-FAC OPCODE 3000 FFDIV1 /FAC_C(A)/FAC OPCODE 3400 /ALL INSTRUCTIONS BEYOND THIS POINT ARE COMMON TO AMODE AND SMODE SEP1, LS1I /S1_C(A) OPCODE 4000 LS2I /S2_C(A) OPCODE 4400 FJOCI /IF TRUE, PC_C(PC,PC+1) OPCODE 5000 ILOOP /NOP OPCODE 5400 LINEI /LINE NUMBER OPCODE 6000 ARRAYI /ARRAY INST OPCODE 6400 ILOOP /NOP OPCODE 7000 OPERI /OPERATE INST OPCODE 7400 SMODE, TAD AC0 /INST OFFSET TAD JMSSI /BUILD JMP OFF STRING TABLE DCA SDIS /PUT IN LINE CLL /CLEAR LINK FOR SCALAR STRING JMS I (STFIND /SET UP ARGUMENT ADDRESS SDIS, HLT /CALL STRING ROUTINE REQUESTED /JUMP TABLE FOR SMODE INSTRUCTIONS SJTAB, SCON1 /SAC_SAC&C(A$) OPCODE 0000 SCOMP /IF SAC .NE. C(A$),PC_PC+2 OPCODE 0400 SREAD /C(A$)_DEVICE OPCODE 1000 SARITH /STRING ARITHMETIC LINKAGE OPCODE 1400 SLOAD /SAC_C(A$) OPCODE 2000 SSTORE /C(A$)_SAC OPCODE 2400 INTPC, 0 /* INTERPRETER PC OPCODE 3000 JMSSI, JMP I .+1 /* SMODE DISPATCH JMP OPCODE 3400 /OPERATE CLASS INSTRUCTIONS OPERI, TAD INSAV /GET OPERATE INSTRUCTION AND [17 /MASK OFF OPERATE OPCODE TAD JMPI3 /BUILD JUMP OFF OPERATE JUMPTABLE DCA .+1 /STORE THE JUMP IN LINE HLT /DISPATCH TO PROPER OPERATE ROUTINE JMPI3, JMP I .+1 /JUMP TO OPERATE ROUTINE CALLED FOR /OPERATE JUMP TABLE FUNC3I /CALL RESIDENT FUNCTION OPCODE 7400 SPFUNC /SPECIAL FUNCTIONS OPCODE 7401 SFN /SET FILE NUMBER OPCODE 7402 FNEGI /NEGATE FAC OPCODE FUNCTION OPCODE 7415 FUNC1I /CALL FUNCTIONS 1 OPCODE 7416 FUNC2I /CALL FUNCTIONS 2 OPCODE 7417 /ARGPRE-ROUTINE TO TRANSLATE OPERAND FIELD INTO 12 BIT POINTER /INTO SCALAR TABLE FOR USE IN FPP CALLS. ARGPRE, 0 TAD INSAV /GET INSTRUCTION AND [377 /STRIP TO OPERAND FIELD DCA AC0 /SAVE TAD AC0 CLL RAL /*2 TAD AC0 /PTR*3 TAD SCSTRT /MAKE 12 BIT ADDR SCALDF, HLT /DF TO SCALAR FIELD (CDF INITIALIZED BY LOADER) JMP I ARGPRE /RETURN /ROUTINE TO ZERO FAC FACCLR, 0 CLA DCA ACX /ZERO EXPONENT DCA ACL /ZERO LOW FRACTION DCA ACH /ZERO HIGH FRACTION JMP I FACCLR /SPECIAL FUNCTIONS SPFUNC, JMS I [FBITGT /ISOLATE FUNCTION BITS TAD JMPSPC /MAKE A JUMP OFF SPECIAL FUNCTION TABLE DCA .+1 /PUT IN LINE HLT JMPSPC, JMP I .+1 /JUMP TO SPECIAL FUNCTION ROUTINE /SPECIAL FUNCTION JUMP TABLE SETF /SET FSWITCH 000 FRANDM /RANDOMIZE 020 ONPFX /ON-GOTO PREFIX 040 SRLIST /STRING READ FROM DATA LIST 060 CSFN /SET FILE # TO TTY 100 RDLIST /READ DATA LIST 120 AMODE /SWITCH TO A MODE 140 SSMODE /SWITCH TO S MODE 160 EXIT /FORCE EXIT IN GOSUB BUMP POINTER TABLE 200 PAGE /ON GOTO OR GOSUB ONPFX, TAD ACH /TEST SIGN OF ACH SMA SZA CLA /IF LE TREAT AS 0 JMS I [UNSFIX CIA /SET NEGATIVE COUNT DCA AC0 ONSRCH, JMS I [PWFECH /GET GOTO/GOSUB OPCODE SNA /SKP IF NOT END OF VECTOR JMP ON /GIVE WARNING AND CONTINUE DCA INSAV /SAVE IT JMS I [PWFECH /GET ADDRESS WITHIN FIELD DCA NEWPC /SAVE IT ISZ AC0 /TEST COUNT JMP ONSRCH /GET ANOTHER ONFLSH, JMS I [PWFECH /NOW FLUSH TO END OF LIST SNA CLA JMP JMPGO /JMP IF FLUSH DONE JMS I [PWFECH CLA JMP ONFLSH ON, JMS I [ERROR /PRINT WARNING JMP I [ILOOP /EXIT TO ILOOP /JUMP ON CONDITION FJOCI, JMS I [PWFECH /GET JMP ADDRESS DCA NEWPC /SAVE IT JMPGO, TAD INSAV /PICK UP OPCODE AND [17 /MASK OFF JUMP CONDITION SNA /IS IT GOSUB? JMP GOSUB /YES-PUSH PC ON STACK THEN JUMP TAD SKPTAD /BASE TAD FOR BUILD OF TAD INSTRUCTION DCA .+1 /PUT IN LINE HLT /GET PROPER SKIP DCA FSKIP /SET UP PROPER SKIP CONDITION TAD ACH /GET HIGH ORDER FAC JMP FSKIP /JMP IF FILE IS OPEN JXOPEN, CLL CLA /FLUSH ACH FROM AC TAD GSP+6 /GET A SNA CLA JMP .+3 JFOPEN, CLA /FLUSH ACH FROM AC TAD GSP+3 /GET A SZA CLA DCA FSKIP TAD I IOTHND /SEE IF HANDLER EP IS PRESENT JMP FSKIP /GO TEST FILE CONDITION /JUMP ON END OF FILE JXEOFI, CLL CLA /CLEAR ACH TAD GSP+6 /GET A SNA CLA JMP .+3 JEOFI, CLA /CLEAR HORD FROM AC TAD GSP+3 /GET A SZA CLA DCA FSKIP JMS I [IDLE /SEE IF FILE OPEN AC0002 /MASK FOR EOF BIT IN HEADER AND I IOTHDR /GET THAT BIT FSKIP, HLT /GET A SKIP OR JMP JMP SUCJMP JMP I [ILOOP /ELSE EXIT TO ILOOP SUCJMP, TAD INSAV /GET JUMP INSTRUCTION AND [340 /MASK OFF DESTINATION FIELD CLL RTR /SLIDE OVER TAD CDFINL /MAKE A CDF INSTRUCTION DCA I [CDFPSU /AND SET NEW PC INSTRUCTION FIELD TAD NEWPC /PICK UP NEW PC JMP SETPC /SET INTERPRETER PC AND EXIT /GOSUB GOSUB, TAD I GSP SMA CLA GS, JMS I [ERROR /ERROR IF STACK OVERFLOW TAD I [CDFPSU /ELSE GET CDF INSTR DCA I GSP ISZ GSP TAD I (INTPC DCA I GSP /STORE INT PC ISZ GSP JMP SUCJMP /EXEC AS NORMAL GOTO NOW /GOSUB RETURN RETRNI, JMS GSPTST /CHECK TO SEE IF THERE IS A RETURN ADDRESS DCA I [CDFPSU SKPTAD, TAD GSP /SET PTR TO ADDR DCA XR1 TAD I XR1 SETPC, DCA I (INTPC /SET PC JMP I [ILOOP /NOW RESUME EXECUTION NEWPC, 0 /FOR-LOOP JUMP ROUTINE /ENTER WITH AC = HORD JFOR, SNA /IS FAC=0? JMP I [ILOOP /YES-DO NOT JUMP TAD FSWITC /ADD FSWITCH SPA CLA /ARE SIGN BIT=FSWITCH? JMP I [ILOOP /NO-DO NOT JUMP JMP SUCJMP /YES-DO JUMP /ROUTINE TO INITIALIZE FSWITCH SETF, AC4000 AND ACH /ISOLATE SIGN OF MANTISSA DCA FSWITC /STORE IN FSWITCH JMP NORMAL IF OPEN COMMAND JMP JXOPEN /13 IF OPEN CMB LINE COMMAND JMP JXEOFI /14 IF END CMB LINE COMMAND /CALL TO DEVICE DRIVER FOR FILE I/O /ENTRY AC = FUNCTION WORD FOR READ OR WRITE /IOTABLE FOR CURRENT FILE HAS BLOCK, BUFFER ADDR, AND HANDLER ENTRY PT DRCALL, 0 DCA DRFUN /FUNCTION WORD INTO DRIVER CALL CDFINL, CDF /DF TO CURRENT FIELD TAD I IOTBUF /GET BUFFER ADDRE FROM I/O TABLE ENTRY DCA DRBUF /PUT IN DRIVER CALL TAD I IOTBLK /GET BLOCK NUMBER FROM I/O TABLE DCA DRBLK /PUT IN DRIVER CALL TAD I IOTHND /GET DRIVER ENTRY DCA DRIVER /SAVE JMS I DRIVER /CALL DRIVER DRFUN, 0 /FUNCTION CONTROL WORD DRBUF, 0 /BUFFER ADDRESS DRBLK, 0 /BLOCK # SMA CLA /DEVICE ERROR-IS IT FATAL? JMP I DRCALL /ALLS WELL DE, JMS I [ERROR /FATAL DRIVER, 0 GSPTST, 0 AC7776 /SET THE AC = -2 TAD GSP /AND ADD STACK POINTER DCA GSP /PUT IT BACK TAD I GSP /DO WE HAVE A CDF FOR A RETURN ADDR. SMA GR, JMS I [ERROR /FATAL ERROR IF NOT JMP I GSPTST /OK PAGE EXIT, JMS I (GSPTST /CHECK TO SEE IF A GOSUB HAS BEEN EXECUTED JMP I [ILOOP /NOW DO A GOTO /HANDLE SUBSCRIPTED NUMERIC AND STRING VARIABLES ARRAYI, TAD INSAV /FIRST GET OPCODE AND [340 CLL RTR RTR TAD MODESW /SHIFT MODE SWITCH TO LINK RAR TAD (AJTAB /ASSUME ARITHMETIC MODE SZL /SKP IF ARITH MODE TAD (SJTAB-AJTAB /CORRECT ADDR OF DISPATCH TABLE DCA ARAYOP /LINK MUST NOT TOGGLE ON ABOVE ADD TAD I ARAYOP /PICK UP DISPATCH ADDR DCA ARAYOP /SAVE IT SZL /SKP IF ARITH MODE JMP SARRY /ELSE DO STR I [ILOOP /DONE FSWITC, 0 /SKIP TABLE USED TO HOLD TESTS FOR VARIOUS CONDITIONS GSP, GSTCK /0 PUSHJ (STACK POINTER MUST PRECEDE SKIP TABLE) CLA /1 JUMPA SMA CLA /2 JUMPGE SZA CLA /3 JUMPN SMA SZA CLA /4 JUMPG SPA CLA /5 JUMPL SNA CLA /6 JUMPE SPA SNA CLA /7 JUMPLE JMP JFOR /10 FORLOOP JUMP ROUTINE JMP JFOPEN /11 NORMAL IF OPEN COMMAND JMP JEOFI /12IABLE DCA ADFC /PUT IN LINE AT END OF ROUTINE TAD I XR1 /GET ARRAY DIMENSION 1 DCA AC2 /SAVE TAD S1 /GET SUBSCRIPT 1 CLL CMA /SET UP 12 BIT COMPARE TAD AC2 /DIMENSION 1 +1 SNL CLA /S1 TOO BIG? SU, JMS I [ERROR /YES-SUBSCRIPT OUT OF BOUNDS ERROR DCA OPH /CLEAR TEMPORARY TAD I XR1 /GET DIMENSION 2 SNA /IS SECOND DIMENSION 0?(ARRAY UNIDIMENSIONAL) JMP ADCALC /YES-DON'T CHECK S2 FOR OUT OF BOUNDS CLL CIA /COMPARE TO SUBSCRIPT 2 TAD S2 SZL CLA /SKP IF S2 LO DIM2+1 JMP SU /ELSE TAKE ERROR EXIT TAD S2 /MULTIPLY DIM1+1 BY S2 JMS I (MPY /12 BY 12 MULTIPLY ROUTINE ADCALC, CLL TAD S1 /LORD OF S1+(DIM1+1)*S2 DCA OPX /SAVE RAL /CARRY TO BIT 11 TAD OPH /HORD OF S1+(DIM1+1)*S2 DCA OPH /SAVE TAD OPX /LORD OF S1+(DIM1+1)*S2 CLL RAL /*2 DCA OPL /LORD OF [S1+(DIM1+1)*S2]*2 TAD OPH /HORD OF S1+(DIM1+1)*S2 RAL /*2 DCA AC2 /HORD OF [S1+(DIM1+1)*S2]*2 CLL TAD OPX /LORD OF S1+(DIM1+1) TAD OPL /LORD OF [S1+(DIM1+1)*S2] DCA OPL /LORD OF 3*[S1+(DIM1+1)*S2] RAL /CARRY TO BIT 11 TAD OPH /HORD OF [S1+(DIM1+1)*S2)*2 TAD AC2 /HORD OF S1+(DIM1+1)*S2 DCA OPH /HORD OF 3*[S1+(DIM1+1)*S2] CLL TAD OPL /INDEX TO ELEMENT TAD TEMP2 /AC POINTS TO CORRECT ARRAY ELEMENT DCA XR1 /SAVE POINTER RAL /CARRY TO BIT 11 TAD OPH /COMBINE TO MAKE TOTAL # OF FIELD OVERLAPS CLL RTL RAL /SLIDE OVERLAPS TO FIELD BITS (6-8) TAD ADFC /ADD ANY CHANGE IN DATA FIELD TO CDF DCA ADFC /PUT ABSOLUTE CDF IN LINE IAC DCA FF /PUT FPP IN "SPECIAL MODE" ADFC, HLT /CHANGE DING ARRAY OPERATION TAD INSAV /GET ARRAY INSTRUCTION AND (37 /MASK OFF ARRAY OPERAND CLL RTL /MULTIPLY BY 4 (ENTRY LENGTH) TAD ARSTRT /MAKE POINTER INTO ARRAY TABLE DCA XR1 /POINTS TO ARRAY FOR THIS OPERATION ATABDF, HLT /CHANGE DF TO ARRAY TABLE FIELD (SET BY START) TAD I XR1 /GET POINTER TO FIRST ARRAY ELEMENT DCA TEMP2 /SAVE FOR LATER TAD I XR1 /GET DF FOR VAR TAD JMPRES /MAKE A JUMP OFF JUMP TABLE DCA .+1 HLT JMPRES, JMP I .+1 /JUMP TABLE FOR RESIDENT FUNCTIONS XABSVL /FUNCTION BITS 000 COMMA / 020 CRFUNC / 040 ILOOPF / 060 UNUSED TAB / 100 PNT / 120 ONERR / 140 PUINIT / 160 PRINT USING INIT PUEXEC / 200 PRINT USING OUTPUT CURSOR / 220 CURSOR POSITIONING FUNCTION OFFERR / 240 TURN "ON ERROR" OFF RESUME / 260 COL / 300 IO CHANNEL PRINT COLUMN NUMBER RESTOR / 320 RESTORE RESUM0 / 340 /CALL FOR FIELD 1 FUNCTIONS FUNC6I, JMS I [FBITGT /GET FUNCTION BITS CIF CDF 10 /JMP TO FIELD 1 DISPATCHER WITH AC = FUNCTION NUMBER JMP I (F1DISP PAGE /ERROR TRAPS O0, JMS I [ERROR /OVERFLOW DV, JMS I [ERROR /DIVISION ERROR JMS I [FACCLR /RETURN 0 IN FAC JMP I [ILOOP LM, JMS I [ERROR /ILLEGAL ARGUMENT ONERR, AC4000 DCA ERRFLG JMS I (PWFECH DCA ERRFLD JMS I (PWFECH DCA ERRCOD JMP I [ILOOP RESUME, CLL CLA IAC /DO WE HAVE AN ERROR AND ERRFLG SNA CLA RS, JMS I [ERROR /WE HAVE NO ERROR TO CLEAR SO REPORT IT RESUM0, AC4000 /CLEAR ERROR FLAG AND ERRFLG SKP OFFERR, CLL CLA / Turn on error oF TO DF OF ARRAY ELEMNT TAD XR1 /AC POINTS TO ARRAY ELEMENT JMS I ARAYOP /PERFORM REQUIRED OPERATION JMP I [ILOOP /FPP SOMETIMES RETURNS TO CALL+2 JMP I [ILOOP /DONE SARRY, JMS I (STFIND /INIT STRING ROUTINES (LINK ON) JMP I ARAYOP /JMP TO STRING ROUTINE ARAYOP, 0 /SUBROUTINE FBITGT-ROUTINE TO PUT FUNCTION BITS FROM INSTRUCTION INTO AC FBITGT, 0 TAD INSAV CLL RTR RTR /PUT FUNCTION BITS IN BITS 8-11 AND [17 /MASK THEM OFF JMP I FBITGT /RETURN /SUBROUTINE FTYPE-RETURNS TO CALL+1 IF FILE NUMERIC,CALL+2 IF ASCII FTYPE, 0 TAD I IOTHDR /GET HEADER CLL RAR /TYPE TO LINK SZL CLA /IS IT NUMERIC? ISZ FTYPE /NO-BUMP RETURN JMP I FTYPE /RETURN /CALL FOR RESIDENT FUNCTION FUNC3I, JMS I [FBITGT /ISOLATE FUNCTION # USE 'CUR6' FOR VT52 TAD ACL CUR2, JMS CUR6 /OUTPUT HOROZONTAL ADDR TAD ACL /NOW SET NEW HOROZONTAL PRINT POSITION AND IOMASK DCA I IOTPOS JMP I [SSMODE /RETURN IN SMODE CUR3, "[ /"[" CHANGED TO "Y" FOR VT52 //OUTPUT THE POSITION FOR THE CURSOR //FIRST TIME FOR VERTICAL POSITION //SECOND TIME FOR HORIZONTAL POSITION CUR4, 0 AND IOMASK /MASK TO 7 BITS TAD [40 /ADD TERMINAL BIAS JMS I [PUTCH /OUTPUT CURSOR ADDR JMP I CUR4 //OUTPUT THE VERTICAL POSITION FOR THE VT278 //AND THEN OUTPUT THE DELIMITER ';' CUR5, 0 JMS I [TWODEC /OUTPUT THE VERTICAL POSITION TAD KSEMI /OUTPUT ";" FOR VT278 JMS I [PUTCH JMP I CUR5 //OUTPUT THE HORIZONTAL POSITION FOR THE VT278 //AND THEN OUTPUT THE TERMINATING CHARACTER 'H' CUR6, 0 JMS I [TWODEC /OUTPUT THE HORIZONTAL POSITION TAD ("H&177 /OUTPUT "H" FOR VT278 JMS I [PUTCH JMP I CUR6 /COL(N) - RETURN PRINT COLUNM NUMBER FOR I/O CHANNEL N COL, JMS I (SETIOT /PICK UP RELATIVE ADDR OF IO CHANNEL N TAD (TTYF+IOTPOS-IOTHDR /MAKE ABSOLUTE PRINT POSITION ADDR DCA AC0 TAD I AC0 /GET IT /FALL INTO FLOAT ROUTINE FLOT12, DCA ACL /STOff DCA ERRFLG JMP I [ILOOP /CUR$(V,H) FUNCTION FOR VT52 & VT278 //CURRENTLY SET UP TO VT278 - MODIFIED FOR VT52 BY 'CHK52' /DIRECTLY OUTPUTS TO CURRENT I/O CHANNEL AND SETS NEW PRINT COLUMN /ADDR 0,0 IS UPPER LEFT CORNER OF SCREEN /SHOULD NORMALLY BE CALLED FROM PRINT STATEMENTS ONLY CURSOR, JMS FIXRGS /FIX THE ARGUMENTS DCA SACLEN /RETURN NULL STRING (SO PRINT POSITION WILL NOT ALTER) JMS I LOADOV /CALL IN THE ARITH. OVERLAY TAD TEMP1 /STORE LAST CURSOR POSITION OF CUR(X,Y) DCA CURROW TAD ACL DCA CURCOL JMS I [CHK52 /CHECK IF VT52 OR NOT TAD KESC JMS I [PUTCH /OUTPUT ESC TAD CUR3 /GET CHARACTER TO OUTPUT. JMS I [PUTCH /OUTPUT "[" FOR VT278, "Y" FOR VT52 TAD TEMP1 CUR1, JMS CUR5 /OUTPUT THE VERTICAL POSITION, ZBLOCK 3 PAGE /VT52 DELAY PARAMETERS (MUST BE AT BEGINNING OF PAGE) HEIGHT, 0 /NEGATIVE SCREEN HEIGHT DELAY, 0 /NEGATIVE DELAY VALUE IFNZRO HEIGHT-1200 <__FIX SET COMMAND__> HCTR, 0 /HEIGHT COUNTER INITIALIZED BY SET DCTR, 0 /DELAY COUNTER INITIALIZED BY SET /LOW LEVEL ROUTINE TO TYPE A CHAR PCH, 0 TLS /TYPE THE CURRENT ONE PCHLP, ISZ SPINNR /SPIN RND NUMBER SEED WHILE WAITING TSF /WAIT FOR THE CHAR JMP PCHLP AND IOMASK /MASK TO 7BIT TAD (-15 /TEST IF LINE FEED WILL BE SENT NEXT SZA CLA JMP PCHXIT /RETURN IF NOT ISZ HCTR /TEST SCREEN HEIGHT IF LF JMP PCHXIT /RETURN IF NOT AT BOTTOM OF SCREEN TAD HEIGHT DCA HCTR /RESET HEIGHT COUNTER NOW TAD DELAY SNA /TEST FOR ZERO DELAY JMP PCHXIT /RETURN IF SO DCRE 12 BIT INTEGER FLOTHI, DCA ACH /CLEAR HIGH ORDER BITS FLOT23, DCA AC1 /CLEAR OVERFLOW BITS TAD (27 /SET EXPONENT DCA ACX JMS I [FFNOR /NORMALIZE THE INTEGER JMP I [ILOOP /RETURN TO ILOOP /FIX TWO REAL ARGUMENTS TO 23 BITS FIXRGS, 0 JMS I FIX23I /FIX THE FAC TAD ACH /SAVE THE INTEGER DCA TEMP2 TAD ACL DCA TEMP1 DCA INSAV /GET TEMP0 JMS I PARGPRE JMS I [FFGET PARGPRE,ARGPRE JMS I FIX23I /FIX IT TOO JMP I FIXRGS /RETURN CALL1, JMS I (7607 /CALL SYSTEM HANDLER 0600 /READ 3 BLOCKS CALL2, OVERLAY /INTO OVERLAY AREA CALL3, HLT /BLOCK # OF FILE CALL4, JMS I [ERROR /ERROR JMS I (PSWAP /SWAP SYSTEM OUT JMP I CALL2 /START USER CODE /LINE NUMBERS LINEI, TAD INSAV /GET INSTRUCTION DCA LINEHI /SAVE JMS I [PWFECH /GET WORD FOLLOWING LINE # INST DCA LINELO /SAVE AS LOW ORDER LINE # TRHOOK, JMP I [ILOOP /RETURN TO I-LOOP TAD (5 /CALL ERROR OVERLAY JMS I LOADOV JMP I [TPRINT /NOW JMP TO PRINT ROUTINE /INTERMEDIATE CHAR BUFFER FOR "FFOUT" /AND A FEW FPP TEMPORARIES INTERB, ZBLOCK 7 FPPTM5, ZBLOCK 3 FPPTM4, ZBLOCK 3 FPPTM3, ZBLOCK 3 NUMBUF, FPPTM2, ZBLOCK 3 FPPTM1,L RTR SZA CLA /SKP IF EITHER JMP CLOKXT /ELSE GET THE CHAR AND RETURN RAL /LINK ON IF ^S DCA XFLAG /SET FLAG APPROPRIATELY JMP I CLOOK /RETURN CLOKXT, TAD SAVCHR /RETURN WITH THE CHARACTER JMP I CLOOK /RETURN CCTRAP, CLA IAC /SET COLUMN NONZERO TO FORCE CRLF BEFORE MESSAGE DCA I (TTYF+IOTPOS-IOTHDR CC, JMS I [ERROR /TAKE ERROR ABORT WITH MESSAGE XFLAG, 0 /^S FLAG (ALSO MARKS START OF GOSUB STACK) SPINNR, 0 /NEW RANDOM NUMBER SEED FOR RANDOMIZE (HIGH 12 BITS) /GOSUB STACK GSTCK, 6000;0 6000;0 6000;0 6000;0 6000;0 6000;0 6000;0 6000;0 6000;0 6000;0 6000;0 6000;0 6000;0 6000;0 6000;0 6000;0 6000;0 6000;0 6000;0 6000;0 6000;0 6000;0 6000;0 6000;0 6000;0 O2525, 2525 /POSITIA DCTR /ELSE SET DELAY COUNTER DLOOP, ISZ GCH /NOW EXEC INNER LOOP 4096 TIMES (USUALLY) JMP .-1 KSF /TEST IF KEY STRUCK SKP JMP PCHXIT /RETURN AT ONCE IF YES ISZ DCTR /TEST DELAY TIMER JMP DLOOP /REITERATE PCHXIT, JMS CTCCHK /TEST FOR ^C HIT KCC //ENABLE THE KEYBOARD FOR VT278 TAD XFLAG SZA CLA JMP PCHXIT /LOOP IF ^S HIT JMP I PCH /NOW ALLOW PRINTING TO CONTINUE /LOW LEVEL ROUTINE TO WAIT FOR A CHAR FROM THE CONSOLE GCH, 0 GCHLP, KSF JMP SPIN /SPIN RND SEED WHILE WE WAIT JMS CLOOK JMP I GCH SPIN, ISZ SPINNR NOP JMP GCHLP /CHECK FOR CONTROL C STRUCK CTCCHK, 0 CTCNOP, KSF /SEE IF A CHARCTER HAS BEEN STRUCK JMP I CTCCHK /NO, RETURN JMS CLOOK /GET THE CHARACTER CLL CLA JMP I CTCCHK /RETURN /GET A CHARACTER CLOOK, 0 KRB /SAMPLE CHAR AND IOMASK /REMOVE PARITY BIT DCA SAVCHR /SAVE THE CHARACTER TAD SAVCHR TAD TRPCHR /GET TRAP CHARACTER SNA CLA /AC = 0 IF THIS IS TRAP CHARACTER TR, JMS I [ERROR /SET ERROR FLAG, WE FOUND TRAP CHARACTER AC7775 /SET AC=-3 TAD SAVCHR SNA JMP CCTRAP /YES, ABORT EXECUTION TAD (3-21 /SEE IF ^Q (XON) OR ^S (XOFF) HIT CLACARG /SAVE THE AC TAD I CALLF0 /GET ROUTINE ADDR ISZ CALLF0 /BUMP PAST ROUTINE ADDR DCA SUBRTN CDF /SET DF TO OUR FIELD TAD ACARG /GET CALLING AC JMS I SUBRTN /CALL THE ROUTINE SKP /ALLOW SKIP RETURNS ISZ CALLF0 CIF CDF 10 /RETURN TO CALLER JMP I CALLF0 ACARG, 0 SUBRTN, 0 /OVERLAY LOAD ROUTINE OVLOAD, 0 DCA AC0 /STORE OVERLAY NUMBER PASSED IN AC CVE TO MARK THE END OF THE GOSUB STACK PAGE /INTERPRETER ERROR ROUTINE /ENTRY DF = CALLING FIELD IF NON FATAL ERROR /ACHTUNG! NON FATAL ERRORS FROM WITHIN OVERLAYS SWAP THEM OUT ERROR, 0 CLA CLL /ENTRY AC RANDOM RDF /READ DF OF CALLER TAD (CIF CDF 00 /STORE RETURN IN CASE NON FATAL DCA XERRRET CDF 00 CLA CLL IAC AND PSFLAG /TEST IF OS/8 17600 RESIDENT SZA CLA /SKP IF NOT JMS I [PSWAP /ELSE FORCE IT OUT TAD I (OVRLAY /SAVE PREVIOUS OVERLAY DCA OVSAVE TAD (5 /BRING IN ERROR OVERLAY JMS OVLOAD JMS I (ERRORR /JMP TO ERROR HANDLER TAD OVSAVE /NOW RESTORE PREV OVERLAY JMS OVLOAD XERRRET,HLT JMP I ERROR /RETURN TO CALLER IF NON FATAL ERROR OVSAVE, 0 /LOAD SUBSCRIPT 1 OR 2 FROM FAC OR MEMORY LSUB2I, ISZ DCASUB JMP LSUB1I LS2I, ISZ DCASUB LS1I, JMS I [FFPUT /SAVE THE FAC INTERB JMS I (ARGPRE /GET ARG POINTER INTO AC JMS I [FFGET /LOAD ARG INTO FAC (SKIPS NEXT INST ON RETURN) DCAS1, DCA S1 JMP .+3 LSUB1I, JMS I [FFPUT /SAVE THE FAC INTERB JMS I [UNSFIX /GET INT(FAC) DCASUB, DCA S1 /SET RESULT AS SUBSCRIPT 1 JMS I [FFGET /RESTORE THE FAC INTERB TAD DCAS1 DCA DCASUB /FUDGE INSTR BACK JMP I [ILOOP /NEXT INSTRCUTION /FUNCTION OVERLAY DRIVER FUNC4I, IAC /EXTENDED FUNCTIONS FUNC5I, IAC /FILE FUNCTIONS FUNC7I, IAC /STORE RECALL FUNC2I, IAC /STRING FUNCTIONS FUNC1I, JMS OVLOAD /MATH FUNCTIONS JMP I (OVDISP /JMP TO OVERLAY DISPATCHER /ROUTINE FOR CROSS FIELD SUBROUTINE CALLS CALLF0, 0 CDF 10 /ALWAYS SET DF TO 1 DCA K OF ARITHMETIC OVERLAY STRNGA, 0 /STARTING BLOCK OF STRING OVERLAY STRREC, 0 /STARTING BLOCK OF STORE AND RECALL FILEFA, 0 /STARTING BLOCK OF FILE OVERLAY USRA, 0 /STARTING BLOCK OF EXTENDED FUNCTIONS ERRA, 0 /STARTING BLOCK OF ERROR MESSAGE PROCESSOR /STRING ARITHMETIC INTERFACE SARITH, CLA IAC /CALL IN OVERLAY 1 JMS I LOADOV JMP I [XSARITH /NOW JMP TO STRING DF /DF TO THIS FIELD TAD AC0 /GET OVERLAY # AGAIN CIA /NEGATE TAD OVRLAY /COMPARE AGAINST OVERLAY FLAG SNA CLA /IS THE ONE WE WANT ALREADY RESIDENT? JMP I OVLOAD /YES-JUST JUMP TO FUNCTION TAD AC0 /NO-GET NUMBER OF OVERALY DESIRED TAD (ARITHA /USE AS OFFSET TO BUILD STARTING BLOCK TAD DCA TEMP2 /POINTS TO PROPER STARING BLOCK # TAD I TEMP2 /GET STARTING BLOCK FOR THIS OVERLAY SNA /SKP IF NON RESIDENT IN FIELD 2 JMP INCORE /ELSE DO FAST CORE SHUFFLE DCA OVADD /PUT IN DRIVER CALL JMS I (7607 /CALL SYSTEM HANDLER 0600 /OVERLAY 3400-4777 OVERLAY OVADD, 0 /STARTING BLOCK # OF OVERLAY OE, JMS I [ERROR /I/O ERROR JMP OVREDY /ALL SET, EXIT INCORE, TAD AC0 /CONVERT NEW OVERLAY NUMBER TO POINTER CLL RAR TAD AC0 /*3 RTR RTR /SHIFT TO PAGE BITS TAD (-1 /THEY START AT *20000 DCA XR1 TAD (OVERLAY-1 /NOW SET FIELD 0 PTR DCA XR2 TAD [7400 /MOVE 6 PAGES DCA TEMP2 OVMOVE, CDF 20 /GET A WORD FROM FIELD 2 TAD I XR1 CDF DCA I XR2 /STORE HERE IN OUR FIELD CDF 20 /DO 3 TIMES IN LINE TAD I XR1 CDF DCA I XR2 /SAVES 512 ISZ/JMP'S CDF 20 TAD I XR1 CDF DCA I XR2 ISZ TEMP2 JMP OVMOVE OVREDY, TAD AC0 DCA OVRLAY /CHANGE RESIDENT FLAG JMP I OVLOAD /--RETURN-- OVRLAY, 0 /# OF CURRENTLY RESIDENT OVERLAY /0=ARITHMETIC,1=STRING,2=STORE, RECALL /3=FILE, 4=EXTENDED, 5=ERROR /OVERLAY TABLE-CONTAINS STARTING BLOCK # OF SYSTEM OVERLAYS /INITIALIZED BY LOADER. ENTRY SET TO ZERO INDICATES OVERLAY RESIDENT IN FIELD 2 ARITHA, 0 /STARTING BLOCDISPATCH ROUTINE PAGE /ERROR EXIT FOR USER FUNCTIONS IA, JMS I [ERROR /ROUTINE TO FIX A POSITIVE 23 BIT INTEGER FROM FAC /RESULT IN ACH;ACL /ERROR IF NEGATIVE NUMBER OR OUT OF RANGE EXPONENT FIX23, 0 TAD ACH /FIRST TEST IF POSITIVE SPA CLA FM, JMS I [ERROR /JMP OUT IF ERROR TAD ACX /SEE IF LT 1 SPA SNA CLA /TRUNCATE TO ZERO IF YES TAD (-30 SMA /SKP IF RESULT LT 2**23 FO2, JMS I [ERROR /ELSE TAKE ERROR EXIT DCA ACX /SET SHIFT COUNTER TAD ACX /TEST IF MORE THAN 12. SHIFTS TAD (14 SMA JMP LT12 /JMP IF NO DCA ACX /DROP COUNTER DOWN IF YES TAD ACH /DO FAST WORD SHIFT DCA ACL DCA ACH LT12, CLA JMP FIXGO /JMP INTO LOOP FIXLUP, TAD ACH /NOW SHIFT DOUBLE WORD RIGHT CLL RAR DCA ACH TAD ACL RAR DCA ACL FIXGO, ISZ ACX /TEST IF DONE YET JMP FIXLUP /NO, ITERATE JMP I FIX23 /OK, RETURN /ROUTINE TO FIX A POSITIVE 12 BIT NUMBER FROM FAC /RETURN RESULT IN AC /SPECIAL CASE OF FIX23 UNSFIX, 0 CDF /RESET DF ON ENTRY JMS FIX23 /FIX THE FAC TAD ACH /SEE IF GE 2**12 SZA CLA /SKP IF NO FO, JMS I [ERROR /ELSE TAKE ERROR EXIT TAD ACL /OK, RETURN LOW 12 BITS JMP I UNSFIX /--RETURN-- /RESTORE ROUTINE RESTOR, TAD ENTNO /GET CURRENT FILE # SNA CLA /IS IT 0? JMP RESDLS /YES-RESTORE DATA LIST JMS I (WRBLK /NO-WRITE CURRENT BUFFER STA /-1 TAD I IOTLOC /STARTING BLOCK-1 DCA I IOTBLK /SET CURRENT BLOCK # TAD I IOTBUF /GET BUFFER ADDRESS DCA I IOTPTR /USE IT TO RESET READ\WRITE POINTER TAD I IOTHDR /GET HEADER WORD AND (7535 /CLEAR EOF BIT, BUFFER WRITTEN BIT, AND CHAR #3 FLAG DCA I IOTHDR JMS I (NEXREC /READ FIRST BLOCK INTO BUFFER JMP I [ILOOP /DONE RESDLS, TAD DLSTRT /ADDRESS OF START OF INCORE DATA LIST DCA DATAXR /USE IT TO RESET DATA LIST POINTER JMP I [ILOOP /THATS ALL! /SUBROUTINE STFIND-WHEN CALLED,IF LINK=1 STRING ARRAY TABLE IS /USED,IF LINK=0 STRING SYMBOL TABLE IS USED. RETURNS WITH AC SET /TO CDF OF OPERAND STRING,STRPTR POINTING TO THE FIRST WORD /IN THE STRING, AND THE MAX LENGTH OF THE STRING IS IN STRMAX. ALSO, /THE ACTUAL LENGTH OF THE STRING IS IN STRCNT STFIND, 0 SZL /IS THIS AN ARRAY INST? JMP SAFIND /YES-POINTER IS INTO ARRAY TABLE TAD INSAV /GET INST AGAIN AND [377 /ISOLATE OPERAND POINTER DCA AC0 /NO-SAVE OPERAND POINTER TAD AC0 /N CLL RAL /2N TAD AC0 /3N (3 WORDS/ENTRY) TAD STSTRT /ADD BASE ADR OF STRING TABLE STCOM, DCA XR2 /POINTER TO THIS ENTRY IN STRING TABLE STDF, HLT /DF TO THAT OF SYMBOL TABLES (SET BY START) TAD I XR2 /GET POINTER TO STRING DCA STRPTR TAD I XR2 /GET CDF FOR OPERAND STRING DCA STRCDF /SAVE TAD I XR2 /GET NUMBER OF WORDS PER STRING DCA STRMAX /SAVE SNL /ARRAY ELEMENT? JMP STRCDF /NO-SKIP THIS SUBSCRIPT CALCULATION TAD S1 /GET SUBSCRIPT STL CMA /SET UP 12 BIT COMPARE TAD I XR2 /GET DIMENSION SZL CLA /IS S1>DIMENSION? JMP I (SU /YES TAD STRMAX /GET NUMBER OF WORDS PER ELEMENT DCA AC2 /# OF WORDS IN EACH ARRAY ELEMENT TAD S1 /GET SUBSCRIPT JMS I (MPY /S1*ELEMENT LENGTH (ASSUMES LINK UNCHANGED ON RETURN) TAD STRPTR /ARRAY OFFSET+POINTER TO A(0) DCA STRPTR /FINAL STRING POINTER RAL /CARRY TO BIT 11 TAD OPH /ADD TO ACCUMLATED OVERLAPS FROM MULTIPLY CLL RTL RAL /PUT OVERLAP # INTO BITS 6-8 TAD STRCDF /ADD TO CDF IF NECESSARY DCA STRCDF /SAVE AGAIN STRCDF, 0 /DF TO STRING FIELD TAD I STRPTR CDF DCA STRCNT /STORE -(CURRENT LENGTH OF STRING) TAD STRCDF /CDF TO OPERAND IN AC DCA I (SSTEX /SETUP STRING STORE EXIT DF HERE STA /NOW SET MAX SIZE OF STRING IN CHARS TAD STRMAX CLL RAR TAD STRMAX CIA /NEGATE IAC /COMPENSATE FOR SIZE WORD DCA STRMAX JMS I (BYTSET /ENTER FUNCTIONS WITH BYTE POINTERS SETUP JMP I STFIND /RETURN SAFIND, TAD INSAV /GET INST AND (37 /ISOLATE OPERAND POINTER CLL RTL /4N (4 WORDS/ENTRY) LE SKP SFN, JMS SETIOT /GO GET ADDRESS OF IOTABLE FOR THIS CHANNEL TAD (TTYF /MAKE ABSOLUTE POINTER TO HEADER WORD DCA XR1 /STORE IN TEMP TAD ACL /SET ENTRY NUMBER FROM LOW FAC DCA ENTNO TAD (IOTHDR-1 /NOW POINT AT PAGE 0 AREA DCA XR2 TAD (IOTHDR-IOTFIL-1 /SETUP ALL BUT FILENAME DCA TEMP2 SFNLUP, TAD XR1 DCA I XR2 ISZ XR1 ISZ TEMP2 JMP SFNLUP /SET UP THE POINTERS NOW AC7776 /NOW GET USER RECORD SIZE (PHYS RECORD SIZE-2) TAD I IOTRSZ SZL /SKP IF HAVE A SIZE CLA /ELSE ASSUME 0, NOT DIRECT ACCESS CDF 10 DCA I (REMSIZ /STORE INITIAL REMAINING SIZE IN RECORD DCA I (EOLPTR /ZERO THE ONCE ONLY FLAG CDF TAD I IOTSUB /NOW SET THE FIELD POINTER CDF 10 DCA I (NXTFLD JMP I [ILOOP /--RETURN-- /ROUTINE TO PICK UP AND RANGE CHECK AN I/O CHANNEL NUMBER FROM FAC SETIOT, 0 JMS I [UNSFIX /FIX FAC TO GET FILE # STL TAD (-MAXFIL /IS RESULT A LEGAL FILE #? SNL SZA CLA FN, JMS I [ERROR /NO-ERROR TAD ACL /PICK UP FILE NUMBER CLL RAL /*2 CLL RTL /*10 TAD ACL /*11 CLL RAL /*22 IFNZRO IOTSIZ-22 <__ASSEMBLY ERROR__> JMP I SETIOT /RETURN WITH AC INDEXING INTO IOTABLE /ROUTINE TO RETURN RECORD FIELD DEFINITIONS TO FREELIST RTNDEF, 0 TAD I IOTSUB /GET HEAD OF USER DEFINED FIELDS CDF 10 RTNLUP, SNA /SKP IF HAVE ONE JMP EORETN /ELSE DONE DCA AC0 /SAVE IT TAD I AC0 /GET ITS LINK DCA AC1 /SAVE IT TAD I (FREHD /NOW GET THE CURRENT FREELIST PTR DCA I AC0 /STORE IN CURRENT FIELD BUFFER TAD AC0 /UPDATE FREELIST DCA I (FREHD TAD AC1 / TAD SASTRT /USE STRING ARRAY TABLE STL /SET LINK FOR ARRAY INST JMP STCOM /RETURN TO SUBROUTINE MAINLINE /PRINT USING INTERFACE PUINIT, CLA IAC /CALL OVERLAY 1 JMS I LOADOV JMP I [XPUINIT PAGE /ROUTINE SFN-ROUTINE TO RESET POINTERS IN PAGE ZERO FILE POINTER /AREA TO REFLECT A CHANGE IN THE CURRENT FILE NUMBER CSFN, DCA ACL /RESET CHANNEL NUMBER TO CONSORE IT BACK TAD HICORE /PICK UP ADDR OF HIGH CORE DCA TEMP2 /POINTER TO HIGH CORE P1CDF, HLT /DF TO HI CORE TAD I TEMP2 /GET WORD FROM HI CORE DCA TM /SAVE IT P2CDF, CDF 10 TAD I AC0 /GET WORD FROM 17600 P1CDF1, HLT /DF TO HI CORE AGAIN DCA I TEMP2 /PUT 17600 WORD IN HI CORE P2CDF1, CDF 10 TAD TM /GET SAVED HI CORE WORD DCA I AC0 /AND PUT IN 17600 ISZ TEMP2 /BUMP HI CORE POINTER P7600, 7600 /CLA ISZ AC0 /BUMP 17600 POINTER AND CHECK FOR DONE JMP P1CDF /NO DONE-MOVE NEXT WORD CDF JMP I PSWAP /DONE-RETURN HICORE, 0 /POINTS TO LOCATION OF 17600 SAVE AREA /STRING COMPARE /COMPARE SAC WITH MEMORY, BLANK EXTENDING THE /SHORTER STRING ON THE RIGHT SCOMP, DCA MODESW /SET INTERPRETER TO ARITH MODE NOW JMS I [FACCLR /TENTATIVELY ASSUME EQUAL (FAC = 0) SCOMLP, TAD STRCNT /IS THE MEMORY STRING EMPTY NOW? SNA CLA TAD L40 /PAD WITH SPACE IF YES SNA JMS I (LDB /LOAD NEXT BYTE IF NOT DCA TEMP2 TAD SACLEN /NOW IS THE SAC EMPTY SNA CLA TAD L40 /YES, PAD IT CDF 10 /GET INTO SAC FIELD SNA TAD I SACXR /NO GET IT CDF CLL CIA /COMPARE TO MEMORY TAD TEMP2 SZA CLA JMP SNEQ /JMP IF NOT EQUAL, L=SENSE OF COMPARE TAD STRCNT /IS MEMORY STRING DONE SZA CLA ISZ STRCNT /NO, BUMP COUNT L40, 40 /EFFECTIVE NOP TAD SACLEN /IS THE SAC EMPTY SZA CLA ISZ SACLEN /NO BUMP COUNT TAD SACLEN /GET SAC REMAINDER (SKP IF IS JUST ZERO) TAD STRCNT /ADD ARG REMAINDER SZA CLA JMP SCOMLP /LOOP IF BOTH NOT EMPTY JMP I [ILOOP /OTHERWISE EQUAL SNEQ, STA RAR DREPEAT FOR NEXT ONE JMP RTNLUP EORETN, CDF DCA I IOTSUB /ZERO THE RECORD FIELD LIST NOW JMP I RTNDEF /--RETURN-- /ROUTINE TO SWAP PG 17600 WITH N7400 OR N7600 (WHICHEVER THE CASE MAY BE) /WHERE N IS THE HIGH CORE FIELD PSWAP, 0 TAD P7600 /POINTER TO 17600 AND COUNTER DCA AC0 TAD PSFLAG /GET SWAPPING FLAGS RAR CML RAL /TOGGLE THE INPLACE BIT DCA PSFLAG /STOINTO SAC CIA TAD [SAC-1 DCA SACXR /TO STORE AFTER END OF PREV STRING SEGCOM, JMS I (LDB /GET A BYTE CDF 10 DCA I SACXR /STORE IT CDF STA TAD SACLEN /NOW BUMP SIZE OF SAC DCA SACLEN TAD SACLEN /CHECK IF ROOM LEFT TAD (SACLIM SPA CLA SC, JMS I [ERROR /FATAL ERROR IF SAC OVERFLOW ISZ STRCNT JMP SEGCOM /ITERATE IF MORE JMP I SCOMN /--RETURN-- /SUBROUTINE MPY- 12 BIT BY 12 BIT MULTIPLY. MULTIPLIES THE CONTENTS /OF AC2 BY THE CONTENTS OF THE AC,LEAVING THE HI RESULT IN OPH /AND THE LOW RESULT IN THE AC MPY, 0 DCA TEMP1 DCA OPH TAD (-14 DCA OPX MP12LP, TAD AC2 RAR DCA AC2 TAD OPH SNL JMP .+3 /12 BIT MULTIPLY USED TO FIND (DIM1+1)*S2 CLL TAD TEMP1 RAR DCA OPH ISZ OPX JMP MP12LP TAD AC2 /LORD OF (DIM1+1)*S2 IN AC RAR /HORD OF (DIM1+1)*S2 IN OPH JMP I MPY /RETURN /ROUTINE TO CHECK IF FILE IDLE IDLE, 0 TAD I IOTHND /GET HANDLER ENTRY SNA CLA /IS IT EMPTY? FI, JMS I [ERROR /YES-USER TRIED TO DO SOMETHING TO AN UNOPEN FILE JMP I IDLE /NO-RETURN /ROUTINE TO READ NEXT WORD IN DATALIST INTO AC DLREAD, 0 TAD DATAXR /DATA LIST POINTER CLL CMA /SET UP 1CA ACH /STORE SIGN BIT JMP I [ILOOP /--RETURN-- /FLOATING NEGATE FNEGI, JMS I [FFNEG JMP I [ILOOP PAGE /STRING DATA LIST READ, STRING LOAD AND STRING CONCATENATE NOP /PAD TO CHANGE VALUE OF TAG "SC" SRLIST, JMS DLREAD /FIRST READ NEG BYTE COUNT DCA STRCNT /STORE IT TAD DATAXR /NOW KLUDGE UP LDB ROUTINE DCA I (BYTPTR TAD (LDBL DCA I (GIVB TAD DLCDF DCA I (BYTCDF DCA SACLEN /CLEAR LENGTH OF CURRENT STRING JMS SCOMN /CALL COMMON CODE TAD I (BYTPTR /NOW RESTORE DATA LIST POINTER DCA DATAXR JMP I [ILOOP /DONE SLOAD, DCA SACLEN /CLEAR SAC LENGTH IF LOAD SCON1, JMS SCOMN /CALL COMMON CODE JMP I [ILOOP /DONE SCOMN, 0 TAD STRCNT SNA CLA JMP I SCOMN /NOTHING TO DO IF NULL STRING TAD SACLEN /COMPUTE OFFSET ED LENGTH? ISZ FOTYPE /NO-BUMP RETURN JMP I FOTYPE /RETURN /ABS(X) FUNCTION XABSVL, JMS ABSVAL /NEGATE FAC IF NEGATIVE JMP I [ILOOP /--RETURN-- /SUBROUTINE TO TAKE ABS VALUE OF FAC ABSVAL, 0 TAD ACH SPA CLA /IS FAC<0? JMS I [FFNEG /YES-NEGATE IT JMP I ABSVAL /RETURN /PNT(X) /SEND 8BIT CHAR TO THE CURRENT FILE PNT, JMS I [UNSFIX /FIX X AND [377 /MASK TO 8 BITS JMS I [PUTCH /PUT IN FILE BUFFER JMP I [ILOOP /DONE /ROUTINE TO ZERO THE CURRENT I/O BUFFER BLZERO, 0 STA TAD I IOTBUF DCA XR1 /POINT INTO THE BUFFER TAD [7400 DCA XR2 /SET COUNT TO 400 WORDS TAD (32 /INSERT A ^Z IN THE BUFFER FIRST CDF 10 DCA I XR1 ISZ XR2 JMP .-2 /LOOP FOR THE REST CDF JMP I BLZERO /--RETURN-- PAGE /STRING STORE SSTORE, TAD SACLEN SNA JMP I (SSTEX /EXIT IF NULL STRING IN SAC DCA AC0 /SET COUNT TAD SACLEN /SEE IF WILL FIT CIA TAD STRMAX SMA SZA CLA /SKP IF LEN.LE.MAX LEN SL, JMS I [ERROR /ERROR IF TARGET STRING TOO SMALL SSTLP, CDF 10 TAD I SACXR /PICK UP SAC BYTE CDF JMS I (DPB /STORE IT ISZ AC0 JMP SSTLP JMP I (SSTEX /--RETURN-- /STRING READ F2 BIT COMPARE TAD DLSTOP /ADDR OF END OF DATA LIST SNL CLA /POINTER AT END OF LIST? DA, JMS I [ERROR /YES DLCDF, . /NO-DF TO DATA LIST TAD I DATAXR /FETCH WORD FROM DATA LIST CDF JMP I DLREAD /DONE /RANDOMIZE STATEMENT FRANDM, TAD I (SPINNR /LOAD NEW VALUE INTO HIGH ORDER 12 BITS OF SEED DCA SEEDH JMP I [ILOOP /RETURN TO ILOOP SEEDH, 0 /31 BIT RANDOM NUMBER SEED FOR RND(0) SEEDL, 1000 SEED1, 140 /SUBROUTINE CR,LF CRLFR, 0 TAD [15 JMS I [PUTCH TAD (12 JMS I [PUTCH /PRINT A CR,AND LF / DCA I IOTPOS /ZERO NUMBER OF CHARS PRINTED SO FAR JMP I CRLFR /SUBROUTINE FOTYPE /RETURNS TO CALL+1 IF FILE FIXED LENGTH,CALL+2 IF VARIABLE FOTYPE, 0 TAD I IOTHDR /GET HEADER AND K4 /ISOLATE TYPE BIT SZA CLA /IS IT FIX0 /YES-PRINT A SPACE BEFORE DOING COMMA CALCULATION JMS I [PUTCH IAC DCA COMMAS /SET COMMA SWITCH JMP COMGO /JMP INTO TAB LOOP COMLUP, TAD TEMP2 /SEE IF PAST THIS TAB STOP CIA TAD I IOTPOS SPA JMP SLOVER /IF NUMBER OF CHARS SO FAR LT TAB STOP, TAB OUT SNA CLA JMP I [ILOOP /RETURN IF EXACTLY ON A COLUMN TAD TEMP2 COMGO, TAD (COLWID /MOVE UP TO NEXT COLUMN DCA TEMP2 TAD TEMP2 /SEE IF END OF THIS COL FITS ON OUR LINE TAD LWIDTH SPA SNA CLA /SKP IF NO, GIVE CRLF JMP COMLUP /TRY NEXT STOP /CARRIAGE RETURN FUNCTION (KNOWN ONLY TO COMPILER FOR TERMINATING /PRINT STATEMENTS) CRFUNC, STA TAD I IOTHDR CLL RTR SMA SNL CLA /SKP CRLF IF EOF SET OR NON ASCII FILE JMS I [CRLFR /DO AS WE ARE TOLD JMP I [ILOOP /NEXT INST ROM FILE TO MEMORY SREADL, TAD CHAR /DEPOSIT THE CHAR JMS I (DPB SREAD, JMS I (GETCH /GET CHAR FROM FILE TAD CHAR TAD (-15 /IS IS CR? SNA JMP I (SSTEX /YES, EXIT CLL /TEST IF FF, VT OR LF TAD (3 SZL CLA /SKP IF NO JMP SREAD /YES, IGNORE IT TAD I (BYTCNT /SEE IF THIS CHAR WILL FIT TAD STRMAX SPA CLA JMP SREADL ST, JMS I [ERROR JMP I (SSTEX /SET STRING SIZE AND EXIT /STRING WRITE FROM SAC TO DEVICE SWRITE, DCA COMMAS TAD SACLEN /SEE IF NULL STRING SNA JMP I [ILOOP /RETURN IF SO CIA TAD I IOTPOS /ADD TO NUMBER OF CHARS PRINTED SO FAR TAD LWIDTH SMA SZA CLA /SKP IF LE WIDTH OF LINE JMS I [CRLFR /ELSE RESET CARRAIGE TAD SACLEN DCA STRCNT /SET LOOP COUNTER TAD [SAC-1 DCA SACXR /POINT AT SAC SWRLP, CDF 10 TAD I SACXR CDF JMS I [PUTCH ISZ STRCNT JMP SWRLP /ITERATE IF MORE JMP I [ILOOP /--RETURN-- /COMMA FUNCTION (KNOWN ONLY TO COMPILER FOR FORMATTING PRINT /STATEMENTS) COMMA, JMS I [FTYPE /SKP IF FILE IS ASCII JMP I [ILOOP /NO-COMMA FUNCTION IS A NOP TAD COMMAS /GET COMMA SWITCH SNA CLA /WAS LAST THING PRINTED A COMMA? JMP .+3 /NO-WE ARE OK TAD [4LUDGE CONSTANT USED BY FIELD 1 FFOUT ROUTINE PAGE /INCREMENT AND LOAD 7 BIT BYTE FROM MEMORY /ENTRY DF MAY BE RANDOM LDB, 0 JMP I GIVB /COROUTINE RETURN GIVB, 0 CDF /RESET DF NOW AND IOMASK /MASK TO 7 OR 8 BIT JMP I LDB /--RETURN-- LDBL, JMS BUMP /BUMP POINTER AND SET DF TAD I BYTPTR /GET A WORD AND [7400 /MASK PART OF THIRD CHAR DCA BYT1 /SAVE TAD I BYTPTR /NOW GET WORD AGAIN JMS GIVB /CALL CALLER BACK JMS BUMP /BUMP POINTER AGAIN TAD I BYTPTR /GET CHAR AND [7400 /SAVE HIGH 4 BITS DCA BYT2 TAD I BYTPTR /GET WORD AGAIN JMS GIVB /RETURN TO CALLER TAD BYT2 /NOW COMBINE LOW AND HIGH NIBBLES CLL RTR RTR TAD BYT1 CLL RTR RTR JMS GIVB /GIVE TO CALLER JMP LDBL /LOOP FOR NEXT PAIR OF WORDS /INCREMENT /TAB FUNCTION TAB, JMS I [UNSFIX /FIX X TO INTEGER STL /REDUCE MODULO LINE WIDTH TAD LWIDTH SNL JMP .-3 CIA TAD LWIDTH /COL 0 IS LEFT MARGIN TAD I IOTPOS /COMPARE DESIRED COLUMN TO REAL COLUMN SMA /IS X>=CURRENT COLUMN? JMP I [ILOOP /YES-THEN DO NOTHING /FALL INTO SPACE OUT ROUTINE SLOVER, DCA COLCNT /-# OF COLUMNS TO NEXT MARKER JMS I [FTYPE /IS FILE NUMERIC? JMP I [ILOOP /YES-THIS IS A NOP TAD [40 /GET SPACE JMS I [PUTCH /PRINT IT ISZ COLCNT /THERE YET? JMP .-3 /NO-TYPE ANOTHER SPACE JMP I [ILOOP /YES-DONE COMMAS, 1 /SET TO 1 IF LAST PRINT WAS A COMMA MOVE COLCNT, 0 /LIST OF AVAILABLE I/O BUFFERS BSTACK, BUFAREA+2000 /ORDERED HIGH TO LOW ON ENTRY TO BRTS BUFAREA+1400 BUFAREA+1000 BUFAREA+0400 BUFAREA 0 /TERMINATED BY ZERO WORD /36 BIT SKIP IF FAC NONZERO FFOUT, 0 /HERE TO PROVIDE FIELD ONE LINKAGE CIF CDF 10 JMS I XFER1 JMP I FFOUT XFER1, FFOUT1 /POINTER TO FIELD ONE FLOATING POINT ROUTINE FFIN, 0 /HERE TO PROVIDE FIELD ONE LINKAGE CIF 10 JMS I XFER2 JMP I FFIN XFER2, FFIN1 /POINTER TO FILED ONE ROUTINE (BOTH MOVED) O5000, 5000 /K EXIT ROUTINE SSTEX, 0 /GETS SET BY STFIND TO DF OF STRING TAD BYTCNT /ENTER WITH POSITIVE LENGTH IN COUNT CIA DCA I STRPTR /STORE IN STRING JMP I [ILOOP /--RETURN-- (ILOOP RESETS DF) BYTCNT, 0 BYTPTR, 0 BYTE, 0 BYT1= BYTSET BYT2= BYTCD2 /WRITE AC INTO FILE BUFFER AND BUMP POINTER WRITFL, 0 DCA OPH /SAVE WORD JMS I [IDLE /FIRST TEST IF FILE OPEN TAD I AND DEPOSIT A 7BIT BYTE IN MEMORY /ENTRY DF MAY BE RANDOM DPB, 0 AND IOMASK /MASK TO 7 OR 8 BIT DCA BYTE /SAVE JMP I TAKB /RETURN TO COROUTINE TAKB, 0 DCA I BYTPTR /STORE WORD BACK NOW CDF /RESET DF ISZ BYTCNT /TALLY NUMBER OF BYTES STORED JMP I DPB /--RETURN-- DPBL, JMS BUMP /FIRST BUMP POINTER AND SET DF TAD BYTCDF /BACK UP CDF TO FIRST WORD DCA BYTCD1 TAD BYTPTR /SAVE POINTER TO FIRST WORD DCA BYT1 TAD BYTE /NOW GET THE BYTE JMS TAKB /STORE IT AND TAKE ANOTHER JMS BUMP /BUMP POINTER TAD BYTCDF /SAVE CDF TO WORD2 INLINE DCA BYTCD2 TAD BYTE /NOW GET BYTE JMS TAKB /STORE AND TAKE ANOTHER TAD BYTE /GET BYTE CLL RTL RTL AND [7400 BYTCD1, 0 TAD I BYT1 DCA I BYT1 /RESTORE WORD1 TAD BYTE /NOW ISOLATE LOW 4 BITS CLL RTR RTR RAR AND [7400 BYTCD2, 0 TAD I BYTPTR /ADD TO WORD2 JMS TAKB /STORE SECOND WORD AND RETURN TO CALLER JMP DPBL /REITERATE /BUMP BYTE POINTER BUMP, 0 ISZ BYTPTR /FIRST INCREMENT WORD POINTER JMP BYTCDF /JMP IF FIELD BOUNDRY NOT CROSSED TAD BYTCDF /ELSE PROPAGATE CARRY INTO CDF TAD [10 DCA BYTCDF BYTCDF, 0 JMP I BUMP /BYTE LOAD/STORE INITIALIZE ROUTINE BYTSET, 0 TAD SSTEX /GET FIELD OF STRING DCA BYTCDF /STORE INLINE TAD STRPTR /NOW GET ADDR OF COUNT WORD DCA BYTPTR /STORE TAD (LDBL /INITIALIZE COROUTINES NWO DCA GIVB TAD (DPBL DCA TAKB DCA BYTCNT /CLEAR DEPOSITED BYTE COUNT TAD [SAC-1 DCA SACXR /ALWAYS RETURN WITH SAC POINTER SET UP JMP I BYTSET /--RETURN-- /STRING STOREHIGH 4 BITS OF ODD CHAR CLL RTL RTL JMS P4BITS /MASK AND STORE THEM TAD AC0 /SHIFT LOW 4 BITS INTO PLACE CLL RTR RTR RAR JMS P4BITS /STORE THEM JMP I PUTCH /--RETURN-- PUTTTY, TAD AC0 /GET THE CHAR JMS I [PCH /PRINT ON THE CONSOLE JMP I PUTCH /--RETURN-- /COMBINE AND STORE 4 BITS OF ODD CHAR P4BITS, 0 AND [7400 /ISOLATE THE BITS DCA TEMP2 JMS B IOTPTR /IF OK, GET BUFFER POINTER DCA OPL /SAVE CDF 10 /GET INTO BUFFER SPACE TAD OPH /NOW STORE THE WORD DCA I OPL CDF /RESET DF ISZ I IOTPTR /BUMP BUFFER POINTER NOP /MAY SKIP IF LAST BUFFER TAD I IOTHDR /NOW SET BUFFER DIRTY BIT AND (7777-40 TAD [40 DCA I IOTHDR AC0002 /AFTER THE FACT, TEST IF EOF BIT SET AND I IOTHDR SNA CLA JMP I WRITFL /OK, RETURN WE, JMS I [ERROR /ELSE GIVE WARNING JMP I [ILOOP /ABORT TO ILOOP /CROSS FIELD LINKAGE FOR FFIN1 GETCH1, 0 JMS I IGETCH /CALL "GETCH" OR VAL INPUT ROUTINE CIF CDF 10 JMP I GETCH1 IGETCH, GETCH /ALTERED BY "VAL" ROUTINE; BE CAREFULL /PRINT USING INTERFACE PUEXEC, CLA IAC JMS I LOADOV /CALL OVERLAY 1 JMP I [XPUEXEC PAGE /ROUTINE TO SEND AN ASCII STREAM TO A FILE /ENTER WITH CHAR IN AC /PRESERVES UNUSED BITS IN 3/2 PACKED WORDS PUTCH, 0 DCA AC0 /SAVE THE CHAR JMS I [FTYPE /SKP IF FILE IS ASCII TYPE SW, JMS I [ERROR /TAKE ERROR IF NOT ISZ I IOTPOS /BUMP COL NUMBER TAD AC0 /RESET COLUMN NUMBER IF CHAR LT 40 TAD [-40 SPA CLA /SKP IF NON SPECIAL CODE DCA I IOTPOS /ELSE RESET IT (FOR ESCAPE SEQUENCES) TAD ENTNO /TEST IF FILE IS TTY SNA CLA JMP PUTTTY /HANDLE SEPARATELY IF YES JMS TH4TWO /SKP IF 3/2 PACKING BIT SET JMP PUT3RD /ELSE HANDLE ODD CHAR JMS BUFGET /GET CURRENT CONTENTS OF NEXT WORD AND [7400 /PRESERVE HIGH 4 BITS FOR RANDOM ACCESS I/O TAD AC0 /ADD THE NEW CHAR JMS I (WRITFL /WRITE BACK AND BUMP POINTER JMP I PUTCH /--RETURN-- PUT3RD, TAD AC0 /STORE UFGET /GET CONTENTS OF BUFFER WORD AND [377 /PRESERVE LOW 8 BITS TAD TEMP2 /ADD HIGH BITS JMS I (WRITFL /WRITE IN FILE AND BUMP POINTER JMP I P4BITS /ROUTINE TO GET AN ASCII STREAM FROM A FILE /RETURN WITH THE CHAR STORED IN "CHAR" GETCH, 0 JMS I [FTYPE /SKP IF FILE IS ASCII SR, JMS I [ERROR /TAKE ERROR EXIT IF NUMERIC IMAGE FILE GETLP, TAD ENTNO /TEST IF CONSOLE TTY SNA CLA JMP GETTTY /HANDLE SPECIALLY IF YES JMS TH4TWO /HANDLE ODD CHAR FLAG, SKP IF NOT SET JMP GET3RD /DO THE 3RD CHAR JMS READFL /READ A WORD JMP GETRTN /DO COMMON CODE GET3RD, JMS READFL /HANDLE ODD CHAR, GET HIGH 4 BITS AND [7400 DCA AC0 JMS READFL /GET LOW 4 BITS AND [7400 CLL RTR /SHIFT AND COMBINE RTR TAD AC0 RTR RTR GETRTN, AND IOMASK /MASK TO 7 OR 8 BITS DCA CHAR /STORE TAD CHAR /REGET CHAR GETCH2, SNA /Gets SKP from READSF JMP GETLP /IGNORE NULLS TAD (-32 /SEE IF ^Z GOTTEN SZA CLA /SKP INTO EOF ROUTINE IF YES JMP I GETCH /ELSE RETURN /ROUTINE TO SET EOF BIT IN I/O ENTRY EOFSET, TAD I IOTHDR /HEADER CLL RTR /EOF BIT TO LINK STL RTL /SET LINK /PUT LINK IN EOF BIT DCA I IOTHDR /STORE IN I/O TABLE ENTRY JMP I [ILOOP /EOF BIT SET-ABORT TO ILOOP GETTTY, CIF CDF 10 /CALL THE CONSOLE ROUTINE JMS I (TTYGCH JMP GETRTN /RETURN THE CHAR /COMMON ROUTINE TO HANDLE 3/2 PACKING BIT /GETS NEXT RECORD IF PAST END OF BUFFER /ADJUSTS POINTERS AS NECESSARY TH4TWO, 0 TAD I IOTHDR /TEST THE FLAG AND [200 SZA JMP DO3RD /JMP IF ODD CHAR IAC JMS I (BUFCHK /SEE IF NEED NEW BUFFERFULL IAC /SEE IF ODD CHAR WILL BE NEXT AND I IOTPTR SZA CLA /SKP IF NOT TAD [200 /TELL OURSELVES BY SETTING FLAG TAD I IOTHDR DCA I IOTHDR ISZ TH4TWO /RETURN TO CALL+2 JMP I TH4TWO DO3RD, CMA AND I IOTHDR DCA I IOTHDR /CLEAR THE BIT AC7776 /BACK UP THE POINTER FOR 3RD CHAR TAD I IOTPTR DCA I IOTPTR JMP I TH4TWO /RETURN TO CALL+1 /ROUTINE TO READ 1 WORD FROM A FILE AND BUMP POINTER READFL, 0 TAD I IOTRSZ /ALLOW READS OF OUTPUT FILE IF RANDOM ACCESS SNA CLA JMS I (FOTYPE /SKP IF OUTPUT ONLY FILE SKP VR, JMS I [ERROR /TAKE ERROR EXIT IF YES AC0002 /SEE IF END OF FILE BIT SET AND I IOTHDR SNA CLA JMP .+3 RE, JMS I [ERROR /GIVE WARNING IF YES JMP I [ILOOP /ABORT TO ILOOP JMS I [IDLE /TEST IF FILE OPEN OR NOT JMS BUFGET /OK, GET THE WORD ISZ I IOTPTR /BUMP POINTER JMP I READFL /MAY SKIP IF LAST BUFFER JMP I READFL /--RETURN-- /GET WORD FROM I/O BUFFER IN FIELD 1 BUFGET, 0 TAD I IOTPTR /GET POINTER DCA BFPTR CDF 10 /GET INTO BUFFER SPACE TAD I BFPTR /GET WORD CDF JMP I BUFGET /RETURN BFPTR, 0 PAGE /READ FLOATING POINT NUMBERS TO FAC FROM FILE OR DATA LIST READI, JMS I [FTYPE /SKP IF ASCII FILE JMP RIMAGE /HANDLE IMAGE FILE JMS I (FFIN /CALL FLOATING POINT INPUT ROUTINE JMP I [ILOOP /DONE RIMAGE, JMS BUFCHK /SEE IF BUFFER EMPTY TAD (READFL-DLREAD /SET FOR FILE READ RDLIST, TAD (DLREAD /SET FOR DATA LIST READ DCA ACL /STORE ROUTINE POINTER JMS I ACL /GET WORD DCA ACX /STORE 3 WORDS JMS I ACL DCA ACH JMS I ACL DCA ACL JMP I [ILOOP /DONE /WRITE FLOATING POINT NUMBER TO FILE FROM FAC WRITEI, JMS I [FTYPE /SKP IF FILE IS ASCII JMP WIMAGE /ELSE DO IMAGE WRITE JMS I (FFOUT /CONVERT INTERNAL TO ASCII TAD XR1 CIA TAD (INTERB-1 /CALCULATE NUMBER OF CHARS STORED IN BUFFER DCA TEMP1 /SAVE TAD (INTERB-1 DCA SACXR /NOW POINT SACXR INTO BUFFER TAD TEMP1 /GET COUNT OF CHARS TO BE PRINTED CIA TAD I IOTPOS /ADD TO PRINT HEAD POSITION TAD LWIDTH /COMPARE AGAINST LINE SIZE SMA SZA CLA /WILL THE NUMBER FIT ON THIS LINE? JMS I [CRLFR /NO-ISSUE A CR,LF CPLOOP, TAD I SACXR /GET CHAR FROM INTERMEDIATE BUFFER JMS I [PUTCH /PUT ON DEVICE ISZ TEMP1 /BUMP COUNTER JMP CPLOOP /NEXT TAD [40 JMS I [PUTFILE BUFCHK, 0 TAD I IOTBUF TAD [377 /SEE IF AT LAST WORD OF BUF CIA TAD I IOTPTR SNA CLA JMS NEXREC /GET NEXT RECORD IF YES JMP I BUFCHK /ROUTINE TO GET NEXT RECORD /IF FILE STRUCTURED DEVICE, WRITES CURRENT BLOCK (IF DIRTY) /AND READS NEXT BLOCK IF NOT NEW FILE ENTRY. IF EOF ENCOUNTERED, SETS EOF INSTEAD /MAY EXTEND FILE SIZE BY ONE BLOCK IF VARIABLE LENGTH OUTPUT FILE /IF NON FILE STRUCTURED INPUT FILE, JUST READS ANOTHER BUFFERFULL /IF NON FILE STRUCTURED OUTPUT FILE, WRITES BUFFER (IF DIRTY) NEXREC, 0 TAD I IOTHDR /GET HEADER AND (20 /GET READ/WRITE ONLY BIT SNA CLA /IS IT ON? JMP FILSTR /NO-DEVICE IS FILE STRUCTURED JMS I (FOTYPE /SKP IF VARIABLE LENGTH OUTPUT FILE JMP RONLY JMS WRBLK /WRITE BLOCK (UNLESS FILE JUST OPENED OR RESTORED) SKP RONLY, JMS BLREAD /READ NEXT BUFFER, OR DO BLOCK 0 INITIALIZATION ISZ I IOTBLK JMS BLINIT /INIT FILE TABLE ENTRIES JMP I NEXREC /DONE FILSTR, JMS WRBLK /WRITE THE CURRENT BLOCK IF IT HAS BEEN CHANGED JMS BLINIT /INIT FILE TABLE ENTRIES ISZ I IOTBLK /BUMP BLOCK # TAD I IOTLOC /STARTING BLOCK CIA /NEGATE TAD I IOTBLK /SUBTRACT FROM CURRENT BLOCK FOR FILE LENGTH CLL CMA /SET UP CURRENT FILE LENGTH FOR 12 BIT COMPARE TAD I IOTLEN /COMPARE TO ACTUAL LENGTH SNL CLA /IS IT > CURRENT LENGTH? JMP LASTB /YES-EXTEND THE FILE IF IT IS OUTPUT JMS BLREAD /READ IN THE NEXT RECORD JMP I NEXREC /RETURN LASTB, JMS I (FOTYPE /IS FILE FIXED LENGTH? JMP I [EOFSET /YES-SET EOF FLAG TAD I IOTLEN /NO-GET ACTCH /SEND OUT A SPACE AFTER NUMBER JMP WDONE /TAKE COMMON EXIT WIMAGE, JMS BUFCHK TAD ACX /EXPONENT JMS I (WRITFL /WRITE IN BUFFER TAD ACH /HIGH MANTISSA JMS I (WRITFL /WRITE IN BUFFER TAD ACL /LOW MANTISSA JMS I (WRITFL /WRITE IN BUFFER WDONE, DCA I (COMMAS /CLEAR COMMA SWITCH JMP I [ILOOP /WRITE IS DONE /END OF BUFFER TEST /AC = 1 IF ASCII FILE, 0 IF IMAGE 2 PAGES ONTO DEVICE WRBLK, 0 TAD I IOTHDR /GET FILE HEADER AND [40 /GET FILE WRITTEN BIT SNA CLA /HAS THIS BLOCK BEEN CHANGED? JMP I WRBLK /NO-RETURN TAD (4210 /"WRITE 2 PAGES" JMS I (DRCALL /CALL TO DEVICE HANDLER JMS I (BLZERO JMP I WRBLK /ROUTINE TO INITIALIZE I/O TABLE ENTRIES AFTER READ OR WRITE BLINIT, 0 TAD I IOTBUF DCA I IOTPTR /INIT READ/WRITE POINTER TAD I IOTHDR AND (7537 /CLEAR DIRTY BIT AND CHAR #3 FLAG DCA I IOTHDR JMP I BLINIT PAGE ///////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////// //////////// OVERLAY BUFFER 3400-4777 //////////////////// //////////// CONTAINS FUNCTION OVERLAYS //////////////////// //////////// AT RUN TIME //////////////////// ///////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////// ////////////// OVERLAY 1-ARITHMETIC FUNCTIONS /////////////// ///////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////// *OVERLAY VERSON&77^100+SUBVAF+60 /VERSION AND PATCH LEVEL FOR ARITH FNS OVDISP, JMS I [FBITGT /GET FUNCTION TO USE TAD JMSAF /BUILD IN LINE JMS DCA .+1 /STORE IT HLT JMP I [ILOOP /RETURN TO ILOOP JMSAF, JMS I .+1 /CALL FOR CANNED FUNCTION SET 1 /UAL LENGTH CLL CMA TAD I IOTMAX /MAXIMUM LENGTH SNL CLA /IS ACTUAL LENGTH >= MAXIMUM LENGTH? JMP I [EOFSET /YES-SET EOF BITS ISZ I IOTLEN /NO-BUMP ACTUAL LENGTH JMP I NEXREC /RETURN WITHOUT READING NEXT RECORD /ROUTINE TO READ 2 PAGES FROM DEVICE BLREAD, 0 JMS I (BLZERO TAD (210 /"READ 2 PAGES" JMS I (DRCALL /HANDLER CALL JMP I BLREAD /ROUTINE TO WRITE TAD TM CLL CML RAR /ROTATE 1'S THROUGH 3 WORD MASK DCA TM / TAD OPX /UNTIL THERE IS A COUNT OF ZERO RAR DCA OPX ISZ TEMP2 /DONE? JMP MASKL /NO TAD ACH /YES-MASK HORD AND TM DCA ACH TAD ACL /MASK LORD AND OPX DCA ACL TAD AC2 /NEG FLAG SNA CLA /WAS ORIGINAL NUMER <0? JMP I INT /NO-DONE JMS I [FFPUT /SAVE INT(X) FPPTM2 JMS I (FFADD /-INT(X)+(X) FPPTM1 TAD ACH /SAVE HORD DCA AC2 JMS I [FACCLR /FLUSH FAC TAD AC2 /WAS INT(X)=X? SNA CLA JMP JUSNEG /YES-JUST NEGATE INT(X) JMS I (FFADD /NO-ADD 1 ONE JUSNEG, JMS I (FFADD /GET INT(X) FPPTM2 JNEG, JMS I [FFNEG /AND NEGATE (INT(5.3)=-6) JMP I INT /DONE M1R, JMS I [FFGET /LOAD FAC WITH 1 ONE JMP JNEG /JUST NEGATE AND RETURN ONE, 1 2000 0 /RND(0) RANDOM NUMBER GENERATOR /USES MULTIPLIER OF 2**16+3 MOD 2**31 /RETURNS HIGH 23 BITS AS FRACTION 00. IS A=0? SNA CLA JMP RET0 /YES A^B=0 JMS I [FFPUT /SAVE B FPPTM3 JMS I (INT /GET INT(B) TAD ACX /TEST IF B GE 2**23 TAD (-30 SMA CLA JMP USELOG /JMP IF RIDICULOUS EXPONENT JMS I (FFSUB /INT(B)-B FPPTM3 TAD ACH /SEE IF B INTEGER SZA CLA JMP USELOG /NO, USE EXP(B*LOG(A)) INSTEAD JMS I [FFGET /GET B BACK FPPTM3 TAD ACH /SAVE SIGN OF B DCA EXPON JMS I (ABSVAL /TAKE ABS(B) JMS I FIX23I /FIX TO UNSIGNED INTEGER IN ACH;ACL TAD ACH /COPY TO SHIFT REGISTER DCA EXPH TAD ACL DCA EXPL JMS I [FFGET /INITIALIZE RUNNING PRODUCT TO ONE ONE JMS I [FFPUT FPPTM4 JMP EXPGO /JMP INTO LOOP EXPLUP, JMS I [FFPUT /SAVE RUNNING PRODUCT FPPTM4 JMS I [FFGET /GET RUNNING PO (7770 DCA ACH /STORE IN FAC FRACTION TAD AC2 RTL RAL AND [7400 DCA ACL TAD AC2 RTL RTL AND (7 TAD ACH DCA ACH DCA AC1 /CLEAR OVERFLOW JMS I (OADD /2**15+1 JMS I (AL1 JMS I (OADD /2**16+3 TAD AC1 /NOW SAVE UPDATED SEED DCA I (SEED1 TAD ACL DCA I (SEEDL TAD ACH DCA I (SEEDH DCA ACX /CLEAR EXPONENT JMS I (RAR1 /ADJUST FOR POSITIVE 23 BIT RESULT JMS I [FFNOR /NORMALIZE IT JMP I [ILOOP /--RETURN-- PAGE /EXPONENTIATION FUNCTION /IF B=0,A^B=1 /IF A=0 AND B>0,A^B=0 /IF A=0 AND B<0,DIVIDE BY ZERO ERROR MESSAGE RESULTS AND A^B=0 /IF B=INTEGER > 0, A^B=A*A*A*.......*A /IF B=INTEGER < 0, A^B=1/A*A*A*.......*A /IF B=REAL AND A>0, A^B=EXP(B*LOG(A)) /IF B=REAL AND A<0, A FATAL ERROR RESULTS EXPON, 0 JMAC=-1 DCA ACX /SET UP FLOAT JMS I [FFLOAT /FLOAT VALUE OF SGN FUNCTION JMP I [ILOOP /DONE PAGE /FLOATING SQUARE ROOT /USES A HARDWARE TYPE ALGORITHM FOR BINARY SQUARE ROOTS /REF: THE LOGIC OF COMPUTER ARITHMETIC-IVAN FLORES-P 409 / FROOT, 0 TAD ACH SNA JMP I [ILOOP /ZERO FAC-NORMALIZED!-RETN. SAME SMA CLA /SKP IF NEGATIVE JMP .+3 JMS I [FFNEG /TAKE ROOT OF ABSOLUTE VALUE IS, JMS I [ERROR /PRINT IMAGINARY SQUARE ROOT WARNING CLA CLL CML RTR /SET RESULT TO 2000;0000 DCA AN1 DCA AN2 CDF /DF TO PACKAGE FIELD TAD KM22 /SET COUNTER FOR DEVELOPING 22 BITS OF RESULT DCA AC2 /ALREADY HAVE 1 TAD ACX /GET EXPONENT OF FAC SPA /IF NEGATIVE-MUST PROPAGATE SIGN CML RAR /DIVIDE EXP. BY 2 DCA ACX /STORE IT BACK SZL /IWER OF A FPPTM5 JMS I (FFMPY /SQUARE IT FPPTM5 JMS I [FFPUT /STORE BACK FPPTM5 /A**2**K JMS I [FFGET /GET PRODUCT AGAIN FPPTM4 EXPGO, TAD EXPH /SHIFT EXPONENT RIGHT CLL RAR DCA EXPH TAD EXPL RAR DCA EXPL SNL /SKP IF THIS POWER OF A GOES IN JMP NOMULT /ELSE JMP BY JMS I (FFMPY FPPTM5 /MULTIPLY A**2**K IN NOMULT, TAD EXPH /SEE IF EXPONENT REDUCED TO ZERO YET SNA TAD EXPL SZA CLA JMP EXPLUP /REITERATE IF YES EMDONE, TAD EXPON /GET SIGN OF B SMA CLA /WAS IT -? JMP I [ILOOP /NO-A^B=A*A*A*...*A JMS I (FFDIV1 /YES-INVERT ONE JMP I [ILOOP /A^B=1/A:A*A*...*A RET0, JMS I [FACCLR JMP I [ILOOP RETRN1, JMS I [FFGET ONE /SET FAC TO 1 JMP I [ILOOP USELOG, TAD EXPON /SIGN OF A SPA CLA /A<0? EM, JMS I [ERROR /YES-PRINT A MESSAGE JMS I [FFGET /LOAD A FPPTM5 JMS I (LOG /LOG(A) JMS I (FFMPY /B*LOG(A) FPPTM3 JMS I (EXPON1 /EXP(B*LOG(A)) JMP I [ILOOP /DONE EXPH, 0 EXPL, 0 /SGN FUNCTION SGN, 0 TAD ACH /GET HIGH MANTISSA SNA /IS X=ZERO? JMP I [ILOOP /YES-THEN LEAVE IT ALONE SPA CLA /IS X>0? JMP .+3 /NO IAC /YES-SET FAC=1 SKP CMA /NO-SET FRACT FROM HI ORDER FAC TAD ACH SNL /RESULT NEGATIVE? JMP GON /YES-NEXT RESULT BIT IS 0 SZA /NO-IS HI ORDER RESULT=0? JMP LOP02 /NO-GO ON ISZ ZCNT /YES-WAS LOW ORDER =0? JMP .+3 /NO-GO ON CMA /YES-REM.=0-SET COUNTER SO DCA AC2 /LOOKS LIKE WE'RE DONE LOP02, DCA ACH /STORE HIGH ORDER REM. IN FAC TAD TM /STORE LO ORDER REM. IN FAC DCA ACL TAD OPL /TRIAL BIT SHIFTED LEFT 1 IS CLL RAL /RESULT BIT-ADD IT TO ROOT DEVELOPED TAD AN2 /SO FAR DCA AN2 TAD OPH RAL TAD AN1 DCA AN1 GON, CLA CLL CMA RAL /RESET COUNTER FOR ZERO REM. DCA ZCNT ISZ AC2 /DONE ALL 23 RESULT BITS? JMP SLOOP /NO-GO ON DONE, TAD AN1 /YES-STORE ANSWER IN FAC DCA ACH /ITS NORMALIZED ALREADY TAD AN2 DCA ACL JMP I [ILOOP /AND RETURN K6000, 600NCREMENT EXP. IF ORIGINAL EXP ISZ ACX /WAS ODD NOP SNL /DO A PRE-SHIFT FOR EVEN EXPONENTS JMS I AL1K /SO FIRST BIT PAIR IS 10 NOT 01 CLA CLL CMA RAL /SET COUNTER FOR DETECTING A DCA ZCNT /ZERO REMAINDER CLA CLL CML RTR /SET UP POSITION OF TRIAL BIT RTR /FOR FIRST PASS THRU LOOP DCA OPH DCA OPL TAD K6000 /GET A FAST FIRST BIT-WE KNOW TAD ACH /THIS WILL WORK SINCE # IS NORMALIZED DCA ACH /IF # IS A POWER OF TWO, AND A PERFECT TAD ACH /SQUARE-WE ARE DONE HERE! SNA /WELL IS IT? TAD ACL /COULD BE-CHECK LOW ORDER SNA CLA JMP DONE /WHOOPPEE-WE WIN BIG. JMP LOP01 /NOPE-LOOP DON'T SHIFT FIRST TIME SLOOP, TAD OPH /SHIFT TRIAL BIT 1 PLACE CLL RAR /TO THE RIGHT DCA OPH /AND STORE BACK TAD OPL RAR DCA OPL JMS I AL1K /SHIFT FAC LEFT 1 PLACE LOP01, TAD OPL /ADD TRIAL BIT TO`ANSWER TAD AN2 /SO FAR CLL CMA IAC /NEGATE IT TAD ACL /AND ADD TO FAC (REMAINDER SO FAR) SNA /IS RESULT ZERO? ISZ ZCNT /YES-INCREMENT COUNTER DCA TM /STORE RESULT IN TEMPORARY CML RAL /ADD CARRY TO HIGH ORDER FOR SUBTRACT TAD OPH /ADD TRIAL BIT TAD AN1 /ADD RESULT SO FAR (HI ORDER) CLL CMA IAC /AND SUBT /CALCULATE SIN(1-X) QUAD3, JMS I [FFNEG /-X JMP POLYSN /CALCULATE SIN(-X) QUAD4, JMS I (FFSUB /X-1 ONE POLYSN, JMS I [FFPUT /SAVE X FPPTM1 JMS I (FFSQ /U=X**2 JMS I [FFPUT /SAVE U FPPTM2 JMS I (FFMPY /A7*U SINA7 JMS I (FFADD /A5+A7*U SINA5 JMS I (FFMPY /A5*U+A7*U**2 FPPTM2 JMS I (FFADD /A3+A5(U)+A7(U**2) SINA3 JMS I (FFMPY /A3(U)+A5(U**2)+A7(U**3) 0 ZCNT, 0 AL1K, AL1 AN1, 0 AN2, 0 KM22, -26 /PRINT THE AC AS A DECIMAL NUMBER DECIMAL PRTDEC, HLT /LIFTED FROM FUTIL, V6. JMS NUMOUT -1000 -100 -10 0 JMP I PRTDEC OCTAL TWODEC, HLT /TWO DIGIT DECIMAL PRINT AND [0177 JMS PRTDEC JMP I TWODEC /ACTUAL NUMBER OUTPUT ROUTINE NUMOUT, HLT DCA NUMB /SAVE IT NUM01, DCA NUMDGT /CLEAR DIGIT COUNTER CLA CLL TAD NUMB /GET CURRENT VALUE TAD I NUMOUT /MINUS DIGIT BEING PRINTED. SNL /DID IT OVERFLOW? JMP NUM02 /NO, TOO FAR! ISZ NUMDGT /YES, BUMP DIGIT. DCA NUMB /AND UPDATE VALUE JMP NUM01+1 NUM02, CLA CLL TAD NUMDGT /OUTPUT THE DIGIT TAD [260 JMS I [PUTCH ISZ NUMOUT /GET NEXT ARG TAD I NUMOUT /DONE ENOUGH? SZA CLA JMP NUM01 /NOPE, MORE TO DO. TAD NUMB /ALL DONE - OUTPUT LAST DIGIT TAD [260 JMS I [PUTCH JMP I NUMOUT /AND RETURN NUMB, 0 NUMDGT, 0 PAGE /23-BIT EXTENDED FUNCTIONS /1-31-72 R BEAN /******SINE****** SIN, 0 JMS NHNDLE /IF X<0,NEGATE X AND SET NFLAG JMS I (FFMPY /X*2/PI TOVPI JMS FRACT /SAVE X IN AC0,THE INTEGER PART OF X IN NUM,AND GET FRACTIONAL PART IN FAC TAD NUM /GET INTEGER PART OF (2/PI)*X AND (3 /ISOLATE BITS 10,11 TAD JMPISN DCA .+1 /MAKE JUMP TO ARGUMENT REDUCING ROUTINE JMP . /AND ADJUST ARG ACCORDING TO QUADRANT OF X JMPISN, JMP I .+1 POLYSN /X IN QUAD1,SIN(X)=SIN(X) QUAD2 /X IN QUAD2,SIN(X)=SIN(1-X) QUAD3 /X IN QUAD3,SIN(X)=SIN(-X) QUAD4 /X IN QUAD4,SIN(X)=SIN(X-1) QUAD2, JMS I (FFSUB1 /1-X ONE JMP POLYSNY**2) EXPA1 JMS I (FFADD /A0+A1/(B1+Y**2) EXPA0 JMS I (FFSUB /A0-Y+A1/(B1+Y**2) FPPTM1 JMS I [FFPUT /SAVE FPPTM2 JMS I [FFGET /GET Y FPPTM1 ISZ ACX /MULT. BY 2=2Y NOP JMS I (FFDIV /2Y/(A0-Y+A1/(B1+Y**2)) FPPTM2 JMS I (FFADD /1+2Y/(AO-Y+A1/(B1+Y**2)) ONE JMS I (FFSQ /[1+2Y/(A0-Y+A1/(B1+Y**2))]**2=EXP(Y) TAD NUM TAD ACX /EXP(X)=(2**N)(EXPY) DCA A FPPTM2 JMS I (FFADD /A1+A3(U)+A5(U**2)+A7(U**3) SINA1 JMS I (FFMPY /A1(X)+A3(X**3)+A5(X**5)+A7(X**7) FPPTM1 JMS NCHK /IF NFLAG IS SET,SET SIN(X)=-SIN(X) JMP I SIN /FAC=SIN(X) /******COSINE****** /USES SIN ROUTINE TO CALCULATE COS(X) COS, 0 JMS I (FFADD /COS(X)=SIN(PI/2+X) PIOV2 JMS SIN JMP I COS /RETURN /ROUTINE TO SEPERATE THE INTEGER AND FRACTIONAL PARTS OF FAC /ORIGINAL FAC IS SAVED IN AC0,THE INTEGER PORTION OF FAC IS /SAVED AT NUM,AND THE FRACTIONAL FORTION OF THE FAC IS LEFT IN THE FAC FRACT, 0 JMS I [FFPUT /SAVE X FPPTM1 JMS I (FFIX /INTEGER PORTION OF X TAD ACX DCA NUM /SAVE FIXED FORTION OF X JMS I [FFLOAT /FAC=FLOAT(FIX(X)) JMS I (FFSUB1 /FAC=X-INT(X)=FRACTION (X) FPPTM1 JMP I FRACT /RETURN /ROUTINE TO CHECK IF FAC<0; IF IT IS,FAC IS NEGATED AND NFLAG IS /SET TO 1 NHNDLE, 0 TAD ACH /FETCH HIGH ORDER MANTISSA SMA CLA /IS IT <0? JMP NFLGST /NO-CLEAR NFLAG JMS I [FFNEG /YES-NEGATE FAC IAC /AND SET NFLAG NFLGST, DCA NFLAG JMP I NHNDLE /ROUTINE TO NEGATE FAC IF NFLAG IS NOT =0 NCHK, 0 /LOC ALSO USED FOR TEMP STORAGE TAD NFLAG SZA CLA /IS NFLAG=0? JMS I [FFNEG /NO-NEGATE FAC JMP I NCHK /YES-RETURN NUM=NCHK /******EXPONENTIAL****** EXPON1, 0 /LOC USED FOR TEMP STORAGE BY SIN,ARCTAN JMS I (FFMPY /Y=XLOG2(E) LOG2E JMS FRACT /GET FRACTIONAL PART OF Y JMS I (FFMPY /(FRACTION(Y))*(LN2/2) LN2OV2 JMS I [FFPUT /SAVE Y FPPTM1 JMS I (FFSQ /Y**2 JMS I (FFADD /B1+Y**2 EXPB1 JMS I (FFDIV1 /A1/(B1+CX JMP I EXPON1 /FAC=EXPON(X) NFLAG=EXPON1 /CONSTANT THAT WOULDN'T FIT ELSEWHERE TOVPI, 0 /.6366198 2427 6302 /SHIFT FAC RIGHT 1 RAR1, 0 TAD ACH CLL RAR DCA ACH TAD ACL RAR DCA ACL TAD AC1 RAR DCA AC1 JMP I RAR1 PAGE /******ARC TANGENT****** ATAN, 0 JMS I NHNDLL /IF X<0,SET NFLAG AND NEGATE JMS I [FFPUT /SAVE X FPPTM1 JMS I FSUBM /X-1 ONE TAD ACH /GET HI MANTISSA SPA CLA /WAS X>1? JMP ARGPOL /NO-CLEAR GT1FLG JMS I [FFGET /YES-ATAN(X)=PI/2-ATAN(1/X) ONE JMS I FDIVM /1/X FPPTM1 JMS I [FFPUT FPPTM1 IAC /SET GT1FLG ARGPOL, DCA GT1FLG JMS I [FFGET /GET X OR 1/X FPPTM1 JMS I FSQRM /Y**2 JMS I [FFPUT /SAVE FPPTM2 JMS I FADDM /Y**2+B3 ATANB3 JMS I FDIV1M /A3/(Y**2+B3) ATANA3 JMS I FADDM /B2+A3/(Y**2+B3) ATANB2 JMS I FADDM /Y**2+B2+A3/(Y**2+B3) FPPTM2 JMS I FDIV1M /A2/(Y**2+B2+A3/(Y**2+B3)) ATANA2 JMS I FADDM /B1+A2/(Y**2+B2+A3/(Y**2+B3)) ATANB1 JMS I FADDM /Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3)) FPPTM2 JMS I FDIV1M /A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3))) ATANA1 JMS I FADDM /B0+A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3))) ATANB0 JMS I FMPYM /ATAN(Y)=X*(B0+A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3)))) FPPTM1 TAD GT1FLG /WAS X>1? SNA CLA JMP NGT /NO-TEST IF X<0? JMS I FSUB1M /ATAN(X)=PI/2-ATAN(1/X) PIOV2 NGT, JMS I NCHKL /IF NFLAG SET,NEGATE FAC JMP I ATAN /FAC=ATAN(X) NHNDLL, NHNDLE NCHKL, NCHK /******NAPERIAN LOGARITHM****** GTFLG=ATAN LOG, 0 TAD ACH SPA SNA /X<0 OR X=0? JMP I ARTRAP /YES-TAKE ILLEGAL ARGUMENT TRAP CLL RTL SNA /NO-HORD=2000? TAD ACX /YES-EXP=1? CMA IAC IAC SNA TAD ACL /YES-LORD=0? SZA CLA JMP POLYNL /NO-ARG IS LEGAL AND NOT 1 DCA ACX DCA ACL LTRPRT, DCA ACH JMP I LOG /YES-LOG(1)=0 POLYNL, TAD ACX DCA GTFLG /SAVE EXPONENT FOR LATER DCA ACX /ISOLATE MANTISSA IN FAC JMS I [FFPUT /SAVE F FPPTM1 JMS I FADDM /F+SQR(.5) SQRP5 JMS I [FFPUT /SAVE FPPTM2 JMS I [FFGET FPPTM1 JMS I FSUBM /F-SQR(.5) SQRP5 JMS I FDIVM /Z=F+SQR(.5)/F-SQR(.5) FPPTM2 JMS I [FFPUT FPPTM1 JMS I FSQRM /Z**2 JMS I [FFPUT FPPTM2 JMS I FMPYM /C5(Z**2) LOGC5 JMS I FADDM /C3+C5(Z**2) LOGC3 JMS I FMPYM /C3(Z**2)+C5(Z**4) FPPTM2 JMS I FADDM /C1+C3(Z**2)+C5(Z**4) LOGC1 JMS I FMPYM /C1(Z)+C3(Z**3)+C5(Z**5) FPPTM1 JMS I FSUBM /C1(Z)+C3(Z**3)+C5(Z**5)-1/2=LOG2(F) ONEHAF JMS I [FFPUT /SAVE LOG2(F) FPPTM2 TAD GTFLG /I DCA ACX /SET UP FLOAT JMS I [FFLOAT JMS I FADDM /I+LOG2(F) FPPTM2 JMS I FMPYM /[I+LOG2(F)]*LOGE(2)=LOGE(X) LN2 JMP I LOG /FAC=LN(X) GT1FLG=LOG FMPYM, FFMPY FADDM, FFADD FDIVM, FFDIV FDIV1M, FFDIV1 FSUBM, FFSUB FSUB1M, FFSUB1 FSQRM, FFSQ ARTRAP, LM /CONSTANTS USED BY VARIOUS FUNCTIONS SINA1, 1 /1.5707949 3110 3747 SINA3, 0 /-.64592098 5325 1167 SINA5, 7775 /.07948766 2426 2466 SINA7, 7771 /-.004362476 5610 3164 PIOV2, 1 /1.5707963 3110 3756 LOG2E, 1 /1.442695 2705 2434 LN2OV2, 7777 /.34657359 2613 4415 EXPB1, 6 /60.090191 3602 7054 EXPA1, 12 /-601.80427 5514 3104 EXPA0, 4 /12.015017 3001 7301 ATANB0, 7776 /.17465544 2626 6157 ATANA1, 2 /3.7092563 3553 1071 ATANB1, 3 /6.762139 3303 670 ATANA2, 3 /-7.10676 4344 5267 ATANB2, 2 /3.3163354 3241 7554 ATANA3, 7777 /-.26476862 5703 4040 ATANB3, 1 /1.44863154 2713 3140 SQRP5, 0 /.7071068 2650 1170 LOGC1, 2 /2.8853913 2705 2440 LOGC3, 0 /.9614706 3661 566 LOGC5, 0 /.59897865 2312 5525 ONEHAF, 0 /.5 2000 0 LN2, 0 /.6931472 2613 4415 /******FIX****** /ROUTINE TO FIX ANY FLOATING NUMBER IN FAC BETWEEN -2047 AND +2047 TO /A TWELVE BIT INTEGER AND LEAVE RESULT IN EXP (LOC 44) FFIX, 0 CLA TAD ACX /FETCH EXPONENT SZA SMA /IS NUMBER <1? JMP .+3 IN LINK RAR /SCALE RIGHT DCA ACH /SAVE ISZ ACX /DONE YET? JMP FIXLP /NO FIXDNE, TAD ACH /YES-ANSWER IN AC DCA ACX /RETURN WITH ANSWER IN 44 JMP I FFIX /RETURN /******FLOAT****** /ROUTINE TO FLOAT ANY INTEGER IN EXP (LOC 44) INTO FAC FFLOAT, 0 TAD ACX DCA ACH /PUT NUMBER IN HI MANTISSA DCA ACL /CLEAR LOW MANTISSA TAD (13 /11(10) INTO EXPONENT DCA ACX JMS I [FFNOR /NORMALIZE JMP I FFLOAT /RETURN /FSQUARE-SQUARE FAC-CALLS MULTIPLY TO MUL. FAC BY ITSELF FFSQ, 0 JMS I (FFMPY /CALL MULTIPLY TO MULTIPLY ACX /FAC BY ITSELF JMP I FFSQ /DONE /TAN(X) /COMPUTED AS SIN(X)/COS(X) DUE TO LAZINESS AND LACK OF SPACE TAN, 0 JMS I [FFPUT /SAVE ANGLE FPPTM3 /IN TEMP NOT USED BY SIN(X) JMS I (COS /COMPUTE COS(X) JMS I [FFPUT /SAVE COS FPPTM4 JMS I [FFGET /GET ANGLE BACK FPPTM3 JMS I (SIN /COMPUTE SIN(X) JMS I (FFDIV /RETURN TAN(X)=SIN(X)/COS(X) FPPTM4 JMP I TAN /--RETURN-- //ROUTINE TO FIND OUT IF THE TERMINAL IS A VT52 //AND IF SO MODIFY 'CURSOR' TO EXECUTE PROPERLY CHK52, 0 TAD V278FG /GET THE VT278 WORD AND [200 /KEEP ONLY BIT 3 SNA CLA /IS THIS A VT78 TERMINAL JMP I CHK52 /NO, GET OUT OF HERE TAD PVH52 /GET JMS FOR VT52 CURSOR POSITIONING DCA I [CUR1 /CHANGE THE VT278 JMS TO VT52 JMS TAD PVH52 /GET JMS FOR VT52 CURSOR POSITIONING DCA I [CUR2 /CHANGE THE VT278 JMS TO VT52 JMS TAD ("Y DCA I [CUR3 /CHANGE "[" TO "Y" JMP I CHK52 PAGE / /INVERSE FLOATING SUBTRACT-USES FLOATING ADD /!!FSW1!!-THIS IS OP-FAC / F/NO-CONTINUE ON FTRPRT, CLA JMP FIXDNE+1 /YES-FIX IT TO ZERO TAD (-13 /SET BINARY POINT AT 11 SNA /PLACES TO RIGHT OF CURRENT POINT? JMP FIXDNE /NO-NUMBER IS ALREADY FIXED THEN. SMA /YES-IS NUMBER TOO LARGE TO FIX? JMP I (FO /YES-TAKE OVERFLOW TRAP DCA ACX /NO-SET SCALE COUNT FIXLP, CLL /0 IN LINK TAD ACH /GET HIGH MANTISSA SPA /IS IT <0? CML /YES-PUT A 1 /SWAP THE FAC AND OPERAND DCA OPL /THERE IS A POINTER TO OPL TAD I AC2 /IN AC2 LEFT FROM ARGET SUBR. DCA ACL TAD ACX /MIGHT AS WELL SUBTRACT THE CLL CMA IAC /EXPONENTS HERE (SAVES A WORD) TAD OPX /THEN ZERO OPX SO WILL NOT DCA ACX /MESS UP WHEN ITS DONE AGAIN DCA OPX /LATER (SEE DIV. ROUTINE) TAD ACH DCA AC2 /NOW SWAP HIGH ORDER MANTISSAS TAD OPH DCA ACH TAD AC2 DCA OPH CDF /DF TO PACKAGE FIELD TAD FFDIV1 /NOW KLUDGE UP A SUBROUTINE LINKAGE DCA I (FFDIV TAD (FFD1 DCA I (MDSET JMP I (MD1 /GO SET UP AND DIVIDE /MDSET-SETS UP SIGNS FOR MULTIPLY AND DIVIDE /ALSO SHIFTS OPERAND ONE BIT TO THE LEFT. /EXIT WITH EXPONENT OF OPERAND IN AC FOR EXPONENT /CALCULATION-CALLED WITH ADDRESS OF OPERAND IN AC AND /DATA FIELD SET PROPERLY FOR OPERAND. / MDSET, 0 JMS I (ARGET /GET ARGUMENT MD1, CDF /DF TO PACKAGE FIELD CLA CLL CMA RAL /SET SIGN CHECK TO -2 DCA TM TAD OPH /IS OPERAND NEGATIVE? SMA CLA JMP .+3 /NO JMS I (OPNEG /YES-NEGATE IT ISZ TM /BUMP SIGN CHECK TAD OPL /AND SHIFT OPERAND LEFT ONE BIT CLL RAL DCA OPL TAD OPH RAL DCA OPH DCA AC1 /CLR. OVERFLOW WORF OF FAC TAD ACH /IS FAC NEGATIVE SMA CLA JMP LEV /NO-GO ON JMS I [FFNEG /YES-NEGATE IT ISZ TM /BUMP SIGN CHECK NOP /MAY SKIP LEV, TAD OPX /EXIT WITH OPERAND EXPONENT IN AC JMP I MDSET / /CONTINUATION OF FLOATING DIVIDE ROUTINE / FD1, TAD AC2 /NEGATE HI ORDER PRODUCT CLL CMA IAC TAD ACH /COMPARE WITH REMAINDER OF FIRST DIV. SNL /WELL? JMP I (DVOPS /GREATER THANFSUB1, 0 JMS I [PATCHF /WHICH MODE? TAD I FFSUB1 /CALLED BY USER-GET ADDR. OF OP. JMS I (ARGET /GO PICK UP OPERAND CDF JMS I [FFNEG /NEGATE FAC TAD FFSUB1 /AND GO ADD JMP I (SUB0 / /INVERSE FLOATING DIVIDE /FSWITCH=1 /THIS IS OP/FAC / FFDIV1, 0 JMS I [PATCHF /WHICH MODE OF CALL? TAD I FFDIV1 /CALLED BY USER-GET ADDR. JMS I (ARGET /PICK UP OPERAND TAD ACLCH JMS I (DV24 /DIVIDE EXTENDED REM. BY HI DIVISOR TAD ACL /NEGATE THE RESULT CLL CMA IAC DCA ACL SNL /IF QUOT. IS NON-ZERO, SUBTRACT CMA /ONE FROM HIGH ORDER QUOT. JMP DVL1 /GO TO IT /MULTIPLY ACH;ACL;AC1 BY 10. MPY10, 0 JMS I (AC2OP /COPY AC FRACTION TO OP JMS I (AL1 /*2 JMS I (AL1 /*4 JMS I (OADD /*5 JMS I (AL1 /*10 JMP I MPY10 / /ROUTINE TO DECIDE CALLING MODE IN LIEU OF "SPECIAL MODE" PROBLEMS / PATCHF, 0 SZA /IS AC EMPTY JMP RTN2 /NO-THIS IS ALWAYS SI MODE WITH ADDR IN AC TAD FF /YES-GET SPECIAL MODE FLIP-FLOP SZA CLA /IF ON,THE ZERO AC MEANS ADDRESS OF 0 RTN2, ISZ PATCHF /USE AC AS ADDRESS OF OPERAND JMP I PATCHF /RETURN PAGE /FLOATING MULTIPLY-DOES 2 24X12 BIT MULTIPLIES FFMPY, 0 JMS I [PATCHF /WHICH MODE OF CALL? TAD I FFMPY /CALLED BY USER-GET OPERAND ADDR. JMS I (MDSET /SET UP FOR MPY-OPX IN AC ON RETN. TAD ACX /DO EXPONENT ADDITION DCA ACX /STORE FINAL EXPONENT DCA DV24 /ZERO TEM STORAGE FOR MPY ROUTINE DCA AC2 TAD ACH /IS FAC=0? SNA CLA DCA ACX /YES-ZERO EXPONENT JMS MP24 /NO-MULTIPLY FAC BY LOW ORDER OPR. TAD OPH /NOW MULTIPLY FAC BY REM.-ADJUST QUOT OF 1ST DIV. CLL /OK-DO (REM-(Q*OPL))/OPH DCA ACH /FIRST STORE ADJUSTED PRODUCT JMS I (DV24 /DIVIDE BY OPH (HI ORDER OPERAND) DVL1, TAD AC1 /GET QUOT. OF FIRST DIV. SMA /IF HI ORDER BIT SET-MUST SHIFT 1 RIGHT JMP FD /NO-ITS NORMALIZED-DONE CLL ISZ ACL SKP IAC RAR DCA ACH /STORE IN FAC TAD ACL /P@ LOW ORDER RIGHT RAR DCA ACL /STORE BACK ISZ ACX /BUMP EXPONENT NOP TAD ACH JMP DVL1+1 FD, DCA ACH /STORE HIGH ORDER RESULT JMP I (FDDON /GO LEAVE DIVIDE / /CONTINUATION OF ROUTINE TO ADJUST QUOT. OF FIRST DIV. /DBAD1 IS ONLY EXECUTED ON DIVIDE OVERFLOW-OTHERWISE THE /ROUTINE STARTS AT DVOP2 / DBAD1, DCA ACX /DIVIDE OVERFLO-ZERO ALL DVOP2, SNA /IS IT ZERO? DCA ACL /YES-MAKE WHOLE THING ZERO DCA A AC1 /YES-INSURE RESULT=0 JMP I MP24 /RETURN MPLP, TAD OPL /SHIFT A BIT OUT OF LOW ORDER MPLP1, RAR /OF MULTIPLIER AND INTO LINK DCA OPL SNL /WAS IT A 1? JMP MPLP2 /NO-0-JUST SHIFT PARTIAL PRODUCT CLL /YES-ADD MULTIPLICAND TO PARTIAL PRODUCT TAD AC2 TAD ACL /LOW ORDER DCA AC2 RAL /PROPAGATE CARRY TAD ACH /HI ORDER MPLP2, TAD DV24 RAR /NOW SHIFT PARTIAL PROD. RIGHT 1 BIT DCA DV24 TAD AC2 RAR DCA AC2 RAR /1 BIT OF OVERFLOW TO AC1 DCA AC1 ISZ OPX /DONE ALL 12 MULTIPLIER BITS? JMP MPLP /NO-GO ON JMP I MP24 /YES-RETURN / /PART OF DIVIDE ROUTINE-FFDIV MUST BE AT LOC. 6722 MP12L, DCA OPL /STORE BACK MULTIPLIET TAD AC2 /GET PRODUCT SO FAR SNL /WAS MULTIPLIER BIT A 1? JMP .+3 /NO-JUST SHIFT THE PARTIAL PRODUCT CLL /YES-CLEAR LINK AND ADD MULTIPLICAND TAD ACL /TO PARTIAL PRODUCT RAR /SHIFT PARTIAL PRODUCT-THIS IS HI ORDER DCA AC2 /RESULT-STORE BACK DVLP1, TAD OPL /SHIFT A BIT OUT OF MULTIPLIER RAR /AND A BIT OR RESLT. INTO IT (LO ORD. PROD.) ISZ FFMPY /DONE ALL BITS? JMP MP12L /NO-LOOP BACK CLL CMA IAC /YES-LOW ORDER PROD. OF QUOT. X OPL IN AC DCA ACL /NEGATE AND SHI ORDER MULTIPLIER DCA OPL JMS MP24 TAD AC2 /STORE RESULT BACK IN FAC RTZRO, DCA ACL /LOW ORDER TAD DV24 /HIGH ORDER DCA ACH TAD ACH /DO WE NEED TO NORMALIZE? RAL SMA CLA JMP SHLFT /YES-DO IT FAST MDONE, DCA AC1 /NO-ZERO OVERFLOW WD(DO I NEED THIS???) ISZ FFMPY /BUMP RETURN POINTER ISZ TM /SHOULD RESULT BE NEGATIVE? JMP I FFMPY /NOPE-RETN. JMS I [FFNEG /YES-NEGATE IT JMP I FFMPY /RETURN SHLFT, CMA /SUBTRACT 1 FROM EXP. TAD ACX DCA ACX JMS I (AL1 /SHIFT FAC LEFT 1 BIT JMP MDONE+1 /DONE. / /24 BIT BY 12 BIT MULTIPLY. MULTIPLIER IS IN OPL /MULTIPLICAND IS IN ACH AND ACL /RESULT LEFT IN DV24,AC2, AND AC1 MP24, 0 TAD (-14 /SET UP 12 BIT COUNTER DCA OPX TAD OPL /IS MULTIPLIER=0? SZA JMP MPLP1 /NO-GO ON DCA OPH /DIVISOR IN OPH (NEGATIVE) SZL CLA /IS IT? JMP I (DV /NO-DIVIDE OVERFLOW TAD (-15 /YES-SET UP 12 BIT LOOP DCA AC2 JMP DV1 /GO BEGIN DIVIDE DV2, TAD ACH /CONTINUE SHIFT OF FAC LEFT RAL DCA ACH /RESTORE HI ORDER TAD ACH /NOW SUBTRACT DIVISOR FROM HI ORDER TAD OPH /DIVIDEND SZL /GOOD SUBTRACT? DCA ACH /YES-RESTORE HI DIVIDEND CLA /NO-DON'T RESTORE--OPH.GT.ACH DV1, TAD ACL /SHIFT FAC LEFT 1 BIT-ALSO SHIFT RAL /1 BIT OF QUOT. INTO LOW ORD OF ACL DCA ACL ISZ AC2 /DONE 12 BITS OF QUOT? JMP DV2 /NO-GO ON JMP I DV24 /YES-RETN W/AC2=0 PAGE / /FLOATING ADD / FFADD, 0 JMS I [PATCHF /WHICH MODE FO CALL? TAD I FFADD /CALLED BY USER-GET ADDR. OF OPR. JMS I (ARGET /PICK UP OPERAND FAD1, CDF /DF TO PACKAGE FIELD TORE CML RAL /PROPAGATE CARRY JMP I (FD1 /GO ON / /FLOATING DIVIDE ROUTINE /USES THE METHOD OF TRIAL DIVISION BY HI ORDER FFDIV, 0 /(USED AS A TEM. BY I/O ROUTINES) JMS I [PATCHF /WHICH MODE OF CALL? TAD I FFDIV /CALLED BY USER-GET ARG. ADDR. JMS I (MDSET /GO SET UP FOR DIVIDE-OPX IN AC ON RETN. FFD1, CMA IAC /NEGATE EXP. OF OPERAND TAD ACX /ADD EXP OF FAC DCA ACX /STORE AS FINAL EXPONENT TAD OPH /NEGATE HI ORDER OP. FOR USE CLL CMA IAC /AS DIVISOR DCA OPH JMS DV24 /CALL DIV.--(ACH+ACL)/OPH TAD ACL /SAVE QUOT. FOR LATER DCA AC1 TAD (-15 /SET COUNTER FOR 12 BIT MULTIPLY DCA FFMPY /TO MULTIPLY QUOT. OF DIV. BY JMP DVLP1 /LOW ORDER OF OPERAND (OPL) / /END OF FLOATING DIVIDE-FUDGE SOME /STUFF THEN JUMP INTO MULTIPLY / FDDON, TAD FFDIV /STORE RETN. ADDR. IN MULT ROUTINE DCA FFMPY JMP MDONE /GO CLEAN UP / /DIVIDE ROUTINE--24 BITS IN ACH,ACL ARE DIVIDED BY 12 BITS /IN OPH. OPH IS ASSUMED NEGATIVE AND .GT. ACH IN ABSOLUTE VALUE /ELSE-DIVIDE OVERFLOW--WE RETURN NORMALLY WITH QUOTIENT /IN ACL AND REM. IN ACH. (AC2=0 ON RETN.) / DV24, 0 TAD ACH /CHECK THAT DIVISOR IS .GT. DIVIDEND TAD /SHIFT LEFT DCA AC1 /STORE BACK TAD ACL /GET LOW ORDER MANTISSA RAL /SHIFT LEFT DCA ACL /STORE BACK TAD ACH /GET HI ORDER RAL DCA ACH /STORE BACK JMP I AL1 /RETN. / /SHIFT FAC RIGHT-ENTER WITH COUNT-1 IN AC (POSITIVE) / ACSR, 0 CMA /AC CONTAINS COUNT-1 DCA AC0 /STORE COUNT LOP1, TAD ACH /GET SIGN BIT OF MANTISSA RAL /SET UP SIGN PROPAGATION CLA TAD ACH /GET HIGH ORDER MANTISSA RAR /SHIFT RIGHT`1, PROPAGATING SIGN DCA ACH /STORE BACK TAD ACL /GET LOW ORDER RAR /SHIFT IT DCA ACL /STORE BACK RAR DCA AC1 /SAVE 1 BIT OF OVERFLOW ISZ ACX /INCREMENT EXPONENT NOP1, NOP ISZ AC0 /DONE? JMP LOP1 /NO-LOOP JMP I ACSR /YES-RETN-AC=L=0 / /DIVIDE OVERFLOW-ZERO ACX,ACH,ACL / DBAD, CLA CLL /NECESSARY SO WE DON'T GTAD OPH /IS OPERAND = 0 SNA CLA JMP DONA /YES-DONE TAD ACH /NO-IS FAC=0? SNA CLA JMP DOADD /YES-DO ADD AC4000 AND ACX /NO, DO EXPONENT CALCULATION TAD OPX RAL /DO 13 BIT SUBTRACT CLA TAD ACX CML CIA TAD OPX SNL SZA /SKP IF OPX .LE. ACX JMP FACR /JMP IF OPX .GT. ACX CIA JMS OPSR JMS ACSR /SHIFT FAC ONE PLACE RIGHT DOADD, TAD OPX /SET EXPONENT OF RESULT DCA ACX JMS OADD /DO THE ADDITION JMS I [FFNOR /NORMALIZE RESULT DONA, ISZ FFADD /BUMP RETURN JMP I FFADD /RETURN FACR, JMS ACSR /SHIFT FAC = DIFF.+1 JMS OPSR /SHIFT OPR. 1 PLACE JMP DOADD /DO ADDITION / /OPERAND SHIFT RIGHT-ENTER WITH POSITIVE COUNT-1 /IN AC OPSR, 0 CMA /- (COUNT+1) TO SHIFT COUNTER DCA AC0 LOP2, TAD OPH /GET SIGN BIT RAL /TO LINK CLA TAD OPH /GET HI MANTISSA RAR /SHIFT IT RIGHT, PROPAGATING SIGN DCA OPH /STORE BACK TAD OPL RAR DCA OPL /STORE LO ORDER BACK RAR /SAVE 1 BIT OF OVERFLOW DCA AC2 /IN AC2 ISZ OPX /INCREMENT EXPONENT NOP2, NOP ISZ AC0 /DONE ALL SHIFTS? JMP LOP2 /NO-LOOP JMP I OPSR /YES-RETN. / /SHIFT FAC LEFT 1 BIT / AL1, 0 TAD AC1 /GET OVERFLOW BIT CLL RAL ARGET /RETURN / /ROUTINE TO NORMALIZE THE FAC / FFNOR, 0 TAD ACH /GET THE HI ORDER MANTISSA SNA /ZERO? TAD ACL /YES-HOW ABOUT LOW? SNA TAD AC1 /LOW=0, IS OVRFLO BIT ON? SNA CLA JMP ZEXP /#=0-ZERO EXPONENT NORMLP, AC2000 /NOT 0-MAKE A 2000 IN AC TAD ACH /ADD HI ORDER MANTISSA SZA /HI ORDER = 6000 JMP .+3 /NO-CHECK LEFT MOST DIGIT TAD ACL /YES-6000 OK ET OVRFLO AGAIN JMP I (DBAD1 /GO ZERO ALL / /FLOATING SUBTRACT / FFSUB, 0 JMS I [PATCHF /WHICH MODE OF CALL? TAD I FFSUB /CALLED BY USER-GET ADDR. OF OP JMS I (ARGET /PICK UO THE OP. JMS OPNEG /NEGATE OPERAND TAD FFSUB /JMP INTO FLTG. ADD SUB0, DCA FFADD /AFTER SETTING UP RETURN JMP FAD1 / /FLOATING NEGATE / FFNEG, 0 /(USED AS A TEM. BY OUTPUT ROUTINE) TAD ACL /GET LOW ORDER FAC CLL CMA IAC /NEGATE IT DCA ACL /STORE BACK CML RAL /ADJUST OVERFLOW BIT AND TAD ACH /PROPAGATE CARRY-GET HI ORD CLL CMA IAC /NEGATE IT DCA ACH /STORE BACK JMP I FFNEG / /NEGATE OPERAND / OPNEG, 0 TAD OPL /GET LOW ORDER CLL CMA IAC /NEGATE AND STORE BACK DCA OPL CML RAL /PROPAGATE CARRY TAD OPH /GET HI ORDER CLL CMA IAC /NEGATE AND STORE BACK DCA OPH JMP I OPNEG / /ADD OPERAND TO FAC / OADD, 0 CLL TAD AC2 /ADD OVERFLOW WORDS TAD AC1 DCA AC1 RAL /ROTATE CARRY TAD OPL /ADD LOW ORDER MANTISSAS TAD ACL DCA ACL RAL TAD OPH /ADD HI ORDER MANTISSAS TAD ACH DCA ACH JMP I OADD /RETN. PAGE /ARGUMENT PICK UP ROUTINE-ENTER WITH DATA FIELD SET TO EITHER /FLTG. DATA FIELD OR FLTG. INSTR. FIELD. /ADDRESS OF OPERAND IS IN THE AC ON ENTRY. /ON RETURN, THE`AC IS CLEAR ARGET, 0 DCA AC2 /STORE ADDRESS OF OPERAND TAD I AC2 /PICK UP EXPONENT DCA OPX JMS ISZAC2 /MOVE POINTER TO HORD,WATCH FOR FIELD OVERLAP TAD I AC2 /PICK IT UP DCA OPH /STORE JMS ISZAC2 /MOVE POINTER TO LORD,WATCHING FOR OVERLAP TAD I AC2 /PICK IT UP DCA OPL /STORE IT JMP I) WHEN THE /REMAINDER OF THE FIRST`DIVIDE IS LESS THAN QUOT*OPL /USED BY FLTG. DIVIDE ROUTINE / DVOPS, CMA IAC /NEGATE AND STORE REVISED REMAINDER DCA ACH CLL TAD OPH TAD ACH /WATCH FOR OVERFLOW SNL JMP DVOP1 /OVERFLOW-DON'T ADJUST QUOT. OF 1ST DIV. DCA ACH /NO OVERFLOW-STORE NEW REM. CMA /SUBTRACT 1 FROM QUOT OF TAD AC1 /FIRST DIVIDE DCA AC1 DVOP1, CLA IF LOW=0 SZA CLA SPA CLA /2,3,4,5,ARE LEGAL LEFT MOST DIGS. JMP FFNORR /FOR NORMALIZED #-(+2000=4,5,6,7) JMP FNLP /JUMP SO FFGET AND PUT ARE ORGED RIGHT FFNORR, DCA AC1 /DONE W/NORMALIZE-CLEAR AC1 JMP I FFNOR /RETURN AL1P, AL1 /FLOATING GET FFGET, 0 JMS I [PATCHF /WHICH MODE OF CALL TAD I FFGET /CALLED BY USER-GET ADDR. OF OP JMS ARGET /PICK UP OPERAND TAD OPX DCA ACX /LOAD THE OPERAND INTO FAC TAD OPL DCA ACL TAD OPH DCA ACH ISZ FFGET CDF JMP I FFGET /RETN. TO CALL +2 / /FLOATING PUT / FFPUT, 0 JMS I [PATCHF /WHICH MODE OF CALL? TAD I FFPUT /CALLED BY USER-GET OPR. ADDR DCA FFGET /STORE IN A TEMP TAD ACX /GET FAC AND STORE IT DCA I FFGET /AT SPECIFIED ADDRESS JMS ISZFGT /BUMP POINTER,WATCHING FOR FIELD OVERLAP TAD ACH DCA I FFGET JMS ISZFGT TAD ACL DCA I FFGET ISZ FFPUT /BUMP RETN. CDF JMP I FFPUT /RETN. TO CALL+2 /ROUTINES TO BUMP ARGET AND FPUT POINTERS AND INCREMENT THE /DATA FIELD IF THE POINTER CROSSES A FIELD BOUNDARY ISZFGT, 0 ISZ FFGET /BUMP POINTER JMP I ISZFGT /NO SKIP MEANS JUST RETURN SKP /SKIP MEANS WE HAVE TO INCREMENT DATA FIELD NEWCDF, DCA ISZFGT /THIS INST EXECUTED ONLY BY ISZAC2 RDF /GET THE DATA FIELD TAD CDF10 /BUMP BY 1 AND MAKE A CDF DCA .+1 /PUT IN LINE . JMP I ISZFGT /RETURN CDF10, CDF 10 ISZAC2, 0 ISZ AC2 /BUMP POINTER JMP I ISZAC2 /NOTHING HAPPENED TAD ISZAC2 /NEED NEW DF. GET RETURN ADDR JMP NEWCDF /AND BUMP DF / /ROUTINE TO ADJUST QUOTINET OF FIRST DIVIDE (MAYBECLL TAD ACH /GET HI ORD OF REMAINDER JMP I DVOP2P /GO ON DVOP2P, DVOP2 FNLP, CLL CML CMA /-1 TAD ACX /SUBTR. 1 FROM EXPONENT DCA ACX JMS I AL1P /SHIFT FAC LEFT 1 JMP NORMLP /GO BACK AND SEE IF NORMALIZED ZEXP, DCA ACX JMP FFNORR /EDITOR READ ROUTINE SITS HERE ABOVE EDITOR LOAD AREA EDREAD, DCA EBLK /ENTER WITH AC = BLOCK JMS I E7607 /READ EDITOR OFF SYS: EDTSIZ /THIS MUCH TO FIELD 0 0000 /STARTING HERE EBLK, 0000 /FROM HERE HLT /CRASH SYS ON ERROR HERE JMP I .+1 /JMP INTO EDITOR CHAIN ENTRY NOW EDTBGN E7607, 7607 /I/O TABLE FOLLOWS AND CROSSES PAGE BOUNDRY /I/O TABLE ENTRIES TTYF, 1 /ASCII ZBLOCK IOTSIZ-1 /FILE #0 (CONSOLE) ZBLOCK IOTSIZ^MAXFIL /FILES #1 THROUGH #5 PAGE /CROSS FIELD LITERAL EQUATES PILOOP= [ILOOP PPUTCH= [PUTCH PPCH= [PCH PSACM1= [SAC-1 PFFNOR= [FFNOR PFFGET= [FFGET PFFPUT= [FFPUT PUNSFIX= [UNSFIX PERROR= [ERROR PFACCLR= [FACCLR PIDLE= [IDLE PPSWAP= [PSWAP PFTYPE= [FTYPE O377= [377 O200= [200 O10= [10 O17= [17 O7400= [7400 O77= [77 O40= [40 O15= [15 O7700= [7700 /PAGE ZERO LITERAL POOL FIELD 1 /FIELD 1 PAGE ZERO TEMPORARIES (VOLATILE) *10 SXR, 0 TXR, 0 /RECORD I/O PARAMETERS, MUST REMAIN VALID FOR LIFE OF I/O STATEMENT *20 EOLPTR, 0 /ONCE ONLY FLAG/PTR ZEROED ON IOTABLE INITIALIZATION REMSIZ, 0 /INITIALIZED TO REMAINING SIZE OF CURRENT RECORD NXTFLD, 0 /INITIALIZED TO HEAD OF RECORD FIELD DEFINITIONS EXPNDF, 0 /NEGATIVE IF CURRENT RECORD CAUSED FILE TO EXPAND /VOLATILE TEMPORARIES PRODL, 0 PRODH, 0 STPCNT, 0 SUBFPT, 0 SACPT, 0 /IOTABLE POINTER IMAGE FOR FIELD 1 IOHDR1, 0 IOBUF1, 0 IOBLK1, 0 IOPTR1, 0 IOHND1, 0 IOLOC1, 0 IOLEN1, 0 IORSZ1, 0 IOSUB1, 0 IONRH1, 0 IONRL1, 0 IOMAX1, 0 IOPOS1, 0 IOFIL1, 0 /FIELD 0, PAGE 0 LINKS FOR FFOUT1, AND FFIN1 FF1,FF AC01,AC0 AC11,AC1 AC21,AC2 DECEX1,DECEXP ACX1,ACX ACH1,ACH ACL1,ACL APX1,OPX OPL1,OPL OPH1,OPH OPX1,OPX CHAR1,CHAR /SEE PAGE ZREO FIELD ZERO FOR VARIABLE DEFINITION PAGE /STRING ACCUMULATOR, ONE 7 OR 8 BIT CHAR PER WORD SAC, START, 0 /ONCE ONLY STARTUP CODE TLS /SET TTY FLAG CDF TAD I (CDFIO /SET CDF'S IN PSWAP DCA I (P1CDF TAD I (CDFIO DCA I (P1CDF1 TAD I (PSFLAG /SET SWAP PAGE SMA CLA /SKP IF 2 PAGE SYSTEM HANDLER TAD (200 /ELSE USE 7600 AS SWAP AREA TAD (7400 DCA I (HICORE CLA IAC /BE SURE OS/8 SWAPPED IN AND I (PSFLAG SZA CLA JMP .+4 CIF JMS I (CALLF0 /SWAP IN IF NOT ALREADY IN PSWAP CDF 10 TAD I (SCOPWD /SAVE SCOPE FLAG DCA I (SCOPFG /SAVE IT FOR LATER CDF TAD I (V278WD /GET THE VT278 WORD DCA I (V278FG /SAVE IT FOR LATER TAD I (HEIGHT DCA I (HCTR /INITIALIZE SCREEN HEIGHT KLUDGE (OS78) TAD (OVDESC-1 /SETUP OVERLAY BLOCK TABLE DCA SXR TAD (ARITHA-1 DCA TXR OVSET, CDF 10 TAD I SXR /GET BLOCK LOCATION PTR SNA /SKP IF NOT EOL JMP SETEM /GO SET ERROR MESSAGE OVERLAY IF DONE DCA SACPT /STORE TAD I SACPT /PICK IT UP TAD I SXR /ADD OFFSET TO THIS OVERLAY CDF SNA /SKP IF HAVE OVERLAY JMP NOOVLY /ELSE DON'T TRY TO READ IT DCA CURBK /STORE INLINE TAD CUROV /SEE IF IT WILL FIT IN FIELD 2 TAD (1400 CLL CIA TAD I (PSSTRT /COMPARE TO START OF PSEUDO CODE CLA CML RAL TAD (CDF 20 CIA TAD I (CDFPS SPA CLA /SKP IF THERE IS ROOM JMP NOFIT /ELSE DON'T LOAD IT CDF 10 CIF /CALL SYS: TO READ IT IN JMS I (7607 0620 /6 PAGES TO FIELD 2 CUROV, 0000 /STARTING HERE CURBK, 0000 /FROM HERE HLT /CRASH SYS ON THIS UNLIKELY ERROR CDF /RESET DF SKP NOFIT, TAD CURBK /STORE BLOCK IN OVERLAY TABLE IF COULDN'T LOAD IT NOOVLY, DCA I TXR /ELSE CLEAR THE ENTRY TAD CUROV /BUMP TO NEXT OVERLAY SLOT TAD (1400 DCA CUROV JMP OVSET SETEM, CDF 10 /NOW SET ERROR OVERLAY ADDR TAD I (CDOPT4 /SAVE CD SWITCHEA I (STDF TAD I (CDFIO /ARRAYS DCA I (ATABDF TAD I (CDFIO /SCALAR NUMERICS DCA I (SCALDF TAD I (CDFIO /INCORE DATA LIST DCA I (DLCDF TAD I (DLSTRT DCA I (DATAXR JMP I START /OK, NOW GO DO SOME INTERPRETING! PAGE *RECPAK /BRTS FIELD 1 STARTUP CODE (RESIDES IN INPUT BUFFER) /ENTER WITH AC = STARTING BLOCK OF BRTS ON SYS: /CALL+1 = ADDR OF BRTS PARAMETER BLOCK INBUF= SAC+SACLIM+1 /START INPUT BUFFER PAST SAC BRTBG1, 0 TAD F0BLK /ADD FIELD 0 OFFSET TO ADDR OF BRTS PASSED IN AC DCA F0BLK /STORE INLINE CDF TAD I BRTBG1 /NOW GET ADDR OF PARAMETER BLOCK FROM CALL+1 DCA PARM1 /POINT AT IT SAVPRM, CDF TAD I PARM1 /SAVE BRTS PARAMETERS CDF 10 DCA I SAV1 ISZ PARM1 ISZ SAV1 ISZ CNT1 JMP SAVPRM CIF /NOW READ IN FIELD 0 OF BRTS JMS I (7607 BRTSZ0 /SIZE CONTROL WORD 0000 /ADDR TO LOAD F0BLK, 13 /FROM HERE (INITIALLY CONTAINS BLOCK OFFSET TO FIELD 0) HLT /CRASH SYSTEM IF ERROR HERE RSTPRM, TAD I SAV2 /NOW RESTORE SYSTEM PARAMETERS CDF DCA I PARM2 CDF 10 ISZ SAV2 ISZ PARM2 ISZ CNT2 JMP RSTPRM CDF /NOW BUSY OUT ALL BUFFERS OCCUPIED BY CODE TAD I (CDFPS /FIRST SEE IF OBJECT CODE RAN INTO BUFFER AREA TAD (-6211 /IN FIELD 1 / SPA / HLT /UNREACHABLE - LOADER ERROR SZA CLA /SKP IF HIT FIELD 1 JMP SETHKS /GO SET ^C HOOKS IF ALL BUFFERS FREE KILBUF, TAD I (BUFSTK /SEE IF CODE IN FIELD 1 IS ABOVE END OF THIS BUFFER DCA SAV1 TAD I SAV1 SZA /SKP IF BUFFER DOES NOT EXISTS JMP GOTBUF TAD (BUFAREA-1 CLL CIA TAD I (PSSS M-X FOR VERSION AND FREE SPACE MSGS DCA PRODL /IN A RANDOM TEMPORARY TAD I (INFO+4 /SITS AT END OF STRING FUNCTIONS IMAGE CDF TAD (14 DCA I (ERRA CIF JMS I (CALLF0 /OUT WITH OS/8 NOW PSWAP CDF /NOW SET VARIOUS CDF'S AND ADDRESSES TAD I (CDFPS /INTERPRETIVE CODE DF AND ADDR DCA I (CDFPSU TAD I (PSSTRT DCA I (INTPC TAD I (CDFIO /STRING STOREAGE CDF DC DCA I (7605 TAD I (BIPCCL /NOW SEE IF FIELD CONTAINING BATCH IS UNTOUCHED AND (70 /ISOLATE BATCH FIELD BITS (IF ANY) CIA TAD I (CDFIO /SUBTRACT FROM FIELD BITS IN CDF INSTR AND (100 /AC5 SET IF CDFIO LT SYSTEM SIZE CLL RTL /IF YES, SET JSW BIT 3 TAD (1000 /ALWAYS SET NON RESTARTABLE BIT DCA I (JSW /STORE THE JSW NOW DCA INBUF /CLEAR THE TTY INPUT BUFFER NOW JMS I (START /GO DO SOME STARTUP CODE TAD PRODL /SEE IF /S OR /V SWITCHES PASSED AND (44 SNA CLA /SKP IF YES JMP I (ILOOP1 /ELSE START THE INTERPRETER NOW TAD (5 /LOAD ERROR MESSAGE OVERLAY CIF JMS I (CALLF0 OVLOAD CIF /NOW CALL THE MESSAGE ROUTINE JMS I (CALLF0 FREESP JMP I (ILOOP1 /AND START THE INTERPRETER UP PARM1, CDFIO SAV1, SAVBUF CNT1, CDFIO-PSFLAG-1 PARM2, CDFIO SAV2, SAVBUF CNT2, CDFIO-PSFLAG-1 SAVBUF, ZBLOCK PSFLAG+1-CDFIO /DESCRIPTION OF OVERLAYS /PTR TO BLOCK NUMBER;OFFSET TO OVERLAY OVDESC, INFO+4;17 /BASIC.AF INFO+4;11 /BASIC.SF INFO+4;6 /BASIC.SR INFO+4;3 /BASIC.FF INFO+4;0 /BASIC.EX 0 /TERMINATED BY ZERO WORD PAGE INEND= .-1 /DEFINE LAST LOCATION IN INPUT BUFFER /CONSOLE INPUT ROUTINE TTYGCH, 0 TTYLP, CDF 10 TAD I INPTR /SEE IF ANYTHING IN BUFFER ISZ INPTR SNA JMP PROMPT /GET ANOTHER LINE IF NOT CIF CDF JMP I TTYGCH /OTHERWISE RETURN LFLUSH, JMS CRLF1 /RETURN CR PROMPT, TAD (PMTBUF /NOW PRINT PROMPT DCA INPTR PRMLP, TAD I INPTR /GET A CHAR SNA JMP GETLIN /END OF PROMPT JMS PCH1 /PRINT IT ISZ INPTR JMP PRMLP GETLIN, TAD TRT SNL CLA HLT /UNREACHABLE - LOADER ERROR JMP SETHKS GOTBUF, TAD (377 /OFFSET TO END OF BUFFER CLL CIA TAD I (PSSTRT /ONE LESS THAN FIRST WORD OF CODE SZL CLA /SKP IF IN THIS BUFFER JMP SETHKS /DONE, GO SET ^C HOOKS ISZ I (BUFSTK /POP BUFFER FROM FREE STACK JMP KILBUF /TRY NEXT ONE SETHKS, TAD (JMP I FSTOP1 /NOW SET ^C HOOKS DCA I (7600 TAD (JMP I FSTOP1NA CLA JMP TTYIN /IGNORE RUBOUT IF YES TAD SCOPFG /TEST IF SCOPE TERMINAL AND [200 /KEEP ONLY THE SCOPE BIT SNA CLA JMP NOSCOP /JMP OF NOT TAD (10 /TRANSMIT BS,SP,BS TO ERASE CHAR IF SCOPE JMS PCH1 TAD (40 JMS PCH1 TAD (10 SKP NOSCOP, TAD (177&"\ /TRANSMIT BACKSLASH FOR OTHER TERMINALS JMS PCH1 STA /BACK UP PTR TAD INPTR JMP BAKFIN /HANDLE CR GOTCR, JMS CRLF1 /ECHO CR,LF FIRST TAD (15 /STORE CR IN BUFFER DCA I INPTR ISZ INPTR DCA I INPTR /MARK END OF BUFFER TAD (INBUF /RESET PTR DCA INPTR JMP TTYLP /RETURN FIRST CHAR INPTR, INBUF /INITIALLY BEGINNING OF INPUT BUFFER SCOPFG, 0 /SET NONZERO IF TERMINAL IS SCOPE CRLF1, 0 CDF /FIRST ZERO THE CONSOLE PRINT POSITION DCA I (TTYF+IOTPOS-IOTHDR TAD (15 /PRINT CR,LF JMS PCH1 TAD (12 JMS PCH1 JMP I CRLF1 PCH1, 0 CIF /PRINT CHAR JMS I (CALLF0 PCH JMP I PCH1 FREE2, .+2;0 /CONTINUATION OF DEFINE FREELIST .+2;0 .+2;0 .+2;0 .+2;0 .+2;0 .+2;0 .+2;0 .+2;0 .+2;0 0;0 /LAST ENTRY HAS ZERO LINK PAGE /DISPATCH FOR FIELD 1 FUNCTIONS /ENTRY WITH AC = FUNCTION CODE F1DISP, TAD JMPF1 (INBUF /INITIALIZE PTR BAKFIN, DCA INPTR TTYIN, CIF CDF TAD I (HEIGHT /RESET HEIGHT FUDGE DCA I (HCTR JMS I (CALLF0 /GET A CHAR GCH DCA I INPTR /TENTATIVELY SAVE IN BUFFER TAD I INPTR SZA /IGNORE NULLS TAD (-32 SNA JMP TTYIN /IGNORE ^Z (CAN'T HAVE END OF FILE ON TTY) TAD (32-25 SNA JMP LFLUSH /DELETE LINE IF ^U TAD (25-177 SNA JMP BACKUP /RUBOUT CHAR IF RUBOUT TAD (177-15 SNA CLA JMP GOTCR /HANDLE END OF LINE IF CR TAD INPTR /SEE IF CHAR WILL FIT TAD (-INEND+2 /(WITH ROOM FOR CR AND NULL DELIMETER) SNA CLA JMP TTYIN /IGNORE IT IF NO TAD I INPTR /ECHO IT FIRST IF YES JMS PCH1 ISZ INPTR /BUMP PTR JMP TTYIN /GET ANOTHER CHAR /HANDLE RUBOUTS BACKUP, TAD INPTR /SEE IF AT LEFT MARGIN TAD (-INBUF SF STRING CIF CDF JMP I (SSMODE /RETURN IN SMODE PMTBUF, 77 /INITIALLY ? ZBLOCK 7 PMTEND, 0 /SETUP FILE TABLE POINTERS IN FIELD 1 SFN1, 0 CDF TAD I (IOTHDR /GET ADDR OF CURRENT FILE BLOCK CDF 10 DCA PRODL /SAVE IN TEMP TAD (IOHDR1 /SET POINTER TO FIELD 1 TABLE DCA PRODH TAD (IOTHDR-IOTFIL-1 /SET COUNT DCA STPCNT TAD PRODL /SETUP POINTERS NOW DCA I PRODH ISZ PRODL ISZ PRODH ISZ STPCNT JMP .-5 JMP I SFN1 /RETURN FREELS, .+2;0 /FREE LIST OF RECORD FIELD DESCRIPTORS .+2;0 /THREAD WORD;POSITIVE FIELD SIZE .+2;0 .+2;0 .+2;0 .+2;0 .+2;0 .+2;0 .+2;0 .+2;0 .+2;0 .+2;0 .+2;0 .+2;0 .+2;0 .+2;0 .+2;0 .+2;0 .+2;0 .+2;0 .+2;0 .+2;0 .+2;0 .+2;0 .+2;0 .+2;0 .+2;0 .+2;0 .+2;0 FREE2;0 /LINK TO PART 2 OF LIST PAGE /OPCODE TO LOCATE A RECORD IN RANDOM ACCESS FILE LOCATE, JMS I (SFN1 /SETUP FILE POINTERS FOR FIELD 1 CIF /FIRST TEST IF FILE IS OPEN JMS I (CALLF0 IDLE /TAKE ERROR EXIT IF NOT CIF /NOW FIX FAC TO GET RECORD NUMBER JMS I (CALLF0 FIX23 CDF /TEST IF RECORD LT NUMBER OF RECORDS IN FILE TAD I IONRL1 /DO DOUBLDCA .+1 HLT JMPF1, JMP I .+1 /DISPATCH TABLE FOR FIELD 1 FUNCTIONS READSF /0 READ RECORD FIELD TO SAC WRITSB /1 WRITE SAC TO RECORED FIELD LOCATE /2 LOCATE RECORD IN RANDOM ACCESS FILE WRTEOR /3 WRITE END OF RECORD IN FILE DEFSUB /4 DEFINE FIELDS IN RECORD DFSIZE /5 DEFINE TOTAL RECORD SIZE DEFPMT /6 DEFINE INPUT STATEMENT PROMPT STRING /DEFINE INPUT STATEMENT PROMPT DEFPMT, TAD (PMTBUF-1 /SET THE POINTERS DCA TXR TAD (SAC-1 DCA SXR STA CDF TAD I (SACLEN CDF 10 DCA STPCNT JMP DEFPGO /GO SET THE PROMPT STRING NOW DEFPLP, TAD TXR /SEE IF IT WILL FIT TAD (-PMTEND+1 SNA CLA JMP EOPDEF TAD I SXR /GET A CHAR DCA I TXR /STORE IN BUFFER DEFPGO, ISZ STPCNT JMP DEFPLP EOPDEF, DCA I TXR /MARK END OTH, TAD PRODL /GET BLOCK OFFSET TAD I IOLOC1 /COMPARE TO CURRENT BLOCK IN BUFFER CIA TAD I IOBLK1 SNA CLA /SKP IF NOT THERE JMP GOTBLK /OTHERWISE WE HAVE IT NOW CIF JMS I (CALLF0 /WRITE CURRENT BLOCK IF DIRTY WRBLK CIF JMS I (CALLF0 /NOW INIT BLOCK (TO RESET DIRTY BIT) BLINIT CDF TAD PRODL /POINT AT THE BLOCK NOW TAD I IOLOC1 /ADD TO BASE DCA I IOBLK1 TAD (210 /NOW CALL THE DRIVER TO READ THE BLOCK CIF JMS I (CALLF0 DRCALL CDF GOTBLK, TAD PRODH /GET READY TO CALCULATE BYTE POINTERS DCA PRODL /SET PRODH;PRODL TO CHAR IN BLOCK DCA PRODH TAD (3 /DIVIDE BY 3 FOR BYTE POINTER JMS I (DIV23 TAD PRODH /REMAINDER = 3/2 STATE RTR CLA /GET 2 BIT, INDICATING 3RD CHAR IN GRP TAD I IOHDR1 /SET THE ODD BIT IF NECESE PRECISION SUBTRACT CLL CIA TAD I (ACL CLA CML RAL /GET BORROW TAD I IONRH1 CIA TAD I (ACH DCA EXPNDF /SAVE TO FLAG FILE EXPANSION IF VARIABLE FILE SNL /SKP IF FILE EXPANDED JMP NOXPND /ELSE DON'T UPDATE HIGHEST REC NO TAD I (ACL DCA I IONRL1 TAD I (ACH DCA I IONRH1 /UPDATE LAST RECORD NUMBER NOXPND, TAD I IORSZ1 /MULTIPLY RECORD NUMBER BY PHYSICAL REC SIZE SZA /ERROR IF NOT DIRECT ACCESS FILE JMS I (MULT23 /RESULT CHAR POSITION IN FILE IN PRODH;PRODL JMP BR-2 /JMP IF MULTIPLY OVERFLOWED (WAY TOO BIG) TAD (600 CLL CIA TAD PRODH /TEST IF CHAR POS GE 384*2**12 SZL CLA /SKP IF NO JMP BR-2 /ELSE BAD RECORD NUMBER TAD (600 /DIVIDE BY 384 (600 OCTAL) FOR BLOCK AND CHAR IN BLOCK JMS I (DIV23 /PRODH=REMAINDER, PRODL=QUOTIENT TAD PRODL /SEE IF PAST END OF FILE CLL CMA TAD I IOMAX1 SNL CLA JMP BR-2 /BAD RECORD NUMBER TAD PRODL /SEE IF FILE GROWTH CLL CMA TAD I IOLEN1 /COMPARE TO CURRENT NUMBER OF BLOCKS IN FILE SZL CLA /SKP IF IOTLEN LT NEW SIZE INCLUDING NEW BLOCK JMP NOGRTH /JMP IF NO (ALWAYS JMPS FOR FIXED SIZE FILES) TAD PRODL /UPDATE IOTLEN IAC DCA I IOLEN1 NOGRD (SKP DCA I (GETCH2 CDF 10 CIF JMS I (CALLF0 /GET THE NEXT CHAR GETCH CDF TAD (SNA /Reset GETCH routine DCA I (GETCH2 TAD I (CHAR /GET CHAR FROM BRTS SNA CLA /Don't pass nulls JMP SUBGO TAD I (SACLEN /SEE IF CHAR WE GOT WILL FIT TAD (SACLIM SPA SNA CLA /SKP IF ROOM JMP ST1-2 /TAKE ERROR RETURN IF NOT TAD I (CHAR /GET CHAR FROM BRTS CDF 10 DCA I SACPT /STORE IN SAC CDF ISZ SACPT /BUMP SAC POINTER STA /INCR NEGATIVE SAC CHAR COUNT TAD I (SACLEN DCA I (SACLEN SUBGO, ISZ STPCNT /TEST RECORD FIELD COUNTER JMP SUBRDL /ITERATE JMP I (ILOOP1 /DONE, RETURN CDF 10 CIF /PRINT WARNING IF STRING TRUNCATED ST1, JMS I (ERROR JMP .+4 SBFLSH, CIF JMS I (CALLF0 /FLUSH REST IF FIELD GETCH ISZ STPCNT JMP SSARY AND (7777-200 SZL TAD (200 DCA I IOHDR1 /STORE HEADER BITS BACK TAD PRODL /NOW GET DOUBLE WORD POINTER CLL RAL /*2 TAD PRODH /ADD CHAR OFFSET TAD I IOBUF1 /ADD TO BASE OF BUFFER DCA I IOPTR1 /TO SET THE POINTER ILOOP1, CIF CDF /DONE, RETURN TO ILOOP JMP I (ILOOP CDF 10 CIF /TAKE ERROR EXIT IF OUT OF RANGE RECORD REQUESTED BR, JMS I (ERROR CIF CDF JMP I (EOFSET /SET END OF FILE NOW /DEFINE RECORD LENGTH (PART OF OPEN PROCESSING) DFSIZE, JMS I (SFN1 /SET ALL THE POINTERS CIF JMS I (CALLF0 /GET 12 BIT RECORD SIZE UNSFIX CLL /RANGE CHECK RECORD NUMBER SZA TAD (2 SNA SZL /SKP IF RECORD LEGAL JMP SZ-2 /ERROR IF GT 4095 CDF DCA I IORSZ1 /ALL SET, STORE SIZE IN IOTABLE DCA I IONRL1 DCA I IONRH1 /CLEAR LAST RECORD SEEN (FOR ^Z DURING FILE CREATION) JMP I (ILOOP1 /OK, RETURN CDF 10 CIF SZ, JMS I (ERROR /TAKE ERROR IF RECORD NOT GE 1 AND LE 4093 PAGE /READ A RECORD SUBFIELD TO SAC READSF, JMS SETUP /DO COMMON SETUP OPERATION DCA I (SACLEN /INITIALIZE TO NULL STRING JMP SUBGO /JMP TO TOP TEST THE LOOP COUNTER SUBRDL, CDF /Patch GETCH to pass nulls TAETUP, 0 CDF 10 TAD NXTFLD /SEE IF ANOTHER FIELD LEFT SNA JMP EOFLD /JMP IF NO DCA SXR /POINT AT ITS DESCRIPTOR TAD I NXTFLD /LINK TO NEXT ONE DCA NXTFLD TAD I SXR /GET SIZE IF THIS ONE EOFLD, CMA /SET STEP COUNTER TO -SIZE-1 DCA STPCNT CDF TAD I (IOTHDR /SET PTR TO HEADER WORD DCA IOHDR1 TAD (SAC /SET PTR TO SAC DCA SACPT JMP I SETUP /DONE PAGE BFLSH JMP I (ILOOP1 /RETURN TO ILOOP /WRITE A RECORD SUBFIELD FROM SAC WRITSB, JMS SETUP /DO COMMON SETUP JMP WRITGO /JMP INTO LOOP WRITSA, CDF 10 TAD I SACPT /GET CHAR FROM SAC CDF ISZ SACPT SKP /SKP IN AND SEND IT WRITPD, CLL CLA /PUT 000 (NULL) CODE AS FILLER CHARACTER CIF JMS I (CALLF0 PUTCH /PUT CHAR OUT CDF STA /DECREMENT REMAINING RECORD SIZE TAD REMSIZ DCA REMSIZ WRITGO, TAD I (SACLEN /SEE IF ANY CHARS LEFT SNA CLA JMP NULSAC /NULL SAC, SEE IF FIELD ENDED ISZ I (SACLEN /BUMP COUNT NOP ISZ STPCNT /TEST FIELD COUNT JMP WRITSA /WRITE SAC IF MORE ROOM CDF 10 /ERROR IF FIELD TOO SHORT CIF SH, JMS I (ERROR /PRINT WARNING JMP I (ILOOP1 /--RETURN-- NULSAC, ISZ STPCNT /SEE IF MORE IN FIELD JMP WRITPD /PAD FIELD IF YES JMP I (ILOOP1 /--RETURN-- /WRITE END OF RECORD WRTEOR, JMS SETUP TAD REMSIZ /SET COUNT TO REMAINING RECORD SIZE CMA DCA STPCNT /SET COUNTER JMP EORGO /GO PAD THE REMAINDER OF RECORD EORPAD, CLL CLA /PAD RECORD WITH NULLS CIF JMS I (CALLF0 /SEND OUT A BLANK PUTCH EORGO, ISZ STPCNT JMP EORPAD EORFIN, CIF JMS I (CALLF0 /NOW SEND THE CR/LF CRLFR CDF TAD I IOHDR1 /SEE IF VARIABLE LENGTH FILE AND (4 SNA CLA JMP I (ILOOP1 /JMP OUT IF NO TAD EXPNDF /SEE IF FILE EXPANDED WITH THIS RECORD SPA CLA /SKP IF THIS RECORD WAS GE HIGHEST SO FAR JMP I (ILOOP1 /NO, RETURN TAD (32 /YES, SEND OUT ^Z CIF JMS I (CALLF0 PUTCH JMP I (ILOOP1 /--RETURN-- /COMMON SETUP CODE FOR READ/WRITE TO RECORD SNE TO MULTIPLY ACH;ACL BY AC /PRODUCT RETURNED IN PRODH;PRODL /SKIP RETURN IF RESULT LT 2**23 /ERROR RETURN OTHERWISE /(THIS ROUTINE SHOULD REALLY BE PART OF ARRAY SUBSCRIPT CALCULATION) MULT23, 0 DCA MULARG /SAVE MULTIPLIER DCA PRODH /CLEAR RESULT REGISTER DCA PRODL MULTLP, TAD MULARG /SEE IF ANYMORE TO MULTIPLY SNA JMP MOUT /RETURN IF NOT CLL RAR DCA MUL /DEFINE SUBFIELD OPERATOR DEFSUB, TAD EOLPTR /SEE IF FIRST TIME THROUGH SZA CLA /SKP IF YES, DO INITIALIZATION JMP DEFGO /ELSE JUST DEFINE NEXT FIELD CIF JMS I (CALLF0 /BE SURE FILE OPENED IDLE TAD REMSIZ /BE SURE THIS IS DIRECT ACCESS FILE SNA CLA JMP BF-2 /JMP OUT IF NO, GIVE ERROR CIF JMS I (CALLF0 /NOW CLEAR ANY CURRENT DEFINES RTNDEF DEFGO, TAD FREHD /SEE IF ANY DESCRIPTOR ELEMENTS LEFT SNA JMP DF-2 /JMP OUT IF NO DCA SUBFPT /IF YES, SAVE PTR TO NEXT ONE TAD I SUBFPT /REMOVE FROM LIST DCA FREHD CIF /NOW GET SIZE OF THIS FIELD JMS I (CALLF0 UNSFIX DCA SXR /SAVE IT TAD SXR /TEST IF FITS IN CURRENT RECORD CLL CIA TAD REMSIZ SNL CLA /SKP IF YES JMP BF-2 /ELSE TAKE ERROR EXIT TAD SXR /REDUCE REMAINING LENGTH OF RECORD CIA TAD REMSIZ DCA REMSIZ TAD EOLPTR /SEE IF FIRST FIELD SZA CLA /SKP IF YES JMP NOTFST /ELSE SKIP INITIALIZATION CDF TAD I (IOTSUB DCA IOSUB1 TAD SUBFPT /INIT PTR TO FIELDS IN IOTABLE DCA I IOSUB1 CDF 10 JMP .+3 NOTFST, TAD SUBFPT /STORE LINK TO THIS DESCRIPTOR IN PREV ONE DCA I EOLPTR TAD SUBFPT /MAKE THIS ONE CURRENT DCA EOLPTR /AND NEGATE ONCE ONLY STATUS DCA I EOLPTR /MARK END OF LIST TAD SXR /STORE SIZE ISZ SUBFPT DCA I SUBFPT /IN THE DESCRIPTOR JMP I (ILOOP1 /--RETURN-- CDF 10 CIF BF, JMS I (ERROR /TAKE ERROR ABORT CDF 10 CIF DF, JMS I (ERROR /NO MORE ROOM FOR RECORD FIELD DEFINITIONS FREHD, FREELS /POINTER TO LIST OF AVALIABLE RECORD FIELD DESCRIPTORS /UTILITY ROUTIARG /SHIFT AND STORE SNL /SKP IF SHOULD ADD THIS TIME JMP NOADD TAD I (ACL TAD PRODL DCA PRODL CML RAL TAD I (ACH TAD PRODH SPA SZL JMP MERR /TAKE ERROR RETURN IF OVERFLOW DCA PRODH NOADD, TAD I (ACL /SHIFT AC LEFT 1 CLL RAL DCA I (ACL TAD I (ACH RAL SPA SZL JMP MERR DCA I (ACH JMP MULTLP /DO NEXT BIT MOUT, ISZ MULT23 /SKIP RETURN IF NO OVERFLOW MERR, CLA CLL JMP I MULT23 /--RETURN-- MULARG, 0 /ROUTINE TO DIVIDE 23 BIT PRODUCT BY AC /12 BIT QUOTIENT TO PRODL, REMAINDER TO PRODH DIV23, 0 CLL CIA /NEGATE DIVISOR DCA DIVISR TAD (-15 /DO 13. STEP RESTORING DIVIDE DCA STPCNT JMP DIVIT /JMP INTO LOOP DIVLUP, TAD PRODH /SHIFT REMAINDER UP RAL DCA PRODH DIVIT, TAD PRODH /SEE IF GOES IN TAD DIVISR SMA /SKP IF NO DCA PRODH /UPDATE IF YES CLA TAD PRODL /SHIFT QUOT BIT IN RAL DCA PRODL ISZ STPCNT JMP DIVLUP /ITERATE JMP I DIV23 /--RETURN-- DIVISR, 0 PAGE /FLOATING POINT OUTPUT ROUTINE /CONVERT INTERNAL NUMBER TO ASCII /EXIT WITH CHAR STRING IN 'INTERB' /XR1 = POINTER TO LAST CHAR STORED *4400 XR11=11 XR21=12 XR31=13 XR41=14 XR51=15 FFOUT1, 0 CDF 0 /ALL OF PAGE REFERENCES TO FIELD ZERO JMS I [STORE /GO TO INITIALIZING ROUTINE TO SETUP FOR FIELD ONE TAD (INTERB-1 DCA XR11 /SET POINTER TO ASCII BUFFER TAD I ACH1 /SEE IF FAC NEGATIVE SMA CLA JMP OKPOS /JMP IF POSITIVE JMS I [FFNEG1 /TAKE ABS VALUE IF NEGATIVE TAD (177&"- /PRINT MINUS SIGN SKP OKPOS, TAD [40 /PRINT SPACE IF POSITIVE DCA I XR11 TAD I ACH1 /SEE IF NUMBER IS ZERO SNA CLA JMP ZERXIT /SPECIAL CASE IF SO JMS I (CVTNUM /CALL ROUTINE TO UNPACK TO BASE 10 TAD (NUMBUF-1 DCA XR21 /POINT XR21 AT DIGIT BUFFER TAD (5 /TEST FORMAT TO USE TAD I DECEX1 CLL TAD (-4 SNL JMP SMLFMT /JMP IF .0NNNNNN TO .0000NNNNNN TAD (-7 SZL CLA JMP REGFMT /JMP IF .NNNNNN TO NNNNNN /OTHERWISE USE E FORMAT N.NNNNNE+NNN OR N.NNNNNE-NNN TAD I XR21 /GET DIGIT TO LEFT OF POINT JMS I [PUTD /PUT IT OUT TAD (177&". DCA I XR11 /NOW SEND OUT DECIMAL POINT TAD (-5 DCA I AC21 /DO 5 MORE DIGITS TAD I XR21 /PICK UP DIGIT JMS I [PUTD /CONVERT TO ASCII AND STORE ISZ I AC21 JMP .-3 /LOOP FOR MORE TAD (177&"E /PRINT E DCA I XR11 / CLL TAD I DECEX1 /TAKE ABS(DECEXP) SPA CML CIA DCA I DECEX1 RTL /CONVERT "+" TO "-" IF NEGATIVE TAD (177&"+ DCA I XR11 JMS IDIV /PRINT 3 DIGITS OF EXPONENT NOW -144 JMS IDIV -12 TAD I DECEX1 JMS I [PUTD RET, JMS I [RESTRE /REPLACE XR1 AND LIKE THAT CIF CDF 0 JMP I FFOUT1 /ALL DONE --RETURN-- /HANDLE .0NNNNNN TO .0000NNNNNN SMLFMT, DCA I AC01 /STORE NUMBER OF LEADING ZEROES TAD (177&". /PUT OUT DECIMAL POINT DCA I XR11 JMS I [PUTD /SEND A 0 ISZ I AC01 JMP .-2 /LOOP FOR LEADING 0'S /GENERAL NON E FORMAT .NNNNNN TO NNNNNN REGFMT, TAD (-7 DCA I AC11 /INIT COUNT OF NONZERO DIGITS TAD (NUMBUF+6 DCA I AC21 /POINT AT END OF DIGIT BUFFER SHRINK, STA /DECREMENT DIGIT POINTER TAD I AC21 DCA I AC21 ISZ I AC11 /REDUCE SIGNIFICANT DIGIT COUNT TAD I DECEX1 IAC TAD I AC11 SMA CLA JMP PRTLP /JMP OUT IF NOT TO RIGHT OF DECIMAL POINT STA TAD I AC21 /ELSE LOOK AT DIGIT DCA 17 TAD I 17 SNA CLA JMP SHRINK /DISCARD IT IF ZERO PRTLP, STA TAD I DECEX1 DCA I DECEX1 /SEE IF DIGIT TO BE PRINTED FOLLOWS DP AC0002 TAD I DECEX1 SZA CLA JMP NODP /NO TAD (177&". /YES, PRINT DP DCA I XR11 NODP, TAD I XR21 /PICK UP DECIMAL DIGIT JMS I [PUTD /PUT OUT ISZ I AC11 JMP PRTLP /JMP IF MORE DIGITS TO PRINT JMP RET /--RETURN-- ZERXIT, JMS I [PUTD JMP RET /--RETURN-- /DIVIDE I DECEX1 BY -DIVISOR IN CALL+1 IDIV, 0 DCA I AC11 /CLEAR QUOTIENT IDIVLP, TAD I DECEX1 CDF 10 TAD I IDIV CDF 0 SPA JMP IDVOUT /JMP OUT IF LESS THAN DIVISOR DCA I DECEX1 /ELSSIVE MULTIPLIES OR DIVIDES BY 10. FOLLOWED BY /RENORMALIZATIONS UNTIL INTEGER BITS /DDDD ARE LT 10. /DECIMAL DIGITS ARE ISOLATED BY REPEATED MULTIPLICATION BY 10. CVTNUM, 0 DCA I AC11 /CLEAR OVERFLOW WORD JMS ADJDEC /NORMALIZE NUMBER AND SET RETURN ADDR TAD I ACX1 /RANGE CHECK BINARY EXPONENT NOW SPA SNA JMP MULGO2 /JMP IF NUMBER LT 1 TAD (-5 /SEE IF EXP GT 4 SMA JMP DIVGO /JMP IF YES, REDUCE TOWARDS ZERO INRANG, DCA I AC21 /SET SHIFT COUNTER SKP JMS AR1 /SHIFT FAC RIGHT ISZ I AC21 JMP .-2 /LEAVE EFFECTIVE BINARY POINT RIGHT OF I ACH1 BIT 4 TAD I ACH1 /ACH = 0DD DDF FFF FFF (D=DECIMAL DIGIT BITS) TAD (5400 /SEE IF DDDD GE 10 SMA CLA JMP DIVGO /DIVIDE AGAIN (NORMALIZATION WILL WORK) CLL TAD I AC11 /NOW ROUND BY ADDING 0.000005 TAD (4761 DCA I AC11 IAC /ADD 24761 TO LOW BITS RAL TAD I ACL1 DCA I ACL1 SZL ISZ I ACH1 TAD I ACH1 TAD (5400 /SEE IF CARRY INTO 9.XXX... SZA CLA JMP CVT10 /JMP IF NO TAD [200 /ELSE SET TO 1.00000 DCA I ACH1 DCA I ACL1 DCA I AC11 ISZ I DECEX1 /AND BUMP DECIMAL EXPONENT O4, 4 /EFFECTIVE NOP /NOW CONVERT TO DECIMAL DIGITS CVT10, TAD (-6 /DO 6 DIGITS DCA I AC01 TAD (NUMBUF-1 DCA XR31 JMP CVTGO /FIRST DIGIT IS ALREADY IN CVTLP, TAD I ACH1 /ZERO OUT PREV DIGIT AND [177 DCA I ACH1 JMS I (MPY101 /NOW MULTIPLY BY 10. CVTGO, TAD I ACH1 /GET DIGIT FROM 0DD DDF FFF FFF RTL RTL RTL AND [17 DCA I XR31 /STORE IT ISZ I AC01 JMP CVTLP /LOOP IF MORE JMP I CVTNUM /--RETURN-- /ROUTINE UPDATE IT ISZ I AC11 /TALLY QUOTIENT JMP IDIVLP /ITERATE IDVOUT, CLA TAD I AC11 /GET QUOT AS NEXT DIGIT JMS I [PUTD /PUT OUT ISZ IDIV JMP I IDIV PAGE /CONVERT NUMBER IN FAC TO FORMAT N.NNNNNE NNN /DECIMAL EXPONENT RETURNED AS SIGNED NUMBER IN I DECEX1 /6 DIGITS STORED IN NUMBUF AS BINARY 0-9 /FIRST REDUCES MANTISSA TO FORM 0DD DDF FFF FFF... /BY SUCCESY EXPONENT DCA I ACX1 JMP NORML /TRY AGAIN MULGO, TAD I ACX1 /INCREASE BINARY EXP TOWARDS ZERO MULGO2, TAD O4 DCA I ACX1 JMS I (AC2OP /COPY AC TO OP JMS AR1 /SHIFT RIGHT 4 BITS AND MULTIPLY BY 10. JMS AR1 /MAX RELATIVE ERROR LT (7*2^-34)/5 PER MULTIPLY JMS I (OADD1 JMS AR1 AC7776 /DECREASE DECIMAL EXPONENT JMP DECRXP /RENORMALIZE AND TRY AGAIN DIVGO, CLA CLL TAD [-40 /SET 32. STAGE SUBTRACT-SHIFT DIVIDE (SLOW BUT ACCURATE) DCA I AC21 /MAX RELATIVE ERROR WILL BE LT 9*2^-34. PER DIVIDE DVLOOP, TAD I ACH1 /SEE IF GE 10. TAD (5400 SMA DCA I ACH1 /UPDATE IF YES CML STA RAL DCA I AC01 /SAVE LOW ORDER BIT JMS I (AL11 /SHIFT MANTISSA NOW ISZ I AC01 /STORE BIT NOW ISZ I AC11 ISZ I AC21 /BUMP COUNT JMP DVLOOP /ITERATE TAD I ACH1 /NOW ZERO OUT REMAINDER AND [377 DCA I ACH1 DECRXP, IAC /NOW INCREASE DECIMAL EXPONENT TAD I DECEX1 JMP ADJDEC+1 /SHIFT FAC RIGHT 1 BIT AR1, 0 TAD I ACH1 CLL RAR DCA I ACH1 TAD I ACL1 RAR DCA I ACL1 TAD I AC11 RAR DCA I AC11 JMP I AR1 /DONE PAGE /FLOATING POINT INPUT ROUTINE /IGNORES LEADING SPACES, TABS, CARRAIGE CONTROL CHARS /PRODUCES ROUNDED RESULT GOOD TO 23 BITS USING 35 BIT ARITHMETIC XR11=11 XR21=12 XR31=13 XR41=14 XR51=15 FFIN1, 0 CDF 0 STA DCA DPFLAG /SET A DECIMAL POINT FLAG STA DCA SIGN /INITIALIZE MINUS SIGN FLAG CDF 10 DCA I (MPY101 /USE ROUTINE ENTRY AS A FLAG CDF 0 DCA OVFCNT /ZERO OVERFLOW DIGIT COUNT DCA I ACH1 /CLEAR OUT THE FAC NOW DCA IE TO TRADE BINARY FOR DECIMAL EXPONENTS /ENTER TO NORMALIZE 36 BIT NUMBER AND SET RETURN ADDR /RE ENTER TO MULTIPLY OR DIVIDE BY 10. AND RENORMALIZE ADJDEC, 0 DCA I DECEX1 /STORE UPDATED DECIMAL EXPONENT NORML, TAD I ACH1 /SEE IF FRACTION IS NORMALIZED RAL SPA SZL CLA JMP I ADJDEC /RETURN IF YES JMS I (AL11 /SHIFT AC LEFT 1 BIT STA TAD I ACX1 /COMPENSATE BINAR JMP NOTPD /JMP IF DP SEEN ALREADY AC0002 /ELSE SEE IF THIS IS DP TAD DIGIT SNA CLA /SKP IF NO JMP FRACLP /GET FRACTION DIGITS IF YES DCA DIGCNT /ZERO FRACTION DIGIT COUNT IF NO DP SEEN NOTPD, TAD SIGN /SAVE SIGN OF FRACTION CDF 10 DCA FSIGN /IN A TRULY RANDOM PLACE STA /NOW RESET MINUS SIGN FLAG DCA SIGN ISZ I (MPY101 /DISABLE LEADING SPACE SUPRESSION NOW CDF 0 TAD I CHAR1 /SEE IF E FORMAT TAD (-105 SNA CLA /SKP IF NO GETEXP, JMS GCHR /ELSE GET A DECIMAL EXPONENT CHAR JMP EDONE /JMP IF AT DELIMITER TAD I DECEX1 /MULTIPLY CURRENT EXP BY 10 CLL RTL /*4 TAD I DECEX1 /*5 CLL RAL /*10 TAD DIGIT /ADD IN NEW DIGIT JMP GETEXP /UPDATE I DECEX1 AND GET NEXT DIGIT EDONE, JMS I (SNFAC /SPECIAL CASE TEST FOR ZERO FRACTION JMP RET1 /RETURN IF YES, (SIMPLIFIES ADJDEC ROUTINE) TAD O43 /OK, SET INITIAL EXPONENT DCA I ACX1 TAD I DECEX1 /GET EXPONENT ISZ SIGN CIA /IN TWOS COMPLEMENT TAD DIGCNT /ADD COMPENSATION FOR DIGITS AFTER DP TAD OVFCNT /ADD EXCESS DIGITS IGNORED BEFORE DP JMS I (ADJDEC /SET IT AND NORMALIZE TAD I DECEX1 /TEST THE REMAINING DECIMAL EXP SPA JMP I (DIVGO / ACL1 DCA I ACX1 DCA I AC11 /CLEAR OVERFLOW WORD TOO FRACLP, DCA DIGCNT /CLEAR DIGIT COUNTER DIGLUP, JMS GCHR /GET A CHAR JMP NOTDIG /JMP IF NOT A DIGIT TAD I ACH1 /SEE IF ROOM IN REGISTER TAD (-314 /OK IF HIGH WORD LT 2048/10 = 204 SPA CLA /SKP IF NO JMP DGFITS /ELSE HANDLE IT NORMALLY TAD DPFLAG /SEE IF DIGIT IS AFTER DP SPA CLA /SKP IF YES ISZ OVFCNT /ELSE BUMP IGNORED SIGNIFICANT DIGIT COUNT JMP DIGLUP /TRY NEXT CHAR DGFITS, JMS I (MPY101 /MULTIPLY BY 10 (INDICATES A DIGIT GOTTEN) TAD DIGIT /NOW ADD IN THE NEW DIGIT DCA I AC21 /PUT IN OP LOW WORD DCA I OPL1 DCA I OPH1 /ZERO HIGH OP JMS I (OADD1 /ADD IT IN STA /NOW BUMP DIGIT COUNTER TAD DIGCNT JMP FRACLP /GET ANOTHER CHAR NOTDIG, ISZ DPFLAG /TEST THE DP FLAG, 0 DCA I DECEX1 /STORE ACCUMULATED EXPONENT (MAYBE) JMS I (INPUT /GET A CHAR FROM TTY. TAD I CHAR1 /PICK IT UP TAD (-53 /TEST IF + OR - CLL RTR /LINK ON IF MINUS SZA CLA /SKP IF + OR - JMP NOTSGN /ELSE SKIP THIS SZL /SKP IF + DCA SIGN /FLIP SWITCH IF - JMS I (INPUT /GET A CHAR. NOTSGN, TAD I CHAR1 TAD (-72 /SEE IF ITS A DIGIT CLL TAD (12 DCA DIGIT /STORE FOR LATER SZL /DIGIT? ISZ GCHR /YES-RETN. TO CALL+2 JMP I GCHR /NO-RETN. TO CALL+1 PAGE SNFAC, 0 TAD I ACH1 /TEST ALL 36 BITS FOR ZERO SNA TAD I ACL1 SNA TAD I AC11 SZA CLA /SKP RETURN BUMP IF ALL ZERO ISZ SNFAC JMP I SNFAC /--RETURN-- /MULTIPLY I ACH1 I;ACL1 I;AC11 BY 10. MPY101, 0 JMS I (AC2OP /COPY AC FRACTION TO OP JMS I (AL11 /*2 JMS I (AL11 /*4 JMS I (OADD1 /*5 JMS I (AL11 /*10 JMP I MPY101 / /FLOATING NEGATE / FFNEG1, 0 /(USED AS A TEM. BY OUTPUT ROUTINE) TAD I ACL1 /GET LOW ORDER FAC CLL CMA IAC /NEGATE IT DCA I ACL1 /STORE BACK CML RAL /ADJUST OVERFLOW BIT AND TAD I ACH1 /PROPAGATE CARRY-GET HI ORD CLL CMA IAC /NEGATE IT DCA I ACH1 /STORE BACK JMP I FFNEG1 AL11, 0 TDIVIDE FRACTION BY 10 IF MINUS SZA CLA JMP I (MULGO /MULTIPLY FRACTION BY 10 IF POSITIVE TAD I AC11 /ROUND TO 23 BITS IF REDUCED TO ZERO SPA CLA /SKP IF NO ROUND ISZ I ACL1 JMP NOBUMP /NO CARRY ISZ I ACH1 TAD I ACH1 /TEST IF OVERROUND SMA CLA /SKP IF YES JMP NOBUMP JMS I (AR1 /CORRECT IT ISZ I ACX1 /COMPENSATE BINARY EXPONENT O43, 43 /EFFECTIVE NOP NOBUMP, ISZ FSIGN /TEST SIGN OF RESULT JMS I [FFNEG1 /COMPLEMENT IF NEGATIVE RET1, CIF CDF 0 JMP I FFIN1 /--RETURN-- OVFCNT, 0 /OVERFLOW DIGIT COUNT DPFLAG, 0 /DECIMAL POINT SEEN FLAG FSIGN, 0 /TEMPORARY SIGN OF FRACTION DIGCNT= XR31 SIGN= XR41 DIGIT= XR51 /ROUTINE TO GET NEXT DIGIT /RETURN TO CALL+1 IF DON'T HAVE DIGIT /RETURN TO CALL+2 IF HAVE DIGIT GCHROUNTERPARTS STORE, 0 TAD INC4 /USE AI 17 DCA MOV1 /AS THE POINTER TO FIELD 0 REGISTERS TAD INC1 DCA MOV2 /TO POINT TO FIELD ONE AI REGISTERS TAD MOV31 DCA MOV3 /INCREMENT MOV2 THIS LOOP TAD (10 JMS MOVER /GO MOVE REGISTERS JMP I STORE /THIS ROUTINE IS USED BOTH BY STORE AND RESTRE /TO MOVE FIELD 0 REG TO FIELD ONE, AND REVERSE MOVER, 0 DCA 17 TAD (-5 DCA AICNT /DO 5 REGISTERS MOV1, 0 MOV2, 0 MOV3, 0 ISZ AICNT JMP MOV1 JMP I MOVER AICNT,0 /COUNTDOWN VARIABLE INC1, DCA 11 /CALCULATED DCA INC4, TAD I 17 /CALCULATED TAD INC5, DCA I 17 /CALCULATED DCA INC7, TAD 11 /CALCULATED TAD MOV31, ISZ MOV2 /INCREMENT THE SECOND VARIABLE MOV30, ISZ MOV1 /INCREMENT THE FIRST CALCULATED VARIABLE RESTRE, 0 TAD IAD I AC11 /GET OVERFLOW BIT CLL RAL /SHIFT LEFT DCA I AC11 /STORE BACK TAD I ACL1 /GET LOW ORDER MANTISSA RAL /SHIFT LEFT DCA I ACL1 /STORE BACK TAD I ACH1 /GET HI ORDER RAL DCA I ACH1 /STORE BACK JMP I AL11 /RETN. OADD1, 0 CLL TAD I AC21 /ADD OVERFLOW WORDS TAD I AC11 DCA I AC11 RAL /ROTATE CARRY TAD I OPL1 /ADD LOW ORDER MANTISSAS TAD I ACL1 DCA I ACL1 RAL TAD I OPH1 /ADD HI ORDER MANTISSAS TAD I ACH1 DCA I ACH1 JMP I OADD1 /RETN. /CONVERT NUMBER IN AC TO ASCII DIGIT /MUST NOT TOUCH THE LINK PUTD, 0 TAD (177&"0 /ADD IN 0 DCA I XR11 /STORE IN BUFFER JMP I PUTD /INPUT ROUTINE, IGNORES LEADING SP, HT, LF, VT, FF, AND CR CHARS INPUT, 0 CIF CDF JMS I (GETCH1 /LINK TO FIELD 0 ROUTINE CDF TAD MPY101 /TEST IF ANY INPUT YET SNA CLA /BYPASS LEADING CHAR IGNORES IF YES TAD I CHAR1 /NO-GET CHAR1 TAD [-40 /COMPARE AGAINST SPACE SZA /SKP IF SPACE TAD (40-11 /CHECK IF HT, LF, VT OR FF CLL TAD (-5 SNL CLA /SKP IF NONE OF ABOVE JMP INPUT+1 /YES-IGNORE IT JMP I INPUT /RETURN /THIS ROUTINE MOVES THE FIELD ZERO AI REGISTERS /TO THEIR FIELD 1 C / 240 CAPS / 260 OCT / 300 BIN / 320 OCS / 340 /OCS$(O) RETURN OCTAL REPRESENTATION OF POSITIVE NUMBER LT 2^23 OCS, JMS I FIX23I /FIX THE NUMBER TAD (-10 /RETURN 8. DIGITS DCA TEMP2 OCSLUP, TAD ACH /ISOLATE NEXT DIGIT RTL RTL AND (7 TAD (60 /MAKE ASCII JMS I (SACPUT /PUT IN SAC JMS I (AL1 /SHIFT LEFT JMS I (AL1 JMS I (AL1 ISZ TEMP2 JMP OCSLUP /DO NEXT DIGIT JMP I (SETLEN /SET LENGTH AND RETURN IN SMODE /OCT AND BIN FUNCTIONS OCT, TAD (6 /SET MASK TO 7 IF OCT(O$) BIN, IAC /SET MASK TO 1 IF BIN(B$) DCA AC0 JMS I PFACCLR /ZERO THE FAC TAD SACLEN /SEE IF NULL STRING SNA CLA JMP OBXIT /QUICK EXIT IF YES OBLUP, CDF 10 TAD I SACXR /GET A CHAR CDF DCA TEMP2 /SAVE IT TAD AC0 /MASK THE HIGHNC7 /MOVE FROM AI 11, FIELD 1 DCA MOV1 TAD INC5 /TO AI 11, FIELD 0 DCA MOV2 TAD MOV30 /INCREMENT INC7 THIS TIME DCA MOV3 TAD (10 JMS MOVER JMP I RESTRE /COPY AC FRACTION TO OP FRACTION AC2OP, 0 TAD I ACH1 DCA I OPH1 TAD I ACL1 DCA I OPL1 TAD I AC11 DCA I AC21 JMP I AC2OP ///////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////// ////////////// OVERLAY 2- STRING FUNCTIONS ///////////////// ///////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////// FIELD 2 *2000 RELOC OVERLAY /VERSION NUMBER WORD FOR STRING OVERLAY VERSON&77^100+SUBVSF+60 OVDISP, TAD PSACM1 DCA SACXR /ALWAYS SET SACXR UP FOR STRING FUNCTIONS JMS I (FBITGT /GET FUNCTION TYPE TAD JMPSF /BUILD JMP DISPATCH INLINE DCA .+1 HLT JMPSF, JMP I .+1 /JMP OFF THE SET 2 TABLE /JUMP TABLE FOR FUNCTION SET 2 ASC /FUNCTION BITS= 000 CHR / 020 DATE / 040 LEN / 060 POS / 100 SEG / 120 STR / 140 VAL / 160 FIXPT / 200 TRACE / 220 STRNEG FER FIRST TAD XR1 CIA TAD (INTERB-1 DCA TEMP2 /SAVE COUNTER TAD (INTERB-1 DCA XR1 /POINT AT BUFFER STRLUP, TAD I XR1 /GET A CHAR TAD (-40 /CROCK TO DELETE BLANKS SNA /SKP IF NOT BLANK JMP .+3 /ELSE IGNORE CHAR TAD O40 /FIX CHAR JMS I (SACPUT ISZ TEMP2 JMP STRLUP /LOOP FOR MORE JMP SETLEN /DONE-SET LENGTH OF SAC AND RETURN /CAP$ FUNCTION /CONVERT S ORDER BITS CMA AND TEMP2 TAD (-60 /SEE IF LEGAL DIGIT SZA CLA JMP OBERR /RETURN AT ONCE IF NO TAD AC0 /NOW SETUP FOR SHIFT OBSHFT, DCA AC2 JMS I (AL1 /SHIFT FAC LEFT TAD AC2 /SHIFT MASK RIGHT CLL RAR SZA /SKP IF DONE JMP OBSHFT /ELSE DO ANOTHER TAD AC0 /NOW ISOLATE NEW BITS AND TEMP2 TAD ACL DCA ACL ISZ SACLEN /DECR COUNT JMP OBLUP /LOOP OBXIT, TAD (27 /NOW SET EXPONENT OF RESULT DCA ACX JMS I PFFNOR /FLOAT NUMBER JMP I PILOOP /EXIT OBERR, TAD SACXR /IF BAD CHAR, RETURN -(ITS INDEX IN STRING) CIA TAD PSACM1 JMP I (FLOATS /FLOAT IT AND RETURN PAGE /CHR$ FUNCTION /RETURNS 1 7 BIT CHAR FOR VALUE OF X CHR, JMS I PUNSFIX /FIX X TO 12 BIT INTEGER AND IOMASK /MASK TO 7 OR 8 BITS JMS I (SACPUT /PUT STRING IN SAC SETLEN, TAD SACXR /NOW COMPUTE -SAC LENGTH CIA TAD PSACM1 DCA SACLEN /SET IT JMP I (SSMODE /SET TO SMODE AND RETURN /ASC FUNCTION /RETURNS DECIMAL ASCII FOR 1 CHAR STRING IN FAC ASC, CDF 10 TAD I SACXR /GET FIRST CHAR OF STRING CDF JMP FLOATS /FLOAT RESULT INTO FAC AND RETURN /LEN FUNCTION /RETURNS LENGTH OF SAC IN FAC LEN, TAD SACLEN /LENGTH OF STRING IN SAC CIA /MAKE POSITIVE /ROUTINE TO FLOAT FAC AND RETURN FLOATS, DCA ACH /NUMBER TO BE FLOATED IN HORD DCA ACL /CLEAR LORD DCA AC1 /CLEAR FPP OVERFLOW TAD (13 /SET EXP TO 11 DCA ACX JMS I PFFNOR /NORMALIZE JMP I PILOOP /RETURN /STR$ FUNCTION /RETURNS ASCII STRING FOR NUMBER IN FAC STR, JMS I (FFOUT /GET NUMBER INTO INTERMEDIATE BUF DATEWD TAD I (BIPCCL /NOW GET YEAR EXTENSION AND (600 /IT'S IN THE 600 BITS CLL RTR RTR /SHIFT INTO PLACE DCA YEAREX /HOLD YEAR EXTENSION TAD DATEWD /NOW GET DAY OF MONTH AND (370 CLL RTR RAR JMS PUTN /PUT "DD-" IN SAC TAD (55 JMS SACPUT TAD DATEWD /ISOLATE MONTH AND O7400 CLL RTL RTL RTL TAD (MONTHS-2 DCA TEMP2 /POINT AT ASCII FOR THIS MONTHAC TO UPPER CASE CAPS, TAD SACLEN /SEE IF NULL STRING SNA JMP I (SSMODE /NOTHING TO DO DCA VALCNT /SET COUNT TAD PSACM1 /SETUP PTR DCA XR1 CDF 10 CAPSLP, TAD I SACXR /RANGE CHECK CHAR FOR LOWER CASE ALPHA TAD (-173 CLL TAD (173-141 SZL /SKP IF NOT LOWER CASE TAD (-40 /ELSE CONVERT TO UPPER CASE TAD (141 /RESTORE CHAR DCA I XR1 /PUT BACK IN SAC ISZ VALCNT JMP CAPSLP / CDF JMP I (SSMODE /--RETURN-- /VAL FUNCTION /RETURNS NUMBER IN FAC FOR STRING IN SAC VAL, STA TAD SACLEN DCA VALCNT /COUNT OF CHARS TO INPUT TAD (VALGET /ADDR OF PHONY INPUT ROUTINE DCA I (IGETCH /PUT IN INPUT ROUTINE IN PLACE OF KRB JMS I (FFIN /CALL FPP INPUT ROUTINE TAD (GETCH /NOW RESTORE REAL INPUT ADDR DCA I (IGETCH /RESTORE IN INPUT ROUTINE JMP I PILOOP /DONE VALGET, 0 ISZ VALCNT /TEST COUNT JMP .+3 /JMP IF NOT END OF SAC TAD O77 /ELSE RETURN AN EFFECTIVE DELIMITER TO FFIN JMP RTNCR CDF 10 TAD I SACXR /GET THE CHAR FROM SAC CDF RTNCR, DCA CHAR JMP I VALGET /RETURN WITH CHAR IN 'CHAR' VALCNT, 0 PAGE /DATE FUNCTION /RETURNS STRING OF THE FORM "DD-MMM-YY" IN SAC IF DATE IS PRESENT /RETURNS NULL STRING OTHERWISE DATE, TAD CDFIO /COPY CDF TO FIELD 17600 IN LINE DCA .+1 YEAREX, 0 TAD PSFLAG /GET TD8E BIT TO LINK CLL RAL SNL CLA TAD I (MDATE /IF ZERO LOOK AT MDATE IN N7600 SZL TAD I (MDATE-200 /ELSE LOOK AT N7400 CDF /DATE IS IN THE FORM MMM MDD DDD YYY SNA /SKP IF HAVE SYSTEM DATE JMP I (SETLEN /ELSE RETURN NULL STRING DCA TAD I TEMP2 /GET THE FIRST CHAR JMS SACPUT /PUT IN SAC ISZ TEMP2 TAD I TEMP2 /GET THE NEXT CHAR BSW AND O77 /MASK TO 6BIT TAD (140 /CONVERT TO LOWER CASE JMS SACPUT TAD I TEMP2 /GET THE LAST CHAR AND O77 TAD (140 JMS SACPUT /STORE IT TAD (55 /SEND OUT "-" JMS SACPUT TAD DATEWD /FINALLY GET YEAR AND (7 TAD YEAREX /ADD TO EXTENSION BITS TAD O106 /ADD 70. FOR BASE YEAR JMS PUTN /PUT OUT "YY" JMP I (SETLEN /SET LENGTH AND RETURN IN SMODE PUTN, 0 ISZ NHIGH /BUMP HIGH ORDER DIGIT TAD (-12 /-10. SMA JMP .-3 /LOOP IF NOT REDUCED YET TAD (12+60 /CONVERT TO DECIMAL DIGIT DCA NLOW /HOLD MOMENTARILY TAD NHIGH /NOW GET HI ORDER DIGIT TAD (57 /MAKE 6BIT JMS SACPUT TAD NLOW /SEND OUT LOW DIGIT JMS SACPUT DCA NHIGH /CLEAR NHIGH FOR NEXT TIME (BE CAREFULL!!) JMP I PUTN SACPUT, 0 CDF 10 DCA I SACXR /STORE THE CHAR CDF JMP I SACPUT NHIGH, 0 NLOW, 0 MONTHS, TEXT /AJANAFEBAMARAAPRAMAYAJUNAJULAAUGASEPAOCTANOVADEC/ DATEWD= .-1 O106= MONTHS+2 /TRACE FUNCTION-ROUTINE TO TURN TRACE ON AND OFF TRACE, TAD ACH /GET HI MANTISSA OF ARG SNA CLA /SKP TO TURN TRACE ON TAD TRREST /ELSE RESTORE TRACE BYPASS INSTR IN LINE NUMBER ROUTINE DCA I (TRHOOK /BY NOP ING INSTRUCTION AT TRHOOK TRREST, JMP I PILOOP PAGE /SEG$ FUNCTION /RETURNS SEGMENT OF X$ BETWEEN Y AND Z /IF Y<=0,THEN Y TAKEN AS 1 /IF Y>LEN(X$),NULL STRING RETURNED /IF Z<=0,NULL STRING RETURNED /IF Z>LEN(X$),Z IS SET=LEN(X$) /IF Z0? SMA SZA CLA JMS I PUNSFIX /FIX IF POSITIVE SNA IAC /SET Y TO 1 IF Y.LE.0 DCA YARG TAD SACLEN /COMPARE YARG TO SACLEN CIA STL CIA TAD YARG SNL SZA CLA /SKP IF YARG.LOS.LEN(X$) JMP NULLST /NO-RETURN THE NULL STRING DCA INSAV /FAKE POINTER TO SCALAR #0 JMS I ARGPLK /GET ADDR OF Z JMS I PFFGET /LOAD Z INTO FAC ARGPLK, ARGPRE /LOC SKIPPED BY FPP SO WE PUT CONST HERE TAD ACH /HI MANTISSA OF Z SPA SNA CLA /IS Z<0? JMP NULLST /YES-RETURN THE NULL STRING JMS I PUNSFIX /NO-FIX Z STL TAD SACLEN /CALC Z-LEN(SAC) SNL /SKP IF Z.LO.LEN(SAC) CLA /ELSE TAKE LEN(SAC) CMA TAD SACLEN TAD YARG /NUMBER OF BYTES TO USE SMA JMP NULLST /NONE, RETURN NULL STRING DCA STRCNT TAD YARG /INDEX INTO STRING FOR SOURCE BYTES TAD (SAC-2 DCA XR2 /SET SOURCE XR TAD STRCNT DCA SACLEN /SET NEW LENGTH OF SAC NOW CDF 10 TAD I XR2 /NOW MOVE THE BYTES DCA I SACXR ISZ STRCNT JMP .-3 / CDF JMP I (SSMODE /--RETURN-- NULLST, CLA CLL DCA SACLEN /ZERO SAC JMP I (SSMODE /--RETURN-- YARG, 0 /POS FUNCTION /RETURNS THE POSITION IN X$ OF Y$ STARTING AFTER Z POS, CLA CLL DCA INSAV /FAKE AS STRING CALL TO STRING 0 JMS I (STFIND /FIND Y$ TAD STRCNT /# OF CHARS IN Y$ SNA CLA /IS Y$ THE NULL STRING? JMP ONERET /YES-RETURN 1 AS POSITION TAD SACLEN /NO-# OF CHARS IN X$ SNA CLA /IS X$ THE NULL STRING? JMP ZRORET /YES-RETURN 0 TAD ACH /NO-GET HORD OF Z SPA SNA CLA /IS Z GT 0? PA, JMS I PERROR /NO-ILLEGAL ARGUMENT JMS I PUNSFIX /FIX Z DCA POSITN /USE IT AS POSITION TO START SEARCH TAD POSITN STL TAD SACLEN /COMPARE POSITION TO MAXIMUM LENGTH OF STRING SNL SZA CLA JMP PA /Z IS PAST END OF STRING-ERROR POSSET, TAD STRCNT CMA TAD POSITN /GET POSITION NOW CHECKING+SIZE IF Y$ TAD SACLEN /COMPARE AGAINST LENGTH OF STRING SMA SZA CLA /ANY MORE TO COME? JMP ZRORET /NO-SEARCH FAILS JMS I (BYTSET /SETUP BYTE LOAD ROUTINE TAD POSITN /SEARCH START POSITION IN X$ TAD (SAC-2 /ADD TO BASE OF SAC DCA SACXR TAD STRCNT /# OF CHARS IN Y$ DCA AC2 /COUNTER SRCLP, JMS I (LDB CIA CDF 10 TAD I SACXR /COMPARE CHARS CDF SNA CLA /DO THEY MATCH? JMP SCONTU /YES-CONTINUE MATCH TO NEXT CHAR IN X$ AND Y$ ISZ POSITN /BUMP POSITION TO BE CHECKED JMP POSSET /ITERATE SCONT SAC LENGTH PASSED IN AC JMP SRETN /JMP TO FINISH OFF XSARITH,JMS SACTOA /MOVE SAC TO ABUF FIRST, TERMINATED BY A NULL TAD (BBUF-1 /MOVE ARG TO B BUFFER DCA XR1 TAD STRCNT SNA CLA JMP SGO SARMOV, JMS I (LDB CDF 10 DCA I XR1 CDF ISZ STRCNT JMP SARMOV SGO, CDF 10 DCA I XR1 / CDF JMS I (PWFECH /GET SUB-OPCODE TAD (JMP I SARVEC /CREATE JMP INLINE DCA .+2 CIF CDF 10 /LINKAGE TO FIELD 1 HLT /GETS DISPATCH TO ROUTINE /VECTOR OF STRING ARITH ENTRY POINTS SARVEC, SADD SSUB PSISUB, SISUB SMUL SDIV SIDIV /INT$(A$) FUNCTION FIXPT, JMS SACTOA /COPY ARG TO A BUFFER CIF CDF 10 JMP I (SINTEGR /JMP TO INT FUNCTION /STRING UNARY MINUS STRNEG, JMS SACTOA /COPY ARG TO THE A BUFFER CIF CDF 10 DCA I (BBUF /PASS NULL STRING IN B BUFFER JMP I PSISUB /JMP TO SUBTRACT ROUTINE /PRINT USING INIT AND OUTPUT XPUINI, TAD (FMTBUF-ABUF JMS SACTOA /MOVE SAC TO PATTERN REGISTER CDF 10 /NOW SET THE INIT FLAG STL RTL DCA I (UINIT JMP I PILOOP /RETURN TO ILOOP (RESETS DF) XPUEXE, TAD (BBUF-ABUF /LOAD B BUFFER WITH OUTPUT NUMBER STRING JMS SACTOA CIF CDF 10 TAD I (UINIT /ADVANCE STATE OF INIT FLAG CLL RAR DCA I (UINIT /THIS CLEARS INIT STATE ON SECOND OUTPUT JMP I (USING /JMP TO PRINT USING CODE NOW SRETN, TAD PSACM1 /RETURN HERE FOR FINAL STRING PROCESSING DCA SACXR /SETUP TO COPY RESULT INTO SAC TAD (SBUF-1 DCA XR1 TAD SACLEN SNA JMP I (SSMODE /DONE IF NULL STRING /SET INTERPRETER TO STRING MODE (IN CASE OF FUNCTION CU, ISZ AC2 /MORE CHARS IN Y$? JMP SRCLP /YES, ITERATE TAD POSITN /NO FOUND A MATCH JMP I (FLOATS ZRORET, JMS I PFACCLR /SEARCH FAILS-RETURN 0 JMP I PILOOP ONERET, CLA IAC JMP I (FLOATS /RETURN 1 POSITN, 0 PAGE /STRING ARITHMETIC INTERFACE /SETS UP BUFFERS AND CALLS STRING PACKAGE LOCATED IN FIELD 1 /STRING ARITH EXIT ROUTINE SEXIT, DCA SACLEN /STORECLA JMP SACNUL /JUST OUTPUT ZERO IF NULL STRING TAD I SACXR /GET A BYTE DCA I XR1 /MOVE CHAR TO BUFFER ISZ SACLEN JMP .-3 /ITERATE SACNUL, DCA I XR1 /STORE THE TERMINATING NULL CDF JMP I SACTOA /DONE PAGE RELOC *OVERLAY VERSON&77^100+SUBVEF+60 /LINE NUMBER TRACE FEATURE /PRINT MESSAGE OF FORM %NNNNN% ON CONSOLE WHEN /NEW LINE ENCOUNTERED TPRINT, TAD (45 /PRINT LEADING % JMS I PPCH JMS PRTLNO /NOW PRINT BCD LINE NUMBER TAD O40 JMS I PPCH /PRINT A TRAILING SPACE TAD (45 /PRINT A TRAILING % JMS I PPCH JMS I (PCRLF /NOW A CR,LF JMP I PILOOP /--RETURN-- /PRINT 5 DIGIT BCD LINE NUMBER, SUPPRESSING LEADING ZEROES PRTLNO, 0 TAD O40 /FIRST PRINT LEADING SPACE JMS I PPCH TAD (SNA /INIT LZ SWITCH DCA MAKSWT TAD LINEHI /HANDLE DIGIT 1 RTR RTR JMS MAKED TAD LINEHI /DIGIT 2 JMS MAKED TAD LINELO /DIGIT 3 RTL RTL RAL JMS MAKED TAD LINELO /DIGIT 4 RTR RTR JMS MAKED TAD LINELO /ALWAYS PRINT LAST DIGIT AND O17 TAD (60 JMS I PPCH JMP I PRTLNO /DONE /ROUTINE TO UNPACK BCD DIGITS MAKED, 0 AND O17 /ISOLATE DIGIT MAKSWT, HLT /SKP/SNA SWITCH JMP I MAKED /RETURN IF SUPPRESSED TAD (60 /MAKE 7BIT JMS I PPCH /PRINT IT TAD (SKP /NOW RESET SWITCH DCA MAKSWT JMP I MAKED /DONE /ERROR MESSAGE PRINTER ERRORR, 0 CLL CLA TAD (INBUF /PURGE ANY CHARACTERS IN INPUT BUFFER CDF 10 DCA I PINPTR DCA I (INBUF CDF 0 TAD (ETAB-1 /GET BEGINNING OF ERROR TABLE DCA EPTR DCA ERRNUM /ERROR # COUNTER ESRCALL) DCA STRCNT CDF 10 STRLP, TAD I XR1 DCA I SACXR ISZ STRCNT JMP STRLP / CDF JMP I (SSMODE /DONE, SET TO SMODE SACTOA, 0 TAD (ABUF-1 /SET POINTER TO STRING BUFFER IN FIELD 1 DCA XR1 /AC CONTAINS OFFSET IF CALL TO STORE IN B BUFFER TAD PSACM1 /INIT SACXR INCASE IF PRINT USING CALL DCA SACXR /(NORMAL STRING CALLS INIT IT FOR US) CDF 10 TAD SACLEN SNA Z ERRFLG JMP I (SUCJMP /AND GO TO IT NOTNOR, CLL CLA CMA SKP ERNORM, CLL CLA DCA ERNTST JMS I (PCRLF JMS I (SCRIBE MSGERR /PRINT "ERROR " JMS I (ERNMBR /PRINT ERR # JMS I (SCRIBE ATLINE /PRINT " AT LINE " JMS PRTLNO /PRINT LINE # JMS I (PCRLF ISZ ERNTST SKP JMP FSTOPN TAD (EFATAL-ETAB CIA TAD ERRNUM /WAS IT FATAL SMA SZA CLA JMP FSTOPN JMP I ERRORR FSTOPN, CLL CLA TAD (140 /FAKE A CALL TO INTERPRETER EXIT FUNCTION DCA INSAV JMP I (FUNC5I EPTR, 0 PINPTR, INPTR ERNTST, 0 PAGE /ERROR MESSAGE MAPPING TABLE /CONTAINS RELATIVE CORE ADDR OF TEXT, FOLLOWED BY -CALLING ADDR /TERMINATED BY ZERO TO FORCE UNKNOWN ERROR MESSAGE IF NO MATCH /ERRORS PRECEEDING TAG "EFATAL" ARE WARNINGS ONLY ETAB, -BR-1 /Bad record number in random access file -DI-1 /Illegal character in numeric string -DM-1 /Illegal minus sign -DP-1 /More than one decimal point encountered -DV-1 /Division by zero -DVS-1 /Divide by zero in string arithmetic -EN-1 /Lookup or enter error in OPEN, STORE, OR RECALL -IF-1 /Illegal DEV:FILENAME specification in FILE command -IN-1 /IH, ISZ ERRNUM /UPDATE ERR NUMBER ISZ EPTR /POINTER TO NEXT ERROR ADDRESS TAD I EPTR /GET -ERROR ADDR FROM TABLE SNA /IF 0 WE GOT A PROBLEM IT IS THE END JMP FSTOPN /EXIT BRTS TAD I PERROR /GET ERROR ADDRESS SZA CLA /SKIP ON A MATCH JMP ESRCH /NO MATCH TRY AGAIN TAD LINELO DCA ERLINL TAD LINEHI DCA ERLINH TAD (ECRASH-ETAB /IS ERROR FATAL CIA TAD ERRNUM /GET ERROR NUMBER SMA SZA CLA JMP NOTNOR /YES, GOTO ERNORM TO PRINT ERR # AC4000 / Is on error active AND ERRFLG SNA CLA JMP ERNORM /NO, GOTO TO NORMAL ERROR ROUTINE CLL CLA IAC AND ERRFLG /YES, BUT IS THIS A SECOND ERROR SZA CLA JMP NOTNOR /YES TAD ERRCOD /NO, SET UP GOTO ADDRESS DCA I (NEWPC /FOR ON ERROR GOTO TAD ERRFLD DCA INSAV ISAIN statement -CI-1 /Inquire failure in CHAIN -CL-1 /Lookup failure in CHAIN -CN-1 /Attempt to CHAIN to a .SV file not on SYS: -DA-1 /Attempt to READ past end of DATA list -DE-1 /Device driver error -DF-1 /No more room for record defines -DO-1 /No more room for drivers -EM-1 /Attempt to raise negative number to a real power -FB-1 /Attempt to create a second file -FC-1 /Loosing tentative file -FE-1 /Fetch error in open -FI-1 /Attempt to use unopened file -FM-1 /Attempt to FIX a negative number -FN-1 /Illegal file number -FO-1 /Attempt to fix a number > 4095 -FO2-1 /Attempt to FIX a number > 2**23-1 -GR-1 /EXIT or RETURN executed with out GOSUB -GS-1 /GOSUB stack overflow -H1-1 /Failure in USR call in STORE, RECALL, CALL -H2-1 /Error in STORE while creating tempory file -H3-1 /Lookup error in RECALL or CALL -H5-1 /Can't STORE tempory file error in close -H6-1 /Bad DEV:FILE.EX format in STORE, RECALL, or CALL -H7-1 /Attempt to create a second tentative file in STORE -H8-1 /File overflow in STORE exceeded free space -HN-1 /Input error in disk read on RECALL -Inquire failure in FILE command -IS-1 /Imaginary square root -O0-1 /Numeric or input overflow -ON-1 /ON statement out of range -OVS-1 /String arithmetic overflow error -RE-1 /Attempt to read past EOF -SH-1 /String truncated during record write -ST-1 /String truncated on input -ST1-1 /String truncated during record read -TR-1 /Trap character found -WE-1 /Attempt to write past EOF -1 /EFFECTIVE NOP FOR EXPANSION -1 /EFFECTIVE NOP FOR EXPANSION -1 /EFFECTIVE NOP FOR EXPANSION -1 /EFFECTIVE NOP FOR EXPANSION -1 /EFFECTIVE NOP FOR EXPANSION EFATAL, -BC-1 /CHAIN attempted with BCOMP.SV or BLOAD.SV missing -BF-1 /Error in DEFINE statement -BO-1 /No more file buffers available -CF-1 /Bad DEV:FILE.EX format in CH-1000 -100 -10 0 JMP I ERRDEC OCTAL ERROUT, 0 DCA ERNUMB /SAVE IT EROUT1, DCA ERDGT /CLEAR DIGIT COUNTER CLL CLA TAD ERNUMB /GET CURRENT VALUE TAD I ERROUT /MINUS DIGIT BEING PRINTED SNL /DID IT OVERFLOW JMP EROUT2 /NO, TO FAR ISZ ERDGT /YES BUMP DIGIT DCA ERNUMB /AND UPDATE VALUE JMP EROUT1+1 EROUT2, CLL CLA TAD ERDGT /OUTPUT THE DIGIT TAD K60 JMS I PPCH ISZ ERROUT /GET NEXT ARGUMENT TAD I ERROUT /DONE ENOUGH SZA CLA JMP EROUT1 /NOPE MORE TO DO TAD ERNUMB /ALL DONE OUTPUT LAST DIGIT TAD K60 JMS I PPCH JMP I ERROUT ERNUMB, 0 ERDGT, 0 /PRINT CR,LF PCRLF, 0 TAD O15 /CR JMS I PPCH TAD (12 /LF JMS I PPCH DCA I (TTYF+IOTPOS-IOTHDR /ZERO THE CONSOLE COLUMN COUNT NOW JMP I PCRLF /RETURA-1 /Illegal argument in user function -LM-1 /Illegal argument in LOG function -NC-1 /Bad command length or CCL.SV missing -OE-1 /Device driver error while overlaying -PA-1 /Illegal arg in POS -SC-1 /SAC overflow on concatenate -SL-1 /String to long or undefined -SR-1 /Attempt to read string from numeric file -SU-1 /Subscript error -SW-1 /Attempt to write string into numeric file -SZ-1 /Illegal record size -VR-1 /Attempt to read variable length file -1 /EFFECTIVE NOP FOR EXPANSION -1 /EFFECTIVE NOP FOR EXPANSION -1 /EFFECTIVE NOP FOR EXPANSION -1 /EFFECTIVE NOP FOR EXPANSION -1 /EFFECTIVE NOP FOR EXPANSION -1 /EFFECTIVE NOP FOR EXPANSION -CALL4-1 /Error loading user overlay -3401-1 /Error in user overlay ECRASH, -CC-1 /Execution aborted a CTRL C found -RS-1 /RESUME executed without error condition 0 PAGE SCRIBE, 0 TAD I SCRIBE DCA MSGPTR ISZ SCRIBE SNXTCH, TAD I MSGPTR SNA JMP I SCRIBE JMS I PPCH ISZ MSGPTR JMP SNXTCH MSGPTR, 0 ERNMBR, 0 /2 DIGIT DECIMAL PRINT TAD ERRNUM JMS ERRDEC JMP I ERNMBR DECIMAL ERRDEC, 0 JMS ERROUT TAD AC0 /GET FIRST FRACTION DIGIT AND (177 DCA AC0 TAD AC0 CLL RTR TAD AC0 CLL RTR CLL RTR AND O17 SNA /SKP IF NONZERO FRACTION JMP NOFRAC DCA AC0 TAD (56 /PRINT . JMS I (PCH TAD AC0 JMS PUTDG NOFRAC, JMS I (SCRIBE /PRINT "K FREE SPACE" SPCLFT JMS I (PCRLF JMP I PILOOP /RETURN TO INTERPRETER PUTDG, 0 TAD (60 JMS I (PCH JMP I PUTDG VERMSG, "B;"R;"T;"S;" ;"V;"e;"r;"s;"i;"o;"n;" ;VERSON;SUBVER+60;0 SPCLFT, "K;" ;"F;"r;"e;"e;" ;"S;"p;"a;"c;"e;0 PAGE RELOC FIELD 3 /LOAD FILES HERE ////////////////////////////////////////////////// ////////////////////////////////////////////////// ///////// OVERLAY 3-FILE MANIPULATING //////////// ///////// FUNCTIONS //////////// ///////////////////////////N MSGERR, "E;"R;"R;"O;"R;" ;0 ATLINE, " ;"A;"T;" ;"L;"I;"N;"E;0 PAGE /ROUTINE TO PRINT VERSION AND FREE SPACE MESSAGES FREESP, 0 JMS I PPSWAP /SWAP OUT OS/8 CDF 10 /PICK UP CD SWITCHES TAD I (CDOPT4 /GET CD OPTION BITS [MNO PQR STU VWX] CDF DCA ACH /SAVE THEM JMS I PPSWAP /KICK OUT OS/8 TAD ACH /SEE IF /V SET AND (4 SNA CLA /SKP IF YES JMP NOVER JMS I (SCRIBE /PRINT IT VERMSG JMS I (PCRLF /FOLLOWED BY CRLF NOVER, TAD ACH /SEE IF /S SET AND (40 SNA CLA /SKP IF YES JMP I PILOOP /RETURN TO INTERPRETER IF NO TAD CDFPS /GET FIELD BITS OF CODE CLL RTR RTR AND (3 DCA AC0 TAD PSSTRT /COMBINE WITH ADDR AND (7774 TAD AC0 RTR RAR /SHIFT FIELD BITS TO AC0-2 XX= BUFAREA%10 TAD (-XX-1000 /SUBTRACT SPACE TAKEN BY BRTS THRU FIELD 1 DCA AC0 /SAVE IT TAD AC0 CLL RTL /GET INTEGER BITS FOR HOW MANY K RTL RTL AND (37 /MASK THEM DCA AC1 /SAVE THEM DCA AC2 DLP1, TAD AC1 /CONVERT TO DECIMAL TAD (-12 SPA JMP GOTQUO DCA AC1 ISZ AC2 JMP DLP1 GOTQUO, CLA TAD AC2 /GET TENS DIGIT SZA /SKP IF ZERO JMS PUTDG /OR PUT IT OUT TAD AC1 /DO UNITS JMS PUTDG SACXR TAD I MOVCMD /GET TARGET PTR ISZ MOVCMD DCA XR1 TAD SACLEN /SET COUNTER DCA AC0 CDF 10 /DATA IN FIELD 1 CCLMOV, TAD I SACXR /GET A BYTE AND IOMASK /MASK TAD O200 /SET PARITY BIT DCA I XR1 /STORE IT ISZ AC0 JMP CCLMOV DCA I XR1 /STORE TERMINATING NULL CDF JMP I MOVCMD CCLNAM, FILENAME CCL.SV PAGE /FILE CLOSING ROUTINE CLOSE, TAD I IOT/////////////////////// ////////////////////////////////////////////////// *OVERLAY VERSON&77^100+SUBVFF+60 /VERSION WORD FOR FILES OVERLAY OVDISP, JMS I (FBITGT /GET FUNCTION TYPE TAD JMPFF /BUILD JMP INLINE DCA .+1 HLT JMPFF, JMP I .+1 /CALL FOR FILE MANIPULATING FUNCTIONS /JUMP TABLE FOR FILE FUNCTIONS CHAIN /FUNCTION BITS= 000 CLOSE / 020 OPENAF / 040 OPENAV / 060 OPENNF / 100 OPENNV / 120 FSTOP /INT. EXIT 140 CCL / 160 /CCL(C$) FUNCTION - PASS COMMAND STRING TO CCL CCL, TAD SACLEN /TEST COMMAND STRING LENGTH SZA TAD (CCLMAX SPA SNA CLA /SKP IF IN RANGE (ALLOWING TERMINATING NULL) JMP NC /ERROR JMS I PPSWAP /GET OS/8 JMS MOVCMD /SHUFFLE COMMAND TO SAFE PLACE IN FIELD 1 SAC-1 /FROM SAC BUFAREA-1 /TO BUFFER AREA ABOVE USR CIF 10 JMS I O7700 /LOCK USR IN 10 CLA IAC /LOOK UP "SYS:CCL.SV" CIF 10 JMS I O200 2 /LOOKUP CCLBLK, CCLNAM 0 NC, JMS I PERROR /FATAL ERROR IF NO FIND JMS I (PSWAP2 /DO THE ONCE ONLY EXIT CODE NOW /(THE CCL COMMAND WILL WIPE THE SAVED BATCH STATE) TAD I (JSW /KEEP ONLY THE BATCH SAVED STATE AND (400 TAD (2001 /SET JSW FOR USR IN CORE DCA I (JSW TAD CCLBLK /COPY BLOCK NUMBER INLINE DCA CHNBLK JMS MOVCMD /NOW MOVE THE COMMAND TO CD AREA BUFAREA-1 /FROM HERE 7577 /TO HERE CIF 10 /DO A RESET TO DELETE ANY TENTATIVE FILES JMS I O200 13 /RESET CIF 10 /NOW DO THE CHAIN JMS I O200 6 /CHAIN CHNBLK, 0 MOVCMD, 0 TAD I MOVCMD /GET SOURCE PTR ISZ MOVCMD DCAS ONE? JMP PSTCHK /YES-DON'T CHECK DRIVER TAD I AC0 /GET HANDLER ENTRY POINT FOR THIS FILE AND (7600 /ISOLATE PAGE BITS CIA /NEGATE TAD I IOTHND /COMPARE TO PAGE OF CURRENT FILE'S HANDLER AND (7600 SNA CLA /SAME DEVICE? JMP CRETN /YES-LEAVE DRIVER IN CORE PSTCHK, TAD AC0 /BUMP HANDLER EP PTR BACK TAD (-IOTSIZ DCA AC0 ISZ AC2 /ALL 4 CHECKED? JMP CHECKL /NOHND /SEE IF FILE IS IDLE SZA CLA /SKP IF YES, CLOSE IS A NOP TAD ENTNO /GET FILE # SNA CLA /IS IT TTY? JMP I PILOOP /YES-DON'T DO ANYTHING TAD I IOTRSZ /NO ^Z IF RANDOM ACCESS FILE (ALREADY HANDLED) SNA CLA JMS I PFTYPE /IS FILE NUMERIC? JMP NOCZ /YES-DON'T OUTPUT ^Z JMS I (FOTYPE /NO-IS FILE VARIABLE LENGTH? JMP NOCZ /NO-DON'T OUTPUT ^Z TAD (32 /YES JMS I PPUTCH /WRITE A ^Z IN FILE NOCZ, JMS I (WRBLK /WRITE LAST BLOCK IF IT HAS CHANGED JMS I (RTNDEF /RETURN ANY CURRENT RECORD DESCRIPTORS TO FREELIST NOW JMS I PPSWAP /RESTORE 17600 JMS I (FOTYPE /IS FILE FIXED LENGTH? JMP CLOSED /YES-NO NEED TO CLOSE THE FILE TAD I IOTLEN /NO-GET FILE LENGTH DCA CLENG /PUT IN CLOSE CALL TAD IOTFIL DCA FNAP /POINTER TO FILE NAME TAD I IOTHDR CLL RTL RTL RAL /GET DEVICE NUMBER INTO BITS 8-11 AND O17 /ISOLATE IT CIF 10 JMS I O7700 /CALL USR 4 /CLOSE FNAP, 0 /POINTER TO FILE NAME CLENG, 0 FC, JMS I PERROR /FILE CLOSING ERROR /FALL INTO BUFFER/HANDLER RELEASE ROUTINE CLOSED, STA /RETURN THIS BUFFER TO THE POOL TAD BUFSTK DCA BUFSTK TAD I IOTBUF DCA I BUFSTK /RELEASE HANDLER (MESSY) TAD I IOTHND /SEE IF CORESIDENT WITH SYS: TAD O200 SMA CLA JMP CRETN /JMP IF YES TAD (-MAXFIL /SEE IF ANY OTHER FILES USING DEVICE CORESIDENT DCA AC2 /WITH THIS FILE TAD (MAXFIL^IOTSIZ+TTYF+IOTHND-IOTHDR DCA AC0 /POINT AT HANDLER ENTRY FOR LAST FILE CHECKL, TAD AC2 /-# OF FILE WERE CHECKING TAD ENTNO /COMPARE TO CURRENT NUMBER SNA CLA /IS IT THI-CHECK THE NEXT 1 TAD I IOTHND /RETURN THE HANDLER TO THE POOL NOW TAD (-HAREA /GET PAGE OFFSET TO AC10,11 RTL RTL RTL AND (7 CMA DCA AC0 /SET SHIFT COUNT TAD I IOTHDR /SEE IF 2 PAGES BEING FREED AND O10 SNA CLA /SKP IF YES TAD (40 /ELSE JUST DO ONE BIT TAD (7637 STL RAR /SHIFT MASK DOWN ISZ AC0 JMP .-2 AND DMAP /NOW CLEAR THE BIT(S) DCA DMAP TAD (RESTBL /MARK ALL ENTRY POINTS GONZO DCA AC0 TAD I IOTHND /SAVE PAGE BITS OF HANDLER AND (7600 DCA AC2 TAD (-17 /DO 15. ENTRY POINTS DCA TEMP2 CDF 10 FREHND, TAD I AC0 /NOW MARK ENTRIES NONRESIDENT AND (7600 CIA TAD AC2 SNA CLA /SKP IF NOT CORESIDENT DCA I AC0 /ELSE CLEAR IT ISZ AC0 ISZ TEMP2 JMP FREHND CDF CRETN, DCA I IOTHND /MAKE THE FILE IDLE NOW DCA I IOTHDR /CLEAR DEVICE BITS TOO JMS I PPSWAP /REMOVE OS/8 JMP I PILOOP /RETURN TO ILOOP PAGE /CHAIN FUNCTION /INVOKES USR CHAIN OPERATION IF FILE EXTENSION IS .SV /OTHERWISE SETS UP CD AREA AND CHAINS TO BCOMP CHAIN, JMS I PPSWAP /RESTORE PG 17600 JMS I DNA2 /GET FILE NAME IN NAME AREA FROM CURRENT FILE 0201 /DEFAULT EXTENSION .BA CF, JMS I PERROR /ERROR IF ILLEGAL FILE NAME CIF 10 JMS I O7700 /CALL USR 10 /LOCK IN CORE TAD I IOTDEV DCA DNA1 /FIRST TWO CHARS OF DEV NAME TAD I IOTDEV+1 /LAST TWO CHARS DCA DNA2 CIF 10 JMS I O200 12 /INQUIRE DNA1, 0 DNA2, NAMEG CDIN, 0 CI, JMS I PERROR /ERROR TAD CDIN /GET ENTRY POINT OF DRIVER FOR CHAIN FILE SZA CLA /IS IT IN CORE? JMP DISIN /YES-NO NEED TO FETCH IT TAD DNA2 /NO-DEVICE # INTO AC CIF 10 JMS I O200 1 /FETCH HANDLER 7001 /INTO PAGE 7000 JMP CI /MAKE IT LOOK LIKE INQUIRE ERROR DISIN, TAD IOTFIL DCA STB /POINTER TO FILE NAME TAD DNA2 /GET DEVICE # CIF 10 JMS I O200 2 /LOOKUP STB, 0 /POINTER TO FILE NAME FLN, 0 CL, JMS I PERROR /LOOKUP ERROR TAD IOTFIL /POINT AT FILENAME EXTENSION TAD (3 DCA TEMP2 TAD I TEMP2 /SEE IF .SV EXTENSION TAD (-2326 SNA CLA JMP CICHAIN /JMP IF YES, DO USR CHAIN CDF 10 /ELSE TEST IF BCOMP AND BLOAD ARE BOTH ACCOUNTED FOR TAD I (INFO+2 /LOOK AT BLOAD BLOCK SZA CLA /FORCE ERROR IF NOT THERE TAD I (INFO+1 /LOOK AT BCOMP BLOCK SNA BC, JMS I PERROR /TAKE ERROR EXIT IF NOT BOTH THERE DCA CBLK /ALL SET, STORE BCOMP BLOCK INLINE TAD STB /GET STARTING BLOCK DCA I (INFO+14 /STARTING BLOCK IN CD AREA TAD FLN /FILE LENGTH CLL RTL RTL AND (7760 /PUT IN BITS 0-7 TAD DNA2 /COMBINE WITH DEVICE # DCA I (INFO+13 /PUT IN CD AREA TAD (40 /SET /G SWITCH FOR BLOAD TO RUN PROGRAM AFTER COMPILE DCA I (CDOPT3 /IN CD SWITHCES [ABC DEF GHI JKL] TAD CDFIO /PASS SIZE OF SYSTEM THROUGH THE = OPTION TO BCOMP CLL RTR RAR AND (7 DCA I (CDOPT6 /THIS PRESERVES BATCH IF POSSIBLE CDF JMS I (PSWAP2 /NOW EXEC DESTRUCTIVE EXIT CODE JMS I (7607 /READ FROM SYS: BCSIZ1+10 /4 BLOCKS TO FIELD 1 BCLOD1 /TO HERE CBLK, 0 /FROM HERE HLT /CRASH SYSTEM IF SYS FAILED CIF CDF 10 /NOW JMP INTO FIELD 1 JMP I (CCHAIN CICHAIN,STA /TEST IF OUR .SV FILE IS ON SYS: TAD DNA2 SZA CLA /SKP IF OK CN, JMS I PERROR /ERROR ABORT: CAN'T CHAIN OUTSIDE SYS: JMS I (PSWAP2 /NOW EXEC ONCE ONLY CLEAN UP ROUTINE TAD (MAGIC /SET MAGIC NUMBER INTO CD = OPTION TO BYPASS CDF 10 /INITIALIZATION LOOKUPS DCA I (7642 /FOR CHAINS TO PRE COMPILED PROGRAMS CDF TAD STB /COPY STARTING BLOCK INLINE DCA CHNSTB CIF 10 /NOW DO A RESET AND DELETE TENTATIVE FILES JMS I O200 13 /RESET CIF 10 /FLAG TENTATIVE FILE CLEANUP JMS I O200 6 /NOW DO THE CHAIN EXIT CHNSTB, HLT /FINAL ENTER/LOOKUP PROCESSING CLEANP, DCA I IOTPOS /ZERO COLUMN POINTER CMA /-1 TAD I IOTLOC /STARTING BLOCK-1 DCA I IOTBLK /CURRENT BLOCK #=STARTING BLOCK-1 TAD I IOTBUF DCA I IOTPTR /READ/WRITE POINTER AT BEGINNING OF BUFFER CIF 10 JMS I O20AVE NEW HEADER WORD TAD ENTNO /IS FILE TTY? SNA CLA JMP I PILOOP /YES-DON'T DO ANYTHING TAD AC0 /IF NOT CONSOLE, SET HEADER WORD DCA I IOTHDR DCA I IOTRSZ /ASSUME NON RANDOM ACCESS FILE TAD I IOTHND /GET HANDLER ENTRY SZA CLA /IS FILE IDLE? FB, JMS I PERROR /ATTEMPT TO OPEN FILE ALREADY OPEN JMS I PPSWAP /RESTORE 17600 JMS I (NAMEG /GET FILE DEVICE NAME AND FILE NAME INTO WORDS 7-14 FROM SAC 0401 /DEFAULT EXTENSION IS .DA JMP IF /GIVE ERROR IF BAD FORMAT NAME CIF 10 JMS I O7700 /CALL TO USR 10 /LOCK USR IN CORE TAD I IOTDEV DCA DEVNA1 /DEVICE NAME INTO INQUIRE CALL TAD I IOTDEV+1 DCA DEVNA2 CIF 10 JMS I O200 /CALL TO USR 12 /INQUIRE DEVNA1, 0 /DEVICE NAME DEVNA2, 0 ENTRYN, 0 /ENTRY POINT JMP INERR /INQUIRE ERROR, GO RECOVER AND WARN USER TAD DEVNA2 /GET DEVICE # CLL RAR RTR /PUT INTO BITS 0-3 RTR TAD I IOTHDR DCA I IOTHDR /STORE IN HEADER WORD CDF 10 /GET INTO USR FIELD STA TAD DEVNA2 TAD I (USRDHT /INDEX INTO USR DEVICE HANDLER TABLE DCA AC0 TAD I AC0 /LOOK AT OUR DEVICE CDF CLL RAL SZL CLA TAD (20 /LOOK FOR 2 CONSECUTIVE PAGES IF BIG HANDLER TAD (40 DCA AC0 /SET INITIAL PAGE MASK IN CASE WE LOOK FOR SPACE SZL /STORE 2 PAGE BIT IN HEADER FOR SUBSEQUENT TAD O10 /RELEASE OF HANDLER PAGES TAD I IOTHDR DCA I IOTHDR TAD ENTRYN /GET DRIVER ADDRESS SZA /IS IT IN CORE? JMP DRIVRN /YES, NO NEED TO FETCH IT RAL /GET 2 PAGE ALLOWANCE BIT TO AC11 TAD (HAREA /POINT AT HANDLER AREA HSRCH, DCA FETPAG /SEARCH FOR0 /CALL TO USR 11 /USROUT JMS I PPSWAP /GET RID OF 17600 JMS I (BLZERO JMS I (NEXREC /DO A NEXREC TO READ IN FIRST FILE BLOCK JMP I PILOOP /DONE, LET'S GET THE HELL OUT OF HERE PAGE /FILE OPENING ROUTINE OPENAV, TAD (4 /ALPHANUMERIC,VARIABLE LENGTH OPENAF, IAC /ALPHANUMERIC,FIXED LENGTH JMP OPENNF OPENNV, TAD (4 /NUMERIC,VARIABLE LENGTH OPENNF, DCA AC0 /S BY NUMBER CIF 10 JMS I O200 /CALL TO USR 1 /FETCH FETPAG, 0 /DRIVER ADDRESS FE, JMS I PERROR /FETCH ERROR TAD FETPAG /NOW STORE THE HANDLER IN IOTABLE DRIVRN, DCA I IOTHND TAD I BUFSTK /SEE IF ANY FREE BUFFERS SNA BO, JMS I PERROR /TAKE ERROR EXIT IF NONE DCA I IOTBUF /ELSE STORE IT IN IOTAB ISZ BUFSTK /BUMP FREELIST PTR UP TAD I IOTHDR /GET HEADER WORD AND (4 /TEST VARIABLE LENGTH BIT SNA CLA /SKP IF NEW FILE BEING CREATED JMP FLOOK /DO A LOOKUP IF FIXED TAD (3 JMS I (ENTLOK /ENTER DCA I IOTMAX /MAXIMUM LENGTH IN WORD 7 DCA I IOTLEN /ZERO ACTUAL LENGTH JMP I (CLEANP /FINALIZE I/O TABLE ENTRY FLOOK, AC0002 JMS I (ENTLOK /LOOKUP DCA I IOTLEN /ACTUAL LENGTH TAD I IOTLEN DCA I IOTMAX /ALSO EQUALS MAXIMUM LENGTH JMP I (CLEANP /FINISH OFF INERR, CIF 10 JMS I O200 /DO A USROUT FIRST 11 IN, JMS I PERROR /GIVE ERROR WARNING SKP /SKP TO CLEAR THIS CHANNEL AND EXIT IF, JMS I PERROR /GIVE ERROR WARNING DCA I IOTHDR /CLEAR HEADER DCA I IOTHND /CLEAR HANDLER ENTRY JMP I PILOOP /EXIT PAGE /ROUTINE TO ENTER OR LOOKUP FILE /ENTRY AC = ENTER OR LOOKUP FUNCTION NUMBER /IF NON FILE STRUCTURED OUTPUT DEVICE, SETS UP FOR BLOCK ZERO /INITIALIZATION ON FIRST OUTPUT CALL /IF NON FILE STRUCTURED INPUT DEVICE, SETS UP FOR BLOCK ZERO /INITIALIZATION DURING FINAL OPEN PROCESSING INSTEAD ENTLOK, 0 DCA FNOM /FUNCTION NUMBER IN PLACE TAD IOTFIL /POINTER TO FILE NAME DCA STARTB /INTO CALL TAD I (DEVNA2 /DEVICE NUMBER CIF 10 JMS I O200 /CAL A SLOT TAD AC0 AND DMAP /BITS OFF INDICATE AVIALABLE CORE SNA CLA JMP GOTPAG /JMP IF GOT IT TAD AC0 /ELSE MOVE WINDOW UP CLL RAR DCA AC0 SZL /SKP IF NOT PAST END OF FREE AREA DO, JMS I PERROR /ELSE TAKE ERROR EXIT TAD FETPAG TAD O200 JMP HSRCH /TRY AGAIN GOTPAG, TAD AC0 /BUSY OUT THE PAGES WE'RE USING TAD DMAP DCA DMAP TAD DEVNA2 /FETCH THE HANDLERROR /GIVE ENTER/LOOKUP ERROR WARNING JMS I PPSWAP /BRING OS/8 RESIDENT IN FOR HANDLER RELEASE JMP I (CLOSED /GO FINISH OFF /SUBROUTINE PSWAP2-RESTORE OS/8 RESIDENT MONITOR PRIOR TO EXIT FROM INTERPRETERTER /THIS IS DESTRUCTIVE CODE, AND ONCE THIS ROUTINE HAS BEEN EXECUTED /THERE IS NO PLACE TO GO BUT OUT. /HAS 3 FUNCTIONS: / 1) REMOVES CTRL/C HOOKS FROM SYS DRIVER / 2) RESTORES BATCH CONTROL WORDS TO N7774-N7777 / 3) IF SYS IS 2 PAGE HANDLER, RESTORES PAGE 27600 AND FIXES CDF'S IN 07600 PSWAP2, 0 TAD (4207 DCA I BOSPT1 /REMOVE CTRL/C HOOKS TAD (6213 DCA I (7605 TAD BOSPT1 DCA I (HICORE /FUDGE POINTER IN SWAP ROUTINE /IN CASE OF 2 PAGE SYSTEM HANDLER TAD PSFLAG /GET RESIDENT STATUS FLAG SMA CLA /SKP IF ROOM ALLOCATED FOR 2 PAGE HANDLER JMP NOT2PG /JMP IF NO DCA PSFLAG /CLEAR RESIDENT STATUS FLAG TAD (CDF 20 DCA I (P2CDF /PUT CDF 20 IN SWAP ROUTINE TAD (CDF 20 DCA I (P2CDF1 JMS I PPSWAP /MOVE DOWN PAGE 27600 AC7775 /TEST MAGIC LOCATION FOR A 3 TAD I (7612 SZA CLA JMP NOT2PG /DO NOTHING IF NOT 2 PAGE HANDLER TAD (7635 /ELSE SETUP MAGIC POINTER DCA AC0 HNL TO USR FNOM, 0 /ENTER OR LOOKUP STARTB, 0 FLEN, 0 JMP ENTERR /ENTER/LOOKUP ERROR, TAKE RECOVERY EXIT TAD STARTB /SEE IF EITHER BLOCK OR NEGATIVE LENGTH RETURNED SNA TAD FLEN /INDICATING FILE STRUCTURED DEVICE SZA CLA JMP FILSTU /JMP IF FILE STRUCTURED DEVICE TAD (20 /NO-FILE IS READ/WRITE ONLY TAD I IOTHDR DCA I IOTHDR /SET READ/WRITE ONLY BIT AC7776 /TEST IF ENTER OR LOOKUP TAD FNOM SNA CLA /SKP IF ENTER AND SET START BLOCK TO ZERO IAC /ELSE SET TO ONE FOR DEVICE INITIALIZATION FUDGE FILSTU, TAD STARTB /GET STARTING BLOCK # OF FILE DCA I IOTLOC /PUT IN I/O TABLE TAD FLEN /FILE LENGTH CIA /MAKE FILE LENGTH POSITIVE JMP I ENTLOK /RETURN ENTERR, CIF 10 /FIRST KICK OUT USR JMS I O200 11 /USROUT EN, JMS I PERBOSPT1, 7600 BOSPT2, 7774 /ROUTINE FOR INTERPRETER EXIT FSTOP, CLL CLA IAC AND PSFLAG / If os8 area is in don't swap it SNA CLA JMS I PPSWAP JMS PSWAP2 CDF 10 TAD I (EDBLK /GET BLOCK NUMBER FOR EDITOR CDF SNA /SKP IF EDITOR WAS RUN JMP I (7605 /RETURN TO KBM IF NO EDITOR JMP I (EDREAD /JMP TO HIGHER CORE TO DO READ (EDITOR OVERLAYS HERE) /PASSING BLOCK IN AC PAGE /ROUTINE TO PARSE A FILE NAME OF THE FORM "DEVN:FILENM.EX" /CALL+1 = DEFAULT EXTENSION, ASSUMES DEFAULT DEVICE DSK: /RETURN TO CALL+2 IF BAD FILE NAME SYNTAX /RETURN TO CALL+3 IF GOT GOOD NAME NAMEG, 0 TAD I NAMEG /GET DEFAULT EXT ISZ NAMEG DCA EXT /SAVE IN BUFFER STA /SET SOME SWITCHES DCA COLSWT STA DCA DOTSWT TAD PSACM1 /SET POINTER TO SAC NOW DCA SACXR TAD (0423 /NOW GET DEFAULT DEVICE - DSK: DCA DEV TAD (1300 GOTDEV, DCA DEV+1 NAMLUP, TAD (-4 /SET A WORD COUNT DCA XR1 TAD (NAME /POINT AT NAME BUFFER DCA TEMP2 DCA NAME /ZERO OUT THE NAME NOW DCA NAME+1 DCA NAME+2 GETNAM, JMS NGCH /GET A CHAR ISZ XR1 /TEST COUNT SKP JMP I NAMEG /ERROR RETURN IF PAST FIELD SIZE TAD AC0 /OK, GET CHDLP, TAD I AC0 /NOW RANGE CHECK CONTENTS OF THIS WORD TAD (-6300 CLL TAD (70 SNL CLA /SKP IF CIF CDF N0, N.NE.0 JMP NOPAT /ELSE TRY AGAIN TAD I AC0 /GET INSTRUCTION BACK AND (7707 TAD (20 /RESTORE FIELD 2 DCA I AC0 /PUT IT BACK NOPAT, ISZ AC0 /CONTINUE TO END OF PAGE JMP HNDLP NOT2PG, TAD I (JSW /SEE IF BATCH UNTOUCHED OR NOT AND (400 SNA CLA /SKP IF YES, NO NEED TO RESTORE PARAMETER WORDS TAD I (BIPCCL /SEE IF BATCH RUNNING RAL SMA CLA JMP I PSWAP2 /RETURN NOW IF NO TAD I (BIPCCL AND (70 /ISOLATE FIELD BITS TAD CDFO DCA .+3 /CDF TO HI CORE CDF 10 TAD I BOSPT1 /GET BATCH WORD HLT DCA I BOSPT2 /BACK INTO LOFTY STATE ISZ BOSPT1 ISZ BOSPT2 JMP .-6 CDFO, CDF JMP I PSWAP2 /WE ARE FINISHED, SO RETURN OP CDF 10 TAD I SACXR /GET A CHAR CDF DCA AC0 /SAVE IT TAD AC0 TAD (-56 /CHECK IF . SNA CLA JMP GOTDOT /JMP IF YES CLL /NOW CHECK IF ALPHANUMERIC TAD AC0 TAD (-60 SMA TAD (60-72 SNA JMP GOTCOL /JMP IF HAPPENS TO BE : SMA TAD (72-101 SMA TAD (101-133 SNL CLA /SKP IF A-Z OR 0-9 JMP I NAMEG /ELSE WORNG CHAR JMP I NGCH COLSWT, 0 DOTSWT, 0 DEV, ZBLOCK 2 NAME, ZBLOCK 3 EXT, 0 PAGE ////////////////////////////////////////// ////////////////////////////////////////// ////////// EXTENDED BASIC //////// ////////// BASIC.EX //////// ////////////////////////////////////////// ////////////////////////////////////////// USR=7700 PR0=6206 PR1=6216 PR3=6236 RELOC FIELD 3 *2AR AND O77 /6 BITS CLL RTL RTL RTL /SHIFT LEFT DCA I TEMP2 /PUT IN BUFFER JMS NGCH /GET ANOTHER CHAR TAD AC0 AND O77 /6 BITS TAD I TEMP2 /ADD TO PREV ONE DCA I TEMP2 ISZ TEMP2 /UP TO NEXT WORD JMP GETNAM /DO NEXT WORD GOTCOL, ISZ COLSWT /SEE IF : SEEN YET JMP I NAMEG /YES, A BADDY TAD NAME+2 /SEE IF DEV GT 4 CHARS SNA CLA TAD NAME /ANY DEV THERE SNA JMP I NAMEG /NO, NO GOOD DCA DEV /OK, STORE IT TAD NAME+1 /AND THE NEXT WORD TOO JMP GOTDEV /GET FILE NOW GOTDOT, ISZ DOTSWT /SEE IF . SEEN YET JMP I NAMEG /YES, ERROR ISZ COLSWT /DISALLOW FURTHER : TOO NOP TAD (EXT /POINT AT EXTENSION FIELD NOW DCA TEMP2 DCA EXT /ZERO OUT THE DEFAULT EXTENSION AC7776 /ALLOW ONLY ONE WORD DCA XR1 JMP GETNAM /GET THE EXTENSION ALREADY EONAM, STA TAD IOTDEV /ALL SET, MOVE THE NAME INTO CURRENT IOTABLE DCA XR1 TAD (DEV-1 DCA XR2 TAD (-6 /6 WORDS DCA AC0 TAD I XR2 /GET A PAIR OF CHARS DCA I XR1 /AND STORE THEM ISZ AC0 JMP .-3 ISZ NAMEG /TAKE SUCCESSFUL RETURN JMP I NAMEG NGCH, 0 TAD SACLEN /SEE IF ANYTHING IN SAC SNA CLA JMP EONAM /END OF NAME IF NO ISZ SACLEN N JMS I (SACP JMP I ESCBRK EIL, JMS I (FIX23 /FIX THE NUMBER PASSED JMS I (ESCBRK /PRINT AN ESC [ TAD ACL /GET THE NUMBER AND (3 /CANT BE LARGER THAN 3 TAD K60 /TURN IT INTO AN ASCII CHARACTER JMS I (SACP /AND PRINT IT TAD (113 /PRINT A K JMS I (SACP JMP I (SETL /GOTO STANDARD EXIT ROUTINE SFM, JMS I (FIX23 /FIX THE NUMBER PASSED JMS I (ESCBRK /PRINT AND ESC [ TAD O77 /PRINT A ? JMS I (SACP TAD (63 /PRINT A 3 JMS I (SACP TAD ACL /GET NUMBER SENT RAR /PUT CHARACTER INTO LINK, CAN ONLY CLA /BE A 0 OR 1 SO THIS WORKS FINE SNL TAD K4 /PRINT A SMALL L FOR 80 COL TAD (150 /PRINT A SMALL H FOR 132 COL JMS I (SACP /PUT THE CHARACTER INTO SAC JMP I (SETL /AND GOTO STANDARD EXIT ROUTINE CONVRT, 000 RELOC OVERLAY VERSON&77^100+SUBVEX+60 OVDISP, TAD PSACM1 DCA SACXR JMS I (FBITGT /GET FUNCTION TYPE TAD JMPEX DCA .+1 HLT JMPEX, JMP I .+1 /CALL FOR GRAPHIC FUNCTION /JUMP TABLE FOR GRAPHICS FUNCTIONS EID /FUNCTION BITS = 000 LST / = 020 SCD / = 040 EIL / = 060 SGR / = 100 SFM / = 120 LCD / = 140 LGD / = 160 SLEEP / = 200 SCS / = 220 SSI / = 240 ERR / = 260 TRAP / = 300 ERL / = 320 KSTROK / = 340 TRAP, CLL CLA JMS I (FIXRGS TAD TEMP1 CIA DCA TRPCHR JMP I PILOOP EID, JMS I (FIX23 JMS I (ESCBRK /PRINT AN ESC BRACKET TAD ACL AND (3 TAD K60 /TURN IT INTO AN ASCII CHARACTER JMS I (SACP TAD (112 /PRINT A J TO FINISH OF COMMAND JMS I (SACP SETL, TAD SACXR /GET NUMBER OF CHARACTERS PRINTED CIA TAD PSACM1 /GET PRIVIOUS LENGTH DCA SACLEN /SAVE TOTAL SUM IN SAC LENGTH JMP I (SSMODE SACP, 0 /STORE DATA IN STRING AC CDF 10 DCA I SACXR CDF JMP I SACP LST, JMS I (ESCBRK TAD (151 /PRINT i FOR PRINT SCREEN JMS I (SACP JMP I (SETL ESCBRK, 0 TAD KESC /PRINT AN ESC JMS I (SACP TAD KBRACK /PRINT A BRACKET GO AGAIN TAD BOXW1 /YES, RESET WIDTH COUNTER DCA BOXW CMA TAD ROWTMP DCA ROWTMP ISZ BOXH /HAS HEIGHT OF BOX BEEN COMPLETED JMP SCD+1 /NO, GO AT IT AGAIN BOXLEV, CLL CLA /STANDARD EXIT FOR SETUP, SCD, LCD, LGD TAD BOXSAC /RESET SAC COUNTER GOT DAMMAGED IN VALID DCA SACXR JMS I (SACP /THROW A NULL INTO SAC TO MAKE IT HAPPY JMP I (SETL /AND LEAVE XPR0 /CONVERT A STRING TO A NUMBER STA /VALUE LEFT IN FAC TAD SACLEN DCA CON1 TAD (CONVT1 DCA I (IGETCH JMS I (FFIN TAD (GETCH DCA I (IGETCH JMS I (FIX23 JMP I CONVRT CONVT1, 0 ISZ CON1 JMP .+3 TAD O77 JMP CONVT2 CDF 10 TAD I SACXR CDF CONVT2, DCA CHAR JMP I CONVT1 CON1, 0 PAGE VALID, 0 /SETUP AND CHECK ROUTINE FOR SCD, LCD, LGD CLL CLA CMA /SUBTRACT 1 FROM CURROW TO GET CORRECT TAD CURROW /POSITION DCA ROWTMP CLL CLA CMA TAD CURCOL /DO THE SAMETHING HERE DCA COLTMP TAD PSACM1 /SAVE SAC COUNTER, CONVRT WILL DESTROY IT DCA BOXSAC JMS I (FIXRGS /FIX THE NUMBERS SO IT CAN BE USED TAD TEMP1 /IF BOXH = 0 THEN BAIL OUT SNA JMP BOXLEV CIA DCA BOXH /BOXH IS OK SO MAKE IT 2'S COMP AND SAVE IT TAD ACL /IF BOXW = 0 THEN BAIL OUT SNA JMP BOXLEV CIA DCA BOXW /BOXW IS OK SO MAKE IT 2'S COMP AND SAVE IT JMS I (CONVRT /CONVERT THE STRING INTO A NUMBER TAD ACL /GET THE CHARACTER AND IOMASK /MASK IT TO 7 BIT TAD SCSLOC /ADD BITS FOR CHARACTER SET AND ATTRIBUTES DCA SAVCHR /AND SAVE IT FOR LATER TAD BOXH /BACK UP COUNTERS DCA BOXH1 TAD BOXW DCA BOXW1 DCA XR5 /GIVE SCREEN TIME TO SETTLE ISZ XR5 JMP .-1 ISZ XR5 JMP .-1 JMP I VALID /RETURN TO CALLING ROUTINE SCD, JMS VALID /SETUP AND CHECK ALL DATA CLL CLA CMA TAD CURCOL /SETUP COLTMP FOR PRINT DCA COLTMP SCD1, JMS XPRNT /GO AND PRINT THE CHARACTER ISZ COLTMP /UPDATE COL POSITION ISZ BOXW /ARE WE DONE WITH THE WIDTH JMP SCD1 /NOter in escape sequence ISZ XR4 JMP .-1 JMP KEY2 PAGE SLEEP, CLL CLA JMS I (FIXRGS /NORMALIZE THE VALUE AND LEAVE IT IN TEMP1 TAD TEMP1 /GET THE VALUE FOR LENGTH OF SLEEP SNA /IS IT ZERO JMP I PILOOP /SURE IS GET OUT CMA /IT'S OK SET UP COUNTER DCA TEMP1 /SAVE IT WHERE WE FOUND IT SLEEP1, CLA /A MUST WHEN WE RETURN AGAIN TAD COUNT DCA COUNTNT, 0 /PANEL MEMORY PRINT ROUTINE VERY FAST CLL CLA TAD SAVCHR /GET THE CHARACTER W/ ATTRIBUTES DCA COLTMP+1 /AND PUT IT IN SCREEN CALLINT ROUTINE PR1 /CALL PANEL MEMORY ROWTMP, 0 /FURTHER EXPLAINATION CAN BE OBTAINED COLTMP, 0 /IN THE DECMATE HARDWARE MANUAL 0 7777 /TERMINATE PANEL MEMORY CALL CLL CLA JMP I XPRNT BOXH, 0 BOXH1, 0 BOXW, 0 BOXW1, 0 BOXSAC, 0 KSTROK, JMS I (FIXRGS TAD TEMP1 CIA SNA /IF COUNTER IS SET TO 0 DON'T USE TIMER JMP KEYGCH DCA TEMP1 /SAVE COUNTER DCA XR4 KEY1, TAD (7773 DCA XR5 ISZ XR4 /KILL .0155 SECONDS JMP .-1 ISZ XR5 / TIMES 10 BASE 8 = ABOUT 1/10TH OF A SECOND JMP .-3 KSF /IS K.B. FLAG SET JMP NOKEY /NO, CHECK WAIT LOOP FOR COUNTER TIME OUT JMS I (CLOOK /GET THE CHARACTER JMP KEYGCH NOKEY, ISZ TEMP1 /IS OUR COUNTER DONE JMP KEY1 /NO JMP I (SETL /YES, EXIT KEYGCH, SNA /DO WE HAVE A CHARACTER JMS I (GCH /NO SO GET ONE (HARD WAIT FOR FIRTS CHARACTER DCA TEMP2 /WE GOT A CHARACTER NOW. TAD TEMP2 /PUT CHARACTER INTO SAC JMS I (SACP TAD TEMP2 /NOW CHECK FOR AN ESC CHARACTER TAD (-33 SNA CLA JMP KEY2 /GOTO ESC ROUTINE (ESC SEQ. NEVER ECHO) TAD ACL /DO WE ECHO THE CHARACTER SNA CLA /0 AC SAY'S DON'T ECHO JMP I (SETL /NO ECHO SO LEAVE TAD TEMP2 JMS I PPCH /ECHO THE CHARACTER JMP I (SETL /LEAVE KEY2, KSF /SKIP ON K.B. FLAG JMP I (SETL /DONE WHEN NOT SET KRB JMS I (SACP TAD (-1000 / Time out to give terminal time to DCA XR4 / Set up next charac2 /SET UP COUNTERS ISZ COUNT1 /TIMER JMP .-1 /KILL .0155 SECONDS ISZ COUNT2 / X 100 BASE 8 JMP .-3 /IS APPROX. 1/10TH SECOND JMS I (CTCCHK /LOOK FOR A CTRL C SLEEP2, ISZ TEMP1 /ARE WE DONE JMP SLEEP1 /NO DO IT AGAIN JMP I PILOOP /ALL DONE TIME TO LEAVE COUNT, 7773 COUNT1, 0 COUNT2, 0 ERR, TAD ERRNUM /GET ERROR NUMBER DCA ACH /FLOAT NUMBER IN HORD DCA ACL DCA AC1 TAD (13 DCA ACX JMS I PFFNOR JMP I PILOOP ERL, TAD ERLINH RTR RTR JMS ERL1 TAD ERLINH JMS ERL1 TAD ERLINL RTL RTL RAL JMS ERL1 TAD ERLINL RTR RTR JMS ERL1 TAD ERLINL AND O17 TAD K60 JMS I (SACP TAD SACXR CIA TAD PSACM1 DCA SACLEN TAD (160 DCA INSAV JMP I (FUNC2I ERL1, 0 AND O17 TAD K60 JMS I (SACP JMP I ERL1 LCD, JMS I (VALID /SET UP AND CHECK ALL DATA JMS I (XPRNT /PRINT BOTTOM LINE OF BOX ISZ I (COLTMP /MOVE COL POSITION RIGHT 1 ISZ I (BOXW /ARE WE DONE JMP LCD+1 /NO, GO AGAIN LCD1, CLL CLA CMA /MOVE TAD I (ROWTMP /ROW POSITION DCA I (ROWTMP /UP ONE ISZ I (BOXH /ARE SIDES DONE JMP .+2 /NO JMP LCD2 /YES CMA /CURCOL IS ALWAYS 1 TO BIG SO ADD A -1 TAD CURCOL /NOW PRINT CHARACTER ON LEFT SIDE DCA I (COLTMP JMS I (XPRNT CLL CLA IAC RAL TAD I (BOXW1 CIA TAD CURCOL DCA I (COLTMP JMS I (XPRNT JMP LCD1 LCD2, CLL CLA IAC TAD I (ROWTMP DCA I (ROWTMP CLL CLA CMA TAD CURCOL DCA I (COLTMP LCD3, JMS I (XPRNT ISZ I (COLTMP ISZ I (BOXW1 JMP LCD3 JMP I (BOXLEV PAGE SGR, JMS I (FIX23 /FIX THE NUMBER THAT WAS SENT CLL CLA TAD ACL AND (17 BSW RTL MQL /PUT AC INTO MQ CLEAR AC TAD SCSLOC AND (200 MQA /OR AC AND MQ RESULT IN AC DCA SCSLOC JMS I (ESCBRK /PRINT AN ESC [ TAD K60 /SHUT OFF ALL ATTRIBUTES JMS I (SACP TAD ACL AND (17 RAR SZL JMS SEVEN7 RAR SZL JMS ONE1 RAR SZL JMS FOUR4 RAR SZL CLA JMS FIVE5 TAD (155 /SMALL M SGRLEV, JMS I (SACP JMP I (SETL SEVEN7, 0 DCA SAVCHR TAD (67 JMS SEMI TAD SAVCHR JMP I SEVEN7 ONE1, 0 DCA SAVCHR TAD (61 JMS SEMI TAD SAVCHR JMP I ONE1 FOUR4, 0 DCA SAVCHR TAD (64 JMS SEMI TAD SAVCHR JMP I FOUR4 FIVE5, 0 TAD (65 JMS SEMI JMP I FIVE5 SEMI, 0 DCA XR5 TAD (73 /SEMICOLON JMS I (SACP TAD XR5 JMS I (SACP JMP I SEMI SSI, TAD V278FG /GET SYSTEM TYPE AND K4 /IS IT A VT278 SNA CLA JMP SSILEV /NO GETOUT JMS I (FIX23 /YES, OK 6130 / clkset 6131 / cklskp JMP SSIDM1 SSIDM2, TAD ACL / Get value passed SNA CLA CLL CLA IAC PR3 0001 7777 JMP SSILEV SSIDM1, 6136 / Clear DMi clock flag TAD (-20 /SET AC > -17 PR3 /SET SCREEN INTENSITY TO 0 5161 CLL CLA TAD ACL /GET VALUE PASSED AND (17 PR3 /SET NEW SCREEN INTENSITY 5161 SSILEV, CLL CLA JMS I (SACP /THROW NULL INTO SAC JMP I (SETL PAGE LGD, JMS I (VALID TAD I (BOXH IAC /IS HEIGHT VALUE LESS THAN 2 SNA CLA JMP I (BOXLEV /YES GET OUT TAD I (BOXW IAC /IS WIDTH VALUE LESS THAN 2 SNA CLA JMP I (BOXLEV /YES GET OUT TAD ACL /WHAT TYPE OF BOX 0, 1, 2? AND (3 SNA /IS IT TYPE 0 JMP I (TYPE0 /YES TAD (-1 /NO, IS IT TYPE1 SNA JMP I (TYPE1 /YES TAD (-1 /NO, IS IT TYPE2 SNA CLA JMP I (TYPE2 /YES JMP I (BOXLEV /NO CORRECT VALUE WAS SELECTED SO GET OUT LGDGO, TAD CHRTR1 /PRINT LOWER LEFT CORNER TAD XR5 /ADD GRAPHIC FEATURES DCA SAVCHR JMS I (XPRNT TAD CHRTR2 /SETUP CHARACTER FOR BOTTOM TAD XR5 DCA SAVCHR CLL CLA IAC TAD I (BOXW1 DCA I (BOXW LGDGO1, ISZ I (BOXW JMP .+2 JMP LGDGO7 ISZ I (COLTMP /UPDATE COL POSITION JMS I (XPRNT JMP LGDGO1 LGDGO7, ISZ I (COLTMP TAD CHRTR3 /LOWER RIGHT CORNER TAD XR5 DCA SAVCHR JMS I (XPRNT LGDGO2, CLL CLA CMA TAD I (ROWTMP /MOVE ROW POSITION UP CMA TAD CURCOL DCA I (COLTMP TAD CHRTR7 /PRINT TOP LEFT CORNER TAD XR5 DCA SAVCHR JMS I (XPRNT TAD CHRTR6 /PRINT TOP TAD XR5 DCA SAVCHR CLL CLA IAC TAD I (BOXW1 DCA I (BOXW LGDGO4, ISZ I (COLTMP ISZ I (BOXW JMP .+2 JMP LGDGO5 JMS I (XPRNT JMP LGDGO4 LGDGO5, TAD CHRTR5 /PRINT TOP RIGHT CORNER TAD XR5 DCA SAVCHR JMS I (XPRNT JMP I (BOXLEV CHRTR1, 0 /L.F. CORNER CHRTR2, 0 /BOTTOM CHRTR3, 0 /B.R. CORNER CHRTR4, 0 /R. SIDE CHRTR5, 0 /T.R. CORNER CHRTR6, 0 /TOP CHRTR7, 0 /T.L. CORNER CHRTR8, 0 /LEFT SIDE PAGE TYPE0, CLL CLA /SET UP VALUES FOR THIS TYPE OF BOX TAD (16 DCA I (CHRTR1 TAD (22 DCA I (CHRTR2 TAD (13 DCA I (CHRTR3 TAD (31 DCA I (CHRTR4 TAD (14 DCA I (CHRTR5 TAD (22 DCA I (CHRTR6 TAD (15 DCA I (CHRTR7 TAD (31 DCA I (CHRTR8 TAD SCSLOC AND (7577 DCA XR5 JMP I (LGDGO TYPE1, CLL CLA /SET UP VALUES FOR THIS TYPE OF BOX TAD (11 DCA I (CHRTR1 TAD (7 DCA I (CHRTR2 TAD (10 DCA I (CHRTR3 TAD (5 DCA I (CHRTR4 TAD (12 DCA I (CHRTR5 TAD (6 DCA I (CHRTR6 TAD (13 DCA I (CHRTR7 TAD (4 DCA I (CHRTR8 TAD SCSLOC AND (7577 TAD (200 DCA XR5 JMP I (LGDGO TYPE2, CLL CLA /SET UP VALUES FOR THIS TYPE OF BOX TAD (6 DCA I (CHRTR1 TAD (6 DCA I (CHRTR2 TAD (6 DCA I (CHRTR3 TAD (36 DCA I (CHRTR4 TAD (34 DCA I (CHRTR5 TAD (34 DCA I (CHRTR6 TAD (34 DCA I (CHRTR7 TAD (36 DCA I (CHRTR8 TAD SCSLOC AND (7577 TAD (200 DCA XR5 J ONE DCA I (ROWTMP ISZ I (BOXH /ARE SIDES DONE JMP .+2 JMP LGDGO3 TAD CHRTR8 /PRINT LEFT SIDE TAD XR5 DCA SAVCHR CMA TAD CURCOL DCA I (COLTMP JMS I (XPRNT TAD CHRTR4 /PRINT RIGHT SIDE TAD XR5 DCA SAVCHR CLL CLA IAC RAL TAD I (BOXW1 CIA TAD CURCOL DCA I (COLTMP JMS I (XPRNT JMP LGDGO2 LGDGO3, CLL CLA IAC TAD I (ROWTMP DCA I (ROWTMP////////////////////////////////// //////////////////////////////////////////// ////////// STORE AND RECALL ////////// ////////// BASIC.SR ////////// //////////////////////////////////////////// //////////////////////////////////////////// RELOC FIELD 3 *5000 RELOC OVERLAY VERSON&77^100+SUBVSR+60 OVDISP, TAD V278FG /GET THE SYSTEM TYPE AND K4 /MASK OUT THE VT278 BIT SNA CLA /IS IT A VT278 JMP I PILOOP /NO GET OUT JMS I (FBITGT /YES, OK TO USE STORE AND RECALL TAD JMPSR DCA .+1 HLT JMPSR, JMP I .+1 /JUMP TABLE XSTORE /FUNCTION BITS = 000 XRECAL / = 020 CALL / = 040 XSTORE, DCA XR5 /SET UP FOR 40MS DELAY ISZ XR5 JMP .-1 /KILL .0155 SECONDS TWICE ISZ XR5 /REQUIRED FOR VT278 TO GIVE TIME JMP .-1 /FOR THE SCREEN TO SETTLE ON PR CALLS TAD K4 /IS THERE A FILEV OUT STANDING AND I IOTHDR SZA CLA /SKIP IF AC = 0 H7, JMS I PERROR /A TENTITIVE FILE ALREADY OPEN JMS I (INQUIR /LOOK UP DEVICE HANDLER JMS I (ENTER /FIND LARGEST FREE SPACE ON DISK CLL CLA CMA TAD (BUFFER /GET START OF BUFFER ADDRESS DCA XR5 /AND SAVE IT DCA ROW /SET INITIAL ROW ADDRESS DCA COLMN /SET INITIAL COL ADDRESS DCA BLKCNT /SET INITIAL BLOCK COUNT STOR1, JMS GETCHR /GET A CHARACTER FROM THE SCREEN DCA SAVCHR TAD SAVCHR SNA CLA /IS THE CHARACTER A NULL (000) JMP UPDATE /YES, UPDATE COUNTERS AND GET ANOTHER CHAR. TAD (-40 /IS THE CHARACTER A SPACE SNA CLA JMP UPDATE /YES, GO GET ANOTHER CHARACTER TAD ROW /ITMP I (LGDGO SCS, JMS I (FIX23 CLL CLA TAD ACL /GET THE VALUE SENT AND (1 RAR /PUT VALUE INTO LINK TAD SCSLOC /GET CHARACTER ATTRIBUTES AND (7400 /SAVE ALL ATTRIBUTES EXCEPT GRAPHICS CHAR. SZL TAD (200 DCA SCSLOC /SAVE IT WHERE IT WON'T GET DAMMAGED JMS I (SACP /THROW A NULL INTO SAC TO MAKE IT HAPPY JMP I (SETL /TIME TO LEAVE PAGE //////////0 /IS CURRENT COL DONE? SZA CLA JMP STOR1 /NO GET ANOTHER CHARACTER DCA COLMN /YES, RESET COL POSITION ISZ ROW /UPDATE FOR NEXT ROW TAD ROW TAD (-30 /HAVE WE LOOKED AT ALL THE ROWS? SZA CLA JMP STOR1 /NO, GET ANOTHER CHARACTER TAD (BUFFER /YES, TIME TO DO SOME CHECKS CIA /2'S COMP OF BUFFER ADDRESS IAC TAD XR5 /GET CURRENT POINTER TO BUFFER LOCATION SZA CLA /ARE WE AT THE BEGINING OF THE BUFFER JMP OK /NO, SKIP THE NEXT PART DCA I XR5 /YES, NEED TO OUTPUT A ROW, COL, CHAR TO MAKE DCA I XR5 /THE VT278 HAPPY. A PR1 DOESN'T WORK TO WELL DCA I XR5 /WHEN DIRECTLY FOLLOWED BY A 7777 OK, CMA DCA I XR5 /ALL DONE WRITE A 7777 INTO BUFFER TAD (JMP I PILOOP /JMP I 0002 TO GET BACK TO PROGRAM DCA I XR5 /AFTER PR1 IS COMPLETE TAD I (LENGTH /GET FREE BLOCK SPACE SMA CLA /IF SPACE LEFT WRITE OUT DATA JMP H8 /OTHERWISE ERROR JMS I (WRITE /LETS DO IT TO IT, WRITE OUT BUFFER JMS I (XCLOSE /CLOSE THE FILE TO MAKE IT PERMINANT JMP I PILOOP /ALL DONE GET OUT GETCHR, 0 /GET A CHARACTER FROM PANEL MEMORY CLL CLA /SET UP THE PR0 COMMAND TO READ PANEL MEMORY TAD ROW /GE'S OK OUTPUT ROW, COL, CHAR DCA I XR5 /INTO BUFFER AREA TAD COLMN DCA I XR5 TAD SAVCHR DCA I XR5 TAD (BUFEND /GET ENDING ADDRESS OF BUFFER CIA TAD XR5 /GET CURRENT BUFFER ADDRESS SZA CLA /CHECK IF BUFFER IS FULL JMP UPDATE /NOPE, UPDATE COUNTERS, AND GET ANOTHER CHAR. CMA /YES, OUTPUT A 7777 (FILLS LAST FREE LOC) DCA I XR5 TAD I (LENGTH /GET REMAINING FREE BLOCKS ON THE DISK SNA CLA /DO WE STILL HAVE ROOM ON THE DISK H8, JMS I PERROR /NO!! TIME TO ABORT OPERATION ISZ I (LENGTH /YES, UPDATE FREE BLOCK LENGTH COUNT NOP /WE WILL SKIP EVENTUALLY JMS I (WRITE /WRITE BUFFER OUT CLL CLA CMA /AC=-1 TAD (BUFFER /RESET POINTER TO BUFFER DCA XR5 UPDATE, ISZ COLMN /INCREMENT COL POSITION TAD COLMN TAD (-12OUNTER JMS INQUIR /LOOK UP DEVICE HANDLER JMS LOOKUP /LOOK UP FILE ON DISK READ, CLL CLA TAD I (BLKCNT /BUILD BLOCK ADDRESS. BLKCNT=# OF BLOCKS READ TAD FILADD /ADD THIS TO THE STARTING BLOCK OF FILE DCA INBLK /AND SAVE IT FOR HANDLER READ CIF CDF 0 /CALL HANDLER JMS I DEVENT /JMS TO POINTER OF HANDLER ENTRY POINT 0200 /READ ONE BLOCK BUFFER /AND DUMP THE DATA STARTING AT THIS ADDRESS INBLK, 0 /BLOCK ADDRESS OF DISK TO BE READ HN, JMS I PERROR /BAD READ DON'T TOLLERATE ANY ERRORS ISZ I (BLKCNT /UPDATE BLOCK READ COUNTER JMP I (PANMEM /DUMP THIS DATA ONTO THE SCREEN /PANEM WILL RETURN TO READ IF MORE DATA IS /IS AVAILABLE, OR RETURN TO PILOOP IF ALL DONE INQUIR, 0 /LOOK UP A DEVICE HANDLER CLL CLA DCA DEVENT /ZERO OUT SO WE WILL IF HANDLER WASN'T IN JMS I (NAM /GET DEVN:FILE.EX 2311 /DEFAULT EXTENSION =.SI H6, JMS I PERROR /FORMAT OF NAME STRING BAD JMS I (PSWAP /RESTORE FIELD 1 (THIS IS ONE OF THOSE HOOKS CDF /THAT YOUR FATHER WARNED YOU ABOUT) CIF 10 JMS I (USR /LET THE USR'S DO THEIR THING 12 DEV1, 0 DEV2, 0 /GETS DEVICE NUMBER DEVENT, 0 /GETT CURRENT ROW COUNT DCA X TAD COLMN /GET CURRENT COL COUNT DCA Y PR0 /GET CHAR FROM SCREEN POSITION ROW,COL X, 0 Y, 0 JMP I GETCHR /LEAVE WITH THE CHARACTER IN AC ROW, 0 COLMN, 0 BLKCNT, 0 PAGE CALL, CLL CLA JMS I (FIXRGS /FIX NUMBER PASSED JMS INQUIR /SET UP DEV AND FILE NAME JMS LOOKUP /DOES FILE EXIST TAD FILADD /YUP IAC /SKIP CCB DCA I (CALL3 /SAVE IT IN HANDLER CALL STA /SET NON VALID OVERLAY # DCA I (OVRLAY JMS I (PSWAP /SWAP SYSTEM BACK IN JMP I (CALL1 /LOAD USER OVERLAY XRECAL, CLL CLA DCA XR5 /SET UP FOR 40MS DELAY ISZ XR5 JMP .-1 /KILL .0155 SECONDS TWICE ISZ XR5 /REQUIRED FOR VT278 TO GIVE TIME JMP .-1 /FOR THE SCREEN TO SETTLE ON PR CALLS DCA I (BLKCNT /INIT BLOCK C4200 /WRITE OUT 1 BLOCK OF DATA BUFFER /POINTER TO BUFFER ADDRESS OUTBLK, 0 JMP HN /ERROR ISZ I (BLKCNT /UPDATE BLOCK COUNT JMP I WRITE XCLOSE, 0 /MAKE OUR TEMPORY FILE A PERMINANT ONE TAD I (BLKCNT /GET BLOCK COUNT DCA BLOCKS JMS I (PSWAP /SWAP FIELD DATA TAD DEV2 /GET DEVICE NUMBER CDF CIF 10 JMS I (USR /CALL THE USR ROUTINES 4 XNAME BLOCKS, 0 H5, JMS I PERROR CLL CLA JMS I (PSWAP /SWAP BACK FIELD STUFF JMP I XCLOSE /OUR FILE IS NOW ON THE DISK PAGE /ROUTINE TO PARSE A FILE NAME OF THE FORM "DEVN:FILENM.EX" /IF DEVN IS SPECIFIED IT WILL BE STRIPPED AND SYS WILL BE USED /CALL+1 = DEFAULT EXTENSION, ASSUMES DEFAULT DEVICE DSK: /RETURN TO CALL+2 IF BAD FILE NAME SYNTAX /RETURN TO CALL+3 IFS ENTRY ADDRESS OF HANDLER H1, JMS I PERROR /ERROR BAIL OUT JMS I (PSWAP TAD DEVENT /DID WE FIND A HANDLER ADDRESS SNA CLA JMP H1 /NO ERROR JMP I INQUIR /SURE DID ENTER, 0 /CREATE A TENTIVE FILE ON THE DISK TAD (XNAME /GET STARTING LOC OF FILE NAME DCA OPNBLK /SAVE IT IN ENTER CALL JMS I (PSWAP /DO SOME FIELD SWAPPING TAD DEVENT-1 /GET DEVICE NUMBER CDF CIF 10 JMS I (USR /DO SOME USR CALLS 3 OPNBLK, 0 /BLOCK ADDRESS LENGTH, 0 /2'S COMP OF BLOCK LENGTH H2, JMS I PERROR /ERROR CLL CLA JMS I (PSWAP /RESTORE FIELD STUFF JMP I ENTER LOOKUP, 0 /FIND A FILE ON THE DISK CLL CLA TAD (XNAME /POINTER TO NAME STRING DCA FILADD /SAVE IT FOR CALL JMS I (PSWAP /SWAP FIELDS TAD DEV2 /GET THE DEVICE NUMBER CDF CIF 10 JMS I (USR /CALL USR ROUTINES 2 FILADD, 0 FILLEN, 0 H3, JMS I PERROR /ERROR CLL CLA JMS I (PSWAP JMP I LOOKUP WRITE, 0 /WRITE OUT 1 BLOCK OF DATA CLL CLA TAD OPNBLK /STARTING BLOCK ADDRESS TAD I (BLKCNT /PLUS BLOCK COUNT DCA OUTBLK /SAVE BLOCK ADDRESS FOR DISK WRITE CDF /HANDLER CALL CIF 0 /CALL HANDLER JMS I DEVENT O NOP TAD (XEXT /POINT AT EXTENSION FIELD NOW DCA TEMP2 DCA XEXT /ZERO OUT THE DEFAULT EXTENSION AC7776 /ALLOW ONLY ONE WORD DCA XR1 JMP NAMGET /GET THE EXTENSION ALREADY EONAME, STA TAD IOTDEV /ALL SET, MOVE THE NAME INTO CURRENT IOTABLE DCA XR1 TAD (DEV1-1 DCA XR2 TAD (-6 /6 WORDS DCA AC0 TAD I XR2 /GET A PAIR OF CHARS DCA I XR1 /AND STORE THEM ISZ AC0 JMP .-3 ISZ NAM /TAKE SUCCESSFUL RETURN JMP I NAM NGETCH, 0 TAD SACLEN /SEE IF ANYTHING IN SAC SNA CLA JMP EONAME /END OF NAME IF NO ISZ SACLEN NOP CDF 10 TAD I SACXR /GET A CHAR CDF DCA AC0 /SAVE IT TAD AC0 TAD (-56 /CHECK IF . SNA CLA JMP DECPNT /JMP IF YES CLL /NOW CHECK IF ALPHANUMERIC TAD AC0 TAD (-60 SMA TAD ( GOT GOOD NAME NAM, 0 TAD I NAM /GET DEFAULT EXT ISZ NAM DCA XEXT /SAVE IN BUFFER STA /SET SOME SWITCHES DCA COLSW STA DCA DOTSW TAD PSACM1 /SET POINTER TO SAC NOW DCA SACXR GOTDVC, TAD (2331 /NOW GET DEFAULT DEVICE - SYS: DCA I (DEV1 TAD (2300 DCA I (DEV2 TAD (-4 /SET A WORD COUNT DCA XR1 TAD (XNAME /POINT AT NAME BUFFER DCA TEMP2 DCA XNAME /ZERO OUT THE NAME NOW DCA XNAME+1 DCA XNAME+2 NAMGET, JMS NGETCH /GET A CHAR ISZ XR1 /TEST COUNT SKP JMP I NAM /ERROR RETURN IF PAST FIELD SIZE TAD AC0 /OK, GET CHAR AND O77 /6 BITS CLL RTL RTL RTL /SHIFT LEFT DCA I TEMP2 /PUT IN BUFFER JMS NGETCH /GET ANOTHER CHAR TAD AC0 AND O77 /6 BITS TAD I TEMP2 /ADD TO PREV ONE DCA I TEMP2 ISZ TEMP2 /UP TO NEXT WORD JMP NAMGET /DO NEXT WORD HAVCOL, ISZ COLSW /SEE IF : SEEN YET JMP I NAM /YES, A BADDY TAD XNAME+2 /SEE IF DEV GT 4 CHARS SNA CLA TAD XNAME /ANY DEV THERE SNA CLA JMP I NAM /NO, NO GOOD JMP GOTDVC /STRIP OFF DEVICE AND GET FILE NAME DECPNT, ISZ DOTSW /SEE IF . SEEN YET JMP I NAM /YES, ERROR ISZ COLSW /DISALLOW FURTHER : TOre is furnished under a license and may be used and ! copied only in accordance with the terms of such license and ! with the inclusion of the above copyright notice. This ! software or any other copies thereof may not be provided or ! otherwise made available to any other person. No title to and ! ownership of the software is hereby transferred. ! ! The60-72 SNA JMP HAVCOL /JMP IF HAPPENS TO BE : SMA TAD (72-101 SMA TAD (101-133 SNL CLA /SKP IF A-Z OR 0-9 JMP I NAM /ELSE WORNG CHAR JMP I NGETCH COLSW, 0 DOTSW, 0 XNAME, ZBLOCK 3 XEXT, 0 PAGE /******************** BUFFER AREA FOR STORE AND RECALL ******************* / IF THIS BUFFER EXCEEDS THE ENDING OVERLAY ADDRESS YOUR DISK WILL PAY FOR / YOUR GRAVE MISTAKE. SO PLEASE TAKE HEED AND HANDLE WITH CARE. / I THANK YOU AND YOUR SOFTWARE THANKS YOU. PANMEM, PR1 /VT278 PR1 INSTRUCTION BUFFER, ZBLOCK 400 /BUFFER CONTAINS ROL;COL;DATA TERMINATED BUFEND=.-2 /BY A 7777 IF IT IS A FULL BUFFER. IN WHICH JMP I .+1 /WE END UP HERE, WHERE WE WILL GO BACK TO GET READ /ANOTHER BUFFER FULL /IF THE BUFFER IS