IFNDEF NOCODE, ;NOCODE=1 : JUST DEFINE SYMBOLS IFE NOCODE,< TITLE BASCOM COMPILE/LOAD PHASE > IFN NOCODE,< UNIVERSAL BSYCOM > 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 .JB41 JSR UUOH LOC .JBINT TRPLOC LOC .JBVER BYTE (3)VWHO(9)VBASIC(6)VMINOR(18)VEDIT IFE NOCODE,< RELOC HISEG > IFN NOCODE, INTERN STACEI,STAFLO,RELCEI,RELFLO EXTERN NEGONE EXTERN AFLAG,ERR,ERL,ERRGO,ERRCNT,LINADR EXTERN ERLB,ERRB EXTERN ACTBL,APPEND,ARAROL,ARATOP,ARGROL,ASCIIB,ATANB,BGNTIM EXTERN BLOCK,CADROL,CATFLG,CEARG,CECAD,CECOD,CECON,CEFAD,CEFCL EXTERN CEFOR,CEGSB,CEIL,CELAD,CELIN,CELIT,CENTRY,CENXT EXTERN CEPTM,CEREF,CESAD,CESEX,CESLT,CESTM,CESVR,CETMP,CEVSP EXTERN CHAERR,CHAFL2,CHAFLG,CHAHAN,CHAXIT,CHKIMG,CHRB EXTERN CLOGB,CLSFIL,CNER1,CODROL,COMTIM,CONROL,COSB EXTERN COTB,CRLF,CRTVAL,DATAFF,DATEB,DAYB,DETER,DEVBAS,DOINPT EXTERN DOREAD,EIFLOT,ELSFLG,ELSEAD,ENDIMG,EOF,EXP3.0,EXPB,EXTD EXTERN EXP1.0,EXP2.0,ECHOB EXTERN FADROL,FCLROL,FCNROL,FILCNT,FILD,FILDIR,FILTYP,FPPN EXTERN FIXPNT,FLTPNT 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,LDDTNH,LEFTB,LENB,LETSW,LEXECT,LINEB EXTERN LINROL,LITROL,LOCLOF,LOGB,LOGNEG,LSAVE,LUXIT EXTERN MARERR,MARGAL,MARGIN,MARGN,MASAPP,MIDB,MINFLG,MTIME EXTERN MIXFLG,MASTST EXTERN MULLIN,NEWOL1,NOTLIN,NUMCOT,NUMRES,ODF,OLDCOD EXTERN ONCESW,ONGFLG,OPNFIL,OPNFLG,OUTSET,PAGE,PAGEAL EXTERN PAGLIM,PAKFLG,PIB,PLIST,POINT,POSB,PRDLER,PSAV,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,THNCNT,THNELS,TIMEB,TMPLOW EXTERN TMPPNT,TMPROL,TOPSTG,TRNFL2,TRNFLG,TRPLOC,TRUTH,TTYPAG EXTERN TYPE,FTYPE,PFLAG EXTERN UUOH,VALB,VARFRE,VARROL,VPAKFL,VRFBOT,VRFSET EXTERN INLNFG EXTERN VRFTOP,VSPROL,WRIPRI,WRPRER,WRREFL,XCTON,XRES EXTERN .JBFF,.JBREL,.JBSA ; VIRTUAL ARRAY LOW SEGMENT EXTERNALS EXTERN VIRSIZ,VIRDIM,FLVIR,CEVIR,VIRROL EXTERN VIRBLK,VIRWRD XLIST IFN BASTEK,< LIST ; ; BASTEK CONDITIONAL CODE ; EXTERN INIPLT,PAGPLT,LINPLT,ORGPLT,STRPLT,WHRPLT,MOVPLT,NOORG EXTERN CURPLT,SAVPLT,PLTOUT,PLTIN ; ; END BASTEK CONDITION CODE ; XLIST > LIST EXTERN LBASIC,UXIT BASIC=LBASIC EUXIT=UXIT ;****** EXTERNALS FROM BASLIB (COMLIB) EXTERN BUMPRL,CLOB,CLOSUP,CPOPJ,CPOPJ1,DATCHK,ERACOM EXTERN ERRMS2,ERRMS3,ERRMSG,EVANUM,FILNAM,FILNMO,GETNU EXTERN GETNUM,INLMES,LOCKOF,LOCKON,NXCH,NXCHD,OPENUP EXTERN OUCH,PANIC1,PRESS,PRINT,PRNNAM,QSA,QSELS,QST,RPUSH EXTERN SCN2,SCN3,SCNLT1,SCNLT2,SCNLT3,SEARCH,TTYIN ;****** END EXTERNALS FROM BASLIB (COMLIB) INTERN RUNNH IFN NOCODE,< IF2,< END> > DEFINE FAIL (A,AC)< XLIST XWD 001000+AC'00,[ASCIZ \A\] LIST > %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 MAXUUO=1 UUOHAN: PUSH P,UUOH ;RETURN ADDRS ON PUSH-DOWN LIST LDB X1,[POINT 9,40,8] IFL MAXUUO-37,< CAILE X1,MAXUUO HALT ;ILLEGAL UUO. > UUOTBL: JRST .(X1) JRST FAILER STAFLO: Z XCHAN+20000(SIXBIT / CHA/) Z XCLOSE+60000(SIXBIT / CLO/) Z XDATA+40000(SIXBIT / DAT/) Z XDEF+40000(SIXBIT / DEF/) Z XDIM(SIXBIT / DIM/) Z XELS+20000(SIXBIT / ELS/) Z XEND+20000(SIXBIT / END/) Z XFILE+40000(SIXBIT/ FIL/) Z XFNEND+60000(SIXBIT / FNE/) Z XFOR+20000(SIXBIT / FOR/) Z XGOSUB+60000(SIXBIT / GOS/) Z XGOTO+60000(SIXBIT / GOT/) Z XIF+20000(SIXBIT / IF /) Z XINPUT+60000(SIXBIT / INP/) Z XLET+20000(SIXBIT / LET/) Z XMAR+60000(SIXBIT / MAR/) Z XMAT+20000(SIXBIT / MAT/) Z XNEXT+60000(SIXBIT / NEX/) Z XNOP+60000(SIXBIT / NOP/) Z XNOQ+60000(SIXBIT / NOQ/) Z XON+20000(SIXBIT / ON /) Z XOPEN+60000(SIXBIT / OPE/) Z XPAG+60000(SIXBIT / PAG/) Z XPAUSE+60000(SIXBIT/ PAU/) XLIST IFN BASTEK,< LIST ; ; BASTEK CONDITIONAL CODE ; Z XPLO+60000(SIXBIT/ PLO/) ; ; END BASTEK CONDTIONAL CODE ; XLIST > LIST Z XPRINT+60000(SIXBIT / PRI/) Z XQUO+60000(SIXBIT / QUO/) Z XRAN+60000(SIXBIT / RAN/) Z XREAD+60000(SIXBIT / REA/) Z XREM(SIXBIT / REM/) Z XREST+20000(SIXBIT / RES/) Z XRETRN+60000(SIXBIT / RET/) Z XSCRAT+60000(SIXBIT/ SCR/) Z XSET+20000(SIXBIT / SET/) Z XSTOP+60000(SIXBIT / STO/) Z XUNTIL+60000(SIXBIT / UNT/) Z XWHILE+60000(SIXBIT / WHI/) Z XWRIT+60000(SIXBIT/ WRI/) STACEI: 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) < > 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: ILLIN: ASCIZ / ? Illegal line reference in RUN(NH) or CHAIN/ SUBTTL INITIALISE COMPILATION RUNNH: MOVEI R,STAROL ;SETUP STAROL MOVEI X1,STAFLO ;GET THE FLOOR MOVEM X1,FLOOR(R) ;SET IT MOVEI X1,STACEI ;GET THE CEIL MOVEM X1,CEIL(R) ;SET IT MOVEI R,RELROL ;SETUP RELROL MOVEI X1,RELFLO ;GET THE FLOOR MOVEM X1,FLOOR(R) ;SET IT MOVEI X1,RELCEI ;GET THE CEIL MOVEM X1,CEIL(R) ;SET IT MOVEI X1,^D9 ;CHAIN ENTRY POINT. RUNNH1: SETZM ACTBL-1(X1) SETZM FILD-1(X1) SETZM EXTD-1(X1) SETZM FPPN-1(X1) SOJG X1,RUNNH1 SETOM VRFSET SETOM COMTIM SETZM MULLIN ;INITIALIZE MULTI-LINE SWITCH SETZM FUNAME ;AND FN NAME SETZM FILCNT SKIPN CHAFLG JRST RNLAB1 ;NO. MOVE P,PLIST PUSHJ P,TTYIN RNLAB1: SKIPE SWAPSS ;SET THE CORE CRUNCHING FLAG IF SETOM PAKFLG ;THIS IS A SWAPPING SYSTEM. PUSHJ P,LOCKON ;PROTECT REST OF COMPILATION PUSHJ P,PRESS ;GUARANTEE SOURCE DOESN'T MOVE!!! MOVEI X1,CODROL ;COMPILE TIME. MOVEM X1,TOPSTG ;TXT,LIN,CODROLS ARE STODGY. OTHERS MOVE. MOVEI R,LINROL PUSHJ P,SLIDRL ;SLIDE LINROL DOWN NEXT TO TXTROL. RUNER1: MOVEM X2,FLCOD MOVEM X2,CECOD ;CODROL IS ALSO PACKED IN PLACE. MOVEI X1,CODROL ;PREPARE TO CLOBBER ALL ROLLS ABOVE CODROL MOVE T,.JBREL ;USE THIS VALUE. PUSHJ P,CLOB ;DO THE CLOBBERING. MOVEI F,0 ;CLEAR COMPILATION FLAGS SKIPE CHAFLG ;CHAINING? JRST RUNER0 ;YES, DON'T DISTURB THE TIME. MOVEI T,0 ;SET UP AC FOR RUNTIM. RUNTIM T, ;GET TIME OF START. MOVEM T,MTIME ;SAVE TIME AT START OF RUNER RUNER0: SETOM RUNFLA SETZM DATAFF ;CLEAR DATA FLAG SETOM TMPLOW ;NO TEMPORARIES USED YET. MOVEI F,REFROL ;CREATE A ROLL OF ZEROS PUSHJ P,ZERROL ;NOW MARK THIS ROLL TO SHOW WHAT PARTS OF THIS PROG ARE INSIDE OF FUNCTIONS: LUKDEF: MOVEI A,LUKD0 ;SET RETURN TO LOOK FOR DEF LUKD0: PUSHJ P,NXLINE ;PREPARE TO READ A LINE PUSHJ P,QSA ;LOOK FOR DEFFN ASCIZ /DEFFN/ JRST LUKD1A ;NOT FOUND, LOOK FOR DIM PUSHJ P,SCNLT1 ;BUILD FN NAME PUSHJ P,DIGIT ;SCAN OFF ANY DIGIT PUSHJ P,DOLLAR ;CHECK FOR STRING FUNCTION CAIA ;IT IS, DON'T CHECK FOR % PUSHJ P,PERCNT ;INTEGER FUNCTION HLLZ B,A ;STORE FN NAME IN B SKIPA A,[XWD Z LUKD2] ;SET RETURN TO LOOK FOR FNEND LUKD1: PUSHJ P,NXCH ;GET NEXT CHAR TLNE C,F.TERM ;LINE TERMINATOR JRST LUKD9 ;YES, MULTI-LINE DEF TLNN C,F.EQAL ;EQUALS SIGN JRST LUKD1 ;NO, KEEP LOOKING FOR ONE OR THE OTHER MOVEI A,LUKD0 ;LOOK FOR DEFFN WHEN DONE WITH DIM JRST LUKD9 ;CHECK FOR ANY DIMS LUKD1A: PUSHJ P,QSA ;LOOK FOR THE DIM ASCIZ /DIM/ JRST LUKD9 ;NOT FOUND, SKIP TO NEXT LINE HLLOS (G) ;MARK LINE AS CONTAINING DIM JRST LUKD3 ;DO NEXT LINE LUKD9: PUSHJ P,LUKEND ;FIND LINE TERMINATOR JRST LUKD1A ;GO LOOK FOR A DIM LUKD2: MOVEI A,LUKD2A ;LOOK FOR FNEND AFTER LINE LUKD2A: PUSHJ P,NXLINE ;PREPARE TO READ A LINE HLLM B,(G) ;MARK LINE AS WITHIN DEF LUKD4: PUSHJ P,QSA ;LOOK FOR FNEND ASCIZ /FNEND/ JRST LUKD5 ;NOT FOUND, GO LOOK FOR DIM LUKD24: MOVEI A,LUKD0 ;LOOK FOR DEF NEXT JRST LUKD3 ;FNEND MUST BE LAST IN LINE LUKD5: PUSHJ P,QSA ;LOOK FOR DIM ASCIZ /DIM/ CAIA ;NOT FOUND, DON'T MARK HLLOS (G) ;MARK LINE AS CONTAINING DIM PUSHJ P,LUKEND ;LOOK FOR LINE TERMINATOR JRST LUKD4 ;GO LOOK FOR FNEND LUKEND: PUSHJ P,NXCH ;GET A CHARACTER CAME C,[XWD F.APOS,"'"] ;COMMENT TLNE C,F.CR ;OR CARRIAGE RETURN JRST LUKD3A ;END OF LINE, START ANOTHER ONE TLNN C,F.TERM ;IS IT A LINE TERMINATOR? JRST LUKEND ;NO, KEEP LOOKING POPJ P, ;YES, RETURN LUKD3A: POP P,X1 ;CLEAN PUSH DOWN STACK LUKD3: AOBJN L,(A) ;DO NEXT LINE IF IT EXITS ;FINISHED MARKING FUN LINES. NOW SET UP A CLEAR LADROL... RUNER2: MOVEI F,LADROL PUSHJ P,ZERROL PUSH P,L ;SAVE LINE POINTER MOVE L,FLREF ;START SCANNING REFROL FIXDIM: CAML L,CEREF ;ENTIRE ROLL SCANNED? JRST FIXDON ;YES, WE ARE DONE HRRZ A,(L) ;CHECK IF THIS LINE CONTAINS A DIM HLLZS (L) ;CLEAR IT IN CASE IT WAS SET SKIPN A ;IF NON-ZERO, DIM COMING UP AOJA L,FIXDIM ;NO DIMS, CHECK NEXT LINE SUB L,FLREF ;MAKE IT A POINTER TO LINROL PUSHJ P,NXLINE ;PREPARE TO READ THE LINE ADD L,FLREF ;RESTORE L FXDIMA: PUSHJ P,QSA ;CHECK FOR DIM ASCIZ /DIM/ JRST FXDIM4 ;NONE THERE, GO TO TERMINATOR PUSHJ P,QSA ;CHECK OR FULL DIMENSION ASCIZ /ENSION/ JFCL ;WHO CARES CAME C,[XWD F.STR,"#"] ;VIRTUAL ARRAY DIM? JRST FXDIM4 ;NO, SCAN TO TERMINATOR PUSHJ P,NXCH ;EAT THE # PUSHJ P,GETNUM ;EVALUATE NUMBER JRST FXDERR ;NONE THERE CAILE N,9 ;CAN'T BE GREATER THAN 9 JRST FXDERR ;GIVE ERROR TLNN C,F.COMA ;COMMA MUST FOLLOW JRST FXDERR ;IT DIDN'T FXDIM0: PUSHJ P,NXCH ;EAT WHATEVER CHARACTER IS IN C HRRI F,ARAROL ;ASSUME NUMERIC ARRAY TLNN C,F.LETT ;MUST HAVE LETTER JRST FXDERR ;SIMPLE SHIT, GIVE ERROR PUSHJ P,SCNLT1 ;BUILD ARRAY NAME PUSHJ P,DIGIT ;CHECK FOR A DIGIT PUSHJ P,DOLLAR ;NOW CHECK FOR A DOLLAR JRST FXDIM1 ;FOUND ONE, STRING ARRAY PUSHJ P,PERCNT ;CHECK FOR INTEGER SPEC CAIA ;F ALREADY SET FOR NUMERIC FXDIM1: HRRI F,SVRROL ;FLAG F FOR STRING TLO A,1 ;MAKE NAME UNIQUE FOR ARRAY MOVEI R,VARROL ;SEARCH VARROL FOR THIS ARRAY PUSHJ P,SEARCH ;DO THE SEARCH CAIA ;NOT FOUND, GOOD CONTINUE JRST FXDERR ;VARIABLE DIMENSIONED TWICE PUSHJ P,REGA2 ;REGISTER THE ARRAY CAIE C,"(" ;( MUST BE PRESENT JRST FXDERR ;NOT THERE ADD B,FLOOR(F) ;POINT B TO ARA(SVR)ROL MOVEI X1,400000 ;MARK AS VIRTUAL HRLM X1,(B) ;AND STORE IN ARRAY FXDIM2: PUSHJ P,NXCH ;GET A CHARACTER TLNE C,F.TERM ;LINE TERMINATOR? JRST FXDERR ;YES, TOO SOON TLNN C,F.RPRN ;CLOSING PAREN? JRST FXDIM2 ;NO, KEEP SCANNING FXDIM3: PUSHJ P,NXCH ;GET A CHARACTER CAME C,[XWD F.APOS,"'"] ;REST OF LINE A COMMENT TLNE C,F.CR ;OR END OF LINE AOJA L,FIXDIM ;YES, DO NEXT LINE TLNE C,F.COMA ;ANOTHER ARRAY COMING UP? JRST FXDIM0 ;YES, PROCESS IT TLNN C,F.TERM ;HOW ABOUT A LINE TERMINATOR? JRST FXDIM3 ;NO, KEEP LOOKING PUSHJ P,NXCH ;EAT THE TERMINATOR JRST FXDIMA ;AND SEE IF WE HAVE ANOTHER DIM FXDIM4: PUSHJ P,NXCH ;GET A CHARACTER CAME C,[XWD F.APOS,"'"] ;COMMENT? TLNE C,F.CR ;OR CARRAIGE RETURN AOJA L,FIXDIM ;YES, END OF LINE, DO NEXT TLNN C,F.TERM ;TERMINATOR? JRST FXDIM4 ;NO, KEEP SCANNING PUSHJ P,NXCH ;YES, EAT IT JRST FXDIMA ;AND LOOK FOR NEXT DIM FXDERR: CLEARM RUNFLA ;FOUND AN ERROR, DON'T PRODUCE ANY CODE CAML L,CEREF ;CHECKED ALL OF REFROL JRST FIXDON ;YES, NOW BEGIN ABORTED COMPILATION HLLZS (L) ;CLEAR DIM FLAG IN REFROL AOJA L,FXDERR ;AND CHECK NEXT FIXDON: POP P,L ;RESTORE LINE POINTER SUBTTL PROCESS EACH LINE ;SO FAR, WE HAVE SET UP LADROL FOR ADDRESSES & CHAINS FOR LABLES ;ALSO, L IS A WORD TO AOBJN & COUNT THROUGH LINES. ;BEGIN COMPILATION OPERATIONS FOR EACH LINE EACHLN: MOVE P,PLIST ;FIX P LIST IN CASE LAST INST FAILED PUSHJ P,LOCKOF ;CHECK REENTER REQUEST PUSHJ P,LOCKON MOVE X1,TMPLOW MOVEM X1,TMPPNT ;NO UNPROTECTED TEMPORARIES USED YET. SETZM LETSW SETZM LOGNEG ; CLEARM AFLAG ;CLEAR A FLAG CLEARM PFLAG ;CLEAR % SEEN FLAG SETZM TRNFLG ;NOT YET SEEING MAT TRN. SETZM INLNFG ;CLEAR INPUT LINE FLAG SETZM REGPNT ;REG IS FREE SETZM PSHPNT ;NO "PUSH" INSTS GENERATED YET SETOM VRFSET SKIPN FUNAME ;IN MIDST OF MULTI-LINE FUNCTION JRST ECLAB1 MOVMS VRFSET JRST EACHL2 ECLAB1: MOVE X1,FLARG ;NO FUNCTION ARGS YET MOVEM X1,CEARG EACHL2: SKIPN MULLIN ;SKIP IF MULTI-STATEMENT JRST ECHL2A ; MOVE D,T ; JRST ECHL2B ; ECHL2A: CLEARM THENAD ;ZERO THEN ADDRESS CLEARM ELSEAD ;ZERO ELSE ADDRESS CLEARM THNCNT ;CLEAR COUNT OF THEN'S CLEARM ELSFLG ;CLEAR SINGLE WORD THEN/ELSE SETZM THNELS ;CLEAR CONDITIONAL FLAG PUSHJ P,NXLINE ;SET UP POINTER TO THIS LINE. ECHL2B: MOVSI A,(SIXBIT /REM/) ;PREPARE FOR COMMENT CAIE C,":" ;IMAGE = REM. JRST EACHL4 SKIPE MULLIN ;MULTI-LINE ? FAIL JRST EACHL1 EACHL4: CAMN C,[XWD F.APOS,"'"] JRST EACHL1 ;JUST COMMENT TLNE C,F.TERM ;ANY OTHER TERMINATOR JRST NXSM4 ;IS IGNORED TLNN C,F.LETT ;? FIRST CHAR A LETTER JRST ILLINS ;NO, GRIPE PUSHJ P,SCNLT1 ;SCAN FIRST LTR CAMN C,[XWD F.STR,"%"] ;NEXT LETTER % ? JRST ELILET ;MUST BE LET OR ERROR CAIE C,"(" TLNE C,F.EQAL+F.DIG+F.DOLL+F.COMA ;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 CAIE X1,(SIXBIT /FN/) ;ELIDED LET FNX= ? JRST EACHL3 ;NO. PUSHJ P,SCNLT3 JRST ILLINS TLNE C,F.DIG ;CHECK FOR MAYBE DIGIT PUSHJ P,NXCH ;YES, EAT IT TLNN C,F.EQAL ;IS FOURTH CHAR AN '=' SIGN? CAMN C,[XWD F.STR,"%"] ;OR A PERCENT JRST ELILET ;YES, ELIDED STATEMENT TLNE C,F.DOLL ;OR A $ JRST ELILET JRST EACHL1 ;NO, BETTER BE FNEND. EACHL3: PUSHJ P,SCNLT3 ;ASSEMBLE THIRD LETTER OF STATEMENT IN A JRST ILLINS ;THIRD CHAR WAS NOT A LETTER CAMN A,[624555000000] ;FIX FOR REM HRRZ C,C ;TWO LINES. 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. MOVE X1,CECOD ;PUT REL ADDRS IN LADROL SUB X1,FLCOD MOVE X2,FLLAD ADDI X2,(L) SKIPN MULLIN ;DONT STORE IF MULTI HRLM X1,(X2) HRLI D,(JUMP) MOVEM D,SORCLN ;SAVE SOURCE LINE NUMBER SETOM JFCLAD ;NO JFCL YET TRZN A,20000 ;EXECUTABLE? JRST EACHL6 SKIPN NOTLIN ;OR ARE WE DELETING LINE NOS SKIPE MULLIN ;OR WITHIN MULTI JRST EACHL7 MOVE D,[JSP A,LINADR] ;NUMBER IN SORCLN. PUSHJ P,BUILDI MOVE D,SORCLN ; PUSHJ P,BUILDI ;GENERATE IT NOW EACHL7: CAIN A,40000+XNEXT ;AND NEXT JRST EACHL6 ;NEED NO JFCL MOVSI D,(JFCL) PUSHJ P,BUILDI ;SET JFCL FOR HANDLING MODIFIERS MOVEM B,JFCLAD ;STORE ADDRESS EACHL6: MOVE X1,A TRZN X1,40000 ;MORE TO COMMAND? SOJA X1,EACHL5 ;NO. JUST DISPATCH PUSHJ P,QST ;CHECK REST OF COMMAND JRST ILLINS EACHL5: JRST 1(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,FLCOD MOVSI X2,(JRST) ;PUT JRST SKIPE SAVRUN TLO X2,(4,) ;OR HALT SKIPE RUNFLA ;STILL RUNNING 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 B,FLCOD ;ADDRESSES PUSHJ P,FIXADR 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 CECOD ;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,CECOD ;NEXT CODE MOVE X1,JAROUN ;JUMP AROUND LOC PUSHJ P,FIXADR ;JUMP INTO NEXT SETOM JAROUN ;NO MORE JUMP AROUND MOVE X1,FTYPE ;GET TYPE OF FOR LOOP MOVEM X1,TYPE ;SET UP FOR NEXT PUSHJ P,NEXCOD ;NEXT CODE JRST MODMOR ;LOOK FOR MORE SAVCEN: MOVE X1,CECOD SUB X1,FLCOD ;NEW CENTRY EXCH X1,(P) ;SAVE IT JRST (X1) OLDCEN: PUSHJ P,HALJRS ;JRST TO OLD CENTRY MOVE X1,CENTRY ADD X1,FLCOD EXCH X1,B PUSHJ P,FIXADR ;SET ADDRESS MOVE B,X1 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,FLCOD MOVE X1,JFCLAD ;JUMP TO MODIFIERS PUSHJ P,FIXADR ;SET ADDRESS SKIPGE X1,JAROUN ;LAST JUMP AROUND JRST NXSM3 ;NONE THERE MOVE B,CECOD ;NEXT STMNT PUSHJ P,FIXADR ;FOR JUMP AROUND NXSM3: TLNE C,F.TERM ;SEEN TERMINATOR YET JRST NXSM2 ; PUSHJ P,QSELS ;ELSE THERE JRST ERTERM MOVEM T,MULLIN JRST NXSM1 ; NXSM4: SKIPE MULLIN ;IGNORE IF MULTI JRST NXSM2 ; MOVE X1,CECOD ;CALCULATE OFFSET OF LAST SUB X1,FLCOD ;WORD OF CODE GENERATED MOVE X2,FLLAD ;MUST STORE IN LADROL ADDI X2,(L) ; HRLM X1,(X2) ; NXSM2: SETZM MULLIN ;END, UNSET MULTI-LINE MOVEI D,"\" ;WAS IT CAIE D,(C) ;BACKSLASH ? JRST NXSM1 ;NO, REALLY NEXT LINE MOVEM T,MULLIN ;YES, SET MULTI-LINE PUSHJ P,NXCH ;GET NEXT CHAR NXSM1: SKIPE AFLAG ;SHOULD WE CLEAR VRFBOT BECAUSE OF V. A. JRST NXSM1A ;YES, DO IT SKIPE VRFSET JRST NXTST1 NXSM1A: MOVE D,[SETZM VRFBOT] PUSHJ P,BUILDI ;ENTER HERE FROM ERROR ROUTINE NXTST1: SKIPE MULLIN ;FINISHED LINE ? JRST EACHLN ;NO SKIPLE X1,THENAD ;STILL UNDER THEN ? PUSHJ P,LNKTHN ;LINK ALL THENAD'S SKIPLE X1,ELSEAD ;ANY ELSE ADDRESSES PUSHJ P,LNKTHN ;LINK THE ELSES NXTST2: AOBJN L,EACHLN NOEND: MOVEI T,NOEND1 ;IF NONE, DIDNT SEE END JRST ERRMSG NOEND1: ASCIZ / ? No END instruction/ LNKTHN: SKIPN RUNFLA ;STILL PRODUCING CODE? POPJ P, ;NO, JUST RETURN MOVE B,CECOD ;FILL IN WITH NEXT STATEMENT ADDRESS LNKTH1: ADD X1,FLCOD ;MAKE X1 AND ADDRESS TO FLCOD HRRZ X2,(X1) ;PICK UP LINK HRRM B,(X1) ;FIX JRST TO NEXT STATEMENT JUMPE X2,CPOPJ ;ANOTHER LINK? MOVE X1,X2 ;YES, SET X1 JRST LNKTH1 ;AND FIX ADDRESS ;END OF COMPILE/EXECUTE PHASE SUBTTL PROGRAM "LOADER" ;HERE AFTER END STATEMENT LINKAG: SETZM VIRWRD ;EXECUTE SEGMENTS NEEDS VIRWRD, MAKE SETZM VIRSIZ ; ;SURE IT IS ZERO SKIPE RUNDDT## JRST LDDTNH SKIPN SAVRUN ;MAKING SAV CODE ? JRST LKS1 ;NO, BACK TO MAINSTREAM HRLZ L,FLLIN ;SET UP L HRR L,CELIN ;TO SWEEP MOVS N,L ;LINE ROLL SUB L,N SKIPGE DATAFF ;DATA SEEN ? HLLZM L,DATAFF ;NOW WILL BE FIRST IN LINROL ADDI L,-1 LKS2: PUSHJ P,NXLINE ;SET UP LINE PUSHJ P,QSA ;WAS IT DATA ASCIZ /DATA/ PUSHJ P,[MOVE B,FLLIN ;NO ADDI B,(L) ;GET ITS # MOVEI R,LINROL ;SET UP FOR LINROL MOVSI D,1 ;REDUCE COUNT SKIPGE DATAFF ;IF ANY ADDM D,DATAFF ;OF DATA LINES PUSHJ P,ERACOM ;AND ZAP IT POPJ P,] ADDI L,-1 ;BACK TO PREVIOUS LINE JUMPLE L,LKS2 MOVE L,FLCOD ;GET CURRENT CODE FLOOR, SAVE MOVEM L,OLDCOD ;FLAG TO PRESS THIS IS SAVE PUSHJ P,PRESS SKIPA R,[Z LINROL] ;SLIDE THE ROLLS LKS1: 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. SKIPN SAVRUN ;MAKING SAV FILE ? JRST LKS3 ;NO MOVE L,FLCOD ;YES, NEW CODE FLOOR MOVE X1,L SUB X1,OLDCOD ;CODE OFFSET LKS4: CAMN L,CECOD ;FINISHED ? JRST LKS3 ;YES HLRZ X2,(L) ;NO, GET INSTRUCTION CAIN X2,(HALT) ;HALT ? TLZA X1,(4,) ;YES (FROM FOR) - TO JRST CAIN X2,(SOJG LP,) ;ALL LOOP ? ADDM X1,(L) ;YES FIX UP TLO X1,(4,) AOJA L,LKS4 ;AND LOOK FOR MORE 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 ;IS IT VIRTUAL JRST LK2B ;YES, IGNORE 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,LKLAB3 ;IMPLICIT 2-DIM ARRAY? HRRI X2,^D11 MOVEI X1,^D121 LKLAB3: 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 ;THIS UNDOCUMENTED CODE IS JRST LK2C ;DEC EDIT # 166 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 VARIABLE 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 [MOVEI T,PANIC1 JRST ERRMSG] LK37: ADD E,CETMP ;CALCULATE TOP OF ARRAY SPACE. MOVEM E,SVRTOP ;SAVE IT. MOVEM E,VARFRE ;THIS IS ALSO FIRST FREE WORD. SKIPN SAVRUN ;MAKING SAV CODE ? JRST LK4 ;NO HRLM E,.JBSA ;SAVE F.F. IN .JBSA HRRM E,.JBFF ;AND .JBFF 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 LDB C,[POINT 7,A,13] JUMPE C,LNK0B1 PUSHJ P,OUCH LNK0B1: TLNN A,4 ;INTEGER? JRST LNK0B2 ;NO MOVEI C,"%" ;YES, OUTPUT PUSHJ P,OUCH ;A % JRST LNK0B3 ;AND CONTINUE LNK0B2: TLNN A,10 ;STRING? JRST LNK0B3 ;NO MOVEI C,"$" ;YES, OUTPUT PUSHJ P,OUCH ;A $ LNK0B3: SKIPE CHAFL2 PUSHJ P,ERRMS3 PUSHJ P,INLMES ASCIZ / / AOJA T,LINK0A LINK0C: MOVE B,FLFOR ;UNSAT FORS? LNK0C1: CAML B,CEFOR JRST LINK0D PUSHJ P,INLMES ASCIZ /? FOR without NEXT/ MOVE L,(B) ;GET POINTER TO LINE NUMBER SKIPN SAVRUN ;MAKING SAVE FILE ? JRST LNK0C2 ;NO PUSHJ P,INLMES ;YES, NO LINE NUMBER ASCIZ / / JRST LNK0C3 LNK0C2: PUSHJ P,FAIL2 LNK0C3: ADDI B,5 ;MORE UNSAT FORS? JRST LNK0C1 LINK0D: SKIPG DATAFF ;WAS DATA OMITTED? JRST LINK0E ;NO PUSHJ P,INLMES ASCIZ / ? No DATA/ SKIPE CHAFL2 PUSHJ P,ERRMS3 LINK0G: 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 [MOVEI T,ILLIN JRST ERRMSG] SUB B,FLOOR(R) MOVEM B,RUNLIN ADD B,FLREF ;IS NOT WITHIN A MULTI-LINE DEF. SKIPN (B) JRST LINK0F MOVEI T,ILLIN 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 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 PUSHJ P,LINKU1 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 PUSHJ P,LINKU1 LINK6: MOVE T,FLGSB ;LINK GOSUB REFS MOVE T1,CEGSB PUSHJ P,LINKU1 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,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 PUSHJ P,BLTZER SKIPN SAVRUN ;MAKING SAV CODE ? JRST LEXECT ;NO, JUST EXECUTE MOVEI X1,START ;YES,GET START ADDRESS HRRM X1,.JBSA ;AND SET IT UP HLRZ X1,.JBSA ;FIRST FREE LOC TRO X1,1777 ;ADJUST TO K BOUND CAMN X1,.JBREL ;SIZE RIGHT ? JRST LSAVE ;YES, GO SAVE CORE X1, ;NO, CONTRACT HALT ;IMPOSSIBLE ERROR JRST LSAVE ;GO SAVE ;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 LINKU1: MOVE A,T ;ORIGIN STARTS AT FLOOR MOVEI B,1 ;ONE WORD PER ENTRY IN ROLE 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 SLIDRL: MOVE X2,CEIL(R) HRRZ X1,CEIL-1(R) ;SLIDE ROLL DOWN NEXT TO LOWER ROLL ADD X2,X1 HRL X1,FLOOR(R) ;SET UP BLT TO MOVE ROLL SUB X2,FLOOR(R) HRRZM X1,FLOOR(R) ;SET NEW ROLL FLOOR BLT X1,(X2) MOVEM X2,CEIL(R) POPJ P, ;ROUTINE TO MAKE A ROLL OF ZEROS =IN LNTH TO LINROL. ZERROL: MOVE R,F MOVE E,CELIN ;COMPUTE LENGTH OF ROLL SUB E,FLLIN JUMPE E,NOEND ;NOTHING TO DO MOVN L,E ;SAVE FOR LINE CNTR. MOVSI L,(L) PUSHJ P,BUMPRL ;ADD TO (EMPTY) ROLL MOVE T,FLOOR+(F) ;CLEAR IT TO 0S SETZM (T) HRL T,T ADDI T,1 MOVE T1,CEIL+(F) CAILE T1,(T) ;SUPPRESS BLT IF ONLY 1 LINE BLT T,-1(T1) POPJ P, BLTZER: HRL X1,X1 ;ZERO OUT CORE SETZM (X1) AOJ X1, BLT X1,-1(X2) POPJ P, SUBTTL STATEMENT GENERATORS ;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 ;CHECK CORE REQUIREMENTS 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,[HRLZI N,5] PUSHJ P,BUILDI MOVE D,[AOS N] 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 SKIPE SAVRUN ;MAKING SAV CODE ? FAIL PUSHJ P,NXCH PUSHJ P,FORMLN ;YES. PUSHJ P,CHKINT ;WE WANT AN INTEGER 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,"%"] PUSHJ P,NXCH 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 VECTOR? MOVSI D,(VECFIN) ;NO, SET FOR INTEGER 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 CAIA JRST ILFORM 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 ;REAL VECTOR? MOVSI D,(VECPIN) ;NO, SET FOR INTEGER 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 ;NOW CHANGE ACTBL TO FILD PUSHJ P,BUILDI ;AND PRODUCE [SETZM FILD-1(LP)] TLNN C,F.COMA ;MORE ? JRST NXTSTA ;NO PUSHJ P,GETCNA ;GET EM JRST XCLOS0 ;DATA STATEMENT ;::= DATA [,...] ;NOTE: A DATA STRING ::= " " ; OR ::= ;NO CODE IS GENERATED FOR A DATA STATEMENT ;RATHER, THE DATA STATEMENT IN THE SOURCE ;TEXT ARE REREAD AT RUN TIME. XDATA: ASCIZ /A/ SKIPL DATAFF ;ALREADY SEEN DATA? MOVEM L,DATAFF ;NO. REMEMBER WHERE FIRST ONE IS SETZM INPFLA PUSHJ P,DATCHK ;CHECK FOR LEGAL DATA FAIL SKIPE MULLIN ;WITHIN MULTI-LINE ? FAIL JRST NXTSTA ;DEF STATEMENT ; ::= DEF FN() = ;GENERATED CODE IS: ; JRST ;JUMP AROUND DEF ; XWD 0,0 ;CONTROL WORD ; MOVEM N,(B) ;SAVE ARGUMENT IN TEMPORARY ; ... ; (EVALUATE EXPRESSION) ; JRST RETURN ;GO TO RETURN SUBROUTINE ;: ... ;INLINE CODING CONTINUES... ;SEE GOSUB STATEMENT FOR USE OF CONTROL WORD. ;DURING EXPRESSION EVALUATION, LOCATION ;FUNARG CONTAINS ASCII REPRESENTATION OF ARGUMENT NAME. ;ROUTINES CALLED BY FORMLN CHECK FOR USE OF ARGUMENT AND RETURN POINTER ;TO FIRST WORD ON TEMPORARY ROLL. ;PRIOR TO GEN OF FIRST EXPRESSION EVALUATION, THE "REAL" TEMPORARY ;ROLL IS SAVED ON "STMROL" AND AN EMPTY "TEMROL" IS CREATED. ;AFTERWARDS, THE NEW "TEMROL" ENTRIES ARE ADDED TO THE PERMANENT ;TEMPORARY ROLL "PTMROL" AND "TEMROL" IS RESTORED. ;THUS EACH DEFINED FUNCTION HAS ITS OWN SET OF TEMPORARIES ;AND CANNOT CONFLICT WITH TEMPORARIES USED BY THE EXPRESSION ;BEING EVALUATED AT THE POINT OF THE CALL. ;NOTE. SPECIAL CASE: CHECK FOR FUNCTION DEF AS LAST LINE OF PROGRAM ;SUPPRESSES GEN OF "JRST" INSTR. COMPILATION WILL FAIL ;("NO END STATEMENT"); HOWEVER THE WORD AFTER LADROL WOULD BE ;CLOBBERED IF "JRST" WERE GENNED. XDEF: ASCIZ /FN/ ;HANDLE THE FN PART AUTOMATICALLY SKIPE FUNAME ;ARE WE IN MIDST OF MULTI-LINE DEF? FAIL MOVEI D,1 MOVEM D,VRFSET MOVSI D,(JFCL) ;MAKE SURE NOT FIRST WRD OF CODE MOVE X1,CECOD CAMG X1,FLCOD PUSHJ P,BUILDI TLNN C,F.LETT ;MAKE SURE LETTER FOLLOWS. JRST ERLETT PUSHJ P,SCNLT1 ;SCAN FCN NAME. PUSHJ P,DIGIT ;CHECK FOR A DIGIT HRLZI F,-1 ;MARK NUMERIC FOR NOW PUSHJ P,DOLLAR ;CHECK FOR $ TLZA F,-2 ;MARK STRING, NO % POSSIBLE PUSHJ P,PERCNT ;CHECK FOR A PERCENT PUSH P,A ;SAVE FCN NAME WITH COUNT OF ZERO ARGUMENTS MOVEM A,FUNAME ; FN'NAME IN BODY OF FUNCTION MOVE X1,TYPE ;SAVE THE TYPE OF MOVEM X1,FTYPE ;THE FUNCTION IN FTYPE ;ADD FUNCTION NAME TO FCNROL XDEF1: MOVEI R,FCNROL ;LOOK FOR FCN NAME IN FCNROL PUSHJ P,SEARCH JRST XDLAB1 SETZM FUNAME FAIL XDLAB1: MOVEI E,1 ;ADD TO FCNROL PUSHJ P,OPENUP ADD A,CECOD ;CONSTRUCT PNTR TO CONTROL WORD SUB A,FLCOD ;STORE IN FCNROL ENTRY. ADDI A,1 MOVEM A,(B) MOVE B,L ;GET JRST DESTINATION AOBJP B,XDLAB2 PUSHJ P,HALJRS XDLAB2: MOVEM B,FUNSTA CLEAR D, ;BUILD ZERO CONTROL WORD PUSHJ P,BUILDI PUSH P,D ;AND ARGUMENT TYPE MASK MOVEI D,1 ;SET UP FOR ARG BITS. ;SCAN FOR ARGUMENT NAME. XDEF2: CAIE C,"(" ;ANY ARGUMENTS? JRST XDEF4 ;NO XDEF2A: PUSHJ P,NXCHK ;SKIP "(" PUSHJ P,SCNLT1 ;ASSEMBLE ARGUMENT NAME PUSHJ P,DIGIT ;SEE IF DIGIT FOLLOWS PUSHJ P,DOLLAR ;CHECK FOR STRING JRST XDEF5A ; PUSHJ P,PERCNT ;CHECK FOR INTEGER TLNN A,4 ;IS IT? JRST XDEF5 ;NO, MARK AS REAL IORM D,(P) ;MARK ONE BIT JRST XDEF5A ;GO TO MARK NEXT XDEF5: IORM D,(P) ;MARK AS REAL LSH D,2 ;SET FOR NEXT ARG JRST XDEF5B ; XDEF5A: LSH D,1 ;SKIP A BIT IORM D,(P) ;MARK FOR STRING LSH D,1 ;SET FOR NEXT ARG XDEF5B: SKIPN D ;ANY BITS LEFT ? FAIL MOVEI R,ARGROL ;NOW ADD THIS NAME TO THE ARGUMENT LIST MOVE B,FLARG ;NOW CHECK ARGROL, FOR TWO IDENTICAL ARGS XDEF2C: CAML B,CEARG JRST XDEF2D CAME A,(B) AOJA B,XDEF2C SETZM FUNAME JRST GRONK XDEF2D: MOVEI E,1 ;ADD NEW ARG TO ROLL PUSHJ P,OPENUP MOVEM A,(B) AOS -1(P) ;COUNT THE ARGUMENT TLNE C,F.COMA ;ANY MORE ARGS? JRST XDEF2A ;YES XDEF3: TLNN C,F.RPRN ;FOLLOWING PARENTHESIS? JRST [SETZM FUNAME JRST ERRPRN] ;NO. PUSHJ P,NXCHK ;YES. SKIP IT. XDEF4: PUSHJ P,ARGCHK ;CHECK FOR RIGHT NUMBER OF ARGUMENTS ;GEN CODE TO EVALUATE EXPRESSION. MOVE X1,FLTMP ;SAVE TEMP ROLL AS STMROL MOVEM X1,FLSTM MOVEM X1,CETMP ;AND EMPTY TMPROL MOVE X1,TMPLOW ;SAVE TEMP POINTER MOVEM X1,FUNLOW SETOM TMPLOW SETOM TMPPNT TLNN C,F.EQAL ;MULTI LINE FN? JRST XDEFM ;YES PUSHJ P,NXCHK ;NO. SKIP EQUAL SIGN SETZM FUNAME ;SIGNAL THAT THIS IS NOT A MULTI-LINE FN PUSHJ P,FORMLU ;GEN THE EXPRESSION PUSH P,B ;SAVE B PUSHJ P,CMIXER ; POP P,B ;RESTORE B PUSHJ P,EIRGNP ;GET IT IN REG ;NOW BUILD AN INSTRUCTION THAT WILL TELL RETURN HOW MANY ARGS TO POP ;OFF THE PUSH LIST POP P,B ;DITCH ARGUMENT TYPE MASK POP P,B ;ARGCHK PUT THE ADDRESS OF A CONSTANT IN HERE XDEFE: MOVSI D,(MOVE T,) PUSHJ P,BUILDA MOVE X2,CETMP ;RESTORE TMPROL, SAVE TEMPORARIES FOR FCN MOVE X1,CESTM MOVEM X2,CEPTM MOVEM X2,FLTMP MOVEM X1,CETMP MOVEM X1,FLSTM HRRE X1,FUNLOW ;RESTORE TMPLOW MOVEM X1,TMPLOW HRRZ X1,FUNSTA ;-1(X1) IS LOC OF JRST AROUND FUNCTION ADD X1,FLCOD HRRZ X2,CECOD ;JRST TO THE NEXT INST TO BE CODED ADDI X2,1 HRRM X2,(X1) MOVE D,[JRST FRETRN] JRST XRET1 ;USE RETURN CODE TO BUILD INST XDEFM: SKIPE MULLIN ;MULTI STATEMENT ? FAIL POP P,X1 ;DITCH ARGUMENT TYPE MASK POP P,X1 ;MULTI-LINE DEF. SAVE THE ARGCOUNT PARAMETER FOR FNEND HRLM X1,FUNSTA MOVE X1,CEFOR ;SAVE NUMBER OF ACTIVE FORS SUB X1,FLFOR ;FOR A CHECK OF FORS HALF IN DEF HRLM X1,FUNLOW TLNE C,F.CR JRST NXTSTA MOVE D,[JSP A,LINADR] PUSHJ P,BUILDI MOVE D,SORCLN PUSHJ P,BUILDI JRST NXTSTA ;DIM STATEMENT ; ::= DIM [$]([,])[,[$]([,])...] ;FOR EACH ARRAY, HAVE ONE-WORD ENTRY IN VARROL ;WHICH POINTS TO THREE-WORD ENTRY IN ARAROL ;WHOSE FORMAT IS: ; () ; (+1)+1 ;THE THIRD WORD IS .LT. 0 IF THE MATRIX IS SET EQUAL TO ITS OWN TRN, ;GT.0 IF THIS IS THE FAKE MATRIX USED FOR TMP STORAGE DURING MATA= ;TRN(A), OTHERWISE IT IS 0. ;DURING COMPILATION, IS CHAIN OF REFERENCES. ;DURING EXECUTION, IS ADDRS OF FIRST WORD. XDIM: PUSHJ P,QSA ASCIZ /ENSION/ JFCL PUSH P,AFLAG ;SAVE A FLAG CLEARM VIRDIM ;ASSUME NOT VIRTUAL ARRAY CAME C,[XWD F.STR,"#"] ;IS IT VIRTUAL ARRAY JRST XDIMA ;NO, CARRY ON PUSHJ P,NXCH ;EAT THE # MOVEI N,1 ;INITIALIZE STARTING WORD MOVEM N,VIRSIZ ;TO ONE MOVEM N,VIRWRD ;SET CURRENT WORD TO ONE CLEARM VIRBLK ;CURRENT BLOCK IS ZERO CLEARM IFFLAG ;CLEAR TYPE FLAG PUSHJ P,GETNUM ;GET THE CHANNEL CAIA ;ERROR CAILE N,^D9 ;MUST BE LESS THAN 10 XDLAB3: FAIL JUMPE N,XDLAB3 ;CAN'T BE ZERO EITHER MOVEM N,VIRDIM ;SAVE CHANNEL TLNN C,F.COMA ;NEED A COMMA NOW JRST ERCOMA ;AND WE DIDN'T GET IT PUSHJ P,NXCHK ;GET FIRST CHARACTER OF VARIABLE XDIMA: SETZI F, ;ALLOW STRING VECTORS. PUSHJ P,ARRAY ;REGISTER ARRAY NAME CAIE A,5 ;STRING VECTOR? ELSE.. JUMPN A,GRONK ;NON-0 RESULT FLAG-SYNTAX ERROR. CAIE C,"(" ;CHECK OPENING PAREN JRST ERLPRN ADD B,FLOOR(F) ;COMPUTE LOC OF ROLL ENTRY SKIPLE X1,1(B) ;DIMENSION FLAG SHOULD BE 0 OR -1 OR -2. FAIL MOVEM X1,TEMLOC PUSHJ P,NXCHK ;SKIP PARENTHESIS PUSHJ P,GETNU ;FIRST DIMENSION JRST GRONK ;NOT A NUMBER JUMPN N,XDLAB4 SETZM TEMLOC XDLAB4: TLNE N,-1 ;WITHIN RANGE FAIL HRRZ D,N ;SAVE FIRST DIM AOBJN D,XDLAB5 ;D::= XWD ,1 XDLAB5: MOVSM D,1(B) ;STORE IN ARAROL (IN CASE 1 DIM) MOVEI N,1 ;IN CASE ONE DIMENSION TLNN C,F.COMA ;TWO DIMS? JRST XDIM1 ;NO PUSHJ P,NXCHK ;YES. SKIP COMMA. PUSHJ P,GETNU ;GET SECOND DIM JRST GRONK ;NOT A NUMBER JUMPN N,XDLAB6 SETZM TEMLOC XDLAB6: TLNE N,-1 FAIL ADDI N,1 HRL D,N ;NOW D HAS XWD , MOVSM D,1(B) ;STORE IN ROLL SWAPPED MOVNI X1,2 CAMN X1,TEMLOC FAIL XDIM1: TLNN C,F.RPRN ;RIGHT PAREN? JRST ERRPRN ;NO, GIVE ERROR PUSHJ P,NXCH ;GET NEXT CHARACTER IMULI N,(D) ;CALCULATE SIZE OF THE ARRAY SKIPN VIRDIM ;VIRTUAL ARRAY? JRST XDIM8 ;NO, JUST STORE SIZE PUSH P,T ;SAVE T SUB B,FLOOR(F) ;MAKE B AN OFFSET TO ARRAY ROLLS PUSH P,B ;AND SAVE IT MOVEI A,0 ;NEED TWO ZERO LOCATIONS MOVEI R,VIRROL ;IN THE VIRTUAL ARRAY ROLL PUSHJ P,RPUSH ;GET FIRST LOCATION PUSHJ P,RPUSH ;GET SECOND LOCATION SOJ B, ;POINT TO FIRST LOCATION JUMPGE F,XDIM4 ;STRING VIRTUAL ARRAY? SKIPLE IFFLAG ;NUMERIC FOLLOWING NUMERIC? JRST XDIM3 ;NO, MUST HAVE FOLLOWED A STRING ; ; NUMERIC ARRAY FOLLOWING NUMERIC ARRAY ; SKIPN X1,VIRBLK ;FIRST BLOCK OF FILE JRST XDIM2 ;YES, JUST USE VIRWRD IMULI X1,^D128 ;128 WRODS PER BLOCK SUBI X1,2 ;EXCEPT FOR FIRST BLOCK XDIM2: ADD X1,VIRWRD ;PLUS PARITALLY FILLED BLOCK XDIM2A: MOVEM X1,(B) ;STORE RANDOM RECORD NUMBER FOR PETE IDIVI N,^D128 ;NUMBER OF BLOCKS NEEDED FOR THIS ARRAY ADD T,VIRWRD ;ADD PARTIAL BLOCK SKIPN VIRBLK ;FIRST BLOCK? ADDI T,2 ;REMEMBER THE TWO WORDS IDIVI T,^D128 ;TWO PARTIALS EQUAL ONE BLOCK ADDM T,VIRBLK ;COULD BE SKIPN VIRBLK SUBI T1,2 MOVEM T1,VIRWRD ;SAVE PARTIAL WORD BLOCK POINTER ADDM N,VIRBLK ;ADD IN BLOCKS NEEDED JRST XDIM7 ;FIX UP CHANNEL NUMBER ; ; NUMERIC FOLLOWING A STRING ARRAY ; XDIM3: MOVE X1,VIRBLK ;CURRENT BLOCK NUMBER IMULI X1,^D128 ;NUMBER OF WORDS USED SOJ X1, ;LESS TWO IN FIRST BLOCK MOVEI X2,1 ;START NEW BLOCK MOVEM X2,VIRWRD ;STARTS AT FIRST WORD AOS VIRBLK ;STEP TO NEXT BLOCK JRST XDIM2A ;FIX UP FOR NEXT ARRAY ; ; HERE FOR STRING ARRAY ; XDIM4: MOVEM N,VIRSIZ ;SAVE SIZE OF ARRAY MOVEI N,^D16 ;DEFAULT SIZE FOR STRING IS 16 TLNN C,F.EQAL ;SIZE GIVEN? JRST XDIM4B ;NO, USE DEFALUT PUSHJ P,NXCH ;EAT THE EQUALS PUSHJ P,GETNU ;GET THE SIZE FAIL MOVEM T,-1(P) ;RESET T CAIG N,^D128 ;WITHIN LIMITS SOJGE N,XDLAB7 ;NOT ZERO FAIL XDLAB7: JFFO N,XDLAB8 ; MOVEI T,^D35 ; XDLAB8: MOVNS T ;NEGATE T MOVSI N,400000 ;SETUP FOR SHIFT LSH N,1(T) ;SHIFT ONE FOR CORRECT POWER XDIM4B: HRLM N,1(B) ;PUT STRING SIZE IN VIRROL SKIPLE IFFLAG ;FOLLOWING A NUMERIC? JRST XDIM6 ;NO, SEE IF WE CAN FIT IN A RECORD SKIPN VIRBLK ;STILL IN FIRST BLOCK AOS VIRBLK ;YES, MAKE IT ONE XDIM5: AOS X1,VIRBLK ;START NEW BLOCK MOVEI X2,1 ;AND FIRST WORD MOVEM X2,VIRWRD ;OF NEW BLOCK HRLM X2,(B) ;SAVE BYTE COUNT HRRM X1,(B) ;AND BLOCK COUNT IN VIRROL IMUL N,VIRSIZ ;NUMBER OF BYTES NEEDED XDIM5A: IDIVI N,^D512 ;NUMBER OF BLOCKS NEEDED AOJ T, ;POINT TO NEXT RECORD MOVEM T,VIRWRD ;SAVE PARTIAL WORD FILL ADDM N,VIRBLK ;UPDATE BLOCK COUNT JRST XDIM7 ;SETUP CHANNEL XDIM6: MOVEI X1,^D513 ;BLOCK SIZE + 1 SUB X1,VIRWRD ;NUMBER OF WROD LEFT IDIV X1,N ;CAN REOCRDS FIT IN JUMPN X2,XDIM5 ;NOT EVENLY, START A NEW BLOCK MOVE T,VIRBLK ;CURRENT BLOCK HRL T,VIRWRD ;GET BYTE COUNT MOVEM T,(B) ;SAVE IN VIRROL IMUL N,VIRSIZ ;CHARACTER SIZE SUBI N,^D513 ;PLUS FULL BLOCK + 1 ADD N,VIRWRD ;LESS SPACE ALREADY USED AOS VIRBLK ;POINT TO NEXT BLOCK JRST XDIM5A ;CARRY ON XDIM7: MOVE X1,VIRDIM ;GET CHANNEL NUMBER HRRM X1,1(B) ;STORE IN VIRROL MOVEM F,IFFLAG ;SAVE TYPE FOR THIS ARRAY SUB B,FLVIR ;MAKE B AN OFFSET TRO B,400000 ;FLAG IT AS VIRTUAL ARRAY POP P,X1 ;GET BACK ARRAY ROLL OFFSET ADD X1,FLOOR(F) ;MAKE IT ABSOLUTE HRLM B,(X1) ;STORE IN ARRAY ROLL POP P,T ;RESTORE T JRST XDIMFN ;FINISH THE DIMENSIONS XDIM8: CAILE N,377777 ;CHECK MAXIMUM DIMENSION SIZE FAIL HRLM N,0(B) ;STORE IN ROLL XDIMFN: TLNN C,F.COMA JRST XDMFN1 ;NO, DONE WITH THIS STATEMENT. PUSHJ P,NXCHK ;SKIP THE COMMA. JRST XDIMA ;KEEP SCANNING. XDMFN1: POP P,AFLAG ;RESTORE A FLAG JRST NXTSTA ;NEXT STATEMENT ; ELSE STATEMENT XELS: MOVEM T,MULLIN ;SAVE POINTER PUSHJ P,QSA ;CHECK FOR FULL ELSE ASCIZ /E/ JRST ILLINS ;ILLEGAL INSTRUCTION SOSGE THNCNT ;IS ELSE LEGAL? FAIL SKIPE ELSFLG ;SINGLE WORD THEN JRST XELS0 ;YES, SKIP THEN FIX MOVE X1,THENAD ;PICK UP THEN LINKAGE MOVE B,CECOD ;ADDRESS FOR ELSE CLAUSE AOJ B, ; SKIPN RUNFLA ;STILL RUNNING? JRST XELS0 ;NO, CONTINUE ADD X1,FLCOD ;POINT TO CODROL HRRZ X2,(X1) ;PICK UP NEW LINK MOVEM X2,THENAD ;SAVE IT HRRM B,(X1) ;SET THEN ADDRESS XELS0: TLNE C,F.DIG ;LINE NUMBER? JRST ELSGO ;SPECIAL TREATMENT SKIPE ELSFLG ;SINGLE WORD THEN? JRST XELS1 ;YES, NO JRST NEXT STATEMENT ADDRESS PUSHJ P,HALJRS ;JRST TO NEXT STATEMENT PUSHJ P,FIXELS ;FIX LINK FOR ELSEAD'S XELS1: CLEARM ELSFLG ;NO MORE SINGLE WORD THENS TLNE C,F.TERM ;TERMINATOR ? FAIL JRST NXSM1 ;NEXT STATEMENT ELSGO: MOVSI D,(CAIA) ;SKIP FROM THEN SKIPN ELSFLG ;UNLESS SINGLE WORD PUSHJ P,BUILDI ; PUSHJ P,XGOFR ;HANDLE THE LINE NUMBER SETZM ELSFLG ;UNSET SINGLE WORD THEN TLNN C,F.CR ;CARRIAGE RETURN CAMN C,[XWD F.APOS,"'"] ; JRST NXSM2 ;YES, DONE WITH STATEMENT PUSHJ P,QSELS ;ELSE NEXT JRST ERTERM ;NO, THEN SHOULD BE TERMINATOR JRST NXTSTA ;NEXT STATEMENT FIXTHN: SKIPN RUNFLA ;STILL RUNNING? POPJ P, ;NO, RETURN SKIPN X1,THENAD ;FIRST IN LINK? JRST FIXTH1 ;NO, JUST SAVE THENAD ADD B,FLCOD ;POINT TO CODROL HRRM X1,(B) ;NO, MAKE LINK SUB B,FLCOD ;BACK TO OFFSET FIXTH1: MOVEM B,THENAD ;SAVE POINTER POPJ P, ;RETURN FIXELS: SKIPN RUNFLA ;STILL RUNNING? POPJ P, ;NO, JUST RETURN SKIPN X1,ELSEAD ;FIRST IN LINK? JRST FIXEL1 ;NO, JUST SAVE ELSEAD ADD B,FLCOD ; HRRM X1,(B) ;NO, MAKE LINK SUB B,FLCOD ; FIXEL1: MOVEM B,ELSEAD ;SAVE POINTER POPJ P, ;RETURN ;END STATEMENT ; ::= END XEND: MOVE X1,FLLIN ;CHECK THAT IT IS LAST STA ADDI X1,1(L) CAMN X1,CELIN TLNN C,F.CR FAIL SKIPN FUNAME JRST XEND1 PUSHJ P,INLMES ASCIZ / ? No FNEND for DEF FN/ MOVEI T,FUNAME SETZ D, PUSHJ P,PRINT SKIPE CHAFL2 ;CHAINING? JRST ERRMS2 ;YES. PUSHJ P,INLMES ASCIZ/ / JRST LUXIT XEND1: SKIPE THNELS ;UNDER THEN OR ELSE ? FAIL MOVE D,[JRST EUXIT] ;COMPILE TERMINAL EXIT PUSHJ P,BUILDI JRST LINKAG ;GO FINISH UP AND EXECUTE ;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 OR FLOAT IT JRST XFOR4+1 ; XFOR2: HLRZ X1,B ;CASE OF A POSITIVE ANDI X1,ROLMSK ;CONSTANT, FORCE THE CAIN X1,CADROL ;UPPERBOUND TO BE 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 JRST XFOR6 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+1 ;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,CECOD ;NEXT LOC SUB X1,FLCOD 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 FIXADR: SKIPN RUNFLA ;GOING TO RUN POPJ P, ;NO, JUST RETURN ADD X1,FLCOD ;FIX CODROL ADDRESS HRRM B,(X1) ;FIX JRST ADDRESS POPJ P, ;RETURN HALJRS: SKIPE SAVRUN ;MAKING SAV CODE ? SKIPA D,[HALT] ;HALT MARKS FOR RELOCATION MOVSI D,(JRST) ;ELSE JRST PUSHJ P,BUILDI POPJ P, ;FNEND STATEMENT ; ::= FNEND XFNEND: ASCIZ /ND/ SKIPN A,FUNAME ;MUST FOLLOW A MULTI-LINE FN DEF FAIL SKIPE THNELS ;CANT BE CONDITIONAL FAIL SETZM FUNAME ;SIGNAL END OF FN TLO A,2 ;ASSEMBLE THE SCALAR NAME OF THE RESULT HRLI F,-1 ;MARK NUMERIC FOR NOW TLNE A,10 ;WAS IT STRING ? TLZA F,-2 ;YES PUSHJ P,[AOS (P) ;NO, REGISTER SCALAR JRST SCAREG] PUSHJ P,STRREG ;REGISTER STRING PUSHJ P,EIRGNP ;GET THE RESULT IN REG HLRZ B,FUNSTA ;RECOVER THE ADDRESS OF THE ARGUMENT COUNT HRLI B,CADROL HLRZ X1,FUNLOW ;THIS IS # OF WDS IN FORROL AT START OF DEF ADD X1,FLFOR CAME X1,CEFOR ;ARE ALL NEXTS INSIDE OF DEF COMPLETE? FAIL TLNE C,F.TERM ;E.O.L. ? CAMN C,[XWD F.APOS,"\"] ;AND NOT MULTI FAIL JRST XDEFE ;FINISH UP END OF FN ;GOSUB STATEMENT XLATE XGOSUB: ASCIZ /UB/ SETZM ONGFLG ;NOT ON ---- GOSUB XGOSU: SKIPE FUNAME FAIL XGOS: PUSHJ P,GETNUM ;READ STATEMENT NUMBER FAIL HRLZ A,N MOVEI R,LINROL ;LOOK UP LINE NO PUSHJ P,SEARCH FAIL ,1 SUB B,FLLIN ;SUCCESS. SAVE REL LOC IN LINROL HRLZ A,B MOVEI R,GSBROL PUSHJ P,SEARCH CAIA JRST XGOS1 MOVEI E,1 PUSHJ P,OPENUP MOVEM A,(B) XGOS1: SUB B,FLGSB HRLI B,GSBROL MOVSI D,(GOSUB) PUSHJ P,BUILDA SKIPE ONGFLG TLNN C,F.COMA ;MORE ARGS FOR ON ---- GOSUB ? JRST NXTSTA PUSHJ P,NXCHK JRST XGOS ;GOTO STATEMENT XGOTO: ASCIZ /O/ 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 MOVE X1,FLREF ADD X1,B MOVE X1,(X1) CAME X1,FUNAME ;BOTH MUST BE ZERO OR SAME FUNCTION. FAIL ,1 MOVE D,CECOD CAME D,FLCOD JRST XGO1 PUSH P,B ;SPECIAL FIX FOR LOADER, MOVSI D,(JFCL) ;IN CASE GO IS FIRST INSTRUCTION. PUSHJ P,BUILDI POP P,B XGO1: HRLI B,LADROL MOVSI D,(JRST) PUSHJ P,BUILDA ;BUILD INSTR 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 CONDITIONAL TLNN C,F.DIG ;NEXT CHAR A DIGIT ? JRST IFCGO ;NO PUSHJ P,XGOFR ;USE GOTO CODE TO GEN JRST INSTR SETOM ELSFLG ;MARK SINGLE WORD THEN TLNN C,F.CR ;END OF LINE CAMN C,[XWD F.APOS,"'"] ; JRST NXSM1 ;YES PUSHJ P,QSELS ;CHECK FOR ELSE JRST ERTERM MOVEM T,MULLIN ;SAVE POINTER JRST NXSM1 ;NEXT STATEMENT IFCGO: PUSHJ P,REVSEN ;REVERSE LOGIC PUSHJ P,HALJRS ;JRST/HALT AROUND THEN CODE PUSHJ P,FIXTHN ;FIX THENAD LINKAGE JRST NXSM1 IFCCOD: PUSHJ P,FORMLB ; MOVE X2,CECOD ;LAST CODE GENERATED HLRZ X1,-1(X2) ;CHECK FOR POSSIBLE OPTIMIZATION CAIE X1,(SETO) ;WAS TDZA AND SETO GENERATED? JRST IFCOD1 ;NO, THEN MUST TEST TRUTH VALUE MOVE B,X2 ;NEW ADDRESS SUBI B,2 ;YES, REMOVE THE TWO INSTRUCTIONS MOVEM B,CECOD ;BY SETTING NEW CEIL SOJ B, ;LAST CODE GENERATED ADDRESS SUB B,FLCOD ;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: SKIPN RUNFLA ;STILL GOING TO RUN? POPJ P, ;NO, JUST RETURN ADD B,FLCOD ;ADDRESS OF LAST RELATION MOVE D,(B) ;CAM??/SKIP? INSTRUCTION TLC D,4000 ;REVERSE SENSE MOVEM D,(B) ;PUT BACK SUB B,FLCOD ;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: CLEARM INPPRI ;SET FLAG NOT TTY INPUT 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, DON'T CHECK FOR OUTPUT STRING SETOM INPPRI ;FLAG, STRING CAN BE OUTPUT TLNN C,F.QUOT ;IS THERE A STRING TO OUTPUT 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, TLNE F,-2 ;WAS IT 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, CARRAY ON PUSH P,D ;SAVE D PUSH P,B ;SAVE B MOVE D,[SETOM INLNFG] ;FLAG INPUT LINE PUSHJ P,BUILDI ;GEN IT POP P,B ;RESTORE B POP P,D ;RESTORE D TLNN C,F.TERM ;ONLY ON STRING PER INPUT LINE FAIL 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 ; ; HERE TO HANDLE STRING CONSTANT ON INPUT ; 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 FIX 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 ;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 ;CHANGE MARGAL TO 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 ;GET CHANNEL AND CHECK DELIMITER XMAR5: PUSHJ P,FORMLN PUSHJ P,EIRGEN PUSHJ P,CHKINT ;MUST BE INTEGER MOVE D,[PUSHJ P,PAGE] SKIPN TABLE HRRI D,MARGN ;CHANGE PAGE TO MARGN PUSHJ P,BUILDI PUSHJ P,CHKDEL ;CHECK FOR DELIMITER JRST XMAR1 ;FOUND ONE 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,FLCOD ;ADDRESS OF STRING UUO HLLZ D,0(B) ;GET THE UUO PUSHJ P,CHKFMT ;CHECK FORMAT CHARACTER XMAT2B: TLNN D,140 JRST GRONK ;FAIL IF ILLEGAL HLLM D,0(B) ;RETURN STRING UUO TLNE C,F.TERM ;IS FORMAT CHAR FOLLOWED BY END OF STA? JRST NXTSTA ;YES. JRST XMAT2A ;PROCESS NEXT ARRAY NAME 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 ARRAY 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 VCTOR: PUSHJ P,ARRAY ;REGISTER ARRAY OR VECTOR CAIE A,5 ;STRING ? JUMPN A,CPOPJ ;NO, ARRAY ? MOVE X2,1(X1) ;YES JUMPG X2,CPOPJ MOVNI X2,2 MOVEM X2,1(X1) POPJ P, ;RETURN ; ::= MAT =()* 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 MOVEM X1,FTYPE ;SAVE THE TYPE 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 CAME X1,FTYPE JRST MTYERR 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 ; ::= 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 ; TLO D,400 ; PUSH P,D HRLI F,777777 PUSHJ P,ARRAY JUMPN A,GRONK PUSHJ P,MATCHK ;CHECK THAT ITS NOT VIRTUAL MOVE X1,TYPE CAME X1,FTYPE JRST MTYERR 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 MOVEM X1,FTYPE ; 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 TLO D,400 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 CAME X1,FTYPE 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 MOVE D,[MOVEI N,1] PUSHJ P,BUILDI ;BUILD INST TO GET SCAL FACTOR POP P,B ;GET SOURCE MAT BACK PUSH P,[MATSCA] JRST XMAT9B 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 ;CHECK IF UNDER THEN-ELSE FAIL XNEX0: TLNN C,F.TERM ;NEXT WITHOUT ARGUMENT? JRST XNEX3 ;YES, FOR-NEXT LOOP MOVE X1,CEFOR ;CHECK UNSAT WHILE/UNTIL CAMG X1,FLFOR ;ANYTHING ON FOR ROLL FAIL SETO X2, ;MAKE SURE THIS IS A UNTIL/WHILE CAME X2,-3(X1) ;INDUCTION VARIABLE -1 CAMN X2,-2(X1) ;INCREMENT -1 CAIA ;YES, ALL IS SWELL FAIL PUSHJ P,POPFOR ;GET TEMPORARY PROTECTION MOVEM B,TMPLOW ;SHOULD NOT HAVE BEEN CHANGED MOVEM B,TMPPNT ; PUSHJ P,POPFOR ;REMOVE -1 FOR INCREMENT PUSHJ P,POPFOR ;REMOVE -1 FOR INDUCTION PUSHJ P,POPFOR ;GET JRST ADDRESSES PUSH P,[Z NXTSTA] ;SET UP THE RETURN JRST XNEX5 ;LET FOR-NEXT CODE HANDLE 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 ISN'T WHILE/UNTIL 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 ; MOVSI D,(ADD) ; PUSHJ P,BUILDA PUSHJ P,POPFOR ;GET JRST POINTER XNEX5: SKIPN RUNFLA ;STILL MAKING CODE ? JRST XNEX2 ;NO, DO NOT FOOL WITH ADDRESSES MOVE A,FLCOD ;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,FLCOD ;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, ; ; 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 NOPAGE 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,FLCOD ;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 ;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,QSA ASCIZ /ERRORGOTO/ JRST XON5 SKIPE FUNAME ;WITHIN FN DEF ? FAIL TLNN C,F.TERM ;ANY ARGUMENT? JRST XON3 ;YES, TEST IT OUT XON4: SKIPE NOTLIN ;MAKING SAVFILNL ? FAIL MOVE D,[CLEARM ERRGO] PUSHJ P,BUILDI MOVE D,[SKIPE ERR] PUSHJ P,BUILDI MOVE D,[JRST ERRCNT] PUSHJ P,BUILDI JRST NXTSTA XON3: PUSHJ P,GETNUM FAIL JUMPE N,XON4 PUSHJ P,XGOGT MOVSI D,(MOVEI N) ADD B,FLCOD HLLM D,(B) MOVE D,[MOVEM N,ERRGO] PUSHJ P,BUILDI JRST NXTSTA XON5: PUSHJ P,FORMLN ;EVALUATE INDEX PUSHJ P,EIRGNP ;GET IN REG PUSHJ P,CHKINT ;MUST HAVE INTEGER MOVE D,[JSP A,XCTON] PUSHJ P,BUILDI ;BUILD THE RUNTIME CALL SETZI D, ;BUILD ADDRESS OF NEXT STATEMENT MOVE B,L AOBJP B,XOLAB1 ;DONT BUILD IF LAST STATEMENT HRLI B,LADROL PUSHJ P,BUILDA XOLAB1: TLNE C,F.COMA ;SKIP OPTIONAL COMMA. PUSHJ P,NXCH PUSHJ P,QSA ASCIZ /GOSUB/ JRST XONA SETOM ONGFLG JRST XGOSU 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 NXTSTA ;NO PUSHJ P,NXCHK ;YES. SKIP COMMA JRST XON1 ;PROCESS NEXT LINE NUMBER ;FILE AND FILES STATEMENTS. ; ;FILES STATEMENTS SET UP INFORMATION FOR THE LOADER, AS FOLLOWS: ;THE ACTBL ENTRY IS +1 FOR SEQ. ACCESS FILES, -1 FOR R.A. FILES. ;THE STRLEN ENTRY CONTAINS THE RECORD LENGTH FOR STRING R.A. ;FILES (OR 0 IF THE STRING R.A. FILE DID NOT SPECIFY A ;RECORD LENGTH) AND 400000,,0 FOR NUMERIC R.A. FILES. THE ;BLOCK ENTRY CONTAINS THE SOURCE STATEMENT LINE NUMBER IN CASE THE ;LOADER NEEDS IT FOR AN ERROR MESSAGE. XFILE: ASCIZ /E/ PUSHJ P,QSA ASCIZ /S/ ;FILE OR FILES? JRST FILEE ;FILE. XFIL1: MOVEI B,";" ;FILES. CAIE B,(C) TLNE C,F.COMA JRST XFIL10 PUSHJ P,FILNMO ;GET FILENAME. JUMP SAVE1 AOS A,FILCNT CAILE A,9 FAIL MOVEI D,9 MOVE X1,FILDIR XFIL2: MOVE X2,FILDIR+1 XFIL3: CAMN X1,FILD-1(D) ;SEARCH FOR DUPLICATE FILE SPECS. CAME X2,EXTD-1(D) JRST XFIL4 MOVE X2,FILDIR+3 ;NAME.EXT MATCHES, TRY PPN CAMN X2,FPPN-1(D) JRST XFIL5 ;ALL MATCH, ERROR SOJG D,XFIL2 ;TRY MORE SKIPA X2,FILDIR+1 XFIL4: SOJG D,XFIL3 JRST XFIL35 XFIL5: PUSHJ P,INLMES ASCIZ / ? File / PUSHJ P,PRNNAM PUSHJ P,INLMES ASCIZ / on more than one channel/ PUSH P,C PUSHJ P,FAIL2 POP P,C XFIL35: MOVEM X1,FILD-1(A) MOVEM X2,EXTD-1(A) MOVE X2,FILDIR+3 ; Delete [4] MOVEM X2,FPPN(A) MOVEM X2,FPPN-1(A) ;[4] SAVE NAME, EXT AND PPN. MOVE X2,L ;SAVE SOURCE LINE ADD X2,FLLIN ;NUMBER IN CASE THE HLRZ X2,(X2) ;LOADER NEEDS IT. MOVEM X2,BLOCK-1(A) MOVEI B,"%" ;TYPE OF FILE-- CAIE B,(C) JRST XFIL36 HRLZI B,400000 ;R.A. NUMERIC. MOVEM B,STRLEN-1(A) PUSHJ P,NXCH JRST XFIL39 XFIL36: TLNN C,F.DOLL JRST XFIL37 PUSHJ P,NXCH ;R.A. STRING. SETZ B, TLNN C,F.DIG ;GET THE RECORD LENGTH. JRST XFIL32 PUSHJ P,XFIL30 SKIPLE B CAILE B,^D132 JRST XFILER JRST XFIL32 XFIL30: ADDI B,-60(C) PUSHJ P,NXCH TLNN C,F.DIG POPJ P, IMULI B,^D10 JRST XFIL30 XFIL32: MOVEM B,STRLEN-1(A) JUMPE B,XFIL39 MOVEI X1,4(B) IDIVI X1,5 ADDI X1,1 HRLM X1,STRLEN-1(A) XFIL39: SETOM ACTBL-1(A) ;MAKE ACTBL ENTRY = -1 FOR R.A. JRST XFIL7 XFIL37: AOS ACTBL-1(A) ;MAKE ACTBL ENTRY = +1 FOR SEQ. ACCESS. XFIL7: TLNE C,F.TERM JRST NXTSTA MOVEI B,";" CAIE B,(C) TLNE C,F.COMA JRST XFIL8 JRST ERSCCM XFIL10: AOS B,FILCNT CAILE B,9 FAIL XFIL8: PUSHJ P,NXCH TLNN C,F.TERM JRST XFIL1 XFIL9: AOS B,FILCNT CAILE B,9 FAIL JRST NXTSTA XOPEN: ASCIZ /N/ SETOM OPNFLG JRST FILEE8 ;SKIP LINE NO OUTPUT FILEE: SETZM OPNFLG SKIPN NOTLIN ;LINE NOS SUPPRESSED ? SKIPE MULLIN ;OR WITHIN MULTI JRST FILEE8 ;IN EITHER CASE, DONT SAVE LINE # MOVE D,[JSP A,LINADR] PUSHJ P,BUILDI ; MOVE D,SORCLN ; PUSHJ P,BUILDI ; MOVSI D,(JFCL) ;SET UP JFCL PUSHJ P,BUILDI MOVEM B,JFCLAD ;RECORD FILEE8: PUSHJ P,CHKCR1 ;CHECK CORE REQUIREMENTS FILEE0: SETOM FILTYP ;FILE TYPE UNKNOWN SKIPE OPNFLG ;OPEN OR FILE ? JRST FILOP0 ;OPEN FILOP2: MOVEI B,-1 ;ASSUME R. A. CAIN C,":" ;IS IT? JRST FILEE2 ;YES, CARRY ON SETZ B, ;HOW ABOUT SEQ. ACC. CAMN C,[XWD F.STR,"#"] ;IF # IT IS JRST FILEE2 ;GOT IT SKIPE OPNFLG ;OPEN? CAME C,[XWD F.STR,"@"] ;AND IS IT VIRTUAL JRST ERCHAN ;NEITHER OF THE ABOVE, ERROR SETZM FILTYP AOSA FILTYP ;SET FILTYP TO 1 FILEE2: PUSHJ P,FILSET PUSHJ P,GETCNA SKIPE OPNFLG ;NO DELIMITER IN OPEN JRST FILOP9 CAIE C,":" ;SKIP DELIMITER. TLNE C,F.COMA CAIA JRST ERCLCM PUSHJ P,NXCH FILOP9: MOVSI D,(HRREI N,) ;SETUP FOR FILTYP SETTING HRR D,FILTYP ;GET TYPE CODE PUSHJ P,BUILDI ;BUILDI IMMEDIATE MOVE D,[MOVEM N,FILTYP] ;FETCH TYPE STORE INSTRUCTION PUSHJ P,BUILDI MOVE D,[SKIPE ACTBL-1(LP)] PUSHJ P,BUILDI MOVE D,[PUSHJ P,CLSFIL] PUSHJ P,BUILDI SKIPE OPNFLG ;OPEN ? JRST FILOP5 ;YES, FINISHED 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 ;HANDLE STRING ARGUMENT SKIPE OPNFLG ;OPEN ? JRST FILOP1 ;YES, GO DO FOR INPUT/OUTPUT MOVE D,[PUSHJ P,OPNFIL] PUSHJ P,BUILDI PUSHJ P,CHKDEL ;CHECK FOR SEPARATOR JRST FILEE0 ;FOUND ONE 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 PUSHJ P,XFIL30 ;GET RECORD SIZE 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 ;MARK 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 THE 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 ? FILERR: FAIL SOS INPOUT FILOP3: PUSHJ P,QSA ASCIZ /ASFILE/ FAIL JRST FILOP2 ;GET CHANNEL FILOP5: MOVE D,[PUSHJ P,OPNFIL] PUSHJ P,BUILDI ;OPEN FILE SKIPG FILTYP ;VIRTUAL ARRAY SPEC SKIPN X1,INPOUT ;MODE SPECIFIED ? JRST NXTSTA ;NO JUMPG X1,FILOP6 ;YES, WHICH HRRI D,SCATH SKIPE FILTYP ;OUTPUT, SCRATCH, RANDOM ? HRRI D,RANSCR ;CHANGE SCATH TO RANSCR PUSHJ P,BUILDI FILPLT: TLNN C,F.TERM ;END OF STATEMENT SKIPN OPNFLG ;OR FILE(S) STATEMENT JRST NXTSTA ;NEXT STATEMENT PUSHJ P,QSA ;CHECK FOR "TO PLOT" ASCIZ /TOPLOT/ JRST NXTSTA SKIPE FILTYP ;SEQ.? JRST FILERR ;NO, ERROR MOVE D,[MOVEM LP,PLTIN] ;ASSUME INPUT PLOTTING SKIPG INPOUT ;OUTPUT PLOTTING? HRRI D,PLTOUT ;YES PUSHJ P,BUILDI ;GENERATE JRST NXTSTA ;NEXT STATEMENT FILOP6: SKIPE FILTYP ;INPUT, RESTORE, RANDOM ? JRST FILOP7 ;YES HRRI D,XRES PUSHJ P,BUILDI JRST FILPLT ;CHECK FOR PLOTTING FILOP7: MOVNI A,5 ;RANDOM FILOP8: MOVE D,RESCOD+5(A) PUSHJ P,BUILDI AOJL A,FILOP8 JRST NXTSTA XREM: SETZM MULLIN ;COMMENT ENDS LINE JRST NXTST1 ;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 ;CHECK FOR SEPARATOR JRST SRAER5 ;FOUND ONE 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 ;GET CHANNEL AND CHECK DELIMETER 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 ;CHECK FOR SEPARATOR JRST XSET ;FOUND ONE SETCOD: JUMPLE N,SETERR ;SOME OF THE CODE GENERATED. CAIGE N,1 JRST SETERR MOVEM N,POINT-1(LP) ; ;PAUSE STATEMENT ; XPAUSE: ASCIZ /SE/ MOVE D,[INCHRW N] ;INPUT CHARACTER , WAIT PUSHJ P,BUILDI ;GENERATE IT TLNN C,F.TERM ;TERMINATOR? FAIL JRST NXTSTA ;YES, DO NEXT XLIST IFN BASTEK,< LIST ; ;PLOT FUNCTION GENERATOR ; XPLO: ASCIZ /T/ XPLOA: PUSHJ P,QSA ;CHECK FOR FUNCTION ASCIZ /LINE(/ ;LINE? JRST XPLOT1 ;NO, TRY DIFFERENT ONE SETOM NOORG ;FLAG FOR LINE (NOT ORIGIN) XPLOTA: CLEARM PSHPNT ;NO ARGUMENTS YET XPLAB1: PUSHJ P,DO1ARG ;DO AN ARGUMENT TLNE C,F.COMA ;ANOTHER ARGUMENT? JRST XPLAB1 ;YES, DO IT MOVEI X1,2 ;ASSUME ORIGIN (TWO ARGUMENTS) SUB X1,PSHPNT ;LESS NUMBER WE COLLECTED CAME X1,NOORG ;0 - ORIGIN ,-1 LINE JRST ARGCH0 ;ARGUMENTS DON'T MATCH MOVE D,[PUSHJ P,ORGPLT] ;ORIGIN? SKIPE NOORG ;ORIGIN? HRRI D,LINPLT PUSHJ P,BUILDI ;BUILD PUSHJ CALL JRST XPLFN1 ;GO SEE IF ANOTHER PLOT FUNCTION DO1ARG: TLNE C,F.COMA ;IS IT A COMMA? PUSHJ P,NXCHK ;SWALLOW CHARACTER IN C SETZM PFLAG ;CLEAR % SEEN FLAG PUSHJ P,FORMLN ;GENERATE NUMERIC ARGUMENT IN REG JUMPGE B,XPLAB2 ;POSITIVE ARG PUSHJ P,EIRGP1 ;NO, MAKE NEGATVIE XPLAB2: PUSHJ P,CHKINT MOVSI D,(PUSH Q,) ;BUILD ARGUMENT PUSH PUSHJ P,BUILDA ; AOS PSHPNT POPJ P, XPLOT1: PUSHJ P,QSA ;TRY ANOTHER FUNCTION ASCIZ /STRING(/ ;STRING? JRST XPLOT2 ;NO, TRY AGAIN CLEARM PSHPNT ;NO ARGUMENTS YET PUSHJ P,DO1ARG ;DO FIRST ARGUMENT TLNN C,F.COMA ;ANOTHER ONE? JRST ARGCH0 ;SHOULD HAVE BEEN PUSHJ P,DO1ARG ;DO SECOND ARGUMENT TLNN C,F.COMA ;ANOTHER ONE? JRST ARGCH0 ;SHOULD HAVE BEEN MOVE D,[PUSHJ P,STRPLT] ;PUSHJ TO STRPLT PUSHJ P,BUILDI ;GENERATE IT MOVSI D,(CLEAR LP,) ;TTY OUTPUT PUSHJ P,BUILDI ;GENERATE IT MOVE D,[PUSHJ P,OUTSET] ;SETUP FOR OUTPUT TO TTY PUSHJ P,BUILDI ;GENERATE IT PUSHJ P,NXCHK ;SWALLOW THE COMMA PUSHJ P,FORMLS ;GENERATE STRING ARGUMENT MOVSI D,(PRSTR 2,) ;STRING OUTPUT W/ NO CARRIAGE MOVEMENT PUSHJ P,BUILDA ;GENERATE WITH ADDRESS IN B MOVE D,[PUSHJ P,MOVPLT] ;MOVE THE ALPHA CURSOR PUSHJ P,BUILDI ;GENERATE IT JRST XPLFN1 ;SEE IF ANOTHER FUNCTION XPLOT2: PUSHJ P,QSA ;CHECK ANOTHER FUNCTION ASCIZ /ORIGIN(/ ;ORIGIN? JRST XPLOT3 ;NO, TRY, TRY AGAIN CLEARM NOORG ;FLAG FOR ORIGIN JRST XPLOTA ;TREAT LIKE LINE XPLOT3: PUSHJ P,QSA ;CHECK ANOTHER FUNCTION ASCIZ /PAGE/ ;PAGE? JRST XPLOT4 ;NO, TRY, TRY, TRY AGAIN MOVE D,[PUSHJ P,PAGPLT] ;PUSHJ TO PAGPLT JRST XPLT4A ;GO TO GENERATE XPLOT4: PUSHJ P,QSA ;ANOTHER TIME ASCIZ /INIT/ ;INIT? JRST XPLOT5 ;TRY, TRY, TRY, TRY AGAIN MOVE D,[PUSHJ P,INIPLT] ;PUSHJ TO INIPLT XPLT4A: PUSHJ P,BUILDI ;GENERATE CODE IN D JRST XPLFIN ;CHECK FOR ANOTHER FUNCTION XPLOT5: PUSHJ P,QSA ;CHECK FOR FUNCTION ASCIZ /WHERE(/ ;WHERE? JRST XPLOT6 ;TRY LAST ONE MOVE D,[JSP A,WHRPLT] ;FOR WHERE PUSHJ P,BUILDI ;GENERATE IT XPLT5A: PUSHJ P,DOSARG ;DO SCALAR ARGUMENT TLNN C,F.COMA ;ONE MORE ARGUMENT? JRST ERCOMA ;NOPE PUSHJ P,DOSARG ;DO ANOTHER SCALAR ARGUMENT JRST XPLFN1 ;GO FOR NEXT XPLOT6: PUSHJ P,QSA ;IS IS CURSOR ASCIZ /CURSOR(/ ; JRST XPLOT7 ;TRY SAVE MOVE D,[JSP A,CURPLT] ; PUSHJ P,BUILDI ; PUSHJ P,DOSARG ; TLNN C,F.COMA ; JRST ERCOMA ; JRST XPLT5A ;LET WHERE CODE HANDLE LAST TWO ARGS. XPLOT7: PUSHJ P,QSA ;TRY SAVE ASCIZ /SAVE(/ FAIL PUSHJ P,GETCN2 ;GET CHANNEL MOVE D,[PUSHJ P,SAVPLT] ;DO SSAVE PLOT PUSHJ P,BUILDI ;GENERATE IT XPLFN1: TLNN C,F.RPRN ;ENDED WITH ')' JRST ERRPRN ;NO, GIVE ERROR PUSHJ P,NXCHK ;SWALLOW THE ')' XPLFIN: PUSHJ P,CHKDEL ;CHECK FOR SEPARATOR JRST XPLOA ;FOUND ONE DOSARG: TDZ F,F ; TLNE C,F.COMA ;HAVE A COMMA PUSHJ P,NXCHK ;EAT THE ',' SETZM PFLAG ;CLEAR % SEEN FLAG PUSHJ P,REGLTR ;SINGLE ARGUMENT CAIE A,1 ;SCALAR? JRST ILVAR ;CAN ONLY BE MOVSI D,(JUMP 2,) ;USE A JUMP SKIPGE TYPE ;WANTS RESULTS IN FLOTING? TLZ D,100 ;NO, MARK FOR INTEGER PJRST BUILDA ; XLIST > LIST ; ; UNTIL AND WHILE - NEXT LOOP STATEMENT ; XUNTIL: ASCIZ /IL/ ;REST OF UNTIL SETOM LOGNEG ;REVERSE SENSE OF WHILE JRST XWHILE+2 ;AND GO XWHILE: ASCIZ /LE/ ;REST OF WHILE SETZM LOGNEG ;NO REVERSING NEEDED MOVE X1,CECOD ;WHERE SHOULD NEXT RETURN TO SUB X1,FLCOD ;TO FIRST STATEMENT OF UNTIL/WHILE SOJ X1, ; HRLM X1,FORPNT ;SAVE IT PUSHJ P,IFCCOD ;GO HANDLE THE CONDITIONAL PUSHJ P,REVSEN ;YES, REVERSE SENSE PUSHJ P,HALJRS ;JRST TO NEXT+1 HRRM B,FORPNT ;SAVE FOR NEXT CODE MOVE A,L ;SAVE STATEMENT IN CASE OF ERROR MOVEI R,FORROL ;PUSH IT ONTO THE FORROL PUSHJ P,RPUSH ; MOVE A,FORPNT ;PUSH JRST POINTER ONTO FORROL PUSHJ P,RPUSH ; SETO A, ;DUMMY TWO -1'S PUSHJ P,RPUSH ; PUSHJ P,RPUSH ; MOVE A,TMPLOW ;GET TEMP PROTECTION PUSHJ P,RPUSH ;DUMMY SAVE JRST NXTSTA ;ALL DONE ; ;WRITE AND PRINT STATEMENTS ;CAUSES DATA TO BE OUTPUT TO THE DISK OR TTY. XWRIT: ASCIZ /TE/ SETOM WRREFL JRST XWLAB1 XPRINT: ASCIZ /NT/ SETZM WRREFL XWLAB1: 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 ;CHECK FOR SEPARATOR 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,XWRMX1 ;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,XWLAB2 POPJ P, XWLAB2: 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 ;MODIFIER THERE ? CAIA ;NO JRST XWRI7 ;YES, HANDLE AS TERMINATOR SETZM PFLAG ;NEW EXPRESSION, CLEAR % SEEN 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,";" CAIA JRST XWRI7 PUSHJ P,NXCH TLNN C,F.TERM ;HIT A TERMINATOR? JRST XWRI5 XWRI7: MOVE D,[PUSHJ P,ENDIMG] PUSHJ P,BUILDI JRST NXTSTA XPRRAN: PUSHJ P,GENTP1 ;R.A. STATEMENT. PUSHJ P,FORMLB MOVEM F,IFFLAG JRST XPRRN2 PUSHJ P,NXCH 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 ;CHECK FOR SEPARATOR JRST XPRRN1 ;FOUND ONE XPRI1: SKIPE WRREFL JRST GRONK MOVSI D,(SETZ LP,) ;TTY. PUSHJ P,BUILDI MOVE D,[PUSHJ P,OUTSET] PUSHJ P,BUILDI XPRI0: PUSHJ P,KWSAMD ;MODIFIER FOLLOWS ? TLNE C,F.TERM ;NON-USING STATEMENTS FROM HERE ON. JRST XPCRLF CAIA XPRI2: PUSHJ P,KWSAMD ;MODIFIER ? CAIA ;NO JRST NXTSTA ;YES, GO HANDLE PUSHJ P,QSA ASCIZ /TAB/ ;TAB FIELD? CAIA ;NO, ASSUME EXPRESSION OR DELIMITER. JRST XPRTAB ;YES, DO THE TAB TLNN C,F.COMA CAIN C,";" JRST PRNDEL CAIE C,74 ;LEFT ANGLE BRACKET JRST PRNEXP ;PRINT DELIMITER. PRNDEL: MOVSI D,(PRDL) PUSHJ P,CHKFMT PUSHJ P,BUILDI JRST XPRFIN ;PRINT EXPRESSION PRNEXP: SETZM PFLAG ;NEW EXPRESSION, CLEAR % SEEN PUSHJ P,FORMLB ;GEN THE EXPRESSION MOVSI D,(PRSTR) ;STR. JUMPGE F,PRNEX1 ;OR WAS IT NO. ? PUSHJ P,GPOSNX ;MOVE TO REG IF UNCOMPLEMENTED OR INDEXED. MOVSI D,(PRNM) ;SET UP OP CODE PRNEX1: PUSHJ P,CHKFMT ;SET FORMAT CODE SKIPGE TYPE ;IS IT REAL? TLO D,400 ;NO, MARK BIT AS INTEGER PUSHJ P,BUILDA ;GEN PRINT UUO JRST XPRFIN ;GO FOR MORE ;PRINT TAB XPRTAB: PUSHJ P,FORMLN ;EVALUATE TAB SUBEXPRESSION PUSHJ P,EIRGNP ;MOVE IT INTO REG PUSHJ P,CHKINT ;MUST HAVE INTEGER MOVSI D,(PRNTB) ;CALL THE TAB INTERPRETER XPRTA1: PUSHJ P,CHKFMT PUSHJ P,BUILDI ;YES, BUILD THE INST. XPRFIN: TLNE C,F.TERM ;CR AT END OF LINE? JRST NXTSTA JRST XPRI2 ;NO. GO FOR MORE ;HERE FOR PRINT WITH NO ARGUMENTS. GEN CARRIAGE RETURN. XPCRLF: MOVE D,[SETZM 40] PUSHJ P,BUILDI MOVE D,[PUSHJ P,PRDLER] PUSHJ P,BUILDI MOVE D,[PUSHJ P,CRLF] PUSHJ P,BUILDI JRST NXTSTA ;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, ;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/ ;REMAINDER OF RANDOM STATEMENT PUSHJ P,QSA ;DID USER INCLUDE FULL STATEMENT ASCIZ /IZE/ JFCL ;WHO CARES MOVE D,[PUSHJ P,RANDER] ;FETCH RUNTIME RANDOMIZER CALL PUSHJ P,BUILDI ;BUILD IMMEDIATE JRST NXTSTA ;THAT'S ALL, FOLKS ;RESTORE STATEMENTS. XREST: PUSHJ P,QSA ;CHECK FOR RESUME ASCIZ /UME/ JRST XRESTA XRESM: MOVE D,[SKIPN ERR] PUSHJ P,BUILDI MOVSI D,(JRST) PUSHJ P,BUILDI PUSH P,B MOVE D,[MOVE P,PSAV] ;WANT TO RESTORE P PUSHJ P,BUILDI ;GENERATE INSTRUCTION TO DO SO MOVE D,[SETZM ERR] PUSHJ P,BUILDI TLNN C,F.CR JRST XRESM2 XRESM1: SKIPE NOTLIN ;SAVFILNL? FAIL MOVE D,[SOS X1,ERL] PUSHJ P,BUILDI MOVE D,[SETZM ERL] PUSHJ P,BUILDI MOVE D,[JRST @X1] PUSHJ P,BUILDI XRSM1A: POP P,X1 ADD X1,FLCOD MOVE B,CECOD SKIPE RUNFLA HRRM B,(X1) JRST NXTSTA XRESM2: PUSHJ P,GETNUM FAIL JUMPE N,XRESM1 MOVE D,[SETZM ERL] PUSHJ P,BUILDI PUSHJ P,XGOGT JRST XRSM1A XRESTA: PUSHJ P,QSA ASCIZ /TORE/ JRST ILLINS 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 ;CHECK FOR SEPARATOR JRST XRES3 ;FOUND ONE 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 ;RETURN STATEMENT XLATE XRETRN: ASCIZ /URN/ SKIPE FUNAME FAIL MOVE D,[JRST RETURN] XRET1: PUSHJ P,BUILDI ;XDEF ENTERS HERE TO COMPLETE A FN DEF. JRST NXTSTA ;STOP STATEMENT XSTOP: ASCIZ /P/ MOVE D,[JRST EUXIT] PUSHJ P,BUILDI JRST NXTSTA ;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,REGFRE ;MAKE SURE REGISTER IS FREE PUSHJ P,CFORM0 ;GET OBJECT OF NOT PUSHJ P,SETFNO ;MUST BE NUMERIC 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 CLEARM MIXFLG ;CLEAR MIX FLAG PUSHJ P,CMIXM ;CHECK FOR MIXED MODE SKIPE MIXFLG ;WAS A MIX MADE? JRST CRFM2A ;YES, DON'T SWITCH TLNN B,ROLMSK ;IS RIGHT SIDE ALREADY IN REG JRST CFORM3 ;YES, COMPARE WITH LEFT SIDE PUSHJ P,EXCHG ;GET LEFT SIDE IN REG CRFM2A: 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 SETOM TYPE ;COMPARISION RESULTS IN INTEGER 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 CLEARM MIXFLG ;CLEAR MIX FLAG PUSHJ P,CMIXM ;CHECK FOR MIXED MODE SKIPGE (P) ;IS SECOND FACTOR A DIVISOR? SKIPE MIXFLG ;OR WAS A MIX MADE CAIA ;YES, REG IS OK 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 ;MARK NUMERIC IF LEGAL 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 ;SUBEXPRESSION CANNOT BE L. H. PUSH P,F ;SAVE TYPE FLAG F PUSHJ P,FORMLB ;GEN THE SUBEXPRESSION POP P,X1 ;RETURN TYPE CODE TLNN X1,-1 ;WAS TYPE DECLARED? JRST FSUBX1 ;NO, SO DON'T CHECK XOR X1,F ;CHECK FOR MIXED MODE JUMPL X1,SETFER ;MIXED MODE FSUBX1: 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 ;MARK NUMERIC IF LEGAL 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. JRST FNUM4 FNUM3: MOVEI R,CONROL ;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 ;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 SKIPN FUNAME ;WITHIN FUNCTION? SETOM AFLAG ;NO, MARK A FLAG XARF2: JUMPE B,XARFFN SKIPGE F MOVSI D,(ARFET2) HRRZ X1,(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 SKIPL F ;STRING VECTOR? PUSHJ P,SITGEN ;YES,SAVE ADDRESS POINTER 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 PUSHJ P,NXCHK PUSH P,LETSW MOVMS LETSW PUSHJ P,XFORMB ;GEN THE ARGUMENT IN REG POP P,LETSW 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 ? FAIL PUSH P,D ;SAVE AGAIN SKIPGE B PUSHJ P,EIRGP1 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 ;GET BACK 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) ;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... 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: MOVEI E,1 ;ADD FCN REF TO FADROL PUSHJ P,OPENUP MOVEM N,(B) POPJ P, ;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 TYPE 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. CLEARM TYPE 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 SETOM TYPE XINF01: TLNN C,F.RPRN JRST ERRPRN PUSHJ P,NXCH POP P,D HRRZI D,(D) ADD D,[PUSHJ P,3] 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 NOT INCLUDED PUSHJ P,NXCH ;EAT THE "(" PUSHJ P,XFORMN ;ONLY NUMERIC EXPRESSION ALLOWED PUSHJ P,EIRGEN ;MAKE SURE EXPRESSION IS IN REG. SKIPGE TYPE ;IS THE EXPRESSION INTEGER? JRST CRTBI1 ;YES, JUST SET CRTVAL MOVE D,[PUSHJ P,FIXPNT] ;HAVE TO FIX CRTVAL PUSHJ P,BUILDI ;GENERATE THE FIXPNT INSTRUCTION CRTBI1: MOVE D,[EXCH N,CRTVAL] ;SET CRTVAL, RETURN OLD VALUE SETOM TYPE ;CRT IS INTEGER FUNCTION JRST INLIOU ;CHECK FOR ")", GENERATE INSTUC. IN D ; ; 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,"(" ;NEED AN ARGUMENT JRST ARGCH0 PUSHJ P,NXCH PUSHJ P,GETNUM ;GET LINE NUMBER FAIL MOVE D,N HRLZ A,N ;CHECK IT OUT MOVEI R,LINROL PUSHJ P,SEARCH FAIL ,1 HRLI D,(MOVEI N,) ;OKAY, SET IT UP SETOM TYPE JRST INLIOU 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 0 IS ZERO PUSHJ P,BUILDI ;GENERATE IT SETOM TYPE ;FUNCTION IS INTEGER MOVE D,[PUSHJ P,SGNB##] ;CALL SIGN FUNCTION 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,XFORMB 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,XFORMB 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 TLZ D,100 ;NO, AC IS ZERO 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 ;CHECK THAT LETTER IS NEXT JRST ERLETT ;IT WAS NOT REGLTR: PUSHJ P,SCNLT1 ;LTR TO A, LEFT JUST 7 BIT HRRI F,SCAROL ;ASSUME SCALAR SETZM TYPE ;ASSUME REAL 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 PERCENT PUSHJ P,SETFNO ;MARK NUMERIC IF LEGAL CAIN C,"(" JRST REGARY ;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? JRST REGL2 ;NO HRRZ D,(B) ;YES. GET PNTR TO SCAROL JRST REGL3 REGL2: MOVEI E,1 ;ADD TO SCALAR ROLL OR VSPROL PUSHJ P,OPENUP ADD A,CEIL(F) ;COMPUTE PNTR TO ROLL SUB A,FLOOR(F) HRRZ D,A ;SAVE ROLL POINTER MOVEM A,(B) MOVEI R,(F) ;PUT NULL ENTRY ON ROLL MOVEI A,0 PUSHJ P,RPUSH ; 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 JRST REGA2 ;NOT ALREADY USED HRRZ D,(B) ;GET POINTER TO ARAROL JRST REGA3 ;ALREADY USED REGA2: MOVEI E,1 ;ADD NEW ARRAY NAME TO VARIABLE ROLL PUSHJ P,OPENUP ADD A,CEIL(F) ;COMPUTE ARRAY OR STRING VECTOR ROLL POINTER SUB A,FLOOR(F) ORI A,400000 ;SET ARRAY FLAG MOVEM A,(B) HRRZ D,A ;SAVE ARAROL POINTER MOVEI R,(F) ;THREE ZEROS ON ARAROL (NULL ENTRY) MOVEI A,0 PUSHJ P,RPUSH PUSHJ P,RPUSH PUSHJ P,RPUSH 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 ? JRST ARRAY2 ;YES, HANDLE STRING PUSHJ P,PERCNT ;PERCENT ? ARRAY0: PUSHJ P,SETFNO ;MARK NUMERIC IF LEGAL 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 VARIABLE SPACE ROLL 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 GRONK ;NO RGSLX1: PUSHJ P,NXCHD AOJA A,REGSL1 REGSL2: 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 ;PUSH POINTER ONTO LITERAL ROLL POP P,E IDIVI E,5 JUMPE E,REGSL3 MOVEI R,SLTROL ;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 DPB C,[POINT 7,A,13] ;YES, STORE IT JRST NXCH ;AND SKIP IT DOLLAR: TLNN C,F.DOLL ;IS IT A $ ? AOSA (P) ;NO, SKIP TLOA A,10 ;YES, MARK IT POPJ P, ;RETURN SETZM TYPE JRST NXCHK ;GOBBLE IT PERCNT: SETZM TYPE ;ASSUME REAL CAME C,[XWD F.STR,"%"] ;IS IT A PERCENT? POPJ P, ;RETURN SETOM TYPE ;MARK AS INTEGER TLO A,4 ;YES, MARK IT SETOM PFLAG JRST NXCHK ;NEXT CHARACTER ;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; ARRAY 1; 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: KWADIF: ASCIZ /THEN/ ASCIZ /GOTO/ KWAAMD: ;ALL POSSIBLE MODIFIERS 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 ASCIZ /IFOR/ ;I FOR THERE ? POPJ P, ;NO, ALL'S WELL 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 ;MARK NUMERIC IF LEGAL JRST REGL1 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 ;MARK NUMERIC IF LEGAL 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 ;CHECK CORE REQUIREMENTS POP P,X1 REGF10: MOVEI C,4 ;$ IN SIXBIT. IDPB C,X1 PUSHJ P,NXCH PUSHJ P,SETFST ;MARK STRING IF LEGAL REGF6: CAMN A,[SIXBIT/VAL /] PUSHJ P,CHKCOR ;CHECK CORE REQUIREMENTS REGF0: MOVEI R,IFNFLO REGF7: CAMN A,(R) JRST REGF8 ;FOUND FN. AOJ R,RGLAB1 RGLAB1: 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 ;CHECK CORE REQUIREMENTS 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 PERCENT 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 CAMN A,FUNAME ;IS THIS THE NAME OF THE CURRENT MULTI-LINE FN? JRST REGFNA ;YES. REGISTER IT AS A SCALAR MOVE D,A ;NO, REAL FUNCTION CALL. SAVE NAME FOR ARGCHK MOVMS LETSW MOVEI R,FCLROL ;FUNCTION CALL ROLL PUSHJ P,SEARCH ;USED THIS ONE YET? CAIA JRST REGFC1 ;ALREADY SEEN A REF MOVEI E,1 PUSHJ P,OPENUP MOVEM A,(B) PUSHJ P,REGFC1 ;SET B UP FOR KLUDGE TEST MOVE X1,FLSEX ;FIX UP SAVED FCN REFS REGFC0: CAML X1,CESEX ;KLUDGE!!! JRST REGFC1+1 HLRZ X2,(X1) ;GET THE ROLL NUMBER CAIN X2,FCLROL ;FCLROL? CAMLE B,(X1) ;YES. IS SEXREF NOW WRONG? AOJA X1,REGFC0 ;NO AOS (X1) ;YES. CORRECT IT AOJA X1,REGFC0 REGFC1: SUB B,FLFCL HRLI B,FCLROL 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, REGFNA: TLO A,2 ;CREATE SPECIAL NAME FOR CURRENT FUNC. SKIPGE F ;NUMERIC ? JRST SCAREG ;REGISTER IT AS A SCALAR JRST STRREG ;NO, REGISTER AS STRING 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 ;HARD LUCK, NUMERIC SPECIFIED HRLI F,1 ;SET STRING SETZM TYPE POPJ P, ;PUSHPR - PUSH PARTIAL RESULT ON SEXROL PUSHPR: MOVEI R,SEXROL MOVE A,B ;SAVE POINTER IN A SKIPE 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 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 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 CLEAR B, 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 CLEAR B, 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,PTMROL JRST SITGN1 ;SITGEN - STORE IN TEMP GEN SITGEN: MOVEI R,TMPROL 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,STLAB1 MOVSI D,(MOVNM N,) STLAB1: CAIE R,TMPROL ;STORE ON TMPROL? JRST SITG2 ;NO. USE PTMROL AOS B,TMPPNT ;WHICH TEMP TO USE? MOVE X1,FLTMP ADD X1,B CAML X1,CETMP ;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,FLPTM JRST SITG1 ;FINISH CONSTRUCTING ADRESS POINTER ;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: SKIPN RUNFLA ;ARE WE GOING TO RUN? POPJ P, ;NO, JUST RETURN MOVEI E,1 MOVEI R,CODROL PUSHJ P,BUMPRL MOVEM D,(B) SUB B,FLCOD 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: SKIPN RUNFLA ;ARE WE GOING TO RUN? POPJ P, ;NO. DONT BUILD 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,CECOD ;LOC+1 OF THE INSTR POP P,X2 ;COMPUTE ADDRS LOCATION LDB R,[POINT 17,X2,17] ADD X2,FLOOR(R) MOVE R,(X2) ;GET NEXT ADDRS IN CHAIN HRRM R,-1(X1) ;STORE IT IN THE INSTR SUB X1,FLCOD SUBI X1,1 HRRM X1,(X2) ;STORE CURR ADDRS IN ROLL PNTD TO POPJ P, 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 ;SHOULD BE SOMETHING POPJ P, THGOTS: PUSHJ P,QSA ASCIZ /GOTO/ THGERR: FAIL TLNE C,F.DIG ;DIGIT FOLLOWS ? POPJ P, ; ERDIGQ: PUSHJ P,FALCHR ASCIZ /a digit or "/ ;ERROR RETURNS ILFORM: FAIL ILVAR: FAIL GRONK: FAIL ILLINS: 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 /"/ ERTERM: PUSHJ P,FALCHR ASCIZ /a line terminator or '/ 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 SKIPN RUNFLA JRST FAL1 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 CAIA JRST FALFF 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/ PUSHJ P,FAIL2 JRST NXTST1 ;COMPILATION ERROR MESSAGES FROM FAIL UUOS. FAILER: SKIPN RUNFLA ;IS THIS THE FIRST ERROR IN COMPILATION? JRST FAIL0 ;NO. PUSHJ P,INLMES ;YES. SETUP TO FOLLOW HEADING. ASCIZ / / FAIL0: PUSHJ P,FAIL1 JRST NXTST1 FAIL1: MOVE T,40 FAILR: MOVEI D,0 PUSHJ P,PRINT LDB X1,[POINT 4,40,12] ;IS AC FIELD NONZERO? JUMPE X1,FAIL2 MOVE T,N ;ATTACH NUMBER IN 'N' TO MSG PUSHJ P,PRTNUM FAIL2: PUSHJ P,INLMES ASCIZ / in line / MOVE T,L ADD T,FLLIN HLRZ T,(T) PUSHJ P,PRTNUM SKIPE CHAFL2 ;CHAINING? PUSHJ P,ERRMS3 PUSHJ P,INLMES ASCIZ / / SETZM RUNFLA SETZM MULLIN ;DELETE MULTI-LINE POPJ P, ;GET NEXT CHAR, BUT CHECK FOR ILLEGAL CHARS (CHARS THAT COULD ONLY BE IN A STRING) NXCHK: PUSHJ P,NXCH TLNE C,F.STR FAIL POPJ P, ;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) ;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,XFORMN PUSHJ P,EIRGNP PUSHJ P,CHKINT ;NEED AN INTEGER 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,XFORMS ;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 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 SETOM MIXFLG ;MARK A MIX MADE 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 ;ROUTINE TO START READING NEXT LINE OF PROGRAM NXLINE: MOVE T,FLLIN ADDI T,(L) MOVE T,(T) MOVS D,T ;SAVE LINE START HRLI T,440700 MOVE G,FLREF ;SETUP REFROL REFERENCE. ADDI G,(L) JRST NXCH PRTNUM: IDIVI T,^D10 JUMPE T,PRTN1 PUSH P,T1 PUSHJ P,PRTNUM POP P,T1 PRTN1: MOVEI C,60(T1) AOS NUMCOT JRST OUCH END