;****** UOFP SEGMENTED BASIC ****** SEARCH S IFNDEF BASLOG, ;BASLOG=0 : ASK FOR CONFIRM IFNDEF NOCODE, ;NOCODE=1 : JUST DEFINE SYMBOLS IFNDEF BASTEK, ;BASTEK=1 : INCLUDE PLOT PACKAGE IFE NOCODE,< TITLE BASEDT COMMAND/EDIT PHASE > IFN NOCODE,< UNIVERSAL BSYEDT > ;****** 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 ****** INTERN CMDCEI,CMDFLO,COMM1,FIXUP,RTIME,SAVFIL INTERN UNSATP,UNSER,UXIT1 ;****** END INTERNS FOR EDTLIB ****** 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,HEDFLG,HPOS,IBF,IFIFG,ININI1 EXTERN LASTLN,LINB0,LINNUM,LINROL,LOWEST,LOWSTA,MARGIN EXTERN MARWAI,MONLVL,MTIME,NEWOL1,NOBFLG,NOTLIN,NUMCOT,OBF,ODF EXTERN OLDFLA,ONCESW,OUTERR,PAGLIM,PAKFLA,PAKFLG,PARAM,PLIST EXTERN PTHBLK,QLSPEC,QUEUER,QUOTBL,RANCNT,RENFLA,RENDON,RENSW EXTERN RETUR1,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,GTNUMB,INLGEN,INLINE EXTERN INLB1,INLME1,INLMES,INLSYS,LINB2,LOCKOF,LOCKON,NOGETD EXTERN NXCH,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 INTERN BASIC 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 ;TABLE OF BASIC COMMANDS DEFINE YYY (A,B)< EXP SIXBIT /A/ + 'A'ER + 'B'0000> CMDFLO: YYY BYE YYY CAT YYY COP YYY CRE YYY DDT YYY DEL YYY GEN YYY GOO YYY HEL YYY KEY YYY LEN YYY LIS YYY MON YYY NEW YYY NOS YYY OLD YYY QUE YYY REN YYY REP YYY RES YYY RUN YYY SAV YYY SCR YYY SYN YYY SYS YYY TAP YYY UNS YYY WEA CMDCEI: SUBTTL COMMAND SCANNER AND EDITOR ;COLD START BASIC: RESET MOVE P,PLIST SETZM IFIFG SETZM QUOTBL SETZM COMTIM SETZM MARWAI MOVEI X1,^D72 MOVEM X1,MARGIN MOVEI X1,^D9 BSLAB1: SETZM ACTBL-1(X1) SOJG X1,BSLAB1 SETZM HPOS SETZM TRPLOC+2 SETZM TRPLOC+3 SETOM PAGLIM SETZM CHAFLG SETZM CHAFL2 SETZM UXFLAG SETZB LP,ODF SETZM MTIME SETOM RENFLA ;ALLOW REENTERS. SETZM RENDON ;AND ^C SKIPN ONCESW ;FIRST TIME, SET THINGS UP JRST BASI1 SETOM SYNTAX ;DEFAULT TO SYNTAX CHECKING SETZM CURNAM PJOB X1, ;BATCHED? HRLZI X1,(X1) HRRI X1,40 SETZM BATCH GETTAB X1, JRST BASI3 TLNN X1,000200 JRST BASI3 SETZM .JBINT ;BATCH, DON'T TRAP ON CONTROL C. SETOM BATCH BASI3: SETZM RANCNT HLRZ T,.JBSA MOVEM T,SJOBSA MOVEM T,FLTXT ;TXTROL ON BOTTOM OF FREE SPACE MOVEM T,CETXT MOVE T,.JBREL ;LINROL ON TOP MOVEM T,SJOBRL MOVEM T,FLLIN MOVEM T,CELIN SETZM PAKFLG ;DON'T HAVE TO CRUNCH CORE YET. HRRZI T,REENTR HRRM T,.JBREN SETZM DSKSYS SETZM SWAPSS HRLZI X1,400000 MOVEM X1,MONLVL ;MONLVL CONTAINS THE MOVE X1,[XWD 17,11] ;PROTECTION CODE "DON'T DELETE" GETTAB X1, ;BIT APPROPRIATE TO THE MONITOR JRST BASI2 ;LEVEL UNDER WHICH BASIC IS RUNNING. TLNN X1,(7B9) JRST BASI0 HRLZI T,100000 MOVEM T,MONLVL BASI0: TLNE X1,200000 SETOM SWAPSS ;SWAPPING SYSTEM. TLNE X1,400000 SETOM DSKSYS ;DISK SYSTEM. BASI2: SETZM ONCESW BASI1: PUSHJ P,TTYIN ;SET UP BUFFERS AND INIT TTY SKIPE CURNAM JRST EDTXIT SETZM RUNFLA PUSHJ P,INLMES ASCIZ / Ready, for help type HELP. / FIXUP: OUTPUT ;WRITE LAST MESSAGE SKIPE CURNAM JRST CLR MOVE X1,[SIXBIT /DSK/] ;INITIALIZE BASIC WITH MOVEM X1,CURDEV ;CURRENT DEVICE==DSK MOVE X1,[SIXBIT /BAS/] ;CURRENT EXT==BAS MOVEM X1,CUREXT SETZM CURBAS ;CURRENT DEV < > FAKED BAS. MOVE X1,[SIXBIT /NONAME/] MOVEM X1,CURNAM ;CURRENT NAME==NONAME CLR: SETZM IFIFG SETZM ODF SETZM SAVRUN XLIST IFN BASTEK,< LIST EXTERN PLTOUT,PLTIN SETZM PLTOUT SETZM PLTIN XLIST > LIST MOVEI R,STAROL ;SETUP STAROL FOR THIS SEGMENT MOVEI X1,STAFLO ;SEGMENT FLOOR MOVEM X1,FLOOR(R) ;SET IT MOVEI X1,STACEI ;SEGMENT CEIL MOVEM X1,CEIL(R) ;SET IT MOVEI R,RELROL ;SET UP RELROL FOR THIS SEGMENT MOVEI X1,RELFLO ;SEGMENT FLOOR MOVEM X1,FLOOR(R) ;SET IT MOVEI X1,RELCEI ;SEGMENT CEIL MOVEM X1,CEIL(R) ;SET IT SKIPN CHAFLG ;CHAINING? SETZM RUNDDT ;NO DDT SETZM NOTLIN MOVEI X1,OVFLCM ;IGNORE OVFLOW DURING COMMANDS. HRRM X1,.JBAPR MOVEI X1,230010 ;SETUP ARITH OVFLOW TRAP APRENB X1, MOVEI X1,TXTROL MOVEM X1,TOPSTG ;EDIT TIME. ONLY TXTROL IS STODGY. ; ;OTHER ROLLS MOVE. MOVE T,CELIN ;CLOBBER ALL COMPILE ROLLS WITH "CELIN" MOVEI X1,LINROL ;PROTECT TXTROL +LINROL FROM CLOBBER: PUSHJ P,CLOB ;FALL INTO MAINLP ;MAIN LOOP FOR EDITOR/MONITOR MAINLP: MOVE P,PLIST PUSHJ P,LOCKOF ;TURN OFF REENTR LOCK SETZM INLNFG ;TURN OFF INPUT LINE FLAG SKIPE CHAFLG ;CHAINING? JRST OLDER ;YES. PUSHJ P,INLINE ;READ A LINE PUSHJ P,GETDNM ;LOOK FOR SEQUENCE NO JRST COMMAN ;NONE. GO INTERPRET COMMAND SKIPE PAKFLG ;CRUNCH CORE? PUSHJ P,SCRER3 ;YES. ;HERE, WE HAVE SEQUENCED LINE INPUT. NUMBER IS IN N, ;POINTER TO FIRST CHAR AFTER NUMBER IS IN T PUSHJ P,LOCKON PUSHJ P,ERASE PUSHJ P,INSERT SKIPE SYNTAX PUSHJ P,SYNCHK PUSHJ P,LOCKOF JRST MAINLP ;HERE ON COMMAND COMMAN: MOVEI R,CMDROL TLNE C,F.CR ;TEST FOR NULL COMMAND JRST MAINLP PUSHJ P,SCNLT1 ;SCAN COMMAND PUSHJ P,SCNLT2 JRST COMM1 ;SECOND CHAR NOT A LETTER PUSHJ P,SCNLT3 JRST COMM1 ;THIRD CHAR NOT A LETTER ;NOW THE FIRST THREE LETTERS OF THE COMMAND ARE PACKED IN LH OF A. PUSHJ P,SEARCH ;LOOK FOR COMMAND JRST COMM1 ;NOT FOUND HRRZ X1,(B) JRST (X1) ;CREF COMMAND EXTERNAL LCRFNH CREER: PUSHJ P,QSA ASCIZ /F/ ;CREF JFCL TLNN C,F.SLSH ;SWITCH? JRST CREFEN ;NO PUSHJ P,NXCH MOVEI B,"T" CAIE B,(C) ;T SWITCH FOR TTY JRST COMM1 ;ONLY SWITCH ALLOWED PUSHJ P,NXCH PUSHJ P,QSAX ASCIZ /TY/ SETOM TTYCRF CREFEN: TLNN C,F.CR JRST COMM1 JRST LCRFNH ;GO GET CREF SEGMENT EXTERNAL TTYCRF ;"GOODBY" OR "BYE" GOOER: PUSHJ P,QSA ;"GOODBYE" ASCIZ /DBYE/ JRST BYEER ;AND "BYE" BYEER: MOVE A,[XWD 17,11] ;BYE AND GOO ARE NOT IMPLEMENTED GETTAB A, ;FOR NON-LOGIN SYSTEMS--SO JFCL ;FIND OUT WHAT TYPE OF SYSTEM TLNE A,100000 ;BASIC IS RUNNING UNDER. JRST BYEER5 ;LOGIN SYSTEM--GO EXECUTE. MOVEI T,NOTIMP ;NON-LOGIN SYSTEM--SEND MESSAGE OUT. JRST ERRMSG BYEER5: MOVSI A,(SIXBIT /SYS/) MOVEM A,NEWOL1 MOVE A,[SIXBIT /KJOB/] MOVEM A,FILDIR SETZM FILDIR+3 PUSHJ P,SCRER1 ;REDUCE LO-SEG CORE FOR RUN SETOM RUNUUO ;MARK BASEDT DOING RUN JRST LCHAIN ;GO LET LO-SEG DO THE RUN ;"CATALOG" OR "CAT" ; RESULTS IN A LISTING OF USER PROGRAMS ON TTY CATER: PUSHJ P,QSA ASCIZ /ALOG/ JFCL CLEARM CATFL1 ;NO SWITCHES YET CATSW: TLNN C,F.SLSH ;SWITCH? JRST CATFIN ;NOPE, CONTINUE PUSHJ P,NXCH ;EAT UP THE / MOVEI B,"F" ;CHECK FOR F-AST CAIE B,(C) ;IS IT? JRST CATPRO ;NO, TRY OTHER SWITCH PUSHJ P,NXCH ;GOODBYE "F" PUSHJ P,QSAX ;ANY MORE OF SWITCH ASCIZ /AST/ ; HRROS CATFL1 ;SET LEFT HALF -1 JRST CATSW ;CHECK MORE CATPRO: MOVEI B,"P" ;CHECK FOR P-ROTECTION CAIE B,(C) ;IS IT? JRST COMM1 ;NO MORE SWITCHES TO CHECK PUSHJ P,NXCH ;EAT THE "P" PUSHJ P,QSAX ;ANY MORE OF SWITCH ASCIZ /ROTECTION/ ; HLLOS CATFL1 ;MARK PROTECTION (ONLY FOR DSK) JRST CATSW ;CHECK FOR MORE CATFIN: CLEARM CATCNT ;START COUNT AT ZERO SETZM CATFLG ;CATFLG IS ZERO FOR DSK, NE 0 FOR DTA'S. SETZM DEVBAS ;DEVBAS IS ZERO FOR DEVICE NOT BAS. MOVSI A,(SIXBIT/DSK/) TLNE C,F.CR JRST CAT2 PUSHJ P,ATOMSZ JUMPE A,CAT000 MOVE B,A DEVCHR B, JUMPN B,CAT01 CAMN A,[SIXBIT/BAS/] JRST CAT00 MOVE T,A JRST NOGETD CAT000: CAME C,[XWD F.STAR,"*"] JRST CAT0 PUSHJ P,NXCH CAME C,[XWD F.STAR,"*"] JRST COMM1 PUSHJ P,NXCH CAME C,[XWD F.STAR,"*"] JRST COMM1 PUSHJ P,NXCH MOVSI A,(SIXBIT/BAS/) MOVE B,A DEVCHR B, JUMPN B,CAT01 CAT00: SETOM DEVBAS ;LT. 0 SAYS NON-EXIST. DEV BAS. CAT0: MOVSI A,(SIXBIT/DSK/) CAT01: CAIN C,72 PUSHJ P,NXCH TLNN C,F.CR JRST COMM1 CAT2: MOVEM A,DEVICE DEVCHR A, JUMPN A,CAT3 MOVE T,DEVICE JRST NOGETD CAT3: TLNE A,200100 JRST CAT4 MOVEI T,CATFAL JRST ERRMSG CAT4: TLNN A,200000 SETOM CATFLG MOVEI N,IBF ;ININI1: 14 MOVEM N,DEVICE+1 ;DEVICE: MOVEI N,14 ;DEVICE+1: IBF MOVEM N,ININI1 OPEN 3,ININI1 ;TRY TO GET THE CAT DEVICE. JRST [MOVE T,DEVICE SKIPE DEVBAS MOVSI T,(SIXBIT/BAS/) JRST NOGETD] MOVEI N,DRMBUF MOVEM N,.JBFF INBUF 3,1 INIT 2,1 ;INIT THE TTY FOR LISTING. SIXBIT /TTY/ XWD OBF, JRST [MOVEI T,(SIXBIT/TTY/) JRST NOGETD] MOVEI N,LINB2 MOVEM N,.JBFF OUTBUF 2,1 PUSHJ P,CLRF SKIPN CATFLG JRST DSKHAN DTAHAN: USETI 3,144 ;POINT TO THE DIRECTORY BLOCK. INPUT 3, STATUS 3,D TRNE D,740000 ;ERROR? JRST CATERR ;YES. MOVEI X2,^D82 ;NO. MOVEI B,^D22 MOVEM B,CATFLG ADD X2,IBF+1 ;SET UP BYTE POINTERS TO FILENAMES ADD B,X2 ;AND EXTENSIONS. CATLP: ILDB N,X2 ILDB 1,B JUMPE N,CATTST ;GO TO CATTST IF NO FILENAME HERE. MOVEM N,FILNM HLLZM 1,FILNM+1 PUSHJ P,CLSTU3 ;OUTPUT FILENAME AND EXT. CATTST: SOSG CATFLG ;ONLY 22 FILES ON A DECTAPE. JRST EDTXIT JRST CATLP DSKHAN: SKIPL DEVBAS ;FAKED DEVICE BAS? JRST DSKH0 MOVE T1,[XWD 5,1] ;YES. JRST DSKH1 DSKH0: MOVE T1,DEVICE ;NO. PREPARE FOR LOOKUP. MOVEM T1,PTHBLK ; SETUP PATH BLOCK SETZM PTHBLK+1 ; CLEAR UNUSED SETZM PTHBLK+2 ; WORDS OF BLOCK MOVE T1,[^D8,,PTHBLK] ; ROOM FOR 5 SFDS PATH. T1, ; GET CURRENT PATH JRST [ MOVE T1,DEVICE ; CAN'T - TRY OLD WAY DEVPPN T1, ; GET PPN OF DEVICE SKIPA ; THAT DOESN'T WORK EITHER JRST DSKH1 ; GO SETUP FOR UFD MOVE T1,DEVICE ; GET CURRENT DEVICE BACK MOVE N,T ; GET SPECIFIED DEVICE CAMN T1,[SIXBIT/SYS/] ; IS CURRENT DEVICE SYS? SKIPA T1,[XWD 1,4] ; YES - USE SYS: PPN GETPPN T1, ; NO - GET PPN OF DEVICE CAMN N,[SIXBIT/BAS/] ; IS SPECIFIED DEVICE BAS? MOVE T1,[XWD 5,1] ; YES - USE BAS: PPN JRST DSKH1] ; AND SETUP FOR UFD SKIPE PTHBLK+3 ; IS PATH THRU ANY SFDS JRST DSKH2 ; YES - SETUP FOR SFD MOVE T1,PTHBLK+2 ; NO - GET DEVICE PPN DSKH1: MOVEM T1,UFD ;UFD : P# ,P# MOVSI N,(SIXBIT/UFD/) ;UFD+1:SIXBIT /UFD/ MOVEM N,UFD+1 ;UFD+2: SETZM UFD+2 MOVE N,[XWD 1,1] ;UFD+3: 1 ,, 1 MOVEM N,UFD+3 JRST DSKH3 ; GO DO LOOKUP DSKH2: SETZ T, ; INIT COUNTER DSLAB1: SKIPN T1,PTHBLK+7(T) ; SEARCH FOR LAST SFD SOJA T,DSLAB1 ; WE KNOW THERE IS AT LEAST 1 MOVEM T1,UFD ; SAVE AS FILENAME SETZM PTHBLK+7(T) ; REMOVE FROM PATH BLOCK MOVSI N,(SIXBIT /SFD/) ; LOOK IN SFD MOVEM N,UFD+1 ; FOR FILES SETZM UFD+2 ; MOVEI N,PTHBLK ; SETUP PATH POINTER MOVEM N,UFD+3 ; FOR LOOKUP SETZM PTHBLK+1 ; DON'T NEED PATH FLAGS DSKH3: LOOKUP 3,UFD ;LOOKUP DIRECTORY JRST DSKERR JRST CLSTU1 DSKERR: PUSHJ P,INLMES ASCIZ / ? File / SETZM ODF SETZM HPOS HLRZ T,DEVICE CAIN T, JRST DSKER1 MOVE T,DEVICE PUSHJ P,PRNSIX MOVSI T,320000 PUSHJ P,PRNSIX DSKER1: HLRZ T,UFD PUSHJ P,PRTOCT MOVSI T,14 PUSHJ P,PRNSIX HRRZ T,UFD PUSHJ P,PRTOCT HLRZ T,UFD+1 CAIN T, JRST DSKER2 TLO T,16 PUSHJ P,PRNSIX DSKER2: PUSHJ P,INLMES ASCIZ / not found / OUTPUT JRST BASIC CLSTU1: SOSLE IBF+2 JRST CLSTU5 CLSTU2: INPUT 3, ;FOR ERROR AND EOF CHECK STATUS 3,D TRNN D,760000 ;ERROR OR EOF? JRST CLSTU5 ;NO. TRZE D,20000 ;YES, EOF? JRST EDTXIT ;YES, EOF. CATERR: MOVEI T,INLSYS ;NO, ERROR. JRST ERRMSG CLSTU5: ILDB N,IBF+1 JUMPE N,CLSTU2 MOVEM N,FILNM SOS IBF+2 ILDB X2,IBF+1 HLLZM X2,FILNM+1 PUSHJ P,CLSTU3 ;OUTPUT FILENAME AND EXT. JRST CLSTU1 CLSTU3: MOVEI G,6 MOVE N,FILNM PUSHJ P,SIXOUT MOVE N,FILNM+1 JUMPE G,CLSTU4 MOVEI X1,40 CTLAB1: PUSHJ P,PUT SOJG G,CTLAB1 CLSTU4: MOVEI X1,56 PUSHJ P,PUT SKIPE N ;ANY EXTENSION? JRST CLSTU7 MOVEI G,3 MOVEI X1,40 CTLAB2: PUSHJ P,PUT SOJG G,CTLAB2 JRST CLSTU6 CLSTU7: MOVEI G,3 PUSHJ P,SIXOUT CLSTU6: SKIPN CATFLG ;DEVICE DSK SKIPE DEVBAS ;ANY NOT BAS JRST CLRF HRRZ X1,CATFL1 ;ASKING FOR PROTECTION JUMPE X1,CLRF ;IF ZERO, NO INIT 14,1 ;INIT DSK FOR LOOKUP SIXBIT /DSK/ ; Z JRST [MOVSI T,(SIXBIT/DSK/) JRST NOGETD] MOVE X1,FILNM ;FILENAME MOVEM X1,CATLOK ;SAVE MOVE X1,FILNM+1 ;EXTENSION MOVEM X1,CATLOK+1 ;SAVE CLEARM CATLOK+2 ; CLEARM CATLOK+3 ; LOOKUP 14,CATLOK ;LOOKUP THE FILE JFCL ;CAN'T HAPPEN RELEAS 14, ;DON'T NEED IT ANYMORE MOVEI X1,74 ;ASCIZ "<" PUSHJ P,PUT ;OUTPUT IT LDB X1,[POINT 9,CATLOK+2,8] PUSHJ P,OCTOUT ;PRINT PROTECTION MOVEI X1,76 ;ASCIZ ">" PUSHJ P,PUT ;OUTPUT IT JRST CLRF ;ALL DONE SIXOUT: MOVE L,[POINT 6,0] SIX02: ILDB X1,L JUMPE X1,CPOPJ ADDI X1,40 PUSHJ P,PUT SOJ G, TLNN L,770000 POPJ P, JRST SIX02 CLRF: SKIPL CATFL1 ;FAST FLAG ON JRST CLRF1 ;NO, ALWAYS OUTPUT SOSLE CATCNT ;TIME FOR ? JRST OUTTAB ;NO, OUTPUT TAB MOVEI X1,4 ;YES, RESTORE CATCNT MOVEM X1,CATCNT ;TO WIDTH 4 JRST CLRF1 ;OUTPUT OUTTAB: MOVEI X1,11 ;SETUP TAB JRST PUT ;OUTPUT IT CLRF1: MOVEI X1,15 PUSHJ P,PUT MOVEI X1,12 PUT: SOSG OBF+2 ;PREPARE OUTPUT OUTPUT 2, IDPB X1,OBF+1 POPJ P, OCTOUT: MOVEI G,3 IDIVI X1,10 SOJE G,OCTOT1 PUSH P,X2 PUSHJ P,OCTOUT+1 POP P,X2 OCTOT1: MOVEI X1,60(X2) JRST PUT ;"COPY" HAS THE FORM: ; ; COPY DEVICE:FILENAME.EXT "RIGHT ANGLE BRACKET" DEVICE:FILENAME.EXT ; ;COPER USES THE FILENAME ANALYZER ROUTINE FILNAM AND THE FLAG COPFLG ;WHEN ANALYZING ITS TWO ARGS. COPER SETS COPFLG TO -1 BEFORE ;CALLING FILNAM AND THEN ENTERS FILNAM AT FILNM1. ALL OTHER ROUTINES ;THAT USE FILNAM ENTER THROUGH AN ENTRY POINT THAT SETS ;COPFLG TO 0. COPFLG IS USED BY FILNAM IN THE SPECIAL CASE IN WHICH ;A DEVICE BUT NOT A FILENAME IS SPECIFIED. WHEN FILNAM IS FINISHED ;PROCESSING THAT SPECIAL CASE, IT SETS COPFLG TO 0. COPER: PUSHJ P,QSA ASCIZ /Y/ JFCL SETOM COPFLG PUSHJ P,FILNM1 ;PROCESS THE FIRST ARG. JUMP IBF+1 MOVEI A,76 ;RIGHT ANGLE BRACKET CAIE A,(C) JRST COMM1 PUSHJ P,NXCH MOVE A,COPFLG MOVEM A,CATFLG ;STORE TEMPORARILY IN CATFLG. SETZM IBF ;IBF: 0 MOVEI N,TYI ;IBF+1: DEVICE MOVEM N,IBF+2 ;IBF+2: TYI MOVE N,FILDIR MOVEM N,FILD1 ;FILD1: FILENAME MOVE N,FILDIR+1 ;FILD1+1: EXT,,0 MOVEM N,FILD1+1 ;FILD1+2: 0 SETZM FILD1+2 ;FILD1+3: [ , ] MOVE N,FILDIR+3 MOVEM N,FILD1+3 COPER0: SETOM COPFLG ;PROCESS THE SECOND ARG. PUSH P,DEVBAS ;SAVE FOR ERROR MESSAGE. PUSHJ P,FILNM1 JUMP OBF+1 ;OBF: 20 ;USER WORD COUNT IS SET. TLNN C,F.CR JRST COMM1 MOVE A,DEVBAS POP P,DEVBAS MOVEI N,20 ;OBF+1: DEVICE MOVEM OBF ;OBF+2: TYO,,0 MOVEI N,TYO HRLZM N,OBF+2 ;FILDIR: AS FILD1, PLUS <>. MOVE N,IBF+1 DEVCHR N, ;CHECK THE FIRST DEVICE. JUMPN N,COPER1 COPERR: SKIPN T,DEVBAS MOVE T,IBF+1 JRST NOGETD COPER1: TLNE N,2 ;CAN THE DEVICE DO INPUT? JRST CPLAB1 ;YES. MOVEI T,NOIN ;NO. JRST ERRMSG CPLAB1: TLNN N,4 ;IS IT A DIRECTORY DEVICE? JRST CPLAB2 ;NO, GO AHEAD. SKIPN CATFLG ;YES. WAS AN EXPLICIT FILENAME GIVEN? JRST COMM1 ;NO--YOU LOSE. CPLAB2: MOVE N,OBF+1 ;YES, OKAY. NOW CHECK THE DEVCHR N, ;ANALOGOUS THINGS FOR THE JUMPN N,COPR0 ;OUTPUT DEVICE. COPERX: SKIPN T,A MOVE T,OBF+1 JRST NOGETD COPR0: TLNE N,1 JRST CPLAB3 MOVEI T,NOOUT JRST ERRMSG CPLAB3: TLNN N,4 JRST CPLAB4 SKIPN COPFLG JRST COMM1 CPLAB4: OPEN 1,IBF JRST COPERR LOOKUP 1,FILD1 JRST [SKIPN T,DEVBAS MOVE T,IBF+1 MOVEM T,SAVE1 MOVE T,FILD1 MOVEM T,FILDIR MOVE T,FILD1+1 MOVEM T,FILDIR+1 JRST NOGETF] OPEN 2,OBF JRST COPERX SKIPG MONLVL JRST COPR4 LOOKUP 2,FILDIR ;5 SERIES. JRST COPR1 HLLZ N,FILDIR+2 ;USE EXISTING < >. TLZ N,777 JRST COPR2 COPR1: MOVE N,[XWD 12,16] ;USE STANDARD < >. GETTAB N, JRST [SETZM FILDIR+2 JRST COPR3] COPR2: TLNN N,700000 IOR N,MONLVL MOVEM N,FILDIR+2 COPR3: HLLZS FILDIR+1 CLOSE 2, COPR4: ENTER 2,FILDIR JRST NOSAVE PUSH P,E ;SET UP THE BUFFERS. MOVEI E,1015 ;4 BUFFERS + 1. PUSHJ P,PANIC POP P,E MOVE N,CETXT MOVEM N,.JBFF INBUF 1,2 PUSHJ P,COPER2 ;FOR A DESCRIPTION OF THE FOLLOWING JRST COPER5 ;CODE, SEE MEMO #100-365-033-00, COPER2: OUT 2, ;SECTION 2.2.1. JRST CPLAB5 ;OUTPUT OKAY. GETSTS 2,N ;OUTPUT ERROR. JRST OUTERR CPLAB5: MOVE N,TYO+2 IDIVI N,5 JUMPE T,CPLAB6 ADDI N,1 CPLAB6: HRRZ T,TYO ADDI T,1 MOVEM N,(T) ;STORE THE WORD COUNT. ADD N,T ;N AND T CONTAIN RESPECTIVELY ADDI T,1 ;THE 1ST AND LAST LOCS TO BE FILLED EXCH N,T ;WITH DATA IN THIS OUTPUT AREA. POPJ P, COPER5: IN 1, JRST COPER3 ;INPUT OKAY. GETSTS 1,N ;INPUT ERROR OR EOF. TRNE N,020000 JRST COPEND ;EOF MOVEI T,INLSYS ;INPUT ERROR. JRST ERRMSG COPER3: HRRZ T1,TYI ADDI T1,1 HRRZ A,(T1) JUMPE A,COPER5 ;NO DATA WORDS IN THIS BUFFER. ADD A,T1 ;T1 AND A CONTAIN RESPECTIVELY THE 1ST ADDI T1,1 ;AND LAST LOCS FROM WHICH DATA CAN BE COPER6: MOVE B,T ;TRANSFERRED IN THIS INPUT AREA. SUB B,N ;B CONTAINS SIZE OF OUTPUT AREA -1. MOVE C,A SUB C,T1 ;C CONTAINS SIZE OF INPUT AREA -1. CAMG B,C ;COMPARE OUT SIZE TO IN SIZE. JRST COPER4 ADD C,N ;OUT SIZE .GT. IN SIZE. HRL N,T1 BLT N,(C) MOVEI N,1(C) ;RESET 1ST LOC TO BE FILLED WORD. JRST COPER5 ;GO BACK FOR MORE INPUT. COPER4: HRL N,T1 ;OUT SIZE .LE. IN SIZE. BLT N,(T) ADD T1,B ADDI T1,1 ;RESET 1ST LOC TO BE TRANSFERRED WORD. PUSHJ P,COPER2 ;OUTPUT. CAMG T1,A ;CAN MORE BE TAKEN FROM THIS IN BUFFER? JRST COPER6 ;YES. JRST COPER5 ;NO. COPEND: OUT 2, ;END OF FILE SEEN. JRST CPLAB7 GETSTS 2,N JRST OUTERR CPLAB7: CLOSE 2, ;(OUTPUT DEVICE WILL BE RELEASED RELEASE 1, ;VIA "BASIC"). SKIPL MONLVL JRST BASIC ;5 SERIES MONITOR. JRST PROCOD ;4 SERIES--PROTECTION CODE MUST BE SET. ;DDT ROUTINE DDTER: SETOM RUNDDT ;SET TO COMPILE PUSHJ P,DDTBRK JRST RUNER1+1 ;CONTINUE LIKE "RUN" ;DELETE (DEL) ROUTINE DELER: PUSHJ P,QSA ASCIZ /ETE/ JFCL TLNE C,F.CR ;DOES DELETE HAVE ANY ARGUMENTS? JRST BADDEL ;NO. DONT ALLOW. DELIM: PUSHJ P,GETNUM JRST COMM1 MOVEM N,FRSTLN SETOM PAKFLA ;MARK FACT THAT THERE IS A HOLE. TLNN C,F.CR TLNE C,F.COMA JRST DELIM2 TLNN C,F.MINS JRST COMM1 PUSHJ P,NXCH PUSHJ P,GETNUM JRST COMM1 DELIM2: SKIPE PAKFLG ;CRUNCH CORE? PUSHJ P,SCRER3 ;YES. MOVEM N,LASTLN PUSH P,C PUSHJ P,DELL1 POP P,C TLNN C,F.COMA JRST DELIM3 PUSHJ P,NXCH JRST DELIM DELIM3: TLNE C,F.CR JRST EDTXIT JRST COMM1 DELL1: MOVE A,FLLIN ;FIND FIRST LINE TO DELETE DELL2: CAML A,CELIN POPJ P, ;THERE IS NONE HLRZ N,(A) ;GET LINE NO CAMLE N,LASTLN ;DONE? POPJ P, CAMGE N,FRSTLN AOJA A,DELL2 PUSHJ P,LOCKON PUSHJ P,ERASE PUSHJ P,LOCKOF JRST DELL1 ;GO LOOK FOR FIRST LINE AGAIN ;WEAVE COMMAND WEAER: PUSHJ P,QSA ASCIZ /VE/ JFCL PUSHJ P,FILNAM JUMP NEWOL1 OPEN SPEC JRST [SKIPN T,DEVBAS MOVE T,NEWOL1 JRST NOGETD] LOOKUP FILDIR JRST [SKIPN T,DEVBAS MOVE T,NEWOL1 MOVEM T,SAVE1 JRST NOGETF] SKIPE PAKFLG ;CRUNCH CORE? PUSHJ P,SCRER3 ;YES. GETT2: SETZM BADGNN INBUF 1 GETT1: PUSHJ P,INLINE PUSHJ P,GETDNM JRST [TLNN C,F.CR JRST BADGET JRST GETT1] MOVEM N,BADGNN ;LAST GOOD LINE WEAVED PUSHJ P,LOCKON PUSHJ P,ERASE PUSHJ P,INSERT PUSHJ P,LOCKOF JRST GETT1 ;THIS ROUTINE PICKS UP A LINE NUMBER AND STOPS ON THE FIRST ;NON-DIGIT CHARACTER, INCLUDING SPACES AND TABS. ;IT IS USED BY OLD, WEAVE, AND MAINLP. GETDNM: MOVEI X1,5 TLNN C,F.DIG POPJ P, MOVEI N,-60(C) GETD1: MOVE G,T PUSHJ P,NXCHS SOJE X1,CPOPJ1 TLNN C,F.DIG JRST CPOPJ1 IMULI N,^D10 ADDI N,-60(C) JRST GETD1 ;HELP. HELER: PUSHJ P,QSA ASCIZ /P/ JFCL HRRZ A,.JBREL MOVEM A,.JBFF MOVE T,[SIXBIT/BASIC/] PUSHJ P,.HELPR PUSHJ P,TTYIN JRST BASIC ;LENGTH OF PROGRAM IN CORE. LENER: PUSHJ P,QSA ASCIZ /GTH/ JFCL PUSHJ P,LOCKON ;ROUTINE TO CALCULATE PROGRAM LENGTH IN CHARS. PUSHJ P,PRESS ;NOTE#### LENGTH DOES NOT INCLUDE PUSHJ P,LOCKOF ;LINE NUMBERS! MOVE T,CETXT SUB T,FLTXT IMULI T,5 SETZM HPOS PUSHJ P,PRTNUM PUSHJ P,INLMES ASCIZ / characters / OUTPUT JRST FIXUP ;TTCALL DEFINITION FOR "TAPE" AND "KEY" OPDEF TTCALL [51B8] ;TTY BACK TO KEYBOARD BIT16=2 KEYER: SETO A, TTCALL 6,A TLZ A,BIT16 TTCALL 7,A JRST BASIC ;TTY INTO PAPERTAPE READER TAPER: PUSHJ P,QSA ASCIZ /E/ JFCL SETO A, TTCALL 6,A TLO A,BIT16 TTCALL 7,A JRST BASIC ;ROUTINE TO LIST FILE LISER: PUSHJ P,QSA ASCIZ /T/ JFCL SETZI F, ;ASSUME NO HEADING DESIRED. PUSHJ P,QSA ASCIZ /NH/ SETOI F, ;HEADING IS DESIRED, OR CMD ERROR SETZM REVFL PUSHJ P,QSA ASCIZ /REV/ JRST NUMER SETOM REVFL NUMER: PUSHJ P,LINLIM ;GET LINE LIMITS OR ERROR SKIPE RETUR1 PUSHJ P,NXCH JUMPE F,LISTX ;SKIP HEADING- PUSH P,T PUSH P,C PUSHJ P,INLMES ;NO, PRINT IT. ASCIZ / / PUSHJ P,LIST01 ;TYPE THE HEADING PUSHJ P,INLMES ;AND A FEW BLANK LINES ASCIZ / / POP P,C POP P,T LISTX: SKIPE REVFL JRST LIST4 JRST LIST1 LIST01: PUSH P,T ;SAVE POINTER TO INPUT LINE PUSH P,C ;SAVE CURRENT CHAR. SKIPN CURBAS JRST LSLAB1 MOVSI T,(SIXBIT/BAS/) JRST LIST04 LSLAB1: HLRZ T,CURDEV CAIN T, ;PRINT DEVICE ONLY IF UNCOMMON. JRST LIST02 MOVE T,CURDEV LIST04: PUSHJ P,PRNSIX ;PRINT THE DEVICE NAME MOVSI T,320000 ;PRINT THE PUSHJ P,PRNSIX ;:. LIST02: MOVE T,CURNAM PUSHJ P,PRNSIX HLRZ T,CUREXT ;DONT PRINT EXT. UNLESS UNCOMMON CAIN T, JRST LIST03 TLO T,16 ;INSERT SIXBIT "." BEFORE EXT PUSHJ P,PRNSIX LIST03: PUSHJ P,TABOUT ;EXECUTE A FORMAT "," MSTIME X1, IDIVI X1,^D60000 IDIVI X1,^D60 MOVEI A,":" ;THE SEPARATION CHAR BETWEEN FIELDS. PUSHJ P,PRDE2 PUSHJ P,TABOUT ;ANOTHER FORMAT "," DATE X1, IDIVI X1,^D31 AOJ X2, MOVE A,X1 IDIVI A,^D12 AOJ B, ADDI A,^D64 MOVE T,X2 PUSHJ P,LIST06 MOVEI C,"-" PUSHJ P,OUCH MOVEI T,DATTBL-1(B) SETZ D, PUSHJ P,PRINT MOVEI C,"-" PUSHJ P,OUCH MOVE T,A PUSHJ P,LIST06 POP P,C ;RECOVER INPUT CHAR POP P,T ;RECOVER INPUT POINTER POPJ P, LIST06: IDIVI T,^D10 MOVEI C,60(T) PUSHJ P,OUCH MOVEI C,60(T1) JRST OUCH LIST1: PUSH P,C PUSH P,T SETZM HPOS MOVE A,FLLIN LIST2: CAML A,CELIN ;READ LINE LIMITS JRST LIST3 ;DONE IF NO MORE HLRZ T,(A) ;T := LINE NO CAMG T,LASTLN CAMGE T,FRSTLN ;AFTER FIRST TO PRINT? AOJA A,LIST2 ;NO SKIPE RENSW ;FOR SAVE/REPLACE ONLY JRST LSLAB2 ;(NOT FOR LIST) SET UP THE PUSHJ P,PRTNUM ;LINE NUMBER AS A JRST LIST25 ;SEQUENCE NUMBER. LSLAB2: MOVE T,TYO+2 JUMPLE T,LIST22 IDIVI T,5 JUMPE T1,LIST22 LSLAB3: SETZ C, ;PAD WITH NULLS SO THAT THE LINE PUSHJ P,OUCH ;NUMBER STARTS IN A NEW WORD. SOJG T1,LSLAB3 LIST22: HLRZ T,(A) SETZM NUMCOT PUSHJ P,PRTNUM MOVE T,NUMCOT SUBI T,5 MOVE T1,@TYO+1 JUMPE T,LIST23 LIST21: LSH T1,-7 ;PAD WITH LEADING ZEROES (RE- TLO T1,300000 ;QUIRED BY THE LINED CUSP). IBP TYO+1 SOS TYO+2 AOJL T,LIST21 LIST23: TRO T1,1 ;SET THE "SEQ. NO." BIT. MOVEM T1,@TYO+1 LIST25: MOVE T,(A) MOVEI D,15 ;QUOTE CHAR PUSHJ P,PRINT PUSHJ P,INLME1 ASCIZ / / AOJA A,LIST2 LIST3: POP P,T POP P,C CLOSE SETZI F, SKIPE RETUR1 JRST NUMER SETZM REVFL SKIPE RENSW JRST RENFIL JRST BASIC LIST4: PUSH P,C PUSH P,T SETZM HPOS MOVE A,CELIN CAMG A,FLLIN JRST LIST3 SOJ A, LIST5: HLRZ T,(A) CAML T,FRSTLN CAMLE T,LASTLN JRST LIST6 PUSHJ P,PRTNUM MOVE T,(A) MOVEI D,15 PUSHJ P,PRINT PUSHJ P,INLME1 ASCIZ / / LIST6: SOJ A, CAMGE A,FLLIN JRST LIST3 JRST LIST5 TABOUT: PUSH P,LP ;ROUTINE TO TAB OVER TO SETZ LP, ;ABOUT THE NEXT ZONE, FOR THE HEADING MOVE A,HPOS ;TYPEOUT. IDIVI A,^D14 JUMPE B,LSLAB4 SUBI B,^D14 MOVNS B LSLAB4: MOVEI C," " PUSHJ P,OUCH ;AT LEAST ONE SPACE OUT. SOJG B,LSLAB4 POP P,LP POPJ P, NEWER: SETZM OLDFLA ;FLAG WOULD BE -1 FOR "OLD" REQUEST. TLNN C,F.CR JRST NEWOL4 PUSHJ P,INLMES ASCIZ /New / JRST NEWOLD OLDER: SETOM OLDFLA SKIPN CHAFLG ;CHAINING? JRST OLDER1 ;NO. MOVEI T,DRMBUF MOVEM T,.JBFF JRST NEWOL3 OLDER1: TLNN C,F.CR JRST NEWOL4 PUSHJ P,INLMES ASCIZ /Old / NEWOLD: PUSHJ P,INLMES ASCIZ /file name--/ OUTPUT PUSHJ P,INLINE NEWOL4: PUSHJ P,FILNAM JUMP NEWOL1 TLNN C,F.CR JRST COMM1 SKIPN OLDFLA ;OLDFILE NAME? JRST NEWOL2 ;NO. ASSUME NEW NAME IS OK FOR NOW. NEWOL3: OPEN SPEC ;YES JRST [SKIPN T,DEVBAS HLRZ T,NEWOL1 JRST NOGETD] ;ILLEGAL DEV NAME. BOMB CURNAM. MOVE C,NEWOL1 DEVCHR C, ;CAN THIS DEVICE TLNE C,2 ;INPUT? JRST NWLAB1 ;YES. MOVEI T,NOIN ;NO. JRST ERRMSG NWLAB1: LOOKUP FILDIR ;REALLY AN OLD FILE? JRST [SKIPN T,DEVBAS MOVE T,NEWOL1 MOVEM T,SAVE1 JRST NOGETF] ;CAN'T FIND FILE. NEWOL2: MOVE C,[XWD F.CR,15] PUSHJ P,LINL1 ;HAVING ACCEPTED THE NAME, DO A "DELETE" PUSHJ P,SCRER1 PUSHJ P,NAMOVE ;ACCEPT NEW CURRENT FILNAM MOVE X1,NEWOL1 MOVEM X1,CURDEV SKIPE CHAFLG ;CHAINING? SETOM CHAFL2 ;YES, SET ERROR MESSAGE FLAG. SKIPE OLDFLA JRST GETT2 ;OLD FILE. FINISH BY GETTING IT. JRST BASIC ;ROUTINE TO QUEUE FILES FOR THE LINE PRINTER. INTERN QUEUEN,QUEUEM QUEUEN=SIXBIT/BASIC/ QUEUEM=QUEUEN_-^D18 QUEER: PUSHJ P,QSA ASCIZ /UE/ JFCL MOVE A,[XWD 36,23] ;CHECK TO SEE IF THE MONITOR GETTAB A, ;HAS SPOOLING. JRST NOTIMQ TLNE A,17 JRST QUEER1 NOTIMQ: MOVEI T,NOTIMP JRST ERRMSG QUEER1: SETZM HEDFLG ;ZERO THE HEADING FLAG. QUELOP: MOVEI A,40 ;ZERO THE PARAMETER AREA. QULAB1: SETZM PARAM-1(A) SOJG A,QULAB1 PUSHJ P,FILNMO ;GET THE FILENAME ARGUMENT JUMP SAVE1 OPEN 1,SAVI JRST [MOVE T,SAVE1 JRST NOGETD] MOVE A,FILDIR ;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. HLLZ A,FILDIR+1 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 SKIPN FILDIR+3 ;CURRENTLY NOT ALLOWED FROM OTHER PPNS LOOKUP 1,QLSPEC JRST [PUSHJ P,QNTFND JRST QNTFN3] ;FILE NOT FOUND. MOVE A,QLSPEC+16 MOVEM A,PARAM+24 QUESWH: TLNN C,F.SLSH ;PROCESS ANY SWITCHES JRST QUEFIN ;NO MORE SWITCHES PUSHJ P,NXCH QUECOP: TLNN C,F.DIG ;COPIES SWITCH JRST QUEUNS HRRZI B,-60(C) PUSHJ P,NXCH TLNN C,F.DIG JRST QUEER4 ;ONLY ONE DIGIT. IMULI B,12 ADDI B,-60(C) PUSHJ P,NXCH CAILE B,^D63 ;GT.63 COPIES REQUESTED? JRST QULAB3 ;YES TLNN C,F.DIG JRST QUEER4 QULAB3: MOVEI T,QCOP63 ;YES JRST ERRMSG QUEER4: JUMPE B,QCOP63 MOVE A,PARAM+37 TRNN A,77 ;DUPLICATE SWITCH? JRST QULAB4 ;NO. QDUPLC: MOVEI T,QUEDUP ;YES JRST ERRMSG QULAB4: DPB B,[XWD 000600,PARAM+37] PUSHJ P,QSAX ASCIZ /COPIES/ JRST QUESWH ;GO TO NEXT SWITCH. QUEUNS: MOVEI B,"U" ;UNSAVE SWITCH. CAIE B,(C) JRST QUELIM PUSHJ P,NXCH PUSHJ P,QSAX ASCIZ /NSAVE/ MOVE A,PARAM+37 TRNE A,700 ;DUPLICATE SWITCH? JRST QDUPLC ;YES. MOVEI B,2 ;NO. DPB B,[XWD 060200,PARAM+37] JRST QUESWH ;GO TO NEXT SWITCH. QUELIM: MOVEI B,"L" ;LIMIT SWITCH. CAIE B,(C) JRST COMM1 PUSHJ P,NXCH PUSHJ P,QSAX ASCIZ /IMIT/ HLRZ A,PARAM+21 JUMPN A,QDUPLC ;DUPLICATE SWITCH. MOVEI D,3 TLNN C,F.DIG JRST COMM1 HRRZI B,-60(C) QULIM1: PUSHJ P,NXCH TLNN C,F.DIG JRST QULIM2 IMULI B,^D10 ADDI B,-60(C) SOJG D,QULIM1 PUSHJ P,NXCH TLNN C,F.DIG JUMPN B,QULIM4 QULIM3: MOVEI T,QLIMLG JRST ERRMSG QULIM2: JUMPE B,QULIM3 QULIM4: HRLM B,PARAM+21 JRST QUESWH ;GO TO NEXT SWITCH QUEFIN: TLNN C,F.CR ;BETTER BE NOTHING LEFT TLNE C,F.COMA ;IN THIS ARG. JRST QULAB5 JRST COMM1 QULAB5: PUSH P,C PUSH P,T HLRZ A,PARAM+21 ;SET UP REST OF PARAMETER JUMPN A,QULAB6 ;AREA. MOVEI A,^D200 HRLM A,PARAM+21 ;DEFAULT--200 PAGES. QULAB6: 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 SKIPE HEDFLG JRST QUCAL1 PUSHJ P,INLMES ASCIZ / Files QUEUEd: / OUTPUT SETOM HEDFLG QUCAL1: PUSHJ P,TTYIN PUSHJ P,PRNNAM ;OUTPUT FILENAME PUSHJ P,INLMES ASCIZ/ / OUTPUT TLNE C,F.CR ;IF THE NEXT CHARACTER JRST EDTXIT ;ISN'T A LINE PUSHJ P,NXCH ;TERMINATOR, IT IS JRST QUELOP ;GUARANTEED TO BE A COMMA. 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, QNTFN2: PUSHJ P,NXCH ;SKIP TO THE QNTFN3: TLNE C,F.CR ;NEXT ARGUMENT, OR JRST EDTXIT ;THE END OF THE TLNN C,F.COMA ;COMMAND JRST QNTFN2 PUSHJ P,NXCH JRST QUELOP ;ROUTINE TO CHANGE CURRENT NAME RENER: PUSHJ P,QSA ASCIZ /AME/ JFCL TLNN C,F.CR ;IS THERE A NAME TO RENAME TO? JRST RENA1 ;YES PUSHJ P,INLMES ;PROMPT USER FOR A NAME ASCIZ /File name--/ OUTPUT PUSHJ P,INLINE ;THERE BETTER BE A NAME NOW. RENA1: SETZM OLDFLA ;REQUEST FOR NEW FILE PUSHJ P,FILNAM JUMP CURDEV ;SAVE DEVICE IN CURNAM TLNN C,F.CR JRST COMM1 PUSHJ P,NAMOVE ;SET CURINFO FROM FILDIR JRST EDTXIT ;REPLACE. REPER: PUSHJ P,QSA ASCIZ /LACE/ JFCL SETOM OLDFLA JRST SAVFIL ; ; GENERATE LINE NUMBERS ; GENER: PUSHJ P,QSA ASCIZ /ERATE/ JFCL SETOM NOBFLG ;ASSUME NO BLANK FOR NOW PUSHJ P,QSA ;SEE IF ITS THERE ASCIZ /NOB/ SETZM NOBFLG ;NOT THERE PUSHJ P,QSA ;SCAN OFF THE REST ASCIZ /LANK/ JFCL PUSHJ P,LIMITS MOVE N,LASTLN HRRZM N,LOWEST MOVEI N,^D10 SKIPN FRSTLN MOVEM N,FRSTLN TLNN C,F.COMA JRST GEN1 PUSHJ P,NXCH PUSHJ P,GETNUM JRST COMM1 GEN1: MOVEM N,LASTLN GEN2: MOVSI G,440700 HRRI G,LINB0 MOVE T,FRSTLN PUSHJ P,PRTNUM OUTPUT SKIPE NOBFLG JRST [PUSHJ P,INLINE JRST GEN2B] OUTCHR GEN2A ;PUT OUT BLANK GEN2A: MOVEI C," " ;AND SET UP TO PUSH P,[XWD Z,GEN2B] PUSH P,X1 ;PUT ONE IN PUSH P,[XWD Z,INLB1] JRST INLGEN ;THE LINE BUFFER GEN2B: TLNE C,F.ESC JRST GEN3 PUSHJ P,LOCKON MOVE N,FRSTLN PUSHJ P,ERASE PUSHJ P,INSERT SKIPE SYNTAX PUSHJ P,SYNCHK PUSHJ P,LOCKOF MOVE X1,FRSTLN ADD X1,LASTLN SKIPN LOWEST JRST GEN3A CAMLE X1,LOWEST JRST GEN3 GEN3A: MOVEM X1,FRSTLN CAIG X1,^D99999 JRST GEN2 GEN3: JRST BASIC ;ROUTINE TO TURN OFF OR ON SYNTAX CHECKING ; SYNER: PUSHJ P,QSA ASCIZ /TAX/ JFCL SETOM SYNTAX JRST EDTXIT NOSER: PUSHJ P,QSA ASCIZ /YNTAX/ JFCL CLEARM SYNTAX JRST EDTXIT ;ROUTINE TO RENUMBER THE BASIC PROGRAM THAT IS IN CORE. ;THE COMMAND IS ; RESEQUENCE NN,MM,LL ;WHERE NN IS THE FIRST NUMBER AND LL IS THE STEP VALUE. ;IF OMITTED, LL, OR BOTH NUMBERS=10 ;ALL LINE NUMBERS LESS THAN MM WILL NOT BE RESEQUENCED. MM MUST NOT ;BE GREATER THAN NN ;A NUMBER IS A LINE NUMBER IF: ;IT IS THE FIRST ATOM ON A LINE. ; IT FOLLOWS AN ATOM BEGINNING WITH THE LETTERS: ; "GOS" OR "GOT" OR "THE" ;ALSO, AFTER THE ATOM "GOTO" HAS BEEN IDENTIFIED, THE NUMBER ;FOLLOWING A COMMA IS A LINE NUMBER. ;REENTRY IS NOT ALLOWED DURING "RESEQUENCE". RESER: PUSHJ P,QSA ASCIZ /EQUENCE/ JFCL SETZM USGFLG PUSHJ P,LIMITS MOVE N,LASTLN ;GET THE SECOND NUMBER(::=LOWEST) HRRZM N,LOWEST MOVEI N,^D10 ;IF FIRST ARG=0, ASSUME FIRST LINE=10 SKIPN FRSTLN MOVEM N,FRSTLN TLNE C,F.CR ;END OF COMMAND ? JRST RES1 ;LET INCREMENT BE DEFAULT (^D10) TLNN C,F.COMA ;NO, DELIMITER ? JRST COMM1 ;NO, ERROR PUSHJ P,NXCH PUSHJ P,GETNUM JRST COMM1 SKIPN N ;NON-ZERO INCREMENT ? JRST RESER1 ;NO, ERROR RES1: SKIPE PAKFLG ;CRUNCH CORE? PUSHJ P,SCRER3 ;YES. MOVEM N,LASTLN ;SAVE INCREMENT HRLZ A,LOWEST ;SEARCH FOR FIRST LINE TO CHANGE MOVEI R,LINROL PUSHJ P,SEARCH JFCL CAMN B,FLLIN ;RESEQ ALL LINES? JRST SEQ0 ;YES. HLRZ N,-1(B) ;NO. MAKE SURE LINE ORDER WILL NOT CHANGE CAMGE N,FRSTLN JRST SEQ0 RESER1: MOVEI T,RESERR JRST ERRMSG SEQ0: MOVN X2,B ADD X2,CELIN ;THIS IS THE NUMBER OF LINES TO RESEQ SUBI X2,1 IMUL X2,LASTLN ADD X2,FRSTLN CAILE X2,^D99999 JRST SEQOV PUSHJ P,LOCKON ;DONT ALLOW REENTRY. MOVE E,CELIN ;COMPUTE NUMBER OF LINES SUB E,B JUMPE E,EDTXIT ;NOTHING TO RENUMBER MOVN L,E MOVSI L,(L) SUB B,FLLIN MOVEM B,LOWSTA HRR L,B PUSH P,L ;SAVE L FOR SECOND LOOP. HRL B,B SUB L,B ;THE LOOP THAT COPIES EACH LINE FOLLOWS: SEQ2: MOVE D,[POINT 7,LINB0] ;BUILD EACH LINE IN LINB0. THEN REINSERT IT. MOVEM D,SEQPNT HRRZ F,L ADD F,FLLIN HRRZ T,(F) HRLI T,440700 ;POINTER TO OLD LINE IS IN G ;F USED AS A FLAG REGISTER FOR " ' ETC. ;THE FLAGS ARE REST.F=1 ;COPY THE REST (APOST SEEN) TOQU.F=2 ;COPY TO QUOTE SIGN COMM.F=4 ;LINE NUMBER FOLLOWS ANY COMMA NUM.F=10 ;NEXT NUMBER IS LINE NUMBER PUSH P,T PUSHJ P,NXCH CAIN C,":" JRST SEQ21 PUSHJ P,QSA ASCIZ /DATA/ JRST SQLAB1 SEQ21: TLO F,REST.F ;IMAGE OR DATA STA.--SET "APOST SEEN". SQLAB1: POP P,T ;THE CHARACTER/ATOM LOOP: SEQ3: PUSHJ P,NXCHD ;GET NEXT CHAR, EVEN IF SPACE OR TAB SEQ31: CAMN C,[XWD F.CR,12] ;LINE FEED ? JRST SEQCPY ;YES, JUST COPY TLNE C,F.CR JRST SEQCR TLNE C,F.QUOT ;TEST FOR QUOTE CHAR TLCA F,TOQU.F ;REVERSE QUOTE SWITCH AND COPY THIS CHAR TLNE F,TOQU.F JRST SEQ5 JRST SEQ52 SEQ5: SKIPN USGFLG JRST SEQCPY TLZ F,NUM.F SETZM USGFLG JRST SEQCPY SEQ52: TLNE C,F.APOS PUSHJ P,[MOVEI B,"\" ;\ IS ALSO A STATEMENT TERMINATOR CAIN B,(C) TLZA F,NUM.F+COMM.F TLO F,REST.F POPJ P,] TLNE F,REST.F JRST SEQ5 MOVE G,T ;SAVE POINTER TLNN F,NUM.F ;EXPECTING A LINE NUMBER? JRST SEQ57 ;NO. LOOK FOR KEYW ATOMS TLNE C,F.DIG JRST SEQ56 SKIPN USGFLG JRST SEQ5 CAMN C,[1000000043] ;SPECIAL HANDLING FOR USING STAS, JRST SEQ53 ;FROM HERE UP TO SEQ56. TLNE C,F.SPTB JRST SEQCPY TLZ F,NUM.F JRST SEQ5 SEQ53: IDPB C,SEQPNT PUSHJ P,NXCHD CAMN C,[XWD F.CR,12] ;LINE FEED ? JRST SEQ53 ;YES, SKIP LIKE SPACE TLNE C,F.CR JRST SEQCR TLNE C,F.SPTB JRST SEQ53 TLNE C,F.DIG JRST SEQ54 TLZ F,NUM.F JRST SEQ5 SEQ54: IDPB C,SEQPNT PUSHJ P,NXCHD CAMN C,[XWD F.CR,12] ;LINE FEED ? JRST SEQ54 ;YES, SKIP LIKE SPACE TLNE C,F.CR JRST SEQCR TLNE C,F.SPTB JRST SEQ54 CAIE C,":" TLNE C,F.COMA JRST SEQ55 JRST SEQ5 SEQ55: IDPB C,SEQPNT PUSHJ P,NXCHD TLNE C,F.SPTB JRST SEQ55 TLNN C,F.DIG JRST SEQ5 SEQ56: SETZM USGFLG JRST SEQNUM SEQ57: SETZM USGFLG TLNE F,COMM.F TLNN C,F.COMA JRST SQLAB2 TLO F,NUM.F ;THIS COMMA IMPLIES NUMBER TO FOLLOW JRST SEQCPY SQLAB2: PUSHJ P,ALPHSX ;PUT NEXT ALL-LETTER ATOM IN A MOVEI B,SEQTND-SEQTBL ;SET INDEX FOR TABLE OF KEYWORDS PRECEDING LINE NUMBERS MOVE T,G ;RESET CHAR POINTER TO START OF ATOM. CAMN A,SEQLL ;[1] SPECIAL TEST FOR LL FUNCTION CAIE C,"(" ;[1] MUST BE FOLLOWED BY ( SQLAB3: CAMN A,SEQTBL(B) TLOA F,NUM.F+COMM.F ;WE FOUND A KEYWORD SOJGE B,SQLAB3 CAME A,[SIXBIT /USING/] JRST SEQ6 ;ONE MORE SPECIAL CASE TLO F,NUM.F SETOM USGFLG LDB C,T IDPB C,SEQPNT MOVEI A,4 SQLAB4: PUSHJ P,NXCHS IDPB C,SEQPNT SOJG A,SQLAB4 JRST SEQ3 SEQ6: CAME A,[SIXBIT /ASC/] ;FUNCTION ASC ? JRST SEQCP1 ;NO, GO ON PUSHJ P,NXCH ;YES, ADVANCE PUSHJ P,NXCH ;TWO CHARS PUSHJ P,NXCH ;GET, HOPEFULLY, ( TLNE C,F.CR ;TERMINATOR ? JRST SEQ61 ;YES, FINISH UP PUSHJ P,NXCH ;GET NEXT CHAR TLNE C,F.QUOT ;IS IT A QUOTE ? TLO F,TOQU.F ;YES, FAKE PRIOR QUOTE SEQ61: MOVE T,G ;SET BACK POINTER TO START SEQCP1: LDB C,T SEQCPY: IDPB C,SEQPNT JRST SEQ3 SEQTBL: SIXBIT /GOSUB/ ;TABLE OF KEYWORDS PRECEDING LINE NUMBERS SIXBIT /GOTO/ SIXBIT /ELSE/ ; Delete [1] SIXBIT /LL/ SEQORG: SIXBIT /ORGOTO/ SEQRES: SIXBIT /RESUME/ SEQTND: SIXBIT /THEN/ SEQLL: SIXBIT /LL/ ;[1] FOR TEST FOR LL FUNCTION SEQNUM: PUSH P,G ;SAVE POINTER IN CASE OF "GLOBAL" LINE NUMBER PUSHJ P,GTNUMB HALT . CAMGE N,LOWEST JRST SEQB1 ;DONT RESEQ THIS NUMBER CAIE B,SEQORG-SEQTBL ;ON ERROR GO TO CAIN B,SEQRES-SEQTBL ;AND RESUME JUMPE N,SEQB1 ;CAN HAVE ARG OF 0 PUSH P,B ;SAVE B MOVEI R,LINROL HRLZ A,N PUSHJ P,SEARCH JRST SEQBAD SUB B,FLLIN SUB B,LOWSTA IMUL B,LASTLN ADD B,FRSTLN ;THIS IS THE NEW LINE NUMBER MOVE X1,B PUSHJ P,MAKNUM ;DEPOSIT THE NUMBER IN LINB0 POP P,B ;RESTORE B POP P,X1 ;CLEAR PLIST A LITTLE TLZ F,NUM.F LDB C,T PUSHJ P,NXCHD2 TLNN C,F.COMA TLZ F,COMM.F JRST SEQ31 SEQBAD: PUSH P,N PUSHJ P,INLMES ASCIZ / ? Undefined line number / POP P,T ;PRINT "GLOBAL" LINE NUMBER PUSHJ P,PRTNUM PUSHJ P,INLMES ASCIZ / in line / HLRZ T,(F) PUSHJ P,PRTNUM PUSHJ P,INLMES ASCIZ / / OUTPUT POP P,B ;ADJUST PDL SEQB1: POP P,T ;POINT TO BAD NUMBER OR NUMBER LDB C,T ;WHICH DOES NOT HAVE TO BE TLZ F,NUM.F ;RESEQUENCED. JRST SEQCPY ;COPY IT SEQCR: SETZM USGFLG IDPB C,SEQPNT HLRZ N,(F) PUSHJ P,ERASE ;ERASE OLD LINE COPY MOVE T1,SEQPNT ;POINT TO END OF LINE FOR NEWLIN PUSHJ P,NEWLIN ;INSERT NEW ONE WITH OLD LINE NUMBER. AOBJN L,SEQ2 ;DO NEXT LINE POP P,L ADD L,FLLIN MOVE N,FRSTLN SQLAB5: HRLM N,(L) ADD N,LASTLN AOBJN L,SQLAB5 JRST EDTXIT ;FINISHED. ALLOW REENTRY. SEQOV: PUSHJ P,INLMES ASCIZ / ? Command error (line numbers may not exceed 99999) / JRST FIXUP ;ROUTINE TO SAVE PROGRAM SAVER: PUSHJ P,QSA ASCIZ /E/ JRST SAVX1 SAVX2: PUSH P,[XWD 0,SAVX3] SAVX4: SETZM OLDFLA ;SAVE "NEW" FILE ONLY SAVFIL: PUSHJ P,FILNAM ;REPLACE ENTERS HERE. JUMP SAVE1 SKIPN OLDFLA ;WAS IT REPLACE ? POPJ P, ;NO, RETURN SAVX3: ;SAVE RETURNS TO HERE TLNN C,F.CR JRST COMM1 PUSHJ P,LIMITS MOVE A,SAVE1 ;CAN THE DEVICE DEVCHR A, ;BE TLNE A,1 ;OUTPUT TO? JRST SVLAB1 ;YES. MOVEI T,NOOUT JRST ERRMSG SVLAB1: OPEN SAVI JRST [SKIPN T,DEVBAS MOVE T,SAVE1 ;ILLEGAL DEVICE NAME JRST NOGETD] PUSHJ P,LOCKON ;DONT ALLOW REENTRY UNTIL ;SAVE IS CHANGED TO BUILD TEMP FILE AND RENAME. SKIPE OLDFLA ;TRYING TO SAVE NEW FILE? JRST SAVE3 TLNN A,4 ;YES, DOES THE DEVICE HAVE A DIR? JRST SAVE2 ;NO. MOVE A,FILDIR+3 LOOKUP FILDIR ;YES, DOES THE FILE EXIST? JRST [MOVEM A,FILDIR+3 JRST SAVE2] ;NO, GOOD MOVEI T,NOTNEW JRST ERRMSG SAVE3: LOOKUP FILDIR ;IS THIS REALLY AN OLDFILE? JRST [SKIPE A,DEVBAS ;NO, GRONK. MOVEM A,SAVE1 JRST NOGETF] SAVE2: CLOSE ;OTHERWISE REPLACE WILL APPEND. HLLZS FILDIR+1 ;LEVEL D FIX. SKIPN OLDFLA JRST SAVE4 HLLZ A,FILDIR+2 ;SAVE < > FOR REPLACE. TLZ A,777 MOVEM A,FILDIR+2 JRST SAVE5 SAVE4: SETZM FILDIR+2 SAVE5: MOVE A,FILDIR+3 ;KEEP PPN ENTER FILDIR JRST NOSAVE MOVEM A,FILDIR+3 ;RESTORE IT OUTBUF 1 SETOM RENSW JRST LIST1 RENFIL: SETZM RENSW MOVE A,SAVE1 DEVCHR A, ;ONLY SET THE PROTECTION FOR DISK. TLNE A,4 TLNE A,100 JRST BASIC OPEN SAVI JRST [SKIPN T,DEVBAS MOVE T,SAVE1 JRST NOGETD] PROCOD: HLLZS FILDIR+1 SETZM FILDIR+2 LOOKUP FILDIR JRST NOGETF HLLZ A,FILDIR+2 TLZ A,777 SKIPL MONLVL TLNN A,700000 IOR A,MONLVL ;MONLVL CONTAINS THE APPROPRIATE MOVEM A,FILDIR+2 ;"DON'T DELETE" BIT. HLLZS FILDIR+1 RENAME FILDIR JRST SVLAB2 JRST BASIC SVLAB2: MOVEI T,NOREN JRST ERRMSG NOREN: ASCIZ / ? File SAVEd but not protected/ SAVX1: PUSHJ P,QSA ;SAVE FILE REQUIRED ? ASCIZ /FIL/ JRST SAVX2 ;NO SETO A, PUSHJ P,QSA ;LINES WANTED ? ASCIZ /NL/ SETZ A, ;YES PUSH P,A ;SAVE A PUSHJ P,SAVX4 ;GO GET FILE NAME POP P,A ;GET BACK A SKIPN STARFL ;DEVICE SEEN ? TLNN C,F.CR ;LINE TERMINATED ? JRST COMM1 ;NO SETOM COMTIM ;YES, SET UP FOR COMPILE SETOM RUNLIN MOVEM A,NOTLIN MOVE A,FILDIR ;GET FILE NAME MOVEM A,SAVRUN ;SAVE AS FLAG SETZB A,SORCLN JRST RUNNH ;GO RUN COMPILE ;ROUTINE TO CLEAR TXTROL. SCRER: PUSHJ P,QSA ASCIZ /ATCH/ JFCL TLNN C,F.TERM JRST COMM1 PUSH P,[EXP EDTXIT] SCRER1: SKIPN SWAPSS ;ENTRY POINT FOR NEW, OLD, AND SCRATCH JRST SCRER2 ;TO CRUNCH CORE FOR A SWAPPING SYSTEM. MOVE X1,.JBREL CAILE X1,377777 JRST SCRER2 ;DON'T CRUNCH--ERRORS WILL RESULT. MOVE X1,SJOBRL CORE X1, JFCL MOVE X1,SJOBSA MOVEM X1,FLTXT ;WIPE OUT LINROL AND TXTROL. MOVEM X1,CETXT MOVE X1,.JBREL MOVEM X1,FLLIN MOVEM X1,CELIN SETZM PAKFLG POPJ P, SCRER2: MOVE X1,FLTXT ;WIPE OUT LINROL AND TXTROL. MOVEM X1,CETXT MOVE X1,FLLIN MOVEM X1,CELIN POPJ P, SCRER3: PUSH P,X1 ;ENTRY POINT FOR EDITS TO CRUNCH CORE MOVE X1,.JBREL ;THEY ONLY GET HERE FOR SWAPPING SYSTEMS. CAILE X1,377777 JRST SCRER5 ;DON'T CRUNCH--ERRORS WILL RESULT. MOVE X1,CELIN ;SAVE LINROL AND TXTROL. CAMG X1,SJOBRL ;CELIN .GT. ORIGINAL .JBREL? SKIPA X1,SJOBRL ADDI X1,2000 ;ALLOW SOME EXTRA SPACE. CAML X1,.JBREL JRST SCRER5 SCRER4: CORE X1, JFCL SCRER5: SETZM PAKFLG POP P,X1 POPJ P, \ ;ROUTINES TO RETURN TO THE SYSTEM. SYSER: PUSHJ P,QSA ASCIZ /TEM/ JFCL EXIT MONER: PUSHJ P,QSA ASCIZ /ITOR/ JFCL EXIT 1, JRST BASIC ;ROUTINE TO UNSAVE FILES "UNS" OR "UNSAVE" UNSER: PUSHJ P,QSA ASCIZ /AVE/ JFCL SETZM HEDFLG ;PRINT HEADING WHEN HEDFLG =0. UNS3: TLNN C,F.CR JRST UNS1 PUSHJ P,FILNAM ;DSK:CURFIL.CUREXT. UNSVFL: JUMP SAVE1 PUSHJ P,UNSER1 JRST BASIC UNS1: TLNN C,F.COMA JRST UNS2 PUSHJ P,FILNAM ;DSK:CURFIL.CUREXT. JUMP SAVE1 PUSHJ P,UNSER1 JRST UNS6 UNS2: PUSHJ P,FILNAM ;MORE OR LESS REAL FILENAME. JUMP SAVE1 TLNE C,F.CR ;CHECK LEGAL FORM BEFORE DOING ANYTHING. JRST UNLAB1 TLNN C,F.COMA JRST COMM1 UNLAB1: MOVE A,SAVE1 DEVCHR A, ;DEVICE MUST BE DISK OR DECTAPE. TLNN A,200100 JRST UNS4 ;FAIL. PUSHJ P,UNSER1 UNS5: TLNE C,F.CR JRST BASIC TLNN C,F.COMA JRST COMM1 UNS6: PUSHJ P,NXCH JRST UNS3 UNS4: PUSHJ P,INLMES ASCIZ / ? UNSAVE device must be disk or DECtape, file / SKIPE A,DEVBAS MOVEM A,SAVE1 PUSHJ P,PRNNAM OUTPUT SETZM HEDFLG JRST UNS5 UNSATP: UNSER1: OPEN SAVI JRST UNER1 LOOKUP FILDIR ;LOOKUP THE FILENAME JRST UNER2 CLOSE MOVE A,FILDIR SETZM FILDIR RENAME FILDIR ;ZERO DIRECTORY ENTRY JRST UNER3 SKIPE HEDFLG JRST UNSR12 PUSHJ P,INLMES ASCIZ / Files UNSAVEd: / OUTPUT SETOM HEDFLG UNSR12: PUSHJ P,TTYIN MOVEM A,FILDIR SKIPE A,DEVBAS MOVEM A,SAVE1 SETZM FILDIR+3 PUSHJ P,PRNNAM PUSHJ P,INLMES ASCIZ / / OUTPUT POPJ P, UNER1: PUSHJ P,INLMES ;ERROR MESSAGES. ASCIZ / ? No such device / SKIPE A,DEVBAS MOVEM A,SAVE1 PUSHJ P,PRNNAM UNEROU: OUTPUT SETZM HEDFLG POPJ P, UNER2: SKIPE A,DEVBAS MOVEM A,SAVE1 PUSHJ P,QNTFND JRST UNEROU UNER3: PUSHJ P,INLMES ASCIZ / ? File / MOVEM A,FILDIR SKIPE A,DEVBAS MOVEM A,SAVE1 SETZM FILDIR+3 PUSHJ P,PRNNAM PUSHJ P,INLMES ASCIZ / could not be UNSAVEd/ JRST UNEROU NAMOVE: MOVE X1,FILDIR MOVEM X1,CURNAM MOVE X1,FILDIR+1 MOVEM X1,CUREXT SETZM CURBAS SKIPE DEVBAS SETOM CURBAS POPJ P, ;ROUTINES TO SET LINE LIMITS LIMITS: TLNE C,F.CR JRST LIMIT1 PUSHJ P,GETNUM LIMIT1: MOVEI N,0 MOVEM N,FRSTLN TLNE C,F.CR JRST LIMIT2 TLNN C,F.COMA JRST COMM1 PUSHJ P,NXCH PUSHJ P,GETNUM LIMIT2: MOVSI N,1 MOVEM N,LASTLN POPJ P, LINLIM: SETZM RETUR1 SKIPN REVFL TLNE C,F.CR JRST LINL3 PUSHJ P,GETNUM LINL1: MOVEI N,0 MOVEM N,FRSTLN TLNN C,F.CR JRST LINL4 LINL6: MOVEM N,LASTLN POPJ P, LINL4: TLNN C,F.COMA JRST LINL5 SETOM RETUR1 JRST LINL6 LINL5: TLNN C,F.MINS JRST COMM1 PUSHJ P,NXCH PUSHJ P,GETNUM MOVSI N,1 MOVEM N,LASTLN HRRZ C,C CAIN C,54 SETOM RETUR1 POPJ P, LINL3: SETZM FRSTLN MOVSI N,1 MOVEM N,LASTLN POPJ P, ;A NONPRINTING ROUTINE SIMILAR TO PRTNUM: MAKNUZ: SETZM @SEQPNT ;CLEAR JUNK BEFORE LINE NO CALC MAKNUM: IDIVI X1,^D10 JUMPE X1,MAKN1 PUSH P,X2 PUSHJ P,MAKNUM POP P,X2 MAKN1: MOVEI X2,60(X2) IDPB X2,SEQPNT POPJ P, ;HERE WE HAVE A LINE OF INPUT AND THERE IS NO EXISTING LINE INSERT: MOVE T1,[POINT 7,LINB0] MOVE T,G ;RESTORE PNTR TO 1ST CHR INSE2: ILDB C,T ;GET NEXT CHAR INSE3: IDPB C,T1 CAIE C,15 ;CHECK FOR CAR RET JRST INSE2 INSE4: CAMN T1,[POINT 7,LINB0,6] POPJ P, MOVEI C,0 ;CLEAR REST OF WORD INLAB1: TLNN T1,760000 JRST NEWLIN IDPB C,T1 JRST INLAB1 ;AT THIS POINT, N CONTAINS A LINE NUMBER AND LINB0 CONTAINS ;A NON-EMPTY INSERTED LINE. T1 CONTAINS ADDRESS OF LAST ;WORD OF THE LINE. NEWLIN: MOVEI T1,(T1) ;COMPUTE LINE LENGTH SUBI T1,LINB0-1 ADD T1,CETXT ;COMPUTE NEW CEILING OF TEXT ROLL CAMGE T1,FLLIN ;ROOM FOR LINE PLUS LINROL ENTRY? JRST NEWL1 ;YES NEWL0: SUB T1,CETXT ;ASK FOR MORE CORE MOVE E,T1 ADDI E,1 PUSHJ P,PANIC ADD T1,CETXT NEWL1: MOVE D,CETXT ;LOC OF NEW LINE MOVE T,D ;CONSTRUCT BLT PNTR HRLI T,LINB0 BLT T,-1(T1) ;MOVE THE LINE MOVEM T1,CETXT ;STORE NEW CEILING ;HERE, LINE IS IN PLACE, ITS LOC IN D, LINE NUMBER IN N. ;MUST STILL PUT LINE NUMBER IN LINROL. NEWNBR: PUSH P,D MOVEI R,LINROL HRLZ A,N PUSHJ P,SEARCH JRST NNLAB1 HALT . ;*****IMPOSSIBLE CONDITION***** NNLAB1: MOVEI E,1 PUSHJ P,OPENUP ;MAKE ROOM FOR IT POP P,D ;*****OTHER HALF OF JUST IN CASE***** HRRI A,(D) ;CONSTRUCT LINROL ENTRY MOVEM A,(B) ;STORE ENTRY POPJ P, ;ALL DONE SUBTTL ERROR MESSAGES NOOUT: ASCIZ / ? Cannot output to this device/ NOIN: ASCIZ / ? Cannot input from this device/ COMM1: PUSHJ P,INLMES ASCIZ / ? What? Ready / JRST FIXUP BADDEL: PUSHJ P,INLMES ;DELETE COMMAND HAD NO ARGUMENTS. ASCIZ / ? DELETE command must specify which lines to delete / JRST FIXUP NOSAVE: PUSHJ P,TTYIN PUSHJ P,INLMES ASCIZ / ? Cannot output / MOVE T,FILDIR PUSHJ P,PRNSIX HLRZ T,FILDIR+1 CAIN T, JRST NSLAB1 TLO T,16 PUSHJ P,PRNSIX NSLAB1: OUTPUT SETZM HPOS JRST BASIC QCOP63: ASCIZ / ? < 1 or > 63 copies requested in QUEUE argument / QUEDUP: ASCIZ / ? Duplicate switch in QUEUE argument / QLIMLG: ASCIZ / ? Page limit < 1 or > 9999 in QUEUE argument / CATFAL: ASCIZ / ? CATALOG device must be disk or DECtape / NOTIMP: ASCIZ / ? This command is not implemented for this monitor / NOGETF: PUSHJ P,QNTFND JRST BASIC EXTERN BADGNN BADGET: TTCALL 3,ASCMSG MOVE X1,[POINT 7,BADGNN] MOVEM X1,SEQPNT MOVE X1,BADGNN ;LAST GOOD LINE NUMBER. TLNN X1,-1 ;HAS IT BEEN CHANGED ALREADY? PUSHJ P,MAKNUZ ;NO, MAKE THE NUMBER TTCALL 3,BADGNN SKIPN CHAFL2 ;CHAINING? JRST BADG4 ;NO. TTCALL 3,ASCIN ;YES. SKIPN CURBAS JRST BADG0 MOVEI C,[ASCIZ/BAS/] JRST BADG1 BADG0: HLRZ T,CURDEV CAIN T, JRST BADG11 MOVE C,CURDEV PUSHJ P,UNPACK BADG1: TTCALL 3,(C) TTCALL 3,ASCCLN BADG11: MOVE C,CURNAM PUSHJ P,UNPACK TTCALL 3,(C) HLRZ C,CUREXT CAIN C, JRST BADG4 TTCALL 3,ASCPER HLLZ C,CUREXT PUSHJ P,UNPACK TTCALL 3,(C) BADG4: TTCALL 3,ASCCR JRST GETT1 ASCMSG: ASCIZ/% Missing line number following line / ASCIN: ASCIZ / in / ASCCLN: ASCIZ /:/ ASCPER: ASCIZ /./ ASCCR: ASCIZ / / NOTNEW: ASCIZ / ? Duplicate file name. REPLACE or RENAME/ RESERR: ASCIZ / ? Command error (you may not overwrite lines or change their order) / SUBTTL COMPILER INTERFACE ;BEGINNING OF COMPILATION RUNER: PUSHJ P,QSA ;WANT TO RUN A SAV FILE ASCIZ /SAV/ JRST RUNER2 ;NO, JUST CARRY ON SETOM RUNUUO ;MARK TO RUN FORTRAN JRST RUNER4 ; RUNER2: PUSHJ P,QSA ;SEE IF USER WANTED IT ASCIZ /FSAV/ JRST RUNER1 MOVEI X1,-1 ; MOVEM X1,RUNUUO ; RUNER4: PUSHJ P,FILNAM ;GET FILE NAME JUMP NEWOL1 TLNN C,F.CR ;LINE TERMINATED ? JRST COMM1 ;NO JRST LCHAIN ;YES, GO TRY TO RUN IT RUNER1: SETZM RUNDDT ;NO BREAKPOINTS SETOM COMTIM MOVEI A,0 PUSHJ P,QSA ;IS IT RUNNH? ASCIZ /NH/ MOVEI A,1 ;NO PRINT HEADING SETOM RUNLIN TLNE C,F.CR ;IS THERE A LINE NUMBER ARGUMENT? JRST RUNER3 ;NO, LEAVE RUNLIN SET TO -1. PUSHJ P,GETDNM JRST COMM1 TLNN C,F.CR JRST COMM1 MOVEM N,RUNLIN ;YES, STORE THE LINE NUMBER IN RUNLIN. RUNER3: JUMPE A,RUNNH ;SHALL WE PRINT THE HEADING? PUSHJ P,INLMES ASCIZ / / PUSHJ P,LIST01 ;PRINT HEADING SANS OUTPUT PUSHJ P,INLMES BYTE (7) 15,12,12 ;SKIP TWO LINES JRST RUNNH INTERN EDTXIT EDTXIT: SETZM CHAFL2 SETZM CHAFLG JRST XXXXXX## UXIT1: JRST EDTXT1 ;THIS ROUTINE UNPACKS THE SIXBIT CHARACTERS IN AC C INTO ;ASCIZ IN ACS T AND T1. ;SCRATCH ACS ARE X1, X2, A, AND B. ;AC C IS SET UP AT THE END TO CONTAIN THE ADDRESS T. UNPACK: SETZB T,T1 ;BE SURE OF TRAILING NULLS. MOVE X1,[POINT 6,C,] MOVE X2,[POINT 7,T,] MOVEI B,6 UNPCK1: ILDB A,X1 JUMPE A,UNPCK2 ADDI A,40 IDPB A,X2 SOJG B,UNPCK1 UNPCK2: MOVEI C,T POPJ P, ;SPECIAL DECIMAL PRINT ROUTINE. PRINTS X1,X2 AS DECIMAL NUMBERS ;SEPARATED BY THE CHARACTER IN ACCUM "A". ;IF X1 OR X2 ARE ZERO, THEY PRINT AS "00". PRDE2: MOVE T,X1 PUSHJ P,PRDE1 MOVE C,A PRDE2A: PUSHJ P,OUCH MOVE T,X2 MOVEI A,177 PRDE1: MOVEI C,"0" ;A ONE DIGIT NUMBER? CAIG T,^D9 PUSHJ P,OUCH ;YES. PUT OUT LEADING ZERO. JRST PRTNUM ;SPECIAL RUNTIME PRINTER RTIME: PUSHJ P,INLMES ASCIZ / Time: / SETZ X1, ;SET UP AC FOR RUNTIM. RUNTIM X1, ;GET TIME NOW. SUB X1,MTIME ;GET ELAPSED TIME. IDIVI X1,^D10 ;REMOVE THOUSANDTHS. IDIVI X1,^D100 ;SECS TO X1, TENTHS AND HUNDREDS TO X2. MOVE T,X1 ;OUTPUT THE PUSHJ P,PRTNUM ;SECONDS. MOVEI C,"." ;OUTPUT ., THE TENTHS, PUSHJ P,PRDE2A ;AND THE HUNDREDTHS. PUSHJ P,INLMES ASCIZ / secs. / SETZM MTIME OUTPUT POPJ P, 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,THNELS,THNCNT,TRNFLG,VSPROL,WRREFL EXTERN ASCIIB,ATANB,CHRB,CLOGB,COSB,COTB,DATEB,DAYB,EXPB,FIXB EXTERN ECHOB,IFFLAG,INSTRB,INTB,JFCLAD,LEFTB,LENB,LINEB EXTERN LOGB,MIDB,PIB,POSB,RELROL,RIGHTB,RNDB,SINB,SLEEPB 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) < > 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: SYNCHK: POP P,SYNTAX MOVE T,[POINT 7,LINB0] MOVSI D,LINB0 ;DUMMY UP D FOR ELIDED LET SETZB F,MULLIN ;INITIALIZE MULTI-LINE SWITCH ; ;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 ;SET UP MULTI-LINE SETZM THNELS ;NO CONDITIONAL SEEN YET SETZM THNCNT ;NO THEN SEEN YET PUSHJ P,NXCHK ;SET UP POINTER TO THIS LINE. CAIA ;SKIP MULTI-LINE INSTRUCTION EACHL0: MOVE D,T ;GET MULTI-LINE POINTER TLNE C,F.TERM ;A DELETION 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 ;FIRST CHAR MUST BE A LETTER JRST ILLINS ;IT WAS NOT 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 MDLAB1 ; JRST MODLOO ;YES, DO THEM MDLAB1: TLNE C,F.TERM ;SEEN TERMINATOR YET JRST NXSM2 ; PUSHJ P,QSELS ; JRST ERTERM ;NO, ABOUT TIME MOVEM T,MULLIN ; JRST EACHLN ; NXSM2: MOVEI D,"\" ;WAS IT CAIE D,(C) ;BACKSLASH ? XREM: JRST @SYNTAX ;NO, REALLY NEXT LINE MOVEM T,MULLIN ;YES, SET MULTI-LINE PUSHJ P,NXCH ;GET NEXT CHAR JRST EACHLN 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 PUSH P,C PUSH P,T PUSHJ P,NXCH TLNE C,F.DIG PUSHJ P,NXCH CAMN C,[XWD F.STR,"%"] PUSHJ P,NXCH PUSHJ P,QSA ASCIZ /TO/ JRST XCHAN3 HRLI F,1 TLNN C,F.LETT JRST ERLETT PUSHJ P,ATOM CAIE A,5 CAIN A,6 JRST NXTSTA JRST ILFORM XCHAN3: POP P,T POP P,C XCHAN1: PUSHJ P,FORMLS ;PROCESS STRING NAME PUSHJ P,QSF ASCIZ /TO/ HRLI F,0 PUSHJ P,ARRAY ;REGISTER VECTOR NAME JUMPN A,GRONK 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 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 ;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,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 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 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 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/ SKIPE THNELS ;UNDER A CONDITIONAL FAIL TLNN C,F.CR ;E.O.L. ? FAIL JRST NXTSTA ;FINISHED ;GOSUB STATEMENT XLATE XGOSUB: ASCIZ /UB/ JRST XGOFIN ;GOTO STATEMENT XGOTO: ASCIZ /O/ XGOFIN: PUSH P,[Z NXTSTA] XGOFR: PUSHJ P,GETNUM ;BUILD GOTO AND RETURN FAIL 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 QUERY ? 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 OUTPUT ILLEGAL WITH CHANNEL CLEARM IFFLAG ;CLEAR TYPE FLAG XINP1: SETZI F, ;STRINGS MAY BE INPUT PUSHJ P,REGLTC ;GET VARIABLE 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 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 JRST XMAT2A ;TREAT LIKE PRINT ;::= MAT PRINT [(,)] [[;!,] [(,)...] XMAT2: PUSHJ P,QSA ;MAT PRINT? ASCIZ /PRINT/ JRST XMAT3 ;NO. MUST HAVE VARIABLE NAME. XMAT2A: HRLI F,0 PUSHJ P,ARRAY ;REGISTER NAME CAIE A,5 ;STRING VECTOR? JUMPN A,GRONK PUSHJ P,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 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. 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 TYPES 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 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 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 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 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 ;SET R.A. FILEE7: PUSHJ P,FILSET ;MARK FILE TYPE JRST FILE20 ;BACK TO MAIN CODE FILSET: SKIPGE FILTYP ;ALREADY SET ? MOVEM B,FILTYP ;NO, SET IT CAME B,FILTYP ;YES, IS IT THE SAME FAIL POPJ P, ;ALL WELL, RETURN FILOP1: SETZM INPOUT ;NO SPECIFIER PUSHJ P,QSA ASCIZ /FOR/ ;SPECIFIER ? JRST FILOP3 ;NO PUSHJ P,QSA ASCIZ /INPUT/ ;INPUT ? JRST FILOP4 ;NO AOS INPOUT ;YES, FLAG JRST FILOP3 ;GO CARRY ON FILOP4: PUSHJ P,QSA ASCIZ /OUTPUT/ ;OUTPUT ? FILERR: FAIL SOS INPOUT FILOP3: PUSHJ P,QSA ASCIZ /ASFILE/ FAIL JRST FILOP2 ;GET CHANNEL FILOP5: 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 TLNN C,F.COMA JRST ERCOMA JRST NXCH XWRI5: PUSHJ P,KWSAMD ;LOOK FOR MODIFIER CAIA ;NOT THERE JRST NXTSTA ;ONE FOUND, TREAT 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/ 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 XFLTAB(A) XFLTAB: 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, GO HANDLE THEM CAIE C,"(" ;OPTIONAL ARGUMENT? POPJ P, ;NO, RETURN PUSHJ P,NXCH ;EAT A "(" PUSHJ P,FORMLB ;GO 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 ;RESTORE 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 ;NOT THERE PUSHJ P,NXCH ;SKIP IT PUSHJ P,GETNUM ;GET ARG FAIL JRST RGTPAR ;LOOK 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,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: POP P,LETSW ;RESTORE LETSW TLNN C,F.RPRN ;MUST HAVE PARENTHESIS JRST ERRPRN JRST NXCHK ;IT DOES. SKIP PAREN AND RETURN. ;ROUTINE TO GEN ARGUMENTS ;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,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 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,0 ;ARRAY CODE POPJ P, ;SUBROUTINE TO REGISTER ARRAY NAME. ;(USED BY DIM,MAT) ARRAY: HRRI F,ARAROL ;ASSUME ITS NOT A STRING TLNN C,F.LETT JRST REGFAL 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,NXCHK ;SKIP DOLLAR SIGN 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,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] 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 SETZM TYPE ; JRST NXCHK ;GET NEXT CHARACTER AND RETURN PERCNT: CAME C,[XWD F.STR,"%"] ;IS IT A PERCENT? POPJ P, ;RETURN 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 ;LOOK FOR I FOR ASCIZ /IFOR/ POPJ P, ;NOT THERE, ALL WELL POP P,X2 ;THERE, CLEAR PDL JRST KWDSR3 ;AND IGNORE ;REGISTER FUNCTION NAME ;FIRST LETTER HAS BEEN SCANNED ;IT IS POSSIBLE THAT WE HAVE SCANNED A ONE-LETTER VARIABLE NAME ;FOLLOWED BY ONE OF THE KEYWORDS "TO" , "THEN", OR "STEP". ;FIRST WE LOOK AHEAD TO SEE IF THIS IS SO; ;IF IT IS WE GO BACK TO SCALAR CODE. REGFCN: PUSHJ P,KWSALL ;LOOK FOR KEYWORDS JRST REGFX1 ;NONE FOUND PUSHJ P,LEGAL JRST REGSCA ;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. REGFX1: 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 REGF7: CAMN A,(R) JRST REGF8 ;FOUND FN. AOJ R, CAIGE R,IFNCEI JRST REGF7 JRST REGFAL REGF8: SUBI R,IFNFLO MOVE B,IF2FLO(R) ;GET ENTRY IN 2ND TABLE. MOVMS LETSW ;CAN'T BE LH(LET) MOVEI A,2 ;INTRINSIC FCN CODE. POPJ P, ;RETURN "XINFCN" DOES ITS OWN ")" CHECK. ;HERE TO REGISTER DEFINED FUNCTION NAME ;THE "FN" HAS ALREADY BEEN SCANNED ;SCAN IDENTIFYING LETTER AND PUTTING ENTRY IN ;FUNCTION CALL ROLL REGDFN: PUSHJ P,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 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: 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 / / OUTPUT N, ;DUMP EVERYTHING JRST @SYNTAX ;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 END BASIC