TITLE BASDDT SEARCH S SUBTTL PARAMETERS AND TABLES ;***COPYRIGHT 1969,1970,1971,1972,1973,1974 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.*** ;VERSION 17E 2-OCT-74/NA ;VERSION 17D 4-MAY-73/KK ;VERSION 17C 2-JAN-73/KK ;VERSION 17B 25-JUL-72/KK ;VERSION 17A 10-FEB-1972/KK ;VERSION 17 15-OCT-1971/KK ;VERSION 16 5-APR-1971/KK ;VERSION 15 17-AUG-1970/KK ;VERSION 14 16-JUL-1970/AL/KK ;VERSION 13 15-SEP-1969 LOC .JBINT TRPLOC LOC .JBVER BYTE (3)VWHO(9)VBASIC(6)VMINOR(18)VEDIT LOC .JB41 JSR UUOH RELOC HISEG EXTERN ERR,ERL,ERRGO,ERRCNT,LINADR,ERLB,ERRB EXTERN TYPE,FTYPE,PFLAG,AFLAG,INLNFG EXTERN FLTPNT,FIXPNT EXTERN EXP1.0,EXP2.0 EXTERN ACTBL,APPEND,ARAROL,ARATOP,ARGROL,ASCIIB,ATANB,BGNTIM EXTERN BLOCK,CADROL,CATFLG,CEARG,CECAD,CECOD,CECON,CEFCL EXTERN CEFOR,CEGSB,CEIL,CELAD,CELIN,CELIT,CENTRY,CENXT EXTERN CEPTM,CESAD,CESEX,CESLT,CESTM,CESVR,CETMP,CEVSP EXTERN CHAERR,CHAFL2,CHAFLG,CHAHAN,CHAXIT,CHKIMG,CHRB EXTERN CLOGB,CLSFIL,CNER1,CODROL,COMTIM,COMTOP,CONROL,CORINC EXTERN COSB,COTB,CRLF,CRTVAL,DATAFF,DATEB,DAYB,DETER,DEVBAS,DOINPT EXTERN DOREAD,D1E14,D1EM18,DECTAB,ECHOB,LIBFLG EXTERN EIFLOT,ELSEAD,ELSFLG,ENDIMG,EOF,EXECUT,EXP3.0,EXPB,EXTD EXTERN FADROL,FCLROL,FCNROL,FILCNT,FILD,FILDIR,FILTYP,FPPN EXTERN FIXB,FLARA,FLARG,FLCAD,FLCOD,FLCON,FLFAD,FLFCL,FLFOR EXTERN FLGSB,FLLAD,FLLIN,FLLIT,FLNXT,FLOOR,FLPTM,FLREF EXTERN FLSAD,FLSCA,FLSEX,FLSLT,FLSTM,FLSVR,FLTMP,FNMX0 EXTERN FNMXER,FORCAR,FORPNT,FORROL,FRETRN,FTRUTH,FUNAME EXTERN FUNLOW,FUNSTA,GSBROL,HPOS,IFFLAG,IFIX,IMGLIN EXTERN INPFLA,INPOUT,INPPRI,INSEQ,INSET,INSTRB,INTB,JAROUN,JFCLAD EXTERN KWDIND,LADROL,LASREC,LEFTB,LENB,LETSW,LEXECT,LINEB EXTERN LINROL,LITROL,LOCLOF,LOGB,LOGNEG,LSAVE,LUXIT EXTERN MARERR,MARGAL,MARGIN,MARGN,MASAPP,MASTST,MIDB,MINFLG,MTIME EXTERN MULLIN,NEWOL1,NOTLIN,NUMCOT,NUMRES,ODF,IFIFG,OLDCOD EXTERN ONCESW,ONGFLG,OPNFIL,OPNFLG,OUTSET,PAGE,PAGEAL EXTERN PAGLIM,PAKFLG,PIB,PLIST,POINT,POSB,PRDLER,PRTNUM,PSHPNT EXTERN PSHROL,PTMROL,QSKIP,QST,QUOTBL,RANDER,RANSCR,REAINP EXTERN REFROL,REGPNT,REINER,RELNEG,RELROL,RENFLA,RESTON EXTERN RETURN,RIGHTB,RNDB,RNNUMO,RNSTRO,ROLMSK,RUNFLA,RUNLIN EXTERN SADROL,SAVACS,SAVE1,SAVRUN,SCAROL,SCATH,SCNIMN,SCNIMS EXTERN SETCOR,SETERR,SEVEN,SEXROL,SINB,SLEEPB,SLTROL,SORCLN,SPACEB EXTERN SQRTB,STAROL,START,STRB,STRLEN,SVRBOT,SVRROL,SVRTOP EXTERN SWAPSS,TABLE,TANB,TEMLOC,TEMP1,THENAD,TIMEB,TMPLOW EXTERN THNCNT,THNELS EXTERN TMPPNT,TMPROL,TOPSTG,TRNFL2,TRNFLG,TRPLOC,TRUTH,TTYPAG EXTERN UUOH,VALB,VARFRE,VARROL,VPAKFL,VRFBOT,VRFSET EXTERN VRFTOP,VSPROL,WRIPRI,WRPRER,WRREFL,XCTON,XRES EXTERN .JBFF,.JBREL,.JBSA EXTERN PLTIN,PLTOUT ; VIRTUAL ARRAY LOW SEGMENT EXTERNALS EXTERN FLVIR,CEVIR,VIRROL,VIRDIM,VIRSIZ EXTERN LBASIC,UXIT BASIC=LBASIC EUXIT=UXIT ;****** EXTERNALS FROM BASLIB (COMLIB) EXTERN CPOPJ,CPOPJ1,DATCHK,ERACOM EXTERN ERRMS3,FILNAM,FILNMO,GETNU,GOSR2 EXTERN GETNUM,INLINE,INLMES,LOCKOF,LOCKON,NXCH,NXCHD EXTERN OUCH,PRINT,PRNNAM,QSA,QST EXTERN SCNLTN,SEARCH,TTYIN ;****** END EXTERNALS FROM BASLIB (COMLIB) EXTERN DDCODE,DDSTRT,DDTFLG,RUNDDT,.USREL,.DDREL,.DDFF,.DDSA EXTERN .DDTMP,DDTCOD,CETXT,FLTXT,PAKFLA,ROLTOP,CEDON EXTERN CEFAD,FLFAD,CEREF,FLDON,DERRGO,NOLINE EXTERN DPTROL,DTPROL,FLDPT,FLDTP,CEDPT,CEDTP EXTERN DLTROL,FLDLT,CEDLT,DITROL,FLDIT,CEDIT EXTERN STMROL,DONROL,FLVAR,CEVAR,CESCA EXTERN DDTERR,ONGADR,FIXCON,GOSBER INTERN DDTGO,DPANIC DEFINE FAIL (A,AC)< XLIST JRST [PUSHJ P,INLMES ASCIZ \A\ IFN AC,< MOVE T,N PUSHJ P,PRTNUM> JRST NXTST3] LIST > DEFINE ERROM(A,B) < ASCIZ B> %OPD=1 ;OPDEF UUO COUNTER DEFINE OPCNT (A)< %OPD=%OPD+1 IFG %OPD-37,> OPDEF A [<%OPD>B8]> OPCNT PRNM OPCNT PRDL OPCNT PRNTB OPCNT GOSUB OPCNT ARFET1 OPCNT ARFET2 OPCNT ARSTO1 OPCNT ARSTO2 OPCNT ARSTN1 OPCNT ARSTN2 OPCNT DATA OPCNT ADATA1 OPCNT ADATA2 OPCNT SDIM OPCNT MATRD OPCNT MATPR OPCNT MATSCA OPCNT MATCON OPCNT MATIDN OPCNT MATTRN OPCNT MATINV OPCNT MATADD OPCNT MATSUB OPCNT MATMPY OPCNT MATZER OPCNT STRUUO OPCNT SVRADR OPCNT PRSTR OPCNT DONFOR OPCNT MATINP DDTFLO: Z XBAS-400000+600000(SIXBIT/ BAS/) Z XCHAN-400000+200000(SIXBIT/ CHA/) Z XCLOSE-400000+600000(SIXBIT/ CLO/) Z XCONT-400000(SIXBIT/ CON/) Z XDEC-400000(SIXBIT/ DEC/) Z XELSE-400000+200000(SIXBIT/ ELS/) Z XEND-400000+200000(SIXBIT/ END/) Z XFOR-400000+200000(SIXBIT/ FOR/) Z XGOSUB-400000+600000(SIXBIT/ GOS/) Z XGOTO-400000+600000(SIXBIT/ GOT/) Z XIF-400000+200000(SIXBIT/ IF /) Z XINPUT-400000+600000(SIXBIT/ INP/) Z XLET-400000+200000(SIXBIT/ LET/) Z XLIST-400000(SIXBIT/ LIS/) Z XMAR-400000+600000(SIXBIT/ MAR/) Z XMAT-400000+200000(SIXBIT/ MAT/) Z XNEXT-400000+600000(SIXBIT/ NEX/) Z XNOP-400000+600000(SIXBIT/ NOP/) Z XNOQ-400000+600000(SIXBIT/ NOQ/) Z XON-400000+200000(SIXBIT/ ON /) Z XOPEN-400000+600000(SIXBIT/ OPE/) Z XPAG-400000+600000(SIXBIT/ PAG/) Z XPRINT-400000+600000(SIXBIT/ PRI/) Z XQUO-400000+600000(SIXBIT/ QUO/) Z XRAN-400000+600000(SIXBIT/ RAN/) Z XREAD-400000+600000(SIXBIT/ REA/) Z XREM-400000(SIXBIT/ REM/) Z XREST-400000+200000(SIXBIT/ RES/) Z XSCRAT-400000+600000(SIXBIT/ SCR/) Z XSET-400000+200000(SIXBIT/ SET/) Z XSTART-400000(SIXBIT/ STA/) Z XSTOP-400000(SIXBIT/ STO/) Z XUNTIL-400000+600000(SIXBIT/ UNT/) Z XWHILE-400000+600000(SIXBIT/ WHI/) Z XWRIT-400000+600000(SIXBIT/ WRI/) DDTCEI: OPDEF STRSTO [STRUUO 1,] OPDEF STRIF [STRUUO 2,] OPDEF STRIN [STRUUO 3,] OPDEF VECFRL [STRUUO 4,] OPDEF VECPRL [STRUUO 5,] OPDEF STOCHA [STRUUO 6,] OPDEF VECFIN [STRUUO 7,] OPDEF VECPIN [STRUUO 10,] OPDEF PJRST [JRST 0] ;TABLE OF INTRINSIC FUNCTIONS DEFINE ZZZ. (X) < XLIST LIST > IFNFLO: ZZZ. (ABS) ZZZ. (ASC) ZZZ. (ASCII) ZZZ. (ATN) ZZZ. (CHR$) ZZZ. (CLOG) ZZZ. (COS) ZZZ. (COT) ZZZ. (CRT) ZZZ. (DATE$) ZZZ. (DAY$) ZZZ. (DET) ZZZ. (ECHO) ZZZ. (ERL) ZZZ. (ERR) ZZZ. (EXP) ZZZ. (FIX) ZZZ. (FLOAT) ZZZ. (INSTR) ZZZ. (INT) ZZZ. (LEFT$) ZZZ. (LEN) ZZZ. (LINE) ZZZ. (LL) ZZZ. (LN) ZZZ. (LOC) ZZZ. (LOF) ZZZ. (LOG) ZZZ. (LOGE) ZZZ. (LOG10) ZZZ. (MID$) ZZZ. (NUM) ZZZ. (NUM$) ZZZ. (PI) ZZZ. (POS) ZZZ. (RIGHT$) ZZZ. (RND) ZZZ. (SGN) ZZZ. (SIN) ZZZ. (SLEEP) ZZZ. (SPACE$) ZZZ. (SQR) ZZZ. (SQRT) ZZZ. (STR$) ZZZ. (TAN) ZZZ. (TIM) ZZZ. (TIME$) ZZZ. (VAL) IFNCEI: %FN=1 DEFINE ZZZ. (X) < XLIST OPDEF ZZZZ. [%FN] ZZZZ. %FN=%FN+1 LIST > DEFINE ZTYPE (A,B,C),< XLIST BYTE (9)A,B(18)C LIST > IF2FLO: ZZZ. (ABS) ZZZ. (ASC) ZTYPE 4,1,ASCIIB ZTYPE 2,2,ATANB ZTYPE 1,4,CHRB ZTYPE 2,2,CLOGB ZTYPE 2,2,COSB ZTYPE 2,2,COTB ZZZ. (CRT) ZTYPE 1,0,DATEB ZTYPE 1,0,DAYB ZZZ. (DET) ZTYPE 4,4,ECHOB ZTYPE 4,0,ERLB ZTYPE 4,0,ERRB ZTYPE 2,2,EXPB ZTYPE 4,2,FIXB ZZZ. (FLTBI) XWD IF31,INSTRB ZTYPE 4,2,INTB XWD IF32,LEFTB ZTYPE 4,1,LENB ZTYPE 4,0,LINEB ZZZ. (LL) ZTYPE 2,2,LOGB ZZZ. (LOC) ZZZ. (LOF) ZTYPE 2,2,LOGB ZTYPE 2,2,LOGB ZTYPE 2,2,CLOGB XWD IF33,MIDB ZZZ. NUM ZTYPE 1,2,STRB ZZZ. (PI) ZTYPE 1,4,POSB XWD IF32,RIGHTB ZTYPE 2,0,RNDB ZZZ. (SGN) ZTYPE 2,2,SINB ZTYPE 4,4,SLEEPB ZTYPE 1,4,SPACEB ZTYPE 2,2,SQRTB ZTYPE 2,2,SQRTB ZTYPE 1,2,STRB ZTYPE 2,2,TANB ZZZ. (TIM) ZTYPE 1,0,TIMEB ZTYPE 2,1,VALB IF2CEI: IF31: XWD 3 ;ARG BLOCK FOR INSTR XWD -1,-1 XWD 0,+1 XWD 0,+1 IF32: XWD 2 ;ARG BLOCK FOR LEFT$, RIGHT$. XWD 0,+1 XWD 0,-1 IF33: XWD 3 ;ARG BLOCK FOR MID$ XWD 0,+1 XWD 0,-1 XWD -1,-1 ;TABLE OF RELATIONS FOR IFSXLA DEFINE ZZZ. (X,Y)< OPDEF ZZZZ. [X] ZZZZ. (Y)> RELFLO: ZZZ. 3435B11,CAMGE ZZZ. 3436B11,CAMN ZZZ. 74B6,CAMG ZZZ. 3635B11,CAMLE ZZZ. 75B6,CAME ZZZ. 76B6,CAML RELCEI: DDTGO: SKIPE DDTERR ;HERE FROM ERROR JRST NXTST4 ;YES, TREAT LIKE COMPILATION ERROR MOVEI R,STAROL ;DUMMY UP STAROL MOVEI X1,DDTFLO ;WITH DDT STATEMENTS MOVEM X1,FLOOR(R) ;SET FLOOR MOVEI X1,DDTCEI ;AND CEIL MOVEM X1,CEIL(R) ;ALL DONE MOVEI R,RELROL ;MUST ALSO USE THIS RELROL MOVEI X1,RELFLO ;NEW FLOOR MOVEM X1,FLOOR(R) ;SET IT MOVEI X1,RELCEI ;NEW CEIL MOVEM X1,CEIL(R) ;SET IT CLEARM DDTFLG ;NO BREAKS YET MOVEI R,SCAROL ;OPEN UP SCAROL MOVEI E,5 ;WITH FIVE LOCATIONS PUSHJ P,BUMPRL ;DO IT MOVEI R,VARROL ;NOW OPEN UP VARROL MOVEI E,5 ;WITH FIVE CORRESPONDING LOCATIONS PUSHJ P,BUMPRL ;DO IT MOVE X1,CESCA ;CEIL OF SCAROL SUB X1,FLSCA ;LESS FLOOR GIVES SIZE SOJ X1, ;CORRECT HRLI X1,777760 ;LARGEST "ASCII" VARIABLE NAME MOVE X2,CEVAR ;START OF FIVE LOCATIONS MOVE A,CESCA ;GET CEIL TO ZERO MOVEI B,5 ;LOOP COUNTER DDTSCA: MOVEM X1,-1(X2) ;STORE IT SUB X1,[XWD 20,1] ;DECREMENT LOCATION AND VARIABLE NAME SOJ X2, ;DECREMENT VARROL POINTER CLEARM -1(A) ;ZERO LOCATION SOJ A, ;DECREMENT SCAROL LOCATION SOJG B,DDTSCA ;ALL FIVE DONE? SUBTTL BASDDT "LOADER" LINKAG: MOVEI R,CONROL ;SLIDE RUNTIME ROLLS DOWN INTO PLACE. LKLAB1: PUSHJ P,SLIDRL CAIGE R,TMPROL AOJA R,LKLAB1 ;SLIDE NEXT ROLL. MOVEM X2,VARFRE ;FIRST FREE LOC IS CEIL OF TMPROL. ; ; GET ARRAY REQUIREMENTS ; LKS3: MOVE E,CETMP ;CHECK ARRAY REQUIREMENTS MOVE T,FLARA SETZM TRNFL2 SETZM TRNFLG JRST LK2A LK1: HLRZ X1,(T) ;KNOW SIZE? TRNE X1,400000 ;VIRTUAL JRST LK2B ;YES, IGNORE IT JUMPN X1,LK2 ;YES, JUMP SKIPG 2(T) ;DON'T SET UP FAKE MATRIX JRST LKLAB2 ;YET, BUT REMEMBER WHICH ONE MOVEM T,TRNFLG ;IT IS. JRST LK2 LKLAB2: MOVSI X2,^D11 ;(11,1) IS STANDARD DIM AOJ X2, MOVEI X1,^D11 MOVE A,1(T) AOJN A,LKLAB4 ;IMPLICIT 2-DIM ARRAY? HRRI X2,^D11 MOVEI X1,^D121 LKLAB4: MOVEM X2,1(T) HRLM X1,(T) ;STORE SIZE LK2: ADD E,X1 ;ADD LENGTH TO IT SKIPL 2(T) JRST LK2B CAMLE X1,TRNFL2 ;TRNFL2 CONTAINS THE SPACE NEEDED MOVEM X1,TRNFL2 ;BY THE LRGST ARRAY SET = ITS OWN TRN. LK2B: ADDI T,3 ;ON TO NEXT ENTRY LK2A: CAME T,FLSVR JRST LK2C SKIPN X2,TRNFLG JRST LK2D MOVE X1,TRNFL2 HRLM X1,(X2) ADD E,X1 LK2D: MOVEM E,SVRBOT LK2C: CAMGE T,CESVR JRST LK1 LK3: SETOM VPAKFL ;DONT TRY TO PRESS VARAIBLE SPACE NOW! SUB E,CESVR ;WE NEED THIS MANY LOCS LK35: MOVE X1,VARFRE ;IS THERE ROOM FOR (E) LOCS? ADDI X1,(E) CAMGE X1,.JBREL JRST LK37 TLNN X1,-1 ;TOO BIG FOR A PDP10 ? CORE X1, JRST [PUSHJ P,INLMES ASCIZ / ? Out of room/ JRST ERRMSG] ; ; GET SPACE FOR DDT ; LK37: ADD E,CETMP ;CALCULATE TOP OF ARRAY SPACE MOVEM E,SVRTOP MOVEM E,VARFRE ;FIRST FREE WORD MOVE X1,.JBREL ;HIGH NOW MOVEM X1,.USREL ;USER HIGH AOJ X1, ;START OF BASDDT MOVEM X1,.DDSA ;SAVE IT ADDI X1,17 ;START FOR DDT MOVEM X1,.DDTMP ;ROOM FOR AC'S AOJ X1, ;START FOR BASDT CODE MOVEM X1,DDTCOD ;SAVE IT ADDI X1,^D100 MOVEM X1,.DDFF ADD X1,CELAD ;ESTIMATE HOW MUCH CORE WE NEED SUB X1,FLVAR ;TO MOVE VARROL THRU LADROL CORE X1, ;GET K FOR DDT JRST [PUSHJ P,INLMES ASCIZ / ? Out of room/ JRST ERRMSG] MOVE X1,.JBREL MOVEM X1,.DDREL LK4: MOVE T,FLFCL MOVEI R,FCNROL LINK0A: CAML T,CEFCL JRST LINK0C ;NO MORE FCN CALLS HLLZ A,(T) ;LOOK UP FUNCTION PUSHJ P,SEARCH JRST LINK0B ;UNDEFINED MOVE A,(B) ;DEFINED. GET ADDRESS. HRLM A,(T) AOJA T,LINK0A LINK0B: SETZM RUNFLA PUSHJ P,INLMES ASCIZ / ? Undefined function -- FN/ LDB C,[POINT 7,A,6] PUSHJ P,OUCH SKIPE CHAFL2 PUSHJ P,ERRMS3 PUSHJ P,INLMES ASCIZ / / AOJA T,LINK0A LINK0C: MOVE B,FLFOR ;UNSAT FORS? CAML B,CEFOR JRST LINK0D SETZM RUNFLA ;RETURN TO BASIC PUSHJ P,INLMES ASCIZ /? FOR without NEXT in line / MOVE T,(B) ;GET LINE ADD T,FLLIN HLRZ T,(T) PUSHJ P,PRTNUM ;PRINT IT SKIPE CHAFL2 PUSHJ P,ERRMS3 PUSHJ P,INLMES ASCIZ / / ADDI B,5 ;MORE UNSAT FORS? JRST LINK0C+1 ; LINK0D: SKIPG DATAFF ;WAS DATA OMITTED? JRST LINK0E ;NO PUSHJ P,INLMES ASCIZ / ? No DATA/ SKIPE CHAFL2 PUSHJ P,ERRMS3 SETZM RUNFLA LINK0E: SKIPGE RUNLIN ;LINE NUMBER ARG IN RUN(NH) COMMAND? JRST LINK0F ;NO. HRLZ A,RUNLIN ;YES. MAKE SURE IT EXISTS AND MOVEI R,LINROL PUSHJ P,SEARCH JRST [PUSHJ P,INLMES ASCIZ / ? Illegal line reference in RUN(NH) or CHAIN/ JRST ERRMSG] SUB B,FLOOR(R) MOVEM B,RUNLIN ADD B,FLREF ;IS NOT WITHIN A MULTI-LINE DEF. SKIPE (B) JRST [PUSHJ P,INLMES ASCIZ / ? Illegal line reference in RUN(NH) or CHAIN/ JRST ERRMSG] LINK0F: SKIPN RUNFLA ;GO INTO EXECUTION? JRST LUXIT ;NO MOVE C,FLCOD ;CODE ROLL IS IN PLACE. C CONTAINS ITS FLOOR LINK0: MOVE T,FLFCL ;LINK FCN CALLS MOVE T1,CEFCL MOVE A,FLCOD MOVEI B,0 PUSHJ P,LINKUP LINK1A: MOVE T,FLARA ;LINK ARRAY REFS MOVE T1,CESVR MOVE A,T MOVEI B,3 PUSHJ P,LINKUP LINK1B: MOVE T,FLARA ;STORE ARRAY ADDRESSES IN ARAROL MOVE G,CETMP JRST LINK1D LINK1C: HLRZ X1,(T) ;GET ARRAY LENGTH TRNE X1,400000 ;VIRTUAL JRST LINK1E ;YES, IGNORE IT HRRM G,(T) ;STORE ABS ADDRS ADD G,X1 ;COMPUTE ADDRS OF NEXT ARRAY LINK1E: ADDI T,3 ;GO TO NEXT ENTRY LINK1D: CAMGE T,T1 JRST LINK1C LINK1: MOVE T,FLCAD ;LINK CONST REFS MOVE T1,CECAD MOVE A,FLCON MOVEI B,1 PUSHJ P,LINKUP LINK2: MOVE T,FLPTM ;LINK TEMPORARY REFS (PERM AND TEMP) MOVE T1,CETMP MOVE A,T MOVEI B,1 PUSHJ P,LINKUP LINK3: MOVE T,FLLAD ;LINK GOTO DESTINATIONS MOVE T1,CELAD MOVE A,FLCOD MOVEI B,0 PUSHJ P,LINKUP LINK4: MOVE T,FLSCA ;LINK SCALARS MOVE T1,CEVSP MOVE A,T MOVEI B,1 PUSHJ P,LINKUP LINK6: MOVE T,FLGSB ;LINK GOSUB REFS MOVE T1,CEGSB MOVE A,T MOVEI B,1 PUSHJ P,LINKUP MOVE T,FLGSB LINK7: CAML T,T1 ;PUT SUBRTN ADDRSES IN GSBROL JRST LINK8 HLRZ X1,(T) ADD X1,FLLAD HLRZ X1,(X1) ADD X1,C MOVEM X1,(T) AOJA T,LINK7 LINK8: MOVE T,FLNXT ;LINK REVERSE REFS IN FORS MOVE T1,CENXT MOVE A,FLCOD MOVEI B,0 PUSHJ P,LINKUP LINK9: MOVE T,FLLIT ;LINK LITROL TO SLTROL. LINK91: CAML T,CELIT JRST LINK92 HRRZ A,(T) ADD A,FLSLT HRRM A,(T) AOJA T,LINK91 LINK92: MOVE T,FLSAD ;LINK POINTERS TO LITROL MOVE T1,CESAD MOVE A,FLLIT MOVEI B,1 PUSHJ P,LINKUP SKIPGE X1,RUNLIN ;GET LOC TO START BEFORE JRST LINKZ ;LADROL IS ZEROED. ADD X1,FLLAD HLRZ X1,(X1) ADD X1,FLCOD MOVEM X1,RUNLIN LINKZ: MOVE X1,.DDFF MOVEM X1,FLSEX MOVEM X1,CESEX AOS .DDFF MOVEI R,VARROL PUSHJ P,SAVROL MOVE X1,.DDFF MOVEM X1,CEARG MOVEM X1,FLARG AOS .DDFF MOVEI R,REFROL PUSHJ P,SAVROL MOVEI R,FCNROL PUSHJ P,SAVROL MOVE X1,.DDFF AOS .DDFF MOVEM X1,FLFCL MOVEM X1,CEFCL MOVEI R,FADROL PUSHJ P,SAVROL MOVE X1,.DDFF AOS .DDFF MOVEM X1,FLCAD MOVEM X1,CECAD MOVEI R,LADROL PUSHJ P,SAVROL MOVEI R,ROLTOP HRLZI X1,FLSAD HRRI X1,FLFOR MOVE X2,.DDFF MOVEM X2,FLSAD BLT X1,FLOOR(R) HRLZI X1,CESAD HRRI X1,CEFOR MOVEM X2,CESAD BLT X1,CEIL(R) PUSH P,TOPSTG ;SAVE TOPSTG MOVEI R,STMROL ;NEW TOPSTG MOVEM R,TOPSTG ; PUSHJ P,PRESS ;MOVE ALL ROLLS AS FAR DOWN AS WE CAN POP P,TOPSTG ;RESTORE TOPSTG PUSHJ P,ZSTOR ;ZERO OUT STORAGE SKIPGE A,RUNLIN ;START AT DIFFERENT LINE HRRZ A,FLCOD ;NO MOVEM A,DDSTRT ;SAVE PROGRAM START MOVEI A,DDFRST ;PSEUDO START MOVEM A,RUNLIN ;FAKE OUT BASDDT JRST EXECUT ;GO DO EXECUTE STUFF NOW ;SUBROUTINE TO LINK ROLL ENTRIES ;CALL WITH A=ORG OF VALUE ROLL, B=INCREMENT (0 IF EXPLICIT REL LOC) ;T=FLOOR OF SRC ROLL, T1=CEIL OF SRC ROLL LINKUP: MOVE X2,A MOVSI X1,C LNKP1: CAML T,T1 ;FINISHED ROLL? POPJ P, HRRZ A,(T) ;FIRST LOC IN CHAIN JUMPN B,LKLAB5 ;EXPLICIT ADDRS? HLRZ X2,(T) ;YES. COMPUTE IT ADD X2,C LKLAB5: JUMPE A,LNKP3 ;SPECIAL CASE--CHAIN VOID LNKP2: HRR X1,A ;ONE LINK IN CHAIN HRRZ A,@X1 HRRM X2,@X1 JUMPN A,LNKP2 LNKP3: JUMPN B,LKLAB6 ;EXPLICIT ADDRS? AOJA T,LNKP1 ;YES, JUST BUMP ROLL PNTR LKLAB6: ADD T,B ;NO, ADD EXPLICIT INCREMENT ADD X2,B ; (ALSO TO DEST ROLL) JRST LNKP1 ZSTOR: MOVE X1,FLSCA ;ZERO OUT SCALARS AND STRING VARS MOVE X2,CEVSP PUSHJ P,BLTZER MOVE X1,CETMP ;ZERO OUT ARRAY ELEMENTS AND STRING VECTORS. MOVE X2,ARATOP BLTZER: HRL X1,X1 ;ZERO OUT CORE SETZM (X1) AOJ X1, BLT X1,-1(X2) POPJ P, ; ; SAVE ROLL FOR DDT ; SAVROL: MOVE X2,CEIL(R) ;START SAVING HERE MOVE X1,.DDFF ;PUT IT HERE ADD X2,X1 ; HRL X1,FLOOR(R) ;SET UP BLT TO MOVE ROLL SUB X2,FLOOR(R) ;AMOUNT NEEDED TO SAVE HRRZM X1,FLOOR(R) ;NEW FLOOR BLT X1,(X2) ;SAVE IT MOVEM X2,CEIL(R) ;NEW CEIL MOVEM X2,.DDFF ;NEW FREE FOR DDT POPJ P, ; ; SLIDE ROLL INTO PLACE FOR RUNTIME ; SLIDRL: MOVE X2,CEIL(R) ;END SAVE HERE HRRZ X1,CEIL-1(R) ;SLIDE ROLL DOWN NEXT TO LOWER ROLL ADD X2,X1 HRL X1,FLOOR(R) ;SET UP BLT TO SLIDE ROLL SUB X2,FLOOR(R) ;AMOUNT NEEDED HRRZM X1,FLOOR(R) ;NEW FLOOR BLT X1,(X2) ;SAVE IT MOVEM X2,CEIL(R) ;NEW CEIL POPJ P, SUBTTL IMMEDIATE MODE PROCESSOR DDFRST: MOVE A,DDSTRT ;GET PROGRAM START MOVEM A,RUNLIN ;RESTORE SETOM DDSTRT ;FORCE START PUSHJ P,INLMES ;SO TELL USER ASCIZ /[BASDDT execution] / OUTPUT ;SEND THE MESSAGE SETZM MULLIN ;IN CASE END WAS ON MULTI-LINE JRST EACHLN ;START DDT DDTBRK: MOVEM A,DDSTRT ;POP-OFF RETURN MOVEM A,SORCLN ;SAVE SOURCE LINE NUMBER MOVE N,.DDSA ;SAVE THE AC'S HERE BLT N,@.DDTMP ;ALL 17 MOVE X1,ERRGO ;SAVE ANY ON ERROR LABEL MOVEM X1,DERRGO ;FOR RESTORATION CLEARM ERRGO ;DO NOT PROCESS ON ERROR IN DDT MODE SETOM NOLINE ;DO NOT PRINT LINE # ON ERROR MOVEI X1,STMROL MOVEM X1,TOPSTG CLEARM ODF ;SETUP FOR OUTPUT TO TTY PUSHJ P,INLMES ;TELL USER A STOP ASCIZ /# / MOVE T,SORCLN HRRZ T,(T) ;GET LINE NUMBER PUSHJ P,PRTNUM ;PRINT LINE # PUSHJ P,PCRLF EACHLN: SETOM VRFSET ; SETZM INLNFG ;CLEAR INPUT LINE FLAG CLEARM ODF ; CLEARM IFIFG ;SETUO FOR TTY INPUT CLEARM AFLAG ;CLEAR A FLAG SETZM LOGNEG ; CLEARM PFLAG ;CLEAR P FLAG SKIPN MULLIN JRST ECHL2A MOVE D,T JRST EACHL2 ECHL2A: CLEARM THENAD CLEARM THNCNT CLEARM ELSFLG CLEARM ELSEAD SETZM THNELS ECHLN1: MOVEI C,">" PUSHJ P,OUCH OUTPUT HRRZS RUNDDT PUSHJ P,INLINE HRROS RUNDDT TLNE C,F.TERM ;JUST A TERMINATOR JRST ECHLN1 ;YES, FORGET IT MOVS D,T ;SAVE LINE POINTER EACHL2: TLNN C,F.LETT ;MUST BE A LETTER JRST ILLINS PUSHJ P,SCNLT1 ;SCAN FIRST LTR CAMN C,[XWD F.STR,"%"] JRST ELILET ; CAIE C,"(" TLNE C,F.EQAL+F.COMA+F.DIG+F.DOLL ;ELIDED LETTER? JRST ELILET ;YES. POSSIBLE ASSUMED "LET" PUSHJ P,SCNLT2 ;SCAN SECOND LETTER. JRST ILLINS ;SECOND CHAR WAS NOT A LETTER. MOVS X1,A CAIE X1,(SIXBIT /IF/) CAIN X1,(SIXBIT /ON/) JRST EACHL1 EACHL3: PUSHJ P,SCNLT3 ;ASSEMBLE THIRD LETTER OF STATEMENT IN A JRST ILLINS ;THIRD CHAR WAS NOT A LETTER JRST EACHL1 ELILET: MOVSI A,(SIXBIT /LET/) ;ASSUME A "LET" STATEMENT. SKIPE T,MULLIN ;MULLIN HAS PTR IF MULTI JRST ELILT1 MOVS T,D ;GO BACK TO THE FIRST LETTER. HRLI T,440700 ELILT1: PUSHJ P,NXCHK ;HERE, FIRST 3 LTRS OF VERB (SIXBIT) ARE IN A. USE TBL LOOKUP AND DISPATCH. EACHL1: MOVEI R,STAROL PUSHJ P,SEARCH ;LOOK IN STATEMENT TYPE TABLE JRST ILLINS ;NO SUCH, GO BITCH HRRZ A,(B) ;FOUND. EACHL6: MOVE X1,A SETOM JFCLAD ;NO JFCL YET SKIPN MULLIN JRST EACHLA SKIPN DDCODE FAIL JRST EACHL7 EACHLA: CLEARM DDCODE ;ASSUME NO CODE PRODUCER TRNN X1,200000 ;CODE PRODUCER? JRST EACHL7 SKIPN DDTFLG FAIL MOVE B,DDTCOD MOVEM B,DDCODE EACHL7: TRZE X1,200000 ;BASDDT INSTRUCTION? JRST EACHL9 ;NO SKIPE MULLIN ;ANY CODE PRODUCERS? FAIL JRST EACHL8 ;CONTINUE EACHL9: MOVSI D,(JFCL) ;SET JFCL FOR HANDLING MODIFIERS PUSHJ P,BUILDI ;DO THE GENERATION MOVEM B,JFCLAD ;STORE ADDRESS EACHL8: TRNN X1,400000 ;MORE TO COMMAND? SOJA X1,EACHL5 ;NO. JUST DISPATCH PUSHJ P,QST ;CHECK REST OF COMMAND JRST ILLINS TRZ X1,400000 ;CLEAR HIGH-ORDER BIT EACHL5: JRST 400001(X1) ;HERE ON END OF STATEMENT XLATION NXTSTA: TLNE C,F.TERM ;END OF LINE ? JRST NXSM2 ;YES, GO CHECK TERMINATOR PUSHJ P,QSELS ;ELSE ? JRST MODSEK ;NO, SEEK MODIFIER MOVEM T,MULLIN ;YES, MARK MULTI JRST NXSM1 ;GO HANDLE MODSEK: PUSHJ P,KWSMOD ;NO, LOOK FOR MODIFIERS JRST ERTERM ;NONE, GO BITCH SKIPGE X1,JFCLAD ;WAS IT EXECUTABLE ? FAIL AOS X1 MOVEM X1,CENTRY ;BEG OF STMNT CODE SOS X1 ADD X1,DDTCOD MOVSI X2,(JRST) ;PUT JRST MOVEM X2,(X1) ;IN PLACE OF JFCL SETOM JAROUN ;NO JUMP AROUND ADDRESS YET MODLOO: PUSHJ P,HALJRS ;JRST AROUND MODIFIER MOVE X1,JAROUN ;GET OLD JUMP AROUND MOVEM B,JAROUN ;SAVE NEW JUMPL X1,MODNOJ ;NO OLD ONE ADD X1,DDTCOD ;ADJUST ADD B,DDTCOD ;ADDRESSES PUSHJ P,FIXADR ;FIX JUMP MODNOJ: MOVE X1,KWDIND ;GET MODIFIER SUBI X1,KWAMOD ;INDEX CAIN X1,7 ;FIX UP FOR AOJ X1, ;(ONLY ONE WORD LONG) LSH X1,-1 JRST @MODIFY(X1) ;GO MODIFY MODIFY: JRST MODWHC ;WHILE JRST MODUTC ;UNTIL JRST MODIFC ;IF JRST MODUSC ;UNLESS JRST MODFOC ;FOR MODWHC: SETZM LOGNEG ;WHILE CAIA MODUTC: SETOM LOGNEG ;UNTIL=NOT WHILE SETOM JAROUN ;NO JUMP AROUND SOS DDCODE ;OVERWRITE IT JRST MODCON ;EVALUATE CONDITION MODIFC: SETZM LOGNEG ;IF CAIA MODUSC: SETOM LOGNEG ;UNLESS=NOT IF MODCON: PUSHJ P,SAVCEN ;SET NEW CENTRY PUSHJ P,IFCCOD ;GENERATE CONDITIONAL PUSHJ P,OLDCEN ;JRST TO OLD CENTRY JRST MODMOR ;LOOK FOR MORE MODFOC: PUSHJ P,SAVCEN ;SAVE NEW CENTRY PUSHJ P,FORCOD ;GENERATE FOR CODE PUSHJ P,OLDCEN ;GO TO OLD CENTRY MOVE B,DDCODE ;NEXT CODE MOVE X1,JAROUN ;JUMP AROUND LOC ADD X1,DDTCOD PUSHJ P,FIXADR ;JUMP INTO NEXT SETOM JAROUN ;NO MORE JUMP AROUND MOVE X1,FTYPE ;TYPE OF FOR INDEX MOVEM X1,TYPE ;SAVE FOR NEXT CODE PUSHJ P,NEXCOD ;NEXT CODE JRST MODMOR ;LOOK FOR MORE SAVCEN: MOVE X1,DDCODE SUB X1,DDTCOD ;NEW CENTRY EXCH X1,(P) ;SAVE IT JRST (X1) OLDCEN: PUSHJ P,HALJRS ;JRST TO OLD CENTRY ADD B,DDTCOD MOVE X1,CENTRY ADD X1,DDTCOD HRRM X1,(B) ;SET ADDRESS POP P,X1 ;RETURN ADDRESS POP P,CENTRY ;NEW CENTRY JRST (X1) MODMOR: PUSHJ P,KWSMOD ;MORE MODIFIERS ? SKIPA B,CENTRY ;NO, GET LAST CENTRY JRST MODLOO ;YES, DO THEM ADD B,DDTCOD MOVE X1,JFCLAD ;JUMP TO MODIFIERS ADD X1,DDTCOD PUSHJ P,FIXADR ;SET ADDRESS SKIPGE X1,JAROUN ;LAST JUMP AROUND JRST NXSM3 ;NONE THERE ADD X1,DDTCOD MOVE B,DDCODE ;NEXT STMNT PUSHJ P,FIXADR ;FOR JUMP AROUND NXSM3: TLNE C,F.TERM ;SEEN TERMINATOR YET JRST NXSM2 ; PUSHJ P,QSELS ; JRST ERTERM ;NO, ABOUT TIME MOVEM T,MULLIN JRST NXSM1 NXSM2: SETZB L,MULLIN ;END, UNSET MULTI-LINE MOVEI D,"\" ;WAS IT CAIE D,(C) ;BACKSLASH ? SOJA L,NXSM1 ;NO, REALLY NEXT LINE MOVEM T,MULLIN ;YES, SET MULTI-LINE PUSHJ P,NXCH ;GET NEXT CHAR MOVEI D,"\" CAIE D,(C) JRST NXSM1 MOVEM T,MULLIN ;SAVE POINTER PUSHJ P,NXCH MOVE B,DDCODE SKIPE X1,THENAD ;ANY THENS ? PUSHJ P,LNKTHN ;YES, FIX THEM UP SKIPE X1,ELSEAD ;ANY ELSES ? PUSHJ P,LNKTHN ;FIX THEM TOO SETZM THNCNT ;AND SET BACK ALL THE POINTERS CLEARM THENAD SETZM ELSEAD SETZM THNELS NXSM1: SKIPGE AFLAG ; JRST NXSM2A ; SKIPE VRFSET JRST NXTST1 NXSM2A: MOVE D,[SETZM VRFBOT] PUSHJ P,BUILDI ;ENTER HERE FROM ERROR ROUTINE NXTST1: SKIPE MULLIN ;FINISHED LINE ? JRST EACHLN ;NO MOVE B,DDCODE ;FIX UP THENS JRST SKIPE X1,THENAD PUSHJ P,LNKTHN ;FIX ADDRESS SKIPE X1,ELSEAD ;AND ELSES TOO, IF ANY PUSHJ P,LNKTHN NXTST2: JUMPE L,EACHLN NXSM1A: SKIPN DDCODE JRST EACHLN MOVE D,[JRST NXTEND] PUSHJ P,BUILDI MOVE B,FLFOR CAMGE B,CEFOR FAIL PUSH P,T PUSH P,C MOVE C,DDTCOD MOVE T,FLCAD MOVE T1,CECAD MOVE A,FLDON MOVEI B,1 PUSHJ P,LINKUP MOVE T,FLDPT MOVE T1,CEDTP MOVE A,T MOVEI B,1 PUSHJ P,LINKUP MOVE T,FLDIT LNKDD1: CAML T,CEDIT JRST LNKDD2 HRRZ A,(T) ADD A,FLDLT HRRM A,(T) AOJA T,LNKDD1 LNKDD2: MOVE T,FLSAD MOVE T1,CESAD MOVE A,FLDIT MOVEI B,1 PUSHJ P,LINKUP POP P,C POP P,T JRST @DDTCOD NXTST4: MOVE N,TOPSTG ;ERROR OCCURRED FROM USER PROGRAM CAIE N,CODROL ;IF NOT STMROL, IT DID JRST NXTST3 ;NO, MUST BE FOR BASDDT CODE MOVE N,.DDSA ;HAVE TO SAVE AC'S BLT N,@.DDTMP ;SAVE 'EM ALL SETOM DDSTRT ;DO NOT ALLOW CONTINUE MOVEI N,STMROL ;RESET TOPSTG FOR BASDDT MOVEM N,TOPSTG ;SO WE DON'T DESTROY WHAT WE NEED SETOM NOLINE ;DO NOT PRINT LINE # ON ERROR NXTST3: CLEARM MULLIN CLEARM ODF ;OUTPUT TO TTY CLEARM IFIFG ;INPUT TO TTY CLEARM DDTERR ;CLEAR ERROR FLAG PUSHJ P,PCRLF NXTEND: PUSHJ P,CLEAN JRST EACHLN CLEAN: MOVEI R,FORROL MOVE X1,CEIL-1(R) HRLZI X2,FLOOR(R) HRRI X2,FLOOR+1(R) MOVEM X1,FLOOR(R) BLT X2,FLDTP HRLZI X2,CEIL(R) HRRI X2,CEIL+1(R) MOVEM X1,CEIL(R) BLT X2,CEDTP CLEARM @FLOOR(R) SETOM TMPPNT MOVE X1,FLCAD MOVEM X1,CECAD MOVE X1,FLSAD MOVEM X1,CESAD POPJ P, FIXADR: HRRM B,(X1) ;YES, FIX ADDRESS POPJ P, ;RETURN LNKTHN: ADD X1,DDTCOD ;FIX X1 HRRZ X2,(X1) ;PICK UP THE LINK HRRM B,(X1) ;FIX ADDRESS JUMPE X2,CPOPJ ;ANOTHER LINK MOVE X1,X2 ;YES, SET X1 JRST LNKTHN ;AND CONTINUE SUBTTL STATEMENT GENERATORS ; ; DEFINE BASDDT ; XBAS: ASCIZ /DDT/ MOVE D,[JRST NXTEND] PUSHJ P,BUILDI JRST NXTSTA ;CHAIN STATEMENT. ; ;CHAIN HAS TWO FORMS: ; ; CHAIN DEV:FILENM.EXT, LINE NO. ; OR ; CHAIN , LINE NO. ; ;IN EACH CASE, ",LINE NO." IS OPTIONAL. ; ;XCHAIN IS REACHED FROM XCHAN. XCHAIN: PUSHJ P,QSA ASCIZ /IN/ JRST ILLINS PUSHJ P,CHKCR1 TLNN C,F.DIG+F.LETT JRST XCHAI1 MOVEI A,5 PUSH P,T PUSH P,C XCHA0: PUSHJ P,NXCH TLNE C,F.DIG+F.LETT SOJG A,XCHA0 JUMPN A,XCHA01 PUSHJ P,NXCH XCHA01: SETZ A, TLNN C,F.COMA+F.TERM+F.PER CAIN C,":" SETO A, POP P,C POP P,T JUMPE A,XCHAI1 XCHAI2: PUSHJ P,FILNAM ;PROCESS FORM 1. JUMP CATFLG MOVSI D,(HRLZI N,) ;THE CODE BEING GENERATED HLR D,CATFLG ;IS DESCRIBED IN MEMO PUSHJ P,BUILDI ;#100-365-033-00. MOVSI D,(HRRI N,) HRR D,CATFLG PUSHJ P,BUILDI MOVE D,[MOVEM N,NEWOL1] PUSHJ P,BUILDI MOVSI D,(HRLZI N,) HLR D,FILDIR PUSHJ P,BUILDI MOVSI D,(HRRI N,) HRR D,FILDIR PUSHJ P,BUILDI MOVE D,[MOVEM N,FILDIR] PUSHJ P,BUILDI MOVSI D,(HRLZI N,) HLR D,FILDIR+1 PUSHJ P,BUILDI MOVE D,[MOVEM N, FILDIR+1] PUSHJ P,BUILDI MOVE D,[SETZM FILDIR+2] PUSHJ P,BUILDI SKIPN DEVBAS JRST XCHA21 MOVE D,[MOVE N,[XWD 5,1]] PUSHJ P,BUILDI MOVE D,[MOVEM N,FILDIR+3] PUSHJ P,BUILDI MOVE D,[SETOM DEVBAS] XCHA20: PUSHJ P,BUILDI JRST XCHAI5 ;GO LOOK FOR LINE NO. ARG. XCHA21: SKIPN FILDIR+3 JRST XCHA22 MOVSI D,(HRLZI N,) HLR D,FILDIR+3 PUSHJ P,BUILDI MOVSI D,(HRRI N,) HRR D,FILDIR+3 PUSHJ P,BUILDI SKIPA D,[MOVEM N,FILDIR+3] XCHA22: MOVE D,[SETZM FILDIR+3] PUSHJ P,BUILDI MOVE D,[SETZM DEVBAS] JRST XCHA20 XCHAI1: PUSHJ P,MASCHK XCHAI7: MOVE D,[PUSHJ P,CHAHAN] PUSHJ P,BUILDI XCHAI5: TLNE C,F.TERM ;LINE NO. ARG? JRST XCHAI6 ;NO. TLNN C,F.COMA JRST ERTERM PUSHJ P,NXCH PUSHJ P,FORMLN ;YES. PUSHJ P,CHKINT MOVE D,[JUMPL N,CHAERR] PUSHJ P,BUILDI MOVE D,[CAILE N,303237] PUSHJ P,BUILDI MOVE D,[JRST CHAERR] PUSHJ P,BUILDI SKIPA D,[MOVEM N,RUNLIN] XCHAI6: MOVE D, [SETOM RUNLIN] PUSHJ P,BUILDI MOVE D, [SETOM CHAFLG] PUSHJ P,BUILDI MOVE D,[JRST CHAXIT] PUSHJ P,BUILDI JRST NXTSTA ;CHANGE STATEMENT ; CHANGE TO ; OR ;CHANGE TO ;COMPILES A FETCH AND PUT WHICH INTERFACE WITH THE "PUTSTR" ROUTINE XCHAN: PUSHJ P,QSA ;CHANGE OR CHAIN? ASCIZ /NGE/ JRST XCHAIN ;NOT CHANGE. TLNN C,F.LETT JRST XCHAN1 PUSH P,C PUSH P,T PUSHJ P,NXCH TLNE C,F.DIG PUSHJ P,NXCH CAMN C,[XWD F.STR,"%"] ;PERCENT? PUSHJ P,NXCH ;YES, EAT IT PUSHJ P,QSA ASCIZ /TO/ JRST XCHAN3 POP P,T POP P,C HRLI F,0 PUSHJ P,VECTOR JUMPN A,GRONK MOVSI D,(VECFRL) SKIPGE TYPE ;REAL? MOVSI D,(VECFIN) PUSHJ P,BUILDA ;GENERATE VECTOR FETCH PUSHJ P,QSF ;"TO" MUST FOLLOW ASCIZ /TO/ HRLI F,1 TLNN C,F.LETT JRST ERLETT PUSHJ P,ATOM CAIE A,5 CAIN A,6 JRST XCLAB1 JRST ILFORM XCLAB1: MOVSI D,(STOCHA) XCHAN2: PUSHJ P,BUILDA ;BUILD APPROPRIATE STORE UUO JRST NXTSTA XCHAN3: POP P,T POP P,C XCHAN1: PUSHJ P,FORMLS ;PROCESS STRING NAME PUSHJ P,EIRGNP PUSHJ P,QSF ASCIZ /TO/ HRLI F,0 PUSHJ P,VECTOR ;REGISTER VECTOR NAME JUMPN A,GRONK MOVSI D,(VECPRL) SKIPGE TYPE MOVSI D,(VECPIN) JRST XCHAN2 ;GO BUILD STORE UUO ; ; CLOSE STATEMENT ; XCLOSE: ASCIZ /SE/ PUSHJ P,GETCN2 ;GET CHANNEL NO XCLOS0: MOVE D,[PUSHJ P,CLSFIL] PUSHJ P,BUILDI MOVE D,[SETZM ACTBL-1(LP)] PUSHJ P,BUILDI HRRI D,FILD-1 PUSHJ P,BUILDI TLNN C,F.COMA ;MORE ? JRST NXTSTA ;NO PUSHJ P,GETCNA ;GET EM JRST XCLOS0 ; ; CONTINUE FROM BREAKPOINT REQUEST ; XCONT: PUSHJ P,QSA ;DID HE INCLUDE "T" ASCIZ /T/ JFCL ;WHO CARES SKIPN DDTFLG ;SHOULD HE CONTINUE FAIL TLNN C,F.CR ;JUST CONTINUE JRST XCONT1 ;NO, NEED LINE NUMBER SKIPGE DDSTRT ;CAN CONTINUE FAIL JRST XCONT2 ;CONTINUE XCONT1: PUSHJ P,GETLIN ;GET THE LINE REFERENCE HRRZM A,DDSTRT ;FOR RETURN XCONT2: MOVEI R,CODROL MOVEM R,TOPSTG MOVE X1,DERRGO ;RESTORE ERRGO MOVEM X1,ERRGO ;FROM DERRGO CLEARM NOLINE ;REMOVE BREAK POINT FLAG HRLZ N,.DDSA ;MUST RESTORE AC'S BLT N,17 ;RESTORE THEM SETOM PFLAG ; JRST @DDSTRT ;CONTINUE XCONT3: HRRZ N,(A) ;GET GOTO ADDRESS HRRZM N,DDSTRT PUSHJ P,CLEAN JRST XCONT2 ;RELEASE BREAK AND GO XCONT6: MOVE P,@.DDTMP ;RESTORE ORIGINAL P MOVE N,A ;RETURN ADDRESS -1 AOJ N, ;RETURN HERE PUSH P,N ;SET UP RETURN JRST XCNT4A ;RESUME XCONT4: MOVE P,@.DDTMP ;RESTORE ORIGINAL P PUSH P,@ONGADR ;PUSH RETURN ADDRESS XCNT4A: MOVE N,(A) HRLI N,(GOSUB) ;SET UP GOSUB MOVEM N,40 ;FAKE UUO MOVEI R,CONROL MOVEM R,TOPSTG HRLZ N,.DDSA BLT N,16 PUSH P,[XWD 0,XCONT5] SETOM PFLAG ; CLEARM NOLINE ;REMOVE BREAKPOINT FLAG JRST GOSBER XCONT5: MOVE N,.DDSA BLT N,@.DDTMP MOVEI X1,STMROL MOVEM X1,TOPSTG SETZM PFLAG ; SETOM NOLINE ;BACK IN BREAK POINT CODING POPJ P, ; ; END STATEMENT ; XEND: TLNN C,F.CR FAIL SKIPE THNELS FAIL MOVE D,[JRST DDTXIT] ;COMPILE TERMINATE EXIT PUSHJ P,BUILDI ;GENERATE IT JRST NXTSTA ;GO FOR NEXT ; DDTXIT: CLEARM RUNDDT ;NO MORE DDT CLEARM DDTFLG ;NO MORE BREAKS CLEARM NOLINE ;REMOVE BREAKPOINT FLAG JRST EUXIT ;EXIT ; ; DECLARE STATEMENT ; XDEC: PUSHJ P,QSA ;DID HE INCLUDE FULL COMMAND ASCIZ /LARE/ JFCL ;WHO CARES XDECA: TLNN C,F.LETT ;DID WE SEE A LETTER? FAIL PUSHJ P,SCNLT1 ;LTR TO A, LEFT JUSTIFY, 7 BIT PUSHJ P,DIGIT ;CHECK FOR DIGIT PUSHJ P,PERCNT ;CHECK FOR PERCENT TLNN C,F.COMA ;SEPARATOR? TLNE C,F.TERM ;OR TERMINATOR? JRST XDEC1 ;YES, GO BUILD FAIL XDEC1: MOVEI R,VARROL ;SETUP TO SEARCH VARROL PUSHJ P,SEARCH ;IS IT THERE? CAIA ;NOT THERE, TREMENDOUS FAIL XDEC1A: PUSH P,B ;SAVE LOCATION FOR NEW VARIABLE PUSH P,A ;SAVE NEW VARIABLE NAME MOVSI A,777660 ;BASDDT VARAIABLE NAME XDEC2: PUSHJ P,SEARCH ;IS IT THERE? JRST XDEC3 ;NOT THERE POP P,A ;GET NEW VARIABLE NAME HRR A,(B) ;GET ITS LOCATION POP P,X1 ;GET LOCATION TO STORE NEW VARIABLE CAMN B,X1 ;SAME JRST XDEC3A ;YES XDEC3B: MOVE X2,-1(B) ;MOVE ROLL DOWN MOVEM X2,(B) ;ONE WORD MOVED SOJ B, ;DECREMENT ADDRESS CAME B,X1 ;LAST ONE MOVED JRST XDEC3B ;NO, DO NEXT XDEC3A: MOVEM A,(B) ;STASH IT TLNE C,F.TERM ;TERMINATOR JRST NXTSTA ;GO FOR NEXT PUSHJ P,NXCHK ;SWALLOW COMMA JRST XDECA ;GO AGAIN XDEC3: CAML A,[XWD 777760,0] ;ALL LOCATIONS TRIED? FAIL ADD A,[XWD 20,0] ;NEXT VARIABLE JRST XDEC2 ;CONTINUE ; ELSE STATEMENT XELSE: MOVEM T,MULLIN ;SAVE POINTER PUSHJ P,QSA ASCIZ /E/ JRST ILLINS SOSGE THNCNT ;IS ELSE LEGAL? FAIL SKIPE ELSFLG ;SINGLE WORD THEN JRST XELS0 ;YES, SKIP ADDRESS FIX MOVE X1,THENAD ;PICK UP THEN LINKAGE ADD X1,DDTCOD MOVE B,DDCODE ;ADDRESS FOR THENS JRST AOJ B, ;ALLOW FOR ELSES JRST OR CAIA HRRZ X2,(X1) MOVEM X1,THENAD ;SAVE IT HRRM B,(X1) MOVEM X2,THENAD XELS0: TLNE C,F.DIG ;DIGIT JRST ELSGO ;YES, LET GO TO HANDLE IT SKIPE ELSFLG ;SINGLE WORD THEN JRST XELS1 ;YES, PUSHJ P,HALJRS ;NO, GEN HALT/JRST PUSHJ P,FIXELS ;FIX THE ELSE XELS1: CLEARM ELSFLG ;CLEAR FLAG JRST NXSM1 ;AND DO NEXT STMNT ELSGO: MOVSI D,(CAIA) ;SKIP FROM THEN SKIPN ELSFLG ;UNLESS IT WAS A JRST PUSHJ P,BUILDI PUSHJ P,XGOFR ;DO GOTO CODE SETZM ELSFLG ;UNSET SINGLE WORD THEN TLNN C,F.CR ;END OF LINE? CAMN C,[XWD F.APOS,"'"] JRST NXSM2 ;YES, END IT ALL PUSHJ P,QSELS ;LOOK FOR ELSE JRST ERTERM JRST NXTSTA ;NEXT STATEMENT FIXTHN: SKIPN X1,THENAD JRST FIXTH1 ADD B,DDTCOD HRRM X1,(B) SUB B,DDTCOD FIXTH1: MOVEM B,THENAD POPJ P, FIXELS: SKIPN X1,ELSEAD JRST FIXEL1 ADD B,DDTCOD HRRM X1,(B) SUB B,DDTCOD FIXEL1: MOVEM B,ELSEAD POPJ P, ; ; FOR STATEMENT ; ;CALCULATE INITIAL, STEP, AND FINAL VALUES ; ;SET INDUCTION VARIABLE TO INITIAL VALUE ;AND JUMP TO END IF IND VAR .GT. FINAL ;INCREMENTING IS HANDLED AT CORRESPONDING NEXT. ;FIVE WORD ENTRY PLACED ON FORROL FOR USE ;BY CORRESPONDING NEXT STATEMENT: ; CURRENT VALUE OF L (FOR "FOR WITHOUT NEXT" MESSAGE) ;,< ADRS OF JRST TO END OF NEXT> ; ; ; XFOR: SKIPE THNELS ;UNDER THEN OR ELSE FAIL PUSHJ P,FORCOD ;GO GENERATE CODE TLNN C,F.TERM ;MODIFIERS ILLEGAL IN FOR FAIL JRST NXTSTA ;DO NEXT STMNT FORCOD: TLNN C,F.LETT ;MAKE SURE VARIABLE IS FIRST. JRST ERLETT HRLI F,777777 PUSHJ P,REGLTR ;REGISTER ON SCAROL CAIE A,1 ;BETTER BE SCALAR JRST ILVAR TLNN C,F.EQAL ;BETTER HAVE EQUAL JRST EREQAL MOVE X1,TYPE ;GET TYPE FOR 'FOR' MOVEM X1,FTYPE ;SAVE IT PUSHJ P,NXCHK ;SKIP EQUAL SIGN. PUSH P,B ;SAVE THE VARIABLE POINTER PUSHJ P,FORMLN ;GEN THE INITIAL VALUE PUSHJ P,EIRGNP PUSHJ P,CMIXER ; MOVSI D,(MOVEM N,) ;GEN STORE INITIAL IN VARIABLE MOVE B,(P) PUSHJ P,BUILDA SETZ B, ;GET A ZERO WORD PUSH P,B ;PUT IT ON STACK FOR INCREMENT PUSH P,B ;PUT IT ON STACK FOR UPPER BOUND FORELS: PUSHJ P,KWSFOR ;LOOK FOR FOR KEYWORDS JRST FORSET ;NO MORE MOVE X1,KWDIND ;INDEX TO KEYWORD SUBI X1,KWAFOR-1 LSH X1,-1 JRST @FRKEYS(X1) ;GO HANDLE KEYWORD ELEMENT FRKEYS: JRST FORTOC ;TO JRST FORBYC ;BY OR STEP JRST FORWHC ;WHILE JRST FORUNC ;UNTIL FORTOC: SKIPE (P) ;SEEN TO ALREADY ? FAIL PUSHJ P,FORMLN ;GEN THE UPPER BOUND. JUMPL B,XFOR4 ;EXCEPT FOR THE SPECIAL MOVE X1,FTYPE ; CAMN X1,TYPE ; JRST XFOR2 ; PUSHJ P,EIRGEN ;PUT IT IN A REGISTER PUSHJ P,CHKTYP ;FIX OF FLOAT IT JRST XFOR4+1 ; XFOR2: HLRZ X1,B ;CASE OF A POSITIVE ANDI X1,ROLMSK ;CONSTANT, FORCE THE CAIE X1,CADROL ;UPPERBOUND TO BE CAIN X1,CONROL ; JRST XFLAB1 ;STORED IN A XFOR4: PUSHJ P,EIRGEN ;PERMANENT PUSHJ P,SIPGEN ;TEMPORARY. XFLAB1: MOVEM B,(P) ;REMEMBER WHERE IT IS JRST FORELS ;GO FOR NEXT KEYWORD FRBY1: MOVEM C,FORCAR ;SAVE CHAR MOVEM T,FORPNT ;AND POINTER MOVE T,[POINT 7,[BYTE (7)"1",15]] ;IMPLICIT "STEP1" PUSHJ P,NXCH ;PULL IN 1 CAIA FORBYC: SETZM FORCAR ;FLAG EXPLICIT STEP SKIPE -1(P) ;ALREADY SEEN INCRE ? FAIL PUSHJ P,FORMLN ;XLATE AND GEN INCREMENT SETZM CATFLG ;CATFLG=0 SAYS STEP IS NOT A CONSTANT. HLRZ X1,B ANDI X1,ROLMSK CAIE X1,CADROL CAIN X1,CONROL JRST XFLAB2 JRST XFOR6 XFLAB2: MOVE X1,FTYPE ; CAMN X1,TYPE ; JRST XFOR5 ; PUSHJ P,EIRGEN ; PUSHJ P,CHKTYP ; JRST XFOR7 ; XFOR5: SETOM CATFLG ;EXCEPT FOR THE SPECIAL JRST XFOR7 ;CASE OF A CONSTANT, XFOR6: PUSHJ P,EIRGEN ;SAVE THE STEP VALUE MOVE X1,FTYPE ; CAME X1,TYPE ; PUSHJ P,CHKTYP ; XFOR7: PUSHJ P,SIPGEN ;IN A PERMANENT TEMP. MOVEM B,-1(P) ;REMEMBER WHERE IT IS SKIPN FORCAR ;EXPLICIT STEP ? JRST FORELS ;YES, NEXT KEYWORD MOVE C,FORCAR ;NO, RESTORE CHAR MOVE T,FORPNT ;AND POINTER JRST FORTER ;GENERATE TERMINATE CODE FORSET: SKIPN (P) ;SEEN UPPER BOUND FAIL MOVMM P,LOGNEG ;MAKE LOGNEG + TO FLAG NO COND JRST XFOR1 ;GO CHECK STEP FORUNC: SETOM LOGNEG ;FLAG LOGICAL NEGATION CAIA FORWHC: SETZM LOGNEG ;STRAIGHT LOGIC XFOR1: SKIPN -1(P) ;SEEN INCREMENT JRST FRBY1 ;NO, GENERATE 1 FORTER: SKIPN (P) ;SEEN UPPER BOUND ? JRST FORCTR ;NO, JUST LOGIC MOVE B,-2(P) ;GET INDUCTION VAR IN REG PUSHJ P,EIRGEN SKIPE CATFLG JRST XFOR3 MOVE B,-1(P) ;GET THE INCREMENT POINTER MOVSI D,(DONFOR) ;BUILD DONFOR EXCEPT FOR A PUSHJ P,BUILDA ;CONSTANT STEP. XFOR3: MOVE X1,-1(P) MOVE B,(P) ;BUILD COMPARE INSTR (IT MOVSI D,(CAMLE N,) ;DOESN'T MATTER WHAT IT SKIPGE X1 ;IS IF DONFOR IS THERE). MOVSI D,(CAMGE) PUSHJ P,BUILDA HRLM B,FORPNT ;STORE CAM ADR FOR NEXT JRST FORCTZ ;CHECK IF LOGIC NEEDED TOO FORCTR: MOVE X1,DDCODE ;NEXT LOC SUB X1,DDTCOD HRLM X1,FORPNT ;FOR NEXT TO JRST TO SETCMM LOGNEG ;REVERSE LOGIC JRST FORLOG ;GO DO LOGIC FORCTZ: SKIPLE LOGNEG ;ANY LOGIC ? JRST FORZZZ ;NO, REALLY GO FINISH UP MOVNI A,4 FORCOP: MOVE D,FORRUN+4(A) PUSHJ P,BUILDI ;COPY LOGIC STORE CODE AOJL A,FORCOP FORLOG: MOVE B,-2(P) ;GET INDUCTION VAR MOVSI D,(MOVEM N,) ;GENERATE STORE PUSHJ P,BUILDA PUSHJ P,IFCCOD ;GO GENERATE LOGIC CODE MOVE D,[SKIPN FTRUTH] ;LOGIC TRUE, WAS CAM ? SKIPE (P) ;NO UPPER BOUND ? PUSHJ P,BUILDI FORZZZ: POP P,B ;POP OFF UPPER BOUND PUSHJ P,HALJRS ;BUILD HALT OR JRST TO NEXT+1 HRRM B,FORPNT ;TELL NEXT WHERE IT IS MOVE B,-1(P) ;INDUCTION VAR MOVSI D,(MOVEM N,) ;STORE CODE SKIPLE LOGNEG ;IF NO LOGIC PUSHJ P,BUILDA MOVE A,L ;SAVE L FOR POSSIBLE ERROR MSG MOVEI R,FORROL PUSHJ P,RPUSH MOVE A,FORPNT ;GET JRST POINTERS PUSHJ P,RPUSH ;ON FOR STACK POP P,FORPNT POP P,A ;AND INDUCTION VAR PUSHJ P,RPUSH MOVE A,FORPNT ;AND INCREMENT PUSHJ P,RPUSH MOVE A,TMPLOW ;SAVE PROT LEVEL TO BE RESTORED BY NEXT PUSHJ P,RPUSH MOVE A,TMPPNT ;PROTECT TEMPS USED BY THIS "FOR" MOVEM A,TMPLOW ;IN THE RANGE OF THE FOR. POPJ P, FORRUN: TDZA X1,X1 ;RUN-TIME LOGIC STORE SETO X1, MOVEM X1,FTRUTH SKIPE FTRUTH ;SKIP STORE IF LOOP OVER HALJRS: MOVSI D,(JRST) ;ELSE JRST PUSHJ P,BUILDI POPJ P, ;GOSUB STATEMENT XLATE XGOSUB: ASCIZ /UB/ SETZM ONGFLG XGOS: MOVE D,[JSP A,XCONT6] ; SKIPE ONGFLG ; HRRI D,XCONT4 ; PUSHJ P,BUILDI ; PUSHJ P,GETLIN ;GET THE LINE REFERENCE MOVE D,FLGSB ;MAKE SEARCH OF GSBROL XGOS1A: CAML D,CEGSB ;LOOKED AT ALL FAIL CAME A,(D) ;IS THIS IT AOJA D,XGOS1A ;NO, CHECK NEXT HRLI D,(JFCL) ;BUILD FAKE GOSUB UUO PUSHJ P,BUILDI ;GENERATE IT SKIPN ONGFLG JRST NXTSTA TLNN C,F.COMA JRST XON2 PUSHJ P,NXCHK JRST XGOS ;GOTO STATEMENT XGOTO: ASCIZ /O/ PUSHJ P,QSA ASCIZ /BASDDT/ JRST XGOFIN JRST XBAS+1 XGOFIN: PUSH P,[Z NXTSTA] ;BUILD GOTO AND END STA XGOFR: PUSHJ P,GETNUM ;BUILD GOTO AND RETURN FAIL XGOGT: HRLZ A,N ;LOOK FOR DESTINATION MOVEI R,LINROL PUSHJ P,SEARCH FAIL ,1 SUB B,FLLIN ;NOW CHECK FOR JUMP INTO/OUTOF FUNCTION PUSH P,B ADD B,FLREF PUSH P,(B) ;SAVE REF TO GO TO LINE MOVE A,SORCLN HRLZ A,(A) PUSHJ P,SEARCH JFCL ;IMPOSSIBLE ERROR SUB B,FLLIN ADD B,FLREF ;GET THAT TO CURRENT LINE POP P,X1 CAME X1,(B) ;SAME ? FAIL ,1 MOVE D,[JSP A,XCONT3] ;TO RELEASE BREAKPOINT PUSHJ P,BUILDI ;GENERATE POP P,B ;RESTORE B HRLI B,LADROL MOVSI D,(JFCL) ;NO-OP PUSHJ P,BUILDA POPJ P, ; ; IF STATEMENT ; ;::=IF THEN ; OR ; ::= IF THEN ; OR ; ::=IF END THEN ;RELATION IS LOOKED UP IN TABLE (RELROL) ;WHICH RETURNS INSTRUCTION TO BE EXECUTED ;IF ONE OF THE EXPRESSIONS BEING COMPARED IS ;IN THE REG, THAT ONE WILL BE COMPARED AGAINST ;THE OTHER IN MEMORY. IF NECESSARY, THE ;INSTRUCTION IS CHANGED TO ITS CONTRAPOSITIVE ;BY FUDGING BITS IN THE OP CODE ;IF STATEMENT XIF: PUSHJ P,QSA ASCIZ/END/ JRST IFSX7 ;HERE FOR NORMAL IF STATEMENTS. CAIE C,":" ;HERE FOR IF END STATEMENT. JRST XIF1 ;SEQ. ACCESS IF END. PUSHJ P,GETCNA ;R.A. IF END. MOVNI A,4 XIF2: MOVE D,IFNCOD+4(A) PUSHJ P,BUILDI AOJL A,XIF2 JRST IFSX5 IFNCOD: SKIPL ACTBL-1(LP) ;CODE GENERATED. JRST FNMXER MOVE N,LASREC-1(LP) CAMGE N,POINT-1(LP) XIF1: CAME C,[XWD F.STR,"#"] JRST ERCHAN PUSHJ P,GETCNA MOVE D,[PUSHJ P,EOF] PUSHJ P,BUILDI HRLOI D,(TROA) PUSHJ P,BUILDI HRLZI D,(SETZ) PUSHJ P,BUILDI HRLZI D,(SKIPE) PUSHJ P,BUILDI JRST IFSX5 IFSX7: SETZM LOGNEG ;DO NOT NEGATE LOGIC PUSHJ P,IFCCOD ;GENERATE IF CODE IFSX5: TLNE C,F.COMA ;SKIP OPTIONAL COMMA. PUSHJ P,NXCH PUSHJ P,THENGO ;LOOK FOR "THEN" OR "GOTO" AOS THNCNT ;UP THEN COUNT SETOM THNELS ;MARK REST OF LINE UNDER CONDITIONAL TLNN C,F.DIG ;NEXT CHAR A DIGIT ? JRST IFCGO ;NO PUSHJ P,XGOFR ;USE GOTO CODE TO GEN JRST INSTR SETOM ELSFLG ;SINGLE WORD THEN FLAG TLNN C,F.CR ;END OF LINE? CAMN C,[XWD F.APOS,"'"] JRST NXSM1 ;YES, DON'T LOOK FOR ELSE PUSHJ P,QSELS ;ELSE THERE TOO ? JRST ERTERM MOVEM T,MULLIN ;YES, MARK MULTI JRST NXSM1 ;AND LET STATEMENT HANDLER DO IT IFCGO: PUSHJ P,REVSEN ;REVERSE LOGIC PUSHJ P,HALJRS ;JRST/HALT AROUND THEN CODE PUSHJ P,FIXTHN ;FIX THEN ADDRESS JRST NXSM1 IFCCOD: PUSHJ P,FORMLB ; MOVE X2,DDCODE ;LAST CODE GENERATED HLRZ X1,-1(X2) ;CHECK FOR POSSIBLE OPTIMIZATION CAIE X1,(SETO) ;WAS TDZA AND SETO GENERATED? JRST IFCOD1 ;NO, MUST TEST TRUTH VALUE MOVE B,X2 ;NEW ADDRESS SUBI B,2 ;YES, REMOVE THE TWO INSTRUCTIONS MOVEM B,DDCODE ;BY SETTING NEW CEIL SOJ B, ;LAST CODE GENERATED ADDRESS SUB B,DDTCOD ;CHANGE TO OFFSET SKIPL LOGNEG ;DOUBLE REVERSE = NOTHING PUSHJ P,REVSEN ; POPJ P, ;RETURN IFCOD1: MOVSI D,(SKIPE) ;SKIP IF TRUE PUSHJ P,BUILDA ;GENERATE THE SKIPN SKIPL LOGNEG ;NEED REVERSE LOGIC POPJ P, ;AND RETURN REVSEN: ADD B,DDTCOD ;ADDRESS OF LAST RELATION MOVE D,(B) ;CAM??/SKIP? INSTRUCTION TLC D,4000 ;REVERSE SENSE MOVEM D,(B) ;PUT BACK SUB B,DDTCOD ;RESTORE B POPJ P, ; ; INPUT AND READ STATEMENT GENERATOR ; ; IN THE FOLLOWING CODE, WRREFL IS FIRST USED AS A FLAG ; FOR READ (-1) AND INPUT (0). AT XINP1, WRREFL IS THEN USED ; TO FLAG SEQUENTIAL ACCESS (0) AND RANDOM ACCESS (-1). ; XREAD: ASCIZ /D/ ;REMAINDER OF READ STATEMENT SETOM WRREFL ;FLAG READ, NOT INPUT JRST XINPT0 ;PRODUCE SET UP CODE ; XINPUT: ASCIZ /UT/ ;REMAINDER OF INPUT STATEMENT CLEARM WRREFL ;FLAG INPUT, NOT READ PUSHJ P,QSA ;CHECK FOR INPUT LINE ASCIZ /LINE/ JRST XINPT0 ;NO SETOM INLNFG ;YES, FLAG IT XINPT0: SETZM INPPRI ;NOT INPUT FROM TTY CAIN C,":" ;RANDOM ACCESS? JRST XINRAN ;YES, HANDLE IT SEPARATELY CAME C,[XWD F.STR,"#"] ;SEQUENTIAL ACCESS? JRST XINP5 ;NO, MUST BE JUST READ OR INPUT PUSHJ P,GETCNB ;GENERATE CODE FOR CHANNEL AND SCAN DELIMITER MOVE D,[PUSHJ P,INSET] ;FETCH INSTRUCTION FOR SETTING INPUT PUSHJ P,BUILDI ;BUILD IMMEDIATE MOVEI D,REAINP-1 ;GENERATE CODE TO CHECK FOR PUSHJ P,GENTYP ;MIXING READ# WITH INPUT# MOVE D,[JRST REINER] ;FAILURE RETURN PUSHJ P,BUILDI ;BUILD IMMEDIATE MOVE D,[PUSHJ P,DOINPT] ;FETCH DO INPUT INSTRUCTION JRST XINP0 ;GO HANDLE ARGUUMENT LIST ; ; CODING FOR READ, AND INPUT ; XINP5: MOVSI D,(CLEAR LP,) ;NON DISK INPUT/READ, CHANNEL IS ZERO PUSHJ P,BUILDI ;BUILD IMMEDIATE SKIPN INLNFG ;INPUT LINE? SKIPE WRREFL ;INPUT? JRST XINP5A ;NO, CARRY ON SETOM INPPRI ;STRING OUTPUT IS NOW LEGAL TLNN C,F.QUOT ;IS THERE ONE COMING UP JRST XINP5A ;NO XINP5L: PUSHJ P,XINOUT ;YES, DO IT SKIPA D,[PUSHJ P,INSEQ] ;SUPPRESS QUERY XINP5A: MOVE D,[PUSHJ P,INSET] ;FETCH INSTRUCTION FOR INPUT SETTING PUSHJ P,BUILDI ;BUILDI IMMEDIATE MOVE D,[PUSHJ P,DOINPT] ;ASSUME THIS IS INPUT SKIPN WRREFL ;WERE WE RIGHT? JRST XINP0 ;YES, SKIP DATA CHECK FOR READ SKIPL DATAFF ;CHECK IF WE HAVE SEEN DATA HLLOS DATAFF ;WE HAVE NOT, FLAG THAT DATA IS NEEDED HRRI D,DOREAD ;CHANGE DOINPT TO DOREAD XINP0: PUSHJ P,BUILDI ;BUILD IMMEDIATE, TO DO READ OR INPUT CLEARM WRREFL ;CHANGE FLAG FOR SEQUENTIAL ACCESS ; ; GENERATE CODE FOR THE ARGUMENT LISTS ; XINP1: CLEAR F, ;STRINGS AND NUMERICS MAY BE INPUT PUSHJ P,REGCLT ;GET VARIABLE IN ARGUMENT LIST SKIPN INLNFG ;INPUT LINE? JRST XINP91 ;NO, CONTINUE TLNE F,-2 ;MUST BE A STRING FAIL XINP91: SKIPN IFFLAG ;HAS TYPE OF INPUT BEEN DECLARED MOVEM F,IFFLAG ;NO, MAKE TYPE = FIRST VARIABLE'S TYPE SKIPN WRREFL ;SEQUENTIAL ACCESS? JRST XINP9 ;YES, STRINGS AND NUMERICS ARE LEGAL XOR F,IFFLAG ;CHECK TYPE OF THIS VARIABLE JUMPGE F,XINP9 ;AGAINST TYPE OF FIRST FAIL XINP9: JUMPE A,XINP2 ;VARIABLE IS A NUMERIC ARRAY CAIG A,4 ;POSSIBLY A STRING? JRST XINP1A ;NO, BETTER BE SCALAR, CHECK IT OUT CAILE A,6 ;IS IT IN FACT A STRING? JRST ILFORM ;NO, BAD FORMAT ; ; CODE FOR STRING VARIABLES ; XINP6: PUSHJ P,FLET2 ;FINISH REGISTERING THE STRING MOVEI X1,3 ;FLAG TO USE STRING UUOS XINP6A: HRLZ D,INUUO(X1) ;ASSUME RANDOM ACCESS, GET INPUT UUO FOR IT SKIPN WRREFL ;IS IT? HLLZ D,INUUO(X1) ;NO, GET FOR SEQUENTIAL ACCESS SKIPGE TYPE ;INTEGER? TLO D,400 ;YES, MARK IT SKIPN INLNFG ;INPUT LINE? JRST XINP6B ;NO, CONTINUE TLNN C,F.TERM ;CAN ONLY BE ONE FAIL PUSH P,B ;SAVE ADDRESS PUSH P,D ;SAVE OP CODE MOVE D,[SETOM INLNFG] ;FLAG FOR INPUT LINE PUSHJ P,BUILDI ;GEN IT POP P,D ;RESTORE OPCODE POP P,B ;RESTORE ADDRESS XINP6B: PUSHJ P,BUILDA ;BUILD UUO WITH ADDRESS IN B JRST XINP3 ;CHECK FOR MORE ARGUMENTS IN LIST ; ; HERE FOR SCALAR, MAKE SURE IT IS ; XINP1A: CAIE A,1 ;IS IT A SCALAR? JRST ILVAR ;NO, ILLEGAL VARIABLE CLEAR X1, ;FLAG TO USE SCALAR UUOS JRST XINP6A ;BUILDI THE INPUT/READ UUO ; ; HERE FOR ARRAY/VECTOR ; XINP2: PUSH P,B ;SAVE ADDRESS OF ARRAY/VECTOR PUSHJ P,XARG ;GO GET THE SUBSCRIPTS HRLZ D,INUUO+1 ;ASSUME RANDOM ACCESS FOR 1-DIM SKIPN WRREFL ;IS IT RANDOM ACCESS? HLLZ D,INUUO+1 ;NO, CHANGE TO SEQUENTIAL ACCESS JUMPE B,XINP2A ;IS IT 1-DIM OR 2-DIM? HRRZ X1,(P) ;2-DIM, GET POINTER TO ARAROL ADD X1,FLARA ;ADD IN FLOOR FOR ADDRESS SKIPN 1(X1) ;HAS DIM FOR THIS VARIABLE BEEN DECLARED? SETOM 1(X1) ;NO, MARK AS 2-DIM HRLZ D,INUUO+2 ;GET RANDOM ACCESS UUO FOR 2-DIM SKIPN WRREFL ;GUESS RIGHT? HLLZ D,INUUO+2 ;NO, CHANGE TO SEQUENTIAL ACCESS XINP2A: EXCH B,(P) ;EXCH # OF SUBSCRIPTS WITH VARIABLE ADDRESS SKIPGE TYPE ;INTEGER? TLO D,400 ;YES, MARK IT PUSHJ P,BUILDA ;BUILD INPUT UUO WITH ADDRESS IN B POP P,B ;RESTORE # OF SUBSCRIPTS PUSHJ P,GENARG ;GENERATE THE JUMPS FOR THE SUBSCRIPTS ; ; END OF ONE VARIABLE ; XINP3: PUSHJ P,CHKDEL ;CHECK FOR DELIMITER, RETURN IF FOUND SKIPE INPPRI ;SHOULD WE CHECK FOR STRING? TLNN C,F.QUOT ;YES, IS THERE ONE? JRST XINP1 ;NO, PROCESS NEXT VARIABLE IN LIST JRST XINP5L ;YES, PROCESS AND RE-SETUP TTY XINOUT: MOVE D,[PUSHJ P,OUTSET] ;SETUP FOR OUTPUT PUSHJ P,BUILDI ;BUILDI IMMEDIATE PUSHJ P,FORMLS ;GET THE STRING MOVSI D,(PRSTR) ;SETUP STRING OUTPUT UUO PUSHJ P,CHKFMT ;HANDLE THE DELIMITER PUSHJ P,BUILDA ;OUTPUT STRING WITH ADDRESS IN B CAIN C,"_" ;WANT TO SUPPRESS QUERY JRST NXCH ;YES, GOBBLE _ AND DO IT AOS (P) ;NO, SKIP POPJ P, ;RETURN ; ; HERE FOR RANDOM ACCESS INPUT/READ ; XINRAN: SKIPE INLNFG ;INPUT LINE? FAIL PUSHJ P,GENTP1 ;PROCESS CHANNEL, DELIMITER AND PRODUCE ;CODE TO CHECK IF FILE IS R. A. CLEARM IFFLAG ;CLEAR TYPE FLAG SETOM WRREFL ;FLAG RANDOM ACCESS, NOT SEQUENTIAL JRST XINP1 ;PROCESS ARGUMENT LIST ; ; INPUT/READ UUOS ; INUUO: DATA (DATA 1,) ;FOR SCALARS ADATA1 (DATA 2,) ;FOR 1-DIM ADATA2 (DATA 3,) ;FOR 2-DIM STRIN (DATA 4,) ;FOR STRINGS ; ; LET STATEMENT ; XLET: SETOM LETSW ;LOOK FOR A LHS. PUSHJ P,FORMLB MOVEM F,IFFLAG ;STORE TYPE (STR OR NUM) IN IFFLAG. SKIPL LETSW ;IF NOT LHS, GIVE REASONABLE ERROR JRST GRONK TLNN C,F.EQAL+F.COMA ;MUST BE A RHS OR ANOTHER LHS. JRST EREQAL XLET0: SKIPL LETSW ;FAIL IF THIS FORMULA IS NOT A VARIABLE. JRST GRONK SKIPGE IFFLAG ;STR? JRST XLLAB1 ;NO. PUSHJ P,PUSHPR ;YES. REMEMBER ADDR OF RESULT POINTER. JRST XLET1 XLLAB1: CAIE A,1 ;FOR NUM LETS, IF THE LHS IS A LIST OR JRST XLET1 ;TABLE, FORMLA HAS STORED AC B AND A PUSH P,[EXP 1] ;FLAG ON PLIST. IF THE LHS IS A SCALAR, SKIPGE TYPE ;IT IS AN INTEGER? TLO B,100000 ;YES, MARK IT AS SUCH PUSH P,B ;PUT THE FLAG AND AC B ON PLIST HERE. XLET1: PUSHJ P,NXCHK ;SKIP EQUAL SIGN. SOS LETSW ;COUNT THIS LHS, AND PUSHJ P,FORMLB ;LOOK FOR ANOTHER. XOR F,IFFLAG JUMPGE F,XLET1A FAIL XLET1A: TLNE C,F.EQAL+F.COMA ;IF NO =, TEMP. ASSUME THIS IS A RHS. JRST XLET0 MOVMS LETSW ;FINISHED SCANNING. SOS LETSW SKIPL IFFLAG ;STRING LET STA? JRST XLET4 ;YES. PUSHJ P,EIRGEN ;NO, GET RESULT IN REG MOVEM B,TEMP1 ;SAVE THE NEGATIVE RESULT CHECK XLET1B: MOVE D,[MOVEM N, (MOVNM N,)] SKIPG -1(P) ;FLAGS ON PLIST ARE -- MOVE D,[ARSTO1 N, (ARSTN1 N,)] ; 0 FOR LIST SKIPL -1(P) ; 1 FOR SCALAR JRST XLET2 ; -1 FOR TABLE. MOVE D,[ARSTO2 N, (ARSTN2 N,)] MOVE X1,0(P) ;DEFAULT ARRAY SIZE (10,10) ADD X1,FLARA SKIPN 1(X1) SETOM 1(X1) XLET2: SKIPGE TEMP1 ;CHECK FOR NEGATIVE RESULT MOVS D,D ;NEGATIVE. GET CORRECT INSTR. PUSH P,D ;SAVE OPCODE SKIPL TYPE ;IS IT AN INTEGER? JRST XLET3 ;NO, MOVE B,-1(P) ;GET TYPE OF OPERAND TLZE B,100000 ;ALSO AN INTEGER? JRST XLET5 ;YES, NOTHING TO DO CLEARM TYPE ;TYPE IS NOW REAL MOVE D,[PUSHJ P,FLTPNT] ;MUST FLOAT IT PUSHJ P,BUILDI ;GENERATE IT JRST XLET5 ;ALL DONE XLET3: MOVE B,-1(P) ; TLZN B,100000 ; JRST XLET5 ; SETOM TYPE ;TYPE IS NOW INTEGER MOVE D,[PUSHJ P,FIXPNT] PUSHJ P,BUILDI ; XLET5: POP P,D ;RESTORE MOVEM OPCODE POP P,B ;RESTORE RESULT PNTR TLZ B,100000 ;CLEAR TYPE FLAG PUSHJ P,BUILDA ;BUILD STORE INSTR POP P,B ;CHECK TRASH FROM PUSHLIST. JUMPG B,XLET2B ;ARRAY REF? PUSHJ P,GENARG ;YES. GEN ARGS FIRST. XLET2B: SOSLE LETSW JRST XLET1B ;THERE IS ANOTHER LHS. JRST NXTSTA XLET4: PUSHJ P,EIRGNP PUSHJ P,POPPR ;GET ADDRESS OF LEFT HALF POINTER BACK PUSH P,B MOVSI D,(STRSTO) ;BUILD THE STRING MOVE INSTRUCTION. PUSHJ P,BUILDA POP P,B SOSLE LETSW JRST XLET4 ;THERE IS ANOTHER LHS. JRST NXTSTA ; ; LIST BREAKPOINTS ; XLIST: PUSHJ P,QSA ;DID SHE INCLUDE T ASCIZ /T/ ;WHO CARES JFCL TLNN C,F.TERM ;TERMINATOR? FAIL PUSH P,T ;SAVE BYTE POINTER PUSH P,C ;SAVE CURRENT CHARACTER PUSHJ P,INLMES ;LABEL ASCIZ /STOPs:/ MOVE X1,FLLAD ;START SEARCHING AT LADROL XLIST1: CAML X1,CELAD ;ALL LOOKED AT? JRST XLIST3 ;YES, RETURN HRRE A,(X1) ;GET FIRST LINE JUMPGE A,XLIST2 ;STOP HERE? MOVE B,X1 ;GET ADDRESS IN LADROL SUB B,FLLAD ;ELEMENT IN LADROL ADD B,FLLIN ;ADDRESS IN LINROL HLRZ T,(B) ;GET STATEMENT NUMBER MOVEI C,11 PUSHJ P,OUCH PUSHJ P,PRTNUM ;PRINT IT XLIST2: AOJA X1,XLIST1 ;CONTINUE XLIST3: PUSHJ P,PCRLF ;OUTPUT POP P,C ;RESTORE C POP P,T ;RESTORE T JRST NXTSTA ;GO FOR NEXT ; ; MARGIN AND MARGIN ALL STATEMENTS. ; ;THIS ROUTINE IS ALSO USED BY THE PAGE AND PAGE ALL STATEMENTS, ;SINCE THEY GENERATE IDENTICAL CODE, EXCEPT FOR THE PUSHJ AT ;THE END OF THE CODE FOR EACH ARGUMENT. FOR A DESCRIPTION OF THE ;CODE GENERATED, SEE MEMO #100-365-033-00. XMAR: ASCIZ /GIN/ SETZM TABLE ;TELLS THAT THIS IS REALLY MARGIN (ALL). XMAR0: PUSHJ P,QSA ;ENTRY POINT FOR PAGE (ALL). ASCIZ /ALL/ JRST XMAR6 ;MARGIN OR PAGE. TLNE C,F.TERM ;MARGIN ALL OR PAGE ALL. JRST ERDIGQ ;ALL MUST HAVE ARG. PUSHJ P,FORMLN ;GENERATE CODE FOR THE ARG. PUSHJ P,EIRGEN PUSHJ P,CHKINT ;MUST BE INTEGER MOVE D,[PUSHJ P,MARGAL] SKIPE TABLE HRRI D,PAGEAL PUSHJ P,BUILDI JRST NXTSTA XMAR6: TLNE C,F.TERM JRST ERDIGQ XMAR1: HRRZ A,C CAIE A,"#" ;CHANNEL SPECIFIER? JRST XMAR2 ;NO, MUST BE TTY. PUSHJ P,GETCNB XMAR5: PUSHJ P,FORMLN PUSHJ P,EIRGEN PUSHJ P,CHKINT ;MUST BE INTEGER MOVE D,[PUSHJ P,PAGE] SKIPN TABLE HRRI D,MARGN PUSHJ P,BUILDI PUSHJ P,CHKDEL JRST XMAR1 XMAR2: HRLZI D,(MOVEI LP,) PUSHJ P,BUILDI JRST XMAR5 ;MAT STATEMENT ;MAT STATEMENTS DIVIDE INTO A NUMBER OF DIFFERENT ;STATEMENTS (MAT READ, ...) THESE POSSIBILITIES ARE TESTED ;ONE AT A TIME BY CALLS TO QSA. ; ::= MAT READ [(,)] [,[(,...]] XMAT: HLLI F, ;ALLOW STRINGS FOR READ,PRINT,INPUT PUSHJ P,QSA ;MAT READ? ASCIZ /READ/ JRST XMAT2 ;NO. GO TRY MAT PRINT XMAT1: HRLI F,0 PUSHJ P,ARRAY ;GET ARRAY NAME CAIE A,5 ;STRING VECTOR? JUMPN A,GRONK PUSHJ P,MATCHK ;CHECK THAT ITS NOT VIRTUAL MOVSI D,(MATRD) SKIPL DATAFF ;DATA SEEN? HLLOS DATAFF ;NO. SET NO DATA FLAG PUSHJ P,XMACOM ;GO CHECK DIMENSIONS AND BUILD UUO. TLNN C,F.COMA ;IS THERE ANOTHER ARRAY TO READ? JRST NXTSTA ;NO. PUSHJ P,NXCHK ;YES. SKIP COMMA TLNE C,F.TERM ;END OF ARRAY LIST? JRST NXTSTA ;YES. JRST XMAT1 ;::= MAT PRINT [(,)] [[;!,] [(,)...] XMAT2: PUSHJ P,QSA ;MAT PRINT? ASCIZ /PRINT/ JRST XMAT3 ;NO. MUST HAVE VARIABLE NAME. XMAT2A: HRLI F,0 PUSHJ P,ARRAY ;REGISTER NAME CAIE A,5 ;STRING VECTOR? JUMPN A,GRONK PUSHJ P,MATCHK ;CHECK THAT ITS NOT VIRTUAL MOVSI D,(MATPR) PUSHJ P,XMACOM ;GO CHECK DIMENSIONS AND BUILD UUO ADD B,DDTCOD ; HLLZ D,0(B) ;ADDRESS OF MAT UUO PUSHJ P,CHKFMT ;CHECK FORMAT CHARACTER XMAT2B: TLNN D,140 JRST GRONK ;FAIL IF ILLEGAL HLLM D,0(B) ;RESTORE WITH CORRECT AC FIELD TLNE C,F.TERM ;IS FORMAT CHAR FOLLOWED BY END OF STA? JRST NXTSTA ;YES. JRST XMAT2A ;PROCESS NEXT ARRAY NAME ; ::= MAT =()* XMAT3: PUSH P,[Z NXTSTA] ;ALL REMAINING MAT STATEMENTS MAY HAVE ;ONE OPERAND, BUT NOT A LIST OF THEM. PUSHJ P,QSA ASCIZ /INPUT/ JRST XMAT3A PUSHJ P,VCTOR ;REGISTER VECTOR NAME CAIE A,5 ;STRING VECTOR? JUMPN A,GRONK ;OR NUMBER VECTOR? PUSHJ P,MATCHK ;CHECK THAT ITS NOT VIRTUAL MOVSI D,(MATINP) ;YES. BUILD MAT INPUT SKIPGE TYPE ;IS IT INTEGER? TLO D,400 ;YES, SET THE BIT JRST BUILDA XMAT3A: HRLI F,-1 ;REMAINING MATOPS CANT HAVE STRINGS. PUSHJ P,ARRAY ;REGISTER THE VARIABLE JUMPN A,GRONK ;CHECK FOR ILLEGAL ARRAY NAME. PUSHJ P,MATCHK ;CHECK THAT ITS NOT VIRTUAL MOVE X1,TYPE ;SAVE THE TYPE MOVEM X1,FTYPE ;FOR MIXED MODE CHECK TLNN C,F.EQAL ; CHECK FOR EQUAL SIGN. JRST EREQAL PUSHJ P,NXCHK ;SKIP EQUAL. CAIE C,"(" ;SCALAR MULTIPLE? JRST XMAT4 ;NO PUSHJ P,NXCHK ;SKIP PARENTHESIS PUSH P,B PUSHJ P,FORMLN ;YES. GEN MULTIPLE MOVE X1,TYPE ;GET TYPE OF SCALAR CAME X1,FTYPE ;SAME MODE? JRST MTYERR ;NO, ERROR PUSHJ P,EIRGNP PUSHJ P,QSF ;SKIP MULTIPLY SIGN ASCIZ /)*/ MOVE X1,[MATSCA] ;SET UP OP CODE SKIPGE FTYPE ;FLOATING SCALE TLO X1,400 ;NO, MARK AS INTEGER PUSH P,X1 ;PUSH IT JRST XMAT9A VCTOR: PUSHJ P,ARRAY ;REGISTER ARRAY OR VECTOR CAIE A,5 ;STRING ? JUMPN A,CPOPJ ;NO, ARRAY ? MOVE X2,1(X1) ;YES, ONE OR THE OTHER JUMPG X2,CPOPJ MOVNI X2,2 MOVEM X2,1(X1) POPJ P, ; ::= MAT ZER!CON!IDN [(,)] XMAT4: PUSHJ P,QSA ;MAT ZER? ASCIZ /ZER/ JRST XMAT5 ;NO. MOVSI D,(MATZER) ;YES. JRST XMACOM XMAT5: PUSHJ P,QSA ;MAT CON? ASCIZ /CON/ JRST XMAT6 MOVSI D,(MATCON) ;YES. JRST XMACOM XMAT6: PUSHJ P,QSA ;MAT IDN? ASCIZ /IDN/ JRST XMAT7 ;NO MOVSI D,(MATIDN) ;YES. ;COMMON GEN FOR MAT ZER,CON,IDN,REA XMACOM: SKIPGE TYPE ;IS IT INTEGER? TLO D,400 ;YES, MARK IT CAIE C,"(" ;EXPLICIT DIMENSIONS? JRST XMAT9D ;NO. PUSH P,B ;SAVE B,D. PUSH P,D PUSHJ P,XARG ;TRANSLATE ARGUMENTS PUSH P,B ;SAVE COUNT OF ARGUMENTS MOVE B,-2(P) ;GET BACK THE REGISTRY OF THE ARRAY. MOVSI D,(SDIM) ;BUILD SDIM INSTR. PUSHJ P,BUILDA POP P,B ;GET THE ARGUMENT COUNT. JUMPN B,XMACO1 ;ONE ARG OR TWO? PUSHJ P,GENAFN ;ONE. FAKE DIMENSIONS OF (N,0). MOVE D,[JUMP 2,ONCESW] PUSHJ P,BUILDI JRST XMAT9C XMACO1: PUSHJ P,GENAR0 ;GEN ARGS JRST XMAT9C ;RESTORE AC,S AND BUILD. XMACMI: ; ::= MAT = INV!TRN () XMAT7: PUSHJ P,QSA ;MAT INV? ASCIZ /INV(/ JRST XMAT8 ;NO MOVSI D,(MATINV) ;YES. GET OP CODE. JRST XMITCM XMAT8: PUSHJ P,QSA ;MAT TRN? ASCIZ /TRN(/ JRST XMAT9 ;NO. MOVSI D,(MATTRN) ;YES. GET OP CODE. MOVEM B,TRNFLG XMITCM: PUSH P,B ;FINISH MAT INV,TRN. SKIPGE TYPE ;IS IT INTEGER? TLO D,400 ;ES, MARK IT PUSH P,D HRLI F,777777 PUSHJ P,ARRAY JUMPN A,GRONK PUSHJ P,MATCHK ;CHECK THAT ITS NOT VIRTUAL MOVE X1,TYPE ;GET THE TYPE CAME X1,FTYPE ;MIXED MODE? JRST MTYERR ;YES, FLAG ERROR HLRZ X1,(P) ;GET THE OPCODE TRZ X1,400 ;CLEAR INTEGER BIT (IF ANY) CAIE X1,(MATTRN) ;MAT INV? SKIPL TYPE ;YES, INTEGER? CAIA ;NO, ONWARD FAIL PUSHJ P,QSF ASCIZ /)/ CAME B,TRNFLG JRST XMAT9B ADD B,FLOOR(F) ;THIS IS MAT A = TRN (A). SETOM 2(B) ;MARK A. MOVE B,TRNFLG ;FAKE IT OUT BY USING AN MOVSI D,(MOVEI T1,) ;INVISIBLE MATRIX FOR TEMPORARY PUSHJ P,BUILDA ;STORAGE. HRLZI A,552640 PUSHJ P,ARRAY0 POP P,D PUSH P,B ADD B,FLOOR(F) AOS 2(B) MOVE B,(P) PUSHJ P,BUILDA JRST XMAT11 ;::=MAT =+!-!* XMAT9: PUSH P,B ;SAVE RESULT LOCATION MOVE X1,TYPE ;SAVE THE TYPE MOVEM X1,FTYPE ;FOR MIXED MODE CHECK HRLI F,777777 PUSHJ P,ARRAY JUMPN A,GRONK PUSHJ P,MATCHK ;CHECK THAT ITS NOT VIRTUAL MOVEI D,0 ;LETTER FOLLOWED BY OPERATOR TLNN C,F.PLUS+F.MINS+F.STAR JRST XMAT10 ;NO OPERATOR. MUST BE MAT COPY TLNN C,F.MINS+F.STAR MOVSI D,(MATADD) TLNN C,F.PLUS+F.STAR MOVSI D,(MATSUB) TLNN C,F.PLUS+F.MINS MOVSI D,(MATMPY) SKIPGE TYPE ;IS IT INTEGER? TLO D,400 ;YES, MARK IT PUSH P,D ;SAVE OPERATION PUSHJ P,NXCHK ;SKIP OPERATOR MOVSI D,(MOVEI T,) ;GEN T:= ADRS OF FIRST ARRAY PUSHJ P,BUILDA ;ENTER HERE FROM SCALAR MULTIPLE XMAT9A: HRLI F,777777 PUSHJ P,ARRAY ;SECOND ARRAY JUMPN A,GRONK ;NOT ARRAY NAME PUSHJ P,MATCHK ;CHECK THAT ITS NOT VIRTUAL MOVE X1,TYPE ;CHECK FOR MIXED MODE CAME X1,FTYPE ;TYPES MATCH? MTYERR: FAIL ;ENTER HERE FROM MAT INV, TRN XMAT9B: MOVSI D,(MOVEI T1,) PUSHJ P,BUILDA XMAT9C: POP P,D POP P,B XMAT9D: JRST BUILDA ;RETURN TO NXTSTA (OR TO PROCESS NEXT ITEM IN PRINT,READ, OR INPUT LIST.) XMAT10: PUSH P,B ;FOR MAT COPY, FAKE MAT B=(1)*A XMAT11: MOVE D,[MOVSI N,(1.0)];PUT CONSTANT 1.0 IN REG FOR SCALE SKIPGE FTYPE ;INTEGER MATRIX? MOVE D,[MOVEI N,1] ;YES, SET UP INTEGER 1 PUSHJ P,BUILDI ;BUILD INST TO GET SCAL FACTOR POP P,B ;GET SOURCE MAT BACK PUSH P,[MATSCA] JRST XMAT9B ; ; QUOTE, NOQUOTE AND NOPAGE STATEMENTS ; ; THE FOLLOWING CODE GENERATES CODE TO HANDLE THE VARIOUS ; TTY AND DSK FILE SETTINGS. THE INSTRUCTION SKELETON IS ; SETUP IN AC N. THE INSTRUCTION TO SET THE TTY WILL ; ONLY BE GENERATED ONCE NO MATTER HOW MANY TIMES IT IS REFERENCED ; XQUO: ASCIZ /TE/ ;REMAINDER OF QUOTE STATEMENT MOVE N,[SETOM QUOTBL] ;FETCH QUOTE INSTRUCTION JRST XNOP8 ;HANDLE THE ARGUMENT LIST ; XNOQ: ASCIZ /UOTE/ ;REMAINDER OF NOQUOTE STATEMENT MOVE N,[CLEARM QUOTBL] ;FETCH NOQUOTE INSTRUCTION JRST XNOP8 ;HANDLE THE ARGUMENT LIST ; XNOP: ASCIZ /AGE/ ;REMAINDER OF NOPAGE STATEMENT MOVE N,[SETOM PAGLIM] ;FETCH INSTRUCTION XNOP8: MOVEM N,TABLE ;SAVE THE SETTING INSTRUCTION PUSHJ P,QSA ;CHECK FOR ALL ASCIZ /ALL/ JRST XNOP9 ;NOT THERE, ARGUMENTS SHOULD FOLLOW MOVE D,[MOVEI LP,9] ;FETCH INSTR. TO BEGIN AT CHANNEL 9 PUSHJ P,BUILDI ;BUILD IMMEDIATE MOVE D,TABLE ;GET THE SETTING INSTRUCTION TLO D,16 ;MASK IN AC 16 AS THE INDEX PUSHJ P,BUILDI ;BUILD IMMEDIATE ADD B,DDTCOD ;CALCULATE ADDRESS OF SETTING INSTRUCTION MOVSI D,(SOJG LP,) ;FETCH INSTR. TO LOOP THRU ALL 9 CHANNELS HRR D,B ;PUT IN THE ADDRESS PUSHJ P,BUILDI ;BUILD IMMEDIATE JRST NXTSTA ;ALL DONE XNOP9: CLEARM TTYPAG ;FLAG, WE HAVEN'T SET TTY YET TLNE C,F.TERM ;ANY ARGUMENTS? JRST XNOP1 ;NO, MEANS TTY, DO IT XNOP2: TLNN C,F.COMA ;CHECK FOR POSSIBLE NULL ARGUMENT CAIN C,";" ;WHICH MEANS TTY JRST XNOP5 ;IS NULL, SET TTY XNOP6: CAMN C,[XWD F.STR,"#"] ;DID USER INCLUDE OPTIONAL # PUSHJ P,NXCH ;YES, EAT IT PUSHJ P,GETCN2 ;HANDLE THE CHANNEL SPECIFIER MOVE D,TABLE ;FETCH THE SETTING INSTRUCTION TLO D,16 ;MASK IN AC 16 AS AN INDEX PUSHJ P,BUILDI ;BUILD IMMEDIATE PUSHJ P,CHKDEL ;CHECK FOR A DELIMITER, RETURN IF FOUND XNOP3: TLNN C,F.TERM ;NULL ARGUMENT? JRST XNOP2 ;NO, LOOK FOR CHANNEL XNOP0: SKIPE TTYPAG ;HAS TTY BEEN SET ALREADY JRST NXTSTA ;YES, JUST RETURN XNOP1: MOVE D,TABLE ;FETCH THE SETTING INSTRUCTION PUSHJ P,BUILDI ;BUILD IMMEDIATE JRST NXTSTA ;ALL DONE XNOP5: PUSHJ P,NXCH ;EAT THE DELIMITER IN C SKIPE TTYPAG ;HAS TTY BEEN SET? JRST XNOP3 ;YES, DON'T DO IT AGAIN MOVE D,TABLE ;FETCH SETTING INSTRUCTION PUSHJ P,BUILDI ;BUILD IMMEDIATE SETOM TTYPAG ;FLAG, THE TTY HAS BEEN SET JRST XNOP3 ;PROCESS NEXT ARGUMENT ; ; PAGE AND PAGE ALL STATEMENTS. ; ;CODE FOR THESE STATEMENTS IS COMPILED BY THE MARGIN AND ;MARGIN ALL ROUTINE, XMAG, WHICH SEE. XPAG: ASCIZ /E/ SETOM TABLE JRST XMAR0 ; ; RANDOM IZE STATEMENT XRAN: ASCIZ /DOM/ PUSHJ P,QSA ASCIZ /IZE/ JFCL MOVE D,[PUSHJ P,RANDER] PUSHJ P,BUILDI ;BUILD CALL TO RUNTIME RANDOMIZER JRST NXTSTA MATCHK: SKIPGE (X1) ;WAS IT VIRTUAL FAIL POPJ P, ; ; NEXT STATEMENT ; ; ::= NEXT ;EXPECT TO FIND 5-WORD ENTRY ON TOP OF FORROL ;DESCRIBING INDUCTION VARIABLE AND LOOP ADDRESS XNEXT: ASCIZ /T/ SKIPE THNELS ;UNDER THEN OR ELSE ? FAIL XNEX0: TLNN C,F.TERM ;NEXT WITHOUT ARGUMENT? JRST XNEX3 ;NO, FOR-NEXT LOOP MOVE X1,CEFOR ;UNSAT UNTIL/WHILE LOOP CAMG X1,FLFOR ;CHECK FOR ROLL FAIL SETO X2, ;MAKE SURE THIS IS UNTIL/WHILE LOOP CAME X2,-3(X1) ;-1 FOR INDUCTION VARIABLE CAMN X2,-2(X1) ;-1 FOR INCREMENT CAIA ;ALL'S QUIET ON THE EASTERN FRONT FAIL PUSHJ P,POPFOR ;RETURN TEMP PROTECTION MOVEM B,TMPLOW ;SHOULD NOT CHANGE MOVEM B,TMPPNT ; PUSHJ P,POPFOR ;DUMMY INCREMENT PUSHJ P,POPFOR ;DUMMY INDUCTION PUSHJ P,POPFOR ;LOPP JRST ADDRESSES PUSH P,[Z NXTSTA] ;SET UP RETURN JRST XNEX4 ;LET NEXT CODE HANDLE THE JRSTS XNEX3: TLNN C,F.LETT FAIL HRLI F,777777 PUSHJ P,REGLTR CAIE A,1 ;BETTER BE SCALAR FAIL MOVE X1,CEFOR ;UNSAT FOR? CAMLE X1,FLFOR CAME B,-3(X1) ;CHECK INDUCTION VARIABLE FAIL SETO X2, ;MAKE SURE THIS IS WHILE/UNTIL LOOP CAME X2,-3(X1) ; CAMN X2,-2(X1) FAIL PUSHJ P,NEXCOD ;GO GENERATE NEXT CODE TLNN C,F.COMA ;STACKED NEXT? JRST XNEX1 ;NO. PUSHJ P,NXCH ;YES. JRST XNEX0 XNEX1: TLNE C,F.TERM ;MODIFIERS ILLEGAL IN NEXT JRST NXTSTA FAIL NEXCOD: PUSHJ P,POPFOR MOVEM B,TMPLOW ;RESTORE PREVIOUS LEVEL OF TEMPORARY PROTECTION MOVEM B,TMPPNT ;BECAUSE THIS IS THE END OF THE "FOR" RANGE . PUSHJ P,POPFOR ;GEN INCREMENT TO REG PUSHJ P,EIRGEN PUSHJ P,POPFOR ;FADR TO INDUCTION VAR MOVSI D,(FADR) SKIPGE TYPE ;INTEGER? MOVSI D,(ADD) ;YES, DO INTEGER ADD PUSHJ P,BUILDA PUSHJ P,POPFOR ;GET JRST POINTER XNEX4: MOVE A,DDTCOD ;GET CODE FLOOR HRLS A ;IN BOTH SIDES ADD A,B ;E.A.OF NEXT'S JRST,LOC OF FOR'S JRST PUSHJ P,HALJRS ;GEN HALT/JRST BACK TO FOR ADD B,DDTCOD ;LOC OF INST HLRM A,(B) ;SET E.A AOS B HRRM B,(A) ;FORS JRST TO NEXT STMNT XNEX2: PUSHJ P,POPFOR ;POP OFF THE SAVED VALUE OF L POPJ P, ;RETURN ;SUBR TO POP TOP OF FORROL. USED ONLY BY XNEXT. POPFOR: SOS X1,CEFOR ;POP TOP OF FORROL MOVE B,(X1) POPJ P, ; ; ON STATEMENT ; ; ::= ON GOTO!THEN [,...] ;CREATES A CALL TO A RUNTIME ROUTINE THAT CHECKS THE RANGE OF THE ARGUMENT ;AND RETURNS TO THE APPROPRIATE JRST: ; JSP A,XCTON ; Z (ADDRESS OF NEXT STATEMENT) ; ; XON: PUSHJ P,FORMLN ;EVALUATE INDEX PUSHJ P,EIRGNP ;GET IN REG PUSHJ P,CHKINT ;MUST BE INTEGER MOVE D,[JSP A,DCTON] PUSHJ P,BUILDI ;BUILD THE RUNTIME CALL CLEAR D, ;DUMMY INSTR. FOR NOW PUSHJ P,BUILDI ;GENERATE IT ADD B,DDTCOD ;ADDRESS OF THUS DUMMY MOVEM B,ONGADR ;SAVE IT TLNE C,F.COMA ;SKIP OPTIONAL COMMA. PUSHJ P,NXCH PUSHJ P,QSA ASCIZ /GOSUB/ JRST XONA SETOM ONGFLG JRST XGOS XONA: PUSHJ P,THENGO ;TEST FOR "THEN" OR "GOTO" XON1: PUSHJ P,XGOFR ;BUILD A JRST TO THE NEXT NAMED STATEMENT TLNN C,F.COMA ;MORE? JRST XON2 ;NO PUSHJ P,NXCHK ;YES. SKIP COMMA JRST XON1 ;PROCESS NEXT LINE NUMBER XON2: MOVE B,DDCODE ;NEXT ADDRESS MOVEM B,@ONGADR ;SET UP LIMIT JRST NXTSTA ;GO FOR NEXT DCTON: JUMPLE N,DCTON1 ;LEGAL ARGUMENT FOR ON MOVEM A,ONGADR ;SAVE UPPER LIMIT HRRZ T,N JUMPE T,DCTON1 ASH T,1 ADDI T,(A) CAMGE T,(A) JRST -1(T) DCTON1: FAIL ; ; OPEN STATEMENT ; XOPEN: ASCIZ /N/ SETOM FILTYP ;FILE TYPE UNKNOWN SETOM OPNFLG FILEE8: MOVE D,[PUSHJ P,SETCOR] PUSHJ P,BUILDI SETZM VRFSET FILOP0: TLNN C,F.QUOT JRST FILE21 PUSH P,C PUSH P,T PUSHJ P,QSKIP JRST ERQUOT TLNN C,F.PLUS ;CHECK FILE SPEC UNLESS CONCATENATION JRST FILEE4 FILE20: POP P,T POP P,C FILE21: PUSHJ P,MASCHK ;GET FILENAME JRST FILOP1 ;YES, GO DO FOR INPUT/OUTPUT FILEE4: MOVE C,-1(P) ;CHECK SYNTAX OF ARG NOW, SINCE IT IS A CONSTANT. MOVE T,(P) PUSHJ P,NXCH PUSHJ P,FILNMO ;FILENM.EXT FORM? JUMP SAVE1 SETZ B, ;ASSUME SEQUENTIAL TLNE C,F.QUOT JRST FILEE7 TLNE C,F.DOLL ;TYPE $ OR %? JRST FILE45 ;$. CAME C,[XWD F.STR,"%"] JRST ERDLPQ PUSHJ P,NXCH ;%. TLNN C,F.QUOT JRST ERQUOT JRST FILEE6 FILE45: PUSHJ P,NXCH TLNN C,F.DIG JRST XFILR1 FILEE5: ADDI B,-60(C) PUSHJ P,NXCH TLNN C,F.DIG JRST FILE55 IMULI B,^D10 JRST FILEE5 FILE55: SKIPLE B CAILE B,^D132 XFILER: FAIL 132> XFILR1: TLNN C,F.QUOT JRST ERDIGQ FILEE6: MOVEI B,-1 ;SET R.A. FILEE7: PUSHJ P,FILSET ;SET FILE TYPE JRST FILE20 ;BACK TO MAIN CODE FILSET: SKIPGE FILTYP ;ALREADY SET ? MOVEM B,FILTYP ;NO, SET IT CAME B,FILTYP ;YES, IS IT SAME FAIL POPJ P, ;ALL WELL, RETURN FILOP1: SETZM INPOUT ;NO SPECIFIER PUSHJ P,QSA ASCIZ /FOR/ ;SPECIFIER ? JRST FILOP3 ;NO PUSHJ P,QSA ASCIZ /INPUT/ ;INPUT ? JRST FILOP4 ;NO AOS INPOUT ;YES, FLAG JRST FILOP3 ;GO CARRY ON FILOP4: PUSHJ P,QSA ASCIZ /OUTPUT/ ;OUTPUT ? FAIL SOS INPOUT FILOP3: PUSHJ P,QSA ASCIZ /ASFILE/ FILERR: FAIL FILOP2: MOVEI B,-1 ;ASSUME R. A. CAIN C,":" ;CORRECT? JRST FILEE2 ;YES SETZ B, ;ASSUME SEQ. ACC. CAMN C,[XWD F.STR,"#"] ;RIGHT? JRST FILEE2 ;YES CAME C,[XWD F.STR,"@"] ;VIRTUAL ARRAY JRST ERCHAN ;GIVE ERROR SETZM FILTYP AOSA FILTYP FILEE2: PUSHJ P,FILSET PUSHJ P,GETCNA FILOP9: MOVSI D,(HRREI N,) HRR D,FILTYP PUSHJ P,BUILDI MOVE D,[MOVEM N,FILTYP] PUSHJ P,BUILDI MOVE D,[SKIPE ACTBL-1(LP)] PUSHJ P,BUILDI MOVE D,[PUSHJ P,CLSFIL] PUSHJ P,BUILDI FILOP5: MOVE D,[PUSHJ P,OPNFIL] PUSHJ P,BUILDI ;OPEN FILE SKIPG FILTYP ;VIRTUAL ARRAY SKIPN X1,INPOUT ;MODE SPECIFIED ? JRST NXTSTA ;NO JUMPG X1,FILOP6 ;YES, WHICH MOVE D,[PUSHJ P,SCATH] SKIPE FILTYP ;OUTPUT, SCRATCH, RANDOM ? MOVE D,[PUSHJ P,RANSCR] PUSHJ P,BUILDI FILPLT: TLNE C,F.TERM ;TERMINATOR JRST NXTSTA ;NEXT STATEMENT PUSHJ P,QSA ASCIZ /TOPLOT/ JRST NXTSTA SKIPE FILTYP JRST FILERR MOVE D,[MOVEM LP,PLTIN] SKIPG INPOUT HRRI D,PLTOUT PUSHJ P,BUILDI JRST NXTSTA FILOP6: SKIPE FILTYP ;INPUT, RESTORE, RANDOM ? JRST FILOP7 ;YES MOVE D,[PUSHJ P,XRES] PUSHJ P,BUILDI JRST FILPLT FILOP7: MOVNI A,5 ;RANDOM FILOP8: MOVE D,RESCOD+4(A) PUSHJ P,BUILDI AOJL A,FILOP8 JRST NXTSTA ; ; UNTIL WHILE LOOP ; XUNTIL: ASCIZ /IL/ SETOM LOGNEG ;REVERSE SENSE OF LOGIC JRST XWHILE+2 ;ONWARD XWHILE: ASCIZ /LE/ SETZM LOGNEG ;STRAIGHT FORWARD LOGIC MOVE X1,DDCODE ;WHERE TO GO SUB X1,DDTCOD ; SOJ X1, ; HRLM X1,FORPNT ;SAVE IT PUSHJ P,IFCCOD ;HANDLE CONDITIONAL PUSHJ P,REVSEN ;YES, DO IT PUSHJ P,HALJRS ;NEXT RETURNS HRRM B,FORPNT ;SAVE FOR NEXT CODE MOVE A,L ;SAVE STATEMENT FOR POSSIBLE ERROR MOVEI R,FORROL ;SAVE ON FOR ROLL PUSHJ P,RPUSH ; MOVE A,FORPNT ;SAVE JRST POINTER ON FORROL PUSHJ P,RPUSH ; SETO A, ;DUMMY INDUCTION AND INCREMENT PUSHJ P,RPUSH ; PUSHJ P,RPUSH ; MOVE A,TMPLOW ;SAVE TEMP PROTECTION PUSHJ P,RPUSH ; JRST NXTSTA ;ALL DONE ; ; PRINT AND WRITE STATEMENT ; XWRIT: ASCIZ /TE/ SETOM WRREFL JRST XPLAB1 XPRINT: ASCIZ /NT/ ;REST OF COMMAND CLEARM WRREFL XPLAB1: CAIN C,":" JRST XPRRAN ;R.A. STATEMENT. PUSHJ P,QSA ASCIZ /USING/ JRST XWRI1 CAME C,[XWD F.STR,"#"] ;USING STATEMENT. IMAGE NEXT? JRST XWRI2 ;YES. PUSHJ P,XWRCHA ;NO, CHANNEL NEXT. PUSHJ P,CHKDL1 ; PUSHJ P,XWRIMG ;IMAGE MUST BE NEXT. JRST XWRI5 ;GO TO GEN THE ARGS AND FINISH. XWRI2: PUSHJ P,XWRIMG ;GET IMAGE. JRST XWRI6 ;MUST BE TTY STATEMENT, GET ARGS & FINISH. XWRI1: CAME C,[XWD F.STR,"#"] JRST XPRI1 ;NOT USING, NOT #, MUST BE SIMPLE PRINT. PUSHJ P,XWCHA ;CHANNEL. TLNE C,F.TERM JRST XPRI0 ;NOT USING STATEMENT - GO TO PRINT# OR WRITE#. TLNN C,F.COMA CAIN C,":" PUSHJ P,NXCH TLNE C,F.TERM JRST XPRI0 ; '' PUSHJ P,QSA ASCIZ /USING/ JRST XPRI0 ; '' MOVE D,[PUSHJ P,IMGLIN] PUSHJ P,BUILDI PUSHJ P,XWRIMG ;GET IMAGE. JRST XWRI5 ;GO TO GEN ARGS AND FINISH. XWRIMG: TLNE C,F.DIG ;HANDLE IMAGE. JRST XWRIM2 ;LINE NUMBER FORM. XWRIM1: PUSHJ P,FORMLS PUSHJ P,EIRGNP TLNN C,F.COMA JRST ERCOMA PUSHJ P,NXCH JRST XWRIM4 XWRIM2: PUSH P,C ;LINE NUMBER FORM. PUSH P,T PUSHJ P,GETNUM ;GET THE NUMBER. JFCL TLNN C,F.COMA JRST ERCOMA XWRIM3: POP P,D POP P,D HRLZ A,N MOVEI R,LINROL ;SEARCH FOR THE LINE IT SPECIFIES. PUSHJ P,SEARCH FAIL ,1 PUSH P,T MOVE B,(B) HRRZI T,(B) HRLI T,440700 XWRIM7: ILDB C,T ;LOOK FOR A LEADING ":", WHICH CAIN C,":" ;SAYS--THIS IS REALLY AN IMAGE LINE. JRST XWRIM8 CAIE C," " CAIN C,11 JRST XWRIM7 FAIL XWRIM8: SETZ A, PUSHJ P,NXCHD PUSH P,C PUSH P,T TLNE C,F.CR FAIL AOJ A, ;PUT THE IMAGE IN THE TABLE XWRMX1: PUSHJ P,NXCHD ;OF STRING CONSTANTS. TLZN C,F.CR ; OR ? AOJA A,XWRMX1 ;NO CAIN C,12 ; ? JRST XWRMX1 ;YES MOVEI E,4(A) MOVN A,A HRLI A,(A) MOVE T,CESLT SUB T,FLSLT HRRI A,(T) MOVEI R,LITROL PUSH P,E PUSHJ P,RPUSH POP P,E IDIVI E,5 MOVEI R,SLTROL PUSHJ P,BUMPRL POP P,T POP P,C HRLI B,440700 XWRIM9: CAIN C,15 JRST XWRM10 CAIE C,12 ;SKIP IDPB C,B ILDB C,T JRST XWRIM9 XWRM10: MOVEI R,SADROL MOVEI A, PUSHJ P,RPUSH SUB B,FLSAD HRLI B,SADROL MOVSI D,(MOVE N,) PUSHJ P,BUILDA POP P,T PUSHJ P,NXCH XWRIM4: MOVE D,[PUSHJ P,CHKIMG] JRST BUILDI XWRCHA: TDZA D,D ;DISK STATEMENT. XWCHA: SETO D, PUSH P,D PUSHJ P,GETCNA MOVE D,[PUSHJ P,OUTSET] PUSHJ P,BUILDI MOVEI D,WRIPRI-1 PUSHJ P,GENTYP MOVE D,[JRST WRPRER] PUSHJ P,BUILDI SKIPN WRREFL JRST XWCHA1 MOVE D,[MOVE N,MARGIN(LP)] PUSHJ P,BUILDI MOVE D,[CAMGE N,SEVEN] PUSHJ P,BUILDI MOVE D,[JRST MARERR] PUSHJ P,BUILDI XWCHA1: POP P,D JUMPE D,XPLAB2 POPJ P, XPLAB2: MOVE D,[PUSHJ P,IMGLIN] JRST BUILDI XWRI6: MOVSI D,(SETZ LP,) PUSHJ P,BUILDI MOVE D,[PUSHJ P,OUTSET] PUSHJ P,BUILDI MOVE D,[PUSHJ P,IMGLIN] PUSHJ P,BUILDI XWRI5: PUSHJ P,KWSAMD ;LOOK FOR MODIFIER CAIA ;NONE JRST XWRI7 ;ONE, HANDLE AS TERMINATOR SETZM PFLAG ;CLEAR % SEEN FLAG PUSHJ P,FORMLB ;GEN THE ARGS. PUSHJ P,EIRGNP MOVE D,[PUSHJ P,FLTPNT] SKIPGE TYPE ;FLOAT IT IF NECESSARY PUSHJ P,BUILDI MOVE D,[PUSHJ P,SCNIMN] SKIPL F MOVE D,[PUSHJ P,SCNIMS] PUSHJ P,BUILDI TLNN C,F.COMA CAIN C,";" JRST XPLAB3 JRST XWRI7 XPLAB3: PUSHJ P,NXCH TLNN C,F.TERM ;CHECK FOR TERMINATOR JRST XWRI5 XWRI7: MOVE D,[PUSHJ P,ENDIMG] PUSHJ P,BUILDI JRST NXTSTA XPRRAN: PUSHJ P,GENTP1 PUSHJ P,FORMLB MOVEM F,IFFLAG JRST XPRRN2 XPRRN1: PUSHJ P,FORMLB XOR F,IFFLAG JUMPGE F,XPRRN2 FAIL XPRRN2: PUSHJ P,EIRGNP MOVE D,[PUSHJ P,RNNUMO] SKIPL IFFLAG HRRI D,RNSTRO PUSHJ P,BUILDI PUSHJ P,CHKDEL JRST XPRRN1 XPRI1: SKIPE WRREFL JRST GRONK MOVSI D,(SETZ LP,) ;TTY OUTPUT PUSHJ P,BUILDI ;GENERATE MOVE D,[PUSHJ P,OUTSET] ;SETUP FOR OUTPUT PUSHJ P,BUILDI ;GENERATE XPRI0: PUSHJ P,KWSAMD ;MODIFIER FOLLOWS? TLNE C,F.TERM ;LINE TERMINATOR? JRST XPCRLF ;YES, JUST WANTS CAIA XPRI2: PUSHJ P,KWSAMD ;MODIFIER CAIA ;NO JRST NXTSTA ;YES, GO HANDLE PUSHJ P,QSA ;TAB FIELD? ASCIZ /TAB/ JRST XPLAB4 JRST XPRTAB ;YES, GO HANDLE XPLAB4: TLNN C,F.COMA ;SEPARATOR? CAIN C,";" ;SEMI-COLON? JRST PRNDEL ;YES, PRINT DELIMETER CAIE C,74 ;LEFT ANGLE BRACKET? JRST PRNEXP ;NO, PRINT EXPRESSION ; ; PRINT DELIMETER ; PRNDEL: MOVSI D,(PRDL) ;UUO NEEDED FOR DELIMETER PUSHJ P,CHKFMT ;CHECK THE FORMAT PUSHJ P,BUILDI ;GENERATE JRST XPRFIN ;SEE IF MORE ; ; PRINT EXPRESSION ; PRNEXP: SETZM PFLAG ;CLEAR % SEEN FLAG PUSHJ P,FORMLB ;GENERATE THE FORMULA JUMPL F,XPLAB5 MOVSI D,(PRSTR) JRST XPLAB6 XPLAB5: PUSHJ P,GPOSNX ;MOVE TO REGISTER (IF NEEDED) MOVSI D,(PRNM) ;SET UP UUO XPLAB6: PUSHJ P,CHKFMT ;CHECK FORMAT SKIPGE TYPE ;INTEGER? TLO D,400 ;YES, MARK IT PUSHJ P,BUILDA ;GENERATE PRINT UUO JRST XPRFIN ;GO FOR MORE ; ; PRINT TAB ; XPRTAB: PUSHJ P,FORMLN ;EVALUATE TAB SUBEXPRESSION PUSHJ P,EIRGNP ;MOVE IT INTO REG MOVSI D,(PRNTB) ;CALL THE TAB INTERPRETER XPRTA1: PUSHJ P,CHKFMT ;CHECK THE FORMAT PUSHJ P,BUILDI ;BUILD THE INST. ; ; END OF ONE ARGUMENT ; XPRFIN: TLNE C,F.TERM ;TERMINATOR? JRST NXTSTA ;YES, TERMINATE JRST XPRI2 ;LOOP FOR NEXT ; XPCRLF: MOVE D,[CLEARM 40] ;NO UUO PUSHJ P,BUILDI ;GENERATE MOVE D,[PUSHJ P,PRDLER] ;DO SETUP PUSHJ P,BUILDI ;GENERATE MOVE D,[PUSHJ P,CRLF] ;DO PUSHJ P,BUILDI ;GENERATE JRST NXTSTA ;GO TERMINATE ; ; REMOVE A BREAKPOINT ; XREM: PUSHJ P,QSA ;DID HER INCLUDE FULL COMMAND ASCIZ /OVE/ ; JFCL ;WHO CARES TLNN C,F.TERM ;REMOVING ALL JRST XREM3 ;NO, ONE AT A TIME PUSH P,T ;SAVE BYTE POINTER PUSH P,C ;SAVE CURRENT CHARACTER MOVE X1,FLLAD ;START AT FLOOR OF LADROL MOVEI R,LADROL ;SETUP R XREM1: CAML X1,CELAD ;ALL LOOKED AT JRST XREM2A ;YES, RESTORE T AND C HRRE A,(X1) ;GET LINE FLAG JUMPGE A,XREM2 ;NO BREAKPOINT HERE HLLZS (X1) ;CLEAR BREAKPOINT HLRZ B,(X1) ;GET REL CODE ADDRESS ADD B,FLCOD ;ADD IN BASE OF CODE MOVE A,[JSP A,LINADR] ;RESTORE THIS INSTR. MOVEM A,(B) ;DO IT XREM2: AOJA X1,XREM1 ;DO NEXT XREM2A: POP P,C ;BACK COMES C POP P,T ;AND T JRST NXTSTA ;GO FOR NEXT COMMAND XREM3: PUSHJ P,GETLIN ;GET THE LINE REFERENCE HLLZS (B) ;CLEAR BREAKPOINT MOVE B,[JSP A,LINADR] ;RESTORE THIS INSTR. MOVEM B,(A) ;DO IT TLNN C,F.COMA ;MORE TO COME JRST NXTSTA ;NOPE, GO HOME PUSHJ P,NXCHK ;SWALLOW THIS COMMA JRST XREM3 ;CONTINUE ; ; RESTORE STATEMENTS. ; XREST: PUSHJ P,QSA ;RESUME? ASCIZ /UME/ JRST XRESTA ;NO, MAYBE RESTORE FAIL XRESTA: PUSHJ P,QSA ;CHECK FOR RESTORE ASCIZ /TORE/ JRST ILLINS ;ILLEGAL INSTRUCTION TLNN C,F.DOLL+F.STAR+F.TERM CAMN C,[XWD F.STR,"%"] JRST XREST1 XRES3: CAIN C,":" JRST XRES5 ;R.A. ARG. CAMN C,[1000000043] PUSHJ P,NXCH PUSHJ P,GETCN2 ;RESTORE# STATEMENT. MOVE D,[PUSHJ P,XRES] PUSHJ P,BUILDI XRES6: PUSHJ P,CHKDEL JRST XRES3 XRES5: PUSHJ P,GETCNA ;R.A. ARG. MOVNI A,5 XRES7: MOVE D,RESCOD+5(A) PUSHJ P,BUILDI AOJL A,XRES7 JRST XRES6 RESCOD: SKIPGE X1,ACTBL-1(LP) ;SOME OF THE CODE GENERATED. CAME X1,NEGONE## ; JRST FNMXER MOVEI N,1 MOVEM N,POINT-1(LP) XREST1: MOVE D,[PUSHJ P,RESTON] ;DATA RESTORE STATEMENT. CAMN C,[XWD F.STR,"%"] JRST XRES2 TLNN C,F.STAR+F.DOLL SOJA D,XRES1 TLNE C,F.DOLL ;RESTORE ONLY STRINGS? ADDI D,1 XRES2: PUSHJ P,NXCHK ;SKIP $ OR * OR % XRES1: PUSHJ P,BUILDI JRST NXTSTA ; ; SCRATCH STATEMENT ; ;FORMAT ; SCRATCH Q4,Q7,Q8 ;WHERE Q IS # OR :. Q MAY BE OMITTED, IN WHICH CASE # IS ASSUMED. XSCRAT: ASCIZ /ATCH/ SRAER5: CAIN C,":" JRST SRAER3 ;R.A. ARGUMENT. CAMN C,[XWD F.STR,"#"] ;SEQ. ACCESS ARGUMENT. PUSHJ P,NXCH PUSHJ P,GETCN2 MOVE D,[PUSHJ P,SCATH] SRAER4: PUSHJ P,BUILDI ;BUILD SCRATCH PUSHJ P,CHKDEL JRST SRAER5 SRAER3: PUSHJ P,GETCNA ;R.A. ARGUMENT. MOVE D,[PUSHJ P,RANSCR] JRST SRAER4 ; ; SET STATEMENT ; ;FORMAT ; SET :N,NUMERIC FORMULA, :N,NUMERIC FORMULA... ; ;WHERE N IS A DIGIT FROM 1 TO 9, THE ":" IS OPTIONAL, THE COMMA ;FOLLOWING N MAY BE REPLACED BY A COLON, AND THE COMMA ;FOLLOWING THE FORMULA MAY BE REPLACED BY A SEMICOLON. XSET: PUSHJ P,GENTP1 PUSHJ P,FORMLN ;GET VALUE FOR POINTER. PUSHJ P,EIRGNP PUSHJ P,CHKINT ;MUST BE INTEGER? MOVNI A,4 XSET2: MOVE D,SETCOD+4(A) PUSHJ P,BUILDI AOJL A,XSET2 PUSHJ P,CHKDEL JRST XSET SETCOD: JUMPLE N,SETERR ;SOME OF THE CODE GENERATED. CAIGE N,1 JRST SETERR MOVEM N,POINT-1(LP) ; ; START USER'S PROGRAM ; XSTART: PUSHJ P,QSA ;DID SHE INCLUDE EVERYTHING ASCIZ /RT/ JFCL ;JUST LIKE A WOMAN TLNN C,F.TERM ;JUST START JRST XSTRT1 ;NO, DO LINE NUMBER STUFF SETOM DDTFLG ; SETOM PFLAG ; PUSHJ P,ZSTOR ;ZERO STORAGE CLEARM NOLINE JRST @RUNLIN ;START UP XSTRT1: PUSHJ P,GETLIN ;GET THE LINE REFERENCE PUSHJ P,ZSTOR ;ZERO STORAGE HRRZM A,DDSTRT ;SAVE FOR START SETOM DDTFLG ; MOVEI R,CODROL ;RESET TOP STODGY ROOL MOVEM R,TOPSTG ;FOR NON BASDDT CLEARM NOLINE ;NO BREAK POINTS SETOM PFLAG ;TURN ON P FLAG JRST @DDSTRT ;START THE PROGRAM ; ; SET A BREAKPOINT ; XSTOP: PUSHJ P,QSA ;DID HE INCLUDE P ASCIZ /P/ JFCL ;WHO CARES XSTOP1: PUSHJ P,GETLIN ;GET THE LINE REFERENCE MOVE X1,[JSP A,DDTBRK] ;GET BREAK INSTRUCTION CAMN X1,(A) ;ALREADY SET? JRST XSTOP2 ;YES, DON'T SET AGAIN HLLOS (B) ;MARK AS BREAK MOVEM X1,(A) ;FOR THIS STATEMENT XSTOP2: TLNN C,F.COMA ;MORE TO COME? JRST NXTSTA ;THAT'S ALL PUSHJ P,NXCHK ;SCAN OFF COMMA JRST XSTOP1 ;DO NEXT SUBTTL SERVICE ROUTINES ; ;CHECK FORMAT CHAR (PRINT AND MAT PRINT) CHKFMT: PUSHJ P,KWSAMD ;DELIMITER THERE ? (IMPLIES CR) TLNE C,F.TERM TLO D,40 ;CR ... AC = 1 CAIN C,";" ;SC ... AC = 2 TLO D,100 ;CMA ... AC = 3 TLNE C,F.COMA ; ... AC = 4 TLO D,140 CAIE C,74 ;LEFT ANGLE BRACKET JRST CHKFM2 HRRZ C,(P) CAIN C,XMAT2B ;MAT STATEMENT CANNOT USE JRST GRONK ;. PUSHJ P,NXCH PUSHJ P,QSA ;< TO RECTIFY ANGLE BRACKET COUNT ASCIZ /PA>/ JRST GRONK TLO D,200 POPJ P, CHKFM2: TLNN D,140 ;WAS THERE A FMT CHAR? TLO D,100 ;NO. ASSUME ";" CAIE C,";" TLNE C,F.COMA ;SKIP FMT CHAR IF THERE WAS ONE. JRST NXCHK ;YES. SKIP POPJ P, ; ; GET NEXT CHARACTER AND CHECK FOR LEGALITY ; NXCHK: PUSHJ P,NXCH ;GET NEXT CHARACTER TLNE C,F.STR ;LEGAL FAIL POPJ P, ;RETURN ;SCAN INITIAL LETTER, LETTER IS PLACED LEFT ;JUSTIFIED IN A, 7-BIT ASCII. SCNLT1: HRRZ A,C ROT A,-7 JRST NXCH ;SCAN SECOND LETTER, NON-SKIP RETURN IF NOT LETTER. ;MAKE 7-BIT LETTER LEFT JUST IN A ;INTO 6-BIT. THAN PUT 6-BIT CURRENT LETTER IN A. SCNLT2: TLNN C,F.LETT POPJ P, SCN2: TLNN A,400000 ;ENTER HERE TO PROCESS NON-LETTER CHARS TLZA A,200000 TLO A,200000 LSH A,1 MOVE X1,[POINT 6,A,5] JRST SCNLTN ;ENTER HERE TO SCAN SECOND CHAR EVEN IF BOTH ARE NOT LETTERS. ;SCAN THIRD LETTER, NON-SKIP IF NOT LETTER. ;PUT 6-BIT LETTER TO 3RD 6-BIT FIELD IN A. SCNLT3: TLNN C,F.LETT POPJ P, SCN3: MOVE X1,[POINT 6,A,11] JRST SCNLTN ;CONTINUE QSELS: AOS (P) ;ASSUME SUCCESS PUSH P,C ;SAVE CHAR PUSH P,T ;AND POINTER PUSHJ P,QSA ASCIZ /ELSE/ ;ELSE THER ? SOS -2(P) ;NO POP P,T ;RESTORE POP P,C ;ACS POPJ P, ILLINS: FAIL ;GEN CODE TO EVALUATE FORMULA ;POINTER TO (POSSIBLY NEGATIVE) RESULT RETURNED IN B ;THIS LOOP HANDLES SUMS OF TERMS, CALLS TERM TO HANDLE PRODUCTS ;AND SO ON ;THE ENTRY POINT FORMLN REGARDS ONLY NUMERIC FORMULAS AS LEGAL. ;THE ENTRY POINT FORMLS REGARDS ONLY STRING FORMULAS AS LEGAL. ;THE ENTRY POINT FORMLB WILL ACCEPT EITHER A STRING OR A NUMERIC FORMULA. ;THE ENTRY POINT FORMLU EXPECTS THE LEGALITY TO BE DEFINED EXTERNALLY. FORMLS: HRLZI F,1 ;ONLY STRINGS ARE LEGAL JRST FORMLU ;HANDLE THE EXPRESSION FORMLB: TDZA F,F ;EITHER IS LEGAL, FIRST COME, FIRST SERVED FORMLN: SETOI F, ;ONLY NUMERICS ARE LEGAL FORMLU: SETZM TYPE ;ASSUME EXPRESSION IS REAL IN CASE OF STRING PUSHJ P,CFORM ;CHECK FOR COMPARISONS ; ; CHECK FOR BOOLEAN LOGIC ; BTERM1: PUSHJ P,KWSCIF ;CHECK FOR BOOLEAN KEYWORDS POPJ P, ;NONE FOUND, RETURN MOVE X1,KWDIND ;GET INDEX TO KEYWORD SUBI X1,KWACIF ;MAKE AN OFFSET FOR OPCODE PUSH P,X1 ;AND SAVE IT MOVMS LETSW ;CANNOT BE L. H. OF LET JUMPGE F,SETFER ;MUST BE NUMERIC PUSHJ P,GPOSGE ;GUARANTEE A POSITIVE OPERAND PUSHJ P,PUSHPR ;SAVE IT ON SEXROL MOVEI F,(F) ; PUSHJ P,CFORM ;CHECK FOR COMPARISONS TLNE B,ROLMSK ;IS RIGHT SIDE OPERAND IN REG? JUMPGE F,SETFER ;ILLEGAL IF STRING PUSHJ P,REGFRE ;NO, MAKE SURE REGISTER IS FREE PUSHJ P,EIRGNP ;GET OPERAND IN REG PUSHJ P,POPPR ;GET RIGHT SIDE OPERAND BACK POP P,X1 ;GET OPCODE INDEX BACK MOVE D,BOCODE(X1) ;PICK UP CORRECT BOOLEAN OPCODE PUSHJ P,BUILDA ;DO THE INSTRUCTION CLEAR B, ;EXPRESSION IN REG, AND POSITIVE JRST BTERM1 ;CHECK FOR ANOTHER BOOLEAN ; BOCODE: AND N, ;AND IOR N, ;OR IOR N, ;IOR XOR N, ;XOR EQV N, ;EQV ORCM N, ;IMP ; CFORM: PUSHJ P,QSA ;CHECK FOR UNARY "NOT" ASCIZ /NOT/ JRST CFORM0 ;NO NOT, CHECK <,>,=, ETC. MOVMS LETSW ;CANNOT BE L. H. PUSHJ P,SETFNO ;MUST BE NUMERIC PUSHJ P,REGFRE ;MAKE SURE REGISTER IS FREE PUSHJ P,CFORM0 ;GET OBJECT OF NOT TLNE B,MINFLG ;OUTSTANDING "-"? PUSHJ P,EIRGNP ;YES, NEGATE IT MOVSI D,(SETCM) ;COMPLEMENT THE BASTARD PUSHJ P,BUILDA ;DO THE INSTRUCTION CLEAR B, ;EXPRESSION IN REG, AND POSITIVE POPJ P, ;AND RETURN ; CFORM0: PUSHJ P,FORM ;CHECK FOR ARITHMETIC FORMULA ; CFORM1: MOVEI X1,76 ;CHECK FOR POSSIBLE COMPARISONS CAIN X1,(C) ;RIGHT ANGLE BRACKET JRST CFORM2 ;YES, COMPARISION COMING UP MOVEI X1,74 ;LEFT ANGLE BRACKET? CAIN X1,(C) ;YES? NO? JRST CFORM2 ;YES, COMPARISION SKIPGE LETSW ;ARE WE ON L. H. OF LET? POPJ P, ;YES, LET AN "=" PASS TLNN C,F.EQAL ;EQUAL SIGNS? POPJ P, ;NO, RETURN CFORM2: MOVMS LETSW ;CAN'T BE L. H. PUSHJ P,GPOSGE ;MAKE SURE WE HAVE CORRECT SIGN PUSHJ P,PUSHPR ;AND SAVE IT PUSHJ P,SCNLT1 ;CHARACTER TO "A" IN SEVEN BIT MOVEI X1,76 ;CHECK FOR TWO WORD COMPARISION CAIE X1,(C) ;RIGHT ANGLE BRACKET TLNE C,F.EQAL ;OR EQUALS SIGN? PUSHJ P,SCN2 ;YES, COMBINE IN "A" IN SIXBIT JFCL ;IGNORE ERROR RETURN MOVEI R,RELROL ;SEARCH RELROL FOR PUSHJ P,SEARCH ;FOR THIS RELATION FAIL HRLZ D,(B) ;PICK UP THE OPCODE PUSH P,D ;AND SAVE IT PUSHJ P,FORM ;GET NEXT ARITHMETIC FORMULA PUSHJ P,GPOSGE ;GET CORRECT SIGN PUSHJ P,CMIXM ;CHECK FOR MIXED MODE TLNN B,ROLMSK ;IS RIGHT SIDE ALREADY IN REG JRST CFORM3 ;YES, COMPARE WITH LEFT SIDE PUSHJ P,EXCHG ;GET LEFT SIDE IN REG MOVE D,(P) ;GET THE OPCODE TLNE D,1000 ;EQUAL OR NOT EQUAL TLC D,6000 ;NO, REVERSE SENSE OF COMPARISION MOVEM D,(P) ;RESTORE OPCODE CFORM3: JUMPGE F,CFORM4 ;STRING COMPARISON PUSHJ P,EIRGNP ;NO, GET OPERAND IN REG PUSHJ P,POPPR ;GET NEXT OPERAND POP P,D ;GET BACK THE OPCODE PUSHJ P,BUILDA ;DO THE INSTRUCTION JRST CFORM5 ;AND CONTINUE CFORM4: PUSHJ P,EIRGNP ;GET OPERAND IN REG PUSHJ P,POPPR ;GET BACK SECOND OPERAND MOVSI D,(STRIF) ;OPCODE FOR STRING COMPARISON PUSHJ P,BUILDA ;DO THE INSTRUCTION POP P,D ;GET BACK COMARISON OPCODE PUSHJ P,BUILDI ;AND COMPARE WITH REG CFORM5: MOVSI D,(TDZA) ;FALSE RESULT PUSHJ P,BUILDI ;DO THE INSTRUCTION MOVSI D,(SETO) ;TRUE RESULT PUSHJ P,BUILDI ;DO THE INSTRUCTION CLEAR B, ;RESULT IN REG HRLI F,-1 ;NUMERIC RESULT JRST CFORM1 ;AND START ALL OVER AGAIN ; ; ALTERNATE ENTRY POINTS FOR FORML? WHEN LOGICAL ; EXPRESSION ARE ILLEGAL ; XFORMS: HRLZI F,1 ;FOR STRINGS ONLY JRST XFORMU ;CARRY ON XFORMB: TDZA F,F ;BOTH ARE LEGAL XFORMN: SETOI F, ;ONLY NUMERICS XFORMU: SETZM TYPE ;TYPE DECLARED EXTERNALLY FORM: PUSHJ P,TERM ;GET FIRST TERM ;ENTER HERE FOR MORE SUMMANDS FORM1: TLNN C,F.PLUS+F.MINS ;IS BREAK PLUS OR "-"? POPJ P, ;NO, SO DONE WITH FORMULA MOVMS LETSW ;THIS CANT BE LH(LET) JUMPL F,FORM3 TLNN C,F.MINS JRST FORM2 PUSHJ P,SETFNO ;MARK NUMERIC IF LEGAL JRST FORM3 FORM2: PUSHJ P,EIRGNP PUSHJ P,CHKCOR ;CHECK CORE REQUIREMENTS PUSHJ P,MASCK1 ;HANDLE STRING EXPRESSION PUSHJ P,TERM PUSHJ P,EIRGNP MOVE D,[PUSHJ P,APPEND] PUSHJ P,BUILDI SETZ B, TLNN C,F.PLUS POPJ P, JRST FORM2 FORM3: PUSHJ P,PUSHPR ;PART RESLT TO SEXROL PUSHJ P,TERM ;GEN SECOND TERM PUSHJ P,CMIXM ;CHECK FOR MIXED MODE TLNE B,ROLMSK ;IS SECOND TERM IN REG? PUSHJ P,EXCHG ;NO. LETS DO FIRST TERM FIRST PUSHJ P,EIRGEN ;FIRST SUMMAND TO REG PUSH P,B ;SAVE SIGN INFORMATION PUSHJ P,POPPR ;GET SECOND SUMMAND SKIPGE (P) ;IS CONTENT OR REG NEGATIVE? TLC B,MINFLG ;YES, NEGATE SECOND SUMMAND SKIPL TYPE ;INTEGER? JRST FORM4 ;NO, DO REAL MOVSI D,(ADD N,) ;ASSUME POSITIVE SKIPGE B ;IS IT MOVSI D,(SUB N,) PUSHJ P,BUILDA ;BUILDI THE INSTRUCTION JRST FORM5 ;CONTINUE FORM4: MOVSI D,(FADR N,) ;FETCH INSTRUCTION PUSHJ P,BUILDS ;BUILD ADD OR SUB INSTR FORM5: POP P,B ;REG PNTR WITH SIGN AND B,[XWD MINFLG,0] JRST FORM1 ;GO LOOK FOR MORE SUMMANDS ;LOOP TO GEN CODE FOR MULTIPLY AND DIVIDE ;CALLS FACTOR TO HANDLE EXPRESSIONS INVOLVING ONLY INFIX OPS AND "^" TERM: PUSHJ P,FACTOR ;GEN FIRST FACTOR ;ENTER HERE FOR MORE FACTORS TERM1: TLNN C,F.STAR+F.SLSH ;MUL OR DIV FOLLOWS? POPJ P, ;NO, DONE WITH TERM. PUSHJ P,SETFNO ;MARK NUMERIC IF LEGAL MOVMS LETSW ;THIS CANT BE LH(LET) HRRZS 0(P) ;SET MUL FLAG. TLNN C,F.STAR ;IS IT MULTIPLY? HRROS 0(P) ;NO. SET DIV FLAG TERM2: PUSHJ P,NXCHK ;SKIP OVER CONNECTIVE PUSHJ P,PUSHPR ;STASH PARTIAL RESULT ON SEXROL PUSHJ P,FACTOR ;GEN NEXT FACTOR PUSHJ P,CMIXM ;CHECK FOR MIXED MODE SKIPGE (P) ;IS SECOND FACTOR A DIVISOR? PUSHJ P,SITGEN ;YES. IT CANNOT STAY IN REG. TLNE B,ROLMSK ;IS SECOND FACTOR IN REG? PUSHJ P,EXCHG ;NO. LETS GET FIRST FACTOR. MOVE X1,CESEX ;PEEK AT DIVISOR OR SECOND FACTOR. MOVE X2,-1(X1) TLZE X2,MINFLG ;IS IT MINUS? TLC B,MINFLG ;YES. CHANGE SIGNS OF BOTH. MOVEM X2,-1(X1) ;NOW DIVISION OR SECOND FACTOR IS PLUS. PUSHJ P,EIRGEN ;GEN FIRST FACTOR OR DIVIDEND PUSH P,B ;SAVE SIGN INFORMATION PUSHJ P,POPPR ;GET SECOND OPERAND MOVSI D,(FMPR N,) ;GET CORRECT INSTRUCTION SKIPGE -1(P) MOVSI D,(FDVR N,) SKIPGE TYPE ;INTEGER? ADD D,[XWD 34000,0] ;YES, MAKE IDIV OR IMUL PUSHJ P,BUILDA ;BUILD MUL OR DIV INSTR POP P,B ;REG PNTR WITH SIGN JRST TERM1 ;GO LOOK FOR MORE FACTORS ;GEN CODE FOR ATOMIC FORMULAS, EXPONENTIATION, AND INFIX SIGNS ;SIGN IS STASHED IN LH OF PUSH-DOWN LIST WORD WITH RETURN ADDRS ;EXPLICIT SIGN IS NOT USED UNTIL AFTER EXPONENTIATION ;IS CHECKED FOR. FACTOR: PUSH P,C ;STASH SIGN IN PUSH LIST. TLNN C,F.MINS ;EXPLICIT MINUS SIGN? JRST FACT2 ;NO. PUSHJ P,SETFNO ;MARK NUMERIC IF LEGAL TLC C,F.PLUS+F.MINS ;YES. PRETEND IT WAS PLUS CALLING ATOM. MOVMS LETSW ;AND THIS CANNOT BE LH OF LET. FACT2: PUSHJ P,ATOM ;GEN FIRST ATOM FACT2A: CAIN C,"^" ;EXPONENT FOLLOWS? JRST FACT3A ;YES. TLNN C,F.STAR ;MAYBE. JRST SNOEXI ;NO. GO NOTE SIGN AND RETURN. MOVEM T,X1 PUSHJ P,NXCHK TLNE C,F.STAR JRST FACT3A ;YES. MOVE T,X1 ;NO. GO NOTE SIGN AND RETURN. MOVE C,[XWD F.STAR, "*"] JRST SNOEXI FACT3A: PUSHJ P,SETFNO ;MARK NUMERIC IF LEGAL MOVMS LETSW ;THIS CANT BE LH(LET) PUSHJ P,NXCHK ;YES. SKIP EXPONENTIATION SIGN PUSHJ P,PUSHPR ;STASH BASE ON SEXROL PUSHJ P,ATOM ;GEN THE EXPONENT PUSHJ P,EXCHG ;EXCHANGE BASE AND EXPONENT PUSHJ P,EIRGNP ;GET POSITIVE BASE IN REG SKIPGE TYPE ;FLOATING BASE? JRST FACT5A ;NO, DO INTEGER EXP PUSHJ P,POPPR ;GET EXPONENT MOVSI D,(MOVE 1,) ;WILL MOVE IT TO AC 1 PUSHJ P,BUILDS ;GENERATE CORRECT SIGN MOVE D,[PUSHJ P,EXP3.0] ;ASSUME FLOATING EXP SKIPGE TYPE ;IS IT? HRRI D,EXP2.0 ;NO, USE EXPS.0 SETZM TYPE ;ANSWER IS FLOATING JRST FACT6A ;CONTINUE FACT5A: MOVE X1,CESEX ;PEEK AT EXP MOVE X2,-1(X1) ; TLNE X2,100000 ;FLOATING EXP? JRST FACT5B ;NO INT ** INT MOVE D,[PUSHJ P,FLTPNT] ;FLOAT THE BASE PUSHJ P,BUILDI ; PUSHJ P,POPPR ;GET THE EXPONENT MOVSI D,(MOVE 1,) ;PUT IN AC 1 PUSHJ P,BUILDS ;CORRECT SIGN MOVE D,[PUSHJ P,EXP3.0] ; JRST FACT6A ;CARRY ON FACT5B: PUSHJ P,POPPR ; MOVSI D,(MOVE 1,) ; PUSHJ P,BUILDS ; MOVE D,[PUSHJ P,EXP1.0] ; FACT6A: PUSHJ P,BUILDI ;BUILD CALL TO EXPONENTIATION ROUTINE MOVEI B,0 ;ANSWER LANDS IN REG JRST FACT2A ;SIGN NOTE AND EXIT ;COMPLEMENT SIGN IF "-" AND APPROPRIATE FLAGS ON PD LIST. ;THEN RETURN FROM SUBROUTINE. SNOEXI: POP P,X1 TLNE X1,F.MINS ;IS SAVED SIGN MINUS? TLC B,MINFLG ;YES. COMPLEMENT POPJ P, ;GEN CODE FOR SIGNED ATOM. ATOM: PUSH P,C ;SAVE SIGN INFO. TLNE C,F.PLUS ;EXPLICIT SIGN? JRST ATOM1 TLNN C,F.MINS JRST ATOM2 PUSHJ P,SETFNO ;CHECK LEGALITY ATOM1: PUSHJ P,NXCHK ;YES. SKIP SIGN ATOM2: TLNE C,F.LETT ;LETTER? JRST FLETTR ;YES. VARIABLE OR FCN CALL. TLNE C,F.DIG+F.PER ;NUMERAL OR DECIMAL POINT? JRST FNUMBR ;YES. LITERAL OCCURRENCE OF NUMBER TLNE C,F.QUOT JRST REGSLT ;STR CONSTANT. CAIE C,"(" ;SUBEXPRESSION? JRST ILFORM ;NO. ILLEGAL FORMULA FSUBEX: PUSHJ P,NXCHK ;SUBEXPR IN PARENS. SKIP PAREN MOVMS LETSW ;CANNOT BE L. H. PUSHJ P,FORMLU ;GEN THE SUBEXPRESSION TLNN C,F.RPRN ;BETTER HAVE MATCHING PAREN JRST ILFORM ;NO. GRONK. PUSHJ P,NXCHK ;SKIP PARENTHESIS JRST SNOEXI ;GO TEST SIGN AND RETURN. ;HERE WHEN ATOMIC FORMULA IS A NUMBER FNUMBR: PUSHJ P,SETFNO ;CHECK LEGALITY MOVMS LETSW PUSH P,F SETZM TYPE ;ASSUME REAL PUSHJ P,EVANUM ;EVALUATE NUMBER (IN N) FAIL POP P,F MOVE X1,0(P) ;GET SIGN FLAG CAIE C,"^" ;EXPONENT FOLLOWS? TLNN X1,F.MINS ;OR IS IT PLUS ANYWAY? JRST FNUM1 ;YES. DONT FUDGE SIGN TLNN C,F.STAR ;CHECK FOR OTHER KIND OF EXPONENT. JRST FNUM5 ;NO, NOT THIS KIND OF EXP EITHER. MOVEM T,B PUSHJ P,NXCH MOVE T,B TLNE C,F.STAR JRST FNUM1 ;YES, EXPONENT. MOVE C,[XWD F.STAR,"*"] FNUM5: MOVN N,N ;NEGATE NUMBER SETZM 0(P) ;AND CLEAR SIGN INFO. FNUM1: MOVE B,FLCON ;SEARCH CONSTANT ROLL FNUM2: CAML B,CECON ;(UNSORTED--CANT USE SEARCH) JRST FNUM3 ;NOT FOUND CAME N,(B) ;THIS ONE? AOJA B,FNUM2 ;NO. GO TO NEXT. SUB B,FLCON ;FOUND. CALC REL ADDRESS IN CONROL. HRLI B,CONROL JRST SNOEXI FNUM3: MOVE B,FLDON FNUM3A: CAML B,CEDON JRST FNUM3B CAME N,(B) AOJA B,FNUM3A SUB B,FLDON JRST FNUM4 FNUM3B: MOVEI R,DONROL ;PUSH ON CONROL MOVE A,N PUSHJ P,RPUSH MOVEI R,CADROL ;PUT ADDRS ON CONST ADDRS ROLL MOVEI A,0 PUSHJ P,RPUSH SUB B,FLCAD ;GET REL ADDRS FNUM4: HRLI B,CADROL ;MAKE POINTER JRST SNOEXI ;GO LOOK AT SIGN AND RETURN. NNUM: PUSH P,[EXP 1] ;REGISTER THE CONSTANT IN "N" JRST FNUM1 ;ROUTINE TO EVALUATE NUMBER ;T: PNTR TO FIRST CHAR, C: FIRST CHAR ;NON-SKIP IS FAIL RETURN ;RETURN NUMBER IN N ;N: ACCUM NBMR, B: SCA FAC, D: DIG CNT, USE FLGS IN LEFT OF F EVANUM: SETZB N,B ;CLEAR ACS MOVEI D,8 MOVEI F,(F) ;CLEAR LH OF F TLNE C,F.PLUS ;SKIP + JRST EVAN1 TLNN C,F.MINS ;CHECK FOR - JRST EVAN2 ;NO TLO F,F.MIN ;SET MINUS FLG EVAN1: PUSHJ P,NXCH EVAN2: TLNN C,F.DIG ;DIGIT? JRST EVAN3 ;NO TLO F,F.NUM ;DIGIT SEEN FLAG JUMPE N,EVAN2A ;DONT COUNT LEADING ZEROS SOJG D,EVAN2A ;COUNT DIGIT, GO ACCUM IF OK ; REST OF DIGITS ARE INSIGNIFIGANT. AOJA B,EVAN2B ;LEAD OR TRAIL 0, FUDGE SCA FAC EVAN2A: IMULI N,^D10 ;ACCUMULATE DIGIT ADDI N,-60(C) EVAN2B: TLNE F,F.DOT ;DECIMAL SEEN? SUBI B,1 ;YES. COUNT DOWN SCALE FACT JRST EVAN1 ;GO TO NEXT CHAR EVAN3: TLNN C,F.PER ;NOT DIGIT. DEC PNT? JRST EVAN4 ;NO. TLOE F,F.DOT ;YES, SET FLG & CHK ONLY ONE POPJ P, ;2 DEC PNTS JRST EVAN1 EVAN4: TLNN F,F.NUM ;DID WE SEE A DIGIT? POPJ P, ;NO. WHAT A LOUSY NUMBER MOVEI X1,"E" CAIE X1,(C) ;EXPLICIT SCALE FACTOR? JRST EVAN8 ;NO PUSH P,T PUSH P,C EV2: PUSHJ P,NXCH ;DO LOOK AHEAD TLNE C,F.PLUS ;SCALE FACTOR SIGN JRST EVAN5 TLNN C,F.MINS JRST EVAN6 TLO F,F.MXP EVAN5: PUSHJ P,NXCH EVAN6: TLNN C,F.DIG ;CHK FOR DIGIT JRST EVAN6A POP P,A POP P,A MOVEI A,-60(C) ;SAVE FIRST EXPON DIGIT EV4: PUSHJ P,NXCH TLNN C,F.DIG ;IS THERE A SECOND DIGIT JRST EVAN7 ;NO IMULI A,^D10 ;YES. ACCUMULATE IT ADDI A,-60(C) EV5: PUSHJ P,NXCH ;DO LOOK AHEAD EVAN7: TLNE F,F.MXP ;NEG EXPON? MOVN A,A ;YES. NEGATE IT ADD B,A ;ADD TO SCALE FACTOR JRST EVAN8 EVAN6A: POP P,C POP P,T EVAN8: JUMPN B,EVAN8F TLNE F,F.DOT JRST EVAN8F CAME C,[XWD F.STR,"%"] ;PERCENT JRST EVAN9 ;NO, CHECK PFLAG SETOM PFLAG ;% SEEN PUSHJ P,NXCH ;EAT THE % EVAN9A: SETOM TYPE ;TYPE IS INTEGER JRST CPOPJ1 ; EVAN9: SKIPGE PFLAG ;WAS A PERCENT SEEN? JRST EVAN9A ;YES, THEN THIS IS INTEGER EVAN8F: JUMPE N,CPOPJ1 ;IGNORE SCALE IF NUMBER IS 0 EVAN8A: MOVE X1,N ;) IDIVI X1,^D10 ;)REMOVE ANY TRAILING ZEROS JUMPN X2,EVAN8B ;) IN MANTISSA. (REASON: MOVE N,X1 ;) SO THAT, E.G., .1, AOJA B,EVAN8A ;) .10, .100, ..., ARE THE SAME) EVAN8B: TLO N,233000 ;FLOAT N FAD N,[0] SETZM LIBFLG ;CLEAR OVER/UNDERFLOW FLAG. EVAN8C: CAIGE B,^D15 ;SCALE UP IF .GE. 10^15 JRST EVAN8D SUBI B,^D14 ;SUBTRACT 14 FROM SCALE FACTOR FMPR N,D1E14 ;MULTIPLY BY 10^14 JRST EVAN8C ;GO LOOK AT SCALE AGAIN EVAN8D: CAML B,[EXP -^D4] ;SCALE DOWN IF .LT. 10^-4 JRST EVAN8E ADDI B,^D18 ;ADD 18 TO SCALE FMPR N,D1EM18 ;MULTIPLY BY 10^-18 JRST EVAN8D ;GO LOOK AT SCALE AGAIN EVAN8E: FMPR N,DECTAB(B) ;SCALE N TLNE F,F.MIN ;MINUS? MOVN N,N ;YES. NEGATE IT SKIPE LIBFLG ;SKIP IF NO OVER/UNDERFLOW. JRST CPOPJ JRST CPOPJ1 ;SUCCESS RETURN, NUMBER IN N ;FLAGS USED BY EVANUM F.NUM==200000 ;DIGIT SEEN F.MIN==100000 ;MINUS SEEN F.MXP==40000 ;MINUS EXPONENT F.DOT==20000 ;DECIMAL POINT SEEN ;XLATE AND GEN ATOMIC FORMULA BEGINNING WITH LETTER FLETTR: PUSHJ P,REGLTR FLET1: JRST .+1(A) JRST XARFET ;ARRAY REF JRST SNOEXI ;SCALAR. JUST RETURN JRST XINFCN ;INTRINSIC FCN JRST XDFFCN ;DEFINED FCN JRST ILVAR JRST XARFET ;STRING VECTOR. PROCESS WITH ARRAY CODE! JRST SNOEXI ;POINTER IS IN B FOR BUILDING. FLET2: PUSH P,[EXP 1] ;PUSH AN IMPLICIT PLUS SIGN ON PLIST JRST FLET1 ;FINISH REGISTERING VARIABLE. XARFET: PUSH P,A PUSH P,B PUSH P,TYPE ;SAVE TYPE OF ARRAY PUSHJ P,REGFRE ;FREE REG PUSHJ P,XARG JUMPG F,XARF1 ;STRING VECTOR? SKIPL LETSW ;NO, IS IT LH OF ARRAY-LET? JRST XARF1 ;DO A FETCH AS USUAL. TLNN C,F.EQAL+F.COMA ;IS IT DEFINITELY LH OF ARRAY-LET? JRST XARF1 ;NO. POP P,TYPE ;RESTORE THE TYPE POP P,X1 ;YES. DON'T FETCH! RETURN TO LH(LET) POP P,A SUB P,[XWD 10,10] ;ADJUST THE PUSHLIST TO ESC FORMLS MOVE A,1(P) PUSH P,B ;SAVE THE ARGUMENT FLAG SKIPGE TYPE ;IS ARRAY INTEGER? TLO X1,100000 ;YES, MARK IT AS SUCH PUSH P,X1 ;SAVE THE ARRAY POINTER JRST (A) XARF1: POP P,TYPE ;RESTORE THE TYPE MOVSI D,(ARFET1) JUMPL F,XARF2 ;STR VECTOR? MOVSI D,(SVRADR) ;YES. FETCH STRING POINTER ADDRESS. HRRZ X1,(P) ;OFFSET TO SVRROL MOVE X2,FLOOR(F) ;FLOOR OF SVRROL ADD X2,X1 ;PLUS OFFSET MOVE X1,(X2) ;GET FIRST ENTRY IN SVRROL TLNE X1,(1B0) ;VIRTUAL STRING VECTOR TLNE C,F.EQAL+F.COMA ;IS THIS A LH OF LET JRST XARF2 ;NOT VIRTUAL OR LH SETOM AFLAG ;NO, MARK A FLAG XARF2: JUMPE B,XARFFN SKIPGE F MOVSI D,(ARFET2) HRRZ X1,0(P) ;MARK DOUBLE ARRAY ADD X1,FLOOR(F) SKIPN 1(X1) SETOM 1(X1) XARFFN: EXCH B,0(P) PUSHJ P,BUILDA POP P,B PUSH P,TYPE ;SAVE THE TYPE PUSHJ P,GENARG POP P,TYPE ;RESTORE THE TYPE MOVEI B,0 ;REG POINTER JUMPL F,XALAB1 ;STRING VECTOR? PUSHJ P,SITGEN ;YES,SAVE ADDRESS POINTER XALAB1: POP P,A JRST SNOEXI ;GEN FUNCTION CALLS XDFFCN: PUSH P,F ;SAVE FCN TYPE PUSH P,D ;SAVE FCN NAME SETZ D, ;BEGIN MASK AT ZERO PUSH P,D ;SET UP ARGUMENT TYPE MASK PUSHJ P,REGFRE ;SAVE ANY SUBEXPRESSION PUSHJ P,PUSHPR ;SAVE FUNCTION LOCATION MOVE D,[PUSHJ P,SAVACS] PUSHJ P,BUILDI CAIE C,"(" ;ANY ARGS? JRST XDFF2 ;NO MOVEI D,1 ;SET UP FOR ARG BITS. PUSH P,D ;SAVE IT SETZM PSHPNT ;INITIALIZE COUNT OF PUSH INSTS GENNED XDFF1: SETZM PFLAG ;CLEAR % SEEN FLAG PUSHJ P,NXCHK PUSH P,LETSW MOVMS LETSW PUSHJ P,FORMLB ;GEN THE ARGUMENT IN REG POP P,LETSW ;RESTORE LET SWITCH POP P,D ;GET BACK ARGUMENT BITS JUMPGE F,XDFF1B ;STRING? SKIPL TYPE ;NO, INTEGER? JRST XDFF1A ;NO, MARK REAL IORM D,(P) ;SET ONE BIT JRST XDFF1B ;MARK SECOND BIT XDFF1A: IORM D,(P) ;MARK REAL LSH D,2 ;SET FOR NEXT ARG JRST XDFF1C ;AND CONTINUE XDFF1B: LSH D,1 ;SKIP A BIT IORM D,(P) ;MARK IT LSH D,1 ;SET UP FOR NEXT ARG XDFF1C: SKIPN D ;TOO MANY ARGUMENTS NOW FAIL PUSH P,D ;RESAVE SKIPGE B ;IN REGISTER? PUSHJ P,EIRGP1 ;YES, TAKE IT OUT MOVSI D,(PUSH Q,) ;BUILD ARGUMENT PUSH PUSHJ P,BUILDA AOS PSHPNT ;COUNT THE PUSH AOS -2(P) ;ALSO SAVE THE COUNT FOR CHECK OF ARGS TLNE C,F.COMA ;MORE ARGS? JRST XDFF1 ;YES TLNN C,F.RPRN ;CHECK FOR MATCHING PAREN JRST ERRPRN SETZM PSHPNT ;RESET THE PUSH COUNT AGAIN PUSHJ P,NXCHK ;SKIP PAREN POP P,X1 ;DITCH ARGUMENT TYPE MASK BIT XDFF2: PUSHJ P,ARGCHK ;CHECK FOR RIGHT NUMBER OF ARGUMENTS POP P,X1 ;GET RID OF ARGUMENT TYPE MASK POP P,X1 ;GET RID OF POINTER TO ARG# CONSTANT PUSHJ P,POPPR ;GET BACK FUNCTION LOC MOVSI D,(GOSUB) PUSHJ P,BUILDA ;GEN THE CALL MOVEI B,0 ;ANSWER IS IN REG POP P,F ;RETURN FCN TYPE JRST SNOEXI ;ROUTINE TO CHECK NUMBER OF ARGUMENTS AND CREATE A CONSTANT TO POP THEM ;OFF THE PUSH LIST. CALLED WITH XWD FCNAME,# OF ARGS ;AT LOCATION -1(P) RETURNS WITH A POINTER TO CONSTANT ;AT THAT LOCATION. ARGCHK: MOVE N,-1(P) ;AND THEIR TYPE MASK PUSHJ P,NNUM ;REGISTER AS CONSTANT MOVE N,-2(P) ;GET FCN NAME IN L.H. MOVEM B,-2(P) ;AND SAVE CONSTANT ADDRESS HRR N,B ;ASSEMBLE FADROL ENTRY... HLRZS B ;CHECK FOR CONSTANT IN CONROL CAIE B,CONROL ;IS IT? JRST ARGCH0 ;TOO BAD HLLZ A,N ;SETUP SEARCH ARGUMENT MOVEI R,FADROL ; XWD FCNAME,CONSTANT ADDRESS PUSHJ P,SEARCH JRST ARGCH1 ;FIRST TIME FCN SEEN. PUT ENTRY IN ROLL CAMN N,(B) ;FCN SEEN BEFORE. SAME NUMBER OF ARGS? POPJ P, SETZM FUNAME ARGCH0: FAIL ARGCH1: FAIL ;INTRINSIC FUNCTION GENERATOR. XINFCN: PUSH P,FTYPE ;SAVE TYPE OF SUBEXPRESSION PUSH P,B ;SAVE FUNCTION LOC AND FLAGS PUSHJ P,REGFRE ;PROTECT ANY PARTIAL RESULT MOVE B,(P) ;GET THE FLAG BITS TLNN B,777777 ;INLINE CODE PRODUCER? JRST XINF4 ;YES, TYPED INTERNALLY TLNE B,777 ;ANY ARGUMENTS? JRST XINF2 ;YES, HANDLE ARGUMENTS CAIE C,"(" ;OPTIONAL ARGUMENT JRST XINF1 ;NO, SET TPE PUSHJ P,NXCH ;EAT A "(" PUSH P,F ;SAVE F PUSHJ P,FORMLB ;DO THE ARGUMENT POP P,F ;RESTORE F XINF0: TLNN C,F.RPRN ;ARGUMENT LIST ENDS WITH ) JRST ERRPRN ;IT DIDN'T PUSHJ P,NXCH ;EAT THE ) XINF1: POP P,D ;GET FUNCTION LOC. AND FLAGS CLEARM TYPE ;ASSUME FUNCTION TYPE IS NON-INTEGER TLNE D,4000 ;IS IT INTEGER? SETOM TYPE ;YES, SET THE TYPE HRLI D,(PUSHJ P,) ;GENERATE THE PUSHJ XINF11: PUSHJ P,BUILDI ; DO THE INSTRUCTION CLEAR B, ;CLEAR ADDRESS POP P,FTYPE ;RESTORE PREVIOUS TYPE JRST SNOEXI ;AND RETURN ; ; HERE FOR FUNCTIONS WITH ARGUMENTS AND NO INLINE ; XINF2: CAIE C,"(" ;NEEDS ARGUMENTS JRST ARGCH0 ;NONE GIVEN PUSH P,F ;SAVE TYPE OF SUBEXPRESSION SKIPGE B ;HAS SPECIAL ARGUMENT BLOCK JRST XINF21 ;YES, HANDLE SEPARATELY LDB X1,[POINT 9,B,17]; GET TYPE OF ARGUMENT SETOM FTYPE ;ASSUME IT SHOULD BE INTEGER CAIE X1,4 ;SHOULD IT BE? CLEARM FTYPE ;NO, SET FOR NON-INTEGER CAIE X1,1 ;SHOULD ARGUMENT BE A STRING? SETO X1, ;NO, SET TYPE FOR NUMERIC HRL F,X1 ;SET TYPE FOR FORMLU MOVEI X1,1 ;ONE ARGUMENT NEEDED JRST XINF22 ;CODE THE FUNCTION ; ; HERE FOR FUNCTIONS WITH SPECIAL ARGUMENT BLOCK ; XINF21: HLRZ D,B ;ADDRESS OF ARG BLOCK MOVE X1,(D) ;NUMBER OF ARGUMENTS TO EXPECT CAIN X1,3 ;3? I. E. INSTR OR MID$ JRST XINF3 ;YES, MIGHT BE TWO ARGUMENTS XINF20: HRLZ F,1(D) ;GET ARGUMENT TYPE FOR FORMLU SETOM FTYPE ;NUMERICS SHOULD ALWAYS BE INTEGER ; XINF22: PUSH P,X1 ;SAVE NUMBER OF ARGUMENTS PUSH P,D ;AND FUNCTION LOC AND FLAGS PUSHJ P,NXCH ;EAT THE SEPARATOR , OR ( PUSHJ P,XFORMU ;GENERATE THE ARGUMENT PUSHJ P,EIRGNP ;MAKE SURE ITS IN REG JUMPG F,XINF23 ;STRING ARGUMENT? MOVE X1,FTYPE ;NO, CHECK THE TYPE CAME X1,TYPE ;MATCHING? PUSHJ P,CHKTYP ;NO, FIX OR FLOAT IT CAIA ;AND SKIP STRING CHECK XINF23: PUSHJ P,MASCK1 ;STORE ARGUMENT IN MASAPP POP P,D ;BACK WITH FUNCTION LOC AND FLAGS POP P,X1 ;AND NUMBER OF ARGUMENTS SOJN X1,XILAB1 ;ALL ARGUMENTS PROCESSED POP P,F ;YES, RESTORE SUBEXPRESSION TYPE JRST XINF0 ;AND FINISH UP XILAB1: TLNN C,F.COMA ;NEED A COMMA JRST ERCOMA ;NONE THERE AOJA D,XINF20 ;DO NEXT XINF3: SKIPG 1(D) JRST XINF31 PUSHJ P,XINST1 ;MID$. PUSHJ P,XINNUM POP P,F ;RESTORE F. CLEARM TYPE ;MID$ IS REAL TLNN C,F.COMA JRST XINF0A MOVE D,[PUSH P,N] PUSHJ P,BUILDI PUSHJ P,XINNM1 HRLI F,1 ;RESTORE F. JRST XINF01 XINF31: PUSHJ P,NXCH ;INSTR. PUSHJ P,CHKCOR ;CHECK CORE REQUIREMENTS PUSHJ P,XFORMB PUSHJ P,EIRGNP JUMPG F,XINF34 SKIPL TYPE ;IS IT INTEGER PUSHJ P,GENINT ;NO, FIX IT MOVE D,[PUSH P,N] PUSHJ P,BUILDI JRST XINF32 XINF34: PUSHJ P,MASCK1 ;HANDLE STRING EXPRESSION PUSHJ P,XINSTR POP P,F SETOM TYPE ;INSTR IS INTEGER JRST XINF0A XINF32: PUSHJ P,XINSTR PUSHJ P,XINSTR POP P,F XINF01: TLNN C,F.RPRN JRST ERRPRN PUSHJ P,NXCH POP P,D HRRZI D,(D) ADD D,[PUSHJ P,3] SETOM TYPE ;INSTR IS INTEGER JRST XINF11 XINSTR: TLNN C,F.COMA ;SUBR FOR STR ARG. JRST ERCOMA XINST1: PUSHJ P,NXCH PJRST MASCHK ;HANDLE STRING ARGUMENT XINNUM: TLNN C,F.COMA ;SUBR FOR NUMERIC ARGUMENT. JRST ERCOMA XINNM1: PUSHJ P,NXCH PUSHJ P,XFORMN JRST CHKINN ;CHECK TYPE XINF0A: TLNN C,F.RPRN JRST ERRPRN PUSHJ P,NXCH POP P,D HRLI D,(PUSHJ P,) JRST XINF11 XINF4: POP P,B POP P,FTYPE ;RESTORE FTYPE JRST .(B) ;IN LINE CODE. JRST ABSBI JRST ASCBI JRST CRTBI JRST DETBI JRST FLTBI JRST LLBI JRST LOCBI JRST LOFBI JRST NUMBI JRST PIBI JRST SGNBI JRST TIMBI ;IN LINE FUNCTION GENERATORS. ABSBI: CAIE C,"(" ;ABS FUNCTION. JRST ARGCH0 PUSHJ P,NXCH PUSHJ P,XFORMN PUSHJ P,EIRGNM TLNN C,F.RPRN JRST ERRPRN JRST INLIO2 INLIOU: TLNN C,F.RPRN JRST ERRPRN INLIO0: PUSHJ P,BUILDI INLIO2: PUSHJ P,NXCH INLIO1: MOVEI B,0 JRST SNOEXI ASCBI: CAIE C,"(" ;ASC FUNCTION. JRST ARGCH0 SETZ X2, PUSHJ P,NXCHD TLNN C,F.RPRN JRST ASCB11 PUSH P,T PUSHJ P,NXCH TLNN C,F.RPRN JRST ASCBI0 POP P,T JRST ASCBI3 ASCB11: TLNN C,F.SPTB JRST ASCBI3 MOVE X1,C ;BLANKS AND TABS. ASCBI1: PUSHJ P,NXCHD ;IF ONLY BLANKS ARE TLNE C,F.RPRN ;PRESENT, THE ARG IS A JRST ASCBI2 ;BLANK. IF ONLY BLANKS TLNE C,F.CR ;AND TABS ARE PRESENT, THE ASCBI0: FAIL ;ARG IS TLNN C,F.SPTB ;A TAB. O'E, THE BLANKS JRST ASCBI3 ;AND TABS ARE IGNORED. CAME C,X1 CAMN C,X2 JRST ASCBI1 MOVE X2,C JRST ASCBI1 ASCBI2: MOVE C,X1 JUMPE X2,ASLAB1 MOVE C,[XWD F.SPTB,11] ASLAB1: PUSH P,T HRRZ A,C PUSHJ P,NXCH TLNE C,F.RPRN JRST ASCB21 POP P,T ROT A,-7 JRST ASCBI5 ASCB21: POP P,T HRLZI A,500000 JRST ASCBI5 ASCBI3: PUSHJ P,SCNLT1 TLNE C,F.RPRN JRST ASCBI5 ;1 CHAR ARG. TLNE C,F.TERM JRST ILFORM PUSHJ P,SCN2 JUMP TLNE C,F.RPRN JRST ASCBI6 ;2 CHAR CODE. TLNE C,F.TERM JRST ILFORM PUSHJ P,SCN3 JUMP TLNN C,F.RPRN JRST ERRPRN JRST ASCBI6 ;THREE CHAR CODE. ASCBI5: PUSH P,N ;SET UP IN LINE CODE. LDB N,[POINT 7,A,6] ASCB51: HRR D,N POP P,N ASCB52: HRLI D,(MOVEI N,) SETOM TYPE JRST INLIO0 ;EXIT. ASCBI6: PUSH P,N ;SEARCH. HLRZ A,A MOVEI X1,ASCFLO ADDI X1,1 ASCBI7: HLRZ X2,-1(X1) CAIN A,(X2) JRST ASCBI8 HRRZ X2,-1(X1) CAIN A,(X2) JRST ASCBI9 CAIGE X1,ASCCEI AOJA X1,ASCBI7 JRST ASCBI0 ASCBI8: SUBI X1,ASCFLO MOVEI N,2(X1) CAIG X1,^D10 MOVEI N,-1(X1) JRST ASCB51 ASCBI9: SUBI X1,ASCFLO MOVEI N,22(X1) CAIN X1,^D15 MOVEI N,^D127 JRST ASCB51 ;TABLE OF CODES FOR THE ASC FUNCTION. ASCFLO: SIXBIT /NULDC3/ SIXBIT /SOHDC4/ SIXBIT /STXNAK/ SIXBIT /ETXSYN/ SIXBIT /EOTETB/ SIXBIT /ENQCAN/ SIXBIT /ACKEM / SIXBIT /BELSUB/ SIXBIT /BS ESC/ SIXBIT /HT FS / SIXBIT /CR GS / SIXBIT /SO RS / SIXBIT /SI US / SIXBIT /DLESP / SIXBIT /DC1DEL/ SIXBIT /DC2 / ASCCEI: ; ; CRT FUNCTION ; CRTBI: CAIE C,"(" ;CRT TAKES AN ARGUMENT JRST ARGCH0 ;BUT NONE GIVEN PUSHJ P,NXCH ;EAT THE "(" PUSHJ P,XFORMN ;CRT NEEDS NUMERIC ARGUMENT PUSHJ P,EIRGEN ;MOVE ARGUMENT VALUE INTO REG. SKIPGE TYPE ;IS ARGUMENT INTEGER? JRST CRTBI1 ;YES, NO CONVERSION NEEDED MOVE D,[PUSHJ P,FIXPNT] ;MUST FIX ARGUMENT PUSHJ P,BUILDI ;DO IT CRTBI1: MOVE D,[EXCH N,CRTVAL] ;SET CRTVAL, RETURN OLD VALUE SETOM TYPE JRST INLIOU ;GENERATE INSTRUC., CHECK FOR ")" ; ; DET FUNCTION ; DETBI: CAIN C,"(" ;DET FUNCTION. JRST ARGCH0 ;NO ARGUMENTS MOVE D,[MOVE N,DETER] SETZM TYPE ;REAL FUNCTION PUSHJ P,BUILDI JRST INLIO1 FLTBI: CAIE C,"(" ;NEEDS AN ARGUMENT JRST ARGCH0 ;NONE THERE PUSHJ P,NXCHD ;EAT THE ( PUSHJ P,XFORMN ;GET NUMERIC ARGUMENT PUSHJ P,EIRGEN ;MOVE TO REG MOVE D,[PUSHJ P,FLTPNT] ;TO FLOAT SKIPL TYPE ;IS IT ALREADY REAL? MOVSI D,(JFCL) ;YES, DUMMY FLOAT JRST INLIOU ;ALL DONE LLBI: CAIE C,"(" ;MUST HAVE ARG JRST ARGCH0 PUSHJ P,NXCH PUSHJ P,GETNUM ;GET IT FAIL MOVE D,N ;STASH NO HRLZ A,N ;AND CHECK ITS VALIDITY MOVEI R,LINROL PUSHJ P,SEARCH FAIL ,1 HRLI D,(MOVEI N,) ;GEN INST. SETOM TYPE JRST INLIOU ;AND GO AWAY LOCBI: SETZM LOCLOF ;LOC FUNCTION. LOCBI1: CAIE C,"(" ;LOF ENTERS HERE. JRST ARGCH0 PUSHJ P,NXCH CAIN C,":" PUSHJ P,NXCH PUSHJ P,GETCN0 HRLZI D,(MOVE X1,) PUSHJ P,BUILDI MOVE D,[SKIPGE X2,ACTBL-1(X1)] PUSHJ P,BUILDI MOVE D,[CAME X2,NEGONE] PUSHJ P,BUILDI MOVE D,[JRST FNMX0] PUSHJ P,BUILDI MOVE D,[MOVE N,POINT-1(X1)] SKIPE LOCLOF MOVE D,[MOVE N,LASREC-1(X1)] SETOM TYPE JRST INLIOU LOFBI: SETOM LOCLOF ;LOF FUNCTION. JRST LOCBI1 NUMBI: CAIN C,"(" ;NUM FUNCTION. JRST ARGCH0 ;NO ARGUMENTS MOVE D,[MOVE N,NUMRES] PUSHJ P,BUILDI SETOM TYPE JRST INLIO1 PIBI: SETZM TYPE MOVE D,[MOVE N,PIB] PUSHJ P,BUILDI JRST INLIO1 SGNBI: CAIE C,"(" ;SGN FUNCTION. JRST ARGCH0 PUSHJ P,NXCH PUSHJ P,XFORMN PUSHJ P,EIRGNP MOVSI D,(SKIPE N) ;SIGN OF ZERO IS ZERO PUSHJ P,BUILDI ;GENERATE INSTRUCTION TO DO SO MOVE D,[PUSHJ P,SGNB##] ;CALL SGN FUNCTION SETOM TYPE JRST INLIOU TIMBI: MOVSI D,(SETZ N,) ;TIM FUNCTION. PUSHJ P,BUILDI MOVE D,[RUNTIM N,] PUSHJ P,BUILDI MOVE D,[SUB N,BGNTIM] PUSHJ P,BUILDI MOVE D,[PUSHJ P,EIFLOT] PUSHJ P,BUILDI MOVE D,[FDVRI N,212764] PUSHJ P,BUILDI SETZM TYPE JRST INLIO1 ;ROUTINE TO XLATE ARGUMENTS ;RETURNS WITH ARGS ON SEXROL. B IS O IF ONE ARG, -1 IF TWO. XARG: PUSHJ P,NXCHK ;SKIP PARENTHESIS. PUSH P,LETSW ;SAVE LETSW WHILE TRANSL ARGS MOVMS LETSW ;THE COMMA FOLLOWING AN ARG IS NOT LH(LET)! PUSH P,F PUSHJ P,FORMLB JUMPL F,XARG0 XARG3: FAIL XARG0: POP P,F PUSHJ P,GPOSNX PUSHJ P,SITGEN PUSHJ P,PUSHPR MOVEI B,0 TLNN C,F.COMA ;COMMA FOLLOWS? JRST XARG1 ;NO. ONE ARG. PUSHJ P,NXCHK ;YES GEN AND SAVE SECOND ARG PUSH P,F PUSHJ P,FORMLB JUMPG F,XARG3 POP P,F PUSHJ P,GPOSNX PUSHJ P,SITGEN PUSHJ P,PUSHPR MOVNI B,1 ;DBL ARG FLAG XARG1: POP P,LETSW ;RESTORE LETSW TLNN C,F.RPRN ;MUST HAVE PARENTHESIS JRST ERRPRN JRST NXCHK ;IT DOES. SKIP PAREN AND RETURN. ;ROUTINE TO GEN ARGUMENTS GENARG: JUMPE B,GENAFN ;ONE OR TWO ARGS? GENAR0: PUSHJ P,POPPR ;TWO PUSHJ P,EXCHG PUSHJ P,GENAF1 GENAFN: PUSHJ P,POPPR GENAF1: MOVSI D,(JUMP 2,) SKIPGE TYPE ;REAL OR INTEGER TLZ D,100 ;INTEGER, CLEAR REAL BIT JRST BUILDA ;ROUTINE TO ANALYZE NEXT ELEMENT ;CALL: PUSHJ P,REGLTR ;RETURNS ROLL PNTR IN B, CODE IN A ;CODE IS: 0-ARRAY, 1-SCALAR, 2-INTRINSIC FCN, 3-DEFINED FCN, 4-FAIL ; 5-STRING VECTOR, 6-STRING VARIABLE, 7-STRING LITERAL. REGCLT: TLNN C,F.LETT ;IS IT A LETTER? JRST ERLETT ;NO, GIVE NEED A LETTER ERROR REGLTR: PUSHJ P,SCNLT1 ;LTR TO A, LEFT JUST 7 BIT HRRI F,SCAROL ;ASSUME SCALAR TLNE C,F.LETT ;ANOTHER LETTER? JRST REGFCN ;YES. GO LOOK FOR FCN REF PUSHJ P,DIGIT ;ADD IN DIGIT IF ANY PUSHJ P,DOLLAR ;STRING VARIABLE? JRST REGSTR ;YES, REGISTER IT PUSHJ P,PERCNT ;CHECK FOR PERCNT PUSHJ P,SETFNO ;AND CHECK LEGALITY CAIN C,"(" ;POSSIBLE ARRAY JRST REGARY ;YES, REGISTER ARRAY ;RETURN HERE IF REGARY SAYS NOT ARRAY ;RETURN HERE IF REGFCN SAYS FOLLOWED BY KEYWORD. REGL1: TLNE A,1 ;IS THIS A SCALAR? JRST REGL1A ;NO. DON'T LOOK FOR FCN ARGUMENT MOVE B,FLARG ;IS THIS A FN ARG? RELAB1: CAML B,CEARG ;SEARCH UNORDERED ARGROL JRST REGL1A ;NOT A FN ARG CAME A,(B) AOJA B,RELAB1 ;TRY NEXT ROLL ENTRY. JRST FARGRF ;YES REGL1A: MOVEI R,VARROL ;NO. SCALAR PUSHJ P,SEARCH ;IN VARIABLE ROLL? FAIL HRRZ D,(B) ;YES. GET PNTR TO SCAROL ; B ::= REL LOC OF ROLL ENTRY REGL3: MOVE B,D ;B ::= REL LOC OF ROLL ENTRY TLO B,(F) ;MAKE ROLL POINTER AND SKIP JRST REGSCA ;COME HERE ON REF TO FCN ROL ;CALCULATE ADDRESS OF THIS FUNCTION ARGUMENT. FARGRF: SUB B,CEARG ;NOW ADDRESS IS -NN FOR FIRST ARG, -1 FOR NNTH ARG, ETC HRLI B,PSHROL REGSCA: MOVEI A,1 ;CODE SAYS SCALAR POPJ P, ;RETURN SCAREG: HRRI F,SCAROL ;REGISTER THE CONTENTS OF A AS SCALAR JRST REGL1A STRREG: HRRI F,VSPROL ;REGISTER AS STRING PUSHJ P,REGL1A ; JRST REGS1 ;FIX TYPE CODE REGARY: HRRI F,ARAROL ;NUMERICAL ARRAY GOES ON ARAROL REGA1: TLO A,1 ;MAKE ARRAY NAME DIFFERENT FROM SCALAR MOVEI R,VARROL ;LOOK FOR VARIABLE NAME PUSHJ P,SEARCH FAIL HRRZ D,(B) ;GET POINTER TO ARAROL REGA3: MOVE B,D ;RECONSTRUCT PNTR ANDI B,377777 ;B := REL ADDRS IN ARRAY ROLL HRLI B,(F) ;B := POINTER TO ENTRY ON ROLL MOVEI A,0 ;ARRAY CODE POPJ P, ;SUBROUTINE TO REGISTER ARRAY NAME. ;(USED BY DIM,MAT) ARRAY: HRRI F,ARAROL ;ASSUME ITS NOT A STRING TLNN C,F.LETT JRST REGFAL SETZM TYPE ;ASSUME REAL PUSHJ P,SCNLT1 ;NAME TO A PUSHJ P,DIGIT ;GET DIGIT IF ANY PUSHJ P,DOLLAR ;DOLLAR FOLLOWS? JRST ARRAY2 ;YES, HANDLE STRING PUSHJ P,PERCNT ;PERCENT? ARRAY0: PUSHJ P,SETFNO ;CHECK FOR LEGALITY PUSHJ P,REGARY ;FINISH REGISTERING ARRAY1: MOVE X1,B ;SET DEFAULT TO 2-DIM ARRAY ADD X1,FLOOR(F) SKIPN 1(X1) SETOM 1(X1) POPJ P, ARRAY2: PUSHJ P,SETFST ;MARK STRING IF LEGAL PUSHJ P,REGSVR ;REGISTER STRING VECTOR JRST ARRAY1 ;SET DEFAULT, IF NECESSARY VECTOR: PUSHJ P,ARRAY ;REGISTER VECTOR CAIE A,5 ;WAS A STRING REGISTERED? JUMPN A,CPOPJ ;WAS AN ARRAY REGISTERED? MOVE X2,1(X1) JUMPG X2,VELAB1 ;EXPLICIT DIMENSION? MOVNI X2,2 ;NO. CALL IT A VECTOR OF UNKNOWN DIM. MOVEM X2,1(X1) POPJ P, VELAB1: TLNE X2,777776 ;IS THIS A ROW VECTOR? TRNN X2,777776 ;OR A COLUMN VECTOR? POPJ P, ;YES. FAIL REGSTR: PUSHJ P,SETFST ;MARK STRING IF LEGAL HRRI F,VSPROL ;POINTER WILL GO ON VSPROL CAIN C,"(" ;IS IT A STRING VECTOR? JRST REGSVR ;YES. PUSHJ P,REGL1 ;REGISTER STRING. JRST REGS1 ;FIX VARIABLE TYPE CODE. REGSLT: MOVMS LETSW ;STR LIT. PUSHJ P,SETFST ;MARK STRING IF LEGAL PUSHJ P,NXCHD PUSH P,C PUSH P,T SETZ A, REGSL1: TLNE C,F.QUOT ;COUNT CHARACTERS. JRST REGSL2 TLZN C,F.CR ; OR ? JRST RGSLX1 ;NO CAIN C,12 ; ? SOSA A ;YES, IGNORE JRST ERQUOT ;NO RGSLX1: PUSHJ P,NXCHD AOJA A,REGSL1 REGSL2: CAILE A,^D132 ;TOO LONG ? FAIL MOVEI E,4(A) MOVN A,A HRLI A,(A) MOVE T,CEDLT SUB T,FLDLT HRRI A,(T) MOVEI R,DITROL PUSH P,E PUSHJ P,RPUSH ;PUSH POINTER ONTO LITERAL ROLL POP P,E IDIVI E,5 JUMPE E,REGSL3 MOVEI R,DLTROL ;SET UP SLTROL. PUSHJ P,BUMPRL REGSL3: POP P,T POP P,C TLZ C,777777 HRLI B,440700 REGSL4: CAIN C,42 JRST REGSL5 CAIE C,12 ;SKIP IDPB C,B ILDB C,T JRST REGSL4 REGSL5: PUSHJ P,NXCH MOVEI R,SADROL ;MOVE LITROL ADDRESS ON STR-LIT-ADR ROLL MOVEI A,0 PUSHJ P,RPUSH SUB B,FLSAD ;GET REL ADRESS HRLI B,SADROL ;SET UP POINTER. MOVEI A,7 JRST SNOEXI REGSVR: HRRI F,SVRROL ;REGISTER STRING VECTOR PUSHJ P,REGA1 ;REGISTER AS AN ARRAY REGS1: CAIE A,4 ;DID REGISTRATION FAIL? ADDI A,5 ;NO. FIX TYPE CODE. POPJ P, DIGIT: TLNN C,F.DIG ;DIGIT FOLLOWS? POPJ P, ;NO, RETURN DPB C,[POINT 7,A,13] ;YES, STORE IT JRST NXCH ;GET NEXT CHARACTER AND RETURN DOLLAR: TLNN C,F.DOLL ;IS IT A $? AOSA (P) ;NO, SKIP RETURN TLOA A,10 ;YES, MARK IT POPJ P, ;RETURN SETZM TYPE JRST NXCHK ;GET NEXT CHARACTER AND RETURN PERCNT: SETZM TYPE ;ASSUME REAL CAME C,[XWD F.STR,"%"] POPJ P, ;RETURN TLO A,4 ;YES, MARK IT SETOM TYPE ;MARK AS INTEGER SETOM PFLAG ;WE SAW A % JRST NXCHK ;GET NEXT ;NOTE: IF THE SAME VARIABLE NAME IS USED AS A SCALAR, ARRAY, ; STRING VECTOR, AND STRING, IT WILL BE DISTINGUISHED IN "VARROL" ; BY THE FOLLOWING 4-BIT ENDINGS: ; SCALAR 0 OR 4; ARRAY 1 OR 5; STRING 10; STRING VECTOR 11. ;TABLE OF MIDSTATEMENT KEYWORDS: KWTBL: KWAALL: KWACIF: ;COMBINED IF KEYWORDS ASCIZ /AND/ ASCIZ /OR/ ASCIZ /IOR/ ASCIZ /XOR/ ASCIZ /EQV/ ASCIZ /IMP/ KWZCIF: ASCIZ /THEN/ ASCIZ /GOTO/ KWAAMD: ASCIZ /ELSE/ KWAFOR: ;FOR STMT KEYWORDS ASCIZ /TO/ ASCIZ /STEP/ ASCIZ /BY/ KWAMOD: ;MODIFIER KEYWORDS ASCIZ /WHILE/ ASCIZ /UNTIL/ KWZFOR: ;END OF FOR KEYWORDS ASCIZ /IF/ ASCIZ /UNLESS/ ASCIZ /FOR/ KWZMOD: ASCIZ /USING/ KWAONG: ASCIZ /GOSUB/ KWZAMD: KWZALL: KWTTOP: ;GENERATE SERVICE ROUTINE FOR VARIOUS KEYWORD SEARCHES DEFINE KWSBEG(U) < IRP U > KWSBEG KWDSR1: PUSH P,X2 ;SAVE X2 FROM QST PUSHJ P,QST ;LOOK FOR NEXT JRST KWDSR2 ;NOT THERE POP P,X2 ;RESTORE X2 AOS -4(P) ;FOUND, SKIP RETURN HRRZM X1,KWDIND ;SAVE INDEX CAIN X2,KWZALL-1 ;SEARCHING ALL KEYWORDS ? JRST KWDSR3 ;YES, JUST RETURN POP P,X2 ;NO, THROW AWAY POP P,X2 ;CHAR & COUNTER JRST KWDSR5 ;TO CONTINUE SCAN KWDSR3: POP P,T ;RESTORE POINTER POP P,C ;AND CHAR KWDSR5: POP P,X2 ;X2 POP P,X1 ;AND X1 POPJ P, ;RETURN KWDSR2: POP P,X2 ;RESTORE X2 MOVE T,(P) ;GET BACK POINTER MOVE C,-1(P) ;AND CHAR CAIE X2,(X1) ;FINISHED ? AOJA X1,KWDSR1 ;NO, TRY AGAIN JRST KWDSR3 ;YES, GO BACK KWSTUP: EXCH X1,(P) ;SAVE X1, GET RETURN ADDRESS PUSH P,X2 ;SAVE X2 PUSH P,C ;SAVE CHAR PUSH P,T ;AND POINTER PUSH P,X1 ;AND RETURN ADDRESS PUSHJ P,QSA ;WAS I FOR THERE ASCIZ /IFOR/ POPJ P, ;NO, ALL CLEAR POP P,X2 ;YES, RECTIFY PDL JRST KWDSR3 ;AND IGNORE IT ;REGISTER FUNCTION NAME ;FIRST LETTER HAS BEEN SCANNED ;IT IS POSSIBLE THAT WE HAVE SCANNED A ONE-LETTER VARIABLE NAME ;FOLLOWED BY ONE OF THE KEYWORDS "TO" , "THEN", OR "STEP". ;FIRST WE LOOK AHEAD TO SEE IF THIS IS SO; ;IF IT IS WE GO BACK TO SCALAR CODE. REGFCN: PUSHJ P,KWSALL ;LOOK FOR KEYWORDS JRST REGFX1 ;NONE FOUND PUSHJ P,SETFNO ;CHECK NUMERIC LEGALITY JRST REGL1 XLIST LIST REGFX1: ;HAVE DETERMINED THAT WE MUST BE SCANNING A FUNCTION NAME ;IF SYNTAX IS LEGAL. ;WE SCAN THE SECOND LETTER AND CHECK FOR ;INTRINSIC OR DEFINED FUNCTION. PUSHJ P,SCNLT2 JRST REGFAL ;NOT A LETTER CAMN A,[SIXBIT /FN/] ;DEFINED FUNCTION? JRST REGDFN ;YES. GO REGISTER DEFINED NAME. ;HERE WE HAVE FN NAME NOT BEGINNING WITH "FN" ;LOOK FOR IT IN TABLE OF INTRINSIC FUNCTIONS. MOVE X1,[POINT 6,A,11] ;CONSTRUCT WHOLE NAME. MOVEI R,4 REGF4: TLNN C,F.LETT JRST REGF5 REGF41: PUSHJ P,KWSALL ;LOOK FOR KEYWORDS CAIA ;NONE JRST REGF9 ;FOUND TLNN C,F.LCAS TRC C,40 IDPB C,X1 PUSHJ P,NXCH SOJG R,REGF4 REGF9: PUSHJ P,SETFNO ;CHECK NUMERIC LEGALITY JRST REGF6 REGF5: TLNN C,F.DIG JRST REGF51 CAME A,[SIXBIT/LOG /] CAMN A,[SIXBIT/LOG1 /] JRST REGF41 REGF51: TLNN C,F.DOLL JRST REGF9 PUSH P,X1 PUSHJ P,CHKCOR POP P,X1 REGF10: MOVEI C,4 ;$ IN SIXBIT. IDPB C,X1 PUSHJ P,NXCH PUSHJ P,SETFST ;CHECK STRING LEGALITY REGF6: CAMN A,[SIXBIT/VAL /] PUSHJ P,CHKCOR REGF0: MOVEI R,IFNFLO REGF7: CAMN A,(R) JRST REGF8 ;FOUND FN. AOJ R, CAIGE R,IFNCEI JRST REGF7 JRST REGFAL REGF8: SUBI R,IFNFLO MOVE B,IF2FLO(R) ;GET ENTRY IN 2ND TABLE. MOVMS LETSW ;CAN'T BE LH(LET) MOVEI A,2 ;INTRINSIC FCN CODE. POPJ P, ;RETURN "XINFCN" DOES ITS OWN ")" CHECK. ;HERE TO REGISTER DEFINED FUNCTION NAME ;THE "FN" HAS ALREADY BEEN SCANNED ;SCAN IDENTIFYING LETTER AND PUTTING ENTRY IN ;FUNCTION CALL ROLL REGDFN: PUSHJ P,CHKCOR REGDF0: PUSHJ P,SCNLT1 ;PUT FUNCTION NAME IN A PUSHJ P,DIGIT ;CHECK FOR A DIGIT PUSHJ P,PERCNT ;CHECK FOR A PERCENT TLNE A,4 ;NO DOLLAR POSSIBLE IF PERCNT JRST REGDF1 ; PUSHJ P,DOLLAR ;DOLLAR THERE PUSHJ P,[AOS (P) ;YES JRST SETFST] ;REGISTER STRING IF LEGAL REGDF1: PUSHJ P,SETFNO ;MARK NUMERIC IF LEGAL MOVE D,A ;NO, REAL FUNCTION CALL. SAVE NAME FOR ARGCHK MOVMS LETSW MOVEI R,FCNROL ;FUNCTION CALL ROLL PUSHJ P,SEARCH ;USED THIS ONE YET? FAIL REGFC1: SUB B,FLOOR(R) HRLI B,FCNROL MOVEI A,3 ;DEFINED FCN CODE POPJ P, ;DON'T CHECK FOR () YET CHKPRN: CAIE C,"(" REGFAL: MOVEI A,4 ;FAIL IF NO PAREN POPJ P, SUBTTL SUBROUTINES USED BY GEN ROUTINES ;SETFNO - SET PARTIAL RESULT NUMERIC IF LEGAL SETFNO: SKIPGE F ;RETURN IF NUMERIC ALREADY POPJ P, ; TLOE F,-1 ;SET NUMERIC, ANY OTHER BITS SET? SETFER: FAIL POPJ P, ;SETFST - SET PARTIAL RESULT STRING IF LEGAL SETFST: JUMPL F,SETFER ;CAN'T - NUMERIC SPECIFIED HRLI F,1 ;MARK STRING SETZM TYPE POPJ P, ;RETURN ;PUSHPR - PUSH PARTIAL RESULT ON SEXROL PUSHPR: MOVEI R,SEXROL MOVE A,B ;SAVE POINTER IN A SKIPGE TYPE ;REAL OR INTEGER? TLO A,100000 ;INTEGER PUSHJ P,RPUSH SUB B,FLSEX ;MAKE POINTER TLZ A,100000 ; TLNN A,ROLMSK ;IS IT A POINTER TO REG? HRROM B,REGPNT ;YES, SET POINTER FOR SITGEN TO USE POPJ P, ;POPPR - POP PARTIAL RESULT FROM SEXROL POPPR: MOVEI R,SEXROL MOVE B,CESEX SUBI B,1 ;COMPUTE ADDRS OF TOP OF SEXROL PUSH P,(B) ;SAVE THE CONTENT MOVEI E,1 PUSHJ P,CLOSUP POP P,B ;POPPED POINTER TO B CLEARM TYPE ; TLZE B,100000 ; SETOM TYPE ; POPPFN: TLNN B,ROLMSK ;POINTER TO REG? SETZM REGPNT ;YES. CLEAR MEMORY POPJ P, ;EXCHG - EXCHANGE CURRENT PNTR WITH TOP OF SEXROL EXCHG: MOVE X1,CESEX MOVEI X2,-1(X1) ;FIX PNTR IF REG SAVED SUB X2,FLSEX TLNN B,ROLMSK HRROM X2,REGPNT SKIPGE TYPE ;IS IT AN INTEGER TLO B,100000 ;YES MARK IT EXCH B,-1(X1) CLEARM TYPE ;ASSUME REAL TLZE B,100000 ;IS IT AN INTEGER SETOM TYPE ;YES, SET THE TYPE JRST POPPFN ;GO FIX PNTR IF REG POPPED ;REGFRE - GUARANTEE THAT NO PART RESULT IS IN REG REGFRE: SKIPN REGPNT ;SUBEXP IN THE REG? POPJ P, ;NO MOVE X1,FLSEX ;YES. COMPUTE WHERE ADD X1,REGPNT EXCH B,(X1) ;GET THE POINTER, SAVE CURR PNTR PUSH P,TYPE ;SAVE THE TYPE CLEARM TYPE ;ASSUME REAL TLZE B,100000 ;IS IT AN INTEGER SETOM TYPE ;YES, REMEMBER IT PUSHJ P,SITGEN ;STORE IN TEMP MOVE X1,FLSEX ;RECOMPUTE LOC IN SEXROL ADD X1,REGPNT SKIPGE TYPE ;IS IT AN INTEGER TLO B,100000 ;YES, MARK IT POP P,TYPE ;RESTORE OLD TYPE EXCH B,(X1) SETZM REGPNT ;CLOBBER REGPNT SINCE REG IS EMPTY POPJ P, ;GPOSGE - GUARANTEE POSITIVE GEN GPOSGE: JUMPGE B,CPOPJ ;RETURN IF ALREADY POSITIVE ;FALL INTO EIRGEN ;EIRGEN - EXP IN REG GEN EIRGEN: TLNN B,ROLMSK ;ALREADY IN REG? POPJ P, ;DO NOTHING ERGNFN: PUSHJ P,REGFRE ;FREE UP REG MOVSI D,(MOVE N,) ;GET MOVE INSTR EIRGM2: PUSHJ P,BUILDS ;BUILD MOVE INSTR MOVEI B,0 ;POSITIVE REG POINTER POPJ P, ;EIRGNP - EXP IN REG GEN POSITIVE EIRGNP: JUMPGE B,EIRGEN ;POSITIVE? EIRGP1: TLNE B,ROLMSK ;NO. IN REG? JRST ERGNFN ;NO. GO MOVE MOVSI D,(MOVN N,) ;YES,NEGATIVE N EIRGM3: PUSHJ P,BUILDI MOVEI B,0 ;POSITIVE REG PNTR POPJ P, ;EIRGNM -- GEN MAG. EIRGNM: TLNN B,ROLMSK JRST EIRGM1 TLZ B,400000 PUSHJ P,REGFRE MOVSI D,(MOVM N,) JRST EIRGM2 EIRGM1: MOVSI D,(MOVM N,) JRST EIRGM3 ;SIPGEN - STORE IN PERMANENT TEM GEN SIPGEN: MOVEI R,DPTROL JRST SITGN1 ;SITGEN - STORE IN TEMP GEN SITGEN: MOVEI R,DTPROL SITGN1: TLNE B,ROLMSK ;IS EXPR IN REG? POPJ P, ;NO. DONT DO ANYTHING MOVEI A,0 ;PREPARE ZERO TO PUSH ON ROLL MOVSI D,(MOVEM N,) ;GET CORRECT INSTR JUMPGE B,SILAB1 MOVSI D,(MOVNM N,) SILAB1: CAIE R,DTPROL ;STORE ON TMPROL? JRST SITG2 ;NO. USE PTMROL AOS B,TMPPNT ;WHICH TEMP TO USE? MOVE X1,FLDTP ADD X1,B CAML X1,CEDTP ;NEED MORE TMP SPACE? PUSHJ P,RPUSH ;YES. PUSH A ZERO ONTO TMPROL MOVE B,TMPPNT ;CONSTRUCT TMP ROLL POINTER SITG1: HRLI B,(R) PUSH P,B ;SAVE ADRESS POINTER PUSHJ P,BUILDA ;BUILD STORE INSTR POP P,B ;RECONSTRUCT POINTER POPJ P, SITG2: PUSHJ P,RPUSH ;PUSH A ZERO ONTO PTMROL SUB B,FLDPT JRST SITG1 ;FINISH CONSTRUCTING ADRESS POINTER SUBTTL UTILITY SUBROUTINES ;ROUTINE TO QSA FOR "THEN" OR "GOTO" (USED IN "IF", "ON" STATEMENTS) THENGO: PUSHJ P,QSA ASCIZ /THE/ JRST THGOTS MOVEM T,MULLIN ;SET MULTI-LINE PUSHJ P,QSA ASCIZ /N/ JRST THGERR ;BAD SPELLING ! TLNE C,F.TERM JRST THGERR POPJ P, THGOTS: PUSHJ P,QSA ASCIZ /GOTO/ THGERR: FAIL TLNE C,F.DIG ;DIGIT FOLLOWS ? POPJ P, PUSHJ P,QSA ASCIZ /BASDDT/ JRST ERDIGQ JRST XBAS+1 ;ERROR RETURNS ILFORM: FAIL ILVAR: FAIL GRONK: FAIL ;COMPILATION ERROR MESSAGES OF THE FORM: ; ? A &1 WAS SEEN WHERE A &2 WAS EXPECTED ;WHERE &1 AND &2 ARE APPROPRIATE MESSAGES OR CHARACTERS. ERCHAN: PUSHJ P,FALCHR ASCIZ /# or :/ ERNMSN: PUSHJ P,FALCHR ASCIZ /#/ ERDLPQ: PUSHJ P,FALCHR ASCIZ /$ or % or "/ ERQUOT: PUSHJ P,FALCHR ASCIZ /"/ ERDIGQ: PUSHJ P,FALCHR ASCIZ /a digit or "/ ERTERM: PUSHJ P,FALCHR ASCIZ /a line terminator or apostrophe/ ERLETT: PUSHJ P,FALCHR ASCIZ /a letter/ ERLPRN: PUSHJ P,FALCHR ASCIZ /(/ ERRPRN: PUSHJ P,FALCHR ASCIZ /)/ EREQAL: PUSHJ P,FALCHR ASCIZ /=/ ERCOMA: PUSHJ P,FALCHR ASCIZ /,/ ERSCCM: PUSHJ P,FALCHR ASCIZ /; or ,/ ERCLCM: PUSHJ P,FALCHR ASCIZ /: or ,/ FALCHR: PUSH P,C PUSHJ P,INLMES ASCIZ / / FAL1: PUSHJ P,INLMES ASCIZ /? / POP P,C MOVEI C,(C) CAIE C,11 CAIN C,40 JRST FALSPT CAIL C,12 CAILE C,15 JRST FALAB1 JRST FALFF FALAB1: CAIL C,41 CAILE C,172 JRST FALNON PUSHJ P,OUCH JRST FAL2 FALNON: PUSHJ P,INLMES ASCIZ /A non-printing character/ JRST FAL2 FALFF: PUSHJ P,INLMES ASCIZ /A FF,LF,VT, or CR/ JRST FAL2 FALSPT: PUSHJ P,INLMES ASCIZ /A space or tab/ FAL2: PUSHJ P,INLMES ASCIZ / was seen where / MOVE T,(P) PUSH P,ODF SETZM ODF SETZ D, PUSHJ P,PRINT ;PRINT EXPECTED CHAR OR MESSAGE. POP P,ODF SETZM HPOS POP P,T ;CLEAN UP PLIST. PUSHJ P,INLMES ASCIZ / was expected/ JRST NXTST3 ;QUOTE SCAN OR FAIL ;CALL WITH INLINE PATTERN ;GO TO GRONK IF NO MATCH QSF: POP P,X1 PUSHJ P,QST JRST GRONK JRST 1(X1) CMIXM: MOVE X1,CESEX ;PEEK AT FIRST OPERAND MOVE X2,-1(X1) ;ITS ADDRESS SKIPL TYPE ; JRST CMIXM2 ;NO, CHECK SECOND OPERAND TLZE X2,100000 ;IS SECOND OPERAND INTEGER? POPJ P, ;YES, NO CONVERSION TLNE X2,ROLMSK ;IS THE REGISTER FREE JRST CMIXM1 ;YES, USE IT CMIXM3: PUSH P,B ;SAVE B PUSHJ P,REGFRE ;FREE THE REGISTER POP P,B ;GIVE US B CMIXM1: PUSHJ P,EIRGEN ;GET THE OPERAND SETZM TYPE ;MAKE TYPE REAL PUSH P,B ;SAVE SIGN INFO MOVE D,[PUSHJ P,FLTPNT] ; PUSHJ P,BUILDI ;MUST FLOAT IT POP P,B ;RETURN SIGN INFO AND D,[XWD MINFLG,0] ;JUST RETURN SIGN POPJ P, ;AND RETURN CMIXM2: TLZN X2,100000 ;IS SECOND OPERAND INTEGER POPJ P, ;YES, NOTHING TO DO TLNN B,ROLMSK ;IS REGISTER FREE PUSHJ P,SITGEN ;STORE IT IN TEMP PUSHJ P,EXCHG ;EXCHANGE REGISTERS JRST CMIXM1 ;NOW FLOAT IT CMIXER: MOVE X1,TYPE ;GET THE TYPE CAMN X1,FTYPE ;A MATCH? POPJ P, ;YES, RETURN CHKTYP: MOVE D,[PUSHJ P,FIXPNT] SKIPL FTYPE ; HRRI D,FLTPNT ; PJRST BUILDI ; CHKINN: PUSHJ P,EIRGNP CAIA CHKINT: PUSHJ P,EIRGEN CHKIN1: SKIPGE TYPE ;IS IT AN INTEGER? JRST CHKIN2 ;YES, NOTHING TO DO GENINT: MOVE D,[PUSHJ P,FIXPNT] ;NO, FIX IT PUSHJ P,BUILDI ;OUT WITH IT SETOM TYPE ;SET TYPE TO INTEGER CHKIN2: CLEAR B, ;CLEAR B POPJ P, ;RETURN ;ROUTINES TO GENERATE CODE FOR THE CHANNEL SPECIFIER. GETCNB: PUSHJ P,NXCH GETCNC: PUSHJ P,GETCN2 CHKDL1: TLNN C,F.COMA CAIN C,":" PJRST NXCH JRST ERCLCM GETCN0: PUSHJ P,FORMLN PUSHJ P,EIRGNP PUSHJ P,CHKINT ; MOVSI D,(CAILE N,) PUSHJ P,BUILDI HRRI D,9 PUSHJ P,BUILDI MOVE D,[JRST CNER1] JRST BUILDI GETCNA: PUSHJ P,NXCH GETCN2: PUSHJ P,GETCN0 MOVE D,[MOVE LP,N] JRST BUILDI CHKDEL: TLNN C,F.COMA CAIN C,";" PJRST NXCH JRST NXTSTA GENTYP: HRLI D,(SKIPN (16)) PUSHJ P,BUILDI HRLI D,(SETOM (16)) SKIPN WRREFL HRLI D,(AOS (16)) PUSHJ P,BUILDI HRLI D,(SKIPL (16)) SKIPN WRREFL HRLI D,(SKIPG (16)) PJRST BUILDI GENTP1: CAIN C,":" PUSHJ P,NXCH PUSHJ P,GETCNC MOVE D,[SKIPL ACTBL-1(LP)] PUSHJ P,BUILDI MOVE D,[JRST FNMXER] PJRST BUILDI CHKCOR: SKIPGE VRFSET CHKCR1: SKIPE FUNAME POPJ P, CLEARM VRFSET MOVE D,[PUSHJ P,SETCOR] PJRST BUILDI MASCHK: PUSHJ P,FORMLS ;GEN STRING EXPRESSION IN REG PUSHJ P,EIRGNP ;CHECK REG MASCK1: MOVE D,[PUSHJ P,MASTST] PUSHJ P,BUILDI MOVE D,[AOS T,MASAPP] ; PUSHJ P,BUILDI MOVE D,[MOVEM N,(T)] PJRST BUILDI GETLIN: PUSHJ P,GETNUM ;GET A LINE NUMBER FAIL HRLZ A,N ;IS IT DEFINED? MOVEI R,LINROL ;DON'T KNOW, SEARCH LINROL PUSHJ P,SEARCH ;WELL, IS IT? FAIL SUB B,FLLIN ;FIND POSTION IN LADROL ADD B,FLLAD ;THIS IS IT HLRZ A,(B) ;GET REL CODE ADDRESS ADD A,FLCOD ;ADD START OF REL CODE POPJ P, ;RETURN ;GPOSNX - GUARANTEE POSITIVE AND UNINDEXED GEN GPOSNX: TLNE B,400000+PSHROL ;NEGATIVE OR INDEXED BY (P)? PUSHJ P,EIRGNP ;YES. FORCE INTO REG POPJ P, BUILDP: TLO D,Q ;INSTRUCTION IS INDEXED BY PLIST POINTER SUB B,PSHPNT ;ADJUST THE ADDRESS FOR ANY PUSH INSTS GENNED BY ADDI B,1 HRR D,B ;A CURRENT FN CALL ;ROUTINE TO ADD CODE TO CODROL. ;A WORD IS ASSUMED IN D ;RETURN REL ADDRS IN B BUILDI: MOVE B,DDCODE CAMLE B,FLSEX FAIL AOS DDCODE MOVEM D,(B) SUB B,DDTCOD POPJ P, ;BUILD SIGNED INSTRUCTION WITH ADDRESS ;CHECK SIGN IN B AND CHANGE UP CODE BITS BUILDS: JUMPGE B,BUILDA ;POSITIVE? TLC D,010000 ;NO. CHANGE MOVE TO MOVN,ETC. ;FALL INTO BUILDA ;BUILDA - BUILD INSTRUCTION WITH LINKED ADDRESS ;INSTRUCTION SKELETON IS IN D, ADDRESS POINTER IS IN B BUILDA: TLZE B,PSHROL ;SPECIAL TEST FOR ROLL WITH ABSOLUTE ADDRESSES JRST BUILDP ;YES, PSHROL. DO BUILDI INDEXED BY (Q) TLZ B,400000 JUMPE B,BUILDI ;ITEM IS IN REG . USE ADDRESS ZERO PUSH P,B ;SAVE THE POINTER PUSHJ P,BUILDI ;ADD INSTR WITH 0 ADDRS TO CODE MOVE X1,DDCODE ;LOC+1 OF THE INSTR POP P,X2 ;COMPUTE ADDRS LOCATION LDB R,[POINT 17,X2,17] ADD X2,FLOOR(R) JRST .-6(R) DEFINE JRSTBL(A),< XLIST JRST BLD'A LIST > JRSTBL CON HALT HALT JRSTBL ARA JRSTBL SVR HALT HALT JRSTBL SCA JRSTBL VSP HALT JRSTBL TMP HALT HALT JRSTBL VAR HALT HALT JRSTBL FCN HALT HALT JRSTBL CAD JRSTBL LAD JRSTBL SAD HALT HALT JRSTBL DON JRSTBL DLT JRSTBL DIT JRSTBL DPT JRSTBL DTP BLDDON: BLDTMP: BLDSCA: BLDVSP: BLDSVR: BLDARA: BLDVAR: BLDCON: HRRM X2,-1(X1) POPJ P, BLDFCN: HRRZ B,(X2) ADD B,FLCOD HRRM B,-1(X1) POPJ P, BLDLAD: HLRZ A,(X2) ADD A,FLCOD HRRM A,-1(X1) POPJ P, BLDDLT: BLDDIT: BLDDPT: BLDDTP: BLDSAD: BLDCAD: MOVE R,(X2) HRRM R,-1(X1) SUB X1,DDTCOD SUBI X1,1 HRRM X1,(X2) POPJ P, PCRLF: PUSH P,C MOVEI C,15 PUSHJ P,OUCH MOVEI C,12 PUSHJ P,OUCH OUTPUT POP P,C POPJ P, ;SUBROUTINES FOR GENERAL ROLL MANIPULATION CLOSUP: MOVN X1,E ;COMPUTE NEW END OF ROLL ADDB X1,CEIL(R) ;AND STORE IT MOVE X2,B ;CONSTRUCT BLT WORD ADD X2,E MOVS X2,X2 HRR X2,B BLT X2,-1(X1) ;MOVE DOWN TOP OF ROLL POPJ P, OPEN2: MOVE X2,E ;IS THERE ROOM ABOVE THIS STODGY ROLL? ADD X2,CEIL(R) ;THE NEW CEILING CAMLE X2,FLOOR+1(R) JRST OPENU0 ;NO ROOM, PACK OTHER ROLLS UP ADDM E,CEIL(R) ;THERE IS ROOM, INCREMENT CEILING POPJ P, OPENU0: SUB B,FLOOR(R) PUSHJ P,PANIC ADD B,FLOOR(R) OPENUP: CAMG R,TOPSTG ;OPEN UP THE TOP STODGY ROLL? JRST OPEN2 ;YES. OPEN UPWARDS, NOT DOWN MOVN X2,E MOVE X1,TOPSTG ;DO NOT MOVE STODGY ROLLS ADD X2,FLOOR+1(X1) CAMGE X2,CEIL+0(X1) JRST OPENU0 ;NEED MORE ROOM HRL X2,FLOOR+1(X1) ;CONSTRUCT BLT WORD SUB B,E ;FIRST WORD OF GAP BLT X2,-1(B) ;MOVE ROLLS DOWN MOVEI X1,1(X1) ;ADJUST POINTERS FOR ROLLS JUST BLT'D. MOVN X2,E OPEN1: ADDM X2,FLOOR(X1) CAML X1,R POPJ P, ADDM X2,CEIL(X1) AOJA X1,OPEN1 ;RPUSH - PUSH A ON TOP OF DESIGNATED ROLL RPUSH: MOVEI E,1 PUSHJ P,BUMPRL ;MAKE ROOM MOVEM A,(B) ;STORE WORD POPJ P, ;ROUTINE TO ADD TO END OF ROLL ;E CONTAINS SIZE, R CONTAINS ROLL NUMBER BUMPRL: MOVE B,CEIL(R) ADD B,E CAIE R,ROLTOP SKIPA X1,FLOOR+1(R) HRRZ X1,.JBREL CAMLE B,X1 JRST BUMP1 EXCH B,CEIL(R) POPJ P, BUMP1: MOVE B,CEIL(R) CAIN R,SEXROL JRST BULAB1 JRST OPENUP BULAB1: ADDI E,^D10 ;***EXTRA 10 LOCS PUSHJ P,OPENUP MOVNI X1,^D10 ;TAKE BACK THE 10 LOCS ADDM X1,CEIL(R) POPJ P, ;DPANIC - ROUTINE FOR BASDDT CORE EXPANSION DPANIC: MOVE C,.DDSA ;START OF BASDDT SEGMENT ADD C,CORINC ;PLUS EXPANSION FACTOR HRL C,.DDSA ;SET UP BLT MOVE T,.JBREL ;HIGH ADDRESS BLT C,(T) ;MOVE IT SKIPN DDCODE ;IN MIDST OF BASDDT CODE JRST DPN5 ;NO, THEN DON'T MOVE MOVE C,DDTCOD ADD C,CORINC MOVE T,DDCODE ;LAST INSTR. ADD T,CORINC ;PLUS CORE EXPANSION FACTOR DPN7: CAML C,T ;ALL MOVED? JRST DPN5 ;YES, NOW ZERO OLD BASDDT AREA HRRZ T1,(C) ;GET ADDRESS OF INSTR. CAML T1,DDTCOD ;WITHIN GENERATED CODE CAMLE T1,.JBREL ; JRST DPN8 ;NO ADD T1,CORINC ;ADJUST BY CORE FACTOR HRRM T1,(C) ;PUT BACK DPN8: AOJA C,DPN7 ;DO NEXT DPN5: HRL C,.DDSA ;START OF OLD BASDDT AREA HRR C,.DDSA ;SET UP FOR BLT AOJ C, ;IT'S DONE CLEARM @.DDSA ;CLEAR FIRST LOCATION MOVE T,.DDREL ;END OF BASDDT AREA BLT C,(T) ;ZAP IT MOVEI C,SEXROL MOVE T,CORINC DPN3: CAILE C,ROLTOP JRST DPN2 ADDM T,FLOOR(C) ADDM T,CEIL(C) AOJA C,DPN3 DPN2: MOVE C,17 DPN2A: CAMN C,PLIST JRST DPN6 HRRZ T1,(C) CAML T1,DDTCOD CAMLE T1,.JBREL JRST DPN2B HLRZ T,(C) TRZ T,3740 ;MASK OUT PROCESSOR-DEPENDENT BITS CAIE T,(CAM) JRST DPN2B ADD T1,CORINC HRRM T1,(C) DPN2B: SUB C,[XWD 1,1] JRST DPN2A DPN6: MOVE C,CORINC ;CORE EXPANSION FACTOR ADDM C,.DDFF ;UPDATE .DDFF ADDM C,DDTCOD ;UPDATE DDTCOD ADDM C,.DDSA ;UPDATE .DDSA ADDM C,.DDTMP ;UPDATE .DDTMP ADDM C,.DDREL ;UPDATE .DDREL DPN4: MOVE C,.DDSA ;NEW BASDDT AREA SOJ C, ;NEW HIGH FOR USER MOVEM C,.USREL ;SET IT POPJ P, ;PANIC - ROUTINE TO COMPRESS CORE PANIC: PUSHJ P,PRESS ;COMPRESS MEMORY MOVE X2,TOPSTG ;IS THERE ROOM BETWEEN STODGY AND MOVE X1,FLOOR+1(X2) ;MOVEABLE ONES? SUB X1,CEIL(X2) CAML X1,E ;ENOUGH ROOM? POPJ P, MOVE X1,.JBREL ;EXPAND BY 1K ADDI X1,2000 CORE X1, JRST [PUSHJ P,INLMES ASCIZ / ? Out of room/ JRST ERRMSG] MOVE X1,.JBREL MOVEM X1,.DDREL JRST PANIC ;OK. GO MOVE ROLLS PANIC1: ERROM(60,) PRESS: PUSH P,G ;SAVE AC PUSH P,A ;ROUTINE TO MOVE ROLLS UP PRESS5: MOVEI G,ROLTOP ;HIGHEST MOVABLE ROLL MOVE X1,.JBREL ;X1 IS PREVIOUS FLOOR ;NOTE: TOP WORD OF USR CORE IS LOST PRESS6: MOVE X2,CEIL(G) ;GET OLD CEIL AND FLOOR MOVE A,FLOOR(G) SUBI X2,1 ;SET UP X2 FOR POP LOOP ORCMI X2,777777 MOVEM X1,CEIL(G) ;NEW CEILING PRESS7: CAILE A,(X2) ;DONE? JRST PRESS8 POP X2,-1(X1) ;MOVE ONE WORD SOJA X1,PRESS7 PRESS8: MOVEM X1,FLOOR(G) ;NEW FLOOR SOS G ;GO TO NEXT LOWER ROLL CAMLE G,TOPSTG ;IS THIS ROLL MOVEABLE? JRST PRESS6 ;YES. GO PRESS IT. PRES9A: POP P,A PRESS9: POP P,G ;RESTORE G POPJ P, ;RETURN ERRMSG: SETZM RUNDDT ;CANT RUN DDT SETOM NOLINE ;NO LINE NUMBER TO OUTPUT JRST GOSR2 END