ASMB,A,B,L,T BASIC LANGUAGE -- JANUARY 1, 1970 HED BASE PAGE LINKS AND CONSTANTS ORG 77B SUP PRESS MULTIPLE OPERAND PRINTING HLT 77B CHANGED TO JSB 107B,I BY 'BOSS' * ** ENTRY POINT FOR CONFIGURED BASIC * JMP START,I * PREAD BSS 1 PHOTO READER LINK WRITE BSS 1 TTY OUTPUT LINK PUNCH BSS 1 PUNCH LINK REED BSS 1 KEYBOARD LINK DEF STOP STOP LINK LWBM BSS 1 LAST WORD OF AVAILABLE MEMORY BSS 1 'BOSS' DRIVER LINKAGE FWAM DEF FINIS FIRST WORD OF AVAILABLE MEMORY LWAM BSS 1 LAST WORD OF AVAILABLE MEMORY PBUFF BSS 1 FIRST WORD OF USERS PROGRAM PBPTR BSS 1 LAST WORD+1 OF USER'S PROGRAM FWABP DEF FINBP FIRST WORD AVAILABLE BASE PAGE FCORE BSS 1 START OF FREE CORE SYMTF BSS 1 START OF SYMBOL TABLE SYMTA BSS 1 SYMBOL TABLE END LSTAK BSS 1 LOW-CORE STACK ADDRESS ASBTB DEF FINIS START OF CALL LINKAGE TABLE SBTBE DEF FINIS LAST WORD +1 OF CALL TABLE IMOFF BSS 1 LINK TO INTERRUPT OFF IMON BSS 1 LINK TO INTERRUPT ON TLINK BSS 1 TTY INTERRUPT LINK PLSTR DEF PUNCH,I LISTR DEF WRITE,I LIST DEVICE REFERENCE JSB,I TLSTR DEF WRITE,I .BUFA BSS 1 I/O BUFFER ADDRESS BADDR BSS 1 I/O BUFFER CCNT BSS 1 POINTERS SBUFA BSS 1 SYNTAX BUFFER ADDRESS SBPTR BSS 1 SYNTAX BUFFER POINTER TFLAG BSS 1 TTYFL BSS 1 TSTPT BSS 1 TEMPORARY STACK POINTER LSTPT BSS 1 LOW-CORE STACK POINTER HSTPT BSS 1 HIGH-CORE STACK POINTER PRADD BSS 1 PROGRAM EXECUTION NXTST BSS 1 SEQUENCING INFORMATION .LNUM BSS 1 CURRENT LINE NUMBER TYPE BSS 1 CURRENT STATEMENT TYPE DSTRT BSS 1 DATA NXTDT BSS 1 STATEMENT DCCNT BSS 1 POINTERS RSYM BSS 1 SIGN BSS 1 EXP BSS 1 XH BSS 1 RANDOM XL BSS 1 VARIABLE TEMPS BSS 12 TEMPORARIES MLBX1 EQU TEMPS+10 B1 BSS 2 B2 BSS 2 B3 BSS 2 SKP START DEF ENTRY INITIATE BASIC SYSTEM RUNA DEF MFASE PHASE 2: BUILD SYMBOL TABLE FASE3 DEF XEC PHASE 3: PROGRAM EXECUTION PEXMA DEF PEXMK RETURN TO MONITOR FROM SYNTAX RDYDA DEF RDYPT RETURN TO MONITOR FROM PHASE 3 DRQSA DEF DRQST REQUEST INPUT DATA LISTA DEF LIST LIST OR PUNCH PROGRAM MATA DEF MAT+1 MAT ENTRY IN PRINT-NAME TABLE EMATA DEF EMAT FIRST WORD OF MATRIX EXECUTION TSRCH DEF TBSRH SEARCH PRINT-NAME TABLE FNDPA DEF FNDPS LOCATE STATEMENT SPECIFIED BY # CNSTA DEF CONST SIGNED ASCII TO BINARY NUMCA DEF NUMCK UNSIGNED ASCII TO BINARY INCHK DEF INTCK ASCII TO INTEGER CONVERSION ENOTA DEF ENOUT SIGNED BINARY NUMBER TO ASCII NUMOA DEF NUMOT UNSIGNED BINARY NUMBER TO ASCII PGINT DEF PRGIN FETCH PROGRAM INTEGER OUTIA DEF OUTIN INTEGER TO ASCII CONVERSION OUTSA DEF OUTST STRING TO BUFFER OUTLA DEF OUTLN DUMP PRINT BUFFER WITH CR/LF OUTCA DEF OUTCR PUT CHARACTER INTO PRINT BUFFER GETCA DEF GETCR FETCH NEXT NON-BLANK CHARACTER DIGCA DEF DIGCK SEE IF CHARACTER IS A DIGIT LETCA DEF LETCK SEE IF CHARACTER IS A LETTER SSYMA DEF SSYMT SEARCH SYMBOL TABLE FOR SYMBOL FETCA DEF FETCH EVALUATE FORMULA A RETURN VALUE FORMA DEF FORMX EVALUATE FORMULA .LOGA DEF .LOG TAKE NATURAL LOG OF ARGUMENT .EXPA DEF .EXP COMPUTE EXPONENTIAL OF ARGUMENT .FADA DEF .FAD FLOATING ADD .FSBA DEF .FSB FLOATING SUBTRACT .FMPA DEF .FMP FLOATING MULTIPLY .FDVA DEF .FDV FLOATING DIVIDE ARINA DEF ARINV NEGATE FLOATING NUMBER MPYA DEF MPY INTEGER MULTIPLY FLUNA DEF .FLUN UNPACK FLOATING NUMBER PACKA DEF .PACK PACK FLOATING NUMBER FLT DEF FLOAT 16-BIT INTEGER TO FLOATING IFIXA DEF IFIX FLOATING TO INTEGER (TRUNCATION) PRNIA DEF PRNIN INITIALIZE PRINT BUFFER CHRSA DEF CHRST ACCST DEF ACTST DELST DEF DLSTM FDAT DEF FDATA LCK2A DEF LCHK2 XEC4A DEF XEC4 FSC1A DEF FSC14 FOR1A DEF FORM1 FOR0A DEF FORM0 FOR0B DEF FOR11 FOR1B DEF FOR10 FR12A DEF FOR12 EOF JSB ERROR NOEOF JSB ERROR E8M1A DEF E8-1 ESYN3 DEF SYNE3-1 FSCEF DEF FSCE4 E6M1A DEF E6-1 EBUFA DEF EBUFF EBFA DEF EBFF-1 LBUFA DEF LBUFF LNBFA DEF LNBFF-1 ERBS DEF ERR-1 RECER DEF RCERR-ERR FOPBS DEF QUOTE-2 STBAS DEF SYNTB-26,I XECBR DEF XECTB-26,I ARBAS DEF AROTB-6,I PDFBS DEF PDFT-1 TBLAD DEF SYCMD STTYP DEF LET MATIO DEF READ MCBOP DEF AND PDFNS DEF SIN MATFN DEF ZER ANEXT DEF NEXT ADATA DEF DATA ATHEN DEF THEN ATO DEF TO ASTEP DEF STEP ANOT DEF NOT ATAB DEF TAB MBXL DEF MLBX1 SKP .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .6 DEC 6 .7 DEC 7 .8 DEC 8 .9 DEC 9 .10 DEC 10 .12 DEC 12 .15 DEC 15 .23 DEC 23 .26 DEC 26 .27 DEC 27 .28 DEC 28 .30 DEC 30 .31 DEC 31 .32 DEC 32 .33 DEC 33 .34 DEC 34 .37 DEC 37 .40 DEC 40 .41 DEC 41 .43 DEC 43 .45 DEC 45 .46 DEC 46 .47 DEC 47 .48 DEC 48 .49 DEC 49 .58 DEC 58 .63 DEC 63 B100 OCT 100 E OCT 105 F OCT 106 .72 DEC 72 .74 DEC 74 .75 DEC 75 N OCT 116 S OCT 123 B133 OCT 133 B177 OCT 177 B200 OCT 200 MSK0 OCT 377 B400 OCT 400 B776 OCT 776 MSK1 OCT 777 B1000 OCT 1000 B2000 OCT 2000 B3000 OCT 3000 SCCNT OCT 3002 B4000 OCT 4000 LF OCT 5000 B1400 OCT 14000 UNMNC OCT 21000 B2200 OCT 22000 B2300 OCT 23000 DEFOP OCT 35000 REMOP OCT 36000 RDOP OCT 52000 TENTH OCT 63146 OPMSK OCT 77000 MSK4 OCT 77600 INF OCT 77777 TYPFL OCT 100017 TABCN OCT 100037 OPDMK OCT 100777 RMODE OCT 130000 UNNRM OCT 140000 HIMSK OCT 174000 M1 DEC -1 M2 DEC -2 M3 DEC -3 M4 DEC -4 M5 DEC -5 M6 DEC -6 M7 DEC -7 M8 DEC -8 M9 DEC -9 M10 DEC -10 M11 DEC -11 M15 DEC -15 M16 DEC -16 M21 DEC -21 M25 DEC -25 M32 DEC -32 D53 OCT -53 D72 OCT -72 D100 OCT -100 M72 DEC -72 M73 DEC -73 M76 DEC -76 D133 OCT -133 M256 DEC -256 M310 DEC -310 M1000 DEC -1000 MAXSN DEC -10000 MSK3 EQU M7 FN ASC 1,FN QMARK ASC 1,? HALF OCT 40000 OCT 0 HONE EQU HALF MNEG OCT 100000 MAXIMUM NEGATIVE FLOATING OCT 376 POINT NUMBER FLGBT EQU MNEG MAXFX DEC -999999.5 MINFX DEC -0.099999959 BLANK OCT 40 HED BASE PAGE SUBROUTINES ** *** EMIT ERROR MESSAGE ** ** ERROR NOP LDA TLSTR SHIFT TO STA LISTR COMMAND MODE LDA CCNT SAVE STA OPCHK OUTPUT LDA BADDR BUFFER STA RSCHK POINTERS LDA EBFA SET BUFFER STA BADDR POINTER LDA .8 SET CHARACTER STA CCNT COUNT LDB ERROR ERROR SOURCE IN (B) LDA ERBS ERROR ADDRESS IN (A) INA MOVE TO NEXT ERROR CPB 0,I SAME AS ACTUAL ERROR? CMA,INA,RSS YES JMP *-3 NO ADA ERBS COMPUTE ERROR STA ENOUT SAVE NEGATIVE OF ERROR CMA,INA NUMBER JSB OUTIA,I NUMBER TO BUFFER LDB EBUFA LOAD BUFFER ADDRESS LDA CCNT LOAD NEGATIVE OF CMA,INA CHARACTER COUNT JSB WRITE,I OUTPUT ERROR MESSAGE LDA LNBFA OUTPUT STA BADDR LDA .10 STA CCNT LINE LDA .LNUM JSB OUTIA,I LDB LBUFA NUMBER LDA CCNT JSB WRITE,I LDA ENOUT RETRIEVE NEGATIVE OF ERROR ADA RECER RECOVERABLE SSA,RSS ERROR? JMP PEXMA,I NO, RETURN TO SYNTAX MODE LDA RMODE RETURN TO STA LISTR RUN MODE LDA OPCHK RESTORE STA CCNT OUTPUT LDA RSCHK BUFFER STA BADDR POINTERS JMP ERROR,I RETURN TO PROGRAM SKP ** *** MOVE WORDS TO HIGHER CORE ** ** MVTOH NOP LDB TEMP2 FETCH SOURCE ADDRESS MVTO1 CPB TEMP3 ALL RELOCATION DONE? JMP MVTOH,I YES, EXIT CCA BACK UP ADA TEMP4 SOURCE AND STA TEMP4 DESTINATION ADB M1 ADDRESSES LDA 1,I MOVE STA TEMP4,I WORD JMP MVTO1 ** *** INPUT A CONSTANT ** ** CONST NOP JSB GETCR JMP CONST,I CLB SET SIGN STB SIGN POSITIVE INB CPA .43 '+' ? JMP CONS1 YES CPA .45 NO, '-' ? CCB,RSS YES JMP CONS2 NO CONS1 STB SIGN RECORD SIGN JSB GETCR FETCH NEXT JMP SYE12-1 CHARACTER CONS2 JSB NUMCK FETCH CONSTANT JMP CONS3 NONE FOUND ISZ CONST SUCCESSFULLY FOUND, JMP CONST,I EXIT VIA (P+2) CONS3 CPB SIGN SIGN FOUND? ( (B) = 0) CCA,RSS NO JSB ERROR YES, SOLITARY SIGN SYE12 JMP CONST,I EXIT VIA (P+1) ** *** FETCH NUMBER AND CONVERT TO BINARY ** ** NUMCK NOP CHARACTER IN (A), SIGN SET CLB STB EXP ZERO STB MANT1 ALL STB MANT2 COMPONENTS STB EXPON OF NUMBER STB TEMP3 SET 'NUMBER' FLAG FALSE CCB SET 'DECIMAL POINT' STB DPFLG FLAG FALSE NUMC1 CPA .46 DECIMAL POINT? ISZ DPFLG YES, SET FLAG TRUE JMP NUMC2 NO CLA INITIALIZE POST-DECIMAL DIGIT STA EXPON DIGIT COUNTER TO ZERO JMP NUMC3+1 FETCH A CHARACTER NUMC2 JSB DIGCK DIGIT? JMP NUMC7 NO ISZ EXPON YES, COUNT DIGIT ALF,ALF LEFT-JUSTIFY ALF,RAR DIGIT AND STA TEMP4 SAVE IT JSB MBY10 MULTIPLY PREVIOUS NUMBER BY 10 LDB EXP SZB ZERO EXPONENT? JMP NUMC4 NO LDA .4 YES, SET STA EXP EXPONENT TO 4 LDA TEMP4 LOAD CLB NUMBER NUMC3 JSB NORML NORMALIZE THE NUMBER ISZ TEMP3 SET 'NUMBER OCCURRED' FLAG JSB GETCR ANOTHER CHARACTER? JMP NUM12 NO JMP NUMC1 YES NUMC4 ADB M4 COMPUTE CMB EXPONENT LDA TEMP4 BIAS AND STB TEMP4 SAVE IT CLB NUMC5 ISZ TEMP4 DIGIT POSITIONED? JMP NUMC6 NO CLE YES, ADD IN ADB MANT2 LOW PART CLO OF NUMBER SEZ OVERFLOW? INA YES, BUMP (A) ADA MANT1 ADD IN HIGH PART OF NUMBER SOS OVERFLOW? JMP NUMC3 NO CLE,ERA YES, ROTATE ERB DOWN AND ISZ EXP BUMP NOP EXPONENT JMP NUMC3 NUMC6 CLE,ERA SHIFT ERB DIGIT JMP NUMC5 RIGHT NUMC7 CLB DECIMAL POINT STB TEMP4 CPB TEMP3 OR DIGIT FOUND? JMP NUMCK,I NO, EXIT VIA (P+1) CPA E YES, 'E' ? RSS YES JMP NUM12 NO, NO EXPONENT PART JSB GETCR NUMER JSB ERROR CPA .43 '+' ? JMP NUMC8 YES CPA .45 NO, '-' ? CCA,RSS YES JMP NUMC9 NO STA TEMP4 NOTE MINUS SIGN NUMC8 JSB GETCR JMP NUMER NUMC9 JSB DIGCK DIGIT? JMP NUMER NO STA TEMP3 YES, SAVE IT JSB GETCR JMP NUM10 SECOND JSB DIGCK DIGIT? JMP NUM10 NO LDB TEMP3 YES BLS,BLS MULTIPLY ADB TEMP3 PRIOR DIGIT BLS BY 10 ADA 1 ADD NEW DIGIT STA TEMP3 SAVE EXPONENT JSB GETCR JMP NUM10 THIRD JSB DIGCK DIGIT? RSS NO JMP NUMER YES NUM10 LDA TEMP3 LOAD EXPONENT ISZ TEMP4 POSITIVE? CMA,INA YES, COMPLEMENT IT RSS NO NUM12 CLA CLEAR IF NO EXPONENT PART ISZ DPFLG DECIMAL POINT? ADA EXPON YES, CORRECT EXPONENT SZA,RSS ZERO EXPONENT? JMP NUM14 YES SSA NO, NEGATIVE EXPONENT? JMP NUM13 NO CMA,INA YES, SET STA EXPON COUNTER JSB DBY10 DIVIDE NUMBER BY 10 ISZ EXPON DONE? JMP *-2 NO JMP NUM14 YES NUM13 STA EXPON SET COUNTER JSB MBY10 MULTIPLY BY 10 ISZ EXPON DONE? JMP *-2 NO NUM14 LDA MANT1 YES, LOAD LDB MANT2 NUMBER ISZ SIGN POSITIVE? JMP NUM15 YES CMA NO, CMB,INB,SZB,RSS COMPLEMENT INA IT NUM15 JSB .PACK PACK NUMBER INTO (A) AND (B) ISZ SBPTR STA SBPTR,I STORE ISZ SBPTR NUMBER IN STB SBPTR,I PROPER ISZ SBPTR LOCATION JSB BCKSP FETCH JSB GETCR FIRST LDA .10 UNUSED CHARACTER ISZ NUMCK RETURN JMP NUMCK,I VIA (P+2) ** *** NORMALIZE AND PACK FLOATING POINT NUMBER ** ** .PACK NOP MANTISSA IN (A) AND (B), JSB NORML EXPONENT IN EXP, (E) CLEARED CLE,SZA,RSS ZERO RESULT? JMP .PACK,I YES ADB B177 NO, ROUND SSA,RSS POSITIVE NUMBER? INB YES, FINISH ROUND CLO SEZ OVERFLOW FROM (B)? CLE,INA YES, BUMP (A) SOS OVERFLOW? (A=100000, B=0) RAL SSA,SLA,RSS TWO HIGH BITS 1'S? (A=140000) JMP PACK1 NO CCE YES ARS,SLA,ALS SET (A) =100000 AND SKIP PACK1 RAR COUNTERPART TO *-5 STA MBY10 SAVE (A) LDA 1 DELETE 8 LOW AND M256 ORDER BITS OF MANTISSA STA 1 SAVE LOWER MANTISSA LDA EXP FETCH EXPONENT SEZ DECREMENT EXPONENT? ADA M1 YES SOC NO, PRIOR OVERFLOW? INA YES, INCREMENT EXPONENT ADA B200 NO, EXPONENT SSA UNDERFLOW? JMP PACK3 YES ADA M256 NO, EXPONENT SSA,RSS OVERFLOW? JMP PACK4 YES ADA B200 NO, RESTORE EXPONENT, RAL POSITION SIGN, AND MSK0 MASK TO 8 BITS, AND ADB 0 COMBINE WITH LOW MANTISSA LDA MBY10 RETRIEVE HIGH MANTISSA CPA MNEG RSS NEGATIVE JMP .PACK,I CPB MNEG+1 OVERFLOW? JMP PACK4 YES JMP .PACK,I NO PACK3 JSB ERROR UNDER CLA ZERO RESULT CLB ON UNDERFLOW JMP .PACK,I PACK4 JSB ERROR OVRER LDA MBY10 JSB OVFLW JMP .PACK,I ** *** LOAD INFINITY ON OVERFLOW ** ** OVFLW NOP LDB M2 LOAD SSA APPROPRIATE LDB B776 LOW MANTISSA IOR INF LOAD SSA APPROPRIATE LDA MNEG HIGH MANTISSA JMP OVFLW,I ** *** NORMALIZE (A), (B), AND EXP ** ** NORML NOP SET STA MBY10 LEFT-SHIFT CLA COUNTER STA MPY TO ZERO LDA MBY10 SZA,RSS ON SZB ZERO JMP NORM3 CLEAR STA EXP EVERYTHING STA MANT1 STORE NORM1 STB MANT2 MANTISSA JMP NORML,I AND RETURN NORM2 ISZ MPY COUNT LEFT SHIFTS NORM3 CLE,ELB ROTATE (A) AND ELA (B) LEFT INTO (E) SEZ,SSA,RSS TWO HIGHEST BITS 0? JMP NORM2 YES, + UNNORMALIZED SEZ,SSA NO, TWO HIGHEST BITS 1? JMP NORM2 YES, - UNNORMALIZED ERA SHIFT TO ERB,CLE NORMALIZE MANTISSA STA MANT1 NO, LDA MPY COMPUTE CMA,INA CORRECTED ADA EXP EXPONENT STA EXP VALUE LDA MANT1 JMP NORM1 ** *** MULTIPLY UNPACKED NUMBER BY 10 ** ** MBY10 NOP LDA MANT1 RETURN ON SZA,RSS ZERO JMP MBY10,I MANTISSA LDB EXP MULTIPLY ADB .3 BY STB EXP 8 LDB MANT2 LOAD MANTISSA CLE,ERA DIVIDE ERB BY CLE,ERA 4 ERB,CLE ADB MANT2 DOUBLE SEZ ADD TO INA PRODUCE ADA MANT1 1.25 * MANTISSA SSA,RSS CORRECT JMP *+5 CLE,ERA ON ERB ISZ EXP OVERFLOW NOP STA MANT1 STB MANT2 JMP MBY10,I ** *** DIVIDE UNPACKED NUMBER BY 10 ** ** DBY10 NOP MULTIPLY BY DOUBLE-LENGTH TENTH LDA MANT1 RETURN SZA,RSS ON ZERO JMP DBY10,I MANTISSA LDB M2 ADD EXPONENT OF ADB EXP 'TENTH' TO STB EXP MANTISSA EXPONENT LDA MANT2 JUSTIFY CLE,ERA LOWER MANTISSA JSB MPY MULTIPLY BY DEF TENTH 63146 (ONE-TENTH) CLE,ELA SHIFT ELB,CLE BACK ADA 1 ADD IN LOWER MANTISSA* SEZ TENTH*(2)-16 INB AND ROUND STB MANT2 TO 16 BITS LDA MANT1 DO JSB MPY SAME DEF TENTH FOR CLE HIGH ADA 1 MANTISSA ADA MANT2 (EFFECTIVELY) SUM SEZ DOUBLE-LENGTH INB PRODUCTS STB MANT1 EXCHANGE STA 1 (A) AND (B) LDA MANT1 REGISTERS JSB NORML NORMALIZE RESULT JMP DBY10,I SKP