ASMB,R HED <> 92065-16001 NAM BASC4,7,99 92065-16007 REV. 2001 791019 * * DATE REVISED 7-21-78 * * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * SOURCE 92065-18005 * * ENT BASC4,ETAB,ERND,ESGN,ESWR,XERR,SERR,OCT,TIM ENT ETYP EXT FINDV,BCKSP,WRITE,DRQST,GETCR,MVTOH,OUTER EXT IFBRK,ENOUT,NUMCK,OUTCR,..FCM,INDCK,.IENT EXT OUTLN,OUTIN,TRAP,FCNEX,.MBT EXT PRNIN,SSYMT,FNDPS,.PACK,COMND EXT EXP,ALOG,RMPAR EXT EXEC,OLNCK,KEYBD EXT .FAD,.FSB,.FMP,.FDV,IFIX,FLOAT EXT BASC8 * COM TEMPS(30),PNTRS(61),SPEC(10) ***************************************** * * * SEGMENT #4: EXECUTE THE PROGRAM * * * ***************************************** * * THIS PART OF THE INTERPRETER IS LOADED BY THE BASIC MAIN CONTROL * AFTER THE SUCCESSFUL COMPLETION OF THE PRE-EXECUTION PROCESSING * SEGMENT. IT WILL EXECUTE THE USER PROGRAM, LINE BY LINE, BY * EXAMINING THE TRANSLITERATED CODE AND BRANCHING TO THE VARIOUS * EXECUTION SUBROUTINES. UPON COMPLETION, IT RETURNS EXECUTION TO * THE MAIN CONTROL PROGRAM. SKP *************************** * * * CONSTANTS AND VARIABLES * * * *************************** * FWAM EQU PNTRS FIRST WORD OF AVAILABLE MEMORY LWBM EQU PNTRS+1 LAST WORD OF AVAILABLE MEMORY .INBF EQU PNTRS+2 INPUT BUFFER ADDRESS SBUFA EQU PNTRS+3 SYNTAX BUFFER ADDRESS SYMTA EQU PNTRS+4 START OF SYMBOL TABLE SYMTF EQU PNTRS+5 END OF SYMBOL TABLE PBUFF EQU PNTRS+6 FIRST WORD OF USER PROGRAM PBPTR EQU PNTRS+7 LAST WORD+1 OF USER PROGRAM INBFA EQU PNTRS+8 INPUT BUFFER POINTER ICCNT EQU PNTRS+9 INPUT CHARACTER COUNT SBPTR EQU PNTRS+10 SYNTAX BUFFER POINTER .LNUM EQU PNTRS+11 CURRENT LINE # FCORE EQU PNTRS+12 START OF FREE CORE MNNAM EQU PNTRS+13 MNEMONIC TABLE NAME:SC:LU BRNAM EQU PNTRS+18 BRANCH TABLE NAME:SC:LU FWAMM EQU PNTRS+23 POINTER TO START OF MNEMONIC TABLE FWAMB EQU PNTRS+24 POINTER TO START OF BRANCH TABLE .OTBF EQU PNTRS+25 POINTER TO OUTPUT BUFFER OCCNT EQU PNTRS+26 OUTPUT CHARACTER COUNT OTBFA EQU PNTRS+27 POINTER INTO OUTPUT BUFFER LUOUT EQU PNTRS+28 CURRENT OUTPUT L.U. # LUINP EQU PNTRS+29 CURRENT INPUT L.U. # SIGN EQU PNTRS+30 SIGN OF CURRENT NUMBER BLANK EQU PNTRS+31 CURRENT TERMINATION CHAR REC# EQU PNTRS+32 COMMAND FILE RECORD NUMBER FLTYP EQU PNTRS+33 TYPE 0 FILE FLAG TTYPR EQU PNTRS+34 CONSOLE TTY L.U. # PRINT EQU PNTRS+35 LISTING L.U. # READR EQU PNTRS+36 AUXILLIARY INPUT L.U. # PUNCH EQU PNTRS+37 AUXILLIARY OUTPUT L.U. # ERTTY EQU PNTRS+38 ERROR LIST OUTPUT L.U. # DCB EQU PNTRS+39 DATA CONTROL BLOCK ADDRESS FILBK EQU PNTRS+40 FILE CONTROL BLOCK ADDRESS PFLAG EQU PNTRS+41 SAVE,LOAD FILE FLAG LOLIM EQU PNTRS+42 LOW LIMITS OF PROGRAM HILIM EQU PNTRS+43 HIGH LIMITS OF PROGRAM LORUN EQU PNTRS+44 LOW RUN LIMITS HIRUN EQU PNTRS+45 HIGH RUN LIMITS SLSTM EQU PNTRS+46 EXECUTE SLOW STMTS LOTRC EQU PNTRS+47 LOW TRACE LIMITS HITRC EQU PNTRS+48 HIGH TRACE LIMITS BRKP1 EQU PNTRS+49 BREAK POINT #1 BRKP2 EQU PNTRS+50 BREAK POINT #2 BRKP3 EQU PNTRS+51 BREAK POINT #3 BRKP4 EQU PNTRS+52 BREAK POINT #4 SMFLG EQU PNTRS+53 SIMULATE FLAG TYPE EQU PNTRS+54 PARTIAL LINE CHARACTER COUNT DLMTR EQU PNTRS+55 CHAR EDIT DELIMITER MERGF EQU PNTRS+56 MERGE FLAG SKP HSTPT BSS 1 HIGH-STACK POINTER TSTPT BSS 1 TEMPORARY STACK POINTER LSTPT BSS 1 LOW-STACK POINTER LSTAK BSS 1 LOW-STACK ADDRESS PRADD BSS 1 PROGRAM EXECUTION NXTST BSS 1 SEQUENCING INFORMATION DSTRT BSS 1 DATA NXTDT BSS 1 STATEMENT DCCNT BSS 1 POINTERS SPC 1 SUP PRESS MULTIPLES LISTING SPC 1 XH BSS 1 XL BSS 1 TT1 BSS 1 TT2 BSS 1 TT3 BSS 1 TT4 BSS 1 EOL BSS 1 TAB END-OF-LINE FLAG STRFG BSS 1 STRING CONSTANT FLAG * FOPBS DEF QUOTE-1 ARBAS DEF AROTB-6,I XECBR DEF XECTB-26,I ADATA DEF DATA FINCA DEF FINCH ADDRESS OF FETCH INPUT ROUTINE FSCHA DEF FSCH ADDRESS OF FETCH SOURCE CHAR ROUTINE * TRMSA DEF *+1 TRACE ASC 4,*TRACE A EQU 0 B EQU 1 SKP .1 DEC 1 .2 DEC 2 .3 DEC 3 .6 DEC 6 .10 DEC 10 .15 DEC 15 .20 DEC 20 .32 DEC 32 LFTAR OCT 137 CTRLQ OCT 21 B40 EQU .32 B42 OCT 42 B77 OCT 77 B377 OCT 377 B777 OCT 777 B2000 OCT 2000 RSS OCT 2001 B3000 OCT 3000 SCCNT OCT 3002 DATA OCT 51004 DATOP OCT 51000 ENDOP OCT 45000 #OP OCT 17000 SPLOP OCT 65000 OPMSK OCT 77000 ATMSK OCT 10000 INF OCT 77777 INTFL OCT 100003 OPDMK OCT 100777 WRFLG OCT 100001 M1 DEC -1 M2 DEC -2 M3 DEC -3 M6 DEC -6 M15 DEC -15 M20 DEC -20 M21 DEC -21 D31 OCT -31 M73 DEC -73 M256 DEC -256 M1000 DEC -1000 HALF OCT 40000 OCT 0 HONE EQU HALF MNEG OCT 100000 MAXIMUM NEGATIVE FLOATING OCT 376 POINT NUMBER FLGBT EQU MNEG HIMSK EQU M256 AFCNX DEF FCNEX ADDRESS OF BRANCH ENTRIES FOR FUNCTIONS SKP *************************** * * * EXECUTION BRANCH TABLES * * * *************************** * * THE EXECUTION BRANCH TABLES ARE THE BASIS FOR EXECUTING A BASIC * USER PROGRAM. FOR EACH OPERATOR IN BASIC THERE IS A UNIQUE CODE * NUMBER. THIS CODE NUMBER, WHEN ADDED TO A REFERENCE ADDRESS, ,• * FORMS A POINTER TO ONE OF THE ADDRESSES IN THESE BRANCH TABLES. * THE ADDRESS WHICH IS POINTED TO IN THE TABLE, IS THE ADDRESS OF * THE CORRESPONDING EXECUTION SUBROUTINE. * XECTB DEF ELET LET DEF XEC4 DIM DEF XEC4 COM DEF XEC4 DEF DEF XEC4 REM DEF EGOTO GO TO DEF EIF IF DEF EFOR FOR DEF ENEXT NEXT DEF EGOSB GOSUB DEF ERTRN RETURN DEF EEND END DEF EEND STOP DEF EWAIT WAIT DEF ECALL CALL DEF XEC4 DATA DEF EREAD READ DEF EPRIN PRINT DEF EINPT INPUT DEF ERSTR RESTORE DEF EPAZ PAUSE DEF XEC4 FAIL DEF EGOTO THEN DEF XEC4 USING NOP .PLACE HOLDERS NOP NOP DEF 0 SPECIAL SYNTAX DEF ETRAP TRAP * SKP DEF FORMX,I EXIT ON EMPTY STACK BSS 5 DUMMY ADDRESSES AROTB DEF ESCMA SUBSCRIPT SEPARATOR DEF ESTR ASSIGNMENT OPERATOR DEF EFAD '+' DEF EFSB '-' DEF EFMP '*' DEF EFDV '/' DEF EPWR '^' DEF EGTRT '>' DEF ELST '<' DEF ENEQL '#' DEF EEQL '=' DEF EUMIN UNARY '-' DEF ELBRC '[' DEF FORM1 '(' DEF FOR11 UNARY '+' DEF EOR OR DEF EAND AND DEF ENOT NOT DEF EGORE '>=' DEF ELORE '<=' * SKP ***************************** * * * OPERATOR PRECEDENCE TABLE * * * ***************************** * * THIS TABLE IS USED BY THE FORMULA EVALUATION SUBROUTINE TO * DETERMINE THE HIERARCHICAL PRECEDENCE OF THE FORMULA-TYPE * OPERATORS. BITS 15-9 OF THE LABELLED WORD ARE THE BASIC * CODE OPERATOR AND BITS 3-0 ARE THE PRECEDENCE FOR THE * OPERATOR. QUOTE OCT 1000 COMMA OCT 2000 SEMIC OCT 3000 * RPARN OCT 4001 RBRAC OCT 5001 SCMMA OCT 6002 ASSOP OCT 7002 PLUS OCT 10007 MINUS OCT 11007 TIMES OCT 12010 DIV OCT 13010 EXPS OCT 14012 GTR OCT 15005 LSS OCT 16005 UNEQL OCT 17005 EQUAL OCT 20005 UNMIN OCT 21011 LBRAC OCT 22020 LPARN OCT 23020 UPLUS OCT 24011 OROP OCT 25003 ANDOP OCT 26004 NOTOP OCT 27011 GTREQ OCT 30005 LSSEQ OCT 31005 * SKP *********************** * * * EXECUTE THE PROGRAM * * * *********************** BASC4 NOP CPB M1 (B)=-1 IF TRAP TABLE IS BUSY RSS YES ITS BUSY SO DONT ALLOW TRAP POLING JMP BASX NO, OK TO USE IT LDA RSS STORE RSS IN 'JSB TRAP' STA TRAPX STA ETRAP BASX LDA SLSTM RETURN SZA FROM SEGMENT 7 OR 8? JMP XEC4 YES, CONTINUE WITH NEXT STMT * * LDA FWAM SET FOR RANDOM NUMBER GENERATOR STA XH INITIALIZE INA RANDOM STA XL VARIABLE SPC 1 * INITIALIZE THE DATA POINTER SPC 1 CCA SET STA DCCNT 'NO STA DSTRT DATA' LDB PBUFF CONDITION STB NXTDT LDA ADATA,I SEARCH FOR FIRST JSB STSRH DATA STATEMENT JMP XEC2 NONE FOUND STB DSTRT SAVE STATEMENT LOCATION JSB SETDP SET DATA POINTER SPC 1 * INITIALIZE STACK POINTERS SPC 1 XEC2 JSB SETPT INITIALIZE PTRS LDA LORUN FIRST STMNT CPA .1 OF PROGRAM? JMP XEC3 YES! JSB FNDPS NO, FIND IT NOP JMP XEC5-1 CAN'T FIND IT * XEC3 LDA 1,I GET FIRST STATEMENT NUMBER STA NXTST AND SET UP FOR STB TEMP1 POINTERS JMP XEC5 SKP * FIND NEXT STATEMENT TO BE EXECUTED SPC 1 XEC4 LDA TTYPR RESTORE STA LUINP CONSOLE STA LUOUT LOGICAL UNITS LDA FCORE SET TEMPORARY STA TSTPT STACK POINTER LDA NXTST XEC44 SZA,RSS END OF PROGRAM? JMP EEND YES LDB HIRUN .CHECK FOR RUN LIMIT CMB ADB A .BEYOND THE LIMIT ? SSB,RSS JMP EEND .YES - END LDB PRADD PROSPECTIVE ADDRESS CPA 1,I DESIRED STATEMENT? JMP XEC6 YES XEC43 JSB FNDPS NO, FIND STATEMENT NOP NON-EXISTENT JSB ERROR STATEMENT XEC5 LDA 1,I GET NEW LINE NO. XEC6 STA .LNUM STB TEMP1 * LDB 1717B GET ID SEG ADDRESS ADB .20 GET ADDRESS OF THE RIGHT WORD LDA 1,I GET THE WORD AND ATMSK OPERATOR ATTENTION SZA FLAG SET? JMP OPEND YES, STOP THE PRESSES! LDB TEMP1 RESTORE B WITH ADDR OF NEXT STATEMENT LDA M1000 STA FILE# .SET TO STANDARD I/O TRAPX JSB TRAP CHECK FOR INTERRUPT JMP TRERR ERROR RETURN SSA,RSS JMP EGOS2 INTERRUPT, DO GOSUB JSB FLWST SETSX LDA TEMPS,I AND OPMSK EXTRACT STATEMENT TYPE CONT ALF,ALF POSITION RAR IT ADA XECBR COMPUTE EXECUTION ADDRESS JMP 0,I BRANCH TO EXECUTION CODE SKP ***************** * * ** EXECUTE LET ** * * ***************** * * ELET CLA,INA ENABLE FOR STRING CONSTANT STA STRFG IN FORMULA JSB FORMX JMP XEC4 * * ******************* * * ** EXECUTE FOR ** * * ******************* * EFOR JSB FVSRH FOR-VARIABLE ALREADY IN STACK? JMP EFOR1 NO STA TEMP2 YES, SAVE SOURCE ADDRESS ADA .6 SAVE STA TEMP4 DESTINATION ADDRESS STB TEMP1 SAVE FOR-VARIABLE ADDRESS JSB MVTOH COMPRESS STACK LDB TEMP1 RESTORE FOR-VARIABLE ADDRESS CLA,RSS COMPUTE NEW EFOR1 LDA M6 TOP OF ADA HSTPT FOR-STACK STA HSTPT POINTER STA TEMP1 CMA,INA STACK ADA LSTPT SSA,RSS OVERFLOW? JMP E1 YES. ERROR 57. STB TEMP1,I NO, RECORD FOR-VARIABLE ADDRESS JSB FORMX INITIALIZE FOR-VARIABLE ISZ TEMPS ISZ TEMP1 SAVE LDA TEMP1 LIMIT STA ENEX2+1 ADDRESS JSB FETCH FETCH STA TEMP1,I AND ISZ TEMP1 STORE STB TEMP1,I LIMIT ISZ TEMP1 LDB M2 SET FOR STEP SIZE STB FDATA SIGN CHECK LDA TEMPS,I LOOK FOR SZA FOLLOWING ' STEP' JMP EFOR2 FOUND LDA HONE NOT FOUND, CMB,INB,RSS DEFAULT IS 1.0 EFOR2 JSB FETCH SSA STEP SIZE NEGATIVE? ISZ FDATA YES STA TEMP1,I SAVE ISZ TEMP1 STEP STB TEMP1,I SIZE ISZ TEMP1 SET POINTER LDA NXTST TO STATEMENT STA TEMP1,I FOLLOWING THE FOR EFOR3 LDA NEXTX FIND LDB PRADD 'NEXT' JSB STSRH STATEMENT NOP JSB FLWST FIND FOLLOWING STATEMENT AND B777 SAME CPA ETAB FOR-VARIABLE? RSS YES JMP EFOR3 NO LDB HSTPT,I LOAD DLD 1,I LOAD VALUE OF FOR VARIABLE JMP ENEX2-2 CHECK ACCEPTABILITY * * NEXTX OCT 42004 * ** EXECUTE NEXT ** * ENEXT JSB FVSRH FIND CORRESPONDING STACK ENTRY JMP XEC4 NONE PRESENT STA HSTPT RESET TOP OF STACK STB ENEX1+1 SAVE FOR-VARIABLE ADDRESS INA SAVE LIMIT STA ENEX2+1 ADDRESS ADA .2 SAVE STEP SIZE STA TEMP1 ADDRESS LDB M2 SET STEP SIZE STB FDATA SIGN CHECK LDA TEMP1,I LOAD ISZ TEMP1 STEP LDB TEMP1,I SIZE ISZ TEMP1 SSA CHECK ISZ FDATA SIGN ENEX1 JSB .FAD INCREMENT FOR-VARIABLE NOP DST ENEX1+1,I AND SAVE VALUE STA EFMT STB NFMT ENEX2 JSB .FSB COMPUTE FOR-VARIABLE - LIMIT NOP ISZ FDATA POSITIVE STEP SIZE? ELA YES, COMPLEMENT SIGN SSA NO, NON-NEGATIVE RESULT? JMP ENEX3 NO LDA TEMP1,I YES, GO TO FIRST STA NXTST JMP XEC4 STATEMENT OF LOOP * ENEX3 LDA HSTPT FAILS, ADA .6 ERASE STA HSTPT STACK ENTRY JMP XEC4 SKP ***************** * * * EXECUTE PRINT * * * ***************** EPRIN LDA HSTPT SAVE HI STK PTR IN CASE STA HTEMP OF END-OF-FILE EXIT JSB VALLU .A #,LU ? STA LUOUT .YES - SAVE * EPR01 JSB PRNIN INITIALIZE OUTPUT BUFFER JSB FLUPT FIND ANY PARTIAL LINE FLAG AND B377 AND ISOLATE THE STA TYPE CHARACTER COUNT CLA,RSS TURN ON EPR02 CCA TURN OFF STA EOL END-OF-LINE FLAG EPR04 LDB TEMPS MORE CPB PRADD STATEMENT? JMP EPR19 NO,EXIT PRINT EXECUTION LDA 1,I AND OPDMK EXTRACT OPERAND SZA NULL JMP EPR07 NO,GO TO EVALUATION EPR05 LDB TEMPS INB CPB PRADD MORE STATEMENT? JMP EPR19 NO, EXIT PRINT PROCESSING LDA 1,I YES, EXTRACT AND OPMSK OPERATOR CPA B2000 "," ? JMP EPR10 YES,GO TO COMMA EXECUTION CPA B3000 ";" ? JMP EPR14 YES, TURN OFF END-LINE FLAG CPA ENDOP "END" JMP EPR19 .EXIT PRINT OPERATION I/O SZA NULL OPERATOR? JMP EPR07 NO,EVALUATE FORMULA EPR06 ISZ TEMPS YES, STEP CODE POINTER, JMP EPR04 AND EXAMINE OPERANND. * EPR07 CLA,INA STA STRFG ALLLOW STRING CONSTANTS CCA AND PRESET TAB FLAG STA EOL JSB FORMX EVALUATE NEXT EXPRESSION ISZ EOL WAS IT A TAB? JMP EPR12 YES, EXECUTION DONE LDB HSTPT,I WAS IT A STRING? SSB JMP EPR11 YES, GO PROCESS IT JSB OPCHK QUALIFY THE OPERAND DLD 1,I NO JSB ENOUT OUTPUT THE NUMBER CLA AND REMEMBER THAT STA TABFG IT WAS NUMERIC OUTPUT JMP EPR12 * EPR12 ISZ HSTPT POP VARIABLE PTR OFF HI STK JMP EPR05 * EPR10 CLA CPA EOL WAS THERE A TAB LAST? JSB EDELM NO,EXECUTE COMMA CLA,INA STA TABFG EPR14 ISZ TEMPS STEP CODE POINTER JMP EPR02 AND TURN OFF END-LINE FLAG * EPR11 LDA M2 PREPARE JSB PSTR PRINT STA TEMP8 STRING STB TPRME LDB TEMPS ADB M1 STB TEMPS LDB M3 LDA TNULL NO,GET STRING LENGTH CMA STA EDELM AND SAVE FOR LATER JSB OLNCK CHECK LINE OVERFLOW LDA .OTBF FIGURE STARTING CLE,ELA CHARACTER ADA OCCNT ADDRESS STA TEMP5 FOR TRSTR ADA EDELM UPDATE OUTPUT CLE,ERA POINTER SEZ,RSS ADA M1 STA OTBFA SINCE TRSTR WON'T LDA OCCNT AND ALSO ADA EDELM UPDATE THE STA OCCNT CHAR COUNT LDA FSCHA JSB TRSTR OUTPUT THE CHARACTERS CLA,INA STA TABFG AND REMEMBER NO BACKSPACING JMP EPR05 EXAMINE THIS OPERATOR * EPR19 CLA ISZ EOL TERMINATE THIS LINE? JMP EPR20 YES,GO TO OUTPUT LDA LUOUT IS THIS AND B77 A JSB FINDV LINEPRINTER? CPA .10 JMP EPR15 YES! LDA LFTAR NO, ADD TRAILING JSB OUTCR LEFT ARROW LDB M1 AND CORRECT FOR IT EPR21 ADB OCCNT MANUFACTURE ADB TYPE LOGICAL UNIT LDA LUOUT AND COUNT AND B77 WORD INCLUDING ALF,ALF ALL CHARACTERS IOR 1 OUTPUT, EXCEPT '_' EPR20 STA TEMP1,I UPDATE OR RELEASE LU/COUNT WORD JSB OUTLN AND OUTPUT THIS RECORD JMP XEC4 * EPR15 LDA LUOUT SET IOR B2000 HONESTY STA LUOUT MODE CLB JMP EPR21 * * * VALIDATE LU # FOR READ AND PRINT * * VALLU NOP LDA M1000 .PRESET FOR NON #,LU CASE STA FILE# LDA TEMPS .LOOK FOR # OPERAND INA LDA A,I AND OPMSK CPA #OP .DO WE HAVE A # ? RSS .FOUND IT - FETCH LU VALUE JMP VAL1 .NOT FOUND LET LU BE STA FILE# .SET TO ALTERNATE LU # ISZ TEMPS .MOVE TO EVALUATE LU CLA STA STRFG .DISABLE STRINGS JSB FETCH .FETCH LU VALUE JSB IFIX .CONVERT TO INTEGER STA VAL2 .SAVE RESULT ISZ TEMPS .SKIP OVER NULL RECORD LDA TEMPS,I FETCH SEMICOLON CPA B3000 .VARIABLE ATTACHED? JMP VAL3 .CHECK FOR STRING CONSTANT FOLLOWING VAL4 LDA VAL2 .RESTORE VALUE JMP VALLU,I & EXIT VAL1 ISZ VALLU .JMP OVER LU SET JMP VALLU,I VAL2 NOP * VAL3 LDB TEMPS .THIS IS AKLUDGE TO COMPENSATE INB . FOR FORMX LDA B,I .CHECK TO SEE IF NEXT DATA AND OPMSK . IS A STRING CONSTANT ALF,ALF . IF IT IS DO NOT INCREMENT TEMPS CPA .2 JMP VAL4 ISZ TEMPS .IF IT NOT ,SKIP OVER 3000 IN JMP VAL4 . INTERPRETTIVE CODE * SKP *********************** * * * FIND LU/COUNT WORD * * * *********************** * FLUPT NOP LDA LUOUT CREATE THE AND B77 SEARCH TARGET STA LUTMP LDB M20 INITIALIZE STB TEMP7 COUNTER ADB FCORE AND FIGURE START OF LIST CCA INITIALIZE STA TEMP1 EMPTY SLOT POINTER STA TEMP3 AND FLAG FLUP1 LDA 1,I EXAMINE A WORD SZA EMPTY ? JMP FLUP2 NO ISZ TEMP3 YES, IS THIS THE FIRST JMP FLUP4 NO, SKIP TO NEXT STB TEMP1 YES, SAVE POINTER JMP FLUP4 AND SKIP TO NEXT FLUP2 ALF,ALF POSITION AND AND B77 ISOLATE LU BYTE CPA LUTMP DOES IT MATCH ? JMP FLUP3 YES FLUP4 INB NO, TRY AGAIN ISZ TEMP7 UNLESS THERE JMP FLUP1 AREN'T ANY MORE * CLA MATCH NOT FOUND LDB TEMP1 WAS THERE AN EMPTY SSB SLOT ? JMP E1 NO, OUT OF STORAGE JMP FLUPT,I YES, QUIT WITH A = 0, B = ADDR * FLUP3 LDA 1,I MATCH FOUND STB TEMP1 RETURN WITH A = LU/COUNT WORD JMP FLUPT,I AND B = POINTER THERETO SKP *************************** * * * SPACE FOR A COMMA * * * *************************** * EDELM NOP CLB STB OUTLN SET FLAG FOR LINE OVERFLOW LDA OCCNT ADA TYPE FIGURE CURRENT COLUMN DIV .15 TAKE COLUMN .MOD. 15 SZB,RSS RIGHT ON ? JMP EDELM,I YES, QUIT NOW LDA 1 NO, COMPUTE ADA M15 BLANKS REQUIRED STA TEMP3 FOR SPACING CMA,INA JSB OLNCK CHECK FOR LINE OVERFLOW LDA OUTLN WAS THERE OVERFLOW ? SZA JMP EDELM,I YES, QUIT NOW EDEL0 LDA .32 NO, EMIT A SPACE JSB OUTCR ISZ TEMP3 KEEP ON DOING IT JMP EDEL0 UNTIL FIELD IS FULL JMP EDELM,I * LUTMP EQU EDELM SKP *************** * * * EXECUTE TAB * * * *************** ETAB NOP JSB .IENT SMALL INTEGER? JMP TABXT NO ADA M73 EXCEED SSA,RSS 72? JMP ETAB1 YES! CMA,INA NO, COMPUTE ADA M73 BLANKS ADA OCCNT REQUIRED ADA TYPE SZA,RSS ARE WE RIGHT ? JMP TABXT YES SSA,RSS TOO FAR TO THE RIGHT ? JMP ETAB2 YES STA TEMP3 NO, DRIFT TO THE RIGHT ETAB0 LDA .32 WRITE BLANKS JSB OUTCR RIGHT ISZ TEMP3 JMP ETAB0 TABXT CLB STB EOL SET TAB FLAG TRUE JMP ETAB,I AND EXIT * ETAB1 JSB OUTLN OUTPUT THE LINE JMP TABXT * ETAB2 LDB TABFG CAN WE SZB LEAN TO THE LEFT ? JMP TABXT NO CMA,INA SAVE NEGATIVE STA TEMP3 BLANK COUNT LDB OCCNT ETAB3 LDA OTBFA,I FETCH LAST WORD SLB LOW OR HIGH BYTE ? ALF,ALF HIGH BYTE -> LOW BYTE AND B377 AND ISOLATE THE BYTE CPA .32 IS IT A BLANK ? RSS YES JMP TABXT NO, QUIT NOW ADB M1 BACK UP STB OCCNT ONE CHARACTER SLB NEW WORD ? JMP ETAB4 NO LDA OTBFA YES ADA M1 STEP BUFFER POINTER STA OTBFA BACK TOO ETAB4 ISZ TEMP3 COUNT BLANKS REMOVED JMP ETAB3 AND CONTINUE JMP TABXT UNLESS COUNT EXHAUSTED SKP ********************* * ** *** EXECUTE NOT ** ** * ********************* * ENOT JSB STTOP LOAD OPERAND JMP EEQL1 ********************* * ** *** EXECUTE AND ** ** * ********************* EAND JSB BINOP VALIDATE JMP *+2 OPERANDS NOP ANDS SZA,RSS FIRST OPERAND ZERO? JMP FALSE YES LDA ANDS-1,I JMP ENEQ1 CHECK SECOND OPERAND ********************* * ** *** EXECUTE OR ** ** * ********************* EOR JSB BINOP VALIDATE JMP *+2 NOP IOR *-1,I TRUE IF EITHER OPND JMP ENEQ1 NON-ZERO. SKP ****************** * * ** EXECUTE IF ** * * ****************** * EIF DLD TEMPS,I CPB EOFOP .END OF FILE CHECK? SSA .EOF RETURNED? CLA,INA,RSS ALLOW STRING JMP EIF1 .YES! STA STRFG CONSTANTS! JSB FETCH FETCH VALUE OF FORMULA STA EFMT SAVE RESULT FOR SINGLE STEPPING STB NFMT SZA,RSS RESULTANT TRUE? JMP XEC4 NO ISZ TEMPS ADVANCE TO NEXT OPERATOR EIF4 LDB TEMPS (B) = PTR TO INTERP. CODE JMP SETSX GO EVALUATE 'THEN' PART * EIF1 ISZ TEMPS JSB VALLU .FETCH LU # NOP . < SYNTAX SEG CHECKS FOR '#LU' > STA EIF2 .SET LU # JSB EXEC DEF EIF5 .MAKE A STATUS CALL ON THE DEVICE DEF .13 DEF EIF2 DEF EIF3 EIF5 LDA EIF3 ALF,ALF .POSITION EOF BIT TO BIT 15 SSA JMP EIF4 .TRUE - DO THEN PART ALS,ALS .SHIFT TO EOT BIT SSA,RSS .SET? JMP XEC4 .FALSE - DO NEXT STATEMENT JMP EIF4 .TRUE - DO THEN PART .13 DEC 13 EIF2 NOP .LU NUMBER EIF3 NOP .STATUS WORD EOFOP OCT 62000 .EOF OPERATOR CODE * ********************* * * ** EXECUTE GO TO ** * * ********************* * EGOTO CLA SET FLAG TO 'GOTO' MODE JMP EGOS0 FIND REFERENCED STATEMENT SKP ********************* * * ** EXECUTE INPUT ** * * ********************* * EINP1 JSB WDRQS PRINT '?' AS WARNING JSB DRQST YES, CALL FOR MORE JSB QCHEK CHECK FOR STOP CHARACTER EINP2 JSB CONST CONVERT AND STORE NUMBER JMP EINP1 NOT NUMBER LDB TEMPS END-OF- INB CPB PRADD STATEMENT? JMP EIN15 YES CPA .10 NO, INSURE MORE INPUT EINPT JSB DRQST CALL FOR INPUT JSB QCHEK CHECK FOR STOP CHARACTER EINP5 LDA TEMPS,I .CHECK FOR NULL RECORD SZA,RSS . IF NULL THEN SKIP OVER JMP EINP6 JSB FORMX COMPUTE VARIABLE ADDRESS LDB HSTPT,I IS IT A SSB STRING VARIABLE? JMP EINP4 YES! ADB M1 STORE ISZ HSTPT ADDRESS-1 IN STB SBPTR POINTER JMP EINP2 EINP6 ISZ TEMPS JMP EINP5 * EINP4 CMB EXTRACT LDA 1,I PHYSICAL LENGTH ALF,ALF LENGTH OF AND B377 DESTINATION STRING CMA SET IT AS END ADA TSTPT,I OF UNSPECIFIED STA TPRME DESTINATION STRING CCA PREPARE JSB PSTR DESTINATION STRING LDB TNULL SAVE LENGTH STB TEMP7 ALLOWANCE EIN14 JSB GETCR FETCH CHARACTER NOP CPA B42 QUOTE? RSS YES! JSB BCKSP NO,STRING BEGINS HERE CLB TURN OFF STB BLANK SUPPRESSION LDA FINCA ADDRESS OF INPUT ROUTINE JSB TRSTR TRANSFER STRING CLB ALL REQUESTED CPB TNULL CHARACTERS TRANSFERRED JMP EIN10 YES! CPB PS1 NO,TRANSFER LENGTH SPECIFIED JMP EINP9 NO STA TEMP7 YES, SAVE (A) CCA FINISH STA TPRME ADA TNULL TRANSFER STA TNULL LDA FSCHA WITH BLANKS JSB TRSTR LDA TEMP7 RESTORE (A) EINP7 CPA .10 TRANSFER ENDED BY END-OF-INPUT JMP EIN13 YES! EINP8 JSB GETCR NO, WAS IT A QUOTE LDA .10 EXIT WITH JMP EIN13 NEXT CHARACTER EINP9 LDB TEMP6,I SET LOGICAL ADB TNULL TO ACTUAL STB TEMP6,I STRING LENGTH JMP EINP7 EIN10 CPB PS1 LENGTH OF STRING SPECIFIED? JMP EIN12 NO! EIN11 JSB GETCR YES! JMP EIN13 IMPLIED CLOSING QUOTE CPA B42 QUOTE? JMP EINP8 YES! JMP EIN11 NO, LOOK FOR " OR END-OF-INPUT EIN12 JSB GETCR END-OF-INPUT NEXT? JMP EIN13 YES! CPA B42 NO,CLOSING QUOTE? JMP EINP8 YES! LDA TEMP7 NO, DESTINATION STRING EXCEEDED! STA TNULL RESTORE LDA SBPTR DESTINATION STRING STA TEMP5 PARAMETERS LDA B40 SET TO SKIP BLANKS STA BLANK JSB WDRQS PRINT EXTRA QUESTION MARK AS WARNING JSB DRQST GET A NEW DATA RECORD JSB QCHEK AND CHECK FOR STOP CHARACTER JMP EIN14 * EIN13 LDB B40 RESTORE STB BLANK BLANK SUPRESSION JMP EINP2+2 * * RESET PARTIAL LINE FLAG PENDING ON LUINP * EIN15 LDA LUINP .SET LUOUT = LUINP STA LUOUT JSB FLUPT .CHECK FOR ANY PARTIAL LINE FLAG SZA,RSS JMP XEC4 .NONE - NEXT STATEMENT CLA STA 1,I .YES - RESET FLAG JMP XEC4 .NOW THEN NEXT STATEMENT * * QCHEK NOP LDA .INBF,I FETCH FIRST WORD CPA QQ .CHECK FOR THE QQ STOP JMP OPEND .IF FOUND STOP PROCESSING ALF,ALF POSITION FIRST BYTE AND B377 AND ISOLATE IT CPA CTRLQ IS IT A '^Q' ? JMP OPEND YES, TAKE ORDERLY ABORT EXIT JMP QCHEK,I NO, RETURN * QQ ASC 1,QQ SKP * * OUTPUT WARNING ? IF KEYBOARD DEVICE * WDRQS NOP LDA LUINP .CHECK FOR CRT DEVICE JSB KEYBD JMP E13-1 .NOT A KEYBOARD - ISSUE ERROR LDA M2 LDB QMRKA .PRINT ? JSB WRITE JMP WDRQS,I .AND RETURN * QMRKA DEF QMARK QMARK ASC 1,?_ * * ******************** * * ** EXECUTE TRAP ** * * ******************** * ETRAP NOP RSS SKIP ERROR MESSAGE IF NOT BUSY JSB ERROR TRAP TABLE BUSY TERR4 EQU * JSB FETCH GET TRAP # JSB IFIX MAKE INTEGER CMA,INA MAKE NEGATIVE STA TEMP4 SAVE IT LDB TEMPS ADB .2 SKIP OVER 'GOSUB' AND FLAG LDA 1,I GET SEQ NO. STA TEMP5 SAVE IT SSA POSITIVE? CMA,INA NO, MAKE IT SO JSB FNDPS MAKE SURE JMP XEC5-1 STATEMENT JMP XEC5-1 EXISTS LDB TEMP5 GET SEQ NO. LDA TEMP4 GET TRAP NO. JSB TRAP SET UP TRAP VS. SEQ NO. TRERR RSS TRAP ERROR JMP XEC4 CPA .1 TRAP TABLE FULL? JSB ERROR YES! TERR1 CPA .2 ILLEGAL TRAP COMBINATION? JSB ERROR YES! TERR2 JSB ERROR NO, MUST BE SCHEDULED BUT DELETED TASKED TERR3 EQU * SKP ********************* * * ** EXECUTE GOSUB ** * * ********************* * EGOSB CCA SET FLAG TO EGOS0 STA RFLAG 'GOSUB' MODE LDA 1,I INB SIMPLE BRANCH AND OPDMK STATEMENT? CPA INTFL JMP EGOS1 YES! JSB FETCH NO, COMPUTE JSB SBFIX BRANCH INDEX JMP XEC4 UNSUITABLE RESULT LDB 0 BLS COMPUTE ADB TEMPS 'ADDRESS' ADB .2 ADDRESS LDA 1 CMA WITHIN ADA PRADD STATEMENT RANGE SSA JMP XEC4 NO! EGOS1 LDA 1,I YES, LOADR BRANCH ADDRESS ISZ RFLAG 'GOTO' MODE? JMP EGOS3 YES LDB NXTST LOAD (B) WITH EGOS2 STA NXTST RETURN SEQUENCE NUMBER JSB SLWST STACK RETURN ON LOW-CORE STACK ADA M21 GOSUBS NESTED 20 DEEP? CPA LSTAK JSB ERROR YES! E2 JMP XEC4 NO! EGOS3 STA NXTST SAVE STMT # JMP XEC4 EXECUTE IT * * *********************** * * ** EXECUTE RESTORE ** * * *********************** * ERSTR LDA TEMPS,I CHECK TO SEE ISZ TEMPS IF THERE IS ANY LDB DSTRT DATA STATEMENTS CPB M1 IMPOSSIBLE ADDRESS? JMP XEC4 YES, SO IGNORE IT SSA,RSS FOLLOWED BY SEQ NUMBER JMP E7 NO! LDA TEMPS,I YES, SO USE IT JSB FNDPS CONVERT THE NOP TO ABSOLUTE CORE ADDRESS JMP XEC5-1 UNDEFINED STATEMENT REFERENCED LDA 1 FOUND A STATEMENT ADA .2 NOW CHECK TO LDA 0,I SEE IF AND OPMSK THIS IS CPA DATOP A DATA STATEMENTNT RSS YES IT IS! JSB ERROR NO, NOT A DATA STMNT E7 JSB SETDP SET DATA POINTERS JMP XEC4 DONE * ** *** EXECUTE A BINARY OPERATOR ** ** BINOP NOP JSB OPCHK VALIDATE TOP (SECOND) OPERAND LDA BINOP INA STB 0,I POST ITS ADDRESS ISZ HSTPT UNSTACK ADDRESS JSB STTOP LOAD & VALIDATE FIRST OPERAND JMP BINOP,I * ** *** EVALUATE FORMULA AND RETURN RESULT ** ** FETCH NOP JSB FORMX EVALUATE FORMULA JSB OPCHK ISZ HSTPT UNSTACK RESULT ADDRESS DLD 1,I LOAD (A&B) WITH VALUE JMP FETCH,I EXIT SKP ******************************** * * ** EXECUTE SUBSCRIPT COMMA ** * * ******************************** ESCMA JSB ESBS INTEGERIZE COLUMN SUBSCRIPT ISZ LSTPT JSB ESBS INTEGERIZE ROW SUBSCRIPT LDB HSTPT,I SSB STRING VARIABLE? JMP ESCM2 YES! ADB .2 FETCH SUBSCRIPT LDA 1,I BOUNDS AND B377 EXTRACT STA OUTLN COLUMN BOUND LDA 1,I EXTRACT ALF,ALF ROW AND B377 BOUND CMA,INA ACTUAL ADA LSTPT,I ROW SUBSCRIPT SSA,RSS LEGAL? JMP E6-1 NO. ERROR 49. LDA LSTPT,I CLB,INB CPB OUTLN COLUMN MATRIX? JMP ESCM1 YES. MPY OUTLN NO, COMPUTE ADDRESS * DISPLACEMENT DUE TO ROWS ESCM1 CCB UNSTACK ADB LSTPT ROW STB LSTPT SUBSCRIPT LDB OUTLN ACTUAL CMB,INB COLUMN ADB LSTPT,I SUBSCRIPT SSB,RSS LEGAL? JSB ERROR NO. ERROR 49. E6 ADA LSTPT,I YES, ADD IN COLUMN DISPLACEMENT ALS DOUBLE DISPLACEMENT LDB HSTPT,I COMPUTE ADA 1,I ACTUAL STA HSTPT,I ADDRESS STB TEMP7 AND SAVE BASE FOR ECALL CCB ADB LSTPT UNSTACK STB LSTPT * JMP FORM1 GO TO FORMULA PROCESSOR * ESCM2 JSB RSCHK PUT STRING LDB M2 SUBSCRIPTS ADB LSTPT ON STB LSTPT TEMPORARY INB STACK DLD 1,I RRR 16 CORRECT ORDER DST TSTPT,I OF SUBSCRIPTS JMP FORM1 SKP ** *** INTEGERIZE A SUBSCRIPT ** ** ESBS NOP JSB OPCHK VALIDATE SUBSCRIPT DLD 1,I FETCH SUBSCRIPT JSB .IENT INTEGER? JMP E6-1 NO. ERROR 49. SEZ,RSS YES, ROUND AND ADA M1 BIAS BY -1 SSA POSITIVE INTEGER? JMP EBS1 CHECK FOR NEG SUBSCRIPT ERROR EBS2 STA LSTPT,I SAVE IN OPERATOR STACK ISZ HSTPT POP OPERAND STACK JMP ESBS,I EBS1 LDB HSTPT IS THIS ADB .2 A STRING LDB 1,I VARIABLE? SSB,RSS JMP E6-1 NO, ERROR NEG SUBSCRIPT! CPA M1 IF STRING -1 JMP EBS2 IS OK JMP E6-1 EVERY OTHER NEG VALUE BAD ** *** EXECUTE STORE ** ** ESTR LDB TEM10 IS NEXT OPERATOR SZB AN END-OF-FORMULA? JMP FOR10 NO, DEFER STORE CPB TEMP5 YES, FIRST STORE OPERATOR USED? JMP ESTR2 YES ESTR1 LDA HSTPT,I SET STA TEMP8 DESTINATION LDA TEMP5 SOURCE ADDRESS IN (A) LDB 0,I TRANSFER HIGH STB TEMP8,I PART OF SOURCE STB EFMT ISZ TEMP8 UPDATE INA POINTERS LDB 0,I TRANSFER LOW STB TEMP8,I PART OF SOURCE STB NFMT ISZ HSTPT POP STACK JMP FOR11 RETURN TO FORMULA ÿÿOCESSOR * ESTR2 LDA HSTPT,I STRING OPERANDS SSA JMP ESTR3 YES! JSB OPCHK SAVE ADDRESS STB TEMP5 OF QUANTITY ISZ HSTPT POP HIGH-CORE JMP ESTR1 STACK AND EXECUTE STORE * ESTR3 LDA M2 PREPARE JSB PSTR SOURCE STA TEMP8 STRING STB TPRME CCA PREPARE JSB PSTR DESTINATION STRING LDB PBPTR SAVE CORE POINTER STB EST1 LDA TEMP8 TRANSFER CMA TO ADA TEMP5 HIGHER SSA CORE? JMP ESTR4 NO ADA TPRME YES ADA .2 OVERLAPPING SSA,RSS TRANSFER? JMP ESTR4 NO LDA TEMP5 YES, SAVE STA EST2 DESTINATION ADDRESS INB SET DESTINATION BLS ADDRESS TO START STB TEMP5 OF FREE CORE LDA TNULL SAVE TRANSFER STA EST3 LENGTH CMA,INA ALLOCATE ARS SPACE FOR JSB OVCHK INTERMEDIATE LDA FSCHA STRING JSB TRSTR TRANSFER STRING TO FREE CORE LDA EST3 RESTORE TRANSFER STA TNULL LENGTH STA TPRME RESET ACTUAL SOURCE LENGTH LDA EST1 SET SOURCE INA ADDRESS TO ALS INTERMEDIATE STA TEMP8 STRING LDA EST2 RESTORE ORIGINAL STA TEMP5 DESTINATION STRING ESTR4 LDA FSCHA JSB TRSTR COMPLETE TRANSFER LDA EST1 RESTORE FREE STA PBPTR CORE POINTER JMP FORM9 EXECUTE END-OF-FORMULA ISZ PBPTR DEFER ISZ PBPTR EXECUTION LDA BASSO GUARANTEE ASSIGNMENT STA PBPTR,I OPERATOR ON STACK JMP FORM4+6 * BASSO OCT 7402 EST1 BSS 1 EST2 BSS 1 EST3 BSS 1 TNULL BSS 1 TPRME BSS 1 CP0 BSS 1 CP1 BSS 1 SKP ***************** * * *** CALL ADD ** * * ***************** * EFAD JSB BINOP JSB .FAD NOP JMP FORM0 ********************** * * ** CALL SUBTRACT ** * * ********************** * EFSB JSB BINOP GET OPERAND DIFFERENCE JSB .FSB NOP JMP FORM0 ********************** * * ** CALL MULTIPLY ** * * ********************** * EFMP JSB BINOP JSB .FMP NOP JMP FORM0 ********************** * * ** CALL DIVIDE ** * * ********************** * EFDV JSB BINOP JSB .FDV NOP JMP FORM0 SKP ********************** * * ** EXECUTE ^ ** * * ********************** * EPWR JSB BINOP EVALUATE ARGUMENTS JMP *+2 EPWRA NOP ADDRESS OF POWER STA UTEMP SAVE BASE STB UTEMP+1 SZA BASE ZERO? JMP PCHK1 NO LDA EPWRA,I BASE ZERO; SZA,RSS IS POWER ZERO? JSB ERROR YES! POWER SSA,RSS NO; POWER POSITIVE? JMP FALSE YES, RETURN ZERO JSB ERROR NO. ERROR 70. ZRTNG LDA INF USE POSITIVE LDB M2 INFINITY JMP FORM0 * PCHK1 DLD EPWRA,I FETCH POWER JSB .IENT INTEGERIZE JMP EPWR1 OVERFLOW SOS BITS LOST ? JMP EPWR1 NO, IS INTEGER. LDA UTEMP REAL POWER. FETCH BASE LDB UTEMP+1 SSA NEGATIVE BASE? JSB ERROR YES. ERROR 51. BASER EQU * JSB ALOG TAKE NATURAL LOG OF BASE JSB ERROR LOG ERROR LOGER JSB .FMP MULTIPLY BY POWER DEF EPWRA,I JSB EXP EXPONENTIATE JSB ERROR EXP ERROR EXPER JMP FORM0 * EPWR1 STA TT1 INTEGER; CALC BY MULTIPLICATION. LDB HONE INITIALIZE RESULT TO 1.0 STB TT3 LDB .2 STB TT4 SSA CMA,INA TAKE ABSOLUTE VALUE IPWR1 SLA,RSS TEST (SHIFTED) POWER JMP IPWR3 WAS EVEN. STA TT2 LDA UTEMP LOAD BASE LDB UTEMP+1 JSB .FMP MULTIPLY RESULT-SO-FAR DEF TT3 STA TT3 SAVE PARTIAL STB TT4 RESULT LDA TT2 IPWR3 ARS STA TT2 SZA,RSS DONE? JMP IPWR4 YES. LDA UTEMP LOAD BASE LDB UTEMP+1 JSB .FMP SQUARE IT DEF UTEMP STA UTEMP STB UTEMP+1 LDA TT2 JMP IPWR1 * IPWR4 LDA TT1 GET ORIGINAL POWER SSA POSITIVE POWER? JMP IPWR5 NEGATIVE. RETURN RECIPROCAL. LDA TT3 YES,LOAD LDB TT4 RESULT JMP FORM0 * IPWR5 LDA HONE LOAD LDB .2 1.0 JSB .FDV DIVIDE BY RESULT DEF TT3 JMP FORM0 RETURN RESULT * * ****************** * * ** EXECUTE <= ** * * ****************** ** ELORE JSB COMPR COMPARE OPERANDS SSA < ? JMP TRUE NO! JMP EEQL+1 YES! ** SKP ***************** * * ** EXECUTE = ** * * ***************** ** EEQL JSB COMPR COMPARE OPERANDS EEQL1 SZA EQUAL? JMP FALSE NO! JMP TRUE YES! ** ***************** * * ** EXECUTE # ** * * ***************** ** ENEQL JSB COMPR COMPARE OPERANDS ENEQ1 SZA NOT EQUAL? JMP TRUE NO! JMP FALSE YES! ** ***************** * * ** EXECUTE > ** * * ***************** ** EGTRT JSB COMPR COMPARE OPERANDS SSA < ? JMP FALSE YES! JMP ENEQL+1 NO! ** ***************** * * ** EXECUTE < ** * * ***************** ** ELST JSB COMPR COMPARE OPERANDS CMA,RSS ** ****************** * * ** EXECUTE >= ** * * ****************** ** EGORE JSB COMPR COMAPARE OPERANDS SSA < ? JMP FALSE YES! JMP TRUE NO! ** FALSE CLA LOAD CLB ZERO JMP FORM0 ** *** EXECUTE UNARY - ** ** EUMIN JSB STTOP LOAD NUMBER JSB ..FCM NEGATE IT JMP FORM0 ** *** EXECUTE LEFT BRACKET ** ** ELBRC ISZ LSTPT LOAD SUBSCRIPT COMMA LDB SCCNT INFORMATION WORD JSB SLWST STACK IT JSB BHSTP BUMP STACK JSB RSCHK LDA HSTPT IS THIS ADA .2 A STRING LDA 0,I VARIABLE? SSA JMP ELB1 YES TRUE LDA HONE NO,ARRAY SO LDB .2 LOAD DEFAULT 0 JMP FORM0 ELB1 CLA SET DEFAULT CLB SUBSCRIPT TO BE JMP FORM0 FINALLY -1 SKP * *********************************** * * * COMPARE TOP OPERANDS ON STACK * * * *********************************** * * ON EXIT (A) IS NEGATIVE IF THE TOP OPERAND OF THE * STACK IS GREATER THAN THE NEXT-TO-TOP OPERAND AND * POSITIVE IF IT IS LESS, AND ZERO IF THEY ARE EQUAL. * COMPR NOP LDA HSTPT,I STRING SSA ARGUMENTS? JMP COMP1 YES! JSB BINOP NO, COMPARE JSB .FSB NUMERICAL NOP JMP COMPR,I OPERANDS SPC 1 COMP1 LDA M2 PREPARE JSB PSTR COMPARISON STA TEMP8 STRING STB TPRME LDA TNULL SAVE SPECIFIED STA CP0 LENGTH LDA M2 PREPARE JSB PSTR TEST STRING STB CP1 SAVE ACTUAL LENGTH ISZ TSTPT RESERVE SPACE ISZ TSTPT FOR RESULT JSB BHSTP BUMP HI STACK COMP2 ISZ CP0 MORE SPECIFIED STRING JMP COMP3 YES! CLB NO, LOAD A NULL JMP COMP4 CHARACTER COMP3 JSB FSCH LOAD NEXT LDA B40 COMPARISON LDB 0 CHARACTER COMP4 ISZ TNULL MORE SPECIFIED TEST STRING? JMP COMP6 YES! CLA NO, LOAD NULL CHARACTER COMP5 CMB,INB COMPARE ADA 1 CHARACTERS SZA,RSS EXIT ON NOT EQUAL SZB,RSS OR BOTH NULL JMP COMPR,I CHARACTERS JMP COMP2 COMP6 LDA CP1 MORE ACTUAL INA,SZA TEST STRING? JMP COMP7 YES! LDA B40 NO, LOAD A BLANK JMP COMP5 COMP7 STA CP1 LDA TEMP5 EXTRACT CLE,ERA LDA 0,I NEXT SEZ,RSS ALF,ALF TEST AND B377 ISZ TEMP5 CHARACTER JMP COMP5 * * ** ************************** * * *** FETCH A DATA ITEM ** * * ************************** * * UPON ENTRY (B)=1 IF NUMBER IS REQUESTED OR (B)=2 IF A * STRING IS REQUESTED. TYPE MATCH IS CHECKED. NUMBERS RETURN * IN (A) AND (B) STRINGS ARE PREPARED A SOURCE STRINGS. * FDATA FILLS FROM A FILE IF ONE IS REFERENCED BY THE CALLER. * FDATA MOVES TO NEW FILE RECORDS OR AS NECESSARY. * ** FDATA NOP STB TEMP8 SAVE DATA TYPE FDAT1 ISZ DCCNT MORE DATA? JMP FDAT2 YES LDA DATA NO, SEARCH LDB NXTDT FOR NEXT JSB STSRH DATA STATEMENT JSB ERROR NONE FOUND. ERROR 56 E4 JSB SETDP INITIALIZE THE JMP FDAT1 DATA POINTERS * FDAT2 LDB TEMP8 RESTORE TYPE ISZ DCCNT UPDATE LDA NXTDT,I POINTER ISZ NXTDT CORRECT RBR TYPE XOR 1 OF DATA? SSA JSB ERROR NO! E5 SSB,RSS YES, STRING? JMP FDAT3 YES! DLD NXTDT,I LOAD ISZ NXTDT DATA ISZ NXTDT UPDATE POINTER ISZ DCCNT AND COUNTER JMP FDATA,I FDAT7 LDA 1,I LOAD STRING HEADER INB SET CLE,ELB SOURCE STB TEMP8 ADDRESS CLE,ERB AND B377 SET CMA TRANSFER STA TPRME LENGTH CMA,INA ADJUST ARS RECORD ADB 0 PAST STB TEMP3,I STRING JMP FDATA,I FDAT3 LDA NXTDT,I SET ISZ NXTDT LDB NXTDT START-OF-STRING RBL CHARACTER STB TEMP8 ADDRESS AND B377 SET CMA TRANSFER STRING STA TPRME LENGTH CMA,INA UPDATE ARS LDB 0 ADA NXTDT DATA STA NXTDT ADB DCCNT STB DCCNT POINTERS JMP FDATA,I SKP ** *** SET FOR FOLLOWING STATEMENT ** ** FLWST NOP (B) HOLDS PRESENT ADDRESS LDA 1 COMPUTE INA ADDRESS LDA 0,I OF ADA 1 NEXT STA PRADD STATEMENT CPA PBPTR END OF PROGRAM? CLA,RSS YES, SET LINE NO. TO 0 LDA 0,I RECORD THE STA NXTST SEQUENCE NUMBER ADB .2 FETCH STB TEMPS FIRST WORD LDA 1,I OF CURRENT JMP FLWST,I STATEMENT * *** SEARCH STACK FOR GIVEN FOR-VARIABLE ** ** FVSRH NOP LDA TEMPS,I FETCH AND B777 FOR-VARIABLE STA ETAB SAVE FOR-VARIABLE JSB SSYMT FIND ADDRESS IN INB SYMBOL TABLE LDA HSTPT SAVE STA TEMP3 STACK TOP FVSR1 CPA SYMTF STACK BOTTOM? JMP FVSRH,I YES, EXIT VIA (P+1) CPB 0,I MATCHING FOR-VARIABLE? JMP FVSR2 YES ADA .6 NO, MOVE TO JMP FVSR1 NEXT STACK ENTRY * FVSR2 ISZ FVSRH EXIT JMP FVSRH,I VIA (P+2) SKP * * * ******************* * * * EXECUTE PAUSE * * * ******************* * EPAZ LDA .2 GO TO RSS SEGMENT 8 * * ********************** * * * EXECUTE END/STOP * * * ********************** * EEND LDA .3 GO TO RSS SEGMENT 8 SKP * * ******************************** * * * EXECUTE OPERATOR ATTENTION * * * ******************************** * OPEND LDA .4 GO TO CLB SEGMENT 8 STB TEMP3 CLEARING ERROR FLAG * * SEG8 STA SLSTM SET SLOW STATEMENT FLAG JSB BASC8 PULL JMP XEC4 .EXECUTE NEXT STATEMENT * .4 DEC 4 SKP ******************** * * * EXECUTE CALL * * * ******************** * * * THE GENERAL FLOW THRU ECALL IS AS FOLLOWS: * * 1. CONTROL IS PASSED TO ECALL OR FCALL WHEN A * CALL OR FORTRAN FUNCTION IS FOUND RESPECTIVELY. * * 2. IF IT IS A CALL THEN THE SIMULATE FLAG IS CHECKED * AND IF SET CONTROL IS PASSED TO SEGMENT 7 TO SIMULATE * THE CALL STATEMENT. * * 3. THEN THE PARAMETERS OF THE CALL ARE STACKED ONE BY ONE * ON THE HIGH STACK. EACH PARAMETER IS A THREE WORD ENTRY. * THE DESCRIPTOR TRIPLET HAS THE FOLLOWING FORM, DEPENDING ON * THE PARAMETER TYPE DISCOVERED BY ECALL: * * SIMPLE VARIABLES ARRAYS STRINGS * ---------------------------------------------------------- * HSTPT+2 ! ARGUMENT POINTER ! ELEMENT POINTER ! -BASE ADDRESS - 1 ! * !----------------------------------------------------------! * HSTPT+1 ! ARGUMENT POINTER ! ARRAY BASE PTR ! CHARACTER ADDRESS ! * !----------------------------------------------------------! * HSTPT ! 2:REAL / 1:INTG ! ARRAY SIZE (WDS)! -STRG LNGTH (CHAR)! * ---------------------------------------------------------- * * 4. FOR FORTRAN FUNCTIONS THE SAME THINGS ARE DONE FOR * PARAMETERS BUT THE CALL # AND PARAMETER COUNT FROM THE * INTERPRETIVE CODE IS STACKED ON THE LOW STACK. DURING * EXECUTION OF THE STATEMENT THE INTERMEDIATE RESULTS ARE * STACKED ON THE TEMPORARY STACK AND POPPED OFF AS REQUIRED. * * 5. AFTER SCANNING THE LIST, THE * PARAM CT. IS PUT ON THE HIGH STACK. AT THIS TIME THE * HIGH STACK CONTAINS THE PARAMETER COUNT AND THREE WORD ENTRIES * FOR EACH OF THE PARAMETERS ALL IN REVERSE ORDER ON THE HIGH * STACK. I.E. LAST PARAMETER ON TOP. * * 6. NEXT THE SUBROUTINE NUMBER IS USED TO FIND THE * CORRECT BRANCH TABLE ENTRY AND THE CONTROL WORD AND * PARAMETER CONVERSION WORDS ARE RETRIEVED FROM THE TABLE. * FROM THE CONTROL WORD, THE NAME OF THE OVERLAY IS BUILT, * AND THE SUBROUTINE NUMBER IS SAVED FOR THE OVERLAY. SKP * 7. THEN THE PARAMETERS ARE WRITTEN OUT TO SYSTEM AVAILABLE * MEMORY WITH CLASS I/O. THE FIRST RECORD WRITTEN IS THE HIGH * STACK WHICH IS USED BY THE OVERLAY AS A PARAMETER DESCRIPTION. * THEN EACH PARAMETER IS WRITTEN OUT, ACCORDING TO THE TABLE * ON THE NEXT PAGE. * * 8. THE OVERLAY IS THEN SCHEDULED. THE OVERLAY READS IN * ALL PARAMETERS FROM SYSTEM AVAILABLE MEMORY, BUILDS * A SUBROUTINE CALL PARAMETER ADDRESS LIST, INTEGERIZES AS * REQUIRED, AND TRANSFERS CONTROL TO THE SUBROUTINE * SPECIFIED BY THE BRANCH TABLE CONTROL WORD. * * 9. UPON COMPLETION OF THE SUBROUTINE THE PARAMETERS ARE * RECONVERTED AS REQUIRED, AND WRITTEN OUT USING * CLASS I/O TO SYSTEM AVAILABLE MEMORY. * CONTROL IS THEN RETURNED TO BASIC AND * THE PARAMETERS ARE READ IN FROM SYSTEM AVAILABLE MEMORY * AND PLACED BACK INTO THEIR RESPECTIVE PLACES, IF THE * RETURNED VALUE FLAG IS SET FOR THAT PARAMETER, AND IF * THE SUBROUTINE RETURNED NO ERROR FLAG. * * 10. CONTROL IS THEN PASSED TO THE NEXT STATEMENT FOR CALLS, AND * BACK INTO THE FORMX ROUTINE FOR FORTRAN FUNCTIONS, UNLESS * AN ERROR OCCURRED. * * ERROR CONDITIONS FROM THE OVERLAY ARE ALWAYS FATAL FOR * FORTRAN FUNCTIONS, AND ARE FATAL FOR CALLS UNLESS * THE BASIC PROGRAM LINE CONTAINS A "FAIL:" STATEMENT. * FOREGROUND/BACKGROUND COMMUNICATION ERRORS AND * OVERLAY ABORT ERRORS ARE ALWAYS FATAL. SKP * THIS TABLE DESCRIBES THE ACTION OF ECALL IN TRANSFERRING * ARGUMENTS FROM THE PARAMETER LIST SPECIFIED IN THE BASIC * PROGRAM TO THE OVERLAY ROUTINE IN THE FOREGROUND. * * THE ACTION TAKEN BY THE INTERPRETER DEPENDS ON THE CONTENTS * OF THREE PARAMETER CONVERSION WORDS OBTAINED FROM THE * BRANCH TABLE, SPECIFYING THE ATTRIBUTES OF THE ARGUMENTS * EXPECTED BY THE OVERLAY ROUTINE: * WORD 0 -- ROUTINE CONTROL WORD * WORD 1 -- ARRAY IDENTIFIER WORD * WORD 2 -- RETURNED VALUE WORD * WORD 3 -- INTEGER CONVERSION WORD * * * FORMAL * ARGUMENT : ARRAY/SIMPLE RETURN/NO INTEGER/REAL * ACTUAL !--------------------------------------------------------! * ARGUMENT: ! ! ! FIX ON CALL ! * SIMPLE ! PASS VARIABLE ! SAVE RETURN ! AND ! * VARIABLE ! ! IF BIT = 1 ! FLOAT ON RETURN ! * !--------------------------------------------------------! * ! PASS ARRAY IF 1 ! PASS VALUE(S) ! FIX ALL VALUES ! * ARRAY ! WITH POINTER TO ! SAVE RETURN(S)! AND ! * VARIABLE ! GIVEN ELEMENT ! IF BIT = 1 ! FLOAT ON RETURN ! * ! PASS ELEMENT IF 0 ! ! ! * !--------------------------------------------------------! * ! PASS STRING OR ! ! \ / ! * STRING ! SUBSTRING IF 1 ! SAVE STRING ! \/ ! * VARIABLE ! PASS 2 CHARACTERS ! OR SUBSTRING ! /\ ! * ! IF 0 ! IF 1 ! / \ ! * !--------------------------------------------------------! * ! PASS STRING OR ! SYNTAX ERROR ! \ / ! * STRING ! SUBSTRING IF 1 ! IF BIT = 1 ! \/ ! * CONSTANT ! PASS 2 CHARACTERS ! PASS ONLY IF 0 ! /\ ! * ! ! ! / \ ! * !--------------------------------------------------------! * ! ! SYNTAX ERROR ! FIX ON CALL ! * SIMPLE ! PASS CONSTANT ! IF BIT =1 ! AND ! * CONSTANT ! ! PASS ONLY IF 0 ! FLOAT ON RETURN ! * ! ! ! IF BIT = 1 ! * !--------------------------------------------------------! * ! SYNTAX ERROR ! ! ! * REAL ! IF BIT = 1 ! SYNTAX ERROR ! FIX VALUE ! * EXPRESSION ! PASS VALUE IF ! IF BIT = 1 ! ON CALL ! * ! BIT = 0 ! ! ! * !--------------------------------------------------------! SKP * ECALL JSB BHSTP CLA .RESET ERRCD BEFORE CALL STA ERRCD FCALL LDA FORMX SAVE RETURN STA HSTPT,I FROM FORMX JSB CALL0 .INITIALIZE FOR THE CALL LDB TEMPS,I STACK CALL ID WORD JSB SLWST ON LOW STACK LDA B AND B777 .CALCULATE THE ADDRESS OF ALS,ALS . BRANCH TABLE ENTRY ADA FWAMB STA TMPC6 . AND SAVE LDB A,I STB SUBLC INA LDB A,I .FETCH ARRAY FLAG WORD STB TMPC1 . AND SAVE ADA .2 .BUMP TO CONVERT FLAG WORD LDB A,I . AND SAVE STB TMPC2 CLB JSB SLWST INIT ARGUMENT CNTR INB & STB STRFG STRING FLAG CALL2 ISZ TEMPS FETCH NEXT CALL3 LDA TEMPS,I INTERPRETIVE WORD SZA,RSS NULL? JMP CBKSP YES,BACK UP 1 CPA LFPAR SUBCRIPTED VARIABLE? JMP CBKSP YES, BACK UP TO OPND-ID AND OPMSK CPA B4000 RIGHT PARENTHESIS? JMP CALL5 YES, END OF LIST JSB FORMX EVALUATE ARGUMENT * LDA HSTPT,I FETCH ARGUMENT ADDRESS SSA STRING? JMP STVAL YES CMA NO, CHECK FOR ARRAY LDB PBPTR LOW END OF ARRAY STORAGE ADB 0 SSB,RSS ABOVE? JMP CSVAL NO,MUST BE CONSTANT LDB FCORE HIGH END OF ARRAY STORAGE ADB M2 DECREMENT FOR 1'S COMP -1 ADB 0 SSB ABOVE? JMP COVAL .YES-MUST BE INTERMED.,COM OR VARIABLE COVAR LDB TEMP7,I NO,FETCH ARRAY BASE ADDR FROM SYMBOL TBL. ISZ TEMP7 POINT TO ARRAY SIZE LDA TEMP7,I FETCH ARRAY SIZE STB TEMP7 SAVE BASE ADDR TEMPORY CLB MULTIPLY RRR 8 COLUMN * BLF,BLF ROW STB TEMP3 TO CALCULATE MPY TEMP3 ARRAY SIZE. RRR 15 CONVERT SIZE TO WORDS IN B LDA TEMP7 FETCH BASE ADDR JMP CSVPT PUT BASE ADDR & SIZE ON HISTK. * COVAL LDB SYMTA .IS THE POINTER TO A ADB M1 . COMMON VARIABLE ? ADB 0 SSB JMP COVAR .YES * CSVAL CMA BACK TO ADDRESS LDB .2 LENGTH =2 CSVPT STB TEMP3 SAVE SIZE TEMPORARY JSB BHSTP STA HSTPT,I SAVE BASE OR CHAR ADDR JSB BHSTP LDA TEMP3 SAVE LENGTH STA HSTPT,I +=WORDS, -=CHARS ISZ LSTPT,I ADD TO ARG COUNT JSB DOPRM .PROCESS THIS PARAMETER JMP CALL2 CHECK FOR MORE * STVAL LDA M2 SOURCE STRING FLAG JSB PSTR PREPARE STRING. RTN A=ADDR, B=LENGTH SWP EXCHANGE REGS CMA STA TEMP7 SAVE ACTUAL STRING LEN LDA TEMP6,I GET ARRAY DIMENSION AND HIMSK AND ADA TEMP7 STUFF IN ACTUAL LENGTH CMA,INA AND SAVE STA TEMP3 LOGICAL-PHYSICAL LENGTH (2'S COMPLMT) SWP JSB BHSTP UNDO STACK BUMP FROM PSTR JMP CSVPT+1 SAVE IT ALL ON HISTK * CBKSP LDB TEMPS BACK UP ADB M1 TO LAST STB TEMPS INTERPRETIVE JMP CALL3 WORD * * END OF ARGUMENT SCAN * B4000 OCT 4000 LFPAR OCT 122000 SKP * * INITIALIZE ROUTINE * CALL0 NOP LDA ADPRM INA STA TMPC2 .ZERO ALL PARAMETER POINTERS STA RTNAD .SET RETURN ADDRESS LDA M15 CLB STB TMPC2,I ISZ TMPC2 INA,SZA .DONE ? JMP *-3 . NO DO ALL 15 JMP CALL0,I ************************************** * * DUMMY CALL AREA * THIS ROUTINE IS CONFIGURED FOR THE * ACTUAL SUBROUTINE CALL * ************************************** * SUBCL NOP JSB SUBLC,I RTNAD DEF *+16 PRAM DEF * REP 14 DEF * JMP SUBCL,I * SUBLC DEF * LCPRM DEF * .LOCAL STORAGE FOR INTEGER IPRAM BSS 15 . ADPRM DEF PRAM-1 TMPC1 NOP .ARRAY FLAGS TMPC7 NOP .RETURN FLAGS TMPC2 NOP .CONVERT FLAGS NOP .PLACE HOLDER TMPC3 NOP .# PARAMETERS TMPC4 NOP .CALL I.D. ARRAY ADDRESS RTN TMPC5 NOP .# ELEMENTS IN INTEGER ARRAY TMPC6 NOP .ADDRESS OF BRANCH TABLE TMPC8 NOP .REAL ARRAY ADDRESS ARRAD EQU TMPC7 ABREG BSS 2 RRL16 OCT 100100 SKP * ********************************************** * * ROUTINE TO CONAFIGURE ROUTINE CALL * * LOWSTACK = # OF PARAMETERS * LOWSTACK-1 = CALL I.D. * HIGHSTACK HAS THREE WORD PARAMETER DESCRIPTOR * ********************************************** * DOPRM NOP LDA TMPC2 SLA .CONVERT TO INTEGER ? JSB ICONV .YES - DO IT JSB CDEF .NO - FIX PARAMETER ADDRESS IN CALL * LDA TMPC1 LDB TMPC2 RRR 1 .POSITION FOR NEXT PARAMETER STA TMPC1 STB TMPC2 ISZ RTNAD .BUMP RETURN ADDRESS JMP DOPRM,I .EXIT * * CDEF NOP LDA HSTPT,I .FETCH PARAMETER TYPE SSA .REAL / INTEGER / ARRAY ? JMP STRNG .NO - IT'S A STRING CPA .1 .INTEGER ? JMP INT .YES CPA .2 .REAL VARIABLE ? JMP REAL .YES LDA HSTPT .IT IS AN ARRAY ADA .2 .MOVE TO ARRAY ADDRESS LDA A,I . AND FETCH IT CDEF2 LDB TMPC2 .AN INTEGER ARRAY ? SLB LDA ARRAD .YES INCERT PROPER ADDRESS CDEF1 LDB ADPRM ADB LSTPT,I .INCREMENT TO PARAM POSITION STA B,I .STUFF PARAM ADDRESS JMP CDEF,I * INT LDA LCPRM ADA LSTPT,I .CALCULATE INTEGER STORE JMP CDEF1 * REAL LDA HSTPT INA LDA A,I .FETCH PARAMETER ADDRESS JMP CDEF2 * STRNG JSB ULWST .POP LOW STACK AND SAVE STB TMPC3 . # PRAM JSB ULWST . AND CALL ID STB TMPC4 LDA LSTPT .COMPUTE STRING PARAMETER ADDRESS INA STA ARRAD .SAVE FOR INCLUSION IN SUB CALL LDA HSTPT ADA .2 .FETCH BASE ADDRESS AND LDA A,I . DETERMINE IF STRING CONSTANT ADA PBPTR SSA .CONSTANT ? JMP STRG1 .NO CONTINUE LDA HSTPT,I .FETCH LENGTH AND " CODE AND B377 .ELIMINATE " CODE STA B ALF,ALF .MOVE LENGTH TO UPPER BYTE ADA B .REINSERT LENGTH STA HSTPT,I .UPDATE HIGH STACK STRG1 LDA HSTPT,I ALF,ALF .POSITION PHYSICAL SIZE IOR LBYTE .FILL UPPER BITS CMA,INA .NEGATE STA STRLG .SAVE FOR MOVE BYTES LDA HSTPT,I .COMPUTE LOGICAL LENGTH CMA,INA AND B377 STA B .PUT ON LOW STACK JSB SLWST LDA HSTPT .FIND BYTE ADDRESS OF STRING INA LDA A,I STA STRPT .SAVE FOR MOVE BYTES CALL LDB LSTPT .COMPUTE BYTE ADDRESS IN LOWSTACK CLE,INB ELB STB SSTR . AND SAVE TEMP JSB .MBT . MOVE STRING DEF STRLG NOP CLE,ERB .COMPUTE NEW LOWSTACK ADDRESS SEZ INB STB LSTPT . AND SAVE CMB,INB .CHECK FOR STACK OVERFLOW ADB HSTPT SSB .OVERFLOW ? JMP E1 .YES LDB STRPT .PLACE BYTE ADDRESS OF STRING ON JSB SLWST . LOWSTACK LDB SSTR .ALSO PLACE BYTE ADDRESS OF STRING JSB SLWST . IN THE LOWSTACK LDB STRLG .ALSO THE STRING LENGTH IN LOW STACK JSB SLWST LDB TMPC4 .REPLACE CALL ID JSB SLWST LDB TMPC3 .REPLACE #PRAM JSB SLWST JMP CDEF1-1 .SET CALL PARAMETER * STRLG NOP STRPT NOP SSTR NOP SKP *********************************************** * * ICONV IS THE PARAMETER CONVERT ROUTINE * FOR SUBROUTINE ENTRY * ********************************************** * ICONV NOP LDA TMPC1 SLA .ARRAY PARAMETER TYPE ? JMP ICON1 .YES LDA HSTPT .NO - FETCH THE PARAMETER ADDRESS LDB HSTPT,I .CHECK FOR ARRAY ELEMENT ADB M3 SSB,RSS INA .YES FETCH ELEMENT POINTER INA LDA A,I DLD A,I .FETCH VALUE ITSELF JSB IFIX . CONVERT TO INTEGER LDB LCPRM ADB LSTPT,I .COMPUTE ADDRESS OF TEMP STA B,I . STORE AND SAVE STB ARRAD .SAVE ADDRESS JMP ICONV,I .EXIT * ICON1 LDB HSTPT INB LDA B,I .FETCH ARRAY BASE ADDRESS INB LDB B,I .FETCH ELEMENT ADDRESS CMB,INB .NEGATE AND COMPUTE # ELEMENTS LEFT ADA B ADA HSTPT,I .COMPUTE SIZE OF PASSED ARRAY ARS . DIVIDE BY 2 = # ELEMENTS CMA,INA STA TMPC5 STA SUBCL .USE SUBCL AS TEMP/ SAVE ARRAY SIZE INA,SZA,RSS .IF REAL THEN ERROR JSB ERROR E15 JSB ULWST .POP LOW STACK AND STB TMPC3 . SAVE # PARAM JSB ULWST STB TMPC4 . AND CALL I.D. LDA LSTPT .STACK TEMPORARILY THE FIXED ARRAY INA .BUMP TO NEXT ADDRESS STA ARRAD . ON THE LOW STACK - SAVE ADDRESS LDA HSTPT ADA .2 LDA A,I .ARRAY BASE ADDRESS STA TMPC8 . AND SAVE ICON2 DLD TMPC8,I JSB IFIX LDB A JSB SLWST .STACK THIS ELEMENT ISZ TMPC8 ISZ TMPC8 .BUMP ARRAY PTR ISZ TMPC5 .DONE ? JMP ICON2 .NO LDB ARRAD .YES - STORE ARRAY LOCATION WITH JSB SLWST . ARRAY ON LOW STACK LDB SUBCL .ALSO SAVE ARRAY SIZE JSB SLWST . ON LOW STACK LDB TMPC4 .YES RESTORE # PARAM JSB SLWST LDB TMPC3 . AND CALL I.D. TO LOW STACK JSB SLWST JMP ICONV,I SKP CALL5 JSB BHSTP MAKE ROOM ON HI STACK JSB ULWST AND UNSTACK STB HSTPT,I ARGUMENT COUNT * EXECUTE SUBROUTINE JSB SUBCL * ****************************** * * SUBROUTINE RETURN PARAMETERS * HANDLING * ****************************** * DST ABREG .SAVE RETURN VALUE * LDB HSTPT,I .FETCH # PARAMETERS ISZ HSTPT . & POP STACK CMB,INB,SZB,RSS . FOR PARAMETER FLAGS JMP RTN6 . NO PARAMETERS SKIP CONVERSION STB TMPC3 ADB .16 ADB RRL16 .FORM ROTATE INSTRUCTION STB RTN1 . AND STORE STB RTN2 JSB ULWST .ELIMINATE CALL I.D. STB CALID . SAVE FOR RETURN PROCESSING LDA TMPC6 .FETCH B&M ADDRESS INA DLD A,I .FETCH ARRAY AND RETURN RTN1 RRL 1 . FLAGS DST TMPC1 .SET ARRAY & RETURN FLAGS LDA TMPC6 ADA .3 LDA A,I CLB RTN2 RRL 1 DST TMPC2 .SET INTEGER FLAG TEMP * RTN5 LDA TMPC7 .RETURN ? SSA,RSS JMP RTN8 .NO - LOOK FOR STRING UNSTACK LDA TMPC2 SSA,RSS .INTEGER ? JMP RTN8 .NO - CHECK FOR STRING LDA TMPC1 SSA,RSS .ARRAY ? JSB RTN3 .NO - RETURN INTEGER JSB RTN4 .YES - RETURN ARRAY * FIN ISZ HSTPT .UNSTACK PARAMETER DESCRIPTOR ISZ HSTPT ISZ HSTPT * ISZ TMPC3 .MORE PARAMETERS ? RSS JMP RTN6 .NO - CHECK FOR FUNCTION * DLD TMPC1 .POSITION PARAM FLAGS RRL 1 . FOR NEXT ONE DST TMPC1 LDA TMPC2 RRL 1 DST TMPC2 JMP RTN5 .PROCESS NEXT PARAMETER * RTN6 LDA CALID .FETCH CALL I.D. AND OPMSK CPA CALOP .IS IT A SUBROUTINE ? JMP RTN10 .YES LDA ERRCD .NO - A FUNCTION SZA .ANY ERROR RETURNED? JMP E15-1 . YES - FATAL FOR FUNCTIONS JSB BHSTP JSB RSCHK .MAKE ROOM FOR RESULT ON LDA TMPC6 ADA .3 .IS THIS AN INTEGER FUNCTION ? LDA A,I SSA,RSS JMP RTN11 .NO - RETURN VALUE AS RECEIVED LDA ABREG JSB FLOAT .YES - RETURN REAL VALUE JMP RTN12 RTN11 DLD ABREG . TEMP STACK RTN12 ISZ TEMPS .STEP PAST RIGHT ) JMP FOR12 .CONTINUE WITH FORMULEA * RTN10 ISZ HSTPT .POP HIGH STACK LDB ERRCD SZB,RSS .ANY ERROR RETURN ? JMP XEC4 .NO - PROCESS NEXT STATEMENT CPB MNEG .IS THIS A FATAL ERROR? JMP E15-1 .YES - ISSUE ERROR ISZ TEMPS LDB PRADD .END OF STATEMENT ? CPB TEMPS JMP E15-1 .YES - ISSUE ERROR ISZ TEMPS .NO - FAIL OPTION USED LDB TEMPS .SKIP OVER FAIL OP CODE JMP SETSX . AND PROCESS REST OF CODE * .16 DEC 16 CALID NOP CALOP OCT 50000 * * RTN8 LDA HSTPT,I . IS IT A STRING SSA,RSS JMP FIN .NO - MOVE TO NEXT PARAMETER JSB ULWST .YES - FETCH STRING DATA STB STRLG . FROM LOWSTACK JSB ULWST . :LENGTH STB SSTR . :LOWSTACK BYTE ADDRESS JSB ULWST . :STRING BYTE ADDRESS LDA SSTR .COMPUTE NEW LOWSTACK ADDRESS CLE,ERA ADA M1 STA LSTPT .AND SAVE LDA TMPC7 .CHECK FOR NO RETURN SSA,RSS JMP RTN9 .YES NO RETURN LDA SSTR .READY FOR MOVE BYTES TO STRING STORE JSB .MBT DEF STRLG NOP LDA HSTPT INA .CHECK FOR SUBSTRING RETURN LDB A,I .FETCH CHARACTER ADDRESS INA LDA A,I .COMPUTE BYTE ADDRESS OF BASE CMA,CLE STA SSTR .SAVE INA .MOVE TO FIRST CHAR BYTE ADDRESS ELA CPA B .BASE = CHAR? JMP STRUP . YES - FIX NEW LOGICAL LENGTH RTN9 JSB ULWST .NO - POP LOWSTACK JMP FIN .MOVE TO NEXT PARAMETER * STRUP JSB ULWST STB A AND B377 .FETCH RETURNED LOGICAL LENGTH STA B LDA SSTR,I .FETCH STRING LENGTH WORD AND LBYTE .REMOVE OLD LOGICAL LENGTH IOR B .MERGE AND STORE BACK STA SSTR,I JMP FIN .MOVE TO NEXT PARAMETER * LBYTE OCT 177400 * ****************************** * * RETURN INTEGER PARAMETER * ****************************** * RTN3 NOP ISZ RTN3 .SET FOR PROPER RETURN LDA TMPC3 CMA,INA ADA LCPRM .ADDRESS OF PARAMETER LDB HSTPT INB LDB B,I .FETCH ADDRESS OF VARIABLE STB TMPC4 LDA A,I .FETCH VALUE JSB FLOAT DST TMPC4,I .FLOAT & STORE JMP RTN3,I * ******************************** * * RETURN INTEGER ARRAY * ******************************** * RTN4 NOP JSB ULWST .FETCH ARRAY SIZE FROM STB TMPC5 . LOW STACK AND SAVE JSB ULWST .FETCH ARRAY LOCATION FROM LOW STB TMPC4 . STACK AND SAVE ADB M1 .COMPUTE NEW LOW STACK ADDRESS STB LSTPT . AND SET IT LDA HSTPT .COMPUTE ELEMENT ADDRESS OF REAL ADA .2 . ARRAY AND SAVE IN SUBCL AS TEMP LDA A,I STA SUBCL * RTN7 LDA TMPC4,I JSB FLOAT .CONVERT TO REAL DST SUBCL,I ISZ TMPC4 .STEP TO NEXT ELEMENT ISZ SUBCL ISZ SUBCL ISZ TMPC5 .DONE ? JMP RTN7 .NO - DO ANOTHER JMP RTN4,I .YES - EXIT SKP ****************** * * * EXECUTE WAIT * * * ****************** EWAIT NOP ISZ TEMPS POINT (TEMPS) TO FORMULA JSB FETCH FETCH EVALUATED FORMULA SSA NEGATIVE JMP XEC4 YES JSB IFIX CONVERT TO INTEGER SOC LARGE INTEGER LDA MNEG YES CMA NO STA TEMP2 SAVE COUNT (<0) ADA .74 AND CHECK FOR SSA,RSS SHORT WAIT JMP COUNT GO COUNT FOR < 75 MS CCB LDA TEMP2 DIV .10 TENS OF MILLISECONDS STA TEMP2 JSB EXEC CALL SYSTEM DEF *+6 FOR DELAY DEF .12 DEF .0 THIS PRGRM DEF .1 BY 10'S OF MS DEF .0 ONLY ONCE DEF TEMP2 FOR THIS LONG JMP XEC4 ABANDON REMAINDER(SYSTEM UNCERTAINTY) * COUNT LDA TEMP2 RECOVER COUNT EWAI1 INA,SZA,RSS WAIT? JMP XEC4 NO! LDB M280 YES SET INNER LOOP INB,SZB MORE? JMP *-1 YES! JMP EWAI1 NO! * .0 DEC 0 .12 DEC 12 .74 DEC 74 M280 DEC -280 SKP ********************** * * * EXECUTE RETURN * * * ********************** ERTRN LDB LSTPT RETURN STACK CPB LSTAK EMPTY? JSB ERROR YES. ERROR 55. E3 LDA LSTPT,I NO, LOAD RETURN ADDRESS ADB M1 RESET STB LSTPT STACK POINTER SSA,RSS IF NEGATIVE STMT NUMBER, JMP XEC43 STA 1 THIS IS RETURN FROM SCHED TASK. LDA M256 HANDLED BY SPECIAL HOOK JSB TRAP IN TRAP ROUTINE. JMP TRERR ERROR JMP XEC43 SKP * * ** EXECUTE READ ** * EREAD LDA HSTPT SAVE HI STK PTR STA HTEMP JSB VALLU .READ #,LU ? JSB EREA4 .SET NEW LUINP LDA FILE# CPA M1000 . READ FROM A DATA STMT? JMP EREA6 .YES LDA LUINP .NO - READ FROM LU AND B77 .SET EOT CONDITION TO IGNOR IOR B700 . PAPER TAPE LEADER STA EREA5 JSB EXEC DEF *+3 DEF .3 DEF EREA5 JMP EINPT .NOW READ FROM THE DEVICE * EREA5 NOP B700 OCT 700 * EREA6 LDB TEMPS EREA1 CPB PRADD JMP XEC4 JSB FORMX NO, EVALUATE NEXT ADDRESS LDA HSTPT,I RECORD ADDRESS SSA STRING VARIABLE? JMP EREA2 YES! STA OUTLN CLB,INB JSB FDATA GET DATA ITEM STA OUTLN,I STORE ISZ OUTLN DATA STB OUTLN,I ITEM ISZ HSTPT EREA3 LDB TEMPS INB JMP EREA1 EREA4 NOP STA LUINP JSB KEYBD .DETERMINE IF NEW DEVICE JMP EREA4,I . IS KEYBOARD LDA LUINP IOR B400 . IT IS SO INSERT ECHO BIT STA LUINP STA LUOUT .SET OUTPUT DEVICE FOR "?" JMP EREA4,I SPC 1 EREA2 LDB .2 PREPARE JSB FDATA SOURCE STRING CCA PREPARE JSB PSTR DESTINATION STRING LDA FSCHA JSB TRSTR TRANSFER STRING JMP EREA3 * * * ** *** SEARCH FOR STATEMENT OF GIVEN TYPE ** ** STSRH NOP TYPE IN (A), ADDRESS IN (B) AND OPMSK (77000) EXTRACT STMT TYPE STA TEMP4 STSR1 CPB PBPTR PAST LAST STATEMENT? JMP STSRH,I YES LDA 1 EXTRACT ADA .2 PROGRAM LDA 0,I STATEMENÿÿ AND OPMSK TYPE CPA TEMP4 DESIRED TYPE? JMP STSR2 YES LDA 1 NO, FETCH INA STATEMENT LENGTH ADB 0,I COMPUTE NEW ADDRESS JMP STSR1 * STSR2 ISZ STSRH FOUND IT, SKIP RETURN JMP STSRH,I * ** *** SET POINTER TO START OF DATA STATEMENT ** ** SETDP NOP STATEMENT ADDRESS IN (B) INB LOAD LDA 1,I STATEMENT LENGTH CMA,INA SET INA DATA COUNTER STA DCCNT TO 1-STATEMENT LENGTH INB SET 'NEXT DATA' POINTER ONE STB NXTDT WORD ABOVE FIRST CONSTANT JMP SETDP,I SPC 1 SETPT NOP LDB SYMTF INITIALIZE STB HSTPT POINTERS TO LDB FCORE 'HIGH CORE' STACK, STB TSTPT ADB .23 STB LSTAK AND 'LOW' STB LSTPT STACK CMB DO ADB HSTPT STACKS SSB MEET? JMP E1 YES LDB PBUFF BEGIN JMP SETPT,I EXECUTION * .23 DEC 23 .9 DEC 9 SKP ** *** ALLOT SPACE FOR INTERMEDIATE RESULT ** ** RSCHK NOP LDA TSTPT ALLOT ADA .2 STA TSTPT SPACE ADA M1 OVERFLOW INTO CPA LSTAK LOW-CORE STACK? RSS YES JMP RSCHK,I NO LDA LSTAK SAVE INA LOWER STA TEMP3 STACK BOUND ADA .9 UPDATE STA LSTAK STACK BOTTOM LDA LSTPT SET INA SOURCE STA TEMP2 ADDRESS ADA .9 UPDATE STA LSTPT STACK TOP INA SET DESTINATION STA TEMP4 ADDRESS CMA,INA OVERFLOW ADA HSTPT INTO SSA HIGH-CORE STACK? JMP E1 YES. ERROR 57. JSB MVTOH NO, MOVE JMP RSCHK,I LOW-CORE STACK SKP ** *** BUMP HIGH STACK POINTER ** ** BHSTP NOP CCB ADVANCE ADB HSTPT STB HSTPT POINTER CPB LSTPT OVERFLOW? JMP E1 YES JMP BHSTP,I NO ** *** VERIFY LEGITIMACY OF OPERAND ** ** OPCHK NOP LDB HSTPT,I OPERAND ADDRESS TO (B) SSB STRING OPERAND? JMP OPCH2 YES LDA 1,I HIGH PART OF CPA MNEG OPERAND 100000B? INB,RSS YES JMP OPCH1 NO; OK. LDA 1,I IS LOW PART OF OPERAND 376B? CPA B376 JSB ERROR YES. VALUE NOT DEFINED. (50) E8 ADB M1 OPCH1 CPB TSTPT TEMPORARY? JMP OPCH3 YES JMP OPCHK,I OPCH2 CMB,INB SET ADDRESS TRUE ISZ HSTPT UNSTACK OPERAND OPCH3 LDA TSTPT UNSTACK TEMP STACK ADA M2 STA TSTPT JMP OPCHK,I * B376 OCT 376 LBOP OCT 22000 M4 DEC -4 SKP * * ************************** * * ** EVALUATE A FORMULA ** * * ************************** * FORMX NOP FORMULA BEGINS IN (TEMPS) CLB INITIALIZE OPERATOR JSB SLWST STACK FORM1 LDA TEMPS,I FETCH OPERAND ISZ TEMPS SET FOR NEXT WORD OF FORMULA AND OPDMK (100777) EXTRACT OPERAND STA TEMP5 AND SAVE IT SZA,RSS NULL OPERAND? JMP FORM2 YES JSB BHSTP SET STACK FOR OPERAND ADDRESS SSA FLAG BIT SET? JMP FORM4 YES JSB SSYMT FETCH OPERAND ADDRESS INB,SZB,RSS EXISTANT? JMP E8-1 NO. ERROR 50. AND .15 YES CPA .15 USER DEFINED FUNCTION? JMP FORM6 YES STB HSTPT,I NO LDB 1,I LOAD PTR TO VALUE SZA STRING VARIABLE? JMP FORM2 NO! LDA TEMPS,I YES AND OPMSK FOLLOWED BY CPA LBOP SUBSCRIPT? JMP FORM2-2 YES! STB TEMP8 NO! JSB RSCHK CREATE TEMPORARY CLA RECORD CCB DST TSTPT,I (0,-1) LDB TEMP8 RETRIEVE AND CMB,INB NEGATE STRING ADDRESS STB HSTPT,I STACK OPERAND ADDRESS FORM2 LDA TEMPS,I FETCH AND OPMSK OPERATOR ALF,ALF POSITION IT CPA .2 STRING CONSTANT? JMP FORM3 YES! FORM8 RAR LDB 0 LOAD ADDRESS OF ADB FOPBS OPERATOR'S INFORMATION WORD ADA M4 NON-FORMULA SSA OPERATOR? CLB YES ADA D31 NO, NON-FORMULA SSA,RSS OPERATOR? CLB YES CLA NO LDA 1,I LOAD INFORMATION WORD AND B777 SAVE STA TEM10 PRECEDENCE XOR 1,I RECOVER OPR NO. ARS STA TEMP5 IDENTIFICATION JMP FOR11 * * EVALUATION ROUTINES RETURN VALUE HERE. * FORM0 DST TSTPT,I STACK HIGH WORD LDA TSTPT STACK OPERAND STA HSTPT,I ADDRESS FOR11 LDA LSTPT,I DOES OPERATOR AND B377 ON TOP OF CMA OPERATOR STACK ADA TEM10 HAVE HIGHER SSA PRECEDENCE? JMP FORM9 YES, EXECUTE IT RSS * FOR10 ISZ LSTPT LDB TEM10 RETRIEVE PRECEDENCE ADB M15 NO, LEFT PARENTHESIS SSB OR LEFT BRACKET? ADB .15 NO, RESTORE PRECEDENCE ADB TEMP5 COMBINE IDENTIFICATION JMP FORM1-1 WITH PRECEDENCE AND STACK SKP * ***************************** * * * PROCESS STRING CONSTANT * * * ***************************** * * WHEN STRING CONSTANTS ARE STACKED, AN APPROPRIATE * ENTRY IS PLACED ON THE TEMPORARY STACK SO THAT ALL * STRING OPERANDS HAVE THE SAME FORM: A NEGATED BASE * ADDRESS ON THE OPERAND STACK AND A TWO WORD ENTRY ON * THE TEMPORARY STACK CONTAINING THE START-OF-STRING * AND END-OF-STRING DESIGNATORS BIASED BY -1 (DEFAULT * START-OF-STRING DESIGNATORS HAVE A STACK VALUE OF 0, * DEFAULT END-OF-STRING DESIGNATORS HAVE S STACK VALUE * OF -1). IN THE CASE OF SUBSCRIPTED STRING VARIABLES, * THE TEMPORARY IS CREATED WHEN THE ']' IS SCANNED THE * ENTRY FOR NON-SUBSCRIPTED STRING OPERANDS IS CREATED * WHEN THEY ARE SCANNED. * FORM3 CLA,INA PRINT STATEMENT CPA STRFG STRING CONSTANT? JSB STSTR NO,STACK STRING CONSTANT! JMP FORM8 EXECUTE END OF FORMULA * FORM4 CPA FLGBT CONSTANT? JMP FORM5 YES AND .15 NO CPA .15 PRE-DEFINED FUNCTION? JMP FORM7 YES LDB TEMP8 NO, MUST BE A JMP FORM2-1 PARAMETER * FORM5 LDB TEMPS LOAD CONSTANT ADDRESS ISZ TEMPS MOVE POINTER TO ISZ TEMPS NEXT CODE WORD JMP FORM2-1 * * HERE FOR USER-DEFINED FUNCTION (FNA, FNB, ETC.) * FORM6 STB TEMP5 SAVE SYMBOL TABLE POINTER LDB TSTPT SAVE CURRENT POINTER JSB SLWST TO TEMPORARY STACK LDB TEMP5,I JSB SLWST SAVE FUNCTION ADDRESS LDA FORMX SAVE CURRENT STA HSTPT,I FORMX RETURN ADDRESS JSB FORMX EVALUATE THE PARAMETER ISZ TEMPS UPDATE FORMULA POINTER ISZ TEMPS PAST RIGHT PARENTHESIS LDA TEMPS SWITCH LDB LSTPT,I FORMULA POINTER STB TEMPS TO FUNCTION'S STA LSTPT,I FORMULA LDB TEMP8 SET LDA HSTPT,I PARAMETER POINTER ISZ LSTPT TO NEW PARAMETER, ISZ HSTPT SAVING PREVIOUS STB LSTPT,I SETTING ON STA TEMP8 LOW-CORE STACK CPA TSTPT PROTECT PARAMETER IF JSB RSCHK ON TEMPORARY STACK JSB FORMX EVALUATE FUNCTION LDA LSTPT,I RESTORE OLD STA TEMP8 PARAMETER POINTER LDA LSTPT CUT BACK ADA M3 LOW-CORE STA LSTPT STACK INA RESTORE ORIGINAL LDB 0,I TEMPORARY STACK STB TSTPT POINTER INA RESTORE LDB 0,I ORIGINAL STB TEMPS FORMULA POINTER JSB STTOP POP RESULT FOR12 DST TSTPT,I STORE HIGH WORD ISZ HSTPT LDB HSTPT,I RESTORE FORMX STB FORMX RETURN ADDRESS LDA TSTPT STACK ADDRESS STA HSTPT,I OF RESULT JMP FORM2 * * HERE FOR PREDEFINED FUNCTION (SIN, ETC.) * FORM7 LDA TEMP5 OPERAND IDENTIFIES FUNCTION CPA FRMSK FORTRAN FUNCTION? JMP FCALL YES! RRR 4 AND .31 FUNCTION OFFSET ALS MULT BY 2 FOR OFFSET IN BR TBL LDB 0 MOVE TO B FOR SLWST JSB SLWST STACK CALL NUMBER LDA FORMX SAVE CURRENT STA HSTPT,I FORMX RETURN ADDRESS JSB FORMX EVALUATE THE PARAMETER ISZ TEMPS UPDATE FORMULA POINTER ISZ TEMPS PAST RIGHT PARENTHESIS JSB ULWST POP FUNCT # OFF LOW STACK * CLA SET INST. FOLLOWING FUNCT. CALL STA SKIPE TO NOP LDA AFCNX COMPUTE THE ADDRESS JSB INDCK OF THE CORRECT ADB 0 ENTRY IN THE BRANCH TABLE DLD 1,I A = WORD THAT INDICATES STA SKIPE 'RSS' OR 'NOP' FOR ERROR STB FADRS B=ADDRESS OF FUNCTION LDA HSTPT,I IS THIS A SSA STRING VARIABLE? JMP FOR13 YES, MUST BE LEN FUNCTION! LDA FADRS .CHECK THE FUNCTION FOR AND MCMSK . MICRO CODE CPA B105K RSS .YES JMP EXSUB .NO LDB FADRS STB EXFUN .SET UP INSTRUCTION JSB STTOP GET THE ARGUMENT OF THE FUNCTION EXFUN JSB FADRS,I EXECUTE THE FUNCTION!!! SKIPE NOP MODIFIED TO AN 'RSS' IF ERROR RETURN JMP FOR12 FUNCTION EXECUTION COMPLETE JSB ERROR THERE WAS AN ERROR FNERR EQU * * EXSUB LDB FINST STB EXFUN JMP EXFUN-1 * * FADRS NOP FUNCTION ADDRESS GOES HERE FINST JSB FADRS,I MCMSK OCT 177000 B105K OCT 105000 * SPC 1 * LENGTH FUNCTION (LEN) SPC 1 FOR13 LDA HSTPT,I GET STRING LENGTH CMA,INA AND CONVERT ADA M1 TO FLT PT LDA 0,I AND B377 JSB FLOAT FLOAT STRING LENGTH JMP FOR12 * * * HERE TO EXECUTE AN OPERATOR (+, *, ETC.) * FORM9 LDA LSTPT,I EXECUTE OPERATOR; UNSTACK CCB OPERATOR ADB LSTPT INFORMATION STB LSTPT WORD ALF,ALF COMPUTE AND B177 SUBROUTINE SZA,RSS END FORMULA? JMP FORMX,I YES, EXIT ADA ARBAS GET ADDRESS JMP 0,I EXECUTE * .31 DEC 31 B177 OCT 177 FRMSK OCT 100757 * *************************** * * * FETCH TOP OF STACK * * * *************************** ** STTOP NOP JSB OPCHK VALIDATE JSB RSCHK OPERAND LDB HSTPT,I SAVE DLD 1,I LOAD JMP STTOP,I SKP ******************************* * * * STACK (B) ON LOW CORE STACK * * * ******************************* SLWST NOP ISZ LSTPT LDA LSTPT CPA HSTPT STACK OVERFLOW E1 JSB ERROR YES STB LSTPT,I JMP SLWST,I * ************************************ * * ** UNSTACK LOW CORE STACK ON (B) ** * * ************************************ * ULWST NOP LDB LSTPT,I POP CCA STACK ADA LSTPT STA LSTPT JMP ULWST,I * *************************** * * * STACK STRING CONSTANT * * * *************************** * STSTR NOP JSB BHSTP SET STACK FOR OPERAND LDA TEMPS STACK NEGATIVE CMA OF STRING STA HSTPT,I ADDRESSES LDA TEMPS,I COMPUTE AND B377 STRING CCB LENGTH ADB 0 -1 ADA .3 UPDATE ARS INTRA-STATEMENT ADA TEMPS POINTER STA TEMPS PAST STRING JSB RSCHK CREATE TEMPORARY CLA RECORD DST TSTPT,I (0,(B)) JMP STSTR,I SKP * **************************** * * * PREPARE STRING OPERAND * * * **************************** * * THE STRING ADDRESS ON TOP OF THE OPERAND STACK IS COMBINED * WITH THE SUBSCRIPTS IN A PSUEDO-ENTRY ON THE TEMPORARY STACK * TO FORM A STRING OPERAND. (A)=-2 UPON ENTRY FOR A SOURCE * STRING (A)=-1 FOR A DESTINATION STRING. THE ADDRESS OF * THE FIRST CHARACTER OF THE STRING OPERAND IS LEFT IN TEMPS+5 * FOR SOURCE STRINGS (A)= TEMPS+5 UPON EXIT. THE SOURCE * STRING LENGTH IN CHARACTERS (1'S COMPLEMENT) IS IN (B) * UPON EXIT. THE FOLLOWING * CONDITIONS EXIT TO ERROR: NEGATIVE STRING LENGTH, REQUESTED * DESTINATION STRING WOULD EXCEED PHYSICAL STRING BOUNDARY, OR * REQUESTED DESTINATION STRING WOULD PRODUCE A STRING QUANTITY * WITH TWO UNCONNECTED PARTS. THE LOGICAL LENGTH OF A * DESTINATION STRING IS ADJUSTED AS NEEDED. * PSTR NOP STA PS0 SAVE MODE FLAG JSB OPCHK UNSTACK OPERAND STB PS1 SET FLAG POSITIVE CLE,ELB SAVE ADDRESS OF FIRST STB TEMP5 CHARACTER OF STRING ERB SAVE ADB M1 POINTER TO STB TEMP6 STRING LENGTH LDB TSTPT LOAD ADB .2 START-OF-STRING LDA 1,I DESIGNATOR STA MPT SAVE IT ADA TEMP5 RECORD CHARACTER ADDRESS STA TEMP5 OF START-OF-STRING STA SBPTR SAVE ADDRESS INB LOAD LDA 1,I END-OF-STRING DESIGNATOR INA,SZA SPECIFIED? JMP PSTR2 YES CCA NO CPA PS0 'SOURCE' MODE? JMP PSTR1 NO LDA TEMP6,I YES LOAD STRING'S AND B377 LOGICAL LENGTH JMP PSTR2 * PSTR1 STA PS1 SET FLAG TO -1 LDA TPRME COMPUTE CMA END-OF-STRING ADA MPT DESIGNATOR PSTR2 STA NQT SAVE IT CMA IS LENGTH ADA MPT OF SPECIFIED STRING SSA,RSS NEGATIVE? JSB ERROR YES STER1 STA TNULL ADA B400 NO SSA >255 JMP STER3-1 STRING OVERFLOW LDA TEMP6,I DOES AND B377 START-OF-STRING CMA CHARACTER ISZ PS0 RELATE TO INA PREVIOUS ADA MPT VALUE SSA,RSS OF STRING JMP PSTR3 NO LDA TEMP6,I YES,EXTRACT ISZ PS0 END-OF- ALF,ALF PERMITTED-STRING AND B377 DESIGNATOR CMA COMPUTE DIFFERENCE FROM ADA NQT END OF SPECIFIED STRING -1 CLB,INB 'SOURCE' CPB PS0 MODE? JMP PSTR5 NO LDB TNULL YES,SPECIFIED SOURCE STRING INA CONTAINED WITHIN SSA,RSS DEFINED SOURCE STRING ADB 0 NO, CORRECT LENGTH JMP PSTR4 OF ACTUAL SOURCE STRING * PSTR3 ISZ PS0 'SOURCE' MODE? JSB ERROR NO, NON-CONTIGUOUS STRING STER2 CCB YES SET ACTUAL LENGTH TO 0 PSTR4 LDA TEMP5 LOAD START-OF-STRING JMP PSTR,I CHARACTER ADDRESS PSTR5 SSA,RSS PHYSICAL STORAGE OVERFLOW? JSB ERROR YES, STRING OVERFLOW STER3 ISZ PS1 END-OF-STRING SPECIFIED? JMP PSTR7 YES * PSTR6 LDA TEMP6,I NO AND M256 RESET IOR NQT LOGICAL LENGTH STA TEMP6,I OF STRING JMP PSTR,I * PSTR7 LDA TEMP6,I IS NEW AND B377 DESTINATION CMA STRING ADA NQT LONGER SSA,RSS THAN OLD? JMP PSTR6 YES JMP PSTR,I * PS0 BSS 1 MPT BSS 1 PS1 BSS 1 NQT BSS 1 B400 OCT 400 TRS0 BSS 1 *********************** * * * TRANSFER A STRING * * * *********************** * * THE NUMBER OF CHARACTERS SPECIFIED BY TNULL (IN 1'S * COMPLEMENT) IS TRANSFERRED FROM THE SOURCE STRING TO * A DESTINATION STRING BEGINNING WITH THE CHARACTER * ADDRESSED BY TEMP5. * TRSTR NOP STA TRFCH SAVE FETCH CHAR ROUTINE ADDR ISZ TNULL MORE TRANSFER STRING? RSS YES JMP TRSTR,I NO JSB TRFCH,I FETCH A SOURCE CHARACTER LDA B40 NONE LEFT,LOAD A BLANK STA TRS0 SAVE IT LDB TEMP5 LOAD CLE,ERB DESTINATION LDA 1,I WORD SEZ,RSS SAVE ALF,ALF OTHER AND M256 CHARACTER IOR TRS0 COMBINE WITH SEZ,RSS NEW CHARACTER ALF,ALF AND STORE STA 1,I WORD ISZ TEMP5 INCREMENT DESTINATION ADDRESS JMP TRSTR+2 * **************************** * * * FETCH CHARACTER STRING * * * **************************** * * CHARACTER ADDRESS IN TEMP8, SOURCE CHARACTER COUNT * IN TPRME (IN 1'S COMPLEMENT). EXIT TO (P+1) ON NO * MORE CHARACTERS (TPRME = -1) ELSE EXIT TO (P+2) WITH * NEXT CHARACTER IN (A). * FSCH NOP LDA TPRME MORE CHARACTERS? INA,SZA,RSS JMP FSCH,I STA TPRME YES, UPDATE CHARACTER COUNT LDA TEMP8 LOAD CHARACTER CLE,ERA ADDRESS LDA 0,I EXTRACT SEZ,RSS NEXT CHARACTER ALF,ALF AND B377 ISZ TEMP8 UPDATE CHARACTER ADDRESS ISZ FSCH JMP FSCH,I * *************************** * * * FETCH INPUT CHARACTER * * * *************************** * * EXITS NORMALLY TO (P+2) WITH NEXT INPUT CHARACTER IN (A). * IF THE CHARACTER IN (A) IS A QUOTE OR THE INPUT RECORD IS * EMPTY, EXIT TO TRSTR,I ( THE ONLY CALLER THAT CAN ENCOUNTER * THE SITUATION ). * FINCH NOP ISZ FINCH JSB GETCR FETCH NEXT CHARACTER JMP FINC1 END-OF-INPUT CPA B42 QUOTE? JMP TRSTR,I YES! JMP FINCH,I FINC1 LDA .10 SET END-OF-INPUT JMP TRSTR,I * ********************** * * * CHECK FOR ENOUGH * * * ********************** * OVCHK NOP NEW WORD REQUIREMNET IN (A) ADA PBPTR CHECK STA PBPTR CMA FOR ADA LWBM OVERFLOW SSA,RSS JMP E1 OUT OF STORAGE JMP OVCHK,I SKP * ****************************** * * * ROUND SUBSCRIPT TO INTEGER * * * ****************************** SBFIX NOP SUBSCRIPT IN (A) AND (B) JSB .FAD SET FOR ROUNDING DEF HALF JSB IFIX CONVERT TO INTEGER SOC WAS IT INTEGER? JMP SBFIX,I NO ADA M1 YES, BIAS BY -1 SSA,RSS POSITIVE INTEGER? ISZ SBFIX YES JMP SBFIX,I NO ******************** * * * 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 E13-1 CHARACTER CONS2 JSB NUMCK FETCH CONSTANT JMP CONS3 NONE FOUND JSB ERROR BAD EXPONENT PART E14 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 E13 JMP CONST,I EXIT VIA (P+1) .43 DEC 43 .45 DEC 45 SKP ********************** * * ** COMPUTE RND(X) ** * * ********************** * * THE RANDOM NUMBER FUNCTION COMPUTES A RANDOM NUMBER FROM THE * FORMULAS: * * X(N)=A*X(N-1)+C(MOD 2^30) (A=5^11,C=2^30*(1/2-1/SQR(12))) * RND =X/2^30 MIN (1-2^-23) * ERND NOP SSA,RSS POSITIVE ARGUMENT? JMP ERND1 YES, USE PREVIOUS VALUE RBL,CLE,ERB NO, MAKE A ELA STA RNDX1 A NEW SEED STB RNDX2 ERND1 EQU * LDA RNDX1 COMPUTE FIRST MPY RNDA2 CROSS PRODUCT. STA RNDX1 SAVE (ONLY NEED LOW ORDER PART) LDA RNDX2 COMPUTE 2ND MPY RNDA1 CROSS PRODUCT. ADA RNDX1 ADD IN FIRST. ADA RNDC1 ADD IN HIGH PART OF C. STA RNDX1 SAVE TOTAL. (THIS IS HIGH PART). CLE LDA RNDX2 COMPUTE LOW ORDER PRODUCT. MPY RNDA2 ADA RNDC2 ADD IN LOW PART OF C. SEZ ADD ANY CARRY INTO INB B. RAL,CLE,ERA E_A(15),A(15)_0. STA RNDX2 SAVE LOW ORDER RESULT. ELB SHIFT HIGH ORDER PART & ADD IN ADB RNDX1 PREVIOUS TOTAL. ELB,CLE,ERB CLEAR BIT 15 AND STORE. STB RNDX1 RAL SHIFT A ADJACENT TO B. SWP EXCHANGE REGISTERS AND JSB .PACK PACK. NOP CPB .2 TEST FOR RESULT=1.0 RSS JMP ERND,I EXIT IF NOT. LDA INF SET RESULT TO 1-2^-23 LDB M256 JMP ERND,I RNDA1 DEC 1490 A DIV 2^15 RNDA2 DEC 3805 A MOD 2^15 RNDC1 OCT 16441 C DIV 2^15 RNDC2 OCT 7701 C MOD 2^15 RNDX1 BSS 1 RNDX2 BSS 1 M5 DEC -5 SKP ***** * ** OCT ** BASIC FUNCTION TO CONVERT INTEGER FOR * OCTAL OUTPUT. ACTUALLY CONVERTS INTEGER * TO FLOATING POINT QUANTITY WHICH WILL * PRINT OUT AS OCTAL VALUE * * CALLING SEQUENCE: * * DLD FLOATING EQUIVALENT OF INTEGER * JSB OCT * RETURN (FLOATING PT VALUE IN .A.8.B.) * ***** * OCT NOP JSB IFIX CONVERT TO INTEGER LDB M5 INITIALIZE STB CNTR DIGIT COUNTER LDB ATBL INITIALIZE POINTER STB TEMP3 TO DIGIT TABLE STA 1 MOVE INTEGER TO .B. RBL USE SIGN BIT CLA AS VALUE SLB FOR FIRST INA DIGIT IN STA TEMP3,I TABLE OCT01 BLF,RBR POSITION NEXT OCTAL DIGIT LDA 1 AND .7 AND ISOLATE IT IN .A. ISZ TEMP3 BUMP POINTER TO TABLE STA TEMP3,I AND MAKE ENTRY ISZ CNTR BUMP COUNTER, MORE DIGITS? JMP OCT01 YES, GET THEM NOW * ** BUILD FLOATING POINT NUMBER * LDB M6 RESET STB CNTR DIGIT COUNTER LDB ATBL REINITIALIZE STB TEMP3 POINTER TO DIGIT TABLE CLA CLB DST VALUE INITIALIZE FLOATING PT VALUE OCT02 LDA TEMP3,I GET NEXT DIGIT ISZ TEMP3 BUMP TO NEXT ENTRY JSB FLOAT CONVERT TO FLOATING POINT JSB .FAD USE TO UPDATE VALUE DEF VALUE ISZ CNTR BUMP DIGIT COUNTER, DONE ? RSS JMP OCT,I YES, RETURN JSB .FMP NO, MULTIPLY BY 10, DEF FD10 DST VALUE UPDATE VALUE JMP OCT02 AND DO FOR NEXT DIGIT * ** STORAGE ** * VALUE BSS 2 CNTR BSS 1 ATBL DEF *+1 BSS 6 FD10 DEC 10. .7 DEC 7 * **************************** * * * READ ERROR CODE FUNCTION * * * **************************** * XERR NOP LDA ERRCD JSB FLOAT FLOAT CODE JMP XERR,I RETURN IN A-B REGISTERS * ***************************** * * * SET ERROR CODE SUBROUTINE * * * ***************************** * ERRCD NOP SERR NOP JSB IFIX CONVERT TO INTEGER STA ERRCD SAVE JMP SERR,I * ******************* * * * TIME FUNCTION * * * ******************* * TIM NOP JSB IFIX FIX INPUT PARAMETER STA TEMP3 AND SAVE JSB EXEC GET DEF *+4 TIME DEF .11 FROM DEF ATBL+1 THE DEF ATBL+6 SYSTEM LDA TEMP3 DETERMINE ADA .2 WHICH ADA ATBL TIME THE USER WANTS LDA 0,I GET IT JSB FLOAT AND FLOAT IT JMP TIM,I RETURN * .11 DEC 11 * SKP **************** * * * SGN FUNCTION * * * **************** * ESGN NOP CLB SZA,RSS ZERO? JMP ESGN,I YES! SSA,RSS NO, POSITIVE? LDB .2 YES, SET EXPONENT LDA FLGBT LOAD MANTISSA SZB POSITIVE? RAR YES, CORRECT MANTISSA JMP ESGN,I * * ******************************************** * * ** EXECUTE SWITCH REGISTER TEST FUNCTION ** * * ******************************************** ESWR NOP JSB .IENT CONVERT TO 16 BIT INTEGER JMP FNERR-1 TOO BIG LDB 0 AND .15 CPA 1 NUMBER OUTSIDE RANGE 0-15? RSS NO JMP FNERR-1 YES LIA 1 READ SWITCH REGISTER SZB,RSS IS THIS THE SWITCH? JMP ESWR1 YES RAR MOVE TO NEXT SWITCH ADB M1 JMP *-4 * ESWR1 AND .1 ISOLATE THAT BIT JSB FLOAT CONVERT TO FLOATING POINT JMP ESWR,I RETURN * * SKP * *********************** * * * PRINT ERROR MESSAGE * * * *********************** ERROR NOP LDA ERBS ERROR ADDRESS IN (A) LDB ERROR ERROR SOURCE IN (B) INA MOVE TO NEXT ERROR CPB 0,I SAME AS ACTUAL ERROR? CMA,INA,RSS YES, MAKE ERROR NEGATIVE JMP *-3 NO ADA ERBS MAKE ERROR POSITIVE CMA,INA ADA .45 ACCOUNT FOR SHORTENED TABLE STA TEMP3 SAVE IT LDA .3 JMP SEG8 PRINT ERROR MESSAGE, AFTER CLEANING HOUSE * * * ******************************************** * * * COMPUTE DATA TYPE * * * ******************************************** * UPON ENTRY (A) AND (B) MUST HAVE A F.P. 0 TO REFERENCE * THE DATA STATEMENT. RETURNS 1,2,3 IF THE DATA ITEM IS * A NUMBER,STRING,END-OF-FILE RESPECTIVILY. * ETYP NOP .DUMMY ENTRY POINT ALLOWS USE SZA,RSS .DATA STATEMENT REFERENCE ? JMP ETYP3 .YES - ONLY ONE ALLOWED IN M BASIC JSB ERROR . OF MURTB BRTBL FNER1 EQU * * ETYP1 JSB FLOAT .PUT RESULT INTO FLOATING PT JMP ETYP,I .AND EXIT ETYP2 LDB NXTDT .OUT OF DATA ? LDA DATA JSB STSRH JMP ETYP5 .YES JSB SETDP .NO , SET DATA POINTERS ETYP3 CCA .MORE DATA IN CURRENT STATEMENT? CPA DCCNT JMP ETYP2 .NO LDB NXTDT,I .YES LOAD TYPE WORD CLA,INA .SET NUMBER SSB,RSS .IS IT A NUMBER? LDA .2 .NO SET TO STRING JMP ETYP1 ETYP5 LDA .3 JMP ETYP1 SKP *************** * * * ERROR TABLE * * * *************** ERBS DEF * ERR DEF E1+1 OUT OF STORAGE DEF E2 GOSUBS NESTED 10 DEEP DEF E3 RETURN WITH NO PRIOR GOSUB DEF E4 OUT OF DATA DEF E5 WRONG DATA TYPE DEF E6 SUBSCRIPT OUT OF BOUNDS DEF E7 STATEMENT REFERENCED NOT DATA DEF E8 UNDEFINED VALUE ACCESSED DEF E13 BAD DATA ITEM DEF E14 BAD EXPONENT DEF E15 .SUB. OR FUNCTION PARAMETER ERROR DEF TERR1 TRAP TABLE FULL DEF TERR2 BAD TRAP/SEQ # COMBINATION DEF TERR3 SCHEDULED BUT DELETED TASK DEF TERR4 TRAP TABLE BUSY DEF STER1 NEGATIVE STRING LENGTH DEF STER2 NON-CONTIGUOUS STRING DEF STER3 STRING OVERFLOW DEF XEC5 UNDEFINED STATEMENT REFERENCE DEF BASER NEGATIVE NUMBER TO REAL POWER DEF POWER ZERO TO ZERO POWER DEF ZRTNG ZERO TO NEGATIVE POWER DEF FNERR OUT OF RANGE IN FUNCTION DEF LOGER LOG OF NEG ARGUMENT DEF EXPER EXP OF NEG ARGUMENT DEF FNER1 .ILLEGAL FUNCTION SKP NFMT EQU TEMPS+1 TEMP1 EQU TEMPS+2 TEMP2 EQU TEMPS+3 TEMP3 EQU TEMPS+4 TEMP4 EQU TEMPS+5 TEMP5 EQU TEMPS+6 TEMP6 EQU TEMPS+7 TEMP7 EQU TEMPS+8 TEMP8 EQU TEMPS+9 TEMP9 EQU TEMPS+10 TEM10 EQU TEMPS+11 EFMT EQU TEMPS+12 RFLAG EQU TEMPS+13 HTEMP EQU TEMPS+14 NUMO1 EQU TEMPS+15 UTEMP EQU TEMPS+16 TWO WORD ARRAY TRFCH EQU TEMPS+18 ADDRESS OF FETCH CHAR ROUTINE FERR EQU TEMPS+19 FILE ERROR FLAG FILE# EQU TEMPS+20 FILE REFERENCE NUMBER RCRD# EQU TEMPS+21 RECORD REFERENCE NUMBER EORFL EQU TEMPS+22 END-OF-RECORD FLAG DADDR EQU TEMPS+23 FILE LOCATION PTR FILT EQU TEMPS+24 FILE REQUEST TYPE RQ2 EQU TEMPS+25 TABFG EQU TEMPS+26 * END