;****** UOFP SEGMENTED BASIC ****** SEARCH S IFNDEF NOCODE, ;NOCODE=1 : JUST DEFINE SYMBOLS IFNDEF BASTEK, ;BASTEK=1 : INCLUDE PLOT PACKAGE IFE NOCODE,< TITLE BASCRF CREF PHASE > IFN NOCODE,< UNIVERSAL BSYCRF > ;****** END UOFP SEGMENTED BASIC ****** SUBTTL PARAMETERS AND TABLES ;***COPYRIGHT 1969,1970,1971,1972,1973,1974 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.*** ;VERSION 17E 2-OCT-74/NA ;VERSION 17D 4-MAY-73/KK ;VERSION 17C 2-JAN-73/KK ;VERSION 17B 25-JUL-72/KK ;VERSION 17A 10-FEB-1972/KK ;VERSION 17 15-OCT-1971/KK ;VERSION 16 5-APR-1971/KK ;VERSION 15 17-AUG-1970/KK ;VERSION 14 16-JUL-1970/AL/KK ;VERSION 13 15-SEP-1969 LOC .JBINT TRPLOC LOC .JBVER BYTE (3)VWHO(9)VBASIC(6)VMINOR(18)VEDIT LOC .JB41 JSR UUOH ;****** UOFP SEGMENTED BASIC ****** IFE NOCODE,< RELOC HISEG > IFN NOCODE, ;****** END UOFP SEGMENTED BASIC ****** ;****** INTERNS FOR EDTLIB ****** ;****** END INTERNS FOR EDTLIB ****** EXTERN FLCOD EXTERN ERRB,ERLB EXTERN TYPE,FTYPE,PFLAG,INLNFG EXTERN ACTBL,BATCH,CATFLG,CELIN,CETXT,CHAFL2,CHAFLG,CMDROL EXTERN CATCNT,CATFL1,CATLOK EXTERN COMTIM,COPFLG,CURBAS,CURDEV,CUREXT,CURNAM,DEVBAS EXTERN DEVICE,DRMBUF,DSKSYS,FILD1,FILDIR,FILNM,FLLIN EXTERN FLTXT,FRSTLN,FUNAME,HEDFLG,HPOS,IBF,IFIFG,ININI1 EXTERN LASTLN,LINB0,LINNUM,LINROL,LOWEST,LOWSTA,MARGIN EXTERN MARWAI,MONLVL,MTIME,NEWOL1,NOTLIN,NUMCOT,OBF,ODF EXTERN OLDFLA,ONCESW,OUTERR,PAGLIM,PAKFLA,PAKFLG,PARAM,PLIST EXTERN QLSPEC,QUEUER,QUOTBL,RANCNT,RENFLA,RENSW,RETUR1 EXTERN REVFL,RUNFLA,RUNLIN,RUNUUO,SAVE1,SAVI,SAVRUN EXTERN SEQPNT,SJOBRL,SJOBSA,SORCLN,SPEC,STARFL,SWAPSS,SYNTAX EXTERN TOPSTG,TRPLOC,TXTROL,TYI,TYO,UFD,USGFLG,UUOH,UXFLAG EXTERN .HELPR,.JBAPR,.JBFF,.JBREL,.JBREN,.JBSA ;****** EXTERNALS FROM BASLIB (EDTLIB) ****** EXTERN ALPHSX,ATOMSZ,CLOB,CPOPJ,CPOPJ1,DATTBL,EDTXT1,ERASE EXTERN ERRMSG,FILNAM,FILNM1,FILNMO,GETNUM,INLINE,INLME1 EXTERN INLMES,INLSYS,LINB2,LOCKOF,LOCKON,NOGETD,NXCH EXTERN NXCHD,NXCHD2,NXCHS,OPENUP,OUCH,PANIC,PRESS EXTERN PRINT,PRNNAM,PRNSIX,PRTOCT,QSA,QSAX,QSELS,SCNLT1,SCNLT2 EXTERN SCNLT3,SEARCH,TTYIN,VIRDIM ;****** END EXTERNALS FROM BASLIB (EDTLIB) EXTERN RUNDDT EXTERN LRUNNH,REENTR,LOVRFL,LCHAIN RUNNH=LRUNNH OVFLCM=LOVRFL IFN NOCODE,< IF2,< END> > ;****** END UOFP SEGMENTED BASIC ****** DEFINE FAIL (A,AC)< XLIST XWD 001000+AC'00,[ASCIZ /A/] LIST > ;UUO HANDLER 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 ;ROUTINE TO QUEUE FILES FOR THE LINE PRINTER. INTERN QUEUEN,QUEUEM QUEUEN=SIXBIT/BASIC/ QUEUEM=QUEUEN_-^D18 SUBTTL INITIALISE CREF INTERN BASCRF BASCRF: JRST BEGCRF QUELOP: MOVEI A,40 ;ZERO THE PARAMETER AREA. QULAB1: SETZM PARAM-1(A) SOJG A,QULAB1 MOVSI A,'DSK' MOVEM A,SAVE1 OPEN 1,SAVI JRST [MOVE T,SAVE1 JRST NOGETD] MOVE A,CURNAM ;SET UP FOR THE EXTENDED MOVEM A,QLSPEC+2 ;LOOKUP, AND SOME MOVEM A,PARAM+5 ;LOCATIONS IN THE PARAMETER MOVEM A,PARAM+33 ;AREA AS WELL. MOVSI A,'LST' MOVEM A,QLSPEC+3 MOVEM A,PARAM+34 GETPPN A, MOVEM A,QLSPEC+1 MOVEM A,PARAM+4 MOVEM A,PARAM+25 MOVEI A,16 MOVEM A,QLSPEC MOVEI A,12 QULAB2: SETZM QLSPEC+4(A) SOJGE A,QULAB2 LOOKUP 1,QLSPEC JRST [PUSHJ P,QNTFND JRST ENDCRF] ;FILE NOT FOUND. MOVE A,QLSPEC+16 MOVEM A,PARAM+24 PUSH P,C PUSH P,T HLRZ A,PARAM+21 JUMPN A,QULAB3 MOVEI A,^D200 HRLM A,PARAM+21 QULAB3: HRRZ A,PARAM+37 MOVEI B,1 TRNN A,700 DPB B,[XWD 060300,PARAM+37] ;DEFAULT--PRESERVE TRNN A,77 DPB B,[XWD 000600,PARAM+37] ;DEFAULT--1 COPY. QUECON: LDB B,[XWD 000600,PARAM+37] HRLZI A,010000 HLLM A,PARAM+37 IMUL B,QLSPEC+5 IDIVI B,^D1024 ADDI B,1 HRRM B,PARAM+21 ;BLOCKS*COPIES/8. HRRZI A,111000 ADDM A,PARAM+37 ;SINGLE SPACING, ASCII. HRRZI A,501 MOVEM A,PARAM+1 ;BASIC=5,CREATE. MOVE A,[XWD 023014,1] ;1 FILE IN REQUEST MOVEM A,PARAM+2 MOVSI A,(SIXBIT/LPT/) ;LPT REQUEST. MOVEM A,PARAM+3 MOVE A,[XWD 12,16] GETTAB A, HRLZI A,055000 TLO A,012 HLRZM A,PARAM+7 MOVEI A,1 MOVEM A,PARAM+36 PJOB B, ;JOB NUMBER. HRLI A,(B) HRRI A,33 GETTAB A, SETZ A, MOVEM A,PARAM+15 ;CHARGE NUMBER HRLI A,(B) HRRI A,31 GETTAB A, SETZ A, MOVEM A,PARAM+16 ;FIRST HALF OF USER'S NAME. HRLI A,(B) HRRI A,32 GETTAB A, SETZ A, MOVEM A,PARAM+17 ;SECOND HALF QUECAL: HRRZ A,.JBREL MOVEM A,.JBFF MOVE T,[XWD 40,PARAM] PUSHJ P,QUEUER POP P,T POP P,C JRST ENDCRF QNTFND: PUSHJ P,INLMES ;HERE WHEN FILE NOT FOUND ASCIZ/ ? File / PUSHJ P,PRNNAM PUSHJ P,INLMES ASCIZ / not found/ OUTPUT SETZM HEDFLG POPJ P, OPNERR: SETZM OUCRFF ;MAKE ERROR GO TO TTY PUSHJ P,INLMES ASCIZ /? Can't init disk / OUTPUT JRST ENDCRF NOCREF: SETZM OUCRFF ;MAKE ERROR GO TO TTY PUSHJ P,INLMES ASCIZ /? No room for CREF file / OUTPUT JRST ENDCRF ;ROUTINE TO CHANGE CURRENT NAME 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 SUBTTL SYNTAX CHECKER EXTERN ARAROL,CADROL,CEIL, DATCHK,ELSFLG,ERRMS3,EVANUM EXTERN FILTYP,FLOOR,FORCAR,FORPNT,GETNU,INPOUT,JAROUN EXTERN KWDIND,LETSW,LOCLOF,LOGNEG,MULLIN,NOORG,OPNFLG EXTERN PSHPNT,PSHROL,QSKIP,QST,REGPNT,SCAROL,SCN2 EXTERN SCN3,STAROL,SVRROL,THNCNT,THNELS,TRNFLG,VSPROL,WRREFL EXTERN ASCIIB,ATANB,CHRB,CLOGB,COSB,COTB,DATEB,EXPB,FIXB EXTERN DAYB,ECHOB,SLEEPB EXTERN IFFLAG,INSTRB,INTB,JFCLAD,LEFTB,LENB,LINEB EXTERN LOGB,MIDB,PIB,POSB,RELROL,RIGHTB,RNDB,SINB EXTERN SPACEB,SQRTB,STRB,TANB,TIMEB,VALB 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 Z XPLO+60000(SIXBIT/ PLO/) 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: ;TABLE OF INTRINSIC FUNCTIONS DEFINE ZZZ. (X) < XLIST LIST > IFNFLO: ZZZ. (ABS) ZZZ. (ASC) ZZZ. (ASCII) ZZZ. (ATN) ZZZ. (CHR$) ZZZ. (CLOG) ZZZ. (COS) ZZZ. (COT) ZZZ. (CRT) ZZZ. (DATE$) ZZZ. (DAY$) ZZZ. (DET) ZZZ. (ECHO) ZZZ. (ERL) ZZZ. (ERR) ZZZ. (EXP) ZZZ. (FIX) ZZZ. (FLOAT) ZZZ. (INSTR) ZZZ. (INT) ZZZ. (LEFT$) ZZZ. (LEN) ZZZ. (LINE) ZZZ. (LL) ZZZ. (LN) ZZZ. (LOC) ZZZ. (LOF) ZZZ. (LOG) ZZZ. (LOGE) ZZZ. (LOG10) ZZZ. (MID$) ZZZ. (NUM) ZZZ. (NUM$) ZZZ. (PI) ZZZ. (POS) ZZZ. (RIGHT$) ZZZ. (RND) ZZZ. (SGN) ZZZ. (SIN) ZZZ. (SLEEP) ZZZ. (SPACE$) ZZZ. (SQR) ZZZ. (SQRT) ZZZ. (STR$) ZZZ. (TAN) ZZZ. (TIM) ZZZ. (TIME$) ZZZ. (VAL) IFNCEI: %FN=1 DEFINE ZZZ. (X) < XLIST OPDEF ZZZZ. [%FN] ZZZZ. %FN=%FN+1 LIST > DEFINE ZTYPE (A,B,C),< XLIST BYTE (9)A,B(18)C LIST > IF2FLO: ZZZ. (ABS) ZZZ. (ASC) ZTYPE 4,1,ASCIIB ZTYPE 2,2,ATANB ZTYPE 1,4,CHRB ZTYPE 2,2,CLOGB ZTYPE 2,2,COSB ZTYPE 2,2,COTB ZZZ. (CRT) ZTYPE 1,0,DATEB ZTYPE 1,0,DAYB ZZZ. (DET) ZTYPE 4,4,ECHOB ZTYPE 4,0,ERLB ZTYPE 4,0,ERRB ZTYPE 2,2,EXPB ZTYPE 4,2,FIXB ZZZ. (FLTBI) XWD IF31,INSTRB ZTYPE 4,2,INTB XWD IF32,LEFTB ZTYPE 4,1,LENB ZTYPE 4,0,LINEB ZZZ. (LL) ZTYPE 2,2,LOGB ZZZ. (LOC) ZZZ. (LOF) ZTYPE 2,2,LOGB ZTYPE 2,2,LOGB ZTYPE 2,2,CLOGB XWD IF33,MIDB ZZZ. NUM ZTYPE 1,2,STRB ZZZ. (PI) ZTYPE 1,4,POSB XWD IF32,RIGHTB ZTYPE 2,0,RNDB ZZZ. (SGN) ZTYPE 2,2,SINB ZTYPE 4,4,SLEEPB ZTYPE 1,4,SPACEB ZTYPE 2,2,SQRTB ZTYPE 2,2,SQRTB ZTYPE 1,2,STRB ZTYPE 2,2,TANB ZZZ. (TIM) ZTYPE 1,0,TIMEB ZTYPE 2,1,VALB IF2CEI: IF31: XWD 3 ;ARG BLOCK FOR INSTR XWD -1,-1 XWD 0,+1 XWD 0,+1 IF32: XWD 2 ;ARG BLOCK FOR LEFT$, RIGHT$. XWD 0,+1 XWD 0,-1 IF33: XWD 3 ;ARG BLOCK FOR MID$ XWD 0,+1 XWD 0,-1 XWD -1,-1 ;TABLE OF RELATIONS FOR IFSXLA DEFINE ZZZ. (X,Y)< OPDEF ZZZZ. [X] ZZZZ. (Y)> RELFLO: ZZZ. 3435B11,CAML ZZZ. 3436B11,CAME ZZZ. 74B6,CAMLE ZZZ. 3635B11,CAMG ZZZ. 75B6,CAMN ZZZ. 76B6,CAMGE RELCEI: EXTERN LUXIT ENOCRF: SETZM OUCRFF ;END CREF OUTPUT ENDCRF: SETZM TTYCRF ;CLEAR TTY FLAG IN CASE SET JRST LUXIT ;GO BACK TO EDIT SEGMENT BEGCRF: SETOM OUCRFF ;MAKE ERRORS GO TO CRF FILE MOVEI R,STAROL ;DUMMY UP STAROL MOVEI X1,STAFLO ;WITH BASIC STATEMENTS FROM BASCRF MOVEM X1,FLOOR(R) ;SET FLOOR MOVEI X1,STACEI ;AND CEILING MOVEM X1,CEIL(R) ;ALL DONE MOVEI R,RELROL ;MUST ALSO USE THIS RELATION ROLL MOVEI X1,RELFLO ;NEW FLOOR MOVEM X1,FLOOR(R) ;SET IT MOVEI X1,RELCEI ;NEW CEIL MOVEM X1,CEIL(R) ;SET IT MOVE E,FLCOD MOVEM E,.JBFF MOVEM E,IOJFF ;SAVE FOR LATER MOVSI E,'DSK' ;INIT DSK MOVEM E,SAVE11 ;FOR OPEN MOVEI E,1 MOVEM E,SAVII MOVSI E,CRBUF MOVEM E,SAVE11+1 OPEN 16,SAVII ;OPEN DSK ON CHANNEL 16 JRST OPNERR ;BETTER BE ABLE TO DO THAT MOVE E,[SIXBIT /BASUSR/] ;NAME OF CREF INPUT FILE MOVEM E,INDIR ;FOR ENTER MOVSI E,'CRF' ;EXTENSION MOVEM E,INDIR+1 SETZM INDIR+2 SETZM INDIR+3 ENTER 16,INDIR JRST NOCREF ;NO ROOM ON DSK OUTBUF 16,2 ;1 OUTPUT BUFFER MOVEI E,EOLIN ;SO JRST @SYNTAX WILL GO TO EOLIN MOVEM E,SYNTAX ;AT END OF A STATEMENT. PUSHJ P,INITHD ;INIT HEADER BLOCK AND OUTPUT HEADER SYNCHK: MOVE E,CELIN SUB E,FLLIN ;LIN ROLL FLOOR JUMPE E,ENOCRF ;NOTHING IN TEXT BUFFER MOVN L,E MOVSI L,(L) ;NEG. NUMBER IN LEFT HALF PUSHJ P,BEGLN ;PUT OUT CREF CONTROL CHAR + LINE #. SETZB F,MULLIN ;INITIALIZE MULTI-LINE SWITCH SETZM FUNAME ;AND FN NAME ; ;BEGIN COMPILATION OPERATIONS FOR EACH LINE ; EACHLN: MOVE P,PLIST ;FIX P LIST IN CASE LAST INST FAILED SETZM INLNFG SETZM PFLAG SETZM LETSW EACHL2: SKIPE MULLIN ;SKIP IF NOT MULTI-STATEMENT JRST EACHL0 ;DO MULTI-LINE STUFF SETZM THNELS ;NO CONDITIONAL SEEN YET SETZM THNCNT ;NO THEN SEEN YET PUSHJ P,NXLINE ;SET UP POINTER TO THIS LINE. CAIA ;SKIP MULTI-LINE INSTRUCTION EACHL0: MOVE D,T ;SET UP POINTER TO MULTI-LINE TLNE C,F.TERM ;A DELTION LINE? JRST @SYNTAX ;YES, NOTHING TO CHECK CAIE C,":" ;IMAGE = REM. JRST EACHL4 SKIPE MULLIN ;MULTI-LINE ? FAIL JRST @SYNTAX ;COMMENT, IGNORE EACHL4: CAMN C,[XWD F.APOS,"'"] JRST @SYNTAX ;COMMENT, IGNORE TLNE C,F.TERM ;ANY OTHER TERMINATOR JRST NXSM2 ;IS IGNORED TLNN C,F.LETT ;MUST BEGIN WITH LETTER JRST ILLINS 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.COMA+F.DIG+F.DOLL ;ELIDED LETTER? JRST ELILET ;YES. POSSIBLE ASSUMED "LET" PUSHJ P,SCNLT2 ;SCAN SECOND LETTER. JRST ILLINS ;SECOND CHAR WAS NOT A LETTER. MOVS X1,A CAIE X1,(SIXBIT /IF/) CAIN X1,(SIXBIT /ON/) JRST EACHL1 CAIE X1,(SIXBIT /FN/) ;ELIDED LET FNX= ? JRST EACHL3 ;NO. PUSHJ P,SCNLT3 JRST ILLINS TLNE C,F.DIG ;POSSIBLE DIGIT? PUSHJ P,NXCH ;YES, EAT IT TLNN C,F.EQAL+F.DOLL ;IS FOURTH CHAR AN '=' SIGN? CAMN C,[XWD F.STR,"%"] ;OR A PERCENT JRST ELILET ;YES, ELIDED STATEMENT 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 JRST EACHL1 ELILET: MOVSI A,(SIXBIT /LET/) ;ASSUME A "LET" STATEMENT. SKIPE T,MULLIN ;MULLIN HAS PTR IF MULTI JRST ELILT1 MOVS T,D 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. CLEARM JFCLAD ; TRZE A,20000 ;EXECUTABLE? SETOM JFCLAD 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 EACHLN ;GO HANDLE MODSEK: PUSHJ P,KWSMOD ;NO, LOOK FOR MODIFIERS JRST ERTERM ;NONE, GO BITCH SKIPL JFCLAD ;WAS IT EXECUTABLE ? FAIL MODLOO: MOVE X1,KWDIND ;GET MODIFIER CAIN X1,KWZMOD-1 ;IS IT FOR? JRST MODFOC ;YES, DO IT MODCON: PUSHJ P,IFCCOD ;GENERATE CONDITIONAL CAIA ;LOOK FOR MORE MODFOC: PUSHJ P,FORCOD ;GENERATE FOR CODE MODMOR: PUSHJ P,KWSMOD ;MORE MODIFIERS ? JRST MOLAB1 ; JRST MODLOO ;YES, DO THEM MOLAB1: TLNE C,F.TERM ;SEEN TERMINATOR YET JRST NXSM2 ; PUSHJ P,QSELS ; JRST ERTERM ;NO, ABOUT TIME MOVEM T,MULLIN ; JRST EACHLN ; NXSM2: SETZM MULLIN ;CLEAR MULLIN FLAG MOVEI D,"\" ;WAS IT CAIE D,(C) ;BACKSLASH ? JRST @SYNTAX ;NO, REALLY NEXT LINE MOVEM T,MULLIN ;YES, SET MULTI-LINE PUSHJ P,NXCH ;GET NEXT CHAR JRST EACHLN XREM: SETZM MULLIN ;CLEAR MULTIPLE LINE FLAG JRST EOLIN PAGE 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 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 SKIPN A ; PUSHJ P,NXCH XCHA01: MOVE X1,C ;SAVE LAST CHARACTER POP P,C ;RESTORE C POP P,T ;RESTORE T TLNN X1,F.COMA+F.TERM+F.PER ;TYPE 1? CAIN X1,":" ; JRST XCHAI2 ;YES, PROCESS TYPE 1 XCHAI1: PUSHJ P,FORMLS ;PROCESS FORM 2. JRST XCHAI5 ;CHECK FOR OPTIONAL LINE NUMBER XCHAI2: PUSHJ P,FILNAM ;PROCESS FORM 1. JUMP FILDIR XCHAI5: PUSHJ P,COMMA ;CHECK FOR COMMA, RETURN IF FOUND PUSHJ P,FORMLN ;YES. 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 PUSHJ P,OUVRNM ;OUTPUT SYMBOL TO CREF FILE AND SET UP POINTER PUSH P,C PUSH P,T PUSHJ P,NXCH TLNE C,F.DIG PUSHJ P,[IDPB C,X22 ;DEPOSIT CHAR IN VARNAM JRST NXCH] CAMN C,[XWD F.STR,"%"] PUSHJ P,[IDPB C,X22 JRST NXCH] PUSHJ P,QSA ASCIZ /TO/ JRST XCHAN3 HRLI F,1 TLNN C,F.LETT JRST ERLETT PUSHJ P,ATOM SETOM VARMOD CAIE A,5 CAIN A,6 JRST NXTSTA JRST ILFORM XCHAN3: POP P,T POP P,C SETZM VARNAM ;CLEAR OUT VARIABLE NAME XCHAN1: PUSHJ P,FORMLS ;PROCESS STRING NAME PUSHJ P,QSF ASCIZ /TO/ HRLI F,0 PUSHJ P,ARRAY ;REGISTER VECTOR NAME JUMPN A,GRONK SETOM VARMOD ;SET VARIABLE BEING MODIFIED FLAG JRST NXTSTA ;ALL DONE ; CLOSE STATEMENT XCLOSE: ASCIZ /SE/ XCLOS0: PUSHJ P,FORMLN ;GET CHANNEL NO PUSHJ P,COMMA ;CHECK FOR COMMA, RETURN IF FOUND JRST XCLOS0 ;GET NEXT CHANNEL NUMBER ;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/ 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 TLNN C,F.LETT ;MAKE SURE LETTER FOLLOWS. JRST ERLETT SKIPE FUNAME ;WITHIN MULTI-LINE DEF ? FAIL PUSHJ P,OUVRNM ;OUTPUT LAST VARIABLE AND SETUP POINTER MOVE F,XDEF ;SET UP FN IN VARIABLE NAME MOVEM F,VARNAM MOVE F,[POINT 7,VARNAM,13] ;SETUP POINTER TO VARNAM IN MOVEM F,X22 ;X22 (VARIABLE POINTER) IDPB C,X22 ;PUT LETTER IN FUNCTION NAME PUSHJ P,SCNLT1 ;SCAN FCN NAME. PUSHJ P,DIGIT ;CHECK FOR DIGIT HRLZI F,-1 ;ASSUME NUMERIC FN PUSHJ P,DOLLAR ;CHECK IT OUT TLZA F,-2 ;WRONG, SET FOR STRING PUSHJ P,PERCNT ;CHECK FOR A PERCENT MOVEM A,FUNAME ;SAVE THE NAME SETOM VARMOD ;SET VARIABLE BEING MODIFIED (DEFINED) ;SCAN FOR ARGUMENT NAME CAIE C,"(" ;ANY ARGUMENTS? JRST XDEF4 ;NO XDEF2A: PUSHJ P,NXCHK ;SKIP "(" TLNN C,F.LETT ;MUST HAVE A LETTER JRST ERLETT ;AND WE DIDN'T PUSHJ P,OUVRNM ;OUTPUT LAST VARIABLE (TO CRF) AND ;SET UP POINTERS PUSHJ P,SCNLT1 ;ASSEMBLE ARGUMENT NAME PUSHJ P,DIGIT ;CHECK FOR DIGIT PUSHJ P,DOLLAR CAIA PUSHJ P,PERCNT TLNE C,F.COMA ;ANY MORE ARGS? JRST XDEF2A ;YES PUSHJ P,RGTPAR ;CHECK FOR RIGHT PARENTHESIS XDEF4: TLNN C,F.EQAL ;MULTI LINE FN? JRST XDEFM ;YES PUSHJ P,NXCHK ;NO. SKIP EQUAL SIGN SETZM FUNAME PUSHJ P,FORMLU ;PARSE THE EXPRESSION JRST NXTSTA ;ALL DONE XDEFM: SKIPE MULLIN ;MULTI STATEMENT ? FAIL 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 CLEARM VIRDIM ;ASSUME NOT VIRTUAL CAME C,[XWD F.STR,"#"] ;IS IT VIRTUAL? JRST XDIMA ;NO, AWAY WE GO PUSHJ P,NXCH ;EAT THE # PUSHJ P,GETNUM ;GET CHANNEL CAIA ;ERROR CAILE N,9 ;LESS THAN 10 XDLAB1: FAIL JUMPE N,XDLAB1 ;CANNOT BE ZERO EITHER TLNN C,F.COMA ;COMMA NEXT JRST ERCOMA ;NO, ERROR PUSHJ P,NXCHK ;GET FIRST CHARACTER OF VARIABLE SETOM VIRDIM ;MARK AS VIRTUAL XDIMA: SETZI F, ;ALLOW STRING VECTORS. PUSHJ P,ARRAY ;REGISTER ARRAY NAME CAIE A,5 ;STRING VECTOR? ELSE.. JUMPN A,GRONK ;NON-0 RESULT IS ERROR CAIE C,"(" ;CHECK OPENING PAREN JRST ERLPRN PUSHJ P,NXCHK ;SKIP PARENTHESIS PUSHJ P,GETNU ;FIRST DIMENSION JRST GRONK ;NOT A NUMBER 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 XDIM1: PUSHJ P,RGTPAR ;CHECK FOR RIGHT PARENTHESIS SKIPE VIRDIM ;REGULAR DIMENSIONS TLNN C,F.EQAL ;NO, STRING SIZE SPECIFIED JRST XDIM2 ;NO, CARRY ON JUMPL F,XDIMR1 ;MUST BE A STRING PUSHJ P,NXCHK ;EAT THE EQUALS PUSHJ P,GETNU ;GET THE SIZE JRST XDIMER ;SOMETHING WRONG CAIL N,1 ;LESS THAN ONE CAILE N,^D128 ;LESS THAN 129 XDIMER: FAIL XDIM2: PUSHJ P,COMMA ;CHECK FOR COMMA, RETURN IF FOUND JRST XDIMA ;KEEP SCANNING. XDIMR1: FAIL ; ELSE STATEMENT XELS: MOVEM T,MULLIN ;SAVE POINTER PUSHJ P,QSA ASCIZ /E/ JRST ILLINS SOSGE THNCNT ;WAS THERE A THEN ? FAIL XELS0: TLNE C,F.DIG ;DIGIT JRST IFSX6 ;YES, LET IF CODING HANDLE THIS TLNE C,F.TERM FAIL JRST EACHLN ;END STATEMENT ; ::= END XEND: TLNN C,F.CR FAIL SKIPE FUNAME ;WITHIN DEF ? FAIL SKIPE THNELS ;UNDER THEN OR ELSE ? FAIL JRST NXTSTA ;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 PUSH P,[Z NXTSTA] ;RETURN FOR NEXT WHEN DONE FORCOD: HRLI F,777777 PUSHJ P,REGLTC ;REGISTER ON SCAROL CAIE A,1 ;BETTER BE SCALAR JRST ILVAR TLNN C,F.EQAL ;BETTER HAVE EQUAL JRST EREQAL SETOM VARMOD ;SET VARIABLE BEING MODIFIED FLAG PUSHJ P,NXCHK ;SKIP EQUAL SIGN. PUSHJ P,FORMLN ;GEN THE INITIAL VALUE 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. SETOM (P) ;REMEMBER WHERE IT IS JRST FORELS ;GO FOR NEXT KEYWORD FORBYC: SKIPE -1(P) ;ALREADY SEEN INCRE ? FAIL PUSHJ P,FORMLN ;XLATE AND GEN INCREMENT SETOM -1(P) ;REMEMBER WHERE IT IS JRST FORELS ;YES, NEXT KEYWORD FORSET: SKIPN (P) ;SEEN UPPER BOUND FAIL JRST FORZZZ ;GO CHECK STEP FORUNC: FORWHC: PUSHJ P,IFCCOD ;GO GENERATE LOGIC CODE FORZZZ: POP P,B ;POP OFF UPPER BOUND POP P,B POPJ P, ;FNEND STATEMENT ; ::= FNEND XFNEND: ASCIZ /ND/ SKIPN FUNAME ;SEEN A DEF ? FAIL SKIPE THNELS ;UNDER A CONDITIONAL FAIL TLNN C,F.CR ;E.O.L. ? FAIL SETZM FUNAME ;ZERO FN NAME JRST NXTSTA ;FINISHED ;GOSUB STATEMENT XLATE XGOSUB: ASCIZ /UB/ SKIPE FUNAME FAIL SETOM GOSBFL ;SET GOSUB FLAG TO OUTPUT A G AFTER LINE# JRST XGOFIN ;GOTO STATEMENT XGOTO: ASCIZ /O/ XGOFIN: PUSH P,[Z NXTSTA] XGOFR: PUSHJ P,GETNUM ;BUILD GOTO AND RETURN FAIL PUSHJ P,COUN ;OUTPUT LINE # TO CREF OUTPUT 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,":" CAMN C,[XWD F.STR,"#"] JRST XIF1 JRST ERCHAN XIF1: PUSHJ P,GETCNA JRST IFSX5 IFSX7: 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 ;INCREMENT THEN COUNT SETOM THNELS ;MARK REST OF LINE CONDITIONAL TLNN C,F.DIG ;NEXT CHAR A DIGIT ? JRST EACHLN ;NO IFSX6: PUSHJ P,XGOFR ;USE GOTO CODE TO GEN JRST INSTR TLNN C,F.CR CAMN C,[XWD F.APOS,"'"] ; JRST NXSM2 PUSHJ P,QSELS ;ELSE THERE TOO ? JRST ERTERM MOVEM T,MULLIN ;YES, MARK MULTI JRST EACHLN IFCCOD: PUSHJ P,FORMLB ;GENERATE CODE FOR SINGLE RELATION PUSHJ P,KWSCIF ;LOOK FOR LOGICAL RELATION POPJ P, ;RETURN JRST IFCCOD ;INPUT AND READ STATEMENT ; ::= INPUT ( ! )[,(!)...] XREAD: ASCIZ /D/ SETZM INPPRI## ;CAN'T OUTPUT STRING JRST XREAD1 XINPUT: ASCIZ /UT/ PUSHJ P,QSA ;CHECK FOR INPUT LINE ASCIZ /LINE/ JRST XIN11 ;NOT IT SETOM INLNFG ;YES, FLAG IT JRST XREAD1 ;" IS ILLEGAL XIN11: SETOM INPPRI ;STRING OUTPUT LEGAL TLNN C,F.QUOT ;POSSIBLE STRING TO OUTPUT JRST XREAD1 ;NO, CONTINUE XINOUT: PUSHJ P,NXCH ;EAT THE QUOTE PUSHJ P,REGSL1 ;SCAN OFF THE STRING PUSHJ P,CHKFMT ;CHECK FORMAT CHARACTER SETZM WRREFL ;FLAG FOR SEQUENTIAL ACCESS CAIN C,"_" ;WANT TO SUPPRESS ? ? PUSHJ P,NXCH ;YES, GOBBLE _ JRST XINP1 ;CARRY ON XREAD1: CLEARM WRREFL CAMN C,[XWD F.STR,"#"] JRST XINPT0 CAIE C,":" JRST XINP1 SKIPE INLNFG ;INPUT LINE? FAIL SETOM WRREFL XINPT0: PUSHJ P,GETCNB SETZM INPPRI ;STRING INPUT ILLEGAL WITH CHANNEL CLEARM IFFLAG ;CLEAR TYPE FLAG XINP1: SETZI F, ;STRINGS MAY BE INPUT PUSHJ P,REGLTC ;GET VARIABLE SETOM VARMOD ;NO. SET VARIABLE BEING MODIFIED FLAG SKIPN INLNFG ;INPUT LINE? JRST XINP91 ;NO, CONTINUE TLNE F,-2 ;MUST BE STRING FAIL XINP91: SKIPN WRREFL JRST XINP9 SKIPN IFFLAG MOVEM F,IFFLAG XOR F,IFFLAG JUMPGE F,XINP9 FAIL XINP9: JUMPE A,XINP2 ;JUMP IF ARRAY CAIG A,4 ;STRING VARIABLE? JRST XINP1A ;NO CAIG A,6 ;VARIABLE? JRST XINP6 ;YES JRST ILFORM ;NO, ATTEMPT TO BOMB A LITERAL XINP1A: CAILE A,1 ;ONLY ARRAY AND SCALAR ALLOWED JRST ILVAR JRST XINP3 XINP2: PUSHJ P,XARG ;XLATE ARGS XINP3: PUSHJ P,CSEPER XINP7: SKIPE INPPRI ;STRING OUTPUT LEGAL? TLNN C,F.QUOT ;AND IS THERE ONE JRST XINP1 ;NO, CARRY ON JRST XINOUT ;YES, GO HANDLE XINP6: PUSHJ P,FLET1 ;STRING. FINISH REGISTERING SKIPN INLNFG ;INPUT LINE JRST XINP3 JRST NXTSTA ;YES, BETTER BE END OF LINE ;LET STATEMENT XLET: SETOM LETSW ;LOOK FOR A LHS. PUSHJ P,FORMLB SETOM VARMOD ;NO. SET VARIABLE BEING MODIFIED FLAG 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 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 SETZM LETSW ;MARK R.H. 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/ 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. JRST NXTSTA XMAR6: TLNE C,F.TERM JRST ERDIGQ XMAR1: HRRZ A,C CAIN A,"#" ;CHANNEL SPECIFIER? PUSHJ P,GETCNB XMAR5: PUSHJ P,FORMLN PUSHJ P,CSEPER JRST XMAR1 ;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: SETZM TYPE ; HLLI F, ;ALLOW STRINGS FOR READ,PRINT,INPUT PUSHJ P,QSA ;MAT READ? ASCIZ /READ/ JRST XMAT2 ;NO. GO TRY MAT PRINT SETOM MRDFL ;SET MAT READ FLAG JRST XMAT2A ;TREAT LIKE PRINT ;::= MAT PRINT [(,)] [[;!,] [(,)...] XMAT2: PUSHJ P,QSA ;MAT PRINT? ASCIZ /PRINT/ JRST XMAT3 ;NO. MUST HAVE VARIABLE NAME. SETZM MRDFL ;CLEAR MAT READ FLAG XMAT2A: HRLI F,0 PUSHJ P,ARRAY ;REGISTER NAME SKIPE MRDFL ;MAT READ? SETOM VARMOD ;YES. SET VARIABLE BEING MODIFIED FLAG CAIE A,5 ;STRING VECTOR? JUMPN A,GRONK PUSHJ P,XMACOM ;GO CHECK DIMENSIONS AND BUILD UUO PUSHJ P,CHKFMT ;CHECK FORMAT CHARACTER XMAT2B: TLNE C,F.TERM ;IS FORMAT CHAR FOLLOWED BY END OF STA? JRST NXTSTA ;YES. JRST XMAT2A ;PROCESS NEXT ARRAY NAME ; ::= MAT =()* XMAT3: PUSH P,[Z NXTSTA] PUSHJ P,QSA ASCIZ /INPUT/ JRST XMAT3A PUSHJ P,ARRAY ;REGISTER VECTOR NAME SETOM VARMOD ;SET VARIABLE BEING MODIFIED FLAG CAIE A,5 ;STRING VECTOR? JUMPN A,GRONK ;OR NUMBER VECTOR? POPJ P, ; XMAT3A: HRLI F,-1 ;REMAINING MATOPS CANT HAVE STRINGS. PUSHJ P,ARRAY ;REGISTER THE VARIABLE JUMPN A,GRONK ;CHECK FOR ILLEGAL ARRAY NAME. SETOM VARMOD ;SET VARIABLE BEING MODIFIED FLAG MOVE X1,TYPE ; MOVEM X1,FTYPE ; 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 PUSHJ P,FORMLN ;YES. GEN MULTIPLE MOVE X1,TYPE ; CAME X1,FTYPE ; JRST MTYERR ; PUSHJ P,QSF ;SKIP MULTIPLY SIGN ASCIZ /)*/ JRST XMAT9A ; ::= MAT ZER!CON!IDN [(,)] XMAT4: PUSHJ P,QSA ;MAT ZER? ASCIZ /ZER/ JRST XMAT5 ;NO. JRST XMACOM XMAT5: PUSHJ P,QSA ;MAT CON? ASCIZ /CON/ JRST XMAT6 JRST XMACOM XMAT6: PUSHJ P,QSA ;MAT IDN? ASCIZ /IDN/ JRST XMAT7 ;NO ;COMMON GEN FOR MAT ZER,CON,IDN,REA XMACOM: CAIN C,"(" ;EXPLICIT DIMENSIONS? PUSHJ P,XARG ;TRANSLATE ARGUMENTS POPJ P, XMACMI: ; ::= MAT = INV!TRN () XMAT7: PUSHJ P,QSA ;MAT INV? ASCIZ /INV(/ JRST XMAT8 ;NO PUSHJ P,XMITCM SKIPGE FTYPE ; FAIL POPJ P, ; XMAT8: PUSHJ P,QSA ;MAT TRN? ASCIZ /TRN(/ JRST XMAT9 ;NO. XMITCM: PUSHJ P,NARRAY ;CHECK FOR NUMERIC ARRAY JRST RGTPAR ;CHECK FOR RIGHT PARENTHESIS ;::=MAT =+!-!* XMAT9: MOVE X1,TYPE ; MOVEM X1,FTYPE ; PUSHJ P,NARRAY ;CHECK FOR NUMERIC ARRAY TLNN C,F.PLUS+F.MINS+F.STAR ;CHECK FOR A OPERATOR JRST XMAT9A+1 ;NONE, MUST BE COPY, CHECK TYPE PUSHJ P,NXCHK ;SKIP OPERATOR XMAT9A: PUSHJ P,NARRAY ;CHECK FOR NUMERIC ARRAY MOVE X1,TYPE ; CAME X1,FTYPE ; MTYERR: FAIL POPJ P, NARRAY: HRLI F,-1 ;MUST HAVE NUMERIC PUSHJ P,ARRAY ;MUST HAVE ARRAY JUMPN A,GRONK ; POPJ P, ;RETURN ;NEXT STATEMENT ; ::= NEXT ;EXPECT TO FIND 5-WORD ENTRY ON TOP OF FORROL ;DESCRIBING INDUCTION VARIABLE AND LOOP ADDRESS XNEXT: ASCIZ /T/ SKIPE THNELS ;UNDER THEN OR ELSE ? FAIL XNEX0: TLNE C,F.TERM ;NEXT WITHOUT ARGUMENT JRST NXTSTA ;YES, GOOD-BYE HRLI F,777777 PUSHJ P,REGLTC CAIE A,1 ;BETTER BE SCALAR FAIL SETOM VARMOD ;SET VARIABLE BEING MODIFIED FLAG PUSHJ P,COMMA ;CHECK FOR COMMA, RETURN IF FOUND JRST XNEX0 ;NOPAGE AND NOPAGE ALL STATEMENTS. ; ;THIS ROUTINE IS ALSO USED BY THE (NO)QUOTE(ALL) STATEMENTS ;SINCE THEY GENERATE PRACTICALLY IDENTICAL CODE TO NOPAGE(ALL). ;FOR A DESCRIPTION OF THE CODE GENERATED, SEE ;MEMO #100-365-033-00. ;"TABLE" TELLS THE ROUTINE WHAT THE DIFFERENCES ARE. XNOP: ASCIZ /AGE/ XNOP8: PUSHJ P,QSA ;(NO)QUOTE(ALL) ENTERS HERE. ASCIZ /ALL/ JRST XNOP1 TLNN C,F.TERM JRST ERTERM JRST NXTSTA XNOP1: TLNE C,F.TERM JRST NXTSTA ;RETURN XNOP2: TLNN C,F.COMA ;DELIMITER? CAIN C,";" JRST XNOP3 XNOP6: CAMN C,[XWD F.STR,"#"] PUSHJ P,NXCH ;EAT IT XNOP4: PUSHJ P,GETCN0 TLNE C,F.TERM ;FINISHED? JRST NXTSTA ;YES. TLNE C,F.COMA ;DELIMITER? JRST XNOP3 CAIE C,";" JRST ERCLCM XNOP3: PUSHJ P,NXCH ;HERE WHEN DELIMITER SEEN. JRST XNOP1 ;GO FOR MORE ;NOQUOTE AND NOQUOTE ALL STATEMENTS. ; ;THESE STATEMENTS USE THE NOPAGE ROUTINE, XNOP, WHICH SEE. XNOQ: ASCIZ /UOTE/ JRST XNOP8 ;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 ;CHECK FOR "ON ERROR" ASCIZ /ERRORGOTO/ JRST XON4 SKIPE FUNAME ;WITHIN FN DEF ? FAIL TLNE C,F.TERM ;ANY ARGUMENT? JRST NXTSTA ;NO, FINISHED, NEXT LINE JRST XGOFIN ;LET GOTO CODE HANDLE LINE NUMBER XON4: PUSHJ P,FORMLN ;EVALUATE INDEX TLNE C,F.COMA ;SKIP OPTIONAL COMMA. PUSHJ P,NXCH PUSHJ P,QSA ASCIZ /GOSUB/ JRST XONA JRST XON1 XONA: PUSHJ P,THENGO ;TEST FOR "THEN" OR "GOTO" XON1: PUSHJ P,XGOFR ;BUILD A JRST TO THE NEXT NAMED STATEMENT XON2: PUSHJ P,COMMA ;CHECK FOR COMMA, RETURN IF FOUND 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: CAIE C,";" ; TLNE C,F.COMA JRST XFIL8 PUSHJ P,FILNMO ;GET FILENAME. JUMP FILDIR XFIL35: CAME C,[XWD F.STR,"%"] JRST XFIL36 PUSHJ P,NXCH JRST XFIL7 XFIL36: TLNN C,F.DOLL JRST XFIL7 PUSHJ P,NXCH ;R.A. STRING. SETZ B, TLNN C,F.DIG ;GET THE RECORD LENGTH. JRST XFIL7 PUSHJ P,XFIL30 SKIPLE B CAILE B,^D132 JRST XFILER JRST XFIL7 XFIL30: ADDI B,-60(C) PUSHJ P,NXCH TLNN C,F.DIG POPJ P, IMULI B,^D10 JRST XFIL30 XFIL7: TLNE C,F.TERM JRST NXTSTA MOVEI B,";" CAIE B,(C) TLNE C,F.COMA JRST XFIL8 JRST ERSCCM XFIL8: PUSHJ P,NXCH TLNN C,F.TERM JRST XFIL1 XFIL9: JRST NXTSTA XOPEN: ASCIZ /N/ SETOM OPNFLG SETOM FILTYP ;FILE TYPE UNKNOWN JRST FILOP0 ;SKIP LINE NO OUTPUT FILEE: SETZM OPNFLG SETOM FILTYP ;FILE TYPE UNKNOWN FILOP2: MOVEI B,-1 ;ASSUME R. A. CAIN C,":" ;TYPE OF ARG IS? JRST FILEE2 ;R.A. SETZ B, CAMN C,[XWD F.STR,"#"] JRST FILEE2 SKIPE OPNFLG CAME C,[XWD F.STR,"@"] JRST ERCHAN SETZM FILTYP AOSA FILTYP ;SEQ. ACCESS. FILEE2: PUSHJ P,FILSET ;SET FILE SPECS PUSHJ P,GETCNA SKIPE OPNFLG ;NO DELIMITER IN OPEN JRST FILOP5 PUSHJ P,GETCND ;CHECK FOR SEPARATOR FILOP0: TLNN C,F.QUOT JRST FILE21 PUSH P,T PUSH P,C PUSHJ P,QSKIP JRST ERQUOT TLNN C,F.PLUS ;CHECK FILE SPEC UNLESS CONCATENATION JRST FILEE4 FILE20: POP P,C POP P,T FILE21: PUSHJ P,FORMLS ;GET FILENM ARG. SKIPE OPNFLG ;OPEN ? JRST FILOP1 ;YES, GO DO FOR INPUT/OUTPUT PUSHJ P,CSEPER ;CHECK FOR SEPARATOR JRST FILOP2 ;FOUND ONE FILEE4: MOVE T,-1(P) MOVE C,0(P) PUSHJ P,NXCH PUSHJ P,FILNMO ;FILENM.EXT FORM? JUMP FILDIR 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 SKIPLE B CAILE B,^D132 XFILER: FAIL 132> XFILR1: TLNN C,F.QUOT JRST ERDIGQ FILEE6: MOVEI B,-1 FILEE7: PUSHJ P,FILSET ;SET FILE TYPE JRST FILE20 ;BACK TO MAIN CODE FILSET: SKIPGE FILTYP ;ALREADY SET ? MOVEM B,FILTYP ;NO, SET IT CAME B,FILTYP ;YES, IS IT 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: SKIPG FILTYP ;VIRTUAL ARRAY FILE SKIPN X1,INPOUT ;MODE SPECIFIED ? JRST NXTSTA ;NO JUMPG X1,FILOP6 ;YES, WHICH 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 JRST NXTSTA ;NEXT STATEMENT FILOP6: SKIPN FILTYP ;INPUT, RESTORE, RANDOM ? JRST FILPLT ;CHECK FOR PLOTTING JRST NXTSTA ;SCRATCH STATEMENT ;FORMAT ; SCRATCH Q4,Q7,Q8 ;WHERE Q IS # OR :. Q MAY BE OMITTED, IN WHICH CASE # IS ASSUMED. XSCRAT: ASCIZ /ATCH/ SRAER5: CAIE C,":" CAMN C,[XWD F.STR,"#"] ;SEQ. ACCESS ARGUMENT. PUSHJ P,NXCH PUSHJ P,FORMLN PUSHJ P,CSEPER ;CHECK FOR SEPARATOR JRST SRAER5 ;FOUND ONE, DO IT ;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: CAIN C,":" ;SKIP OPTIONAL COLON. PUSHJ P,NXCH PUSHJ P,GETCNC PUSHJ P,FORMLN ;GET VALUE FOR POINTER. PUSHJ P,CSEPER ;CHECK FOR SPEARATOR JRST XSET ;FOUND ONE, DO IT ; ;PAUSE STATEMENT ; XPAUSE: ASCIZ /SE/ 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 TLNN C,F.RPRN ;IF NOT COMMA, THEN ')' JRST ERRPRN ;TELL HIM IT WASN'T MOVEI X1,2 ;ASSUME ORIGIN (TWO ARGUMENTS) SUB X1,NOORG ;FIX FOR LINE OR ORIGIN CAME X1,PSHPNT ;CORRECT NUMBER OF ARGUMENTS JRST ARGCH0 ;NOPE JRST XPLFN1 ;GO SEE IF ANOTHER PLOT FUNCTION DO1ARG: TLNE C,F.COMA ;COME HERE WITH COMMA PUSHJ P,NXCHK ;SWALLOW CHARACTER IN C PUSHJ P,FORMLN ;GENERATE NUMERIC ARGUMENT IN REG AOS PSHPNT ;UP PUSH COUNT POPJ P, ;RETURN XPLOT1: PUSHJ P,QSA ;TRY ANOTHER FUNCTION ASCIZ /STRING(/ ;STRING? JRST XPLOT2 ;NO, TRY AGAIN 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 PUSHJ P,NXCHK ;SWALLOW THE COMMA PUSHJ P,FORMLS ;GENERATE STRING ARGUMENT TLNN C,F.RPRN ;END ON ')' JRST ERRPRN ;TOO BAD 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 JRST XPLFIN ;END OF PAGE XPLOT4: PUSHJ P,QSA ;ANOTHER TIME ASCIZ /INIT/ ;INIT? JRST XPLOT5 ;TRY, TRY, TRY, TRY AGAIN XPLT4A: JRST XPLFIN ;CHECK FOR ANOTHER FUNCTION XPLOT5: PUSHJ P,QSA ;CHECK FOR FUNCTION ASCIZ /WHERE(/ ;WHERE? JRST XPLOT6 ;TRY LAST ONE 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 XPLT7A ;END XPLOT6: PUSHJ P,QSA ;IS IS CURSOR ASCIZ /CURSOR(/ ; JRST XPLOT7 ;TRY SAVE PUSHJ P,DOSARG ; TLNN C,F.COMA ; JRST ERCOMA ; JRST XPLT5A ;DO LAST TWO ARGUMENTS XPLOT7: PUSHJ P,QSA ;TRY SAVE ASCIZ /SAVE(/ FAIL PUSHJ P,GETCN0 ;GET CHANNEL XPLT7A: TLNN C,F.RPRN ;FOLLOWED BY ")"? JRST ERRPRN ;NO, GIVE ERROR XPLFN1: PUSHJ P,NXCHK ;SWALLOW THE ')' XPLFIN: PUSHJ P,CSEPER ;CHECK FOR SPEARATOR JRST XPLOA ;FOUND ONE, DO IT DOSARG: TDZ F,F ; TLNE C,F.COMA ;IS THERE A COMMA PUSHJ P,NXCHK ;EAT THE ',' PUSHJ P,REGLTR ;SINGLE ARGUMENT CAIE A,1 ;SCALAR? JRST ILVAR ;CAN ONLY BE POPJ P, ; XLIST > LIST ; ; UNTIL-WHILE-NEXT LOOP ; XUNTIL: ASCIZ /IL/ CAIA XWHILE: ASCIZ /LE/ PUSHJ P,IFCCOD ;LET IF CODE HANDLE CONDITION 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 CAMN C,[XWD F.STR,"#"] ;USING STATEMENT. IMAGE NEXT? PUSHJ P,GETCNB XWRI2: PUSHJ P,XWRIMG ;GET IMAGE. JRST XWRI5 ;MUST BE TTY STATEMENT, GET ARGS & FINISH. XWRI1: CAME C,[XWD F.STR,"#"] JRST XPRI1 ;NOT USING, NOT #, MUST BE SIMPLE PRINT. PUSHJ P,GETCNA ;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 ; '' JRST XWRI2 ;GO TO GEN ARGS AND FINISH. XWRIMG: TLNE C,F.DIG ;HANDLE IMAGE. JRST XWRIM2 ;LINE NUMBER FORM. XWRIM1: PUSHJ P,FORMLS TLNN C,F.COMA JRST ERCOMA JRST NXCH XWRIM2: PUSHJ P,GETNUM ;GET THE NUMBER. JFCL PUSHJ P,COUN ;OUTPUT LINE # TO CREF OUTPUT TLNN C,F.COMA JRST ERCOMA JRST NXCH XWRI5: PUSHJ P,KWSAMD ;LOOK FOR MODIFIER CAIA ;NONE THERE JRST NXTSTA ;TREAT IT AS TERMINATOR PUSHJ P,FORMLB PUSHJ P,CSEPER TLNN C,F.TERM JRST XWRI5 JRST NXTSTA XPRRAN: PUSHJ P,GETCNB PUSHJ P,FORMLB MOVEM F,IFFLAG XPRRN1: PUSHJ P,CSEPER ;CHECK FOR SEPARATOR JRST XPRRN2 ;FOUND ONE, DO IT XPRRN2: PUSHJ P,FORMLB XOR F,IFFLAG JUMPGE F,XPRRN1 FAIL XPRI1: SKIPE WRREFL JRST GRONK XPRI0: PUSHJ P,KWSAMD ;MODIFIER FOLLOWS ? TLNE C,F.TERM ;NON-USING STATEMENTS FROM HERE ON. JRST NXTSTA CAIA XPRI2: PUSHJ P,KWSAMD ;MODIFIER ? CAIA ;NO JRST NXTSTA ;YES, GO HANDLE PUSHJ P,QSA ASCIZ /TAB/ ;TAB FIELD? JRST XWLAB2 ;NO, ASSUME EXPRESSION OR DELIMITER. JRST XPRTAB ;YES, DO THE TAB XWLAB2: TLNE C,F.COMA JRST XPRTA1 CAIE C,";" CAIN C,74 ;LEFT ANGLE BRACKET JRST XPRTA1 ;PRINT EXPRESSION PRNEXP: PUSHJ P,FORMLB ;GEN THE EXPRESSION JRST XPRTA1 ;GO FOR MORE ;PRINT TAB XPRTAB: PUSHJ P,FORMLN ;EVALUATE TAB SUBEXPRESSION XPRTA1: PUSHJ P,CHKFMT XPRFIN: TLNE C,F.TERM ;CR AT END OF LINE? JRST NXTSTA JRST XPRI2 ;NO. GO FOR MORE ;CHECK FORMAT CHAR (PRINT AND MAT PRINT) CHKFMT: PUSHJ P,KWSAMD ;DELIMITER THERE ? (IMPLIES CR) JFCL ; 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 POPJ P, CHKFM2: 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/ JRST XMAR0 ;QUOTE AND QUOTE ALL STATEMENTS. ; ;CODE FOR THESE STATEMENTS IS COMPILED BY THE NOPAGE AND NOPAGE ALL ;ROUTINE, XNOP, WHICH SEE. XQUO: ASCIZ /TE/ JRST XNOP8 ;RANDOM IZE STATEMENT XRAN: ASCIZ /DOM/ PUSHJ P,QSA ASCIZ /IZE/ JRST NXTSTA JRST NXTSTA ;RESTORE STATEMENTS. XREST: PUSHJ P,QSA ;CHECK FOR RESUME ASCIZ /UME/ JRST XRESTA ;NO, MAYBE RESTORE TLNE C,F.TERM ;ARGUMENT TO RESUME JRST NXTSTA ;NO, ALL DONE JRST XGOFIN ;LET GOTO CODE HANDLE LINE NUMBER XRESTA: PUSHJ P,QSA ;BETTER BE RESTORE ASCIZ /TORE/ JRST ILLINS ;NO, ILLEGAL INSTRUCTION TLNN C,F.DOLL+F.STAR+F.TERM CAMN C,[XWD F.STR,"%"] JRST XREST1 XRES3: CAIE C,":" CAMN C,[1000000043] PUSHJ P,NXCH PUSHJ P,FORMLN ;RESTORE# STATEMENT. XRES6: PUSHJ P,CSEPER ;CHECK FOR SEPARATOR JRST XRES3 ;FOUND ONE, DO IT XREST1: TLNN C,F.TERM PUSHJ P,NXCHK ;SKIP $ OR * OR % JRST NXTSTA ;RETURN STATEMENT XLATE XRETRN: ASCIZ /URN/ SKIPE FUNAME FAIL JRST NXTSTA ;STOP STATEMENT XSTOP: ASCIZ /P/ JRST NXTSTA SUBTTL FORMULA GENERATOR ;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 JRST FORMLU FORMLB: TDZA F,F FORMLN: SETOI F, FORMLU: SETZM TYPE ;CLEAR TYPE IN CASE OF STRING PUSHJ P,CFORM ;CHECK FOR COMPARISON ; ; BOOLEAN LOGIC ; BTERM1: PUSHJ P,KWSCIF ;BOOLEAN KEYWORD? POPJ P, ;NO, RETURN JUMPGE F,SETFER ; MOVEI F,(F) ; PUSHJ P,CFORM ; JUMPGE F,SETFER ; CLEAR B, ; JRST BTERM1 ; CFORM: PUSHJ P,QSA ; ASCIZ /NOT/ JRST CFORM0 ; MOVMS LETSW ; PUSHJ P,CFORM0 ; JUMPGE F,SETFER ; CLEAR B, ; POPJ P, ; CFORM0: PUSHJ P,FORM ; ; CFORM1: MOVEI X1,76 ; CAIN X1,(C) ; JRST CFORM2 ; MOVEI X1,74 ; CAIN X1,(C) ; JRST CFORM2 ; SKIPGE LETSW ; POPJ P, ; TLNN C,F.EQAL ; POPJ P, ; CFORM2: MOVMS LETSW ; PUSHJ P,SCNLT1 ; MOVEI X1,76 ; CAIE X1,(C) ; TLNE C,F.EQAL ; PUSHJ P,SCN2 ; JFCL ; MOVEI R,RELROL ; PUSHJ P,SEARCH ; FAIL PUSHJ P,FORM ; CLEAR B, ; HRLI F,-1 ; JRST CFORM1 ; ; ; XFORMS: HRLZI F,1 ; JRST XFORMU ; XFORMB: TDZA F,F ; XFORMN: SETOI F, ; XFORMU: SETZM TYPE ; 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) TLNN C,F.MINS JRST FORM2 PUSHJ P,LEGAL JRST FORM3 FORM2: JUMPL F,FORM3 FORM4: PUSHJ P,TERM SETZ B, TLNN C,F.PLUS POPJ P, JRST FORM4 FORM3: PUSHJ P,TERM ;GEN SECOND TERM 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,LEGAL MOVMS LETSW ;THIS CANT BE LH(LET) TERM2: PUSHJ P,NXCHK ;SKIP OVER CONNECTIVE JRST TERM ;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: TLNN C,F.MINS ;EXPLICIT MINUS SIGN? JRST FACT2 ;NO. PUSHJ P,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. POPJ P, ;NO, 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, "*"] POPJ P, FACT3A: PUSHJ P,LEGAL MOVMS LETSW ;THIS CANT BE LH(LET) PUSHJ P,NXCHK ;YES. SKIP EXPONENTIATION SIGN PUSHJ P,ATOM ;GEN THE EXPONENT MOVEI B,0 ;ANSWER LANDS IN REG JRST FACT2A ;GEN CODE FOR SIGNED ATOM. ATOM: TLNE C,F.PLUS ;EXPLICIT SIGN? JRST ATOM1 TLNN C,F.MINS JRST ATOM2 PUSHJ P,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 ; PUSH P,F ;SAVE F PUSHJ P,FORMLB ;GEN THE SUBEXPRESSION POP P,X1 ;GET BACK PREVIOUS MODE TLNN X1,-1 ;TYPE DECLARED? JRST FSUBX1 ;NO, DON'T CHECK XOR X1,F ;CHECK FOR MIXED MODE JUMPL X1,SETFER ;T. S. FSUBX1: JRST RGTPAR ;CHECK FOR RIGHT PARENTHESIS ;HERE WHEN ATOMIC FORMULA IS A NUMBER FNUMBR: PUSHJ P,LEGAL MOVMS LETSW PUSH P,F PUSHJ P,EVANUM ;EVALUATE NUMBER (IN N) FAIL POP P,F CAIE C,"^" TLNN C,F.STAR JRST FNUM4 MOVEM T,B PUSHJ P,NXCH MOVE T,B TLNN C,F.STAR MOVE C,[XWD F.STAR,"*"] FNUM4: HRLI B,CADROL ;MAKE POINTER POPJ P, ;RETURN ;XLATE AND GEN ATOMIC FORMULA BEGINNING WITH LETTER FLETTR: PUSHJ P,REGLTR FLET1: JRST .+1(A) JRST XARFET ;ARRAY REF POPJ P, ;JUST RETURN JRST XINFCN ;INTRINSIC FCN JRST XDFFCN ;DEFINED FCN JRST ILVAR JRST XARFET ;STRING VECTOR. PROCESS WITH ARRAY CODE! POPJ P, ;POINTER IS IN B FOR BUILDING XARFET: 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. SUB P,[XWD 3,3] ;ADJUST THE PUSHLIST TO ESC XFORMS POPJ P, XARF1: POPJ P, ;GEN FUNCTION CALLS XDFFCN: PUSH P,F ;SAVE TYPE OF FCN CAIE C,"(" ;ANY ARGS? JRST XDFF2 ;NO XDFF1: PUSHJ P,NXCHK PUSH P,LETSW MOVMS LETSW PUSHJ P,XFORMB ;GEN THE ARGUMENT IN REG POP P,LETSW TLNE C,F.COMA ;MORE ARGS? JRST XDFF1 ;YES TLNN C,F.RPRN ;CHECK FOR MATCHING PAREN JRST ERRPRN PUSHJ P,NXCHK ;SKIP PAREN XDFF2: MOVEI B,0 ;ANSWER IS IN REG POP P,F ;RESTORE TYPE OF FCN POPJ P, ;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. ARGCH0: FAIL ;INTRINSIC FUNCTION GENERATOR. XINFCN: TLNN B,777777 ;INLINE CODE PRODUCER? JRST XINF4 ;YES, TYPED INTERNALLY TLNE B,777 ;ANY ARGUMENTS? JRST XINF2 ;YES, HANDLE THE ARGUMENT CAIE C,"(" ;OPTIONAL ARGUMENT? POPJ P, ;NO, RETURN PUSHJ P,NXCH ;EAT A "(" PUSHJ P,FORMLB ;DO THE ARGUMENT TLNN C,F.RPRN ;END WITH ")" JRST ERRPRN ;SHOULD HAVE JRST NXCH ;RETURN AFTER EATING ")" ; ; 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 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 XINF22: PUSH P,D ;SAVE D PUSH P,X1 PUSHJ P,NXCH ;EAT THE SEPARATOR , OR ( PUSHJ P,XFORMU ;GENERATE THE ARGUMENT POP P,X1 ;AND NUMBER OF ARGUMENTS POP P,D SOJN X1,XINF24 ;ALL ARGUMENTS PROCESSED POP P,F ;YES, RESTORE SUBEXPRESSION TYPE JRST RGTPAR ;CHECK FOR RIGHT PARENTHESIS AND RETURN XINF24: 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 PUSHJ P,XINNM1 HRLI F,1 ;RESTORE F. JRST XINF01 XINF31: PUSHJ P,NXCH ;INSTR. PUSHJ P,XFORMB JUMPL F,XINF32 XINF34: PUSHJ P,XINSTR POP P,F JRST XINF0A XINF32: PUSHJ P,XINSTR PUSHJ P,XINSTR POP P,F XINF01: JRST RGTPAR ;CHECK FOR RIGHT PARENTHESIS AND RETURN XINSTR: TLNN C,F.COMA ;SUBR FOR STR ARG. JRST ERCOMA XINST1: PUSHJ P,NXCH JRST XFORMS ;HANDLE STRING ARGUMENT XINNUM: TLNN C,F.COMA ;SUBR FOR NUMERIC ARGUMENT. JRST ERCOMA XINNM1: PUSHJ P,NXCH JRST XFORMN ;HANDLE NUMERIC ARGUMENT XINF0A: JRST RGTPAR ;CHECK FOR RIGHT PARENTHESIS AND RETURN XINF4: JRST .(B) ;IN LINE CODE. JRST ABSBI JRST ASCBI JRST CRTBI JRST DETBI JRST FLTBI ;FLOAT JRST LLBI JRST LOCBI JRST LOFBI JRST NUMBI JRST PIBI JRST SGNBI JRST CPOPJ ; ;IN LINE FUNCTION GENERATORS. FLTBI: SGNBI: CRTBI: ABSBI: CAIE C,"(" ;ABS FUNCTION. JRST ARGCH0 PUSHJ P,NXCH PUSHJ P,XFORMN INLIOU: JRST RGTPAR ;CHECK FOR RIGHT PARENTHESIS AND RETURN ASCBI: CAIE C,"(" ;MUST START WITH ( JRST ARGCH0 ;IT DIDN'T PUSHJ P,NXCHD ;GET NEXT CHARACTER TLNN C,F.RPRN ;COULD ( BE THE ARGUMENT? JRST ASCB11 ;NO, CHECK FOR SPACE OR TAB PUSHJ P,NXCH ;NEXT CHARACTER JRST RGTPAR ;HAS TO BE RIGHT PARENTHESIS ASCB11: TLNN C,F.SPTB ;SPACE OR TAB? JRST ASCBI3 ;NO, MUST BE CHARACTER ASCBI1: PUSHJ P,NXCHD ;NEXT CHARACTER TLNE C,F.RPRN ;RIGHT PARENTHESIS? JRST ASCBI2 ;YES, IS IT THE ARGUMENT? TLNE C,F.CR ;END-OF-LINE? ASCBI0: FAIL TLNN C,F.SPTB ;ANOTHER SPACE OR TAB? JRST ASCBI3 ;NO, MUST BE CHARACTER ARGUMENT JRST ASCBI1 ;YES, CHECK NEXT CHARACTER ASCBI2: PUSH P,T ;SAVE CURRENT WORD POINTER PUSHJ P,NXCH ;GET NEXT CHARACTER POP P,T ;RESTORE T TLNE C,F.RPRN ;RIGHT PARENTHESIS? IBP T ; POPJ P, ;AND RETURN, SPACE WAS THE ARGUMENT ASCBI3: PUSHJ P,SCNLT1 ;PUT CHARACTER IN A TLNE C,F.RPRN ;RIGHT PARENTHESIS JRST NXCH ; TLNE C,F.TERM ;END-OF LINE? JRST ILFORM ;NOT EXPECTED PUSHJ P,SCN2 ;SECOND CHARACTER TO A JFCL TLNE C,F.RPRN ;END OF LIST? JRST ASCBI6 ;YES, CHECK ARGUEMNT TLNE C,F.TERM ;END OF LINE? JRST ILFORM ;NOT EXPECTED PUSHJ P,SCN3 ;THIRD CHARACTER TO A JFCL ; TLNN C,F.RPRN ;MUST BE END OF LIST JRST ERRPRN ;WASN'T EXPECTED ASCBI6: HLRZ A,A ;PUT CODE IN RIGHT HALF MOVEI X1,ASCFLO+1 ;START SEARCH HERE ASCBI7: HLRZ X2,-1(X1) ;GET POSSIBLE ARGUMENT CAIN A,(X2) ;MATCH JRST NXCH ;YES, RETURN WITH ANOTHER CHARACTER HRRZ X2,-1(X1) ;GET POSSIBLE ARGUMENT CAIN A,(X2) ;MATCH? JRST NXCH ;YES, RETURN WITH ANOTHER CHARACTER CAIGE X1,ASCCEI ;EXHAUSTED THE LIST? AOJA X1,ASCBI7 ;NO, TRY AGAIN JRST ASCBI0 ;YES, GIVE AN ERROR ;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: PIBI: NUMBI: DETBI: CAIN C,"(" ;DET FUNCTION. JRST ARGCH0 ; HRLI F,777777 ;RESTORE F. POPJ P, ;RETURN LLBI: CAIE C,"(" ;MUST HAVE ARG. JRST ARGCH0 PUSHJ P,NXCH PUSHJ P,GETNUM ;GET IT FAIL PUSHJ P,COUN ;REGISTER LINE REF. JRST RGTPAR ;CHECK FOR CLOSING PAREN LOFBI: LOCBI: CAIE C,"(" ;LOF ENTERS HERE. JRST ARGCH0 PUSHJ P,NXCH CAIN C,":" PUSHJ P,NXCH PUSHJ P,XFORMN JRST RGTPAR ;CHECK RIGHT PARENTHESIS AND RETURN ;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,VARNAM SETZM VARNAM PUSH P,F PUSHJ P,XFORMB JUMPL F,XARG0 XARG3: FAIL XARG0: POP P,F 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 MOVNI B,1 ;DBL ARG FLAG XARG1: PUSHJ P,OUVRNM POP P,VARNAM POP P,LETSW ;RESTORE LETSW TLNN C,F.RPRN ;MUST HAVE PARENTHESIS JRST ERRPRN PUSHJ P,NXCHK ;IT DOES. SKIP PAREN AND RETURN. TLNE C,F.EQAL+F.COMA SETOM VARMOD POPJ P, ;ROUTINE TO GEN ARGUMENTS ;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. REGLTC: TLNN C,F.LETT ;NEED A LETTER JRST ERLETT ;NONE THERE REGLTR: PUSHJ P,OUVRNM ;OUTPUT LAST VARIABLE AND SETUP PUSHJ P,SCNLT1 ;LTR TO A, LEFT JUST 7 BIT HRRI F,SCAROL ;ASSUME SCALAR TLNE C,F.LETT ;ANOTHER LETTER? JRST REGFCN ;YES. GO LOOK FOR FCN REF TLNN C,F.DIG ;DIGIT FOLLOWS? JRST REGLIB ;NO, GO CHECK FOR ARRAY DPB C,[POINT 7,A,13];ADD DIGIT TO NAME IDPB C,X22 ;DEPOSIT CHAR IN CRF VARIABLE TOO PUSHJ P,NXCH ;GO ON TO NEXT CHAR REGLIB: TLNE C,F.DOLL ;STRING VARIABLE? JRST REGSTR ;YES. REGISTER IT. PUSHJ P,PERCNT ;CHECK FOR PERCENT CAIN C,"(" JRST REGARY PUSHJ P,LEGAL ;COME HERE ON REF TO FCN ROL ;CALCULATE ADDRESS OF THIS FUNCTION ARGUMENT. FARGRF: 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 REGSCA REGARY: PUSHJ P,LEGAL REGA0: HRRI F,ARAROL ;NUMERICAL ARRAY GOES ON ARAROL. MOVEI A,"(" ;() AFTER CREF VARIABLE MEANS ARRAY IDPB A,X22 ;DEPOSIT IN CREF VARIABLE NAME MOVEI A,")" IDPB A,X22 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 PUSHJ P,OUVRNM ;OUTPUT LAST CREF VARIABLE AND SETUP TLNN C,F.LETT JRST REGFAL PUSHJ P,SCNLT1 ;NAME TO A PUSHJ P,DIGIT ;CHECK FOR A DIGIT PUSHJ P,DOLLAR ;NOW FOR A DOLLAR JRST ARRAY2 ;FOUND, STRING ARRAY PUSHJ P,PERCNT ;CHECK FOR A PERCENT ARRAY0: PUSHJ P,LEGAL JRST REGA0 ;FINISH REGISTERING ARRAY2: JUMPL F,ILFORM HRLI F,1 JRST REGSVR ;REGISTER STRING VECTOR AND RETURN REGSTR: JUMPL F,ILFORM ;REGISTER STRING, IF STRING IS LEGAL HRLI F,1 HRRI F,VSPROL ;POINTER WILL GO ON VARIABLE SPACE ROLL TLNE C,F.DOLL ;SKIP DOLLAR SIGN? PUSHJ P,[TLO A,10 IDPB C,X22 JRST NXCHK] CAIN C,"(" ;IS IT A STRING VECTOR? JRST REGSVR ;YES. PUSHJ P,REGSCA ;REGISTER STRING. JRST REGS1 ;FIX VARIABLE TYPE CODE. REGSLT: MOVMS LETSW ;STR LIT. JUMPL F,ILFORM HRLI F,1 PUSHJ P,NXCHD REGSL1: TLNE C,F.QUOT ;COUNT CHARACTERS. JRST REGSL5 TLZN C,F.CR ; OR ? JRST RGSLX1 ;NO CAIE C,12 ; ? JRST GRONK ;NO RGSLX1: PUSHJ P,NXCHD JRST REGSL1 REGSL5: PUSHJ P,NXCH MOVEI A,7 POPJ P, REGSVR: HRRI F,SVRROL ;REGISTER STRING VECTOR TLNE C,F.DOLL ;DOLLAR SIGN? PUSHJ P,NXCHK ;YES, SKIP IT MOVEI A,"(" ;() FOR CREF VARIABLE IDPB A,X22 ;MEANS ARRAY VARIABLE MOVEI A,")" IDPB A,X22 MOVEI A,0 ;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? POPJ P, ;RETURN DPB C,[POINT 7,A,13] IDPB C,X22 ;DEPOSIT CHAR IN CREF VARIABLE JRST NXCH ;GET NEXT CHARACTER AND RETURN DOLLAR: TLNN C,F.DOLL ;DOLLAR SIGN? AOSA (P) ;NO, SKIP RETURN TLOA A,10 ;YES, MARK IT POPJ P, ;RETURN IDPB C,X22 ;DEPOSIT CHAR IN CREF VARIABLE SETZM TYPE ; JRST NXCHK ;GET NEXT CHARACTER AND RETURN PERCNT: CAME C,[XWD F.STR,"%"] ;IS IT A PERCENT? POPJ P, ;RETURN IDPB C,X22 ;DEPOSIT CHAR IN CREF VARIABLE SETOM TYPE ; TLO A,4 ;YES, MARK IT 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: ASCIZ /THEN/ ASCIZ /GOTO/ KWAAMD: ASCIZ /ELSE/ KWAFOR: ;FOR STMT KEYWORDS ASCIZ /TO/ ASCIZ /STEP/ ASCIZ /BY/ KWAMOD: ;MODIFIER KEYWORDS ASCIZ /WHILE/ ASCIZ /UNTIL/ KWZFOR: ;END OF FOR KEYWORDS ASCIZ /IF/ ASCIZ /UNLESS/ ASCIZ /FOR/ KWZMOD: ASCIZ /USING/ KWAONG: ASCIZ /GOSUB/ KWZAMD: KWZALL: KWTTOP: ;GENERATE SERVICE ROUTINE FOR VARIOUS KEYWORD SEARCHES DEFINE KWSBEG(U) < IRP U > KWSBEG KWDSR1: PUSH P,X2 ;SAVE X2 FROM QST PUSHJ P,QST ;LOOK FOR NEXT JRST KWDSR2 ;NOT THERE POP P,X2 ;RESTORE X2 AOS -4(P) ;FOUND, SKIP RETURN HRRZM X1,KWDIND ;SAVE INDEX CAIN X2,KWZALL-1 ;SEARCHING ALL KEYWORDS ? JRST KWDSR3 ;YES, JUST RETURN POP P,X2 ;NO, THROW AWAY POP P,X2 ;CHAR & COUNTER JRST KWDSR5 ;TO CONTINUE SCAN KWDSR3: POP P,T ;RESTORE POINTER POP P,C ;AND CHAR KWDSR5: POP P,X2 ;X2 POP P,X1 ;AND X1 POPJ P, ;RETURN KWDSR2: POP P,X2 ;RESTORE X2 MOVE T,(P) ;GET BACK POINTER MOVE C,-1(P) ;AND CHAR CAIE X2,(X1) ;FINISHED ? AOJA X1,KWDSR1 ;NO, TRY AGAIN JRST KWDSR3 ;YES, GO BACK KWSTUP: EXCH X1,(P) ;SAVE X1, GET RETURN ADDRESS PUSH P,X2 ;SAVE X2 PUSH P,C ;SAVE CHAR PUSH P,T ;AND POINTER PUSH P,X1 ;AND RETURN ADDRESS PUSHJ P,QSA ;IS I FOR THERE ? ASCIZ /IFOR/ POPJ P, ;NO, ALL CLEAR POP P,X2 ;YES, RECTIFY PDL JRST KWDSR3 ;AND IGNORE IT ;REGISTER FUNCTION NAME ;FIRST LETTER HAS BEEN SCANNED ;IT IS POSSIBLE THAT WE HAVE SCANNED A ONE-LETTER VARIABLE NAME ;FOLLOWED BY ONE OF THE KEYWORDS "TO" , "THEN", OR "STEP". ;FIRST WE LOOK AHEAD TO SEE IF THIS IS SO; ;IF IT IS WE GO BACK TO SCALAR CODE. REGFCN: XLIST LIST PUSHJ P,KWSALL ;LOOK FOR KEYWORDS JRST REGFX1 ;NONE FOUND PUSHJ P,LEGAL SETZM VARNAM ;CLEAR LAST VARIABLE NAME JRST REGSCA XLIST LIST REGFX1: ;HAVE DETERMINED THAT WE MUST BE SCANNING A FUNCTION NAME ;IF SYNTAX IS LEGAL. ;WE SCAN THE SECOND LETTER AND CHECK FOR ;INTRINSIC OR DEFINED FUNCTION. IDPB C,X22 ;DEPOSIT CHAR IN CREF VARIABLE 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,LEGAL JRST REGF0 REGF5: TLNN C,F.DIG JRST REGF51 CAME A,[SIXBIT/LOG /] CAMN A,[SIXBIT/LOG1 /] JRST REGF41 REGF51: TLNN C,F.DOLL JRST REGF9 REGF10: MOVEI C,4 ;$ IN SIXBIT. IDPB C,X1 PUSHJ P,NXCH JUMPL F,ILFORM HRLI F,1 REGF0: MOVEI R,IFNFLO PUSHJ P,OUVA ;OUTPUT SIXBIT FUNCTION NAME IN A SETZM VARNAM ;CLEAR OUT VARNAM 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: IDPB C,X22 ;DEPOSIT CHAR IN CREF VARIABLE PUSHJ P,SCNLT1 ;PUT FUNCTION NAME IN A PUSHJ P,DIGIT ;CHECK FOR A DIGIT HRLZI F,-1 ;ASSUME NUMERIC PUSHJ P,DOLLAR ;CHECK FOR $ TLZA F,-2 ;WE WERE RIGHT PUSHJ P,PERCNT ;CHECK FOR % HRRZ D,LETSW ; CAIN D,-1 JRST SCAREG ;YES. REGISTER IT AS A SCALAR MOVMS LETSW MOVEI A,3 ;DEFINED FCN CODE POPJ P, ;DON'T CHECK FOR () YET CHKPRN: CAIE C,"(" REGFAL: MOVEI A,4 ;FAIL IF NO PAREN POPJ P, SUBTTL UTILITY SUBROUTINES ;ROUTINE TO QSA FOR "THEN" OR "GOTO" (USED IN "IF", "ON" STATEMENTS) THENGO: PUSHJ P,QSA ASCIZ /THE/ JRST THGOTS MOVEM T,MULLIN ;SET MULTI-LINE PUSHJ P,QSA ASCIZ /N/ JRST THGERR ;BAD SPELLING ! TLNE C,F.TERM JRST THGERR POPJ P, THGOTS: PUSHJ P,QSA ASCIZ /GOTO/ THGERR: FAIL TLNE C,F.DIG ;DIGIT FOLLOWS ? POPJ P, JRST ERDIGQ ;ERROR RETURNS SETFER: FAIL 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 /"/ ERDIGQ: PUSHJ P,FALCHR ASCIZ /a digit or "/ ERTERM: PUSHJ P,FALCHR ASCIZ /a line terminator or apostrophe/ ERLETT: PUSHJ P,FALCHR ASCIZ /a letter/ ERLPRN: PUSHJ P,FALCHR ASCIZ /(/ ERRPRN: PUSHJ P,FALCHR ASCIZ /)/ EREQAL: PUSHJ P,FALCHR ASCIZ /=/ ERCOMA: PUSHJ P,FALCHR ASCIZ /,/ ERSCCM: PUSHJ P,FALCHR ASCIZ /; or ,/ ERCLCM: PUSHJ P,FALCHR ASCIZ /: or ,/ FALCHR: PUSH P,C SETOM CRFERR PUSHJ P,EOLIN CLEARM CRFERR FAL1: PUSHJ P,INLMES ASCIZ /? / POP P,C MOVEI C,(C) CAIE C,11 CAIN C,40 JRST FALSPT CAIL C,12 CAILE C,15 JRST FLLAB1 JRST FALFF FLLAB1: 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) SETZ D, PUSHJ P,PRINT ;PRINT EXPECTED CHAR OR MESSAGE. SETZM HPOS POP P,T ;CLEAN UP PLIST. PUSHJ P,INLMES ASCIZ / was expected/ JRST FAIL2 ;COMPILATION ERROR MESSAGES FROM FAIL UUOS. FAILER: SETOM CRFERR ;SET FLAG SO EOLIN WILL POPJ BACK IN TIME PUSHJ P,EOLIN ;GO FINISH CREF LINE SETZM CRFERR ;THRU WITH FLAG NOW. 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 / / JRST INCEAC ;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, COMMA: TLNN C,F.COMA ;COMMA? JRST NXTSTA ;NO, GO FOR NEXT STATEMENT JRST NXCH ;GET NEXT CHARACTER AND RETURN RGTPAR: TLNN C,F.RPRN ;RIGHT PARENTHESIS JRST ERRPRN ;NO, GIVE ERROR JRST NXCH ;GET NEXT CHARACTER AND RETURN CSEPER: TLNN C,F.COMA CAIN C,";" JRST NXCH JRST NXTSTA LEGAL: JUMPL F,LGLAB1 TLOE F,-1 JRST ILFORM LGLAB1: 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,XFORMN GETCND: TLNN C,F.COMA CAIN C,":" JRST NXCH JRST ERCLCM GETCNA: PUSHJ P,NXCH GETCN0: JRST XFORMN PAGE SUBTTL MISC CREF OUTPUT GENERATOR ROUTINES ;COMES HERE AT END OF EACH LINE DURING SYNTAX CHECK (STATEMENT) EOLIN: PUSHJ P,OUVRNM ;OUTPUT LAST CREF VARIABLE SETZM VARNAM ;CLEAR VARIABLE NAME MOVEI C,RUBOUT PUSHJ P,OUCHX ;END OF CREF STUFF FOR THIS LINE MOVEI C,"A" ;TERMINAT WITH A TAB PUSHJ P,OUCHX ;WILL APPEAR BEFORE USERS STUFF MOVE T,FLLIN ;FLOOR OF LINE ROLL ADDI T,(L) MOVE T,(T) ;SETUP T TO POINT TO TEXT FOR THIS LINE HRLI T,440700 ;SEVEN BIT BYTE POINTER EOLP1: ILDB C,T ;SCAN AND OUTPUT TEXT LINE CAIN C,12 ;LINE FEED? JRST EOLF ;YES. PROCESS LF CAIN C,15 ;CARRIAGE RETURN? JRST EOCR ;YES. PROCESS CR PUSHJ P,OUCHX ;ANYTHING ELSE GOES RIGHT OUT JRST EOLP1 ;LOOP TO FIND CR EOCR: PUSHJ P,OUCHX ;OUTPUT CR MOVEI C,12 ;LINE FEED PUSHJ P,OUCHX ;OUTPUT LF PUSHJ P,INCLIN ;INCREMENT LINE # ETC. SETZM MULLIN ;AND UNSET MULTI-LINE SKIPE CRFERR ;COME HERE FROM FAIL UUO? POPJ P, ;YES. GO BACK TO DO ERROR MESSAGE INCEAC: AOBJN L,[PUSHJ P,BEGLN JRST EACHLN] ;INCREMENT L AND DO NEXT LINE (IF ANY) CLOSE 16, ;CLOSE CRF OUTPUT FILE MOVE C,IOJFF ;.JBFF BEFORE I/O BUFFERS MOVEM C,.JBFF ;RESTORE .JBFF SETZM OUCRFF ;ERRORS BACK TO TTY JRST CREF0 ;GO DO CREF EOLF: MOVEI C,15 ;CARRIAGE RETURN PUSHJ P,OUCHX ;OUTPUT CR MOVEI C,12 ;LINE FEED PUSHJ P,OUCHX ;OUTPUT LF PUSHJ P,INCLIN ;INCREMENT LINE # ETC. MOVEI C,RUBOUT PUSHJ P,OUCHX MOVEI C,11 ;PUT OUT A TAB PUSHJ P,OUCHX JRST EOLP1 ;KEEP OUTPUTTING TEXT FROM LINE ROLL NXLINE: MOVE T,FLLIN ;FLOOR OF LINE ROLL ADDI T,(L) MOVE T,(T) MOVS D,T HRLI T,440700 ;SETUP T TO POINT TO CURRENT LINE JRST NXCHK PAGE RUBOUT==177 OUVRNM: PUSH P,C ;SAVE C PUSH P,T ;SAVE T PUSH P,T1 ;SAVE T1 SKIPN VARNAM ;IS THERE A SYMBOL SETUP? JRST NOSYM ;NO. JUST GO SETUP POINTERS ETC. MOVEI C,1 ;^A MEANS SYMBOL BEING DEFINED PUSHJ P,OUCHX ;OUPUT CREF SYB BEING MODIFIED CHAR SETZ C, MOVE T,[POINT 7,VARNAM] OUVLPX: ILDB T1,T ;GET A CHAR FROM SYMBOL JUMPE T1,OUVEX ;NULL? AOJ C, ;NO. INCREMENT COUNT CAIE C,5 ;5 CHARS YET? JRST OUVLPX ;NO. KEEP COUNTING OUVEX: PUSHJ P,OUCHX ;OUTPUT COUNT OF CHARS IN SYMBOL ;FOR CREF MOVE T,C ;PUT COUNT IN T MOVE T1,[POINT 7,VARNAM] OUVLPY: ILDB C,T1 ;GET CHAR FROM VARIABLE PUSHJ P,OUCHX ;OUTPUT IT SOJG T,OUVLPY ;ANY LEFT? MOVEI C,2 ;NO. TELL CREF END OF SYMBOL (^B) SKIPE VARMOD ;MODIFIED VARIABLE? PUSHJ P,OUCHX ;YES. NOSYM: SETZM VARMOD ;CLEAR VARIABLE BEING MODIFIED FLAG SETZM VARNAM ;CLEAR VARIABLE NAME POP P,T1 POP P,T MOVE C,[POINT 7,VARNAM] ;POINTER TO CREF VARIABLE MOVEM C,X22 ;PUT IN X22 POINTER POP P,C ;GET CHAR BACK IDPB C,X22 ;PUT IT IN CREF VARIABLE POPJ P, ;RETURN TO CALLER PAGE ;ROUTINE TO OUTPUT CREF BEGIN CHAR + LINE NUMBER (ALWAYS 5 DIGITS) BEGLN: MOVEI C,RUBOUT ;RUBOUT B IS BEGIN CREF SIGNAL FOR LINE PUSHJ P,OUCHX MOVEI C,"B" ;BEGIN CREF STUFF PUSHJ P,OUCHX MOVEI C,17 ;^O TO TELL CREF TO USE THIS LINE# PUSHJ P,OUCHX PUSH P,T PUSH P,T1 ;SAVE T1 AND T MOVE C,FLLIN ;FLOOR OF LINE ROLL ADD C,L ;ADD LINE POINTER HLRZ T,0(C) ;GET LINE # TO AC T MOVEI C,5 ;ALWAYS 5 CHARS (PUT OUT LEADING 0'S) PUSHJ P,OUCHX COUNUM: SETZM NUMCOT ;0 TO REAL NUMBER OF CHARS IN LINE # BPR2: IDIVI T,^D10 ;START CONVERSION TO ASCII JUMPE T,BPR1 ;FINISHED WHEN ZERO PUSH P,T1 ;SAVE REMAINDER AOS NUMCOT ;INCREMENT REAL COUNT OF NO. OF CHARS JRST BPR2 ;KEEP CONVERTING TO ASCII BPR1: MOVEI C,"0" ;LEADING 0 PUSH P,T1 ;SAVE LAST REMAINDER AOS NUMCOT ;INCREMENT REAL COUNT MOVEI T,5 SUB T,NUMCOT ;THIS MANY LEADING ZERO'S NEEDED JUMPE T,BPR3 ;NO MORE LEADING ZERO'S NEEDED SKIPN NLZF ;SKIP IF DONT WANT LEADING ZERO'S PUSHJ P,OUCHX ;OUTPUT A LEADING "0" SOJG T,.-1 ;DO AS MANY AS NEEDED BPR3: POP P,C ;GET A REMAINDER ADDI C,60 ;CONVERT TO ASCII PUSHJ P,OUCHX ;OUTPUT IT SOS NUMCOT ;DECREMENT COUNT OF REAL CHARS IN # SKIPE NUMCOT ;FINISHED? JRST BPR3 ;NO. KEEP OUTPUTTING AND POPPING SKIPE NLZF ;NO LEADING ZEROS ENTRY? POPJ P, ;YES. DONT POP OFF AC'S T1&T POP P,T1 ;RESTORE T1 POP P,T ;RESTORE T POPJ P, PAGE ;OUTPUT SIXBIT INTRINSIC FUNCTION NAME IN A OUVA: PUSH P,C ;SAVE C PUSH P,T ;SAVE T PUSH P,T1 ;SAVE T1 MOVEI C,5 ;MAKE IT LOOK LIKE A MACRO CALL PUSHJ P,OUCHX ;OUTPUT CREF CONTROL CHAR SETZ C, MOVE T,[POINT 6,A] ;LOAD POINTER OUVALX: ILDB T1,T ;GET A CHAR FROM NAME JUMPE T1,OUVAX ;IF NULL NO MORE CHARS. AOJ C, ;INCREMENT COUNT IN C CAIE C,6 ;6 CHARS YET? JRST OUVALX ;NO. KEEP COUNTING OUVAX: PUSHJ P,OUCHX ;OUTPUT COUNT OF CHARS IN SYMBOL MOVE T,C ;STORE COUNT IN T MOVE T1,[POINT 6,A] ;SETUP LOAD POINTER OUVALY: ILDB C,T1 ;GET A CHAR ADDI C,40 ;CONVERT TO 7 BIT PUSHJ P,OUCHX ;OUTPUT CHAR SOJG T,OUVALY ;KEEP OUTPUTTING CHARS T TIMES JRST NOSYM ;FINISHED PUTTING OUT SYMBOL PAGE ;CREF OUTCHR ROUTINE ;ROUTINE TO INCREMENT LINE COUNT AND MAYBE PUT OUT HEADER INCLIN: AOS C,LINUM ;INCREMENT LINE COUNT CAIE C,^D58 ;58 LINES PER PAGE POPJ P, ;NOT 58 YET MOVEI C,14 ;FORM FEED PUSHJ P,OUCHX ;TO CREF OUTPUT FILE AOS PAGCNT ;INCREMENT PAGE COUNT PUSHJ P,OHEAD ;OUTPUT HEADER LINE POPJ P, PAGE ;ROUTINE TO OUTPUT PAGE HEADER FOR CREF OUTPUT OHEAD: PUSH P,T1 ;SAVE T1 PUSH P,T ;SAVE T MOVEI T,^D65 ;65 CHARS IN HEADER +PAGE # MOVE T1,[POINT 7,VBUF] ;POINTER TO HEADER BLOCK OHLP1: ILDB C,T1 ;GET CHAR FROM HEADER BLOCK PUSHJ P,OUCHX ;OUPUT TO CREF OUTPUT FILE SOJG T,OHLP1 ;DO 65 CHARACTERS SETOM NLZF ;SET NO LEADING ZEROES FLAG MOVE T,PAGCNT ;GET PAGE # PUSHJ P,COUNUM ;CONVERT TO ASCII AND OUTPUT SETZM NLZF ;CLEAR NO LEADING ZEROES FLAG MOVEI C,15 PUSHJ P,OUCHX MOVEI C,12 ;LF PUSHJ P,OUCHX PUSHJ P,OUCHX MOVEI C,2 ;RESET LINE COUNT TO 2 MOVEM C,LINUM POP P,T ;RESTORE T POP P,T1 ;RESTORE T1 POPJ P, PAGE ;ROUTINE TO PUT VERSION # IN HEADER BLOCK PVER: PUSH P,[0] ;MARK BOTTOM OF STACK LDB T,[POINT 3,.JBVER,2] ;GET USER BITS JUMPE T,GETE ;NOT SET IF ZERO ADDI T,"0" ;FORM ASCII NUMBER PUSH P,T ;STACK IT MOVEI T,"-" ;SEPARATE BY HYPHEN PUSH P,T ;STACK IT ALSO GETE: HRRZ T,.JBVER ;GET EDIT NUMBER JUMPE T,GETU ;SKIP ALL THIS IF ZERO MOVEI T1,")" ;ENCLOSE IN PARENS PUSH P,T1 ;STACK THIS TOO GETED: IDIVI T,8 ;GET OCTAL DIGITS ADDI T1,"0" ;MAKE ASCII PUSH P,T1 ;STACK IT JUMPN T,GETED ;LOOP TIL DONE MOVEI T,"(" ;OTHER PAREN PUSH P,T GETU: LDB T,[POINT 6,.JBVER,17] ;UPDATE NUMBER JUMPE T,GETV ;SKIP IF ZERO IDIVI T,^D26 ;MIGHT BE TWO DIGITS ADDI T1,"@" ;FORM ALPHA PUSH P,T1 JUMPN T,GETU+1 ;LOOP IF NOT DONE GETV: LDB T,[POINT 9,.JBVER,11] ;GET VERSION NUMBER IDIVI T,8 ;GET DIGIT ADDI T1,"0" ;TO ASCII PUSH P,T1 ;STACK IT JUMPN T,GETV+1 ;LOOP TIL DONE MOVE T1,[POINT 7,VBUF+1,20] ;POINTER TO DEPOSIT IN VBUF GTLPP: POP P,T ;GET CHARACTER FROM STACK JUMPN T,.+2 ;LOOP UNTIL NULL POPJ P, ;RETURN IDPB T,T1 ;PUT IN VBUF JRST GTLPP PAGE ;OUTPUT NUMBER IN AC N COUN: PUSHJ P,OUVRNM ;OUTPUT ANY SYMBOL THAT MAY BE STORED PUSH P,C ;SAVE C PUSH P,T ;SAVE T PUSH P,T1 ;SAVE T1 SETZM VARNAM ;CLEAR VARIABLE NAME MOVE T,N ;GET LINE # TO T MOVEI C,5 ;MAKE IT LOOK LIKE A MACRO CALL PUSHJ P,OUCHX ;OUTPUT TO CREF OUTPUT SETZ C, ;CLEAR CHAR. COUNT PUSH P,[-1] ;MARK TOP OF STACK COUN2: IDIVI T,^D10 ;START CONVERSION TO ASCII PUSH P,T1 ;STACK REMAINDER AOJ C, ;INCREMENT COUNT OF DIGITS JUMPN T,COUN2 ;LOOP TIL DONE COUN1: MOVEM C,TEMLOC ;SAVE COUNT OF REAL DIGITS MOVEI C,5 ;ALWAYS 5 DIGITS MOVEI T,5 SKIPE GOSBFL ;GOSUB LINE #? ADDI C,1 ;YES ADD A G TO LINE# PUSHJ P,OUCHX ;COUNT OF DIGITS TO CREF SUB T,TEMLOC ;FIND OUT HOW MANY LEADING 0'S JUMPE T,COUN4 ;NO MORE MOVEI C,"0" PUSHJ P,OUCHX ;OUTPUT A LEADING "0" SOJG T,.-1 COUN4: POP P,C ;GET A DIGIT JUMPL C,COUN3 ;END OF STACK? ADDI C,"0" ;NO. CONVERT TO ASCII PUSHJ P,OUCHX ;OUTPUT A DIGIT TO CREF JRST COUN4 ;LOOP FOR MORE DIGITS COUN3: MOVEI C,"G" ;INCASE GOSUB FLAG SKIPE GOSBFL ;GOSUB FLAG SET? PUSHJ P,OUCHX ;YES.OUTPUT THE "G" SETZM GOSBFL ;CLEAR GOSUB FLAG POP P,T1 ;RESTORE T1 POP P,T ;RESTORE T POP P,C ;RESTORE C POPJ P, ;RETURN PAGE INIOSX: MOVE X1,[POINT 6,C] ;SETUP POINTER TO SIXBIT WORD IN C SETZ X2 ;CLEAR COUNT INIOS2: ILDB T,X1 ;GET A SIXBIT CHAR JUMPN T,INIOS1 ;NULL? POPJ P, ;YES. RETURN INIOS1: ADDI T,40 ;NO. CONVERT TO ASCII 7 BIT IDPB T,T1 ;DEPOSIT WITH POINTER IN T1 AOS X2, ;INCREMENT COUNT CAIE X2,6 ;SIX YET? JRST INIOS2 ;NO. KEEP LOOPING POPJ P, ;YES. THRU INIONM: JUMPN X1,.+2 ;IS NO. ZERO? POPJ P, ;YES. JUST RETURN PUSH P,[-1] ;NO. OK TO MARK BOTTOM OF STACK WITH 0 INION1: IDIVI X1,^D10 ;CONVERT TO ASCII PUSH P,X2 ;STACK REMAINDER JUMPN X1,INION1 ;LOOP TIL DONE INION3: POP P,T ;GET A DIGIT JUMPGE T,INION2 ;END OF STACK? POPJ P, ;YES. RETURN INION2: ADDI T,"0" ;CONVERT TO ASCII DIGIT IDPB T,T1 ;USE T1 BYTE POINTER JRST INION3 ;LOOP FOR MORE DIGITS PAGE ;ROUTINE TO INITIALIZE HEADER BLOCK INITHD: MOVE T,[ASCII / /] ;BLANKS MOVEM T,VBUF ;TO VBUF MOVE T,[XWD VBUF,VBUF+1] ;SET UP BLT BLT T,VBUF+^D12 ;BLANKS TO ALL OF VBUF MOVE T,[ASCII /BASIC/] ; MOVEM T,VBUF ;SO KNOWS CREF FROM BASIC MOVE T,[ASCII / V /] ;TO PRECEDE VERSION # OF BASIC MOVEM T,VBUF+1 ;PUT IN VBUF+1 PUSHJ P,PVER MOVE T1,[POINT 7,VBUF+5] ;SETUP T1 WITH BYTE POINTER MOVE C,CURDEV ;DEVICE IN SIXBIT PUSHJ P,INIOSX ;CONVERT TO 7 BIT MOVEI T,":" IDPB T,T1 ;TO FOLLOW DEVICE MOVE C,CURNAM ;SIXBIT NAME PUSHJ P,INIOSX ;CONVERT AND STORE MOVEI T,"." IDPB T,T1 ;FOLLOWS NAME HLLZ C,CUREXT ;SIXBIT EXTENSION PUSHJ P,INIOSX ;CONVERT AND STORE MOVE T1,[POINT 7,VBUF+10] ;POINTER FOR TIME AND DATE MOVE X1,[XWD 61,11] ;HOUR GETTAB X1, HALT PUSHJ P,INIONM ;OUTPUT HOUR MOVEI C,":" IDPB C,T1 MOVE X1,[XWD 62,11] ;MINUTES GETTAB X1, HALT PUSHJ P,INIONM ;CONVERT AND STORE MOVEI C," " IDPB C,T1 MOVE X1,[XWD 60,11] ;DAY GETTAB X1, HALT PUSHJ P,INIONM MOVEI C,"-" IDPB C,T1 MOVE X1,[XWD 57,11] ;MONTH GETTAB X1, HALT MOVE C,MONTAB-1(X1) ;GET SIXBIT MONTH PUSHJ P,INIOSX MOVEI C,"-" IDPB C,T1 MOVE X1,[XWD 56,11] ;YEAR GETTAB X1, HALT PUSHJ P,INIONM MOVE C,[ASCII /PAGE /] MOVEM C,VBUF+^D12 MOVEI C,1 MOVEM C,PAGCNT ;INIT PAGE COUNT TO 1 PUSHJ P,OHEAD ;OUTPUT HEADER POPJ P, MONTAB: SIXBIT/JAN/ SIXBIT /FEB/ SIXBIT /MAR/ SIXBIT /APR/ SIXBIT /MAY/ SIXBIT /JUN/ SIXBIT /JUL/ SIXBIT /AUG/ SIXBIT /SEP/ SIXBIT /OCT/ SIXBIT /NOV/ SIXBIT /DEC/ PAGE STANSW==0 ;STANFORD ASSEMBLY ;This program is based on CREF, a program Copyright 1968, 1969, 1970, ;1971, 1972, 1973, 1974, by Digital Equipment Corporation, Maynard, ;Massachusetts. The extent of the improvements over the original ;justify calling this a a different program. ; ; Ralph E. Gorin ; Stanford University Artificial Intelligence Laboratory ; Stanford, California ; COPYRIGHT (C) 1974 BY DIGITAL EQUIPMENT CORP, MAYNARD, MASS. IFNDEF CFP, IFNDEF STANSW, ;SET TO 1 FOR STANFORD A.I. LAB FEATURES IFN STANSW, ; IFNDEF SEGSW, ;SET TO 1 FOR TWO-SEGMENT SHARABLE ASSEMBLY IFNDEF TEMPC, ;SET TO 1 TO ALLOW TMPCOR UUO HASH==145 SUBTTL REVISION HISTORY ;17 ----- MODIFY FOR FORTRAN-10 VERSION 2 ;20 ----- MODIFY THE DEC VERSION FOR FULL FAIL FEATURES REG 5/18/74 ;21 ----- MODIFY FOR (ALGOL) LONG SYMBOLS DGS 3/13/75 SUBTTL SYMBOLIC DEFINITIONS EXTERNAL .JBFF, .JBREL EXTERNAL SAVII,SAVE11 EXTERNAL VARNAM,X22,VARMOD,MRDFL EXTERNAL TEMLOC,FSTPNT,LINUM,CRBUF,VBUF,PAGCNT,NLZF EXTERNAL TTYCRF,GOSBFL,OUCHX,OUCRFF,CRFERR INTERNAL CREF ;ACCUMULATOR DEFINITIONS AC0=0 ;THIS HAD BETTER ALWAYS BE ZERO! TEMP=1 TEMP1=2 WPL=3 ;CONTAINS COUNT OF HOW MANY REFERENCES/LINE IN LISTING RC=WPL SX=4 BYTEX=7 BYTEM=10 TX=BYTEM C=5 CS=6 LINE=11 ;HOLDS LINE # FLAG=12 FREE=13 ;POINTS TO HIGH END OF INCREMENT BYTE TABLE SYMBOL=14 ;POINTS TO ENTRY COUNT AT LOW END OF SYMBOL TABLE TEMPX=15 IO=16 ;HOLDS FLAGS P=17 ;PUSH DOWN POINTER ;DEFINITIONS FOR LENGTHS OF LINES AND PAGES WPLLPT==^D14 ;IN OUTPUT LPT LISTING, 14 REFERENCES/LINE IFN STANSW,< WPLLPT==^D10 > ;(NARROW LPT) WPLTTY==^D8 ;IN OUTPUT TTY LISTING, 8 REFERENCES/LINE .LPP==^D53 ;LINES PER PAGE IN LISTING SUBTTL BIT DEFINITIONS FOR FLAGS IN ACCUMULATOR "IO" IOLST== 000001 ;IF 1, SUPPRESS PROGRAM LISTING IOSAME==000002 ;SET TO 1 WHEN NEXT SYMBOL TO OUTPUT NEEDS A BLOCK NAME IOPAGE==000004 ;IF 1, DO A FORM FEED IOFAIL==000010 ;1 IF "NEW STYLE" CREF DATA HAS BBEN SEEN IODEF== 000020 ;1 IF SYMBOL IS A DEFINING OCCURRANCE ; IOENDL==000040 ;REPLACED BY M0XCT FEATURE IOCCL== 000100 ;1 IF CCL SYSTEM IN USE (SET BY STARTING AT (.JBSA)+1) IOTABS==000200 ;"RUBOUT A" SEEN AT END OF CREF DATA (INSERT TAB IN LISTING) IOEOF== 000400 ;END OF FILE SEEN ; IONLZ== 001000 ;LEADING ZERO TEST, HANDLED BY RECODING OUTASC IOTB2== 002000 ;FOR F4 IOLSTS==004000 ;SET IF PROGRAM OUTPUT IS BEING SUPPRESSED IOERR== 010000 ;IMPROPER INPUT DATA SEEN ; ROOM FOR ANOTHER IOSYM== 040000 ;SYMBOL DEFINED WITH = OR : IOMAC== 100000 ;MACRO NAME IOOP== 200000 ;OPDEF, OP CODE, OR PSEUDO INSTRUCTION OCCURRANCE IOPROT==400000 ;1 IF INPUT 'CRF' OR 'LST' FILE IS PROTECTED BY /P SWITCH IODF2== 020000 ;DEFINING OCCURRANCE OF A SYMBOL. FLAG IN REGISTER SX ONLY! ;DEFINITIONS FOR "OLD STYLE" CODES FROM VARIOUS PROCESSORS %OP==33 %EOF==37 ;MULTIPLE-PROGRAM BREAK CHARACTER CHAR==2 ;INPUT DEVICE NUMBER LST==3 ;LISTING DEVICE NUMBER ;DEFINITION FOR "NEW STYLE" CODES I.BEGN=="B" ;[17] ALL NEW STYLE CREF INFO BEGINS WITH ;[17] B I.FTAB=="A" ;[17] END CREF INFO WITH LINE # AND TAB I.FNTB=="C" ;[17] END CREF INFO WITH LINE # BUT NO TAB I.FINV=="D" ;[17] DO NOT PRINT ANYTHING AFTER CREF INFO I.BRK=="E" ;[17] SUBROUTINE BREAK - OUTPUT CURRENT ;[17] INFORMATION NOW AND RESET I.NLTB=="F" ;[21] NO LINE NUMBER, NO TAB ; COMMAND STRING ACCUMULATORS ACTXT==0 ;STORES TEXT FOR DEVICES, FILENAMES, EXT. ACDEV==1 ;DEVICE ACFILE==2 ;FILE ACEXT==3 ;EXTENSION ACDEL==4 ;DELIMITER ACPNTR==5 ;BYTE POINTER ACPPN==6 ;HOLDS PROJ,PROG FOR COMMAND SCANNER ;C=7 ;INPUT TEXT CHARACTER ;CS=10 ACTMP==11 ;TEMP AC TIO==15 ;HOLDS MTAPE FLAGS ;IO=16 ;CREF FLAGS SET BY COMMAND SCANNER ;P=17 ;PUSH DOWN POINTER ;FLAGS USED IN AC TIO ;MNEMONIC FOR ERROR MESSAGES ;MNEMONIC SEVERITY MEANING ;CRFIDC WARNING IMPROPER INPUT DATA ;CRFXKC INFORMATION SIZE OF LOW SEGMENT IN K OF CORE ;CRFCFF FATAL CANNOT FIND FILE ;CRFCFE FATAL COMMAND FILE INPUT ERROR ;CRFINE FATAL INPUT ERROR ;CRFOUE FATAL OUTPUT ERROR ;CRFDNA FATAL DEVICE NOT AVAILABLE ;CRFCEF FATAL CANNOT ENTER FILE ;CRFIMA FATAL INSUFFICIENT MEMORY AVAILABLE ;CRFCME FATAL COMMAND ERROR ;CRFBTB FATAL BUFFERS TOO BIG SUBTTL INITIALIZATION CREF0: CREF: MOVE ACTMP,.JBFF ;SAVE JOBFF MOVEM ACTMP,SVJFF ;THE END OF ONE CCL COMMAND LINE AND THE BEGINNING OF THE NEXT ;RETURNS TO HERE. THE INPUT COMMAND BUFFER IS PRESERVED. THE ;OUTPUT AND INPUT FILE BUFFERS ARE RECLAIMED PRIOR TO PROCESSING ;THE NEXT CCL COMMAND LINE. RETCCL: TLO IO,IOPAGE!IOSYM!IOMAC SETZM STCLR ;CLEAR FIXED DATA AREA MOVE 0,[XWD STCLR,STCLR+1] BLT 0,ENDCLR HLLOS UPPLIM ;ASSUME VERY LARGE UPPER LIMIT MOVE AC0,[TDNN IO,SX] ;SETUP M6X MOVEM AC0,M6X ;SKIP IF WE'RE CREFING THIS KIND OF SYM MOVSI ACDEV,'DSK' SKIPE TTYCRF ;WANT CREF ON TTY? MOVSI ACDEV,'TTY' ;YES. USE TTY MOVEM ACDEV,LSTDEV ;STORE DEV IN LSTDEV SUBTTL INITIALIZATION - LSTSET - SETUP DESTINATION DEVICE LSTS2: MOVE ACTMP,SYNERR MOVEM ACTMP,OFLAG3 ;SAVE ERROR FLAG MADEIT: MOVEM TIO,OFLAG ;SAVE SWITCHES MOVEM CS,OFLAG1 MOVEM C,OFLAG2 INSET2: MOVE TIO,OFLAG ;GET FLAGS BACK MOVE CS,OFLAG1 MOVE C,OFLAG2 DOOPN: MOVEI ACTMP,0 MOVSI ACTMP+1,'DSK' MOVEI ACTMP+2,INBUF ;BUFFER HEADER OPEN CHAR,ACTMP ;OPEN INPUT DEVICE JRST OPNERR ;BETTER BE A DSK INBUF CHAR,2 ;2 INPUT BUFFERS MOVE ACTMP,[SIXBIT /BASUSR/] MOVEM ACTMP,INDIR MOVSI ACTMP,'CRF' MOVEM ACTMP,INDIR+1 LOOKUP CHAR,INDIR HALT ;BETTER BE A FILE. MOVEI ACTMP,0 ;INIT DEVICE IN ASCII MODE MOVE ACTMP+1,LSTDEV MOVSI ACTMP+2,LSTBUF ;BUFFER HEADER ADDRESS OPEN LST,ACTMP ;TRY TO INIT DEVICE JRST OPNERR GDOPN: OUTBUF LST,2 ;MAKE BUFFERS MOVE ACTMP,CURNAM MOVEM ACTMP,INDIR MOVSI ACTMP,'LST' MOVEM ACTMP,INDIR+1 SETZM INDIR+2 SETZM INDIR+3 ENTER LST,INDIR JRST NOCREF MOVEI ACTMP+1,LST ;USE CHANNEL NYMBER DEVCHR ACTMP+1, ;GET OUTPUT DEVICE CHARACTERISTICS MOVEI ACTMP,WPLLPT ;ASSUME LINES FOR LPT TLNE ACTMP+1,10 ;IS DEVICE REALLY TTY? MOVEI ACTMP,WPLTTY ;YES. SET UP LINES FOR TTY MOVEM ACTMP,.WPL ;SAVE NUMBER OF ENTRIES/LINE TLNE ACTMP+1,10 ;SKIP IF NOT TTY SKIPA ACTMP,[CAIE C,12] ;WRITE LINE-BY-LINE ON TTY. MOVSI ACTMP,() MOVEM ACTMP,WRITEX ;SET INSTR. TO XCT TO EXIT FROM WRITE. LSTSE4: MOVSI ACTMP,() ;OUTPUT INSTRUCTION FOR ALL EXCEPT MTA. MOVEM ACTMP,DMPXCT ;SET OUTPUT INSTRUCTION INSET3: MOVE C,[SOSG LSTBUF+2] ;SET UP WRITE ENTRANCE INSTRUCTION MOVEM C,WRITEE SUBTTL PROCESS CREF INPUT FILE MOVEI FREE,BLKST-1 MOVEM FREE,BLKND ;INITIALIZE FOR COMBG RECYCL: HRRZ FREE,.JBFF ;RETURN FOR MULTIPLE F4 PROGS ADDI FREE,1 TRZ FREE,1 ;MAKE SURE FREE STARTS OUT EVEN MOVEM P,PPSAV ;SAVE P IN CASE OF IMPROPER INPUT DATA SETZM FSTPNT MOVEI LINE,1 CAMGE LINE,LOWLIM TLO IO,IOLST ;WE DON'T WANT LISTING YET. LOWLIM>LINE TLNN IO,IOLST ;LISTING SUPPRESSED? SKIPA C,[WRITE] MOVEI C,CPOPJ MOVEM C,AWRITE ;WRITE BY PUSHJ P,@AWRITE. MOVSI C,() MOVEM C,M0XCT ;SET UP INSTRUCTION FOR M0 PUSHJ P,READ ;TEST FIRST CHARACTER CAIE C,%EOF ;PROGRAM BREAK? JRST M2A ;NO, PROCESS JRST M2 ;YES, BYPASS IFE CFP,< NOTINF: SKIPA TEMP,[177] ;HERE TO INSERT RUBOUT (WASN'T NEW FORMAT) M0A: MOVEI TEMP,11 ;HERE TO INSERT TAB EXCH C,TEMP PUSHJ P,@AWRITE> IFN CFP, MOVSI C,() MOVEM C,M0XCT ;SET UP INSTRUCTION FOR M0 MOVEI C,(TEMP) M0: XCT M0XCT ;WRITE NORMAL CHARACTER. (JFCL, OR JRST M0A) M1: PUSHJ P,@AWRITE ;WRITE CHARATER M2: PUSHJ P,READ ;READ NEXT M2A: CAIN C,177 ;RUBOUT? JRST FAILM ;YES. PROBABLY NEW STYLE CREF CAILE C,%EOF ;MIGHT THIS BE A SPECIAL CHARACTER. JRST M0 ;NO WAY. THIS HAS TO BE NORMAL. CAIL C,%OP ;IN RANGE FOR OLD-STYLE CREF? JRST M2C ;YES. SPECIAL CHARACTER FOR OLD-STYLE CREF CAIN C,12 ;LF? JRST M1 ;PASS IT DIRECTLY CAIE C,15 ;CR? JRST M0 ;NO. THIS IS NOT ANY SPECIAL CHARACTER. IFE CFP,< MOVE TEMP,[JRST M0A] TLNE IO,IOTABS!IOTB2 ;HANDLE CR. TAB FLAGS ON? MOVEM TEMP,M0XCT> ;YES. ARRANGE TO WRITE TAB LATER JRST M1 ;GO WRITE CR. ;DISPATCH FOR OLD-STYLE CREF. XCT'ED FROM M2C+4 MTAB: MOVSI SX,IOOP ;33 OPCODE REF MOVSI SX,IOMAC ;34 MACRO REF SKIPA C,LINE ;35 END OF LINE MOVSI SX,IOSYM ;36 SYMBOL REF JRST R0 ;37 BREAK BETWEEN PROGRAMS ;HERE FOR OLD-STYLE CREF FORMAT M2C: TLNE IO,IOFAIL ;ARE WE DOING NEW-STYLE ALREADY? JRST M0 ;YES. THEN THESE AREN'T SPECIALS MOVSI TEMP,() MOVEM TEMP,M0XCT ;SEEN TEXT ON LINE. FLUSH TAB INSERTION INSTR. TLO IO,IOTB2 ;NEED TAB XCT MTAB-%OP(C) ;(CAN SKIP) JRST M3 ;FLAG SET. GOBBLE SYMBOL NAME M2B: TLNE IO,IOLSTS ;PERMANENT LISTING SUPPRESS? AOJA LINE,M2 ;YES. JUST INCREMENT LINE AND READ MORE CAML LINE,LOWLIM ;LINE ABOVE LOWER LIMIT? CAMLE LINE,UPPLIM ;YES. SKIP IF BELOW HIGH LIMIT TLOA IO,IOLST ;ASSUME OUT OF BOUNDS TLZA IO,IOLST ;LINE IN BOUNDS, CLEAR LISTING SUPPRESS SKIPA TEMP,[CPOPJ] ;SUPPRESS OUTPUT MOVEI TEMP,WRITE MOVEM TEMP,AWRITE ;PUSHJ P,@AWRITE TO OUTPUT A CHARACTER TLNE IO,IOLST AOJA LINE,M2 PUSHJ P,CNVRT ;WRITE LINE NUMBER MOVEI C,11 TLNE IO,IOTABS ;NEED TO DO TABS? PUSHJ P,WRITE ;YES. WRITE A TAB AOJA LINE,M2 ;OLD STYLE-CREF. GOBBLE SYMBOL M3: MOVEI AC0,0 ;ACCUMULATE SIXBIT LEFT ADJUSTED IN AC0 MOVSI TEMP,440600 ;BYTE POINTER TO AC0 M4: PUSHJ P,READ ;GET CHARACTER. CAIGE C,40 JRST M5A ;NOT SIXBIT. THIS BREAK DEFINES END OF SIXBIT SUBI C,40 ;CONVERT ASCII TO SIXBIT TLNE TEMP,770000 ;SKIP IF AC0 FULL IDPB C,TEMP ;STUFF CHARACTER JRST M4 ERROR: MOVE P,PPSAV ;RESTORE P TLOE IO,IOERR ;ANY ERRORS ALREADY? JRST M2 ;YES. DON'T REPORT AGAIN MOVEI RC,[SIXBIT /%CRFIDC Improper input data at line @/] PUSHJ P,PNTMSG ;IDENTIFY MESSAGE MOVE C,LINE ;TELL WHAT LINE # PUSHJ P,ECNVRT MOVEI RC,[SIXBIT / - continuing@/] PUSHJ P,PNTM0 ;IDENTIFY MESSAGE. OUTSTR CRLF JRST M2 ;TRY TO CONTINUE M5A: JUMPE AC0,ERROR ;ERROR IF ZERO CAIN C,33 ;SPECIAL BREAK CHARACTER? TLO IO,IODEF ;YES. THIS SYMBOL IS BEING DEFINED. PUSH P,[M2] ;SET RETURN ADDRESS FROM M6/SRCH. FALL INTO M6 M6: XCT M6X ;TDNN IO,SX -- SKIP IF WE'RE CREFFING THIS ; KIND OF SYMBOL, OR, ; POPJ P, -- LISTING RANGE IS EMPTY. POPJ P, ;NOT CREFFING THIS KIND OF SYMBOL CAML LINE,LOWLIM CAMLE LINE,UPPLIM TDZA FLAG,FLAG ;OUT OF BOUNDS MOVSI FLAG,400000 ;FLAG THAT SYMBOL WAS USED INSIDE RANGE OF INTEREST SUBTTL SEARCH FOR A SYMBOL, ENTER ANOTHER REFERENCE COMMENT $ There are 3 tables (symbols, opcodes, and macros). Each is indexed by a hash code. The table entry points to a chain of symbol-entry blocks. Each symbol-entry block is 4 words: 0/ Sixbit symbol name 1/ link-out to next 2/ byte(1)flag(17)lastline(18)refchain 3/ AUXHEAD,,AUXTAIL, later becoming: AUXHEAD,,block name addr Flag is on if this symbol was ever seen within the line-limit range. lastline: the last line number on which this symbol was used. Auxhead and Auxtail are pointers to auxiliary refchains which must be output before the main refchain. the refchain points to a 2-word block: 0/ byte pointer to next rd 1/ byte(6)rfb,rd1,rd2(18)link to next refchain entry subsequent 2-word blocks on the refchain contain 9 6-bit bytes of rd, and an 18-bit link-out. The rd are reference-data, which are differential line numbers, with a bit to specify reference/definition. The rd are stored radix 32 (decimal), with a bit in each 6-bit byte to specify continuation/lastbyte. Differential line number = 2*(this line - last line where used) + if reference then 1 else 0 $ SRCH: MOVEI C,1 ;SET UP SOME BITS TO SAVE CODE AND TIME TLZE IO,IODEF ; LATER MOVEI C,2 MOVEM C,REFBIT ;2=DEFINING OCCURENCE, 1= REFERENCE ANDI C,1 MOVEM C,REFINC ;0=DEFINING OCCURENCE, 1= REFERENCE MOVE BYTEX,AC0 ;GET SIXBIT TLNN BYTEX,770000 ; [21] POINTER TO LONG SYMBOL ? MOVE BYTEX,(BYTEX) ; [21] YES - GET FIRST WORD. IDIVI BYTEX,HASH MOVMS TX TLNE SX,IOOP ;SELECT APPROPRIATE TABLE MOVEI TX,OPTBL(TX) ;SEARCH CORRECT ONE TLNE SX,IOMAC MOVEI TX,MACTBL(TX) TLNE SX,IOSYM MOVEI TX,SYMTBL(TX) SKIPN SX,(TX) ;SEARCH FOR SYMBOL JRST NTFND ;NONE THERE. TLNN AC0,770000 ; [21] LONG SYMBOL ? JRST LNSRCH ; [21] YES - DO SEPARATELY CAMN AC0,(SX) ;MATCHES FIRST SYMBOL? JRST STV10B ;YES. (AVOID MOVING SYM TO FRONT OF CHAIN) SKIPN BYTEX,1(SX) ;ADVANCE TO NEXT. JRST NTFND ;NOT FOUND. SRCH1: CAMN AC0,(BYTEX) ;MATCH? JRST STV9 ;YES. (BYTEX=CURRENT, SX=PREVIOUS) SKIPN SX,1(BYTEX) JRST NTFND CAMN AC0,(SX) ;SEARCH HASH CHAIN FOR SYMBOL JRST STV10 ;GOT IT (SX=CURRENT, BYTEX=PREVIOUS) SKIPE BYTEX,1(SX) ;SEARCH NEXT (BYTEX=CURRENT, SX=PREVIOUS) JRST SRCH1 ;KEEP LOOKING NTFND: SKIPE SX,FSTPNT ;FAILURE. MAKE NEW ENTRY FOR THIS SYM. JRST [MOVE BYTEX,1(SX) ;GET 4-WORD BLOCK FROM FREE STORAGE MOVEM BYTEX,FSTPNT ;RESET FREE STG JRST NTFND1] MOVE SX,FREE ;OTHERWISE, GET 4-WORDS FROM END OF MEM. ADDI FREE,4 ;GET A SPACE TO PUT NEW SYMBOL CAML FREE,.JBREL PUSHJ P,XCEED ;GET MORE CORE NTFND1: MOVEM AC0,(SX) ;STORE SIXBIT FOR SYMBOL MOVE BYTEX,(TX) ;GET FIRST LINK ON THIS CHAIN MOVEM BYTEX,1(SX) ;STORE THAT IN OUR LINK-OUT MOVEM SX,(TX) ;STORE OUR ADDRESS AT HEAD OF CHAIN SETZM 3(SX) MOVE TX,FREE ;NEXT, WE NEED A 2-WORD BLOCK ADDI FREE,2 CAML FREE,.JBREL PUSHJ P,XCEED SETZM 1(TX) MOVEI BYTEX,1(TX) HRLI BYTEX,() ;POINTER FOR DEPOSITING RD (REF DATA) MOVE C,REFBIT ;2=DEFINED, 1=REFERNCED DPB C,[POINT 6,1(TX),5] ;DEPOSIT REFTYPE BITS MOVE C,LINE LSH C,1 IOR C,REFINC ;LINE*2+(IF REF THEN 1 ELSE 0); LAST REFLINE HRLM LINE,2(SX) ;STORE LASTLINE ON WHICH REF OCCURED. HRRM TX,2(SX) ;ADDRESS OF REFCHAIN JRST STV12 LNSRCH: ; LONG SYMBOL - AC0 IS POINTER ; SX IS HEAD OF HASH-CHAIN HLRZ C,AC0 ; [21] GET LENGTH HLRZ TEMP,(SX) ; [21] GET LENGTH OF FIRST-OF-CHAIN CAIE C,(TEMP) ; [21] = ? JRST LNSRC1 ; [21] NO - NO CHANCE PUSHJ P,COMPLN ; [21] YES - COMPARE NAMES JRST STV10B ; [21] = - DON'T BOTHER TO MOVE TO HEAD LNSRC1: MOVE BYTEX,SX ; [21] ADVANCE SKIPN SX,1(SX) ; [21] TO NEXT JRST NTFND ; [21] END OF CHAIN - NOT FOUND HLRZ TEMP,(SX) ; [21] GET LENGTH CAIE C,(TEMP) ; [21] SAME ? JRST LNSRC1 ; [21] NO - TRY NEXT PUSHJ P,COMPLN ; [21] YES - COMPARE NAMES JRST STV10 ; [21] = - DONE JRST LNSRC1 ; [21] NOT - TRY AGAIN COMPLN: ; COMPARE LONG NAMES. POINTERS IN (SX) & AC0. SKIP IF NOT =. ; LENGTHS ARE = ON ENTRY, IN C (WORDS) ; PRESERVE BYTEX,SX,AC0, C(UNLESS =) HRRZM AC0,L1 ; [21] SAVE ADDRESS 1 MOVE TEMP,(SX) ; [21] GET, & HRRZM TEMP,L2 ; [21] SAVE ADDRESS 2 CMPLN1: MOVE TEMP,@L1 ; [21] COMPARE CAME TEMP,@L2 ; [21] A WORD JRST CMPLN2 ; [21] UNEQUAL AOS L1 ; [21] ADVANCE AOS L2 ; [21] ADDRESSES SOJG C,CMPLN1 ; [21] & LOOP, UNLESS DONE HRRZ C,AC0 ; [21] EQUAL - RETURN NEW BUFFER HLRZ AC0,AC0 ; [21] C:=POINTER; AC0:=LENGTH; LSH AC0,-2 ; [21] AC0:= # OF 4-WORD BLOCKS CMPLN3: MOVE TEMP,C ; [21] ADDR OF 4-WORD BLOCK EXCH TEMP,FSTPNT ; [21] CHAIN INTO MOVEM TEMP,1(C) ; [21] FREE CORE CHAIN ADDI C,4 ; [21] ADVANCE TO NEXT BLOCK, SOJG AC0,CMPLN3 ; [21] IF ANY POPJ P, ; [21] SAY EQUAL CMPLN2: HLRZ C,AC0 ; [21] RESTORE C AOS (P) ; [21] AND SKIP POPJ P, ; [21] RETURN ;MOVE SX TO HEAD OF LIST. STV9: EXCH SX,BYTEX ;MAKE SX=CURRENT, BYTEX=PREVIOUS STV10: MOVE C,(TX) ;GET LIST-HEAD EXCH C,1(SX) ;SAVE THAT IN OUR LINKOUT MOVEM C,1(BYTEX) ;OUR OLD LINKOUT INTO PREVIOUS LINKOUT MOVEM SX,(TX) ;OUR ADDRESS IN LIST HEAD STV10B: LDB C,[POINT 17,2(SX),17] ;GET LINE NUMBER OF PREVIOUS REFERENCE HRRZ TX,2(SX) ;POINTER TO REFCHAIN CAME C,LINE ;LAST LINE THE SAME AS THIS LINE? JRST STV10A ;NOPE. LDB TEMP,[POINT 6,1(TX),5] ;GET THE REFERENCE TYPE BITS TDOE TEMP,REFBIT ;TURN ON A BIT FOR THIS TYPE OF REFERENCE POPJ P, ;THIS KIND OF REF EXISTS ALREADY. JRST STV10C STV10A: MOVE TEMP,REFBIT ;SET REFERENCE/DEFINITION TYPE STV10C: DPB TEMP,[POINT 6,1(TX),5] ;STORE REFTYPE DPB LINE,[POINT 17,2(SX),17] ;STORE CURRENT LINE NUMBER SUBM LINE,C ;C_(CURRENT LINE-PREVIOUS REF LINE) LSH C,1 ;DOUBLE DIFFERENCE IOR C,REFINC ;PLUS 1 IF REFERENCE MOVE BYTEX,0(TX) ;GET THE BYTE POINTER ;HERE C= 2*(THIS LINE-PREVIOUS REF LINE)+(IF DEFINING THEN 0 ELSE 1) ;BYTEX=BYTE POINTER FOR RD (REF DATA) ;CONTENTS OF C ARE STORED AS RADIX =32 BYTES, WITH THE 40 BIT ON IN EVERY ;BYTE BUT THE LAST. THESE BYTES ARE STORED IN 6-BIT FIELDS. STV12: ORM FLAG,2(SX) ;STORE FLAG (SIGN BIT) CAIGE C,40 JRST STV20 ;SMALL OPTIMIZATION MOVEM P,PPTEMP STV14: IDIVI C,40 PUSH P,CS CAIL C,40 JRST STV14 STV16: TRO C,40 PUSHJ P,STV20 POP P,C CAME P,PPTEMP JRST STV16 ;HERE WITH C CONTAINING A BYTE OF REFERENCE DATA STV20: TRNE BYTEX,1 ;SKIP END-TEST IF EVEN WORD CAML BYTEX,[POINT 6,0,16] ;AT END? JRST STV22 ;NOT AT END (OF 9-BYTE RD STRING) HRRM FREE,0(BYTEX) ;STORE FREE POINTER INTO REFCHAIN MOVE BYTEX,FREE ;SET BYTE POINTER TO POINT AT FREE HRLI BYTEX,() ADDI FREE,2 ;INCREMENT FREE POINTER CAML FREE,.JBREL PUSHJ P,XCEED STV22: IDPB C,BYTEX ;STOW BYTE MOVEM BYTEX,0(TX) ;AND BYTE POINTER POPJ P, SUBTTL HANDLE NEW-STYLE INPUT ;HERE TO READ A SYMBOL NAME FREAD: PUSHJ P,READ ;READ A LABEL. GET CHARACTER COUNT MOVEI TEMP1,(C) ;SAVE CHARACTER COUNT SETZM FRDTMP ;ACCUMULATE SIXBIT HERE. MOVE AC0,[POINT 6,FRDTMP] ;POINTER FOR 6-BIT DEPOSIT FM4: PUSHJ P,READ ;GET A CHARACTER SUBI C,40 ;CONVERT TO SIXBIT TLNN AC0,770000 ; [21] IF WORD IS EXHAUSTED JRST LNGSYM ; [21] GO HANDLE LONG SYMBOL IDPB C,AC0 ;STUFF THIS CHARACTER SOJG TEMP1,FM4 ;LOOP WHILE CHARACTER COUNT LASTS LB2: MOVE AC0,FRDTMP ;LOAD RESULT INTO AC0 (AC0=0 - DON'T DO SKIPN) JUMPE AC0,ERROR ;ERROR IF ZERO. POPJ P, FAILM: PUSHJ P,READ ;177 SEEN. GET THE NEXT. CAIN C,I.BRK ;[17] BREAK BETWEEN FORTRAN SUBROUTINES? JRST R0 ;YES. FLUSH PRESENT CREF DATA AND REINITIALIZE CAIE C,I.BEGN ;IS THIS THE START JRST NOTINF ;NO. PUT THE 177 INTO THE OUTPUT STREAM TLO IO,IOFAIL ;THIS IS A NEW-STYLE PROGRAM FM2: PUSHJ P,READ ;GET NEXT CAIN C,177 ;RUBOUT? JRST TEND ;YES. CHECK FOR END CAILE C,DTABLN ;IN RANGE? JRST ERROR ;FOO! XCT DTAB-1(C) ;EXCECUTE SPECIFIC FUNCTION JUMPE SX,FM2 ;JUMP IF NO FLAGS WERE SET - GOBBLE MORE CREF DATA TLZE SX,IODF2 ;DO WE WANT TO DEFINE IT? TLO IO,IODEF ;YES, SET REAL DEFINITION FLAG PUSHJ P,FREAD ;GET THE SYMBOL NAME FM6: PUSHJ P,M6 ;GO ENTER SYMBOL JRST FM2 TEND: MOVE AC0,SVLAB ;IS THERE A LABEL TO PUT IN? JUMPE AC0,TEND1 ;NO. SETZM SVLAB ;CLEAR SAVED LABEL MOVSI SX,IOSYM PUSHJ P,M6 ;PUT THE LABEL IN TEND1: PUSHJ P,READ ;CHECK FOR VALID END CHARACTER CAIN C,I.FINV ; JRST M2 ;177D JUST GOBBLE CREF INFO BUT NO LINE NUMBER MOVSI TEMP,() MOVEM TEMP,M0XCT ;INFORMATION WAS SEEN ON LINE. FLUSH TAB WRITER CAIN C,I.NLTB ;[21] NO LINE NUMBER, NO TAB JRST M2 ;[21] YES. CAIN C,I.FTAB TLOA IO,IOTABS ;TAB AFTER LINE NUMBER CAIN C,I.FNTB ;OTHER LEGAL END CHARACTER? SKIPA C,LINE ;LEGAL END CHARACTER. C GETS LINE NUMBER JRST ERROR ;LOSE - ILLEGAL INPUT FORMAT JRST M2B ;GO WRITE THE LINE NUMBER ;DISPATCH TABLE FOR SPECIAL CHARACTERS (1-17) DTAB: JRST SETLAB ; ^A=1 PREVIOUS SYMBOL IS REFERENCED JRST DLAB ; ^B=2 PREVIOUS SYMBOL IS DEFINED MOVSI SX,IOOP ; ^C=3 OPCODE REFERENCE - GOBBLE NAME MOVSI SX,IOOP!IODF2 ; ^D=4 OPCODE DEFINITION - GOBBLE NAME MOVSI SX,IOMAC ; ^E=5 MACRO REFERENCE MOVSI SX,IOMAC!IODF2 ; ^F=6 MACRO DEFINITION SETZB SX,SVLAB ; ^G=7 FAIL TAKES BACK A MISTAKEN OCCURANCE JRST COMBIN ; ^H=10 COMBINE TWO FIXUP CHAINS FOR FAIL JRST DEFSYM ; ^I=11 DEFINE SYMBOL (CHANGE NUMBER TO NAME) JRST ERROR ; ^J=12 LF JRST DEFMAC ; ^K=13 DEFINE MACRO (CHANGE NUMBER TO NAME) JRST ERROR ; ^L=14 FF JRST BBEG ; ^M=15 BLOCK BEGIN JRST BBEND ; ^N=16 BLOCK END JRST SETLIN ; ^O=17 READ LINE NUMBER FROM FILE DTABLN==.-DTAB SUBTTL LONG SYMBOLS. LNGSYM: PUSH P,TEMP ; [21] SAVE AN AC MOVEI AC0,6(TEMP1) ; [21] ALLOW FOR 6 ALREADY DONE IDIVI AC0,6 ; [21] LENGTH SKIPE TEMP ; [21] IN ADDI AC0,1 ; [21] WORDS TRNE AC0,1 ; [21] MAKE IT EVEN *** MUST BE *** ADDI AC0,1 ; [21] TRNE AC0,2 ; [21] MAKE MULTIPLE OF 4 ADDI AC0,2 ; [21] MOVE TEMP,FREE ; [21] GET ADD FREE,AC0 ; [21] SOME CAML FREE,.JBREL ; [21] CORE, IF PUSHJ P,XCEED ; [21] NEEDED. HRLZ AC0,AC0 ; [21] HRR AC0,TEMP ; [21] EXCH AC0,FRDTMP ; [21] SAVE WORD-COUNT,,PNTR, GET 1ST WORD MOVEM AC0,(TEMP) ; [21] SAVE 1ST WORD OF SYMBOL IN BUFFER ADD TEMP,[ POINT 6,1] ; [21] FORM BYTE-POINTER TO 2ND WORD LB0: IDPB C,TEMP ; [21] PUT CHARACTER AWAY SOJLE TEMP1,LB1 ; [21] SEE IF DONE PUSHJ P,READ ; [21] NOT - GET NEXT CHARACTER SUBI C,40 ; [21] TO SIXBIT JRST LB0 ; [21] AND LOOP LB1: TLNN TEMP,770000 ; [21] WHOLE WORD ? JRST LB3 ; [21] YES. MOVEI C,0 ; [21] IDPB C,TEMP ; [21] NULL FILL JRST LB1 ; [21] & TRY AGAIN LB3: POP P,TEMP ; [21] JRST LB2 ; [21] RETURN TO MAIN FLOW SUBTTL DEFMAC, DEFSYM, COMBIN ;REDEFINE SYMBOL NAME FOR FAIL (CHANGES NUMERIC NAME TO ITS PRINTING NAME) DEFMAC: SKIPA SX,[MACTBL] ;CODE 13 DEFSYM: MOVEI SX,SYMTBL ;CODE 11 MOVE AC0,SVLAB JUMPE AC0,DEFS0 ;NO SAVED SYMBOL SETZM SVLAB ;ENTER SAVED SYMBOL BEFORE REDEFINING A SYMBOL NAME, IN CASE IT'S THE SAVED ;SYMBOL THAT'S BEING REDEFINED. PUSH P,SX ;SAVE SX MOVSI SX,IOSYM ;SET TO DEFINE OLD SYMBOL PUSHJ P,M6 ;STUFF SYMBOL POP P,SX DEFS0: PUSHJ P,FREAD ;GET SYMBOL NAME MOVE BYTEX,AC0 IDIVI BYTEX,HASH MOVMS TX ;HASH IT ADDI TX,(SX) ;ADDRESS OF CHAIN HEADER SKIPN SX,(TX) JRST DEFBYP ;NOT FOUND DEFS1: CAMN AC0,(SX) ;FIND SYMBOL JRST DEFFD SKIPE SX,1(SX) JRST DEFS1 DEFBYP: PUSHJ P,FREAD ;HERE IF SYMBOL IS NOT FOUND (ERROR?) JRST FM2 ;HERE IF THE SYMBOL IS FOUND. SX POINTS TO OUR ENTRY FOR IT DEFFD: PUSHJ P,FREAD ;NOW GET DEFINITION MOVEM AC0,(SX) ;STORE DEFINITION MOVE AC0,BLKND ;GET BLOCK NAME HRRM AC0,3(SX) ;STORE IT WITH SYMBOL JRST FM2 ;HERE WHEN FAIL DISCOVERS THAT TWO FORMERLY DIFFERENT SYMBOLS ARE THE SAME. ;COMBINE THEIR CREF SYMBOLS INTO ONE NEW SYMBOL. COMBIN: PUSHJ P,FREAD ;GET FIRST MOVE BYTEX,AC0 IDIVI BYTEX,HASH MOVMS TX MOVEI SX,SYMTBL-1(TX) CMB1: MOVE TEMP,SX ;FIND IT (TEMP IS THE PREVIOUS POINTER) SKIPN SX,1(TEMP) JRST DEFBYP ;NOT FOUND (ERROR?) CAME AC0,(SX) JRST CMB1 PUSHJ P,FREAD ;FOUND FIRST. NOW, GET NEXT NAME MOVE BYTEX,AC0 IDIVI BYTEX,HASH MOVMS TX MOVEI TEMP1,SYMTBL-1(TX) CMB2: MOVE TX,TEMP1 SKIPN TEMP1,1(TX) JRST MOVSYM ;SECOND NOT FOUND CAME AC0,(TEMP1) JRST CMB2 LDB BYTEX,[ POINT 17,2(TEMP1),17] ;GET LINE NUMBER FROM SECOND LDB AC0,[ POINT 17,2(SX),17] ;AND FROM FIRST. CAML BYTEX,AC0 ;AND SEE WHICH IS SMALLER JRST CMBOK ;SMALLER IS ONE TO DELETE (SX) MOVE AC0,2(SX) ;SWAP FIRST AND SECOND TO MAKE SX SMALLER EXCH AC0,2(TEMP1) MOVEM AC0,2(SX) MOVE AC0,3(SX) EXCH AC0,3(TEMP1) MOVEM AC0,3(SX) CMBOK: MOVE BYTEX,FREE ;GOBBLE A 2-WORD BLOCK ADDI FREE,2 CAML FREE,.JBREL PUSHJ P,XCEED MOVSI AC0,400000 ;PREPARE TO SET FLAG IN (TX) IF NEEDED SKIPGE C,2(SX) ;SKIP IF FLAG OFF IN SX (C _ REFCHAIN) IORM AC0,2(TEMP1) ;TURN ON BIT IN TEMP1 IF BIT WAS SET IN SX HLL C,3(TEMP1) ;AUXCHAIN FROM MAIN SYMBOL MOVEM C,(BYTEX) ;STORE: AUX POINTER,,REFCHAIN ADDRESS SKIPN 3(TEMP1) ;WAS THERE AN OLD MERGE POINTER? MOVEM BYTEX,3(TEMP1) ;NO. "TAIL" OF AUXLIST = (BYTEX) MOVE C,3(SX) ;GET AUXLIST FROM DELETED SYMBOL HLLM C,3(TEMP1) ;STUFF IT AS OUR AUXLIST. JUMPE C,CMB4 ;JUMP IF THERE IS NO OLD AUXLIST. HRLM BYTEX,(C) ;APPEND NEW LIST (BYTEX) TO OLD AUXLIST CMB3: MOVE TX,FSTPNT ;PUT DELETED SYMBOL BACK ON FREE LIST EXCH TX,1(SX) ;AND LINK IT OUT OF THE SYMBOL TABLE MOVEM SX,FSTPNT MOVEM TX,1(TEMP) JRST FM2 CMB4: HRLM BYTEX,3(TEMP1) ;NO OLD AUXLIST. (BYTEX)=HEAD OF NEW AUXLIST JRST CMB3 COMMENT $ THE LAST WORD OF A SYMBOL ENTRY POINTS TO THE HEAD AND TAIL OF AN AUXILIARY LIST OF ENTRIES FOR THIS SYMBOL (LH=HEAD, RH=TAIL). THE AUXILIARY LIST CONTAINS TWO-WORD ENTRIES OF: 0/ LINKOUT,,REFCHAIN ADRESS 1/ UNUSED $ MOVSYM: MOVE BYTEX,AC0 ;GET THE SYMBOL NAME AGAIN TLNN BYTEX,770000 ; [21] POINTER TO LONG SYMBOL ? MOVE BYTEX,(BYTEX) ; [21] YES - FOLLOW IT IDIVI BYTEX,HASH MOVMS TX SKIPE TEMP1,FSTPNT ;GET A BLOCK JRST [MOVE BYTEX,1(TEMP1) MOVEM BYTEX,FSTPNT JRST MOVS1] MOVE TEMP1,FREE ADDI FREE,4 CAML FREE,.JBREL PUSHJ P,XCEED MOVS1: MOVE BYTEX,SYMTBL(TX) ;INSERT SYMBOL INTO SYMBOL TABLE MOVEM BYTEX,1(TEMP1) MOVEM TEMP1,SYMTBL(TX) MOVEM AC0,(TEMP1) HRLI BYTEX,2(SX) HRRI BYTEX,2(TEMP1) BLT BYTEX,3(TEMP1) ;COPY INFO FROM DELETED SYMBOL MOVE TX,FSTPNT ;PUT DELETED SYMBOL BACK ON FREE LIST EXCH TX,1(SX) ;AND LINK IT OUT OF THE SYMBOL TABLE MOVEM SX,FSTPNT MOVEM TX,1(TEMP) JRST FM2 SUBTTL LABELS AND BLOCKS. SETLAB, DLAB, BBEG, BBEND, BLKPRN,SETLIN SETLAB: PUSHJ P,FREAD ;GET LABEL. SYMBOL REFERENCE EXCH AC0,SVLAB ;CHANGE FOR OLD LABEL JUMPE AC0,FM2 ;IF NO OLD LABEL, GO GET MORE MOVSI SX,IOSYM ;SET TO REFERENCE OLD LABEL JRST FM6 ;ADD OLD LABEL TO SYMBOL TABLE DLAB: MOVE AC0,SVLAB ;USE LAST LABEL. DEFINE PREVIOUS SYMBOL SETZM SVLAB ;NO OLD LABEL NOW. JUMPE AC0,ERROR ;ERROR IF NONE THERE MOVSI SX,IOSYM ;SET FOR SYMBOL TABLE TLO IO,IODEF ;SET FOR DEFINING OCCURANCE. PUSHJ P,M6 ; [22] STUFF IT MOVE AC0,BLKND ; [22] GET BLOCK-NAME HRRM AC0,3(SX) ; [22] STUFF THAT TOO JRST FM2 ; [22] ONWARD BBEG: AOS TEMP,LEVEL ;GET CURRENT LEVEL. BEGIN A BLOCK MOVSI SX,0 ;FLAG BEGIN FOR COMBEG JRST COMBG ;GO INSERT BEGIN IN BLOCK LIST BBEND: MOVE TEMP,LEVEL ;CURRENT LEVEL SOSGE LEVEL ;RESET LEVEL SETZM LEVEL ;BUT NOT TO GO NEGATIVE (PRGEND DOES THIS!) MOVEI SX,1 ;FLAG BEND FOR COMBEG COMBG: PUSHJ P,FREAD ;GET BLOCK NAME MOVE TEMP1,FREE ADDI FREE,4 ;RESERVE 4 WORDS CAML FREE,.JBREL PUSHJ P,XCEED MOVEM AC0,(TEMP1) ;SAVE BLOCK NAME HRLZM TEMP,1(TEMP1) ;AND LEVEL MOVEM LINE,2(TEMP1) ;AND CURRENT LINE HRLM SX,2(TEMP1) ;AND FLAG TO SELECT BEGIN/BEND MOVE TEMP,BLKND ;ADD THIS BLOCK TO END OF LIST HRRM TEMP1,1(TEMP) MOVEM TEMP1,BLKND ;SET END OF THE LIST TO POINT HERE JRST FM2 COMMENT $ BLOCK NAME LIST Block names are entered on a single-linked list of four-word elements. Each element contains: 0/ block name (sixbit) 1/ block level,,link to next element 2/ BEGIN/BEND flag,,Line number where the BEGIN/BEND occured 3/ Unused BLKND points to the last entry (initially to BLKST-1, which is the head of the list). $ ;PRINT BLOCK NAMES. CALL WITH BYTEX POINTING TO THE LIST OF BLOCK NAMES BLKPRN: PUSHJ P,LINOUT ;PRINT BLOCK LIST MOVE CS,@BLKND ;NAME OF THE OUTER BLOCK IS PROGRAM NAME PUSHJ P,OUTASC ;WRITE IN ASCII MOVEI C,11 PUSHJ P,WRITE MOVE CS,[SIXBIT /PROGRA/] ;GET THE "M" LATER... PUSHJ P,OUTASC MOVEI C,"M" PUSHJ P,WRITE BLKP3: PUSHJ P,LINOUT ;NEXT LINE HLRZ BYTEM,1(BYTEX) ;GET BLOCK LEVEL LSH BYTEM,-1 ;DIVIDE BY 2 ;(INDENT 4 SPACES HALF-TAB FOR EACH LEVEL) JUMPE BYTEM,BLKP1 PUSHJ P,TABOUT ;OUTPUT MANY TABS SOJG BYTEM,.-1 ;HALF AS MANY TABS AS NESTING LEVEL BLKP1: HLRZ BYTEM,1(BYTEX) ;GET THE BLOCK LEVEL AGAIN HLRZ SX,2(BYTEX) ;0=BEGIN, 1=BEND TRNE BYTEM,1 ;ODD LEVEL? ADDI SX,4 ;YES. NEED 4 MORE SPACES JUMPE SX,BLKP2 ;NOW WRITE SPACES FROM COUNT IN SX MOVEI C," " ;(ONE EXTRA SPACE FOR BEND) PUSHJ P,WRITE SOJG SX,.-1 ;WRITE ENOUGH SPACES BLKP2: MOVE CS,(BYTEX) ;GET AND WRITE THE BLOCK NAME PUSHJ P,OUTASC HLRZ SX,2(BYTEX) ;0=BEGIN, 1=BEND MOVNS SX ADDI SX,5 ;4 SPACES FOR BEND, 5 FOR BEGIN SKIPN CS,(BYTEX) JRST BLKP2A ;BLANK BLOCK NAMES ARE NOT GENERATED BY FAIL JRST .+2 LSH CS,-6 TRNN CS,77 AOJA SX,.-2 ;COUNT TRAILING SPACES IN THE BLOCK NAME BLKP2A: MOVEI C," " PUSHJ P,WRITE SOJG SX,.-1 ;WRITE SPACES TO GET TO A NICE COLUMN HRRZ C,2(BYTEX) ;GET THE LINE NUMBER PUSHJ P,CNVRT ;AND WRITE IT HRRZ BYTEX,1(BYTEX) ;ADVANCE TO NEXT BLOCK NAME JUMPN BYTEX,BLKP3 ;LOOP UNLESS LIST EXHAUSTED TLO IO,IOPAGE ;TIME FOR A NEW PAGE POPJ P, SETLIN: PUSHJ P,READ ;[17] READ LINE NUMBER FROM FILE MOVEI TEMP,(C) ;[17] SAVE CHARACTER COUNT MOVEI LINE,0 ;[17] ACCUMULATE NEW VALUE SETLI1: PUSHJ P,READ ;[17] GET A DIGIT IMULI LINE,12 ;[17] ADDI LINE,-"0"(C) ;[17] SOJG TEMP,SETLI1 ;[17] JRST FM2 ;[17] DONE. SCAN MORE. SUBTTL EOF SEEN. OUTPUT TABLES AND FINISH UP. R0: MOVE C,[SOSG LSTBUF+2] ;SET UP WRITE ENTRANCE INSTRUCTION MOVEM C,WRITEE ;SO THAT CREF DATA WILL BE WRITTEN SKIPE BYTEX,BLKST ;CHECK FOR FAIL BLOCK STRUCTURE PUSHJ P,BLKPRN ;PRINT FAIL BLOCK STRUCTURE MOVE CS,@BLKND ;SET FOR PURGED SYMBOL W/O BLOCK NAME MOVEM CS,BLKST-1 ;BLOCK NAME OF OUTER BLOCK SAVED HERE. TLZ IO,IOSAME ;CLEAR FLAG FOR OUTP MOVEI BYTEX,SYMTBL TLNE IO,IOSYM ;SKIP IF NO SYMBOL OUTPUT REQUIRED PUSHJ P,SORT ;SORT SYMTBL - OUTPUT SYMTBL MOVEI BYTEX,MACTBL TLNE IO,IOMAC ;SKIP IF NO MACRO OUTPUT REQUIRED PUSHJ P,SORT ;SORT AND OUTPUT MACTBL MOVEI BYTEX,OPTBL TLNE IO,IOOP ;SKIP IF NO OPCODE OUTPUT REQUIRED PUSHJ P,SORT ;SORT AND OUTPUT OPTBL MOVE P,PPSAV ;RE-INITIALIZE STACK. TLZN IO,IOEOF ;END OF FILE SEEN? JRST RECYCL ;NO, RECYCLE (F40 PROGRAM?) IFN CFP, CCLFN1: RELEAS CHAR, SKIPE TTYCRF ;WAS OUTPUT TO TTY? JRST ENDCRF ;YES. NOTHING TO QUEUE JRST QUELOP ;NO. RETURN FOR NEXT ASSEMBLY TYDEC: IDIVI C,12 HRLM CS,(P) JUMPE C,.+2 PUSHJ P,TYDEC HLRZ C,(P) ADDI C,"0" OUTCHR C POPJ P, SUBTTL SORT SYMBOL TABLE COMMENT $ This sort routine should not be approached as a trivial programming example. This is coded for speed and compactness, not clarity. For each non-empty symbol chain, LSORT is called, which sorts that one chain. Sorted chains are deposited into a compact table (SORT2) which is terminated by a zero (SORT4). Then, adjacent pairs of lists are merged by LMERGE, and deposited in a compact table. Each pairwise merge pass continues until one of a pair is zero, at which time a zero is deposited at the end of the compact area, and another merge pass is started. The pairwise merge terminates when the second word of the first pair is zero, at which point the result is the first word of that pair. The routine LSORT is recursive. A single-element is list is sorted. For longer lists, break the list into two lists (of approximately equal size) and sort those two lists (i.e., recur). The result of those two sorts is merged (LMERGE again) to form one sorted list. Also, this sort routines causes the hash table to be cleared to zero. $ SORT: MOVEM BYTEX,SRTTMP ;SAVE FIRST ADDRESS OF HASH TABLE HRLI BYTEX,-HASH ;AOBJN POINTER TO TABLE MOVEI FLAG,-1(BYTEX) ;PUSHDOWN POINTER TO "FIRST FREE" HEADER SORT1: SKIPN SX,(BYTEX) ;GET LIST HEADER JRST SORT3 ;THIS IS EASY SETZM (BYTEX) ;CLEAR OUT SOURCE ENTRY PUSHJ P,LSORT ;SORT ONE CHAIN. RESULT IS POINTER IN SX SORT2: PUSH FLAG,SX ;STORE SORTED CHAIN SORT3: AOBJN BYTEX,SORT1 ;ADVANCE TO NEXT CHAIN SORT5: HRRZ BYTEX,SRTTMP ;GET BACK THE HASH TABLE ADDRESS SETZB SX,TX EXCH SX,(BYTEX) ;GET FIRST CHAIN (STORE ZERO) EXCH TX,1(BYTEX) ;ANY SECOND CHAIN? (STORE ZERO) JUMPE TX,OUTP ;NO. RESULT IS IN SX. CALL OUTP MOVEI FLAG,-1(BYTEX) ;INITIALIZE POINTER FOR DEPOSITS SORT6: PUSHJ P,LMERGE ;MERGE SX,TX. RESULT IN SX PUSH FLAG,SX ;STUFF RESULT ADDI BYTEX,2 ;ADVANCE TO NEXT SETZB SX,TX EXCH SX,(BYTEX) ;GET FIRST OF NEXT PAIR (STORE ZERO) JUMPE SX,SORT5 ;NO NEXT PAIR. DO ANOTHER MERGE PASS EXCH TX,1(BYTEX) ;GET SECOND OF PAIR (STORE ZERO) JUMPE TX,SORT2 ;NOT THERE. PUSH SX. (BYTEX>0) JRST SORT6 ;LOOP UNTIL A PAIRWISE MERGE PASS COMPLETES ;SORT ONE NON-EMPTY LIST POINTED TO BY SX, RESULT IN SX. LSORT: SKIPN TX,1(SX) ;GET NEXT LINK POPJ P, ;LIST WITH ONE ELEMENT IS SORTED. MOVE C,TX ;TAIL OF TX LIST MOVE CS,SX ;TAIL OF SX LIST LSORT1: MOVE TEMP,1(C) ;GET LINK-OUT OF TS-LIST MOVEM TEMP,1(CS) ;STORE LINK-OUT OF NA-LIST SKIPN CS,TEMP ;ADVANCE NA-TAIL JRST LSORT2 ;NONE LEFT MOVE TEMP,1(CS) MOVEM TEMP,1(C) SKIPE C,TEMP JRST LSORT1 LSORT2: PUSH P,TX ;TX AND SX ARE EACH HALF THE LENGTH OF PUSHJ P,LSORT ;ORIGINAL LIST. RECUR TO SORT EACH EXCH SX,(P) ;SX AND TX GET EXCH'D HERE, BUT NO ONE CARES PUSHJ P,LSORT POP P,TX ;ENTER HERE TO MERGE TWO NON-EMPTY LISTS INTO ONE. ARGS IN SX,TX; RESULT IN SX LMERGE: MOVEI CS,C-1 ;LIST HEAD (OF RESULT) INTO C. SCOMP: MOVE TEMP,(SX) ;COMPARE CAR(SX), CAR(TX). MOVE TEMP1,(TX) ; [21] TLNN TEMP,770000 ; [21] LONG SYMBOL ? JRST LSYM1 ; [21] YES TLNN TEMP1,770000 ; [21] LONG SYMBOL ? JRST LSYM2 ; [21] YES. CAMGE TEMP,(TX) ;COMPARE SYMBOL NAMES JRST LCOMP ;CAR(SX)) ADDI BYTEX,1 MOVE BYTEM,-1(BYTEX) MOVEI LINE,0 JRST GETV20 ;START OUTPUTTING VALUES GETVAL: TLZN IO,IODEF JRST GETV20 MOVEI C,"#" PUSHJ P,WRITE GETV20: CAMN BYTEX,BYTEM POPJ P, PUSHJ P,TABOUT MOVEI C,0 GETV10: TRNE BYTEX,1 CAML BYTEX,[POINT 6,0,16] JRST GETV12 MOVE BYTEX,0(BYTEX) HRLI BYTEX,() GETV12: ILDB CS,BYTEX ROT CS,-5 LSHC C,5 JUMPN CS,GETV10 TRNN C,1 ;SET DEFINED FLAG TLO IO,IODEF LSH C,-1 ADDB LINE,C PUSH P,[GETVAL] ;RETURN FROM CNVRT TO GETVAL CNVRT: MOVEI TEMP,5 ;HERE TO OUTPUT A FIVE-DIGIT NUMBER FROM C MOVEI TEMP1,0 CNVRT1: IDIV C,TABL(TEMP) ADD TEMP1,C ADDI C,40 SKIPE TEMP1 ADDI C,20 PUSHJ P,WRITE MOVE C,CS SOJGE TEMP,CNVRT1 POPJ P, TABL: DEC 1,10,100,1000,10000,100000 SUBTTL OUTPUT ROUTINES - TABOUT, LINOUT, WRITE LINOUT: SOSG LPP TLO IO,IOPAGE MOVEI C,15 PUSHJ P,WRITE MOVEI C,12 MOVE WPL,.WPL JRST WRITE TABOU0: PUSHJ P,LINOUT TABOUT: MOVEI C,11 SOJL WPL,TABOU0 WRITE0: TLZN IO,IOPAGE JRST WRITE PUSH P,C MOVEI C,14 PUSHJ P,WRITE MOVEI C,.LPP MOVEM C,LPP POP P,C WRITE: XCT WRITEE ;SOSG LSTBUF+2 OR JRST WRITE1 PUSHJ P,DMPLST IDPB C,LSTBUF+1 XCT WRITEX ;EXIT FROM WRITE (POPJ P, OR CAIE C,12) POPJ P, ;WASN'T LF IN TTY OUTPUT MODE. ;FORCE TTY OUTPUT AFTER EVERY LINE. DMPLST: XCT DMPXCT ;OUTPUT BUFFER (OUT OR PUSHJ P,DMPOUT) POPJ P, ;WIN. ;LOSE. TSTLST: STATO LST,742000 ;ANY ERROR. (EOT NOT TESTED BY OUT UUO) POPJ P, ;NO ERRORS. GETSTS LST,ERRSTS MOVEI CS,LSTDEV JSP RC,DVFSTS SIXBIT /?CRFOUE OUTPUT ERROR, @/ ;[17] IDENTIFY MESSAGE JRST CREF SUBTTL HERE TO EXPAND CORE - XCEED XCEED: PUSH P,1 ;HERE TO EXPAND CORE HRRZ 1,.JBREL ;GET CURRENT TOP MOVEI 1,2000(1) IFN SEGSW,< CAIGE 1,400000 ;DON'T EXPAND LOWER ABOVER 128K> CORE 1, ;REQUEST MORE CORE JRST ERRCOR ;ERROR, BOMB OUT POP P,1 POPJ P, SUBTTL SCAN COMMAND INPUT CRLF: BYTE(7)15,12 SUBTTL FILE INPUT READ: SOSG INBUF+2 ;BUFFER EMPTY? JRST READ3 ;YES READ1: ILDB C,INBUF+1 ;PLACE CHARACTER IN C JUMPE C,READ POPJ P, READ3: IN CHAR,0 ;GET NEXT BUFFER. JRST READ1 ;OK SO FAR. (THIS IGNORES EOT AS AN ERROR) GETSTS CHAR,C ;GET FILE STATUS TRNE C,020000 ;EOF? JRST [TLO IO,IOEOF JRST R0] ;YES. MOVEM C,ERRSTS ;REAL ERROR. SAVE ERROR STATUS MOVEI CS,INDEV JSP RC,DVFSTS SIXBIT /?CRFINE INPUT ERROR, @/ ;[17] IDENTIFY MESSAGE JRST CREF SUBTTL ERROR MESSAGES/ERROR TYPEOUT ERRENT: MOVEI CS,LSTDEV ;ENTER FAILURE JSP RC,DVFDIR SIXBIT /?CRFCEF CANNOT ENTER FILE, @/ ;[17] IDENTIFY MESSAGE JRST CREF ERRCOR: JSP RC,ERRMSX ;CORE UUO FAILURE SIXBIT /?CRFIMA INSUFFICIENT MEMORY AVAILABLE@/ ;[17] IDENTIFY MESSAGE JRST CREF ERRMSX: PUSHJ P,PNTMSG ;FOR SIMPLE ERROR MESSAGES OUTSTR CRLF ;TYPE CRLF JRST (RC) ;RETURN TO AFTER SIXBIT TEXT DVFDIR: HRRZ C,2(CS) ;PRINT MESSAGE WITH DIR ERR # MOVEM C,ERRSTS DVFSTS: PUSHJ P,PNTMSG ;PRINT MESSAGE, ERR #, DEV:FILENAM.EXT PUSH P,RC ;SAVE RETURN AT END OF SIXBIT TEXT PUSHJ P,PNTSTS OUTCHR [" "] POP P,RC ;GET RETURN BACK NOW JRST DVFN2 DVFNEX: PUSHJ P,PNTMSG ;PRINT MESSAGE DEV:FILENAME.EXT PUSHJ P,PNTASC ;PRINT ASCII FILE NAME JRST ERRFIN ;AND DONE DVFN2: PUSHJ P,PNTSIX ;PRINT DEVICE OUTCHR [":"] ADDI CS,1 ;ADVANCE POINTER TO FILENAME SKIPN (CS) ;IS FILENAME 0? JRST ERRFIN ;YES, NO FILENAME PUSHJ P,PNTSIX ;NO, PRINT FILENAME ADDI CS,1 ;ADVANCE POINTER TO EXTENSION HLLZS C,(CS) ;ZERO OUT OTHER HALF. EXTENSION=0? JUMPE C,ERRFIN ;EXTENSION 0? OUTCHR ["."] ;NO PUSHJ P,PNTSIX ;PRINT EXTENSION ERRFIN: OUTSTR CRLF ;TYPE RETURN JRST 0(RC) ;RETURN PNTSIX: HRLI CS,() ;PRINT 1 WORD OF SIXBIT PNTSX1: TLNN CS,770000 ;NEXT ILDB GO OVER WORD BOUNDARY? POPJ P, ;YES, FINISHED ILDB C,CS JUMPE C,.-2 ;STOP AT A 0 ADDI C,40 ;CONVERT TO ASCII OUTCHR C JRST PNTSX1 PNTASC: OUTSTR (CS) POPJ P, ;AND DONE PNTMSG: OUTSTR CRLF ;PRINT SIXBIT MESSAGE PNTM0: HRLI RC,() PNTM1: ILDB C,RC CAIN C,40 ;STOP AT @ AOJA RC,CPOPJ ;POINT TO LOCATION AFTER SIXBIT ADDI C,40 ;CONVERT TO ASCII OUTCHR C JRST PNTM1 ECNVRT: MOVEI TEMP,5 ;HERE TO TYPE A FIVE-DIGIT NUMBER FROM C MOVEI TEMP1,0 ; LEFT-JUSTIFIED, ZERO-SUPPRESSED. ECNVR1: IDIV C,TABL(TEMP) ADD TEMP1,C ADDI C,"0" SKIPE TEMP1 OUTCHR C MOVE C,CS SOJGE TEMP,ECNVR1 POPJ P, PNTSTS: HRRZ RC,ERRSTS ;PRINT ERROR STATUS PNTOCT: IDIVI RC,10 ;PRINT OCTAL NUMBER HRLM RC+1,(P) SKIPE RC PUSHJ P,PNTOCT HLRZ C,(P) ADDI C,"0" OUTCHR C POPJ P, ;THE LITERALS ARE XLISTED FOR YOUR READING PLEASURE XLIST LIT LIST EXTERN L1,L2,SVJFF,.WPL,WRITEE,WRITEX,AWRITE,M6X,M0XCT,DMPXCT EXTERN SYNERR,STCLR,OPTBL,MACTBL,SYMTBL,REFBIT,REFINC,SRTTMP EXTERN FRDTMP,INBUF,INDEV,INDIR,LSTDEV,LSTBUF,PPSAV EXTERN LPP,PPTEMP,FIRSTL,ERRSTS,CMDTRM,IOJFF,LOWLIM,UPPLIM EXTERN SVLAB,LEVEL,BLKST,OFLAG,OFLAG1,OFLAG2,OFLAG3,BLKND EXTERN ENDCLR END