Trailing-Edge
-
PDP-10 Archives
-
decuslib10-10
-
43,50516/basedt.mac
There are no other files named basedt.mac in the archive.
;****** UOFP SEGMENTED BASIC ******
SEARCH S
IFNDEF BASLOG,<BASLOG==0> ;BASLOG=0 : ASK FOR CONFIRM
IFNDEF NOCODE,<NOCODE==0> ;NOCODE=1 : JUST DEFINE SYMBOLS
IFNDEF BASTEK,<BASTEK==0> ;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,<LOC 400010>
;****** 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,<SIXBIT/ DSK/>
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,<SIXBIT/ BAS/>
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 <CR><LF>
SOSLE CATCNT ;TIME FOR <CR><LF>?
JRST OUTTAB ;NO, OUTPUT TAB
MOVEI X1,4 ;YES, RESTORE CATCNT
MOVEM X1,CATCNT ;TO WIDTH 4
JRST CLRF1 ;OUTPUT <CR><LF>
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,<SIXBIT / DSK/> ;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,<SIXBIT / BAS/>
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,<SIXBIT/ BAS/>
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,<SIXBIT/ DSK/>
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,<SIXBIT/ BAS/>
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 <RETURN>
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) <
<SIXBIT /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<? Image must be first in line>
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 <? Modifier with non-executable stmnt>
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 <STRING EXPRESSION>, 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 <VECTOR> TO <STRING>
; OR
;CHANGE <STRING> TO <VECTOR>
;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 STA>::= DATA <DEC NBR!STRING> [,<DEC NBR!STRING>...]
;NOTE: A DATA STRING ::= " <ANY CHARS EXCEPT CR,LF> "
; OR ::= <A LETTER><ANY CHARS EXCEPT COMMA OR APOST,CR,LF>
;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 <? DATA not in correct form>
SKIPE MULLIN ;WITHIN MULTI-LINE ?
FAIL <? DATA must be first in line>
JRST NXTSTA
;DEF STATEMENT
;<DEF STA> ::= DEF FN<LETTER>(<ARGUMENT>) = <EXPRESSION>
;GENERATED CODE IS:
; JRST <A> ;JUMP AROUND DEF
; XWD 0,0 ;CONTROL WORD
; MOVEM N,(B) ;SAVE ARGUMENT IN TEMPORARY
; ...
; (EVALUATE EXPRESSION)
; JRST RETURN ;GO TO RETURN SUBROUTINE
;<A>: ... ;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<? DEFINE must be first in line>
JRST NXTSTA
;DIM STATEMENT
;<DIM STA> ::= DIM <LETTER>[$](<NUMBER>[,<NUMBER>])[,<LETTER>[$](<NUMBER>[,<NUMBER>])...]
;FOR EACH ARRAY, HAVE ONE-WORD ENTRY IN VARROL
;WHICH POINTS TO THREE-WORD ENTRY IN ARAROL
;WHOSE FORMAT IS:
; (<LENGTH OF ARRAY>)<PNTR>
; (<LEFT DIM>+1)<RIGHT DIM>+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, <PNTR> IS CHAIN OF REFERENCES.
;DURING EXECUTION, <PNTR> 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 <? Illegal channel specified>
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 <? Illegal string size>
XDIM2: PUSHJ P,COMMA ;CHECK FOR COMMA, RETURN IF FOUND
JRST XDIMA ;KEEP SCANNING.
XDIMR1: FAIL <? Array is not a string>
; ELSE STATEMENT
XELS: MOVEM T,MULLIN ;SAVE POINTER
PUSHJ P,QSA
ASCIZ /E/
JRST ILLINS
SOSGE THNCNT ;WAS THERE A THEN ?
FAIL <? ELSE without THEN>
XELS0: TLNE C,F.DIG ;DIGIT
JRST IFSX6 ;YES, LET IF CODING HANDLE THIS
TLNE C,F.TERM
FAIL <? Illegal ELSE>
JRST EACHLN
;END STATEMENT
;<END STA> ::= END
XEND: TLNN C,F.CR
FAIL <? END is not last>
SKIPE THNELS ;UNDER THEN OR ELSE?
FAIL <? END under conditional>
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 FOR NEXT TO JRST TO>,< ADRS OF JRST TO END OF NEXT>
; <POINTER TO INDUCTION VARIABLE>
; <POINTER TO INCREMENT>
; <CURRENT VALUE OF TMPLOW>
XFOR: SKIPE THNELS ;UNDER THEN OR ELSE
FAIL <? Illegal FOR use>
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 <? Illegal FOR use>
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 <? Illegal FOR use>
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 <? Illegal FOR use>
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 STA> ::= FNEND
XFNEND: ASCIZ /ND/
SKIPE THNELS ;UNDER A CONDITIONAL
FAIL <? FNEND under conditional>
TLNN C,F.CR ;E.O.L. ?
FAIL <? FNEND not last in line>
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 <? Illegal line reference>
POPJ P,
;IF STATEMENT
;<IF STA>::=IF <NUM FORMULA> <RELATION> <NUM FORMULA> THEN <LINE NUMBER>
; OR
; ::= IF <STRING FORMULA><RELATION><STRING FORMULA> THEN <LINE NUMBER>
; OR
; ::=IF END <CHANNEL SPEC> THEN <LINE NUMBER>
;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 STA> ::= INPUT (<SCALAR> ! <ARRAY REF>)[,(<SCALAR>!<ARRAY REF>)...]
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 <? Line input illegal in r.a.>
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 <? String line input only>
XINP91: SKIPN WRREFL
JRST XINP9
SKIPN IFFLAG
MOVEM F,IFFLAG
XOR F,IFFLAG
JUMPGE F,XINP9
FAIL <? Mixed strings and numbers>
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 <? Mixed strings and numbers>
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 STA> ::= MAT READ <LETTER>[(<EXP>,<EXP>)] [,<LETTER>[(<EXP>,<EXP>...]]
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 STA>::= MAT PRINT <LETTER>[(<EXP>,<EXP>)] [[;!,] <LETTER>[(<EXP>,<EXP>)...]
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 SCALE STA> ::= MAT <LETTER>=(<EXPRESSION>)*<LETTER>
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 SETUP STA> ::= MAT ZER!CON!IDN <LETTER>[(<EXPRESSION>,<EXPRESSION>)]
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 FCN STA> ::= MAT<LETTER> = INV!TRN (<LETTER>)
XMAT7: PUSHJ P,QSA ;MAT INV?
ASCIZ /INV(/
JRST XMAT8 ;NO
PUSHJ P,XMITCM
SKIPGE FTYPE ;
FAIL <? Cannot invert integer matrix>
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 OPERATOR STA>::=MAT <LETTER>=<LETTER>+!-!*<LETTER>
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 <? Cannot mix modes in matrix operations>
POPJ P,
NARRAY: HRLI F,-1 ;MUST HAVE NUMERIC
PUSHJ P,ARRAY ;MUST HAVE ARRAY
JUMPN A,GRONK ;
POPJ P, ;RETURN
;NEXT STATEMENT
;<NEXT STA> ::= NEXT <SCALAR>
;EXPECT TO FIND 5-WORD ENTRY ON TOP OF FORROL
;DESCRIBING INDUCTION VARIABLE AND LOOP ADDRESS
XNEXT: ASCIZ /T/
SKIPE THNELS
FAIL <? NEXT under conditional>
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 <? Illegal NEXT arg>
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 STA> ::= ON <EXPRESSION> GOTO!THEN <STA NUMBER> [,<STA NUMBER>...]
;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)
; <NEST OF>
; <GOTO'S >
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 <? String record length < 1 or > 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 <? Mixed r.a. and seq.>
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 <? Illegal OPEN stmnt>
SOS INPOUT
FILOP3: PUSHJ P,QSA
ASCIZ /ASFILE/
FAIL <? Illegal OPEN stmnt>
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 <? Illegal PAUSE statement>
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 <? Illegal PLOT function>
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 <? Mixed strings and numbers>
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 ;<PA>.
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 <? Illegal relation>
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 <? Illegal constant>
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 <? Incorrect number of arguments>
;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 <? Illegal ASC argument>
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 <? Illegal line reference>
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 <? Nested string vectors>
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 ;<CR> OR <LF> ?
JRST RGSLX1 ;NO
CAIE C,12 ;<LF> ?
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
<KWS'U: PUSHJ P,KWSTUP
MOVEI X1,KWA'U
MOVEI X2,KWZ'U-1
JRST KWDSR1 > >
KWSBEG<ALL,CIF,FOR,MOD,AMD>
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 <? THEN or GO TO were expected>
TLNE C,F.DIG ;DIGIT FOLLOWS ?
POPJ P,
JRST ERDIGQ
;ERROR RETURNS
SETFER: FAIL <? Mixed strings and numbers>
ILFORM: FAIL <? Illegal formula>
ILVAR: FAIL <? Illegal variable>
GRONK: FAIL <? Illegal format>
ILLINS: FAIL <? Illegal statement keyword>
;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 <? Illegal character>
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