Trailing-Edge
-
PDP-10 Archives
-
decuslib10-10
-
43,50516/bascom.mac
There are no other files named bascom.mac in the archive.
IFNDEF NOCODE,<NOCODE==0> ;NOCODE=1 : JUST DEFINE SYMBOLS
IFE NOCODE,<
TITLE BASCOM COMPILE/LOAD PHASE
>
IFN NOCODE,<
UNIVERSAL BSYCOM
>
SEARCH S
SUBTTL PARAMETERS AND TABLES
;***COPYRIGHT 1969,1970,1971,1972,1973,1974 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***
;VERSION 17E 2-OCT-74/NA
;VERSION 17D 4-MAY-73/KK
;VERSION 17C 2-JAN-73/KK
;VERSION 17B 25-JUL-72/KK
;VERSION 17A 10-FEB-1972/KK
;VERSION 17 15-OCT-1971/KK
;VERSION 16 5-APR-1971/KK
;VERSION 15 17-AUG-1970/KK
;VERSION 14 16-JUL-1970/AL/KK
;VERSION 13 15-SEP-1969
LOC .JB41
JSR UUOH
LOC .JBINT
TRPLOC
LOC .JBVER
BYTE (3)VWHO(9)VBASIC(6)VMINOR(18)VEDIT
IFE NOCODE,<
RELOC
HISEG
>
IFN NOCODE,<LOC 400010>
INTERN STACEI,STAFLO,RELCEI,RELFLO
EXTERN NEGONE
EXTERN AFLAG,ERR,ERL,ERRGO,ERRCNT,LINADR
EXTERN ERLB,ERRB
EXTERN ACTBL,APPEND,ARAROL,ARATOP,ARGROL,ASCIIB,ATANB,BGNTIM
EXTERN BLOCK,CADROL,CATFLG,CEARG,CECAD,CECOD,CECON,CEFAD,CEFCL
EXTERN CEFOR,CEGSB,CEIL,CELAD,CELIN,CELIT,CENTRY,CENXT
EXTERN CEPTM,CEREF,CESAD,CESEX,CESLT,CESTM,CESVR,CETMP,CEVSP
EXTERN CHAERR,CHAFL2,CHAFLG,CHAHAN,CHAXIT,CHKIMG,CHRB
EXTERN CLOGB,CLSFIL,CNER1,CODROL,COMTIM,CONROL,COSB
EXTERN COTB,CRLF,CRTVAL,DATAFF,DATEB,DAYB,DETER,DEVBAS,DOINPT
EXTERN DOREAD,EIFLOT,ELSFLG,ELSEAD,ENDIMG,EOF,EXP3.0,EXPB,EXTD
EXTERN EXP1.0,EXP2.0,ECHOB
EXTERN FADROL,FCLROL,FCNROL,FILCNT,FILD,FILDIR,FILTYP,FPPN
EXTERN FIXPNT,FLTPNT
EXTERN FIXB,FLARA,FLARG,FLCAD,FLCOD,FLCON,FLFAD,FLFCL,FLFOR
EXTERN FLGSB,FLLAD,FLLIN,FLLIT,FLNXT,FLOOR,FLPTM,FLREF
EXTERN FLSAD,FLSCA,FLSEX,FLSLT,FLSTM,FLSVR,FLTMP,FNMX0
EXTERN FNMXER,FORCAR,FORPNT,FORROL,FRETRN,FTRUTH,FUNAME
EXTERN FUNLOW,FUNSTA,GSBROL,HPOS,IFFLAG,IFIX,IMGLIN
EXTERN INPFLA,INPOUT,INPPRI,INSEQ,INSET,INSTRB,INTB,JAROUN,JFCLAD
EXTERN KWDIND,LADROL,LASREC,LDDTNH,LEFTB,LENB,LETSW,LEXECT,LINEB
EXTERN LINROL,LITROL,LOCLOF,LOGB,LOGNEG,LSAVE,LUXIT
EXTERN MARERR,MARGAL,MARGIN,MARGN,MASAPP,MIDB,MINFLG,MTIME
EXTERN MIXFLG,MASTST
EXTERN MULLIN,NEWOL1,NOTLIN,NUMCOT,NUMRES,ODF,OLDCOD
EXTERN ONCESW,ONGFLG,OPNFIL,OPNFLG,OUTSET,PAGE,PAGEAL
EXTERN PAGLIM,PAKFLG,PIB,PLIST,POINT,POSB,PRDLER,PSAV,PSHPNT
EXTERN PSHROL,PTMROL,QSKIP,QST,QUOTBL,RANDER,RANSCR,REAINP
EXTERN REFROL,REGPNT,REINER,RELNEG,RELROL,RENFLA,RESTON
EXTERN RETURN,RIGHTB,RNDB,RNNUMO,RNSTRO,ROLMSK,RUNFLA,RUNLIN
EXTERN SADROL,SAVACS,SAVE1,SAVRUN,SCAROL,SCATH,SCNIMN,SCNIMS
EXTERN SETCOR,SETERR,SEVEN,SEXROL,SINB,SLEEPB,SLTROL,SORCLN,SPACEB
EXTERN SQRTB,STAROL,START,STRB,STRLEN,SVRBOT,SVRROL,SVRTOP
EXTERN SWAPSS,TABLE,TANB,TEMLOC,TEMP1,THENAD,THNCNT,THNELS,TIMEB,TMPLOW
EXTERN TMPPNT,TMPROL,TOPSTG,TRNFL2,TRNFLG,TRPLOC,TRUTH,TTYPAG
EXTERN TYPE,FTYPE,PFLAG
EXTERN UUOH,VALB,VARFRE,VARROL,VPAKFL,VRFBOT,VRFSET
EXTERN INLNFG
EXTERN VRFTOP,VSPROL,WRIPRI,WRPRER,WRREFL,XCTON,XRES
EXTERN .JBFF,.JBREL,.JBSA
; VIRTUAL ARRAY LOW SEGMENT EXTERNALS
EXTERN VIRSIZ,VIRDIM,FLVIR,CEVIR,VIRROL
EXTERN VIRBLK,VIRWRD
XLIST
IFN BASTEK,<
LIST
;
; BASTEK CONDITIONAL CODE
;
EXTERN INIPLT,PAGPLT,LINPLT,ORGPLT,STRPLT,WHRPLT,MOVPLT,NOORG
EXTERN CURPLT,SAVPLT,PLTOUT,PLTIN
;
; END BASTEK CONDITION CODE
;
XLIST
>
LIST
EXTERN LBASIC,UXIT
BASIC=LBASIC
EUXIT=UXIT
;****** EXTERNALS FROM BASLIB (COMLIB)
EXTERN BUMPRL,CLOB,CLOSUP,CPOPJ,CPOPJ1,DATCHK,ERACOM
EXTERN ERRMS2,ERRMS3,ERRMSG,EVANUM,FILNAM,FILNMO,GETNU
EXTERN GETNUM,INLMES,LOCKOF,LOCKON,NXCH,NXCHD,OPENUP
EXTERN OUCH,PANIC1,PRESS,PRINT,PRNNAM,QSA,QSELS,QST,RPUSH
EXTERN SCN2,SCN3,SCNLT1,SCNLT2,SCNLT3,SEARCH,TTYIN
;****** END EXTERNALS FROM BASLIB (COMLIB)
INTERN RUNNH
IFN NOCODE,<
IF2,< END>
>
DEFINE FAIL (A,AC)<
XLIST
XWD 001000+AC'00,[ASCIZ \A\]
LIST
>
%OPD=1 ;OPDEF UUO COUNTER
DEFINE OPCNT (A)<
%OPD=%OPD+1
IFG %OPD-37,<PRINTX <TOO MANY UUO'S>>
OPDEF A [<%OPD>B8]>
OPCNT PRNM
OPCNT PRDL
OPCNT PRNTB
OPCNT GOSUB
OPCNT ARFET1
OPCNT ARFET2
OPCNT ARSTO1
OPCNT ARSTO2
OPCNT ARSTN1
OPCNT ARSTN2
OPCNT DATA
OPCNT ADATA1
OPCNT ADATA2
OPCNT SDIM
OPCNT MATRD
OPCNT MATPR
OPCNT MATSCA
OPCNT MATCON
OPCNT MATIDN
OPCNT MATTRN
OPCNT MATINV
OPCNT MATADD
OPCNT MATSUB
OPCNT MATMPY
OPCNT MATZER
OPCNT STRUUO
OPCNT SVRADR
OPCNT PRSTR
OPCNT DONFOR
OPCNT MATINP
MAXUUO=1
UUOHAN: PUSH P,UUOH ;RETURN ADDRS ON PUSH-DOWN LIST
LDB X1,[POINT 9,40,8]
IFL MAXUUO-37,<
CAILE X1,MAXUUO
HALT ;ILLEGAL UUO.
>
UUOTBL:
JRST .(X1)
JRST FAILER
STAFLO:
Z XCHAN+20000(SIXBIT / CHA/)
Z XCLOSE+60000(SIXBIT / CLO/)
Z XDATA+40000(SIXBIT / DAT/)
Z XDEF+40000(SIXBIT / DEF/)
Z XDIM(SIXBIT / DIM/)
Z XELS+20000(SIXBIT / ELS/)
Z XEND+20000(SIXBIT / END/)
Z XFILE+40000(SIXBIT/ FIL/)
Z XFNEND+60000(SIXBIT / FNE/)
Z XFOR+20000(SIXBIT / FOR/)
Z XGOSUB+60000(SIXBIT / GOS/)
Z XGOTO+60000(SIXBIT / GOT/)
Z XIF+20000(SIXBIT / IF /)
Z XINPUT+60000(SIXBIT / INP/)
Z XLET+20000(SIXBIT / LET/)
Z XMAR+60000(SIXBIT / MAR/)
Z XMAT+20000(SIXBIT / MAT/)
Z XNEXT+60000(SIXBIT / NEX/)
Z XNOP+60000(SIXBIT / NOP/)
Z XNOQ+60000(SIXBIT / NOQ/)
Z XON+20000(SIXBIT / ON /)
Z XOPEN+60000(SIXBIT / OPE/)
Z XPAG+60000(SIXBIT / PAG/)
Z XPAUSE+60000(SIXBIT/ PAU/)
XLIST
IFN BASTEK,<
LIST
;
; BASTEK CONDITIONAL CODE
;
Z XPLO+60000(SIXBIT/ PLO/)
;
; END BASTEK CONDTIONAL CODE
;
XLIST
>
LIST
Z XPRINT+60000(SIXBIT / PRI/)
Z XQUO+60000(SIXBIT / QUO/)
Z XRAN+60000(SIXBIT / RAN/)
Z XREAD+60000(SIXBIT / REA/)
Z XREM(SIXBIT / REM/)
Z XREST+20000(SIXBIT / RES/)
Z XRETRN+60000(SIXBIT / RET/)
Z XSCRAT+60000(SIXBIT/ SCR/)
Z XSET+20000(SIXBIT / SET/)
Z XSTOP+60000(SIXBIT / STO/)
Z XUNTIL+60000(SIXBIT / UNT/)
Z XWHILE+60000(SIXBIT / WHI/)
Z XWRIT+60000(SIXBIT/ WRI/)
STACEI:
OPDEF STRSTO [STRUUO 1,]
OPDEF STRIF [STRUUO 2,]
OPDEF STRIN [STRUUO 3,]
OPDEF VECFRL [STRUUO 4,]
OPDEF VECPRL [STRUUO 5,]
OPDEF STOCHA [STRUUO 6,]
OPDEF VECFIN [STRUUO 7,]
OPDEF VECPIN [STRUUO 10,]
OPDEF PJRST [JRST 0]
;TABLE OF INTRINSIC FUNCTIONS
DEFINE ZZZ. (X) <
<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,CAMGE
ZZZ. 3436B11,CAMN
ZZZ. 74B6,CAMG
ZZZ. 3635B11,CAMLE
ZZZ. 75B6,CAME
ZZZ. 76B6,CAML
RELCEI:
ILLIN: ASCIZ /
? Illegal line reference in RUN(NH) or CHAIN/
SUBTTL INITIALISE COMPILATION
RUNNH: MOVEI R,STAROL ;SETUP STAROL
MOVEI X1,STAFLO ;GET THE FLOOR
MOVEM X1,FLOOR(R) ;SET IT
MOVEI X1,STACEI ;GET THE CEIL
MOVEM X1,CEIL(R) ;SET IT
MOVEI R,RELROL ;SETUP RELROL
MOVEI X1,RELFLO ;GET THE FLOOR
MOVEM X1,FLOOR(R) ;SET IT
MOVEI X1,RELCEI ;GET THE CEIL
MOVEM X1,CEIL(R) ;SET IT
MOVEI X1,^D9 ;CHAIN ENTRY POINT.
RUNNH1: SETZM ACTBL-1(X1)
SETZM FILD-1(X1)
SETZM EXTD-1(X1)
SETZM FPPN-1(X1)
SOJG X1,RUNNH1
SETOM VRFSET
SETOM COMTIM
SETZM MULLIN ;INITIALIZE MULTI-LINE SWITCH
SETZM FUNAME ;AND FN NAME
SETZM FILCNT
SKIPN CHAFLG
JRST RNLAB1 ;NO.
MOVE P,PLIST
PUSHJ P,TTYIN
RNLAB1: SKIPE SWAPSS ;SET THE CORE CRUNCHING FLAG IF
SETOM PAKFLG ;THIS IS A SWAPPING SYSTEM.
PUSHJ P,LOCKON ;PROTECT REST OF COMPILATION
PUSHJ P,PRESS ;GUARANTEE SOURCE DOESN'T MOVE!!!
MOVEI X1,CODROL ;COMPILE TIME.
MOVEM X1,TOPSTG ;TXT,LIN,CODROLS ARE STODGY. OTHERS MOVE.
MOVEI R,LINROL
PUSHJ P,SLIDRL ;SLIDE LINROL DOWN NEXT TO TXTROL.
RUNER1: MOVEM X2,FLCOD
MOVEM X2,CECOD ;CODROL IS ALSO PACKED IN PLACE.
MOVEI X1,CODROL ;PREPARE TO CLOBBER ALL ROLLS ABOVE CODROL
MOVE T,.JBREL ;USE THIS VALUE.
PUSHJ P,CLOB ;DO THE CLOBBERING.
MOVEI F,0 ;CLEAR COMPILATION FLAGS
SKIPE CHAFLG ;CHAINING?
JRST RUNER0 ;YES, DON'T DISTURB THE TIME.
MOVEI T,0 ;SET UP AC FOR RUNTIM.
RUNTIM T, ;GET TIME OF START.
MOVEM T,MTIME ;SAVE TIME AT START OF RUNER
RUNER0: SETOM RUNFLA
SETZM DATAFF ;CLEAR DATA FLAG
SETOM TMPLOW ;NO TEMPORARIES USED YET.
MOVEI F,REFROL ;CREATE A ROLL OF ZEROS
PUSHJ P,ZERROL
;NOW MARK THIS ROLL TO SHOW WHAT PARTS OF THIS PROG ARE INSIDE OF FUNCTIONS:
LUKDEF: MOVEI A,LUKD0 ;SET RETURN TO LOOK FOR DEF
LUKD0: PUSHJ P,NXLINE ;PREPARE TO READ A LINE
PUSHJ P,QSA ;LOOK FOR DEFFN
ASCIZ /DEFFN/
JRST LUKD1A ;NOT FOUND, LOOK FOR DIM
PUSHJ P,SCNLT1 ;BUILD FN NAME
PUSHJ P,DIGIT ;SCAN OFF ANY DIGIT
PUSHJ P,DOLLAR ;CHECK FOR STRING FUNCTION
CAIA ;IT IS, DON'T CHECK FOR %
PUSHJ P,PERCNT ;INTEGER FUNCTION
HLLZ B,A ;STORE FN NAME IN B
SKIPA A,[XWD Z LUKD2] ;SET RETURN TO LOOK FOR FNEND
LUKD1: PUSHJ P,NXCH ;GET NEXT CHAR
TLNE C,F.TERM ;LINE TERMINATOR
JRST LUKD9 ;YES, MULTI-LINE DEF
TLNN C,F.EQAL ;EQUALS SIGN
JRST LUKD1 ;NO, KEEP LOOKING FOR ONE OR THE OTHER
MOVEI A,LUKD0 ;LOOK FOR DEFFN WHEN DONE WITH DIM
JRST LUKD9 ;CHECK FOR ANY DIMS
LUKD1A: PUSHJ P,QSA ;LOOK FOR THE DIM
ASCIZ /DIM/
JRST LUKD9 ;NOT FOUND, SKIP TO NEXT LINE
HLLOS (G) ;MARK LINE AS CONTAINING DIM
JRST LUKD3 ;DO NEXT LINE
LUKD9: PUSHJ P,LUKEND ;FIND LINE TERMINATOR
JRST LUKD1A ;GO LOOK FOR A DIM
LUKD2: MOVEI A,LUKD2A ;LOOK FOR FNEND AFTER LINE
LUKD2A: PUSHJ P,NXLINE ;PREPARE TO READ A LINE
HLLM B,(G) ;MARK LINE AS WITHIN DEF
LUKD4: PUSHJ P,QSA ;LOOK FOR FNEND
ASCIZ /FNEND/
JRST LUKD5 ;NOT FOUND, GO LOOK FOR DIM
LUKD24: MOVEI A,LUKD0 ;LOOK FOR DEF NEXT
JRST LUKD3 ;FNEND MUST BE LAST IN LINE
LUKD5: PUSHJ P,QSA ;LOOK FOR DIM
ASCIZ /DIM/
CAIA ;NOT FOUND, DON'T MARK
HLLOS (G) ;MARK LINE AS CONTAINING DIM
PUSHJ P,LUKEND ;LOOK FOR LINE TERMINATOR
JRST LUKD4 ;GO LOOK FOR FNEND
LUKEND: PUSHJ P,NXCH ;GET A CHARACTER
CAME C,[XWD F.APOS,"'"] ;COMMENT
TLNE C,F.CR ;OR CARRIAGE RETURN
JRST LUKD3A ;END OF LINE, START ANOTHER ONE
TLNN C,F.TERM ;IS IT A LINE TERMINATOR?
JRST LUKEND ;NO, KEEP LOOKING
POPJ P, ;YES, RETURN
LUKD3A: POP P,X1 ;CLEAN PUSH DOWN STACK
LUKD3: AOBJN L,(A) ;DO NEXT LINE IF IT EXITS
;FINISHED MARKING FUN LINES. NOW SET UP A CLEAR LADROL...
RUNER2: MOVEI F,LADROL
PUSHJ P,ZERROL
PUSH P,L ;SAVE LINE POINTER
MOVE L,FLREF ;START SCANNING REFROL
FIXDIM: CAML L,CEREF ;ENTIRE ROLL SCANNED?
JRST FIXDON ;YES, WE ARE DONE
HRRZ A,(L) ;CHECK IF THIS LINE CONTAINS A DIM
HLLZS (L) ;CLEAR IT IN CASE IT WAS SET
SKIPN A ;IF NON-ZERO, DIM COMING UP
AOJA L,FIXDIM ;NO DIMS, CHECK NEXT LINE
SUB L,FLREF ;MAKE IT A POINTER TO LINROL
PUSHJ P,NXLINE ;PREPARE TO READ THE LINE
ADD L,FLREF ;RESTORE L
FXDIMA: PUSHJ P,QSA ;CHECK FOR DIM
ASCIZ /DIM/
JRST FXDIM4 ;NONE THERE, GO TO TERMINATOR
PUSHJ P,QSA ;CHECK OR FULL DIMENSION
ASCIZ /ENSION/
JFCL ;WHO CARES
CAME C,[XWD F.STR,"#"] ;VIRTUAL ARRAY DIM?
JRST FXDIM4 ;NO, SCAN TO TERMINATOR
PUSHJ P,NXCH ;EAT THE #
PUSHJ P,GETNUM ;EVALUATE NUMBER
JRST FXDERR ;NONE THERE
CAILE N,9 ;CAN'T BE GREATER THAN 9
JRST FXDERR ;GIVE ERROR
TLNN C,F.COMA ;COMMA MUST FOLLOW
JRST FXDERR ;IT DIDN'T
FXDIM0: PUSHJ P,NXCH ;EAT WHATEVER CHARACTER IS IN C
HRRI F,ARAROL ;ASSUME NUMERIC ARRAY
TLNN C,F.LETT ;MUST HAVE LETTER
JRST FXDERR ;SIMPLE SHIT, GIVE ERROR
PUSHJ P,SCNLT1 ;BUILD ARRAY NAME
PUSHJ P,DIGIT ;CHECK FOR A DIGIT
PUSHJ P,DOLLAR ;NOW CHECK FOR A DOLLAR
JRST FXDIM1 ;FOUND ONE, STRING ARRAY
PUSHJ P,PERCNT ;CHECK FOR INTEGER SPEC
CAIA ;F ALREADY SET FOR NUMERIC
FXDIM1: HRRI F,SVRROL ;FLAG F FOR STRING
TLO A,1 ;MAKE NAME UNIQUE FOR ARRAY
MOVEI R,VARROL ;SEARCH VARROL FOR THIS ARRAY
PUSHJ P,SEARCH ;DO THE SEARCH
CAIA ;NOT FOUND, GOOD CONTINUE
JRST FXDERR ;VARIABLE DIMENSIONED TWICE
PUSHJ P,REGA2 ;REGISTER THE ARRAY
CAIE C,"(" ;( MUST BE PRESENT
JRST FXDERR ;NOT THERE
ADD B,FLOOR(F) ;POINT B TO ARA(SVR)ROL
MOVEI X1,400000 ;MARK AS VIRTUAL
HRLM X1,(B) ;AND STORE IN ARRAY
FXDIM2: PUSHJ P,NXCH ;GET A CHARACTER
TLNE C,F.TERM ;LINE TERMINATOR?
JRST FXDERR ;YES, TOO SOON
TLNN C,F.RPRN ;CLOSING PAREN?
JRST FXDIM2 ;NO, KEEP SCANNING
FXDIM3: PUSHJ P,NXCH ;GET A CHARACTER
CAME C,[XWD F.APOS,"'"] ;REST OF LINE A COMMENT
TLNE C,F.CR ;OR END OF LINE
AOJA L,FIXDIM ;YES, DO NEXT LINE
TLNE C,F.COMA ;ANOTHER ARRAY COMING UP?
JRST FXDIM0 ;YES, PROCESS IT
TLNN C,F.TERM ;HOW ABOUT A LINE TERMINATOR?
JRST FXDIM3 ;NO, KEEP LOOKING
PUSHJ P,NXCH ;EAT THE TERMINATOR
JRST FXDIMA ;AND SEE IF WE HAVE ANOTHER DIM
FXDIM4: PUSHJ P,NXCH ;GET A CHARACTER
CAME C,[XWD F.APOS,"'"] ;COMMENT?
TLNE C,F.CR ;OR CARRAIGE RETURN
AOJA L,FIXDIM ;YES, END OF LINE, DO NEXT
TLNN C,F.TERM ;TERMINATOR?
JRST FXDIM4 ;NO, KEEP SCANNING
PUSHJ P,NXCH ;YES, EAT IT
JRST FXDIMA ;AND LOOK FOR NEXT DIM
FXDERR: CLEARM RUNFLA ;FOUND AN ERROR, DON'T PRODUCE ANY CODE
CAML L,CEREF ;CHECKED ALL OF REFROL
JRST FIXDON ;YES, NOW BEGIN ABORTED COMPILATION
HLLZS (L) ;CLEAR DIM FLAG IN REFROL
AOJA L,FXDERR ;AND CHECK NEXT
FIXDON: POP P,L ;RESTORE LINE POINTER
SUBTTL PROCESS EACH LINE
;SO FAR, WE HAVE SET UP LADROL FOR ADDRESSES & CHAINS FOR LABLES
;ALSO, L IS A WORD TO AOBJN & COUNT THROUGH LINES.
;BEGIN COMPILATION OPERATIONS FOR EACH LINE
EACHLN: MOVE P,PLIST ;FIX P LIST IN CASE LAST INST FAILED
PUSHJ P,LOCKOF ;CHECK REENTER REQUEST
PUSHJ P,LOCKON
MOVE X1,TMPLOW
MOVEM X1,TMPPNT ;NO UNPROTECTED TEMPORARIES USED YET.
SETZM LETSW
SETZM LOGNEG ;
CLEARM AFLAG ;CLEAR A FLAG
CLEARM PFLAG ;CLEAR % SEEN FLAG
SETZM TRNFLG ;NOT YET SEEING MAT TRN.
SETZM INLNFG ;CLEAR INPUT LINE FLAG
SETZM REGPNT ;REG IS FREE
SETZM PSHPNT ;NO "PUSH" INSTS GENERATED YET
SETOM VRFSET
SKIPN FUNAME ;IN MIDST OF MULTI-LINE FUNCTION
JRST ECLAB1
MOVMS VRFSET
JRST EACHL2
ECLAB1: MOVE X1,FLARG ;NO FUNCTION ARGS YET
MOVEM X1,CEARG
EACHL2: SKIPN MULLIN ;SKIP IF MULTI-STATEMENT
JRST ECHL2A ;
MOVE D,T ;
JRST ECHL2B ;
ECHL2A: CLEARM THENAD ;ZERO THEN ADDRESS
CLEARM ELSEAD ;ZERO ELSE ADDRESS
CLEARM THNCNT ;CLEAR COUNT OF THEN'S
CLEARM ELSFLG ;CLEAR SINGLE WORD THEN/ELSE
SETZM THNELS ;CLEAR CONDITIONAL FLAG
PUSHJ P,NXLINE ;SET UP POINTER TO THIS LINE.
ECHL2B: MOVSI A,(SIXBIT /REM/) ;PREPARE FOR COMMENT
CAIE C,":" ;IMAGE = REM.
JRST EACHL4
SKIPE MULLIN ;MULTI-LINE ?
FAIL<? Image must be first in line>
JRST EACHL1
EACHL4: CAMN C,[XWD F.APOS,"'"]
JRST EACHL1 ;JUST COMMENT
TLNE C,F.TERM ;ANY OTHER TERMINATOR
JRST NXSM4 ;IS IGNORED
TLNN C,F.LETT ;? FIRST CHAR A LETTER
JRST ILLINS ;NO, GRIPE
PUSHJ P,SCNLT1 ;SCAN FIRST LTR
CAMN C,[XWD F.STR,"%"] ;NEXT LETTER % ?
JRST ELILET ;MUST BE LET OR ERROR
CAIE C,"("
TLNE C,F.EQAL+F.DIG+F.DOLL+F.COMA ;ELIDED LETTER?
JRST ELILET ;YES. POSSIBLE ASSUMED "LET"
PUSHJ P,SCNLT2 ;SCAN SECOND LETTER.
JRST ILLINS ;SECOND CHAR WAS NOT A LETTER.
MOVS X1,A
CAIE X1,(SIXBIT /IF/)
CAIN X1,(SIXBIT /ON/)
JRST EACHL1
CAIE X1,(SIXBIT /FN/) ;ELIDED LET FNX= ?
JRST EACHL3 ;NO.
PUSHJ P,SCNLT3
JRST ILLINS
TLNE C,F.DIG ;CHECK FOR MAYBE DIGIT
PUSHJ P,NXCH ;YES, EAT IT
TLNN C,F.EQAL ;IS FOURTH CHAR AN '=' SIGN?
CAMN C,[XWD F.STR,"%"] ;OR A PERCENT
JRST ELILET ;YES, ELIDED STATEMENT
TLNE C,F.DOLL ;OR A $
JRST ELILET
JRST EACHL1 ;NO, BETTER BE FNEND.
EACHL3: PUSHJ P,SCNLT3 ;ASSEMBLE THIRD LETTER OF STATEMENT IN A
JRST ILLINS ;THIRD CHAR WAS NOT A LETTER
CAMN A,[624555000000] ;FIX FOR REM
HRRZ C,C ;TWO LINES.
JRST EACHL1
ELILET: MOVSI A,(SIXBIT /LET/) ;ASSUME A "LET" STATEMENT.
SKIPE T,MULLIN ;MULLIN HAS PTR IF MULTI
JRST ELILT1
MOVS T,D ;GO BACK TO THE FIRST LETTER.
HRLI T,440700
ELILT1: PUSHJ P,NXCHK
;HERE, FIRST 3 LTRS OF VERB (SIXBIT) ARE IN A. USE TBL LOOKUP AND DISPATCH.
EACHL1: MOVEI R,STAROL
PUSHJ P,SEARCH ;LOOK IN STATEMENT TYPE TABLE
JRST ILLINS ;NO SUCH, GO BITCH
HRRZ A,(B) ;FOUND.
MOVE X1,CECOD ;PUT REL ADDRS IN LADROL
SUB X1,FLCOD
MOVE X2,FLLAD
ADDI X2,(L)
SKIPN MULLIN ;DONT STORE IF MULTI
HRLM X1,(X2)
HRLI D,(JUMP)
MOVEM D,SORCLN ;SAVE SOURCE LINE NUMBER
SETOM JFCLAD ;NO JFCL YET
TRZN A,20000 ;EXECUTABLE?
JRST EACHL6
SKIPN NOTLIN ;OR ARE WE DELETING LINE NOS
SKIPE MULLIN ;OR WITHIN MULTI
JRST EACHL7
MOVE D,[JSP A,LINADR] ;NUMBER IN SORCLN.
PUSHJ P,BUILDI
MOVE D,SORCLN ;
PUSHJ P,BUILDI ;GENERATE IT NOW
EACHL7: CAIN A,40000+XNEXT ;AND NEXT
JRST EACHL6 ;NEED NO JFCL
MOVSI D,(JFCL)
PUSHJ P,BUILDI ;SET JFCL FOR HANDLING MODIFIERS
MOVEM B,JFCLAD ;STORE ADDRESS
EACHL6: MOVE X1,A
TRZN X1,40000 ;MORE TO COMMAND?
SOJA X1,EACHL5 ;NO. JUST DISPATCH
PUSHJ P,QST ;CHECK REST OF COMMAND
JRST ILLINS
EACHL5: JRST 1(X1)
;HERE ON END OF STATEMENT XLATION
NXTSTA:
TLNE C,F.TERM ;END OF LINE ?
JRST NXSM2 ;YES, GO CHECK TERMINATOR
PUSHJ P,QSELS ;ELSE ?
JRST MODSEK ;NO, SEEK MODIFIER
MOVEM T,MULLIN ;YES, MARK MULTI
JRST NXSM1 ;GO HANDLE
MODSEK: PUSHJ P,KWSMOD ;NO, LOOK FOR MODIFIERS
JRST ERTERM ;NONE, GO BITCH
SKIPGE X1,JFCLAD ;WAS IT EXECUTABLE ?
FAIL <? Modifier with non-executable stmnt>
AOS X1
MOVEM X1,CENTRY ;BEG OF STMNT CODE
SOS X1
ADD X1,FLCOD
MOVSI X2,(JRST) ;PUT JRST
SKIPE SAVRUN
TLO X2,(4,) ;OR HALT
SKIPE RUNFLA ;STILL RUNNING
MOVEM X2,(X1) ;IN PLACE OF JFCL
SETOM JAROUN ;NO JUMP AROUND ADDRESS YET
MODLOO: PUSHJ P,HALJRS ;JRST AROUND MODIFIER
MOVE X1,JAROUN ;GET OLD JUMP AROUND
MOVEM B,JAROUN ;SAVE NEW
JUMPL X1,MODNOJ ;NO OLD ONE
ADD B,FLCOD ;ADDRESSES
PUSHJ P,FIXADR
MODNOJ: MOVE X1,KWDIND ;GET MODIFIER
SUBI X1,KWAMOD ;INDEX
CAIN X1,7 ;FIX UP FOR
AOJ X1, ;(ONLY ONE WORD LONG)
LSH X1,-1
JRST @MODIFY(X1) ;GO MODIFY
MODIFY: JRST MODWHC ;WHILE
JRST MODUTC ;UNTIL
JRST MODIFC ;IF
JRST MODUSC ;UNLESS
JRST MODFOC ;FOR
MODWHC: SETZM LOGNEG ;WHILE
CAIA
MODUTC: SETOM LOGNEG ;UNTIL=NOT WHILE
SETOM JAROUN ;NO JUMP AROUND
SOS CECOD ;OVERWRITE IT
JRST MODCON ;EVALUATE CONDITION
MODIFC: SETZM LOGNEG ;IF
CAIA
MODUSC: SETOM LOGNEG ;UNLESS=NOT IF
MODCON: PUSHJ P,SAVCEN ;SET NEW CENTRY
PUSHJ P,IFCCOD ;GENERATE CONDITIONAL
PUSHJ P,OLDCEN ;JRST TO OLD CENTRY
JRST MODMOR ;LOOK FOR MORE
MODFOC: PUSHJ P,SAVCEN ;SAVE NEW CENTRY
PUSHJ P,FORCOD ;GENERATE FOR CODE
PUSHJ P,OLDCEN ;GO TO OLD CENTRY
MOVE B,CECOD ;NEXT CODE
MOVE X1,JAROUN ;JUMP AROUND LOC
PUSHJ P,FIXADR ;JUMP INTO NEXT
SETOM JAROUN ;NO MORE JUMP AROUND
MOVE X1,FTYPE ;GET TYPE OF FOR LOOP
MOVEM X1,TYPE ;SET UP FOR NEXT
PUSHJ P,NEXCOD ;NEXT CODE
JRST MODMOR ;LOOK FOR MORE
SAVCEN: MOVE X1,CECOD
SUB X1,FLCOD ;NEW CENTRY
EXCH X1,(P) ;SAVE IT
JRST (X1)
OLDCEN: PUSHJ P,HALJRS ;JRST TO OLD CENTRY
MOVE X1,CENTRY
ADD X1,FLCOD
EXCH X1,B
PUSHJ P,FIXADR ;SET ADDRESS
MOVE B,X1
POP P,X1 ;RETURN ADDRESS
POP P,CENTRY ;NEW CENTRY
JRST (X1)
MODMOR: PUSHJ P,KWSMOD ;MORE MODIFIERS ?
SKIPA B,CENTRY ;NO, GET LAST CENTRY
JRST MODLOO ;YES, DO THEM
ADD B,FLCOD
MOVE X1,JFCLAD ;JUMP TO MODIFIERS
PUSHJ P,FIXADR ;SET ADDRESS
SKIPGE X1,JAROUN ;LAST JUMP AROUND
JRST NXSM3 ;NONE THERE
MOVE B,CECOD ;NEXT STMNT
PUSHJ P,FIXADR ;FOR JUMP AROUND
NXSM3: TLNE C,F.TERM ;SEEN TERMINATOR YET
JRST NXSM2 ;
PUSHJ P,QSELS ;ELSE THERE
JRST ERTERM
MOVEM T,MULLIN
JRST NXSM1 ;
NXSM4: SKIPE MULLIN ;IGNORE IF MULTI
JRST NXSM2 ;
MOVE X1,CECOD ;CALCULATE OFFSET OF LAST
SUB X1,FLCOD ;WORD OF CODE GENERATED
MOVE X2,FLLAD ;MUST STORE IN LADROL
ADDI X2,(L) ;
HRLM X1,(X2) ;
NXSM2: SETZM MULLIN ;END, UNSET MULTI-LINE
MOVEI D,"\" ;WAS IT
CAIE D,(C) ;BACKSLASH ?
JRST NXSM1 ;NO, REALLY NEXT LINE
MOVEM T,MULLIN ;YES, SET MULTI-LINE
PUSHJ P,NXCH ;GET NEXT CHAR
NXSM1: SKIPE AFLAG ;SHOULD WE CLEAR VRFBOT BECAUSE OF V. A.
JRST NXSM1A ;YES, DO IT
SKIPE VRFSET
JRST NXTST1
NXSM1A: MOVE D,[SETZM VRFBOT]
PUSHJ P,BUILDI
;ENTER HERE FROM ERROR ROUTINE
NXTST1: SKIPE MULLIN ;FINISHED LINE ?
JRST EACHLN ;NO
SKIPLE X1,THENAD ;STILL UNDER THEN ?
PUSHJ P,LNKTHN ;LINK ALL THENAD'S
SKIPLE X1,ELSEAD ;ANY ELSE ADDRESSES
PUSHJ P,LNKTHN ;LINK THE ELSES
NXTST2: AOBJN L,EACHLN
NOEND: MOVEI T,NOEND1 ;IF NONE, DIDNT SEE END
JRST ERRMSG
NOEND1: ASCIZ /
? No END instruction/
LNKTHN: SKIPN RUNFLA ;STILL PRODUCING CODE?
POPJ P, ;NO, JUST RETURN
MOVE B,CECOD ;FILL IN WITH NEXT STATEMENT ADDRESS
LNKTH1: ADD X1,FLCOD ;MAKE X1 AND ADDRESS TO FLCOD
HRRZ X2,(X1) ;PICK UP LINK
HRRM B,(X1) ;FIX JRST TO NEXT STATEMENT
JUMPE X2,CPOPJ ;ANOTHER LINK?
MOVE X1,X2 ;YES, SET X1
JRST LNKTH1 ;AND FIX ADDRESS
;END OF COMPILE/EXECUTE PHASE
SUBTTL PROGRAM "LOADER"
;HERE AFTER END STATEMENT
LINKAG:
SETZM VIRWRD ;EXECUTE SEGMENTS NEEDS VIRWRD, MAKE
SETZM VIRSIZ ;
;SURE IT IS ZERO
SKIPE RUNDDT##
JRST LDDTNH
SKIPN SAVRUN ;MAKING SAV CODE ?
JRST LKS1 ;NO, BACK TO MAINSTREAM
HRLZ L,FLLIN ;SET UP L
HRR L,CELIN ;TO SWEEP
MOVS N,L ;LINE ROLL
SUB L,N
SKIPGE DATAFF ;DATA SEEN ?
HLLZM L,DATAFF ;NOW WILL BE FIRST IN LINROL
ADDI L,-1
LKS2: PUSHJ P,NXLINE ;SET UP LINE
PUSHJ P,QSA ;WAS IT DATA
ASCIZ /DATA/
PUSHJ P,[MOVE B,FLLIN ;NO
ADDI B,(L) ;GET ITS #
MOVEI R,LINROL ;SET UP FOR LINROL
MOVSI D,1 ;REDUCE COUNT
SKIPGE DATAFF ;IF ANY
ADDM D,DATAFF ;OF DATA LINES
PUSHJ P,ERACOM ;AND ZAP IT
POPJ P,]
ADDI L,-1 ;BACK TO PREVIOUS LINE
JUMPLE L,LKS2
MOVE L,FLCOD ;GET CURRENT CODE FLOOR, SAVE
MOVEM L,OLDCOD ;FLAG TO PRESS THIS IS SAVE
PUSHJ P,PRESS
SKIPA R,[Z LINROL] ;SLIDE THE ROLLS
LKS1:
MOVEI R,CONROL ;SLIDE RUNTIME ROLLS DOWN INTO PLACE.
LKLAB1: PUSHJ P,SLIDRL
CAIGE R,TMPROL
AOJA R,LKLAB1 ;SLIDE NEXT ROLL.
MOVEM X2,VARFRE ;FIRST FREE LOC IS CEIL OF TMPROL.
SKIPN SAVRUN ;MAKING SAV FILE ?
JRST LKS3 ;NO
MOVE L,FLCOD ;YES, NEW CODE FLOOR
MOVE X1,L
SUB X1,OLDCOD ;CODE OFFSET
LKS4: CAMN L,CECOD ;FINISHED ?
JRST LKS3 ;YES
HLRZ X2,(L) ;NO, GET INSTRUCTION
CAIN X2,(HALT) ;HALT ?
TLZA X1,(4,) ;YES (FROM FOR) - TO JRST
CAIN X2,(SOJG LP,) ;ALL LOOP ?
ADDM X1,(L) ;YES FIX UP
TLO X1,(4,)
AOJA L,LKS4 ;AND LOOK FOR MORE
LKS3:
MOVE E,CETMP ;CHECK ARRAY REQUIREMENTS
MOVE T,FLARA
SETZM TRNFL2
SETZM TRNFLG
JRST LK2A
LK1: HLRZ X1,(T) ;KNOW SIZE?
TRNE X1,400000 ;IS IT VIRTUAL
JRST LK2B ;YES, IGNORE
JUMPN X1,LK2 ;YES, JUMP
SKIPG 2(T) ;DON'T SET UP FAKE MATRIX
JRST LKLAB2 ;YET, BUT REMEMBER WHICH ONE
MOVEM T,TRNFLG ;IT IS.
JRST LK2
LKLAB2: MOVSI X2,^D11 ;(11,1) IS STANDARD DIM
AOJ X2,
MOVEI X1,^D11
MOVE A,1(T)
AOJN A,LKLAB3 ;IMPLICIT 2-DIM ARRAY?
HRRI X2,^D11
MOVEI X1,^D121
LKLAB3: MOVEM X2,1(T)
HRLM X1,(T) ;STORE SIZE
LK2: ADD E,X1 ;ADD LENGTH TO IT
SKIPL 2(T)
JRST LK2B
CAMLE X1,TRNFL2 ;TRNFL2 CONTAINS THE SPACE NEEDED
MOVEM X1,TRNFL2 ;BY THE LRGST ARRAY SET = ITS OWN TRN.
LK2B: ADDI T,3 ;ON TO NEXT ENTRY
LK2A: CAME T,FLSVR ;THIS UNDOCUMENTED CODE IS
JRST LK2C ;DEC EDIT # 166
SKIPN X2,TRNFLG
JRST LK2D
MOVE X1,TRNFL2
HRLM X1,(X2)
ADD E,X1
LK2D: MOVEM E,SVRBOT
LK2C: CAMGE T,CESVR
JRST LK1
LK3: SETOM VPAKFL ;DONT TRY TO PRESS VARIABLE SPACE NOW!
SUB E,CESVR ;WE NEED THIS MANY LOCS
LK35: MOVE X1,VARFRE ;IS THERE ROOM FOR (E) LOCS?
ADDI X1,(E)
CAMGE X1,.JBREL
JRST LK37
TLNN X1,-1 ;TOO BIG FOR A PDP10 ?
CORE X1,
JRST [MOVEI T,PANIC1
JRST ERRMSG]
LK37: ADD E,CETMP ;CALCULATE TOP OF ARRAY SPACE.
MOVEM E,SVRTOP ;SAVE IT.
MOVEM E,VARFRE ;THIS IS ALSO FIRST FREE WORD.
SKIPN SAVRUN ;MAKING SAV CODE ?
JRST LK4 ;NO
HRLM E,.JBSA ;SAVE F.F. IN .JBSA
HRRM E,.JBFF ;AND .JBFF
LK4: MOVE T,FLFCL
MOVEI R,FCNROL
LINK0A: CAML T,CEFCL
JRST LINK0C ;NO MORE FCN CALLS
HLLZ A,(T) ;LOOK UP FUNCTION
PUSHJ P,SEARCH
JRST LINK0B ;UNDEFINED
MOVE A,(B) ;DEFINED. GET ADDRESS.
HRLM A,(T)
AOJA T,LINK0A
LINK0B: SETZM RUNFLA
PUSHJ P,INLMES
ASCIZ /
? Undefined function -- FN/
LDB C,[POINT 7,A,6]
PUSHJ P,OUCH
LDB C,[POINT 7,A,13]
JUMPE C,LNK0B1
PUSHJ P,OUCH
LNK0B1: TLNN A,4 ;INTEGER?
JRST LNK0B2 ;NO
MOVEI C,"%" ;YES, OUTPUT
PUSHJ P,OUCH ;A %
JRST LNK0B3 ;AND CONTINUE
LNK0B2: TLNN A,10 ;STRING?
JRST LNK0B3 ;NO
MOVEI C,"$" ;YES, OUTPUT
PUSHJ P,OUCH ;A $
LNK0B3: SKIPE CHAFL2
PUSHJ P,ERRMS3
PUSHJ P,INLMES
ASCIZ /
/
AOJA T,LINK0A
LINK0C: MOVE B,FLFOR ;UNSAT FORS?
LNK0C1: CAML B,CEFOR
JRST LINK0D
PUSHJ P,INLMES
ASCIZ /? FOR without NEXT/
MOVE L,(B) ;GET POINTER TO LINE NUMBER
SKIPN SAVRUN ;MAKING SAVE FILE ?
JRST LNK0C2 ;NO
PUSHJ P,INLMES ;YES, NO LINE NUMBER
ASCIZ /
/
JRST LNK0C3
LNK0C2: PUSHJ P,FAIL2
LNK0C3: ADDI B,5 ;MORE UNSAT FORS?
JRST LNK0C1
LINK0D: SKIPG DATAFF ;WAS DATA OMITTED?
JRST LINK0E ;NO
PUSHJ P,INLMES
ASCIZ /
? No DATA/
SKIPE CHAFL2
PUSHJ P,ERRMS3
LINK0G: SETZM RUNFLA
LINK0E: SKIPGE RUNLIN ;LINE NUMBER ARG IN RUN(NH) COMMAND?
JRST LINK0F ;NO.
HRLZ A,RUNLIN ;YES. MAKE SURE IT EXISTS AND
MOVEI R,LINROL
PUSHJ P,SEARCH
JRST [MOVEI T,ILLIN
JRST ERRMSG]
SUB B,FLOOR(R)
MOVEM B,RUNLIN
ADD B,FLREF ;IS NOT WITHIN A MULTI-LINE DEF.
SKIPN (B)
JRST LINK0F
MOVEI T,ILLIN
JRST ERRMSG
LINK0F: SKIPN RUNFLA ;GO INTO EXECUTION?
JRST LUXIT ;NO
MOVE C,FLCOD
;CODE ROLL IS IN PLACE. C CONTAINS ITS FLOOR
LINK0: MOVE T,FLFCL ;LINK FCN CALLS
MOVE T1,CEFCL
MOVE A,FLCOD
MOVEI B,0
PUSHJ P,LINKUP
LINK1A: MOVE T,FLARA ;LINK ARRAY REFS
MOVE T1,CESVR
MOVE A,T
MOVEI B,3
PUSHJ P,LINKUP
LINK1B: MOVE T,FLARA ;STORE ARRAY ADDRESSES IN ARAROL
MOVE G,CETMP
JRST LINK1D
LINK1C: HLRZ X1,(T) ;GET ARRAY LENGTH
TRNE X1,400000 ;VIRTUAL?
JRST LINK1E ;YES, IGNORE
HRRM G,(T) ;STORE ABS ADDRS
ADD G,X1 ;COMPUTE ADDRS OF NEXT ARRAY
LINK1E: ADDI T,3 ;GO TO NEXT ENTRY
LINK1D: CAMGE T,T1
JRST LINK1C
LINK1: MOVE T,FLCAD ;LINK CONST REFS
MOVE T1,CECAD
MOVE A,FLCON
MOVEI B,1
PUSHJ P,LINKUP
LINK2: MOVE T,FLPTM ;LINK TEMPORARY REFS (PERM AND TEMP)
MOVE T1,CETMP
PUSHJ P,LINKU1
LINK3: MOVE T,FLLAD ;LINK GOTO DESTINATIONS
MOVE T1,CELAD
MOVE A,FLCOD
MOVEI B,0
PUSHJ P,LINKUP
LINK4: MOVE T,FLSCA ;LINK SCALARS
MOVE T1,CEVSP
PUSHJ P,LINKU1
LINK6: MOVE T,FLGSB ;LINK GOSUB REFS
MOVE T1,CEGSB
PUSHJ P,LINKU1
MOVE T,FLGSB
LINK7: CAML T,T1 ;PUT SUBRTN ADDRSES IN GSBROL
JRST LINK8
HLRZ X1,(T)
ADD X1,FLLAD
HLRZ X1,(X1)
ADD X1,C
MOVEM X1,(T)
AOJA T,LINK7
LINK8: MOVE T,FLNXT ;LINK REVERSE REFS IN FORS
MOVE T1,CENXT
MOVE A,FLCOD
MOVEI B,0
PUSHJ P,LINKUP
LINK9: MOVE T,FLLIT ;LINK LITROL TO SLTROL.
LINK91: CAML T,CELIT
JRST LINK92
HRRZ A,(T)
ADD A,FLSLT
HRRM A,(T)
AOJA T,LINK91
LINK92: MOVE T,FLSAD ;LINK POINTERS TO LITROL
MOVE T1,CESAD
MOVE A,FLLIT
MOVEI B,1
PUSHJ P,LINKUP
SKIPGE X1,RUNLIN ;GET LOC TO START BEFORE
JRST LINKZ ;LADROL IS ZEROED.
ADD X1,FLLAD
HLRZ X1,(X1)
ADD X1,FLCOD
MOVEM X1,RUNLIN
LINKZ: MOVE X1,FLSCA ;ZERO OUT SCALARS AND STRING VARS
MOVE X2,CEVSP
PUSHJ P,BLTZER
MOVE X1,CETMP ;ZERO OUT ARRAY ELEMENTS AND STRING VECTORS.
MOVE X2,ARATOP
PUSHJ P,BLTZER
SKIPN SAVRUN ;MAKING SAV CODE ?
JRST LEXECT ;NO, JUST EXECUTE
MOVEI X1,START ;YES,GET START ADDRESS
HRRM X1,.JBSA ;AND SET IT UP
HLRZ X1,.JBSA ;FIRST FREE LOC
TRO X1,1777 ;ADJUST TO K BOUND
CAMN X1,.JBREL ;SIZE RIGHT ?
JRST LSAVE ;YES, GO SAVE
CORE X1, ;NO, CONTRACT
HALT ;IMPOSSIBLE ERROR
JRST LSAVE ;GO SAVE
;SUBROUTINE TO LINK ROLL ENTRIES
;CALL WITH A=ORG OF VALUE ROLL, B=INCREMENT (0 IF EXPLICIT REL LOC)
;T=FLOOR OF SRC ROLL, T1=CEIL OF SRC ROLL
LINKU1: MOVE A,T ;ORIGIN STARTS AT FLOOR
MOVEI B,1 ;ONE WORD PER ENTRY IN ROLE
LINKUP: MOVE X2,A
MOVSI X1,C
LNKP1: CAML T,T1 ;FINISHED ROLL?
POPJ P,
HRRZ A,(T) ;FIRST LOC IN CHAIN
JUMPN B,LKLAB5 ;EXPLICIT ADDRS?
HLRZ X2,(T) ;YES. COMPUTE IT
ADD X2,C
LKLAB5: JUMPE A,LNKP3 ;SPECIAL CASE--CHAIN VOID
LNKP2: HRR X1,A ;ONE LINK IN CHAIN
HRRZ A,@X1
HRRM X2,@X1
JUMPN A,LNKP2
LNKP3: JUMPN B,LKLAB6 ;EXPLICIT ADDRS?
AOJA T,LNKP1 ;YES, JUST BUMP ROLL PNTR
LKLAB6: ADD T,B ;NO, ADD EXPLICIT INCREMENT
ADD X2,B ; (ALSO TO DEST ROLL)
JRST LNKP1
SLIDRL: MOVE X2,CEIL(R)
HRRZ X1,CEIL-1(R) ;SLIDE ROLL DOWN NEXT TO LOWER ROLL
ADD X2,X1
HRL X1,FLOOR(R) ;SET UP BLT TO MOVE ROLL
SUB X2,FLOOR(R)
HRRZM X1,FLOOR(R) ;SET NEW ROLL FLOOR
BLT X1,(X2)
MOVEM X2,CEIL(R)
POPJ P,
;ROUTINE TO MAKE A ROLL OF ZEROS =IN LNTH TO LINROL.
ZERROL: MOVE R,F
MOVE E,CELIN ;COMPUTE LENGTH OF ROLL
SUB E,FLLIN
JUMPE E,NOEND ;NOTHING TO DO
MOVN L,E ;SAVE FOR LINE CNTR.
MOVSI L,(L)
PUSHJ P,BUMPRL ;ADD TO (EMPTY) ROLL
MOVE T,FLOOR+(F) ;CLEAR IT TO 0S
SETZM (T)
HRL T,T
ADDI T,1
MOVE T1,CEIL+(F)
CAILE T1,(T) ;SUPPRESS BLT IF ONLY 1 LINE
BLT T,-1(T1)
POPJ P,
BLTZER: HRL X1,X1 ;ZERO OUT CORE
SETZM (X1)
AOJ X1,
BLT X1,-1(X2)
POPJ P,
SUBTTL STATEMENT GENERATORS
;CHAIN STATEMENT.
;
;CHAIN HAS TWO FORMS:
;
; CHAIN DEV:FILENM.EXT, LINE NO.
; OR
; CHAIN <STRING EXPRESSION>, LINE NO.
;
;IN EACH CASE, ",LINE NO." IS OPTIONAL.
;
;XCHAIN IS REACHED FROM XCHAN.
XCHAIN: PUSHJ P,QSA
ASCIZ /IN/
JRST ILLINS
PUSHJ P,CHKCR1 ;CHECK CORE REQUIREMENTS
TLNN C,F.DIG+F.LETT
JRST XCHAI1
MOVEI A,5
PUSH P,T
PUSH P,C
XCHA0: PUSHJ P,NXCH
TLNE C,F.DIG+F.LETT
SOJG A,XCHA0
JUMPN A,XCHA01
PUSHJ P,NXCH
XCHA01: SETZ A,
TLNN C,F.COMA+F.TERM+F.PER
CAIN C,":"
SETO A,
POP P,C
POP P,T
JUMPE A,XCHAI1
XCHAI2: PUSHJ P,FILNAM ;PROCESS FORM 1.
JUMP CATFLG
MOVSI D,(HRLZI N,) ;THE CODE BEING GENERATED
HLR D,CATFLG ;IS DESCRIBED IN MEMO
PUSHJ P,BUILDI ;#100-365-033-00.
MOVSI D,(HRRI N,)
HRR D,CATFLG
PUSHJ P,BUILDI
MOVE D,[MOVEM N,NEWOL1]
PUSHJ P,BUILDI
MOVSI D,(HRLZI N,)
HLR D,FILDIR
PUSHJ P,BUILDI
MOVSI D,(HRRI N,)
HRR D,FILDIR
PUSHJ P,BUILDI
MOVE D,[MOVEM N,FILDIR]
PUSHJ P,BUILDI
MOVSI D,(HRLZI N,)
HLR D,FILDIR+1
PUSHJ P,BUILDI
MOVE D,[MOVEM N, FILDIR+1]
PUSHJ P,BUILDI
MOVE D,[SETZM FILDIR+2]
PUSHJ P,BUILDI
SKIPN DEVBAS
JRST XCHA21
MOVE D,[HRLZI N,5]
PUSHJ P,BUILDI
MOVE D,[AOS N]
PUSHJ P,BUILDI
MOVE D,[MOVEM N,FILDIR+3]
PUSHJ P,BUILDI
MOVE D,[SETOM DEVBAS]
XCHA20: PUSHJ P,BUILDI
JRST XCHAI5 ;GO LOOK FOR LINE NO. ARG.
XCHA21: SKIPN FILDIR+3
JRST XCHA22
MOVSI D,(HRLZI N,)
HLR D,FILDIR+3
PUSHJ P,BUILDI
MOVSI D,(HRRI N,)
HRR D,FILDIR+3
PUSHJ P,BUILDI
SKIPA D,[MOVEM N,FILDIR+3]
XCHA22: MOVE D,[SETZM FILDIR+3]
PUSHJ P,BUILDI
MOVE D,[SETZM DEVBAS]
JRST XCHA20
XCHAI1: PUSHJ P,MASCHK
XCHAI7: MOVE D,[PUSHJ P,CHAHAN]
PUSHJ P,BUILDI
XCHAI5: TLNE C,F.TERM ;LINE NO. ARG?
JRST XCHAI6 ;NO.
TLNN C,F.COMA
JRST ERTERM
SKIPE SAVRUN ;MAKING SAV CODE ?
FAIL <? CHAIN with line arg in SAVFIL(NL)>
PUSHJ P,NXCH
PUSHJ P,FORMLN ;YES.
PUSHJ P,CHKINT ;WE WANT AN INTEGER
MOVE D,[JUMPL N,CHAERR]
PUSHJ P,BUILDI
MOVE D,[CAILE N,303237]
PUSHJ P,BUILDI
MOVE D,[JRST CHAERR]
PUSHJ P,BUILDI
SKIPA D,[MOVEM N,RUNLIN]
XCHAI6: MOVE D, [SETOM RUNLIN]
PUSHJ P,BUILDI
MOVE D, [SETOM CHAFLG]
PUSHJ P,BUILDI
MOVE D,[JRST CHAXIT]
PUSHJ P,BUILDI
JRST NXTSTA
;CHANGE STATEMENT
; CHANGE <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
POP P,T
POP P,C
HRLI F,0
PUSHJ P,VECTOR
JUMPN A,GRONK
MOVSI D,(VECFRL)
SKIPGE TYPE ;REAL VECTOR?
MOVSI D,(VECFIN) ;NO, SET FOR INTEGER
PUSHJ P,BUILDA ;GENERATE VECTOR FETCH
PUSHJ P,QSF ;"TO" MUST FOLLOW
ASCIZ /TO/
HRLI F,1
TLNN C,F.LETT
JRST ERLETT
PUSHJ P,ATOM
CAIE A,5
CAIN A,6
CAIA
JRST ILFORM
MOVSI D,(STOCHA)
XCHAN2: PUSHJ P,BUILDA ;BUILD APPROPRIATE STORE UUO
JRST NXTSTA
XCHAN3: POP P,T
POP P,C
XCHAN1: PUSHJ P,FORMLS ;PROCESS STRING NAME
PUSHJ P,EIRGNP
PUSHJ P,QSF
ASCIZ /TO/
HRLI F,0
PUSHJ P,VECTOR ;REGISTER VECTOR NAME
JUMPN A,GRONK
MOVSI D,(VECPRL)
SKIPGE TYPE ;REAL VECTOR?
MOVSI D,(VECPIN) ;NO, SET FOR INTEGER
JRST XCHAN2 ;GO BUILD STORE UUO
; CLOSE STATEMENT
XCLOSE: ASCIZ /SE/
PUSHJ P,GETCN2 ;GET CHANNEL NO
XCLOS0: MOVE D,[PUSHJ P,CLSFIL]
PUSHJ P,BUILDI
MOVE D,[SETZM ACTBL-1(LP)]
PUSHJ P,BUILDI
HRRI D,FILD-1 ;NOW CHANGE ACTBL TO FILD
PUSHJ P,BUILDI ;AND PRODUCE [SETZM FILD-1(LP)]
TLNN C,F.COMA ;MORE ?
JRST NXTSTA ;NO
PUSHJ P,GETCNA ;GET EM
JRST XCLOS0
;DATA STATEMENT
;<DATA 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/
SKIPL DATAFF ;ALREADY SEEN DATA?
MOVEM L,DATAFF ;NO. REMEMBER WHERE FIRST ONE IS
SETZM INPFLA
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
SKIPE FUNAME ;ARE WE IN MIDST OF MULTI-LINE DEF?
FAIL <? Nested DEF>
MOVEI D,1
MOVEM D,VRFSET
MOVSI D,(JFCL) ;MAKE SURE NOT FIRST WRD OF CODE
MOVE X1,CECOD
CAMG X1,FLCOD
PUSHJ P,BUILDI
TLNN C,F.LETT ;MAKE SURE LETTER FOLLOWS.
JRST ERLETT
PUSHJ P,SCNLT1 ;SCAN FCN NAME.
PUSHJ P,DIGIT ;CHECK FOR A DIGIT
HRLZI F,-1 ;MARK NUMERIC FOR NOW
PUSHJ P,DOLLAR ;CHECK FOR $
TLZA F,-2 ;MARK STRING, NO % POSSIBLE
PUSHJ P,PERCNT ;CHECK FOR A PERCENT
PUSH P,A ;SAVE FCN NAME WITH COUNT OF ZERO ARGUMENTS
MOVEM A,FUNAME ; FN'NAME IN BODY OF FUNCTION
MOVE X1,TYPE ;SAVE THE TYPE OF
MOVEM X1,FTYPE ;THE FUNCTION IN FTYPE
;ADD FUNCTION NAME TO FCNROL
XDEF1: MOVEI R,FCNROL ;LOOK FOR FCN NAME IN FCNROL
PUSHJ P,SEARCH
JRST XDLAB1
SETZM FUNAME
FAIL <? Function defined twice>
XDLAB1: MOVEI E,1 ;ADD TO FCNROL
PUSHJ P,OPENUP
ADD A,CECOD ;CONSTRUCT PNTR TO CONTROL WORD
SUB A,FLCOD ;STORE IN FCNROL ENTRY.
ADDI A,1
MOVEM A,(B)
MOVE B,L ;GET JRST DESTINATION
AOBJP B,XDLAB2
PUSHJ P,HALJRS
XDLAB2: MOVEM B,FUNSTA
CLEAR D, ;BUILD ZERO CONTROL WORD
PUSHJ P,BUILDI
PUSH P,D ;AND ARGUMENT TYPE MASK
MOVEI D,1 ;SET UP FOR ARG BITS.
;SCAN FOR ARGUMENT NAME.
XDEF2: CAIE C,"(" ;ANY ARGUMENTS?
JRST XDEF4 ;NO
XDEF2A: PUSHJ P,NXCHK ;SKIP "("
PUSHJ P,SCNLT1 ;ASSEMBLE ARGUMENT NAME
PUSHJ P,DIGIT ;SEE IF DIGIT FOLLOWS
PUSHJ P,DOLLAR ;CHECK FOR STRING
JRST XDEF5A ;
PUSHJ P,PERCNT ;CHECK FOR INTEGER
TLNN A,4 ;IS IT?
JRST XDEF5 ;NO, MARK AS REAL
IORM D,(P) ;MARK ONE BIT
JRST XDEF5A ;GO TO MARK NEXT
XDEF5: IORM D,(P) ;MARK AS REAL
LSH D,2 ;SET FOR NEXT ARG
JRST XDEF5B ;
XDEF5A: LSH D,1 ;SKIP A BIT
IORM D,(P) ;MARK FOR STRING
LSH D,1 ;SET FOR NEXT ARG
XDEF5B: SKIPN D ;ANY BITS LEFT ?
FAIL <? Too many function arguments>
MOVEI R,ARGROL ;NOW ADD THIS NAME TO THE ARGUMENT LIST
MOVE B,FLARG ;NOW CHECK ARGROL, FOR TWO IDENTICAL ARGS
XDEF2C: CAML B,CEARG
JRST XDEF2D
CAME A,(B)
AOJA B,XDEF2C
SETZM FUNAME
JRST GRONK
XDEF2D: MOVEI E,1 ;ADD NEW ARG TO ROLL
PUSHJ P,OPENUP
MOVEM A,(B)
AOS -1(P) ;COUNT THE ARGUMENT
TLNE C,F.COMA ;ANY MORE ARGS?
JRST XDEF2A ;YES
XDEF3: TLNN C,F.RPRN ;FOLLOWING PARENTHESIS?
JRST [SETZM FUNAME
JRST ERRPRN] ;NO.
PUSHJ P,NXCHK ;YES. SKIP IT.
XDEF4: PUSHJ P,ARGCHK ;CHECK FOR RIGHT NUMBER OF ARGUMENTS
;GEN CODE TO EVALUATE EXPRESSION.
MOVE X1,FLTMP ;SAVE TEMP ROLL AS STMROL
MOVEM X1,FLSTM
MOVEM X1,CETMP ;AND EMPTY TMPROL
MOVE X1,TMPLOW ;SAVE TEMP POINTER
MOVEM X1,FUNLOW
SETOM TMPLOW
SETOM TMPPNT
TLNN C,F.EQAL ;MULTI LINE FN?
JRST XDEFM ;YES
PUSHJ P,NXCHK ;NO. SKIP EQUAL SIGN
SETZM FUNAME ;SIGNAL THAT THIS IS NOT A MULTI-LINE FN
PUSHJ P,FORMLU ;GEN THE EXPRESSION
PUSH P,B ;SAVE B
PUSHJ P,CMIXER ;
POP P,B ;RESTORE B
PUSHJ P,EIRGNP ;GET IT IN REG
;NOW BUILD AN INSTRUCTION THAT WILL TELL RETURN HOW MANY ARGS TO POP
;OFF THE PUSH LIST
POP P,B ;DITCH ARGUMENT TYPE MASK
POP P,B ;ARGCHK PUT THE ADDRESS OF A CONSTANT IN HERE
XDEFE: MOVSI D,(MOVE T,)
PUSHJ P,BUILDA
MOVE X2,CETMP ;RESTORE TMPROL, SAVE TEMPORARIES FOR FCN
MOVE X1,CESTM
MOVEM X2,CEPTM
MOVEM X2,FLTMP
MOVEM X1,CETMP
MOVEM X1,FLSTM
HRRE X1,FUNLOW ;RESTORE TMPLOW
MOVEM X1,TMPLOW
HRRZ X1,FUNSTA ;-1(X1) IS LOC OF JRST AROUND FUNCTION
ADD X1,FLCOD
HRRZ X2,CECOD ;JRST TO THE NEXT INST TO BE CODED
ADDI X2,1
HRRM X2,(X1)
MOVE D,[JRST FRETRN]
JRST XRET1 ;USE RETURN CODE TO BUILD INST
XDEFM:
SKIPE MULLIN ;MULTI STATEMENT ?
FAIL<? DEFINE must be first in line>
POP P,X1 ;DITCH ARGUMENT TYPE MASK
POP P,X1 ;MULTI-LINE DEF. SAVE THE ARGCOUNT PARAMETER FOR FNEND
HRLM X1,FUNSTA
MOVE X1,CEFOR ;SAVE NUMBER OF ACTIVE FORS
SUB X1,FLFOR ;FOR A CHECK OF FORS HALF IN DEF
HRLM X1,FUNLOW
TLNE C,F.CR
JRST NXTSTA
MOVE D,[JSP A,LINADR]
PUSHJ P,BUILDI
MOVE D,SORCLN
PUSHJ P,BUILDI
JRST NXTSTA
;DIM STATEMENT
;<DIM 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
PUSH P,AFLAG ;SAVE A FLAG
CLEARM VIRDIM ;ASSUME NOT VIRTUAL ARRAY
CAME C,[XWD F.STR,"#"] ;IS IT VIRTUAL ARRAY
JRST XDIMA ;NO, CARRY ON
PUSHJ P,NXCH ;EAT THE #
MOVEI N,1 ;INITIALIZE STARTING WORD
MOVEM N,VIRSIZ ;TO ONE
MOVEM N,VIRWRD ;SET CURRENT WORD TO ONE
CLEARM VIRBLK ;CURRENT BLOCK IS ZERO
CLEARM IFFLAG ;CLEAR TYPE FLAG
PUSHJ P,GETNUM ;GET THE CHANNEL
CAIA ;ERROR
CAILE N,^D9 ;MUST BE LESS THAN 10
XDLAB3: FAIL <? Illegal channel specified>
JUMPE N,XDLAB3 ;CAN'T BE ZERO EITHER
MOVEM N,VIRDIM ;SAVE CHANNEL
TLNN C,F.COMA ;NEED A COMMA NOW
JRST ERCOMA ;AND WE DIDN'T GET IT
PUSHJ P,NXCHK ;GET FIRST CHARACTER OF VARIABLE
XDIMA: SETZI F, ;ALLOW STRING VECTORS.
PUSHJ P,ARRAY ;REGISTER ARRAY NAME
CAIE A,5 ;STRING VECTOR? ELSE..
JUMPN A,GRONK ;NON-0 RESULT FLAG-SYNTAX ERROR.
CAIE C,"(" ;CHECK OPENING PAREN
JRST ERLPRN
ADD B,FLOOR(F) ;COMPUTE LOC OF ROLL ENTRY
SKIPLE X1,1(B) ;DIMENSION FLAG SHOULD BE 0 OR -1 OR -2.
FAIL <? Variable dimensioned twice>
MOVEM X1,TEMLOC
PUSHJ P,NXCHK ;SKIP PARENTHESIS
PUSHJ P,GETNU ;FIRST DIMENSION
JRST GRONK ;NOT A NUMBER
JUMPN N,XDLAB4
SETZM TEMLOC
XDLAB4: TLNE N,-1 ;WITHIN RANGE
FAIL <? Dimensions too large>
HRRZ D,N ;SAVE FIRST DIM
AOBJN D,XDLAB5 ;D::= XWD <FIRST DIM+1>,1
XDLAB5: MOVSM D,1(B) ;STORE IN ARAROL (IN CASE 1 DIM)
MOVEI N,1 ;IN CASE ONE DIMENSION
TLNN C,F.COMA ;TWO DIMS?
JRST XDIM1 ;NO
PUSHJ P,NXCHK ;YES. SKIP COMMA.
PUSHJ P,GETNU ;GET SECOND DIM
JRST GRONK ;NOT A NUMBER
JUMPN N,XDLAB6
SETZM TEMLOC
XDLAB6: TLNE N,-1
FAIL <? Dimensions too large>
ADDI N,1
HRL D,N ;NOW D HAS XWD <COLS+1>,<ROWS+1>
MOVSM D,1(B) ;STORE IN ROLL SWAPPED
MOVNI X1,2
CAMN X1,TEMLOC
FAIL <? Vector cannot be matrix>
XDIM1: TLNN C,F.RPRN ;RIGHT PAREN?
JRST ERRPRN ;NO, GIVE ERROR
PUSHJ P,NXCH ;GET NEXT CHARACTER
IMULI N,(D) ;CALCULATE SIZE OF THE ARRAY
SKIPN VIRDIM ;VIRTUAL ARRAY?
JRST XDIM8 ;NO, JUST STORE SIZE
PUSH P,T ;SAVE T
SUB B,FLOOR(F) ;MAKE B AN OFFSET TO ARRAY ROLLS
PUSH P,B ;AND SAVE IT
MOVEI A,0 ;NEED TWO ZERO LOCATIONS
MOVEI R,VIRROL ;IN THE VIRTUAL ARRAY ROLL
PUSHJ P,RPUSH ;GET FIRST LOCATION
PUSHJ P,RPUSH ;GET SECOND LOCATION
SOJ B, ;POINT TO FIRST LOCATION
JUMPGE F,XDIM4 ;STRING VIRTUAL ARRAY?
SKIPLE IFFLAG ;NUMERIC FOLLOWING NUMERIC?
JRST XDIM3 ;NO, MUST HAVE FOLLOWED A STRING
;
; NUMERIC ARRAY FOLLOWING NUMERIC ARRAY
;
SKIPN X1,VIRBLK ;FIRST BLOCK OF FILE
JRST XDIM2 ;YES, JUST USE VIRWRD
IMULI X1,^D128 ;128 WRODS PER BLOCK
SUBI X1,2 ;EXCEPT FOR FIRST BLOCK
XDIM2: ADD X1,VIRWRD ;PLUS PARITALLY FILLED BLOCK
XDIM2A: MOVEM X1,(B) ;STORE RANDOM RECORD NUMBER FOR PETE
IDIVI N,^D128 ;NUMBER OF BLOCKS NEEDED FOR THIS ARRAY
ADD T,VIRWRD ;ADD PARTIAL BLOCK
SKIPN VIRBLK ;FIRST BLOCK?
ADDI T,2 ;REMEMBER THE TWO WORDS
IDIVI T,^D128 ;TWO PARTIALS EQUAL ONE BLOCK
ADDM T,VIRBLK ;COULD BE
SKIPN VIRBLK
SUBI T1,2
MOVEM T1,VIRWRD ;SAVE PARTIAL WORD BLOCK POINTER
ADDM N,VIRBLK ;ADD IN BLOCKS NEEDED
JRST XDIM7 ;FIX UP CHANNEL NUMBER
;
; NUMERIC FOLLOWING A STRING ARRAY
;
XDIM3: MOVE X1,VIRBLK ;CURRENT BLOCK NUMBER
IMULI X1,^D128 ;NUMBER OF WORDS USED
SOJ X1, ;LESS TWO IN FIRST BLOCK
MOVEI X2,1 ;START NEW BLOCK
MOVEM X2,VIRWRD ;STARTS AT FIRST WORD
AOS VIRBLK ;STEP TO NEXT BLOCK
JRST XDIM2A ;FIX UP FOR NEXT ARRAY
;
; HERE FOR STRING ARRAY
;
XDIM4: MOVEM N,VIRSIZ ;SAVE SIZE OF ARRAY
MOVEI N,^D16 ;DEFAULT SIZE FOR STRING IS 16
TLNN C,F.EQAL ;SIZE GIVEN?
JRST XDIM4B ;NO, USE DEFALUT
PUSHJ P,NXCH ;EAT THE EQUALS
PUSHJ P,GETNU ;GET THE SIZE
FAIL <? Illegal string size>
MOVEM T,-1(P) ;RESET T
CAIG N,^D128 ;WITHIN LIMITS
SOJGE N,XDLAB7 ;NOT ZERO
FAIL <? Illegal string size>
XDLAB7: JFFO N,XDLAB8 ;
MOVEI T,^D35 ;
XDLAB8: MOVNS T ;NEGATE T
MOVSI N,400000 ;SETUP FOR SHIFT
LSH N,1(T) ;SHIFT ONE FOR CORRECT POWER
XDIM4B: HRLM N,1(B) ;PUT STRING SIZE IN VIRROL
SKIPLE IFFLAG ;FOLLOWING A NUMERIC?
JRST XDIM6 ;NO, SEE IF WE CAN FIT IN A RECORD
SKIPN VIRBLK ;STILL IN FIRST BLOCK
AOS VIRBLK ;YES, MAKE IT ONE
XDIM5: AOS X1,VIRBLK ;START NEW BLOCK
MOVEI X2,1 ;AND FIRST WORD
MOVEM X2,VIRWRD ;OF NEW BLOCK
HRLM X2,(B) ;SAVE BYTE COUNT
HRRM X1,(B) ;AND BLOCK COUNT IN VIRROL
IMUL N,VIRSIZ ;NUMBER OF BYTES NEEDED
XDIM5A: IDIVI N,^D512 ;NUMBER OF BLOCKS NEEDED
AOJ T, ;POINT TO NEXT RECORD
MOVEM T,VIRWRD ;SAVE PARTIAL WORD FILL
ADDM N,VIRBLK ;UPDATE BLOCK COUNT
JRST XDIM7 ;SETUP CHANNEL
XDIM6: MOVEI X1,^D513 ;BLOCK SIZE + 1
SUB X1,VIRWRD ;NUMBER OF WROD LEFT
IDIV X1,N ;CAN REOCRDS FIT IN
JUMPN X2,XDIM5 ;NOT EVENLY, START A NEW BLOCK
MOVE T,VIRBLK ;CURRENT BLOCK
HRL T,VIRWRD ;GET BYTE COUNT
MOVEM T,(B) ;SAVE IN VIRROL
IMUL N,VIRSIZ ;CHARACTER SIZE
SUBI N,^D513 ;PLUS FULL BLOCK + 1
ADD N,VIRWRD ;LESS SPACE ALREADY USED
AOS VIRBLK ;POINT TO NEXT BLOCK
JRST XDIM5A ;CARRY ON
XDIM7: MOVE X1,VIRDIM ;GET CHANNEL NUMBER
HRRM X1,1(B) ;STORE IN VIRROL
MOVEM F,IFFLAG ;SAVE TYPE FOR THIS ARRAY
SUB B,FLVIR ;MAKE B AN OFFSET
TRO B,400000 ;FLAG IT AS VIRTUAL ARRAY
POP P,X1 ;GET BACK ARRAY ROLL OFFSET
ADD X1,FLOOR(F) ;MAKE IT ABSOLUTE
HRLM B,(X1) ;STORE IN ARRAY ROLL
POP P,T ;RESTORE T
JRST XDIMFN ;FINISH THE DIMENSIONS
XDIM8: CAILE N,377777 ;CHECK MAXIMUM DIMENSION SIZE
FAIL <? Dimensions too large>
HRLM N,0(B) ;STORE IN ROLL
XDIMFN: TLNN C,F.COMA
JRST XDMFN1 ;NO, DONE WITH THIS STATEMENT.
PUSHJ P,NXCHK ;SKIP THE COMMA.
JRST XDIMA ;KEEP SCANNING.
XDMFN1: POP P,AFLAG ;RESTORE A FLAG
JRST NXTSTA ;NEXT STATEMENT
; ELSE STATEMENT
XELS: MOVEM T,MULLIN ;SAVE POINTER
PUSHJ P,QSA ;CHECK FOR FULL ELSE
ASCIZ /E/
JRST ILLINS ;ILLEGAL INSTRUCTION
SOSGE THNCNT ;IS ELSE LEGAL?
FAIL <? ELSE without THEN>
SKIPE ELSFLG ;SINGLE WORD THEN
JRST XELS0 ;YES, SKIP THEN FIX
MOVE X1,THENAD ;PICK UP THEN LINKAGE
MOVE B,CECOD ;ADDRESS FOR ELSE CLAUSE
AOJ B, ;
SKIPN RUNFLA ;STILL RUNNING?
JRST XELS0 ;NO, CONTINUE
ADD X1,FLCOD ;POINT TO CODROL
HRRZ X2,(X1) ;PICK UP NEW LINK
MOVEM X2,THENAD ;SAVE IT
HRRM B,(X1) ;SET THEN ADDRESS
XELS0: TLNE C,F.DIG ;LINE NUMBER?
JRST ELSGO ;SPECIAL TREATMENT
SKIPE ELSFLG ;SINGLE WORD THEN?
JRST XELS1 ;YES, NO JRST NEXT STATEMENT ADDRESS
PUSHJ P,HALJRS ;JRST TO NEXT STATEMENT
PUSHJ P,FIXELS ;FIX LINK FOR ELSEAD'S
XELS1: CLEARM ELSFLG ;NO MORE SINGLE WORD THENS
TLNE C,F.TERM ;TERMINATOR ?
FAIL <? Illegal ELSE>
JRST NXSM1 ;NEXT STATEMENT
ELSGO: MOVSI D,(CAIA) ;SKIP FROM THEN
SKIPN ELSFLG ;UNLESS SINGLE WORD
PUSHJ P,BUILDI ;
PUSHJ P,XGOFR ;HANDLE THE LINE NUMBER
SETZM ELSFLG ;UNSET SINGLE WORD THEN
TLNN C,F.CR ;CARRIAGE RETURN
CAMN C,[XWD F.APOS,"'"] ;
JRST NXSM2 ;YES, DONE WITH STATEMENT
PUSHJ P,QSELS ;ELSE NEXT
JRST ERTERM ;NO, THEN SHOULD BE TERMINATOR
JRST NXTSTA ;NEXT STATEMENT
FIXTHN: SKIPN RUNFLA ;STILL RUNNING?
POPJ P, ;NO, RETURN
SKIPN X1,THENAD ;FIRST IN LINK?
JRST FIXTH1 ;NO, JUST SAVE THENAD
ADD B,FLCOD ;POINT TO CODROL
HRRM X1,(B) ;NO, MAKE LINK
SUB B,FLCOD ;BACK TO OFFSET
FIXTH1: MOVEM B,THENAD ;SAVE POINTER
POPJ P, ;RETURN
FIXELS: SKIPN RUNFLA ;STILL RUNNING?
POPJ P, ;NO, JUST RETURN
SKIPN X1,ELSEAD ;FIRST IN LINK?
JRST FIXEL1 ;NO, JUST SAVE ELSEAD
ADD B,FLCOD ;
HRRM X1,(B) ;NO, MAKE LINK
SUB B,FLCOD ;
FIXEL1: MOVEM B,ELSEAD ;SAVE POINTER
POPJ P, ;RETURN
;END STATEMENT
;<END STA> ::= END
XEND: MOVE X1,FLLIN ;CHECK THAT IT IS LAST STA
ADDI X1,1(L)
CAMN X1,CELIN
TLNN C,F.CR
FAIL <? END is not last>
SKIPN FUNAME
JRST XEND1
PUSHJ P,INLMES
ASCIZ /
? No FNEND for DEF FN/
MOVEI T,FUNAME
SETZ D,
PUSHJ P,PRINT
SKIPE CHAFL2 ;CHAINING?
JRST ERRMS2 ;YES.
PUSHJ P,INLMES
ASCIZ/
/
JRST LUXIT
XEND1: SKIPE THNELS ;UNDER THEN OR ELSE ?
FAIL <? END under conditional>
MOVE D,[JRST EUXIT] ;COMPILE TERMINAL EXIT
PUSHJ P,BUILDI
JRST LINKAG ;GO FINISH UP AND EXECUTE
;FOR STATEMENT
;CALCULATE INITIAL, STEP, AND FINAL VALUES
;
;SET INDUCTION VARIABLE TO INITIAL VALUE
;AND JUMP TO END IF IND VAR .GT. FINAL
;INCREMENTING IS HANDLED AT CORRESPONDING NEXT.
;FIVE WORD ENTRY PLACED ON FORROL FOR USE
;BY CORRESPONDING NEXT STATEMENT:
; CURRENT VALUE OF L (FOR "FOR WITHOUT NEXT" MESSAGE)
;<ADRS 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>
PUSHJ P,FORCOD ;GO GENERATE CODE
TLNN C,F.TERM ;MODIFIERS ILLEGAL IN FOR
FAIL <? Illegal FOR use>
JRST NXTSTA ;DO NEXT STMNT
FORCOD: TLNN C,F.LETT ;MAKE SURE VARIABLE IS FIRST.
JRST ERLETT
HRLI F,777777
PUSHJ P,REGLTR ;REGISTER ON SCAROL
CAIE A,1 ;BETTER BE SCALAR
JRST ILVAR
TLNN C,F.EQAL ;BETTER HAVE EQUAL
JRST EREQAL
MOVE X1,TYPE ;GET TYPE FOR 'FOR'
MOVEM X1,FTYPE ;SAVE IT
PUSHJ P,NXCHK ;SKIP EQUAL SIGN.
PUSH P,B ;SAVE THE VARIABLE POINTER
PUSHJ P,FORMLN ;GEN THE INITIAL VALUE
PUSHJ P,EIRGNP
PUSHJ P,CMIXER ;
MOVSI D,(MOVEM N,) ;GEN STORE INITIAL IN VARIABLE
MOVE B,(P)
PUSHJ P,BUILDA
SETZ B, ;GET A ZERO WORD
PUSH P,B ;PUT IT ON STACK FOR INCREMENT
PUSH P,B ;PUT IT ON STACK FOR UPPER BOUND
FORELS: PUSHJ P,KWSFOR ;LOOK FOR FOR KEYWORDS
JRST FORSET ;NO MORE
MOVE X1,KWDIND ;INDEX TO KEYWORD
SUBI X1,KWAFOR-1
LSH X1,-1
JRST @FRKEYS(X1) ;GO HANDLE KEYWORD ELEMENT
FRKEYS: JRST FORTOC ;TO
JRST FORBYC ;BY OR STEP
JRST FORWHC ;WHILE
JRST FORUNC ;UNTIL
FORTOC: SKIPE (P) ;SEEN TO ALREADY ?
FAIL <? Illegal FOR use>
PUSHJ P,FORMLN ;GEN THE UPPER BOUND.
JUMPL B,XFOR4 ;EXCEPT FOR THE SPECIAL
MOVE X1,FTYPE ;
CAMN X1,TYPE ;
JRST XFOR2 ;
PUSHJ P,EIRGEN ;PUT IT IN A REGISTER
PUSHJ P,CHKTYP ;FIX OR FLOAT IT
JRST XFOR4+1 ;
XFOR2: HLRZ X1,B ;CASE OF A POSITIVE
ANDI X1,ROLMSK ;CONSTANT, FORCE THE
CAIN X1,CADROL ;UPPERBOUND TO BE
JRST XFLAB1 ;STORED IN A
XFOR4: PUSHJ P,EIRGEN ;PERMANENT
PUSHJ P,SIPGEN ;TEMPORARY.
XFLAB1: MOVEM B,(P) ;REMEMBER WHERE IT IS
JRST FORELS ;GO FOR NEXT KEYWORD
FRBY1: MOVEM C,FORCAR ;SAVE CHAR
MOVEM T,FORPNT ;AND POINTER
MOVE T,[POINT 7,[BYTE (7)"1",15]]
;IMPLICIT "STEP1"
PUSHJ P,NXCH ;PULL IN 1
CAIA
FORBYC: SETZM FORCAR ;FLAG EXPLICIT STEP
SKIPE -1(P) ;ALREADY SEEN INCRE ?
FAIL <? Illegal FOR use>
PUSHJ P,FORMLN ;XLATE AND GEN INCREMENT
SETZM CATFLG ;CATFLG=0 SAYS STEP IS NOT A CONSTANT.
HLRZ X1,B
ANDI X1,ROLMSK
CAIE X1,CADROL
JRST XFOR6
MOVE X1,FTYPE ;
CAMN X1,TYPE ;
JRST XFOR5 ;
PUSHJ P,EIRGEN ;
PUSHJ P,CHKTYP ;
JRST XFOR7 ;
XFOR5: SETOM CATFLG ;EXCEPT FOR THE SPECIAL
JRST XFOR7+1 ;CASE OF A CONSTANT,
XFOR6: PUSHJ P,EIRGEN ;SAVE THE STEP VALUE
MOVE X1,FTYPE ;
CAME X1,TYPE ;
PUSHJ P,CHKTYP ;
XFOR7: PUSHJ P,SIPGEN ;IN A PERMANENT TEMP.
MOVEM B,-1(P) ;REMEMBER WHERE IT IS
SKIPN FORCAR ;EXPLICIT STEP ?
JRST FORELS ;YES, NEXT KEYWORD
MOVE C,FORCAR ;NO, RESTORE CHAR
MOVE T,FORPNT ;AND POINTER
JRST FORTER ;GENERATE TERMINATE CODE
FORSET: SKIPN (P) ;SEEN UPPER BOUND
FAIL <? Illegal FOR use>
MOVMM P,LOGNEG ;MAKE LOGNEG + TO FLAG NO COND
JRST XFOR1 ;GO CHECK STEP
FORUNC: SETOM LOGNEG ;FLAG LOGICAL NEGATION
CAIA
FORWHC: SETZM LOGNEG ;STRAIGHT LOGIC
XFOR1: SKIPN -1(P) ;SEEN INCREMENT
JRST FRBY1 ;NO, GENERATE 1
FORTER: SKIPN (P) ;SEEN UPPER BOUND ?
JRST FORCTR ;NO, JUST LOGIC
MOVE B,-2(P) ;GET INDUCTION VAR IN REG
PUSHJ P,EIRGEN
SKIPE CATFLG
JRST XFOR3
MOVE B,-1(P) ;GET THE INCREMENT POINTER
MOVSI D,(DONFOR) ;BUILD DONFOR EXCEPT FOR A
PUSHJ P,BUILDA ;CONSTANT STEP.
XFOR3: MOVE X1,-1(P)
MOVE B,(P) ;BUILD COMPARE INSTR (IT
MOVSI D,(CAMLE N,) ;DOESN'T MATTER WHAT IT
SKIPGE X1 ;IS IF DONFOR IS THERE).
MOVSI D,(CAMGE)
PUSHJ P,BUILDA
HRLM B,FORPNT ;STORE CAM ADR FOR NEXT
JRST FORCTZ ;CHECK IF LOGIC NEEDED TOO
FORCTR: MOVE X1,CECOD ;NEXT LOC
SUB X1,FLCOD
HRLM X1,FORPNT ;FOR NEXT TO JRST TO
SETCMM LOGNEG ;REVERSE LOGIC
JRST FORLOG ;GO DO LOGIC
FORCTZ: SKIPLE LOGNEG ;ANY LOGIC ?
JRST FORZZZ ;NO, REALLY GO FINISH UP
MOVNI A,4
FORCOP: MOVE D,FORRUN+4(A)
PUSHJ P,BUILDI ;COPY LOGIC STORE CODE
AOJL A,FORCOP
FORLOG: MOVE B,-2(P) ;GET INDUCTION VAR
MOVSI D,(MOVEM N,) ;GENERATE STORE
PUSHJ P,BUILDA
PUSHJ P,IFCCOD ;GO GENERATE LOGIC CODE
MOVE D,[SKIPN FTRUTH] ;LOGIC TRUE, WAS CAM ?
SKIPE (P) ;NO UPPER BOUND ?
PUSHJ P,BUILDI
FORZZZ: POP P,B ;POP OFF UPPER BOUND
PUSHJ P,HALJRS ;BUILD HALT OR JRST TO NEXT+1
HRRM B,FORPNT ;TELL NEXT WHERE IT IS
MOVE B,-1(P) ;INDUCTION VAR
MOVSI D,(MOVEM N,) ;STORE CODE
SKIPLE LOGNEG ;IF NO LOGIC
PUSHJ P,BUILDA
MOVE A,L ;SAVE L FOR POSSIBLE ERROR MSG
MOVEI R,FORROL
PUSHJ P,RPUSH
MOVE A,FORPNT ;GET JRST POINTERS
PUSHJ P,RPUSH ;ON FOR STACK
POP P,FORPNT
POP P,A ;AND INDUCTION VAR
PUSHJ P,RPUSH
MOVE A,FORPNT ;AND INCREMENT
PUSHJ P,RPUSH
MOVE A,TMPLOW ;SAVE PROT LEVEL TO BE RESTORED BY NEXT
PUSHJ P,RPUSH
MOVE A,TMPPNT ;PROTECT TEMPS USED BY THIS "FOR"
MOVEM A,TMPLOW ;IN THE RANGE OF THE FOR.
POPJ P,
FORRUN: TDZA X1,X1 ;RUN-TIME LOGIC STORE
SETO X1,
MOVEM X1,FTRUTH
SKIPE FTRUTH ;SKIP STORE IF LOOP OVER
FIXADR: SKIPN RUNFLA ;GOING TO RUN
POPJ P, ;NO, JUST RETURN
ADD X1,FLCOD ;FIX CODROL ADDRESS
HRRM B,(X1) ;FIX JRST ADDRESS
POPJ P, ;RETURN
HALJRS: SKIPE SAVRUN ;MAKING SAV CODE ?
SKIPA D,[HALT] ;HALT MARKS FOR RELOCATION
MOVSI D,(JRST) ;ELSE JRST
PUSHJ P,BUILDI
POPJ P,
;FNEND STATEMENT
;<FNEND STA> ::= FNEND
XFNEND: ASCIZ /ND/
SKIPN A,FUNAME ;MUST FOLLOW A MULTI-LINE FN DEF
FAIL <? FNEND before DEF>
SKIPE THNELS ;CANT BE CONDITIONAL
FAIL <? FNEND under conditional>
SETZM FUNAME ;SIGNAL END OF FN
TLO A,2 ;ASSEMBLE THE SCALAR NAME OF THE RESULT
HRLI F,-1 ;MARK NUMERIC FOR NOW
TLNE A,10 ;WAS IT STRING ?
TLZA F,-2 ;YES
PUSHJ P,[AOS (P) ;NO, REGISTER SCALAR
JRST SCAREG]
PUSHJ P,STRREG ;REGISTER STRING
PUSHJ P,EIRGNP ;GET THE RESULT IN REG
HLRZ B,FUNSTA ;RECOVER THE ADDRESS OF THE ARGUMENT COUNT
HRLI B,CADROL
HLRZ X1,FUNLOW ;THIS IS # OF WDS IN FORROL AT START OF DEF
ADD X1,FLFOR
CAME X1,CEFOR ;ARE ALL NEXTS INSIDE OF DEF COMPLETE?
FAIL <? FNEND before NEXT>
TLNE C,F.TERM ;E.O.L. ?
CAMN C,[XWD F.APOS,"\"] ;AND NOT MULTI
FAIL<? FNEND not last in line>
JRST XDEFE ;FINISH UP END OF FN
;GOSUB STATEMENT XLATE
XGOSUB: ASCIZ /UB/
SETZM ONGFLG ;NOT ON ---- GOSUB
XGOSU: SKIPE FUNAME
FAIL <? GOSUB within DEF>
XGOS: PUSHJ P,GETNUM ;READ STATEMENT NUMBER
FAIL <? Illegal line reference>
HRLZ A,N
MOVEI R,LINROL ;LOOK UP LINE NO
PUSHJ P,SEARCH
FAIL <? Undefined line number >,1
SUB B,FLLIN ;SUCCESS. SAVE REL LOC IN LINROL
HRLZ A,B
MOVEI R,GSBROL
PUSHJ P,SEARCH
CAIA
JRST XGOS1
MOVEI E,1
PUSHJ P,OPENUP
MOVEM A,(B)
XGOS1: SUB B,FLGSB
HRLI B,GSBROL
MOVSI D,(GOSUB)
PUSHJ P,BUILDA
SKIPE ONGFLG
TLNN C,F.COMA ;MORE ARGS FOR ON ---- GOSUB ?
JRST NXTSTA
PUSHJ P,NXCHK
JRST XGOS
;GOTO STATEMENT
XGOTO: ASCIZ /O/
XGOFIN: PUSH P,[Z NXTSTA] ;BUILD GOTO AND END STA
XGOFR: PUSHJ P,GETNUM ;BUILD GOTO AND RETURN
FAIL <? Illegal line reference >
XGOGT: HRLZ A,N ;LOOK FOR DESTINATION
MOVEI R,LINROL
PUSHJ P,SEARCH
FAIL <? Undefined line number >,1
SUB B,FLLIN ;NOW CHECK FOR JUMP INTO/OUTOF FUNCTION
MOVE X1,FLREF
ADD X1,B
MOVE X1,(X1)
CAME X1,FUNAME ;BOTH MUST BE ZERO OR SAME FUNCTION.
FAIL <? Illegal line reference >,1
MOVE D,CECOD
CAME D,FLCOD
JRST XGO1
PUSH P,B ;SPECIAL FIX FOR LOADER,
MOVSI D,(JFCL) ;IN CASE GO IS FIRST INSTRUCTION.
PUSHJ P,BUILDI
POP P,B
XGO1: HRLI B,LADROL
MOVSI D,(JRST)
PUSHJ P,BUILDA ;BUILD INSTR
POPJ P,
;IF STATEMENT
;<IF 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,":" ;HERE FOR IF END STATEMENT.
JRST XIF1 ;SEQ. ACCESS IF END.
PUSHJ P,GETCNA ;R.A. IF END.
MOVNI A,4
XIF2: MOVE D,IFNCOD+4(A)
PUSHJ P,BUILDI
AOJL A,XIF2
JRST IFSX5
IFNCOD: SKIPL ACTBL-1(LP) ;CODE GENERATED.
JRST FNMXER
MOVE N,LASREC-1(LP)
CAMGE N,POINT-1(LP)
XIF1: CAME C,[XWD F.STR,"#"]
JRST ERCHAN
PUSHJ P,GETCNA
MOVE D,[PUSHJ P,EOF]
PUSHJ P,BUILDI
HRLOI D,(TROA)
PUSHJ P,BUILDI
HRLZI D,(SETZ)
PUSHJ P,BUILDI
HRLZI D,(SKIPE)
PUSHJ P,BUILDI
JRST IFSX5
IFSX7: SETZM LOGNEG ;DO NOT NEGATE LOGIC
PUSHJ P,IFCCOD ;GENERATE IF CODE
IFSX5: TLNE C,F.COMA ;SKIP OPTIONAL COMMA.
PUSHJ P,NXCH
PUSHJ P,THENGO ;LOOK FOR "THEN" OR "GOTO"
AOS THNCNT ;UP THEN COUNT
SETOM THNELS ;MARK REST OF LINE CONDITIONAL
TLNN C,F.DIG ;NEXT CHAR A DIGIT ?
JRST IFCGO ;NO
PUSHJ P,XGOFR ;USE GOTO CODE TO GEN JRST INSTR
SETOM ELSFLG ;MARK SINGLE WORD THEN
TLNN C,F.CR ;END OF LINE
CAMN C,[XWD F.APOS,"'"] ;
JRST NXSM1 ;YES
PUSHJ P,QSELS ;CHECK FOR ELSE
JRST ERTERM
MOVEM T,MULLIN ;SAVE POINTER
JRST NXSM1 ;NEXT STATEMENT
IFCGO: PUSHJ P,REVSEN ;REVERSE LOGIC
PUSHJ P,HALJRS ;JRST/HALT AROUND THEN CODE
PUSHJ P,FIXTHN ;FIX THENAD LINKAGE
JRST NXSM1
IFCCOD: PUSHJ P,FORMLB ;
MOVE X2,CECOD ;LAST CODE GENERATED
HLRZ X1,-1(X2) ;CHECK FOR POSSIBLE OPTIMIZATION
CAIE X1,(SETO) ;WAS TDZA AND SETO GENERATED?
JRST IFCOD1 ;NO, THEN MUST TEST TRUTH VALUE
MOVE B,X2 ;NEW ADDRESS
SUBI B,2 ;YES, REMOVE THE TWO INSTRUCTIONS
MOVEM B,CECOD ;BY SETTING NEW CEIL
SOJ B, ;LAST CODE GENERATED ADDRESS
SUB B,FLCOD ;CHANGE TO OFFSET
SKIPL LOGNEG ;DOUBLE REVERSE = NOTHING
PUSHJ P,REVSEN ;
POPJ P, ;RETURN
IFCOD1: MOVSI D,(SKIPE) ;SKIP IF TRUE
PUSHJ P,BUILDA ;GENERATE THE SKIPN
SKIPL LOGNEG ;NEED REVERSE LOGIC?
POPJ P, ;AND RETURN
REVSEN: SKIPN RUNFLA ;STILL GOING TO RUN?
POPJ P, ;NO, JUST RETURN
ADD B,FLCOD ;ADDRESS OF LAST RELATION
MOVE D,(B) ;CAM??/SKIP? INSTRUCTION
TLC D,4000 ;REVERSE SENSE
MOVEM D,(B) ;PUT BACK
SUB B,FLCOD ;RESTORE B
POPJ P,
;
; INPUT AND READ STATEMENT GENERATOR
;
; IN THE FOLLOWING CODE, WRREFL IS FIRST USED AS A FLAG
; FOR READ (-1) AND INPUT (0). AT XINP1, WRREFL IS THEN USED
; TO FLAG SEQUENTIAL ACCESS (0) AND RANDOM ACCESS (-1).
;
XREAD: ASCIZ /D/ ;REMAINDER OF READ STATEMENT
SETOM WRREFL ;FLAG READ, NOT INPUT
JRST XINPT0 ;PRODUCE SET UP CODE
;
XINPUT: ASCIZ /UT/ ;REMAINDER OF INPUT STATEMENT
CLEARM WRREFL ;FLAG INPUT, NOT READ
PUSHJ P,QSA ;CHECK FOR INPUT LINE
ASCIZ /LINE/
JRST XINPT0 ;NO
SETOM INLNFG ;YES, FLAG IT
XINPT0: CLEARM INPPRI ;SET FLAG NOT TTY INPUT
CAIN C,":" ;RANDOM ACCESS?
JRST XINRAN ;YES, HANDLE IT SEPARATELY
CAME C,[XWD F.STR,"#"] ;SEQUENTIAL ACCESS?
JRST XINP5 ;NO, MUST BE JUST READ OR INPUT
PUSHJ P,GETCNB ;GENERATE CODE FOR CHANNEL AND SCAN DELIMITER
MOVE D,[PUSHJ P,INSET] ;FETCH INSTRUCTION FOR SETTING INPUT
PUSHJ P,BUILDI ;BUILD IMMEDIATE
MOVEI D,REAINP-1 ;GENERATE CODE TO CHECK FOR
PUSHJ P,GENTYP ;MIXING READ# WITH INPUT#
MOVE D,[JRST REINER] ;FAILURE RETURN
PUSHJ P,BUILDI ;BUILD IMMEDIATE
MOVE D,[PUSHJ P,DOINPT] ;FETCH DO INPUT INSTRUCTION
JRST XINP0 ;GO HANDLE ARGUUMENT LIST
;
; CODING FOR READ, AND INPUT
;
XINP5: MOVSI D,(CLEAR LP,) ;NON DISK INPUT/READ, CHANNEL IS ZERO
PUSHJ P,BUILDI ;BUILD IMMEDIATE
SKIPN INLNFG ;INPUT LINE?
SKIPE WRREFL ;INPUT?
JRST XINP5A ;NO, DON'T CHECK FOR OUTPUT STRING
SETOM INPPRI ;FLAG, STRING CAN BE OUTPUT
TLNN C,F.QUOT ;IS THERE A STRING TO OUTPUT
JRST XINP5A ;NO
XINP5L: PUSHJ P,XINOUT ;YES, DO IT
SKIPA D,[PUSHJ P,INSEQ] ;SUPPRESS QUERY
XINP5A: MOVE D,[PUSHJ P,INSET] ;FETCH INSTRUCTION FOR INPUT SETTING
PUSHJ P,BUILDI ;BUILDI IMMEDIATE
MOVE D,[PUSHJ P,DOINPT] ;ASSUME THIS IS INPUT
SKIPN WRREFL ;WERE WE RIGHT?
JRST XINP0 ;YES, SKIP DATA CHECK FOR READ
SKIPL DATAFF ;CHECK IF WE HAVE SEEN DATA
HLLOS DATAFF ;WE HAVE NOT, FLAG THAT DATA IS NEEDED
HRRI D,DOREAD ;CHANGE DOINPT TO DOREAD
XINP0: PUSHJ P,BUILDI ;BUILD IMMEDIATE, TO DO READ OR INPUT
CLEARM WRREFL ;CHANGE FLAG FOR SEQUENTIAL ACCESS
;
; GENERATE CODE FOR THE ARGUMENT LISTS
;
XINP1: CLEAR F, ;STRINGS AND NUMERICS MAY BE INPUT
PUSHJ P,REGCLT ;GET VARIABLE IN ARGUMENT LIST
SKIPN INLNFG ;INPUT LINE?
JRST XINP91 ;NO,
TLNE F,-2 ;WAS IT A STRING?
FAIL <? String line input only>
XINP91: SKIPN IFFLAG ;HAS TYPE OF INPUT BEEN DECLARED
MOVEM F,IFFLAG ;NO, MAKE TYPE = FIRST VARIABLE'S TYPE
SKIPN WRREFL ;SEQUENTIAL ACCESS?
JRST XINP9 ;YES, STRINGS AND NUMERICS ARE LEGAL
XOR F,IFFLAG ;CHECK TYPE OF THIS VARIABLE
JUMPGE F,XINP9 ;AGAINST TYPE OF FIRST
FAIL <? Mixed strings and numbers>
XINP9: JUMPE A,XINP2 ;VARIABLE IS A NUMERIC ARRAY
CAIG A,4 ;POSSIBLY A STRING?
JRST XINP1A ;NO, BETTER BE SCALAR, CHECK IT OUT
CAILE A,6 ;IS IT IN FACT A STRING?
JRST ILFORM ;NO, BAD FORMAT
;
; CODE FOR STRING VARIABLES
;
XINP6: PUSHJ P,FLET2 ;FINISH REGISTERING THE STRING
MOVEI X1,3 ;FLAG TO USE STRING UUOS
XINP6A: HRLZ D,INUUO(X1) ;ASSUME RANDOM ACCESS, GET INPUT UUO FOR IT
SKIPN WRREFL ;IS IT?
HLLZ D,INUUO(X1) ;NO, GET FOR SEQUENTIAL ACCESS
SKIPGE TYPE ;INTEGER?
TLO D,400 ;YES, MARK IT
SKIPN INLNFG ;INPUT LINE?
JRST XINP6B ;NO, CARRAY ON
PUSH P,D ;SAVE D
PUSH P,B ;SAVE B
MOVE D,[SETOM INLNFG] ;FLAG INPUT LINE
PUSHJ P,BUILDI ;GEN IT
POP P,B ;RESTORE B
POP P,D ;RESTORE D
TLNN C,F.TERM ;ONLY ON STRING PER INPUT LINE
FAIL <? Line input takes only one string>
XINP6B: PUSHJ P,BUILDA ;BUILD UUO WITH ADDRESS IN B
JRST XINP3 ;CHECK FOR MORE ARGUMENTS IN LIST
;
; HERE FOR SCALAR, MAKE SURE IT IS
;
XINP1A: CAIE A,1 ;IS IT A SCALAR?
JRST ILVAR ;NO, ILLEGAL VARIABLE
CLEAR X1, ;FLAG TO USE SCALAR UUOS
JRST XINP6A ;BUILDI THE INPUT/READ UUO
;
; HERE FOR ARRAY/VECTOR
;
XINP2: PUSH P,B ;SAVE ADDRESS OF ARRAY/VECTOR
PUSHJ P,XARG ;GO GET THE SUBSCRIPTS
HRLZ D,INUUO+1 ;ASSUME RANDOM ACCESS FOR 1-DIM
SKIPN WRREFL ;IS IT RANDOM ACCESS?
HLLZ D,INUUO+1 ;NO, CHANGE TO SEQUENTIAL ACCESS
JUMPE B,XINP2A ;IS IT 1-DIM OR 2-DIM?
HRRZ X1,(P) ;2-DIM, GET POINTER TO ARAROL
ADD X1,FLARA ;ADD IN FLOOR FOR ADDRESS
SKIPN 1(X1) ;HAS DIM FOR THIS VARIABLE BEEN DECLARED?
SETOM 1(X1) ;NO, MARK AS 2-DIM
HRLZ D,INUUO+2 ;GET RANDOM ACCESS UUO FOR 2-DIM
SKIPN WRREFL ;GUESS RIGHT?
HLLZ D,INUUO+2 ;NO, CHANGE TO SEQUENTIAL ACCESS
XINP2A: EXCH B,(P) ;EXCH # OF SUBSCRIPTS WITH VARIABLE ADDRESS
SKIPGE TYPE ;INTEGER?
TLO D,400 ;YES, MARK IT
PUSHJ P,BUILDA ;BUILD INPUT UUO WITH ADDRESS IN B
POP P,B ;RESTORE # OF SUBSCRIPTS
PUSHJ P,GENARG ;GENERATE THE JUMPS FOR THE SUBSCRIPTS
;
; END OF ONE VARIABLE
;
XINP3: PUSHJ P,CHKDEL ;CHECK FOR DELIMITER, RETURN IF FOUND
SKIPE INPPRI ;SHOULD WE CHECK FOR STRING?
TLNN C,F.QUOT ;YES, IS THERE ONE
JRST XINP1 ;NO, PROCESS NEXT VARIABLE IN LIST
JRST XINP5L ;YES, PROCESS AND RE-SETUP TTY
;
; HERE TO HANDLE STRING CONSTANT ON INPUT
;
XINOUT: MOVE D,[PUSHJ P,OUTSET] ;SETUP FOR OUTPUT
PUSHJ P,BUILDI ;BUILDI IMMEDIATE
PUSHJ P,FORMLS ;GET THE STRING
MOVSI D,(PRSTR) ;SETUP STRING OUTPUT UUO
PUSHJ P,CHKFMT ;HANDLE THE DELIMITER
PUSHJ P,BUILDA ;OUTPUT STRING WITH ADDRESS IN B
CAIN C,"_" ;WANT TO SUPPRESS QUERY ?
JRST NXCH ;YES, GOBBLE _ AND DO IT
AOS (P) ;NO, SKIP
POPJ P, ;RETURN
;
; HERE FOR RANDOM ACCESS INPUT/READ
;
XINRAN: SKIPE INLNFG ;INPUT LINE?
FAIL <? Line input illegal in r.a.>
PUSHJ P,GENTP1 ;PROCESS CHANNEL, DELIMITER AND PRODUCE
;CODE TO CHECK IF FILE IS R. A.
CLEARM IFFLAG ;CLEAR TYPE FLAG
SETOM WRREFL ;FLAG RANDOM ACCESS, NOT SEQUENTIAL
JRST XINP1 ;PROCESS ARGUMENT LIST
;
; INPUT/READ UUOS
;
INUUO: DATA (DATA 1,) ;FOR SCALARS
ADATA1 (DATA 2,) ;FOR 1-DIM
ADATA2 (DATA 3,) ;FOR 2-DIM
STRIN (DATA 4,) ;FOR STRINGS
;LET STATEMENT
XLET: SETOM LETSW ;LOOK FOR A LHS.
PUSHJ P,FORMLB
MOVEM F,IFFLAG ;STORE TYPE (STR OR NUM) IN IFFLAG.
SKIPL LETSW ;IF NOT LHS, GIVE REASONABLE ERROR
JRST GRONK
TLNN C,F.EQAL+F.COMA ;MUST BE A RHS OR ANOTHER LHS.
JRST EREQAL
XLET0: SKIPL LETSW ;FAIL IF THIS FORMULA IS NOT A VARIABLE.
JRST GRONK
SKIPGE IFFLAG ;STR?
JRST XLLAB1 ;NO.
PUSHJ P,PUSHPR ;YES. REMEMBER ADDR OF RESULT POINTER.
JRST XLET1
XLLAB1: CAIE A,1 ;FOR NUM LETS, IF THE LHS IS A LIST OR
JRST XLET1 ;TABLE, FORMLA HAS STORED AC B AND A
PUSH P,[EXP 1] ;FLAG ON PLIST. IF THE LHS IS A SCALAR,
SKIPGE TYPE ;IT IS AN INTEGER?
TLO B,100000 ;YES, MARK IT AS SUCH
PUSH P,B ;PUT THE FLAG AND AC B ON PLIST HERE.
XLET1: PUSHJ P,NXCHK ;SKIP EQUAL SIGN.
SOS LETSW ;COUNT THIS LHS, AND
PUSHJ P,FORMLB ;LOOK FOR ANOTHER.
XOR F,IFFLAG
JUMPGE F,XLET1A
FAIL <? Mixed strings and numbers>
XLET1A: TLNE C,F.EQAL+F.COMA ;IF NO =, TEMP. ASSUME THIS IS A RHS.
JRST XLET0
MOVMS LETSW ;FINISHED SCANNING.
SOS LETSW
SKIPL IFFLAG ;STRING LET STA?
JRST XLET4 ;YES.
PUSHJ P,EIRGEN ;NO, GET RESULT IN REG
MOVEM B,TEMP1 ;SAVE THE NEGATIVE RESULT CHECK
XLET1B: MOVE D,[MOVEM N, (MOVNM N,)]
SKIPG -1(P) ;FLAGS ON PLIST ARE --
MOVE D,[ARSTO1 N, (ARSTN1 N,)] ; 0 FOR LIST
SKIPL -1(P) ; 1 FOR SCALAR
JRST XLET2 ; -1 FOR TABLE.
MOVE D,[ARSTO2 N, (ARSTN2 N,)]
MOVE X1,0(P) ;DEFAULT ARRAY SIZE (10,10)
ADD X1,FLARA
SKIPN 1(X1)
SETOM 1(X1)
XLET2: SKIPGE TEMP1 ;CHECK FOR NEGATIVE RESULT
MOVS D,D ;NEGATIVE. GET CORRECT INSTR.
PUSH P,D ;SAVE OPCODE
SKIPL TYPE ;IS IT AN INTEGER?
JRST XLET3 ;NO,
MOVE B,-1(P) ;GET TYPE OF OPERAND
TLZE B,100000 ;ALSO AN INTEGER?
JRST XLET5 ;YES, NOTHING TO DO
CLEARM TYPE ;TYPE IS NOW REAL
MOVE D,[PUSHJ P,FLTPNT] ;MUST FIX IT
PUSHJ P,BUILDI ;GENERATE IT
JRST XLET5 ;ALL DONE
XLET3: MOVE B,-1(P) ;
TLZN B,100000 ;
JRST XLET5 ;
SETOM TYPE ;TYPE IS NOW INTEGER
MOVE D,[PUSHJ P,FIXPNT]
PUSHJ P,BUILDI ;
XLET5: POP P,D ;RESTORE MOVEM OPCODE
POP P,B ;RESTORE RESULT PNTR
TLZ B,100000 ;CLEAR TYPE FLAG
PUSHJ P,BUILDA ;BUILD STORE INSTR
POP P,B ;CHECK TRASH FROM PUSHLIST.
JUMPG B,XLET2B ;ARRAY REF?
PUSHJ P,GENARG ;YES. GEN ARGS FIRST.
XLET2B: SOSLE LETSW
JRST XLET1B ;THERE IS ANOTHER LHS.
JRST NXTSTA
XLET4: PUSHJ P,EIRGNP
PUSHJ P,POPPR ;GET ADDRESS OF LEFT HALF POINTER BACK
PUSH P,B
MOVSI D,(STRSTO) ;BUILD THE STRING MOVE INSTRUCTION.
PUSHJ P,BUILDA
POP P,B
SOSLE LETSW
JRST XLET4 ;THERE IS ANOTHER LHS.
JRST NXTSTA
;MARGIN AND MARGIN ALL STATEMENTS.
;
;THIS ROUTINE IS ALSO USED BY THE PAGE AND PAGE ALL STATEMENTS,
;SINCE THEY GENERATE IDENTICAL CODE, EXCEPT FOR THE PUSHJ AT
;THE END OF THE CODE FOR EACH ARGUMENT. FOR A DESCRIPTION OF THE
;CODE GENERATED, SEE MEMO #100-365-033-00.
XMAR: ASCIZ /GIN/
SETZM TABLE ;TELLS THAT THIS IS REALLY MARGIN (ALL).
XMAR0: PUSHJ P,QSA ;ENTRY POINT FOR PAGE (ALL).
ASCIZ /ALL/
JRST XMAR6 ;MARGIN OR PAGE.
TLNE C,F.TERM ;MARGIN ALL OR PAGE ALL.
JRST ERDIGQ ;ALL MUST HAVE ARG.
PUSHJ P,FORMLN ;GENERATE CODE FOR THE ARG.
PUSHJ P,EIRGEN
PUSHJ P,CHKINT ;MUST BE INTEGER
MOVE D,[PUSHJ P,MARGAL]
SKIPE TABLE
HRRI D,PAGEAL ;CHANGE MARGAL TO PAGEAL
PUSHJ P,BUILDI
JRST NXTSTA
XMAR6: TLNE C,F.TERM
JRST ERDIGQ
XMAR1: HRRZ A,C
CAIE A,"#" ;CHANNEL SPECIFIER?
JRST XMAR2 ;NO, MUST BE TTY.
PUSHJ P,GETCNB ;GET CHANNEL AND CHECK DELIMITER
XMAR5: PUSHJ P,FORMLN
PUSHJ P,EIRGEN
PUSHJ P,CHKINT ;MUST BE INTEGER
MOVE D,[PUSHJ P,PAGE]
SKIPN TABLE
HRRI D,MARGN ;CHANGE PAGE TO MARGN
PUSHJ P,BUILDI
PUSHJ P,CHKDEL ;CHECK FOR DELIMITER
JRST XMAR1 ;FOUND ONE
XMAR2: HRLZI D,(MOVEI LP,)
PUSHJ P,BUILDI
JRST XMAR5
;MAT STATEMENT
;MAT STATEMENTS DIVIDE INTO A NUMBER OF DIFFERENT
;STATEMENTS (MAT READ, ...) THESE POSSIBILITIES ARE TESTED
;ONE AT A TIME BY CALLS TO QSA.
;<MAT READ STA> ::= MAT READ <LETTER>[(<EXP>,<EXP>)] [,<LETTER>[(<EXP>,<EXP>...]]
XMAT: HLLI F, ;ALLOW STRINGS FOR READ,PRINT,INPUT
PUSHJ P,QSA ;MAT READ?
ASCIZ /READ/
JRST XMAT2 ;NO. GO TRY MAT PRINT
XMAT1: HRLI F,0
PUSHJ P,ARRAY ;GET ARRAY NAME
CAIE A,5 ;STRING VECTOR?
JUMPN A,GRONK
PUSHJ P,MATCHK ;CHECK THAT ITS NOT VIRTUAL
MOVSI D,(MATRD)
SKIPL DATAFF ;DATA SEEN?
HLLOS DATAFF ;NO. SET NO DATA FLAG
PUSHJ P,XMACOM ;GO CHECK DIMENSIONS AND BUILD UUO.
TLNN C,F.COMA ;IS THERE ANOTHER ARRAY TO READ?
JRST NXTSTA ;NO.
PUSHJ P,NXCHK ;YES. SKIP COMMA
TLNE C,F.TERM ;END OF ARRAY LIST?
JRST NXTSTA ;YES.
JRST XMAT1
;<MAT PRINT 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,MATCHK ;CHECK THAT ITS NOT VIRTUAL
MOVSI D,(MATPR)
PUSHJ P,XMACOM ;GO CHECK DIMENSIONS AND BUILD UUO
ADD B,FLCOD ;ADDRESS OF STRING UUO
HLLZ D,0(B) ;GET THE UUO
PUSHJ P,CHKFMT ;CHECK FORMAT CHARACTER
XMAT2B: TLNN D,140
JRST GRONK ;FAIL IF ILLEGAL
HLLM D,0(B) ;RETURN STRING UUO
TLNE C,F.TERM ;IS FORMAT CHAR FOLLOWED BY END OF STA?
JRST NXTSTA ;YES.
JRST XMAT2A ;PROCESS NEXT ARRAY NAME
XMAT3: PUSH P,[Z NXTSTA] ;ALL REMAINING MAT STATEMENTS MAY HAVE
;ONE OPERAND, BUT NOT A LIST OF THEM.
PUSHJ P,QSA
ASCIZ /INPUT/
JRST XMAT3A
PUSHJ P,VCTOR ;REGISTER ARRAY NAME
CAIE A,5 ;STRING VECTOR?
JUMPN A,GRONK ;OR NUMBER VECTOR?
PUSHJ P,MATCHK ;CHECK THAT ITS NOT VIRTUAL
MOVSI D,(MATINP) ;YES. BUILD MAT INPUT
SKIPGE TYPE ;IS IT INTEGER?
TLO D,400 ;YES, SET THE BIT
JRST BUILDA
VCTOR: PUSHJ P,ARRAY ;REGISTER ARRAY OR VECTOR
CAIE A,5 ;STRING ?
JUMPN A,CPOPJ ;NO, ARRAY ?
MOVE X2,1(X1) ;YES
JUMPG X2,CPOPJ
MOVNI X2,2
MOVEM X2,1(X1)
POPJ P, ;RETURN
;<MAT SCALE STA> ::= MAT <LETTER>=(<EXPRESSION>)*<LETTER>
XMAT3A: HRLI F,-1 ;REMAINING MATOPS CANT HAVE STRINGS.
PUSHJ P,ARRAY ;REGISTER THE VARIABLE
JUMPN A,GRONK ;CHECK FOR ILLEGAL ARRAY NAME.
PUSHJ P,MATCHK ;CHECK THAT ITS NOT VIRTUAL
MOVE X1,TYPE
MOVEM X1,FTYPE ;SAVE THE TYPE
TLNN C,F.EQAL ; CHECK FOR EQUAL SIGN.
JRST EREQAL
PUSHJ P,NXCHK ;SKIP EQUAL.
CAIE C,"(" ;SCALAR MULTIPLE?
JRST XMAT4 ;NO
PUSHJ P,NXCHK ;SKIP PARENTHESIS
PUSH P,B
PUSHJ P,FORMLN ;YES. GEN MULTIPLE
MOVE X1,TYPE
CAME X1,FTYPE
JRST MTYERR
PUSHJ P,EIRGNP
PUSHJ P,QSF ;SKIP MULTIPLY SIGN
ASCIZ /)*/
MOVE X1,[MATSCA] ;SET UP OP CODE
SKIPGE FTYPE ;FLOATING SCALE
TLO X1,400 ;NO, MARK AS INTEGER
PUSH P,X1 ;PUSH IT
JRST XMAT9A
;<MAT SETUP STA> ::= MAT ZER!CON!IDN <LETTER>[(<EXPRESSION>,<EXPRESSION>)]
XMAT4: PUSHJ P,QSA ;MAT ZER?
ASCIZ /ZER/
JRST XMAT5 ;NO.
MOVSI D,(MATZER) ;YES.
JRST XMACOM
XMAT5: PUSHJ P,QSA ;MAT CON?
ASCIZ /CON/
JRST XMAT6
MOVSI D,(MATCON) ;YES.
JRST XMACOM
XMAT6: PUSHJ P,QSA ;MAT IDN?
ASCIZ /IDN/
JRST XMAT7 ;NO
MOVSI D,(MATIDN) ;YES.
;COMMON GEN FOR MAT ZER,CON,IDN,REA
XMACOM: SKIPGE TYPE ;IS IT INTEGER?
TLO D,400 ;YES, MARK IT
CAIE C,"(" ;EXPLICIT DIMENSIONS?
JRST XMAT9D ;NO.
PUSH P,B ;SAVE B,D.
PUSH P,D
PUSHJ P,XARG ;TRANSLATE ARGUMENTS
PUSH P,B ;SAVE COUNT OF ARGUMENTS
MOVE B,-2(P) ;GET BACK THE REGISTRY OF THE ARRAY.
MOVSI D,(SDIM) ;BUILD SDIM INSTR.
PUSHJ P,BUILDA
POP P,B ;GET THE ARGUMENT COUNT.
JUMPN B,XMACO1 ;ONE ARG OR TWO?
PUSHJ P,GENAFN ;ONE. FAKE DIMENSIONS OF (N,0).
MOVE D,[JUMP 2,ONCESW]
PUSHJ P,BUILDI
JRST XMAT9C
XMACO1: PUSHJ P,GENAR0 ;GEN ARGS
JRST XMAT9C ;RESTORE AC,S AND BUILD.
XMACMI:
;<MAT FCN STA> ::= MAT<LETTER> = INV!TRN (<LETTER>)
XMAT7: PUSHJ P,QSA ;MAT INV?
ASCIZ /INV(/
JRST XMAT8 ;NO
MOVSI D,(MATINV) ;YES. GET OP CODE.
JRST XMITCM
XMAT8: PUSHJ P,QSA ;MAT TRN?
ASCIZ /TRN(/
JRST XMAT9 ;NO.
MOVSI D,(MATTRN) ;YES. GET OP CODE.
MOVEM B,TRNFLG
XMITCM: PUSH P,B ;FINISH MAT INV,TRN.
SKIPGE TYPE ;
TLO D,400 ;
PUSH P,D
HRLI F,777777
PUSHJ P,ARRAY
JUMPN A,GRONK
PUSHJ P,MATCHK ;CHECK THAT ITS NOT VIRTUAL
MOVE X1,TYPE
CAME X1,FTYPE
JRST MTYERR
HLRZ X1,(P) ;GET THE OPCODE
TRZ X1,400 ;CLEAR INTEGER BIT (IF ANY)
CAIE X1,(MATTRN) ;MAT INV?
SKIPL TYPE ;YES, INTEGER?
CAIA ;NO, ONWARD
FAIL <? Cannot invert integer matrix>
PUSHJ P,QSF
ASCIZ /)/
CAME B,TRNFLG
JRST XMAT9B
ADD B,FLOOR(F) ;THIS IS MAT A = TRN (A).
SETOM 2(B) ;MARK A.
MOVE B,TRNFLG ;FAKE IT OUT BY USING AN
MOVSI D,(MOVEI T1,) ;INVISIBLE MATRIX FOR TEMPORARY
PUSHJ P,BUILDA ;STORAGE.
HRLZI A,552640
PUSHJ P,ARRAY0
POP P,D
PUSH P,B
ADD B,FLOOR(F)
AOS 2(B)
MOVE B,(P)
PUSHJ P,BUILDA
JRST XMAT11
;<MAT OPERATOR STA>::=MAT <LETTER>=<LETTER>+!-!*<LETTER>
XMAT9: PUSH P,B ;SAVE RESULT LOCATION
MOVE X1,TYPE
MOVEM X1,FTYPE ;
HRLI F,777777
PUSHJ P,ARRAY
JUMPN A,GRONK
PUSHJ P,MATCHK ;CHECK THAT ITS NOT VIRTUAL
MOVEI D,0 ;LETTER FOLLOWED BY OPERATOR
TLNN C,F.PLUS+F.MINS+F.STAR
JRST XMAT10 ;NO OPERATOR. MUST BE MAT COPY
TLNN C,F.MINS+F.STAR
MOVSI D,(MATADD)
TLNN C,F.PLUS+F.STAR
MOVSI D,(MATSUB)
TLNN C,F.PLUS+F.MINS
MOVSI D,(MATMPY)
SKIPGE TYPE
TLO D,400
PUSH P,D ;SAVE OPERATION
PUSHJ P,NXCHK ;SKIP OPERATOR
MOVSI D,(MOVEI T,) ;GEN T:= ADRS OF FIRST ARRAY
PUSHJ P,BUILDA ;ENTER HERE FROM SCALAR MULTIPLE
XMAT9A: HRLI F,777777
PUSHJ P,ARRAY ;SECOND ARRAY
JUMPN A,GRONK ;NOT ARRAY NAME
PUSHJ P,MATCHK ;CHECK THAT ITS NOT VIRTUAL
MOVE X1,TYPE
CAME X1,FTYPE
MTYERR: FAIL <? Cannot mix modes in matrix operations>
;ENTER HERE FROM MAT INV, TRN
XMAT9B: MOVSI D,(MOVEI T1,)
PUSHJ P,BUILDA
XMAT9C: POP P,D
POP P,B
XMAT9D: JRST BUILDA ;RETURN TO NXTSTA (OR TO PROCESS NEXT ITEM IN PRINT,READ, OR INPUT LIST.)
XMAT10: PUSH P,B ;FOR MAT COPY, FAKE MAT B=(1)*A
XMAT11: MOVE D,[MOVSI N,(1.0)];PUT CONSTANT 1.0 IN REG FOR SCALE
SKIPGE FTYPE
MOVE D,[MOVEI N,1]
PUSHJ P,BUILDI ;BUILD INST TO GET SCAL FACTOR
POP P,B ;GET SOURCE MAT BACK
PUSH P,[MATSCA]
JRST XMAT9B
MATCHK: SKIPGE (X1) ;WAS IT VIRTUAL
FAIL <? MAT function on virtual array>
POPJ P,
;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 ;CHECK IF UNDER THEN-ELSE
FAIL <? NEXT under conditional>
XNEX0: TLNN C,F.TERM ;NEXT WITHOUT ARGUMENT?
JRST XNEX3 ;YES, FOR-NEXT LOOP
MOVE X1,CEFOR ;CHECK UNSAT WHILE/UNTIL
CAMG X1,FLFOR ;ANYTHING ON FOR ROLL
FAIL <? NEXT without WHILE/UNTIL>
SETO X2, ;MAKE SURE THIS IS A UNTIL/WHILE
CAME X2,-3(X1) ;INDUCTION VARIABLE -1
CAMN X2,-2(X1) ;INCREMENT -1
CAIA ;YES, ALL IS SWELL
FAIL <? Illegal NEXT statement>
PUSHJ P,POPFOR ;GET TEMPORARY PROTECTION
MOVEM B,TMPLOW ;SHOULD NOT HAVE BEEN CHANGED
MOVEM B,TMPPNT ;
PUSHJ P,POPFOR ;REMOVE -1 FOR INCREMENT
PUSHJ P,POPFOR ;REMOVE -1 FOR INDUCTION
PUSHJ P,POPFOR ;GET JRST ADDRESSES
PUSH P,[Z NXTSTA] ;SET UP THE RETURN
JRST XNEX5 ;LET FOR-NEXT CODE HANDLE JRSTS
XNEX3: TLNN C,F.LETT
FAIL <? Illegal NEXT arg>
HRLI F,777777
PUSHJ P,REGLTR
CAIE A,1 ;BETTER BE SCALAR
FAIL <? Illegal NEXT arg>
MOVE X1,CEFOR ;UNSAT FOR?
CAMLE X1,FLFOR
CAME B,-3(X1) ;CHECK INDUCTION VARIABLE
FAIL <? NEXT without FOR>
SETO X2, ;MAKE SURE THIS ISN'T WHILE/UNTIL
CAME X2,-3(X1) ;
CAMN X2,-2(X1) ;
FAIL <? Illegal NEXT statement>
PUSHJ P,NEXCOD ;GO GENERATE NEXT CODE
TLNN C,F.COMA ;STACKED NEXT?
JRST XNEX1 ;NO.
PUSHJ P,NXCH ;YES.
JRST XNEX0
XNEX1: TLNE C,F.TERM ;MODIFIERS ILLEGAL IN NEXT
JRST NXTSTA
FAIL <? Illegal NEXT use>
NEXCOD: PUSHJ P,POPFOR
MOVEM B,TMPLOW ;RESTORE PREVIOUS LEVEL OF TEMPORARY PROTECTION
MOVEM B,TMPPNT ;BECAUSE THIS IS THE END OF THE "FOR" RANGE .
PUSHJ P,POPFOR ;GEN INCREMENT TO REG
PUSHJ P,EIRGEN
PUSHJ P,POPFOR ;FADR TO INDUCTION VAR
MOVSI D,(FADR)
SKIPGE TYPE ;
MOVSI D,(ADD) ;
PUSHJ P,BUILDA
PUSHJ P,POPFOR ;GET JRST POINTER
XNEX5: SKIPN RUNFLA ;STILL MAKING CODE ?
JRST XNEX2 ;NO, DO NOT FOOL WITH ADDRESSES
MOVE A,FLCOD ;GET CODE FLOOR
HRLS A ;IN BOTH SIDES
ADD A,B ;E.A.OF NEXT'S JRST,LOC OF FOR'S JRST
PUSHJ P,HALJRS ;GEN HALT/JRST BACK TO FOR
ADD B,FLCOD ;LOC OF INST
HLRM A,(B) ;SET E.A
AOS B
HRRM B,(A) ;FORS JRST TO NEXT STMNT
XNEX2: PUSHJ P,POPFOR ;POP OFF THE SAVED VALUE OF L
POPJ P, ;RETURN
;SUBR TO POP TOP OF FORROL. USED ONLY BY XNEXT.
POPFOR: SOS X1,CEFOR ;POP TOP OF FORROL
MOVE B,(X1)
POPJ P,
;
; QUOTE, NOQUOTE AND NOPAGE STATEMENTS
;
; THE FOLLOWING CODE GENERATES CODE TO HANDLE THE VARIOUS
; TTY AND DSK FILE SETTINGS. THE INSTRUCTION SKELETON IS
; SETUP IN AC N. THE INSTRUCTION TO SET THE TTY WILL
; ONLY BE GENERATED ONCE NO MATTER HOW MANY TIMES IT IS REFERENCED
;
XQUO: ASCIZ /TE/ ;REMAINDER OF QUOTE STATEMENT
MOVE N,[SETOM QUOTBL] ;FETCH QUOTE INSTRUCTION
JRST XNOP8 ;HANDLE THE ARGUMENT LIST
;
XNOQ: ASCIZ /UOTE/ ;REMAINDER OF NOQUOTE STATEMENT
MOVE N,[CLEARM QUOTBL] ;FETCH NOQUOTE INSTRUCTION
JRST XNOP8 ;HANDLE THE ARGUMENT LIST
;
XNOP: ASCIZ /AGE/ ;REMAINDER OF NOPAGE STATEMENT
MOVE N,[SETOM PAGLIM] ;FETCH NOPAGE INSTRUCTION
XNOP8: MOVEM N,TABLE ;SAVE THE SETTING INSTRUCTION
PUSHJ P,QSA ;CHECK FOR ALL
ASCIZ /ALL/
JRST XNOP9 ;NOT THERE, ARGUMENTS SHOULD FOLLOW
MOVE D,[MOVEI LP,9] ;FETCH INSTR. TO BEGIN AT CHANNEL 9
PUSHJ P,BUILDI ;BUILD IMMEDIATE
MOVE D,TABLE ;GET THE SETTING INSTRUCTION
TLO D,16 ;MASK IN AC 16 AS THE INDEX
PUSHJ P,BUILDI ;BUILD IMMEDIATE
ADD B,FLCOD ;CALCULATE ADDRESS OF SETTING INSTRUCTION
MOVSI D,(SOJG LP,) ;FETCH INSTR. TO LOOP THRU ALL 9 CHANNELS
HRR D,B ;PUT IN THE ADDRESS
PUSHJ P,BUILDI ;BUILD IMMEDIATE
JRST NXTSTA ;ALL DONE
XNOP9: CLEARM TTYPAG ;FLAG, WE HAVEN'T SET TTY YET
TLNE C,F.TERM ;ANY ARGUMENTS?
JRST XNOP1 ;NO, MEANS TTY, DO IT
XNOP2: TLNN C,F.COMA ;CHECK FOR POSSIBLE NULL ARGUMENT
CAIN C,";" ;WHICH MEANS TTY
JRST XNOP5 ;IS NULL, SET TTY
XNOP6: CAMN C,[XWD F.STR,"#"] ;DID USER INCLUDE OPTIONAL #
PUSHJ P,NXCH ;YES, EAT IT
PUSHJ P,GETCN2 ;HANDLE THE CHANNEL SPECIFIER
MOVE D,TABLE ;FETCH THE SETTING INSTRUCTION
TLO D,16 ;MASK IN AC 16 AS AN INDEX
PUSHJ P,BUILDI ;BUILD IMMEDIATE
PUSHJ P,CHKDEL ;CHECK FOR A DELIMITER, RETURN IF FOUND
XNOP3: TLNN C,F.TERM ;NULL ARGUMENT?
JRST XNOP2 ;NO, LOOK FOR CHANNEL
XNOP0: SKIPE TTYPAG ;HAS TTY BEEN SET ALREADY
JRST NXTSTA ;YES, JUST RETURN
XNOP1: MOVE D,TABLE ;FETCH THE SETTING INSTRUCTION
PUSHJ P,BUILDI ;BUILD IMMEDIATE
JRST NXTSTA ;ALL DONE
XNOP5: PUSHJ P,NXCH ;EAT THE DELIMITER IN C
SKIPE TTYPAG ;HAS TTY BEEN SET?
JRST XNOP3 ;YES, DON'T DO IT AGAIN
MOVE D,TABLE ;FETCH SETTING INSTRUCTION
PUSHJ P,BUILDI ;BUILD IMMEDIATE
SETOM TTYPAG ;FLAG, THE TTY HAS BEEN SET
JRST XNOP3 ;PROCESS NEXT ARGUMENT
;ON STATEMENT
;<ON 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
ASCIZ /ERRORGOTO/
JRST XON5
SKIPE FUNAME ;WITHIN FN DEF ?
FAIL <? ON ERROR GOTO within DEF>
TLNN C,F.TERM ;ANY ARGUMENT?
JRST XON3 ;YES, TEST IT OUT
XON4: SKIPE NOTLIN ;MAKING SAVFILNL ?
FAIL <? Retroactive ON ERROR GO TO in SAVFILNL>
MOVE D,[CLEARM ERRGO]
PUSHJ P,BUILDI
MOVE D,[SKIPE ERR]
PUSHJ P,BUILDI
MOVE D,[JRST ERRCNT]
PUSHJ P,BUILDI
JRST NXTSTA
XON3: PUSHJ P,GETNUM
FAIL <? Illegal line reference>
JUMPE N,XON4
PUSHJ P,XGOGT
MOVSI D,(MOVEI N)
ADD B,FLCOD
HLLM D,(B)
MOVE D,[MOVEM N,ERRGO]
PUSHJ P,BUILDI
JRST NXTSTA
XON5: PUSHJ P,FORMLN ;EVALUATE INDEX
PUSHJ P,EIRGNP ;GET IN REG
PUSHJ P,CHKINT ;MUST HAVE INTEGER
MOVE D,[JSP A,XCTON]
PUSHJ P,BUILDI ;BUILD THE RUNTIME CALL
SETZI D, ;BUILD ADDRESS OF NEXT STATEMENT
MOVE B,L
AOBJP B,XOLAB1 ;DONT BUILD IF LAST STATEMENT
HRLI B,LADROL
PUSHJ P,BUILDA
XOLAB1: TLNE C,F.COMA ;SKIP OPTIONAL COMMA.
PUSHJ P,NXCH
PUSHJ P,QSA
ASCIZ /GOSUB/
JRST XONA
SETOM ONGFLG
JRST XGOSU
XONA: PUSHJ P,THENGO ;TEST FOR "THEN" OR "GOTO"
XON1: PUSHJ P,XGOFR ;BUILD A JRST TO THE NEXT NAMED STATEMENT
TLNN C,F.COMA ;MORE?
JRST NXTSTA ;NO
PUSHJ P,NXCHK ;YES. SKIP COMMA
JRST XON1 ;PROCESS NEXT LINE NUMBER
;FILE AND FILES STATEMENTS.
;
;FILES STATEMENTS SET UP INFORMATION FOR THE LOADER, AS FOLLOWS:
;THE ACTBL ENTRY IS +1 FOR SEQ. ACCESS FILES, -1 FOR R.A. FILES.
;THE STRLEN ENTRY CONTAINS THE RECORD LENGTH FOR STRING R.A.
;FILES (OR 0 IF THE STRING R.A. FILE DID NOT SPECIFY A
;RECORD LENGTH) AND 400000,,0 FOR NUMERIC R.A. FILES. THE
;BLOCK ENTRY CONTAINS THE SOURCE STATEMENT LINE NUMBER IN CASE THE
;LOADER NEEDS IT FOR AN ERROR MESSAGE.
XFILE: ASCIZ /E/
PUSHJ P,QSA
ASCIZ /S/ ;FILE OR FILES?
JRST FILEE ;FILE.
XFIL1: MOVEI B,";" ;FILES.
CAIE B,(C)
TLNE C,F.COMA
JRST XFIL10
PUSHJ P,FILNMO ;GET FILENAME.
JUMP SAVE1
AOS A,FILCNT
CAILE A,9
FAIL <? Too many files>
MOVEI D,9
MOVE X1,FILDIR
XFIL2: MOVE X2,FILDIR+1
XFIL3: CAMN X1,FILD-1(D) ;SEARCH FOR DUPLICATE FILE SPECS.
CAME X2,EXTD-1(D)
JRST XFIL4
MOVE X2,FILDIR+3 ;NAME.EXT MATCHES, TRY PPN
CAMN X2,FPPN-1(D)
JRST XFIL5 ;ALL MATCH, ERROR
SOJG D,XFIL2 ;TRY MORE
SKIPA X2,FILDIR+1
XFIL4: SOJG D,XFIL3
JRST XFIL35
XFIL5: PUSHJ P,INLMES
ASCIZ /
? File /
PUSHJ P,PRNNAM
PUSHJ P,INLMES
ASCIZ / on more than one channel/
PUSH P,C
PUSHJ P,FAIL2
POP P,C
XFIL35: MOVEM X1,FILD-1(A)
MOVEM X2,EXTD-1(A)
MOVE X2,FILDIR+3
; Delete [4] MOVEM X2,FPPN(A)
MOVEM X2,FPPN-1(A) ;[4] SAVE NAME, EXT AND PPN.
MOVE X2,L ;SAVE SOURCE LINE
ADD X2,FLLIN ;NUMBER IN CASE THE
HLRZ X2,(X2) ;LOADER NEEDS IT.
MOVEM X2,BLOCK-1(A)
MOVEI B,"%" ;TYPE OF FILE--
CAIE B,(C)
JRST XFIL36
HRLZI B,400000 ;R.A. NUMERIC.
MOVEM B,STRLEN-1(A)
PUSHJ P,NXCH
JRST XFIL39
XFIL36: TLNN C,F.DOLL
JRST XFIL37
PUSHJ P,NXCH ;R.A. STRING.
SETZ B,
TLNN C,F.DIG ;GET THE RECORD LENGTH.
JRST XFIL32
PUSHJ P,XFIL30
SKIPLE B
CAILE B,^D132
JRST XFILER
JRST XFIL32
XFIL30: ADDI B,-60(C)
PUSHJ P,NXCH
TLNN C,F.DIG
POPJ P,
IMULI B,^D10
JRST XFIL30
XFIL32: MOVEM B,STRLEN-1(A)
JUMPE B,XFIL39
MOVEI X1,4(B)
IDIVI X1,5
ADDI X1,1
HRLM X1,STRLEN-1(A)
XFIL39: SETOM ACTBL-1(A) ;MAKE ACTBL ENTRY = -1 FOR R.A.
JRST XFIL7
XFIL37: AOS ACTBL-1(A) ;MAKE ACTBL ENTRY = +1 FOR SEQ. ACCESS.
XFIL7: TLNE C,F.TERM
JRST NXTSTA
MOVEI B,";"
CAIE B,(C)
TLNE C,F.COMA
JRST XFIL8
JRST ERSCCM
XFIL10: AOS B,FILCNT
CAILE B,9
FAIL <? Too many files>
XFIL8: PUSHJ P,NXCH
TLNN C,F.TERM
JRST XFIL1
XFIL9: AOS B,FILCNT
CAILE B,9
FAIL <? Too many files>
JRST NXTSTA
XOPEN: ASCIZ /N/
SETOM OPNFLG
JRST FILEE8 ;SKIP LINE NO OUTPUT
FILEE:
SETZM OPNFLG
SKIPN NOTLIN ;LINE NOS SUPPRESSED ?
SKIPE MULLIN ;OR WITHIN MULTI
JRST FILEE8 ;IN EITHER CASE, DONT SAVE LINE #
MOVE D,[JSP A,LINADR]
PUSHJ P,BUILDI ;
MOVE D,SORCLN ;
PUSHJ P,BUILDI ;
MOVSI D,(JFCL) ;SET UP JFCL
PUSHJ P,BUILDI
MOVEM B,JFCLAD ;RECORD
FILEE8: PUSHJ P,CHKCR1 ;CHECK CORE REQUIREMENTS
FILEE0: SETOM FILTYP ;FILE TYPE UNKNOWN
SKIPE OPNFLG ;OPEN OR FILE ?
JRST FILOP0 ;OPEN
FILOP2: MOVEI B,-1 ;ASSUME R. A.
CAIN C,":" ;IS IT?
JRST FILEE2 ;YES, CARRY ON
SETZ B, ;HOW ABOUT SEQ. ACC.
CAMN C,[XWD F.STR,"#"] ;IF # IT IS
JRST FILEE2 ;GOT IT
SKIPE OPNFLG ;OPEN?
CAME C,[XWD F.STR,"@"] ;AND IS IT VIRTUAL
JRST ERCHAN ;NEITHER OF THE ABOVE, ERROR
SETZM FILTYP
AOSA FILTYP ;SET FILTYP TO 1
FILEE2: PUSHJ P,FILSET
PUSHJ P,GETCNA
SKIPE OPNFLG ;NO DELIMITER IN OPEN
JRST FILOP9
CAIE C,":" ;SKIP DELIMITER.
TLNE C,F.COMA
CAIA
JRST ERCLCM
PUSHJ P,NXCH
FILOP9: MOVSI D,(HRREI N,) ;SETUP FOR FILTYP SETTING
HRR D,FILTYP ;GET TYPE CODE
PUSHJ P,BUILDI ;BUILDI IMMEDIATE
MOVE D,[MOVEM N,FILTYP] ;FETCH TYPE STORE INSTRUCTION
PUSHJ P,BUILDI
MOVE D,[SKIPE ACTBL-1(LP)]
PUSHJ P,BUILDI
MOVE D,[PUSHJ P,CLSFIL]
PUSHJ P,BUILDI
SKIPE OPNFLG ;OPEN ?
JRST FILOP5 ;YES, FINISHED
FILOP0: TLNN C,F.QUOT
JRST FILE21
PUSH P,C
PUSH P,T
PUSHJ P,QSKIP
JRST ERQUOT
TLNN C,F.PLUS ;CHECK FILE SPEC UNLESS CONCATENATION
JRST FILEE4
FILE20: POP P,T
POP P,C
FILE21: PUSHJ P,MASCHK ;HANDLE STRING ARGUMENT
SKIPE OPNFLG ;OPEN ?
JRST FILOP1 ;YES, GO DO FOR INPUT/OUTPUT
MOVE D,[PUSHJ P,OPNFIL]
PUSHJ P,BUILDI
PUSHJ P,CHKDEL ;CHECK FOR SEPARATOR
JRST FILEE0 ;FOUND ONE
FILEE4: MOVE C,-1(P) ;CHECK SYNTAX OF ARG NOW, SINCE IT IS A CONSTANT.
MOVE T,(P)
PUSHJ P,NXCH
PUSHJ P,FILNMO ;FILENM.EXT FORM?
JUMP SAVE1
SETZ B, ;ASSUME SEQUENTIAL
TLNE C,F.QUOT
JRST FILEE7
TLNE C,F.DOLL ;TYPE $ OR %?
JRST FILE45 ;$.
CAME C,[XWD F.STR,"%"]
JRST ERDLPQ
PUSHJ P,NXCH ;%.
TLNN C,F.QUOT
JRST ERQUOT
JRST FILEE6
FILE45: PUSHJ P,NXCH
TLNN C,F.DIG
JRST XFILR1
PUSHJ P,XFIL30 ;GET RECORD SIZE
SKIPLE B
CAILE B,^D132
XFILER: FAIL <? 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: MOVE D,[PUSHJ P,OPNFIL]
PUSHJ P,BUILDI ;OPEN FILE
SKIPG FILTYP ;VIRTUAL ARRAY SPEC
SKIPN X1,INPOUT ;MODE SPECIFIED ?
JRST NXTSTA ;NO
JUMPG X1,FILOP6 ;YES, WHICH
HRRI D,SCATH
SKIPE FILTYP ;OUTPUT, SCRATCH, RANDOM ?
HRRI D,RANSCR ;CHANGE SCATH TO RANSCR
PUSHJ P,BUILDI
FILPLT: TLNN C,F.TERM ;END OF STATEMENT
SKIPN OPNFLG ;OR FILE(S) STATEMENT
JRST NXTSTA ;NEXT STATEMENT
PUSHJ P,QSA ;CHECK FOR "TO PLOT"
ASCIZ /TOPLOT/
JRST NXTSTA
SKIPE FILTYP ;SEQ.?
JRST FILERR ;NO, ERROR
MOVE D,[MOVEM LP,PLTIN] ;ASSUME INPUT PLOTTING
SKIPG INPOUT ;OUTPUT PLOTTING?
HRRI D,PLTOUT ;YES
PUSHJ P,BUILDI ;GENERATE
JRST NXTSTA ;NEXT STATEMENT
FILOP6: SKIPE FILTYP ;INPUT, RESTORE, RANDOM ?
JRST FILOP7 ;YES
HRRI D,XRES
PUSHJ P,BUILDI
JRST FILPLT ;CHECK FOR PLOTTING
FILOP7: MOVNI A,5 ;RANDOM
FILOP8: MOVE D,RESCOD+5(A)
PUSHJ P,BUILDI
AOJL A,FILOP8
JRST NXTSTA
XREM: SETZM MULLIN ;COMMENT ENDS LINE
JRST NXTST1
;SCRATCH STATEMENT
;FORMAT
; SCRATCH Q4,Q7,Q8
;WHERE Q IS # OR :. Q MAY BE OMITTED, IN WHICH CASE # IS ASSUMED.
XSCRAT: ASCIZ /ATCH/
SRAER5: CAIN C,":"
JRST SRAER3 ;R.A. ARGUMENT.
CAMN C,[XWD F.STR,"#"] ;SEQ. ACCESS ARGUMENT.
PUSHJ P,NXCH
PUSHJ P,GETCN2
MOVE D,[PUSHJ P,SCATH]
SRAER4: PUSHJ P,BUILDI ;BUILD SCRATCH
PUSHJ P,CHKDEL ;CHECK FOR SEPARATOR
JRST SRAER5 ;FOUND ONE
SRAER3: PUSHJ P,GETCNA ;R.A. ARGUMENT.
MOVE D,[PUSHJ P,RANSCR]
JRST SRAER4
;SET STATEMENT
;
;FORMAT
; SET :N,NUMERIC FORMULA, :N,NUMERIC FORMULA...
;
;WHERE N IS A DIGIT FROM 1 TO 9, THE ":" IS OPTIONAL, THE COMMA
;FOLLOWING N MAY BE REPLACED BY A COLON, AND THE COMMA
;FOLLOWING THE FORMULA MAY BE REPLACED BY A SEMICOLON.
XSET: PUSHJ P,GENTP1 ;GET CHANNEL AND CHECK DELIMETER
PUSHJ P,FORMLN ;GET VALUE FOR POINTER.
PUSHJ P,EIRGNP
PUSHJ P,CHKINT ;MUST BE INTEGER?
MOVNI A,4
XSET2: MOVE D,SETCOD+4(A)
PUSHJ P,BUILDI
AOJL A,XSET2
PUSHJ P,CHKDEL ;CHECK FOR SEPARATOR
JRST XSET ;FOUND ONE
SETCOD: JUMPLE N,SETERR ;SOME OF THE CODE GENERATED.
CAIGE N,1
JRST SETERR
MOVEM N,POINT-1(LP)
;
;PAUSE STATEMENT
;
XPAUSE: ASCIZ /SE/
MOVE D,[INCHRW N] ;INPUT CHARACTER , WAIT
PUSHJ P,BUILDI ;GENERATE IT
TLNN C,F.TERM ;TERMINATOR?
FAIL <? 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
MOVEI X1,2 ;ASSUME ORIGIN (TWO ARGUMENTS)
SUB X1,PSHPNT ;LESS NUMBER WE COLLECTED
CAME X1,NOORG ;0 - ORIGIN ,-1 LINE
JRST ARGCH0 ;ARGUMENTS DON'T MATCH
MOVE D,[PUSHJ P,ORGPLT] ;ORIGIN?
SKIPE NOORG ;ORIGIN?
HRRI D,LINPLT
PUSHJ P,BUILDI ;BUILD PUSHJ CALL
JRST XPLFN1 ;GO SEE IF ANOTHER PLOT FUNCTION
DO1ARG: TLNE C,F.COMA ;IS IT A COMMA?
PUSHJ P,NXCHK ;SWALLOW CHARACTER IN C
SETZM PFLAG ;CLEAR % SEEN FLAG
PUSHJ P,FORMLN ;GENERATE NUMERIC ARGUMENT IN REG
JUMPGE B,XPLAB2 ;POSITIVE ARG
PUSHJ P,EIRGP1 ;NO, MAKE NEGATVIE
XPLAB2: PUSHJ P,CHKINT
MOVSI D,(PUSH Q,) ;BUILD ARGUMENT PUSH
PUSHJ P,BUILDA ;
AOS PSHPNT
POPJ P,
XPLOT1: PUSHJ P,QSA ;TRY ANOTHER FUNCTION
ASCIZ /STRING(/ ;STRING?
JRST XPLOT2 ;NO, TRY AGAIN
CLEARM PSHPNT ;NO ARGUMENTS YET
PUSHJ P,DO1ARG ;DO FIRST ARGUMENT
TLNN C,F.COMA ;ANOTHER ONE?
JRST ARGCH0 ;SHOULD HAVE BEEN
PUSHJ P,DO1ARG ;DO SECOND ARGUMENT
TLNN C,F.COMA ;ANOTHER ONE?
JRST ARGCH0 ;SHOULD HAVE BEEN
MOVE D,[PUSHJ P,STRPLT] ;PUSHJ TO STRPLT
PUSHJ P,BUILDI ;GENERATE IT
MOVSI D,(CLEAR LP,) ;TTY OUTPUT
PUSHJ P,BUILDI ;GENERATE IT
MOVE D,[PUSHJ P,OUTSET] ;SETUP FOR OUTPUT TO TTY
PUSHJ P,BUILDI ;GENERATE IT
PUSHJ P,NXCHK ;SWALLOW THE COMMA
PUSHJ P,FORMLS ;GENERATE STRING ARGUMENT
MOVSI D,(PRSTR 2,) ;STRING OUTPUT W/ NO CARRIAGE MOVEMENT
PUSHJ P,BUILDA ;GENERATE WITH ADDRESS IN B
MOVE D,[PUSHJ P,MOVPLT] ;MOVE THE ALPHA CURSOR
PUSHJ P,BUILDI ;GENERATE IT
JRST XPLFN1 ;SEE IF ANOTHER FUNCTION
XPLOT2: PUSHJ P,QSA ;CHECK ANOTHER FUNCTION
ASCIZ /ORIGIN(/ ;ORIGIN?
JRST XPLOT3 ;NO, TRY, TRY AGAIN
CLEARM NOORG ;FLAG FOR ORIGIN
JRST XPLOTA ;TREAT LIKE LINE
XPLOT3: PUSHJ P,QSA ;CHECK ANOTHER FUNCTION
ASCIZ /PAGE/ ;PAGE?
JRST XPLOT4 ;NO, TRY, TRY, TRY AGAIN
MOVE D,[PUSHJ P,PAGPLT] ;PUSHJ TO PAGPLT
JRST XPLT4A ;GO TO GENERATE
XPLOT4: PUSHJ P,QSA ;ANOTHER TIME
ASCIZ /INIT/ ;INIT?
JRST XPLOT5 ;TRY, TRY, TRY, TRY AGAIN
MOVE D,[PUSHJ P,INIPLT] ;PUSHJ TO INIPLT
XPLT4A: PUSHJ P,BUILDI ;GENERATE CODE IN D
JRST XPLFIN ;CHECK FOR ANOTHER FUNCTION
XPLOT5: PUSHJ P,QSA ;CHECK FOR FUNCTION
ASCIZ /WHERE(/ ;WHERE?
JRST XPLOT6 ;TRY LAST ONE
MOVE D,[JSP A,WHRPLT] ;FOR WHERE
PUSHJ P,BUILDI ;GENERATE IT
XPLT5A: PUSHJ P,DOSARG ;DO SCALAR ARGUMENT
TLNN C,F.COMA ;ONE MORE ARGUMENT?
JRST ERCOMA ;NOPE
PUSHJ P,DOSARG ;DO ANOTHER SCALAR ARGUMENT
JRST XPLFN1 ;GO FOR NEXT
XPLOT6: PUSHJ P,QSA ;IS IS CURSOR
ASCIZ /CURSOR(/ ;
JRST XPLOT7 ;TRY SAVE
MOVE D,[JSP A,CURPLT] ;
PUSHJ P,BUILDI ;
PUSHJ P,DOSARG ;
TLNN C,F.COMA ;
JRST ERCOMA ;
JRST XPLT5A ;LET WHERE CODE HANDLE LAST TWO ARGS.
XPLOT7: PUSHJ P,QSA ;TRY SAVE
ASCIZ /SAVE(/
FAIL <? Illegal PLOT function>
PUSHJ P,GETCN2 ;GET CHANNEL
MOVE D,[PUSHJ P,SAVPLT] ;DO SSAVE PLOT
PUSHJ P,BUILDI ;GENERATE IT
XPLFN1: TLNN C,F.RPRN ;ENDED WITH ')'
JRST ERRPRN ;NO, GIVE ERROR
PUSHJ P,NXCHK ;SWALLOW THE ')'
XPLFIN: PUSHJ P,CHKDEL ;CHECK FOR SEPARATOR
JRST XPLOA ;FOUND ONE
DOSARG: TDZ F,F ;
TLNE C,F.COMA ;HAVE A COMMA
PUSHJ P,NXCHK ;EAT THE ','
SETZM PFLAG ;CLEAR % SEEN FLAG
PUSHJ P,REGLTR ;SINGLE ARGUMENT
CAIE A,1 ;SCALAR?
JRST ILVAR ;CAN ONLY BE
MOVSI D,(JUMP 2,) ;USE A JUMP
SKIPGE TYPE ;WANTS RESULTS IN FLOTING?
TLZ D,100 ;NO, MARK FOR INTEGER
PJRST BUILDA ;
XLIST
>
LIST
;
; UNTIL AND WHILE - NEXT LOOP STATEMENT
;
XUNTIL: ASCIZ /IL/ ;REST OF UNTIL
SETOM LOGNEG ;REVERSE SENSE OF WHILE
JRST XWHILE+2 ;AND GO
XWHILE: ASCIZ /LE/ ;REST OF WHILE
SETZM LOGNEG ;NO REVERSING NEEDED
MOVE X1,CECOD ;WHERE SHOULD NEXT RETURN TO
SUB X1,FLCOD ;TO FIRST STATEMENT OF UNTIL/WHILE
SOJ X1, ;
HRLM X1,FORPNT ;SAVE IT
PUSHJ P,IFCCOD ;GO HANDLE THE CONDITIONAL
PUSHJ P,REVSEN ;YES, REVERSE SENSE
PUSHJ P,HALJRS ;JRST TO NEXT+1
HRRM B,FORPNT ;SAVE FOR NEXT CODE
MOVE A,L ;SAVE STATEMENT IN CASE OF ERROR
MOVEI R,FORROL ;PUSH IT ONTO THE FORROL
PUSHJ P,RPUSH ;
MOVE A,FORPNT ;PUSH JRST POINTER ONTO FORROL
PUSHJ P,RPUSH ;
SETO A, ;DUMMY TWO -1'S
PUSHJ P,RPUSH ;
PUSHJ P,RPUSH ;
MOVE A,TMPLOW ;GET TEMP PROTECTION
PUSHJ P,RPUSH ;DUMMY SAVE
JRST NXTSTA ;ALL DONE
;
;WRITE AND PRINT STATEMENTS
;CAUSES DATA TO BE OUTPUT TO THE DISK OR TTY.
XWRIT: ASCIZ /TE/
SETOM WRREFL
JRST XWLAB1
XPRINT: ASCIZ /NT/
SETZM WRREFL
XWLAB1: CAIN C,":"
JRST XPRRAN ;R.A. STATEMENT.
PUSHJ P,QSA
ASCIZ /USING/
JRST XWRI1
CAME C,[XWD F.STR,"#"] ;USING STATEMENT. IMAGE NEXT?
JRST XWRI2 ;YES.
PUSHJ P,XWRCHA ;NO, CHANNEL NEXT.
PUSHJ P,CHKDL1 ;CHECK FOR SEPARATOR
PUSHJ P,XWRIMG ;IMAGE MUST BE NEXT.
JRST XWRI5 ;GO TO GEN THE ARGS AND FINISH.
XWRI2: PUSHJ P,XWRIMG ;GET IMAGE.
JRST XWRI6 ;MUST BE TTY STATEMENT, GET ARGS & FINISH.
XWRI1: CAME C,[XWD F.STR,"#"]
JRST XPRI1 ;NOT USING, NOT #, MUST BE SIMPLE PRINT.
PUSHJ P,XWCHA ;CHANNEL.
TLNE C,F.TERM
JRST XPRI0 ;NOT USING STATEMENT - GO TO PRINT# OR WRITE#.
TLNN C,F.COMA
CAIN C,":"
PUSHJ P,NXCH
TLNE C,F.TERM
JRST XPRI0 ; ''
PUSHJ P,QSA
ASCIZ /USING/
JRST XPRI0 ; ''
MOVE D,[PUSHJ P,IMGLIN]
PUSHJ P,BUILDI
PUSHJ P,XWRIMG ;GET IMAGE.
JRST XWRI5 ;GO TO GEN ARGS AND FINISH.
XWRIMG: TLNE C,F.DIG ;HANDLE IMAGE.
JRST XWRIM2 ;LINE NUMBER FORM.
XWRIM1: PUSHJ P,FORMLS
PUSHJ P,EIRGNP
TLNN C,F.COMA
JRST ERCOMA
PUSHJ P,NXCH
JRST XWRIM4
XWRIM2: PUSH P,C ;LINE NUMBER FORM.
PUSH P,T
PUSHJ P,GETNUM ;GET THE NUMBER.
JFCL
TLNN C,F.COMA
JRST ERCOMA
XWRIM3: POP P,D
POP P,D
HRLZ A,N
MOVEI R,LINROL ;SEARCH FOR THE LINE IT SPECIFIES.
PUSHJ P,SEARCH
FAIL <? Undefined line number >,1
PUSH P,T
MOVE B,(B)
HRRZI T,(B)
HRLI T,440700
XWRIM7: ILDB C,T ;LOOK FOR A LEADING ":", WHICH
CAIN C,":" ;SAYS--THIS IS REALLY AN IMAGE LINE.
JRST XWRIM8
CAIE C," "
CAIN C,11
JRST XWRIM7
FAIL <? Specified line is not an image>
XWRIM8: SETZ A,
PUSHJ P,NXCHD
PUSH P,C
PUSH P,T
TLNE C,F.CR
FAIL <? No characters in image>
AOJ A,XWRMX1 ;PUT THE IMAGE IN THE TABLE
XWRMX1: PUSHJ P,NXCHD ;OF STRING CONSTANTS.
TLZN C,F.CR ;<CR> OR <LF> ?
AOJA A,XWRMX1 ;NO
CAIN C,12 ;<LF> ?
JRST XWRMX1 ;YES
MOVEI E,4(A)
MOVN A,A
HRLI A,(A)
MOVE T,CESLT
SUB T,FLSLT
HRRI A,(T)
MOVEI R,LITROL
PUSH P,E
PUSHJ P,RPUSH
POP P,E
IDIVI E,5
MOVEI R,SLTROL
PUSHJ P,BUMPRL
POP P,T
POP P,C
HRLI B,440700
XWRIM9: CAIN C,15
JRST XWRM10
CAIE C,12 ;SKIP <LF>
IDPB C,B
ILDB C,T
JRST XWRIM9
XWRM10: MOVEI R,SADROL
MOVEI A,
PUSHJ P,RPUSH
SUB B,FLSAD
HRLI B,SADROL
MOVSI D,(MOVE N,)
PUSHJ P,BUILDA
POP P,T
PUSHJ P,NXCH
XWRIM4: MOVE D,[PUSHJ P,CHKIMG]
JRST BUILDI
XWRCHA: TDZA D,D ;DISK STATEMENT.
XWCHA: SETO D,
PUSH P,D
PUSHJ P,GETCNA
MOVE D,[PUSHJ P,OUTSET]
PUSHJ P,BUILDI
MOVEI D,WRIPRI-1
PUSHJ P,GENTYP ;
MOVE D,[JRST WRPRER]
PUSHJ P,BUILDI
SKIPN WRREFL
JRST XWCHA1
MOVE D,[MOVE N,MARGIN(LP)]
PUSHJ P,BUILDI
MOVE D,[CAMGE N,SEVEN]
PUSHJ P,BUILDI
MOVE D,[JRST MARERR]
PUSHJ P,BUILDI
XWCHA1: POP P,D
JUMPE D,XWLAB2
POPJ P,
XWLAB2: MOVE D,[PUSHJ P,IMGLIN]
JRST BUILDI
XWRI6: MOVSI D,(SETZ LP,)
PUSHJ P,BUILDI
MOVE D,[PUSHJ P,OUTSET]
PUSHJ P,BUILDI
MOVE D,[PUSHJ P,IMGLIN]
PUSHJ P,BUILDI
XWRI5: PUSHJ P,KWSAMD ;MODIFIER THERE ?
CAIA ;NO
JRST XWRI7 ;YES, HANDLE AS TERMINATOR
SETZM PFLAG ;NEW EXPRESSION, CLEAR % SEEN
PUSHJ P,FORMLB ;GEN THE ARGS.
PUSHJ P,EIRGNP
MOVE D,[PUSHJ P,FLTPNT]
SKIPGE TYPE ;FLOAT IT IF NECESSARY
PUSHJ P,BUILDI
MOVE D,[PUSHJ P,SCNIMN]
SKIPL F
MOVE D,[PUSHJ P,SCNIMS]
PUSHJ P,BUILDI
TLNN C,F.COMA
CAIN C,";"
CAIA
JRST XWRI7
PUSHJ P,NXCH
TLNN C,F.TERM ;HIT A TERMINATOR?
JRST XWRI5
XWRI7: MOVE D,[PUSHJ P,ENDIMG]
PUSHJ P,BUILDI
JRST NXTSTA
XPRRAN: PUSHJ P,GENTP1 ;R.A. STATEMENT.
PUSHJ P,FORMLB
MOVEM F,IFFLAG
JRST XPRRN2
PUSHJ P,NXCH
XPRRN1: PUSHJ P,FORMLB
XOR F,IFFLAG
JUMPGE F,XPRRN2
FAIL <? Mixed strings and numbers>
XPRRN2: PUSHJ P,EIRGNP
MOVE D,[PUSHJ P,RNNUMO]
SKIPL IFFLAG
HRRI D,RNSTRO
PUSHJ P,BUILDI
PUSHJ P,CHKDEL ;CHECK FOR SEPARATOR
JRST XPRRN1 ;FOUND ONE
XPRI1: SKIPE WRREFL
JRST GRONK
MOVSI D,(SETZ LP,) ;TTY.
PUSHJ P,BUILDI
MOVE D,[PUSHJ P,OUTSET]
PUSHJ P,BUILDI
XPRI0: PUSHJ P,KWSAMD ;MODIFIER FOLLOWS ?
TLNE C,F.TERM ;NON-USING STATEMENTS FROM HERE ON.
JRST XPCRLF
CAIA
XPRI2: PUSHJ P,KWSAMD ;MODIFIER ?
CAIA ;NO
JRST NXTSTA ;YES, GO HANDLE
PUSHJ P,QSA
ASCIZ /TAB/ ;TAB FIELD?
CAIA ;NO, ASSUME EXPRESSION OR DELIMITER.
JRST XPRTAB ;YES, DO THE TAB
TLNN C,F.COMA
CAIN C,";"
JRST PRNDEL
CAIE C,74 ;LEFT ANGLE BRACKET
JRST PRNEXP
;PRINT DELIMITER.
PRNDEL: MOVSI D,(PRDL)
PUSHJ P,CHKFMT
PUSHJ P,BUILDI
JRST XPRFIN
;PRINT EXPRESSION
PRNEXP: SETZM PFLAG ;NEW EXPRESSION, CLEAR % SEEN
PUSHJ P,FORMLB ;GEN THE EXPRESSION
MOVSI D,(PRSTR) ;STR.
JUMPGE F,PRNEX1 ;OR WAS IT NO. ?
PUSHJ P,GPOSNX ;MOVE TO REG IF UNCOMPLEMENTED OR INDEXED.
MOVSI D,(PRNM) ;SET UP OP CODE
PRNEX1: PUSHJ P,CHKFMT ;SET FORMAT CODE
SKIPGE TYPE ;IS IT REAL?
TLO D,400 ;NO, MARK BIT AS INTEGER
PUSHJ P,BUILDA ;GEN PRINT UUO
JRST XPRFIN ;GO FOR MORE
;PRINT TAB
XPRTAB: PUSHJ P,FORMLN ;EVALUATE TAB SUBEXPRESSION
PUSHJ P,EIRGNP ;MOVE IT INTO REG
PUSHJ P,CHKINT ;MUST HAVE INTEGER
MOVSI D,(PRNTB) ;CALL THE TAB INTERPRETER
XPRTA1: PUSHJ P,CHKFMT
PUSHJ P,BUILDI ;YES, BUILD THE INST.
XPRFIN: TLNE C,F.TERM ;CR AT END OF LINE?
JRST NXTSTA
JRST XPRI2 ;NO. GO FOR MORE
;HERE FOR PRINT WITH NO ARGUMENTS. GEN CARRIAGE RETURN.
XPCRLF: MOVE D,[SETZM 40]
PUSHJ P,BUILDI
MOVE D,[PUSHJ P,PRDLER]
PUSHJ P,BUILDI
MOVE D,[PUSHJ P,CRLF]
PUSHJ P,BUILDI
JRST NXTSTA
;CHECK FORMAT CHAR (PRINT AND MAT PRINT)
CHKFMT: PUSHJ P,KWSAMD ;DELIMITER THERE ? (IMPLIES CR)
TLNE C,F.TERM
TLO D,40 ;CR ... AC = 1
CAIN C,";" ;SC ... AC = 2
TLO D,100 ;CMA ... AC = 3
TLNE C,F.COMA ;<PA> ... AC = 4
TLO D,140
CAIE C,74 ;LEFT ANGLE BRACKET
JRST CHKFM2
HRRZ C,(P)
CAIN C,XMAT2B ;MAT STATEMENT CANNOT USE
JRST GRONK ;<PA>.
PUSHJ P,NXCH
PUSHJ P,QSA
;< TO RECTIFY ANGLE BRACKET COUNT
ASCIZ /PA>/
JRST GRONK
TLO D,200
POPJ P,
CHKFM2: TLNN D,140 ;WAS THERE A FMT CHAR?
TLO D,100 ;NO. ASSUME ";"
CAIE C,";"
TLNE C,F.COMA ;SKIP FMT CHAR IF THERE WAS ONE.
JRST NXCHK ;YES. SKIP
POPJ P,
;PAGE AND PAGE ALL STATEMENTS.
;
;CODE FOR THESE STATEMENTS IS COMPILED BY THE MARGIN AND
;MARGIN ALL ROUTINE, XMAG, WHICH SEE.
XPAG: ASCIZ /E/
SETOM TABLE
JRST XMAR0
;
; RANDOM(IZE) STATEMENT
;
XRAN: ASCIZ /DOM/ ;REMAINDER OF RANDOM STATEMENT
PUSHJ P,QSA ;DID USER INCLUDE FULL STATEMENT
ASCIZ /IZE/
JFCL ;WHO CARES
MOVE D,[PUSHJ P,RANDER] ;FETCH RUNTIME RANDOMIZER CALL
PUSHJ P,BUILDI ;BUILD IMMEDIATE
JRST NXTSTA ;THAT'S ALL, FOLKS
;RESTORE STATEMENTS.
XREST: PUSHJ P,QSA ;CHECK FOR RESUME
ASCIZ /UME/
JRST XRESTA
XRESM: MOVE D,[SKIPN ERR]
PUSHJ P,BUILDI
MOVSI D,(JRST)
PUSHJ P,BUILDI
PUSH P,B
MOVE D,[MOVE P,PSAV] ;WANT TO RESTORE P
PUSHJ P,BUILDI ;GENERATE INSTRUCTION TO DO SO
MOVE D,[SETZM ERR]
PUSHJ P,BUILDI
TLNN C,F.CR
JRST XRESM2
XRESM1: SKIPE NOTLIN ;SAVFILNL?
FAIL <? RESUME without argument in SAVFILNL>
MOVE D,[SOS X1,ERL]
PUSHJ P,BUILDI
MOVE D,[SETZM ERL]
PUSHJ P,BUILDI
MOVE D,[JRST @X1]
PUSHJ P,BUILDI
XRSM1A: POP P,X1
ADD X1,FLCOD
MOVE B,CECOD
SKIPE RUNFLA
HRRM B,(X1)
JRST NXTSTA
XRESM2: PUSHJ P,GETNUM
FAIL <? Illegal line reference>
JUMPE N,XRESM1
MOVE D,[SETZM ERL]
PUSHJ P,BUILDI
PUSHJ P,XGOGT
JRST XRSM1A
XRESTA: PUSHJ P,QSA
ASCIZ /TORE/
JRST ILLINS
TLNN C,F.DOLL+F.STAR+F.TERM
CAMN C,[XWD F.STR,"%"]
JRST XREST1
XRES3: CAIN C,":"
JRST XRES5 ;R.A. ARG.
CAMN C,[1000000043]
PUSHJ P,NXCH
PUSHJ P,GETCN2 ;RESTORE# STATEMENT.
MOVE D,[PUSHJ P,XRES]
PUSHJ P,BUILDI
XRES6: PUSHJ P,CHKDEL ;CHECK FOR SEPARATOR
JRST XRES3 ;FOUND ONE
XRES5: PUSHJ P,GETCNA ;R.A. ARG.
MOVNI A,5
XRES7: MOVE D,RESCOD+5(A)
PUSHJ P,BUILDI
AOJL A,XRES7
JRST XRES6
RESCOD: SKIPGE X1,ACTBL-1(LP) ;SOME OF THE CODE GENERATED.
CAME X1,NEGONE
JRST FNMXER
MOVEI N,1
MOVEM N,POINT-1(LP)
XREST1: MOVE D,[PUSHJ P,RESTON] ;DATA RESTORE STATEMENT.
CAMN C,[XWD F.STR,"%"]
JRST XRES2
TLNN C,F.STAR+F.DOLL
SOJA D,XRES1
TLNE C,F.DOLL ;RESTORE ONLY STRINGS?
ADDI D,1
XRES2: PUSHJ P,NXCHK ;SKIP $ OR * OR %
XRES1: PUSHJ P,BUILDI
JRST NXTSTA
;RETURN STATEMENT XLATE
XRETRN: ASCIZ /URN/
SKIPE FUNAME
FAIL <? RETURN within DEF>
MOVE D,[JRST RETURN]
XRET1: PUSHJ P,BUILDI ;XDEF ENTERS HERE TO COMPLETE A FN DEF.
JRST NXTSTA
;STOP STATEMENT
XSTOP: ASCIZ /P/
MOVE D,[JRST EUXIT]
PUSHJ P,BUILDI
JRST NXTSTA
;GEN CODE TO EVALUATE FORMULA
;POINTER TO (POSSIBLY NEGATIVE) RESULT RETURNED IN B
;THIS LOOP HANDLES SUMS OF TERMS, CALLS TERM TO HANDLE PRODUCTS
;AND SO ON
;THE ENTRY POINT FORMLN REGARDS ONLY NUMERIC FORMULAS AS LEGAL.
;THE ENTRY POINT FORMLS REGARDS ONLY STRING FORMULAS AS LEGAL.
;THE ENTRY POINT FORMLB WILL ACCEPT EITHER A STRING OR A NUMERIC FORMULA.
;THE ENTRY POINT FORMLU EXPECTS THE LEGALITY TO BE DEFINED EXTERNALLY.
FORMLS: HRLZI F,1 ;ONLY STRINGS ARE LEGAL
JRST FORMLU ;HANDLE THE EXPRESSION
FORMLB: TDZA F,F ;EITHER IS LEGAL, FIRST COME, FIRST SERVED
FORMLN: SETOI F, ;ONLY NUMERICS ARE LEGAL
FORMLU: SETZM TYPE ;ASSUME EXPRESSION IS REAL IN CASE OF STRING
PUSHJ P,CFORM ;CHECK FOR COMPARISONS
;
; CHECK FOR BOOLEAN LOGIC
;
BTERM1: PUSHJ P,KWSCIF ;CHECK FOR BOOLEAN KEYWORDS
POPJ P, ;NONE FOUND, RETURN
MOVE X1,KWDIND ;GET INDEX TO KEYWORD
SUBI X1,KWACIF ;MAKE AN OFFSET FOR OPCODE
PUSH P,X1 ;AND SAVE IT
MOVMS LETSW ;CANNOT BE L. H. OF LET
JUMPGE F,SETFER ;MUST BE NUMERIC
PUSHJ P,GPOSGE ;GUARANTEE A POSITIVE OPERAND
PUSHJ P,PUSHPR ;SAVE IT ON SEXROL
MOVEI F,(F) ;
PUSHJ P,CFORM ;CHECK FOR COMPARISONS
TLNE B,ROLMSK ;IS RIGHT SIDE OPERAND IN REG?
JUMPGE F,SETFER ;ILLEGAL IF STRING
PUSHJ P,REGFRE ;NO, MAKE SURE REGISTER IS FREE
PUSHJ P,EIRGNP ;GET OPERAND IN REG
PUSHJ P,POPPR ;GET RIGHT SIDE OPERAND BACK
POP P,X1 ;GET OPCODE INDEX BACK
MOVE D,BOCODE(X1) ;PICK UP CORRECT BOOLEAN OPCODE
PUSHJ P,BUILDA ;DO THE INSTRUCTION
CLEAR B, ;EXPRESSION IN REG, AND POSITIVE
JRST BTERM1 ;CHECK FOR ANOTHER BOOLEAN
;
BOCODE: AND N, ;AND
IOR N, ;OR
IOR N, ;IOR
XOR N, ;XOR
EQV N, ;EQV
ORCM N, ;IMP
;
CFORM: PUSHJ P,QSA ;CHECK FOR UNARY "NOT"
ASCIZ /NOT/
JRST CFORM0 ;NO NOT, CHECK <,>,=, ETC.
MOVMS LETSW ;CANNOT BE L. H.
PUSHJ P,REGFRE ;MAKE SURE REGISTER IS FREE
PUSHJ P,CFORM0 ;GET OBJECT OF NOT
PUSHJ P,SETFNO ;MUST BE NUMERIC
TLNE B,MINFLG ;OUTSTANDING "-"?
PUSHJ P,EIRGNP ;YES, NEGATE IT
MOVSI D,(SETCM) ;COMPLEMENT THE BASTARD
PUSHJ P,BUILDA ;DO THE INSTRUCTION
CLEAR B, ;EXPRESSION IN REG, AND POSITIVE
POPJ P, ;AND RETURN
;
CFORM0: PUSHJ P,FORM ;CHECK FOR ARITHMETIC FORMULA
;
CFORM1: MOVEI X1,76 ;CHECK FOR POSSIBLE COMPARISONS
CAIN X1,(C) ;RIGHT ANGLE BRACKET
JRST CFORM2 ;YES, COMPARISION COMING UP
MOVEI X1,74 ;LEFT ANGLE BRACKET?
CAIN X1,(C) ;YES? NO?
JRST CFORM2 ;YES, COMPARISION
SKIPGE LETSW ;ARE WE ON L. H. OF LET?
POPJ P, ;YES, LET AN "=" PASS
TLNN C,F.EQAL ;EQUAL SIGNS?
POPJ P, ;NO, RETURN
CFORM2: MOVMS LETSW ;CAN'T BE L. H.
PUSHJ P,GPOSGE ;MAKE SURE WE HAVE CORRECT SIGN
PUSHJ P,PUSHPR ;AND SAVE IT
PUSHJ P,SCNLT1 ;CHARACTER TO "A" IN SEVEN BIT
MOVEI X1,76 ;CHECK FOR TWO WORD COMPARISION
CAIE X1,(C) ;RIGHT ANGLE BRACKET
TLNE C,F.EQAL ;OR EQUALS SIGN?
PUSHJ P,SCN2 ;YES, COMBINE IN "A" IN SIXBIT
JFCL ;IGNORE ERROR RETURN
MOVEI R,RELROL ;SEARCH RELROL FOR
PUSHJ P,SEARCH ;FOR THIS RELATION
FAIL <? Illegal relation>
HRLZ D,(B) ;PICK UP THE OPCODE
PUSH P,D ;AND SAVE IT
PUSHJ P,FORM ;GET NEXT ARITHMETIC FORMULA
PUSHJ P,GPOSGE ;GET CORRECT SIGN
CLEARM MIXFLG ;CLEAR MIX FLAG
PUSHJ P,CMIXM ;CHECK FOR MIXED MODE
SKIPE MIXFLG ;WAS A MIX MADE?
JRST CRFM2A ;YES, DON'T SWITCH
TLNN B,ROLMSK ;IS RIGHT SIDE ALREADY IN REG
JRST CFORM3 ;YES, COMPARE WITH LEFT SIDE
PUSHJ P,EXCHG ;GET LEFT SIDE IN REG
CRFM2A: MOVE D,(P) ;GET THE OPCODE
TLNE D,1000 ;EQUAL OR NOT EQUAL
TLC D,6000 ;NO, REVERSE SENSE OF COMPARISION
MOVEM D,(P) ;RESTORE OPCODE
CFORM3: JUMPGE F,CFORM4 ;STRING COMPARISON
PUSHJ P,EIRGNP ;NO, GET OPERAND IN REG
PUSHJ P,POPPR ;GET NEXT OPERAND
POP P,D ;GET BACK THE OPCODE
PUSHJ P,BUILDA ;DO THE INSTRUCTION
JRST CFORM5 ;AND CONTINUE
CFORM4: PUSHJ P,EIRGNP ;GET OPERAND IN REG
PUSHJ P,POPPR ;GET BACK SECOND OPERAND
MOVSI D,(STRIF) ;OPCODE FOR STRING COMPARISON
PUSHJ P,BUILDA ;DO THE INSTRUCTION
POP P,D ;GET BACK COMARISON OPCODE
PUSHJ P,BUILDI ;AND COMPARE WITH REG
CFORM5: MOVSI D,(TDZA) ;FALSE RESULT
PUSHJ P,BUILDI ;DO THE INSTRUCTION
MOVSI D,(SETO) ;TRUE RESULT
PUSHJ P,BUILDI ;DO THE INSTRUCTION
CLEAR B, ;RESULT IN REG
HRLI F,-1 ;NUMERIC RESULT
SETOM TYPE ;COMPARISION RESULTS IN INTEGER
JRST CFORM1 ;AND START ALL OVER AGAIN
;
; ALTERNATE ENTRY POINTS FOR FORML? WHEN LOGICAL
; EXPRESSION ARE ILLEGAL
;
XFORMS: HRLZI F,1 ;FOR STRINGS ONLY
JRST XFORMU ;CARRY ON
XFORMB: TDZA F,F ;BOTH ARE LEGAL
XFORMN: SETOI F, ;ONLY NUMERICS
XFORMU: SETZM TYPE ;TYPE DECLARED EXTERNALLY
FORM: PUSHJ P,TERM ;GET FIRST TERM
;ENTER HERE FOR MORE SUMMANDS
FORM1: TLNN C,F.PLUS+F.MINS ;IS BREAK PLUS OR "-"?
POPJ P, ;NO, SO DONE WITH FORMULA
MOVMS LETSW ;THIS CANT BE LH(LET)
JUMPL F,FORM3
TLNN C,F.MINS
JRST FORM2
PUSHJ P,SETFNO ;MARK NUMERIC IF LEGAL
JRST FORM3
FORM2: PUSHJ P,EIRGNP
PUSHJ P,CHKCOR ;CHECK CORE REQUIREMENTS
PUSHJ P,MASCK1 ;HANDLE STRING EXPRESSION
PUSHJ P,TERM
PUSHJ P,EIRGNP
MOVE D,[PUSHJ P,APPEND]
PUSHJ P,BUILDI
SETZ B,
TLNN C,F.PLUS
POPJ P,
JRST FORM2
FORM3: PUSHJ P,PUSHPR ;PART RESLT TO SEXROL
PUSHJ P,TERM ;GEN SECOND TERM
PUSHJ P,CMIXM ;CHECK FOR MIXED MODE
TLNE B,ROLMSK ;IS SECOND TERM IN REG?
PUSHJ P,EXCHG ;NO. LETS DO FIRST TERM FIRST
PUSHJ P,EIRGEN ;FIRST SUMMAND TO REG
PUSH P,B ;SAVE SIGN INFORMATION
PUSHJ P,POPPR ;GET SECOND SUMMAND
SKIPGE (P) ;IS CONTENT OR REG NEGATIVE?
TLC B,MINFLG ;YES, NEGATE SECOND SUMMAND
SKIPL TYPE ;INTEGER?
JRST FORM4 ;NO, DO REAL
MOVSI D,(ADD N,) ;ASSUME POSITIVE
SKIPGE B ;IS IT
MOVSI D,(SUB N,)
PUSHJ P,BUILDA ;BUILDI THE INSTRUCTION
JRST FORM5 ;CONTINUE
FORM4: MOVSI D,(FADR N,) ;FETCH INSTRUCTION
PUSHJ P,BUILDS ;BUILD ADD OR SUB INSTR
FORM5: POP P,B ;REG PNTR WITH SIGN
AND B,[XWD MINFLG,0]
JRST FORM1 ;GO LOOK FOR MORE SUMMANDS
;LOOP TO GEN CODE FOR MULTIPLY AND DIVIDE
;CALLS FACTOR TO HANDLE EXPRESSIONS INVOLVING ONLY INFIX OPS AND "^"
TERM: PUSHJ P,FACTOR ;GEN FIRST FACTOR
;ENTER HERE FOR MORE FACTORS
TERM1: TLNN C,F.STAR+F.SLSH ;MUL OR DIV FOLLOWS?
POPJ P, ;NO, DONE WITH TERM.
PUSHJ P,SETFNO ;MARK NUMERIC IF LEGAL
MOVMS LETSW ;THIS CANT BE LH(LET)
HRRZS 0(P) ;SET MUL FLAG.
TLNN C,F.STAR ;IS IT MULTIPLY?
HRROS 0(P) ;NO. SET DIV FLAG
TERM2: PUSHJ P,NXCHK ;SKIP OVER CONNECTIVE
PUSHJ P,PUSHPR ;STASH PARTIAL RESULT ON SEXROL
PUSHJ P,FACTOR ;GEN NEXT FACTOR
CLEARM MIXFLG ;CLEAR MIX FLAG
PUSHJ P,CMIXM ;CHECK FOR MIXED MODE
SKIPGE (P) ;IS SECOND FACTOR A DIVISOR?
SKIPE MIXFLG ;OR WAS A MIX MADE
CAIA ;YES, REG IS OK
PUSHJ P,SITGEN ;YES. IT CANNOT STAY IN REG.
TLNE B,ROLMSK ;IS SECOND FACTOR IN REG?
PUSHJ P,EXCHG ;NO. LETS GET FIRST FACTOR.
MOVE X1,CESEX ;PEEK AT DIVISOR OR SECOND FACTOR.
MOVE X2,-1(X1)
TLZE X2,MINFLG ;IS IT MINUS?
TLC B,MINFLG ;YES. CHANGE SIGNS OF BOTH.
MOVEM X2,-1(X1) ;NOW DIVISION OR SECOND FACTOR IS PLUS.
PUSHJ P,EIRGEN ;GEN FIRST FACTOR OR DIVIDEND
PUSH P,B ;SAVE SIGN INFORMATION
PUSHJ P,POPPR ;GET SECOND OPERAND
MOVSI D,(FMPR N,) ;GET CORRECT INSTRUCTION
SKIPGE -1(P)
MOVSI D,(FDVR N,)
SKIPGE TYPE ;INTEGER?
ADD D,[XWD 34000,0] ;YES, MAKE IDIV OR IMUL
PUSHJ P,BUILDA ;BUILD MUL OR DIV INSTR
POP P,B ;REG PNTR WITH SIGN
JRST TERM1 ;GO LOOK FOR MORE FACTORS
;GEN CODE FOR ATOMIC FORMULAS, EXPONENTIATION, AND INFIX SIGNS
;SIGN IS STASHED IN LH OF PUSH-DOWN LIST WORD WITH RETURN ADDRS
;EXPLICIT SIGN IS NOT USED UNTIL AFTER EXPONENTIATION
;IS CHECKED FOR.
FACTOR: PUSH P,C ;STASH SIGN IN PUSH LIST.
TLNN C,F.MINS ;EXPLICIT MINUS SIGN?
JRST FACT2 ;NO.
PUSHJ P,SETFNO ;MARK NUMERIC IF LEGAL
TLC C,F.PLUS+F.MINS ;YES. PRETEND IT WAS PLUS CALLING ATOM.
MOVMS LETSW ;AND THIS CANNOT BE LH OF LET.
FACT2: PUSHJ P,ATOM ;GEN FIRST ATOM
FACT2A: CAIN C,"^" ;EXPONENT FOLLOWS?
JRST FACT3A ;YES.
TLNN C,F.STAR ;MAYBE.
JRST SNOEXI ;NO. GO NOTE SIGN AND RETURN.
MOVEM T,X1
PUSHJ P,NXCHK
TLNE C,F.STAR
JRST FACT3A ;YES.
MOVE T,X1 ;NO. GO NOTE SIGN AND RETURN.
MOVE C,[XWD F.STAR, "*"]
JRST SNOEXI
FACT3A: PUSHJ P,SETFNO ;MARK NUMERIC IF LEGAL
MOVMS LETSW ;THIS CANT BE LH(LET)
PUSHJ P,NXCHK ;YES. SKIP EXPONENTIATION SIGN
PUSHJ P,PUSHPR ;STASH BASE ON SEXROL
PUSHJ P,ATOM ;GEN THE EXPONENT
PUSHJ P,EXCHG ;EXCHANGE BASE AND EXPONENT
PUSHJ P,EIRGNP ;GET POSITIVE BASE IN REG
SKIPGE TYPE ;FLOATING BASE?
JRST FACT5A ;NO, DO INTEGER EXP
PUSHJ P,POPPR ;GET EXPONENT
MOVSI D,(MOVE 1,) ;WILL MOVE IT TO AC 1
PUSHJ P,BUILDS ;GENERATE CORRECT SIGN
MOVE D,[PUSHJ P,EXP3.0] ;ASSUME FLOATING EXP
SKIPGE TYPE ;IS IT?
HRRI D,EXP2.0 ;NO, USE EXPS.0
SETZM TYPE ;ANSWER IS FLOATING
JRST FACT6A ;CONTINUE
FACT5A: MOVE X1,CESEX ;PEEK AT EXP
MOVE X2,-1(X1) ;
TLNE X2,100000 ;FLOATING EXP?
JRST FACT5B ;NO INT ** INT
MOVE D,[PUSHJ P,FLTPNT] ;FLOAT THE BASE
PUSHJ P,BUILDI ;
PUSHJ P,POPPR ;GET THE EXPONENT
MOVSI D,(MOVE 1,) ;PUT IN AC 1
PUSHJ P,BUILDS ;CORRECT SIGN
MOVE D,[PUSHJ P,EXP3.0] ;
JRST FACT6A ;CARRY ON
FACT5B: PUSHJ P,POPPR ;
MOVSI D,(MOVE 1,) ;
PUSHJ P,BUILDS ;
MOVE D,[PUSHJ P,EXP1.0] ;
FACT6A: PUSHJ P,BUILDI ;BUILD CALL TO EXPONENTIATION ROUTINE
MOVEI B,0 ;ANSWER LANDS IN REG
JRST FACT2A
;SIGN NOTE AND EXIT
;COMPLEMENT SIGN IF "-" AND APPROPRIATE FLAGS ON PD LIST.
;THEN RETURN FROM SUBROUTINE.
SNOEXI: POP P,X1
TLNE X1,F.MINS ;IS SAVED SIGN MINUS?
TLC B,MINFLG ;YES. COMPLEMENT
POPJ P,
;GEN CODE FOR SIGNED ATOM.
ATOM: PUSH P,C ;SAVE SIGN INFO.
TLNE C,F.PLUS ;EXPLICIT SIGN?
JRST ATOM1
TLNN C,F.MINS
JRST ATOM2
PUSHJ P,SETFNO ;MARK NUMERIC IF LEGAL
ATOM1: PUSHJ P,NXCHK ;YES. SKIP SIGN
ATOM2: TLNE C,F.LETT ;LETTER?
JRST FLETTR ;YES. VARIABLE OR FCN CALL.
TLNE C,F.DIG+F.PER ;NUMERAL OR DECIMAL POINT?
JRST FNUMBR ;YES. LITERAL OCCURRENCE OF NUMBER
TLNE C,F.QUOT
JRST REGSLT ;STR CONSTANT.
CAIE C,"(" ;SUBEXPRESSION?
JRST ILFORM ;NO. ILLEGAL FORMULA
FSUBEX: PUSHJ P,NXCHK ;SUBEXPR IN PARENS. SKIP PAREN
MOVMS LETSW ;SUBEXPRESSION CANNOT BE L. H.
PUSH P,F ;SAVE TYPE FLAG F
PUSHJ P,FORMLB ;GEN THE SUBEXPRESSION
POP P,X1 ;RETURN TYPE CODE
TLNN X1,-1 ;WAS TYPE DECLARED?
JRST FSUBX1 ;NO, SO DON'T CHECK
XOR X1,F ;CHECK FOR MIXED MODE
JUMPL X1,SETFER ;MIXED MODE
FSUBX1: TLNN C,F.RPRN ;BETTER HAVE MATCHING PAREN
JRST ILFORM ;NO. GRONK.
PUSHJ P,NXCHK ;SKIP PARENTHESIS
JRST SNOEXI ;GO TEST SIGN AND RETURN.
;HERE WHEN ATOMIC FORMULA IS A NUMBER
FNUMBR: PUSHJ P,SETFNO ;MARK NUMERIC IF LEGAL
MOVMS LETSW
PUSH P,F
SETZM TYPE ;ASSUME REAL
PUSHJ P,EVANUM ;EVALUATE NUMBER (IN N)
FAIL <? Illegal constant>
POP P,F
MOVE X1,0(P) ;GET SIGN FLAG
CAIE C,"^" ;EXPONENT FOLLOWS?
TLNN X1,F.MINS ;OR IS IT PLUS ANYWAY?
JRST FNUM1 ;YES. DONT FUDGE SIGN
TLNN C,F.STAR ;CHECK FOR OTHER KIND OF EXPONENT.
JRST FNUM5 ;NO, NOT THIS KIND OF EXP EITHER.
MOVEM T,B
PUSHJ P,NXCH
MOVE T,B
TLNE C,F.STAR
JRST FNUM1 ;YES, EXPONENT.
MOVE C,[XWD F.STAR,"*"]
FNUM5: MOVN N,N ;NEGATE NUMBER
SETZM 0(P) ;AND CLEAR SIGN INFO.
FNUM1: MOVE B,FLCON ;SEARCH CONSTANT ROLL
FNUM2: CAML B,CECON ;(UNSORTED--CANT USE SEARCH)
JRST FNUM3 ;NOT FOUND
CAME N,(B) ;THIS ONE?
AOJA B,FNUM2 ;NO. GO TO NEXT.
SUB B,FLCON ;FOUND. CALC REL ADDRESS IN CONROL.
JRST FNUM4
FNUM3: MOVEI R,CONROL ;PUSH ON CONROL
MOVE A,N
PUSHJ P,RPUSH
MOVEI R,CADROL ;PUT ADDRS ON CONST ADDRS ROLL
MOVEI A,0
PUSHJ P,RPUSH
SUB B,FLCAD ;GET REL ADDRS
FNUM4: HRLI B,CADROL ;MAKE POINTER
JRST SNOEXI ;GO LOOK AT SIGN AND RETURN.
NNUM: PUSH P,[EXP 1] ;REGISTER THE CONSTANT IN "N"
JRST FNUM1
;XLATE AND GEN ATOMIC FORMULA BEGINNING WITH LETTER
FLETTR: PUSHJ P,REGLTR
FLET1: JRST .+1(A)
JRST XARFET ;ARRAY REF
JRST SNOEXI ;SCALAR. JUST RETURN
JRST XINFCN ;INTRINSIC FCN
JRST XDFFCN ;DEFINED FCN
JRST ILVAR
JRST XARFET ;STRING VECTOR. PROCESS WITH ARRAY CODE!
JRST SNOEXI ;POINTER IS IN B FOR BUILDING.
FLET2: PUSH P,[EXP 1] ;PUSH AN IMPLICIT PLUS SIGN ON PLIST
JRST FLET1 ;FINISH REGISTERING VARIABLE.
XARFET: PUSH P,A
PUSH P,B
PUSH P,TYPE ;SAVE TYPE OF ARRAY
PUSHJ P,REGFRE ;FREE REG
PUSHJ P,XARG
JUMPG F,XARF1 ;STRING VECTOR?
SKIPL LETSW ;NO, IS IT LH OF ARRAY-LET?
JRST XARF1 ;DO A FETCH AS USUAL.
TLNN C,F.EQAL+F.COMA ;IS IT DEFINITELY LH OF ARRAY-LET?
JRST XARF1 ;NO.
POP P,TYPE ;RESTORE THE TYPE
POP P,X1 ;YES. DON'T FETCH! RETURN TO LH(LET)
POP P,A
SUB P,[XWD 10,10] ;ADJUST THE PUSHLIST TO ESC FORMLS
MOVE A,1(P)
PUSH P,B ;SAVE THE ARGUMENT FLAG
SKIPGE TYPE ;IS ARRAY INTEGER?
TLO X1,100000 ;YES, MARK IT AS SUCH
PUSH P,X1 ;SAVE THE ARRAY POINTER
JRST (A)
XARF1: POP P,TYPE ;RESTORE THE TYPE
MOVSI D,(ARFET1)
JUMPL F,XARF2 ;STR VECTOR?
MOVSI D,(SVRADR) ;YES. FETCH STRING POINTER ADDRESS.
HRRZ X1,(P) ;OFFSET TO SVRROL
MOVE X2,FLOOR(F) ;FLOOR OF SVRROL
ADD X2,X1 ;PLUS OFFSET
MOVE X1,(X2) ;GET FIRST ENTRY IN SVRROL
TLNE X1,(1B0) ;VIRTUAL STRING VECTOR
TLNE C,F.EQAL+F.COMA ;IS THIS A LH OF LET
JRST XARF2 ;NOT VIRTUAL OR LH
SKIPN FUNAME ;WITHIN FUNCTION?
SETOM AFLAG ;NO, MARK A FLAG
XARF2: JUMPE B,XARFFN
SKIPGE F
MOVSI D,(ARFET2)
HRRZ X1,(P) ;MARK DOUBLE ARRAY
ADD X1,FLOOR(F)
SKIPN 1(X1)
SETOM 1(X1)
XARFFN: EXCH B,0(P)
PUSHJ P,BUILDA
POP P,B
PUSH P,TYPE ;SAVE THE TYPE
PUSHJ P,GENARG
POP P,TYPE ;RESTORE THE TYPE
MOVEI B,0 ;REG POINTER
SKIPL F ;STRING VECTOR?
PUSHJ P,SITGEN ;YES,SAVE ADDRESS POINTER
POP P,A
JRST SNOEXI
;GEN FUNCTION CALLS
XDFFCN: PUSH P,F ;SAVE FCN TYPE
PUSH P,D ;SAVE FCN NAME
SETZ D, ;BEGIN MASK AT ZERO
PUSH P,D ;SET UP ARGUMENT TYPE MASK
PUSHJ P,REGFRE ;SAVE ANY SUBEXPRESSION
PUSHJ P,PUSHPR ;SAVE FUNCTION LOCATION
MOVE D,[PUSHJ P,SAVACS]
PUSHJ P,BUILDI
CAIE C,"(" ;ANY ARGS?
JRST XDFF2 ;NO
MOVEI D,1 ;SET UP FOR ARG BITS.
PUSH P,D ;SAVE IT
SETZM PSHPNT ;INITIALIZE COUNT OF PUSH INSTS GENNED
XDFF1: SETZM PFLAG ;CLEAR % SEEN
PUSHJ P,NXCHK
PUSH P,LETSW
MOVMS LETSW
PUSHJ P,XFORMB ;GEN THE ARGUMENT IN REG
POP P,LETSW
POP P,D ;GET BACK ARGUMENT BITS
JUMPGE F,XDFF1B ;STRING?
SKIPL TYPE ;NO, INTEGER?
JRST XDFF1A ;NO, MARK REAL
IORM D,(P) ;SET ONE BIT
JRST XDFF1B ;MARK SECOND BIT
XDFF1A: IORM D,(P) ;MARK REAL
LSH D,2 ;SET FOR NEXT ARG
JRST XDFF1C ;AND CONTINUE
XDFF1B: LSH D,1 ;SKIP A BIT
IORM D,(P) ;MARK IT
LSH D,1 ;SET UP FOR NEXT ARG
XDFF1C: SKIPN D ;TOO MANY ?
FAIL <? Too many function arguments>
PUSH P,D ;SAVE AGAIN
SKIPGE B
PUSHJ P,EIRGP1
MOVSI D,(PUSH Q,) ;BUILD ARGUMENT PUSH
PUSHJ P,BUILDA
AOS PSHPNT ;COUNT THE PUSH
AOS -2(P) ;ALSO SAVE THE COUNT FOR CHECK OF ARGS
TLNE C,F.COMA ;MORE ARGS?
JRST XDFF1 ;YES
TLNN C,F.RPRN ;CHECK FOR MATCHING PAREN
JRST ERRPRN
SETZM PSHPNT ;RESET THE PUSH COUNT AGAIN
PUSHJ P,NXCHK ;SKIP PAREN
POP P,X1 ;DITCH ARGUMENT TYPE MASK BIT
XDFF2: PUSHJ P,ARGCHK ;CHECK FOR RIGHT NUMBER OF ARGUMENTS
POP P,X1 ;GET RID OF ARGUMENT TYPE MASK
POP P,X1 ;GET RID OF POINTER TO ARG# CONSTANT
PUSHJ P,POPPR ;GET BACK FUNCTION LOC
MOVSI D,(GOSUB)
PUSHJ P,BUILDA ;GEN THE CALL
MOVEI B,0 ;ANSWER IS IN REG
POP P,F ;GET BACK FCN TYPE
JRST SNOEXI
;ROUTINE TO CHECK NUMBER OF ARGUMENTS AND CREATE A CONSTANT TO POP THEM
;OFF THE PUSH LIST. CALLED WITH XWD FCNAME,# OF ARGS
;AT LOCATION -1(P) RETURNS WITH A POINTER TO CONSTANT
;AT THAT LOCATION.
ARGCHK: MOVE N,-1(P) ;THEIR TYPE MASK
PUSHJ P,NNUM ;REGISTER AS CONSTANT
MOVE N,-2(P) ;GET FCN NAME IN L.H.
MOVEM B,-2(P) ;AND SAVE CONSTANT ADDRESS
HRR N,B ;ASSEMBLE FADROL ENTRY...
HLLZ A,N ;SETUP SEARCH ARGUMENT
MOVEI R,FADROL ; XWD FCNAME,CONSTANT ADDRESS
PUSHJ P,SEARCH
JRST ARGCH1 ;FIRST TIME FCN SEEN. PUT ENTRY IN ROLL
CAMN N,(B) ;FCN SEEN BEFORE. SAME NUMBER OF ARGS?
POPJ P,
SETZM FUNAME
ARGCH0: FAIL <? Incorrect number or type of arguments>
ARGCH1: MOVEI E,1 ;ADD FCN REF TO FADROL
PUSHJ P,OPENUP
MOVEM N,(B)
POPJ P,
;INTRINSIC FUNCTION GENERATOR.
XINFCN: PUSH P,FTYPE ;SAVE TYPE OF SUBEXPRESSION
PUSH P,B ;SAVE FUNCTION LOC AND FLAGS
PUSHJ P,REGFRE ;PROTECT ANY PARTIAL RESULT
MOVE B,(P) ;GET THE FLAG BITS
TLNN B,777777 ;INLINE CODE PRODUCER?
JRST XINF4 ;YES, TYPED INTERNALLY
TLNE B,777 ;ANY ARGUMENTS?
JRST XINF2 ;YES, HANDLE ARGUMENTS
CAIE C,"(" ;OPTIONAL ARGUMENT?
JRST XINF1 ;NO, SET TYPE
PUSHJ P,NXCH ;EAT A "("
PUSH P,F ;SAVE F
PUSHJ P,FORMLB ;DO THE ARGUMENT
POP P,F ;RESTORE F
XINF0: TLNN C,F.RPRN ;ARGUMENT LIST ENDS WITH )
JRST ERRPRN ;IT DIDN'T
PUSHJ P,NXCH ;EAT THE )
XINF1: POP P,D ;GET FUNCTION LOC. AND FLAGS
CLEARM TYPE ;ASSUME FUNCTION TYPE IS NON-INTEGER
TLNE D,4000 ;IS IT INTEGER?
SETOM TYPE ;YES, SET THE TYPE
HRLI D,(PUSHJ P,) ;GENERATE THE PUSHJ
XINF11: PUSHJ P,BUILDI ; DO THE INSTRUCTION
CLEAR B, ;CLEAR ADDRESS
POP P,FTYPE ;RESTORE PREVIOUS TYPE
JRST SNOEXI ;AND RETURN
;
; HERE FOR FUNCTIONS WITH ARGUMENTS AND NO INLINE
;
XINF2: CAIE C,"(" ;NEEDS ARGUMENTS
JRST ARGCH0 ;NONE GIVEN
PUSH P,F ;SAVE TYPE OF SUBEXPRESSION
SKIPGE B ;HAS SPECIAL ARGUMENT BLOCK
JRST XINF21 ;YES, HANDLE SEPARATELY
LDB X1,[POINT 9,B,17]; GET TYPE OF ARGUMENT
SETOM FTYPE ;ASSUME IT SHOULD BE INTEGER
CAIE X1,4 ;SHOULD IT BE?
CLEARM FTYPE ;NO, SET FOR NON-INTEGER
CAIE X1,1 ;SHOULD ARGUMENT BE A STRING?
SETO X1, ;NO, SET TYPE FOR NUMERIC
HRL F,X1 ;SET TYPE FOR FORMLU
MOVEI X1,1 ;ONE ARGUMENT NEEDED
JRST XINF22 ;CODE THE FUNCTION
;
; HERE FOR FUNCTIONS WITH SPECIAL ARGUMENT BLOCK
;
XINF21: HLRZ D,B ;ADDRESS OF ARG BLOCK
MOVE X1,(D) ;NUMBER OF ARGUMENTS TO EXPECT
CAIN X1,3 ;3? I. E. INSTR OR MID$
JRST XINF3 ;YES, MIGHT BE TWO ARGUMENTS
XINF20: HRLZ F,1(D) ;GET ARGUMENT TYPE FOR FORMLU
SETOM FTYPE ;NUMERICS SHOULD ALWAYS BE INTEGER
;
XINF22: PUSH P,X1 ;SAVE NUMBER OF ARGUMENTS
PUSH P,D ;AND FUNCTION LOC AND FLAGS
PUSHJ P,NXCH ;EAT THE SEPARATOR , OR (
PUSHJ P,XFORMU ;GENERATE THE ARGUMENT
PUSHJ P,EIRGNP ;MAKE SURE ITS IN REG
JUMPG F,XINF23 ;STRING ARGUMENT?
MOVE X1,FTYPE ;NO, CHECK THE TYPE
CAME X1,TYPE ;MATCHING?
PUSHJ P,CHKTYP ;NO, FIX OR FLOAT IT
CAIA ;AND SKIP STRING CHECK
XINF23: PUSHJ P,MASCK1 ;STORE ARGUMENT IN MASAPP
POP P,D ;BACK WITH FUNCTION LOC AND FLAGS
POP P,X1 ;AND NUMBER OF ARGUMENTS
SOJN X1,XILAB1 ;ALL ARGUMENTS PROCESSED
POP P,F ;YES, RESTORE SUBEXPRESSION TYPE
JRST XINF0 ;AND FINISH UP
XILAB1: TLNN C,F.COMA ;NEED A COMMA
JRST ERCOMA ;NONE THERE
AOJA D,XINF20 ;DO NEXT
XINF3: SKIPG 1(D)
JRST XINF31
PUSHJ P,XINST1 ;MID$.
PUSHJ P,XINNUM
POP P,F ;RESTORE F.
CLEARM TYPE ;MID$ IS REAL
TLNN C,F.COMA
JRST XINF0A
MOVE D,[PUSH P,N]
PUSHJ P,BUILDI
PUSHJ P,XINNM1
HRLI F,1 ;RESTORE F.
CLEARM TYPE
JRST XINF01
XINF31: PUSHJ P,NXCH ;INSTR.
PUSHJ P,CHKCOR ;CHECK CORE REQUIREMENTS
PUSHJ P,XFORMB
PUSHJ P,EIRGNP
JUMPG F,XINF34
SKIPL TYPE ;IS IT INTEGER
PUSHJ P,GENINT ;NO, FIX IT
MOVE D,[PUSH P,N]
PUSHJ P,BUILDI
JRST XINF32
XINF34: PUSHJ P,MASCK1 ;HANDLE STRING EXPRESSION
PUSHJ P,XINSTR
POP P,F
SETOM TYPE ;INSTR IS INTEGER
JRST XINF0A
XINF32: PUSHJ P,XINSTR
PUSHJ P,XINSTR
POP P,F
SETOM TYPE
XINF01: TLNN C,F.RPRN
JRST ERRPRN
PUSHJ P,NXCH
POP P,D
HRRZI D,(D)
ADD D,[PUSHJ P,3]
JRST XINF11
XINSTR: TLNN C,F.COMA ;SUBR FOR STR ARG.
JRST ERCOMA
XINST1: PUSHJ P,NXCH
PJRST MASCHK ;HANDLE STRING ARGUMENT
XINNUM: TLNN C,F.COMA ;SUBR FOR NUMERIC ARGUMENT.
JRST ERCOMA
XINNM1: PUSHJ P,NXCH
PUSHJ P,XFORMN
JRST CHKINN ;CHECK TYPE
XINF0A: TLNN C,F.RPRN
JRST ERRPRN
PUSHJ P,NXCH
POP P,D
HRLI D,(PUSHJ P,)
JRST XINF11
XINF4: POP P,B
POP P,FTYPE ;RESTORE FTYPE
JRST .(B) ;IN LINE CODE.
JRST ABSBI
JRST ASCBI
JRST CRTBI
JRST DETBI
JRST FLTBI
JRST LLBI
JRST LOCBI
JRST LOFBI
JRST NUMBI
JRST PIBI
JRST SGNBI
JRST TIMBI
;IN LINE FUNCTION GENERATORS.
ABSBI: CAIE C,"(" ;ABS FUNCTION.
JRST ARGCH0
PUSHJ P,NXCH
PUSHJ P,XFORMN
PUSHJ P,EIRGNM
TLNN C,F.RPRN
JRST ERRPRN
JRST INLIO2
INLIOU: TLNN C,F.RPRN
JRST ERRPRN
INLIO0: PUSHJ P,BUILDI
INLIO2: PUSHJ P,NXCH
INLIO1: MOVEI B,0
JRST SNOEXI
ASCBI: CAIE C,"(" ;ASC FUNCTION.
JRST ARGCH0
SETZ X2,
PUSHJ P,NXCHD
TLNN C,F.RPRN
JRST ASCB11
PUSH P,T
PUSHJ P,NXCH
TLNN C,F.RPRN
JRST ASCBI0
POP P,T
JRST ASCBI3
ASCB11: TLNN C,F.SPTB
JRST ASCBI3
MOVE X1,C ;BLANKS AND TABS.
ASCBI1: PUSHJ P,NXCHD ;IF ONLY BLANKS ARE
TLNE C,F.RPRN ;PRESENT, THE ARG IS A
JRST ASCBI2 ;BLANK. IF ONLY BLANKS
TLNE C,F.CR ;AND TABS ARE PRESENT, THE
ASCBI0: FAIL <? Illegal argument for ASC function> ;ARG IS
TLNN C,F.SPTB ;A TAB. O'E, THE BLANKS
JRST ASCBI3 ;AND TABS ARE IGNORED.
CAME C,X1
CAMN C,X2
JRST ASCBI1
MOVE X2,C
JRST ASCBI1
ASCBI2: MOVE C,X1
JUMPE X2,ASLAB1
MOVE C,[XWD F.SPTB,11]
ASLAB1: PUSH P,T
HRRZ A,C
PUSHJ P,NXCH
TLNE C,F.RPRN
JRST ASCB21
POP P,T
ROT A,-7
JRST ASCBI5
ASCB21: POP P,T
HRLZI A,500000
JRST ASCBI5
ASCBI3: PUSHJ P,SCNLT1
TLNE C,F.RPRN
JRST ASCBI5 ;1 CHAR ARG.
TLNE C,F.TERM
JRST ILFORM
PUSHJ P,SCN2
JUMP
TLNE C,F.RPRN
JRST ASCBI6 ;2 CHAR CODE.
TLNE C,F.TERM
JRST ILFORM
PUSHJ P,SCN3
JUMP
TLNN C,F.RPRN
JRST ERRPRN
JRST ASCBI6 ;THREE CHAR CODE.
ASCBI5: PUSH P,N ;SET UP IN LINE CODE.
LDB N,[POINT 7,A,6]
ASCB51: HRR D,N
POP P,N
ASCB52: HRLI D,(MOVEI N,)
SETOM TYPE
JRST INLIO0 ;EXIT.
ASCBI6: PUSH P,N ;SEARCH.
HLRZ A,A
MOVEI X1,ASCFLO
ADDI X1,1
ASCBI7: HLRZ X2,-1(X1)
CAIN A,(X2)
JRST ASCBI8
HRRZ X2,-1(X1)
CAIN A,(X2)
JRST ASCBI9
CAIGE X1,ASCCEI
AOJA X1,ASCBI7
JRST ASCBI0
ASCBI8: SUBI X1,ASCFLO
MOVEI N,2(X1)
CAIG X1,^D10
MOVEI N,-1(X1)
JRST ASCB51
ASCBI9: SUBI X1,ASCFLO
MOVEI N,22(X1)
CAIN X1,^D15
MOVEI N,^D127
JRST ASCB51
;TABLE OF CODES FOR THE ASC FUNCTION.
ASCFLO: SIXBIT /NULDC3/
SIXBIT /SOHDC4/
SIXBIT /STXNAK/
SIXBIT /ETXSYN/
SIXBIT /EOTETB/
SIXBIT /ENQCAN/
SIXBIT /ACKEM /
SIXBIT /BELSUB/
SIXBIT /BS ESC/
SIXBIT /HT FS /
SIXBIT /CR GS /
SIXBIT /SO RS /
SIXBIT /SI US /
SIXBIT /DLESP /
SIXBIT /DC1DEL/
SIXBIT /DC2 /
ASCCEI:
;
; CRT FUNCTION
;
CRTBI: CAIE C,"(" ;CRT TAKES AN ARGUMENT
JRST ARGCH0 ;BUT NOT INCLUDED
PUSHJ P,NXCH ;EAT THE "("
PUSHJ P,XFORMN ;ONLY NUMERIC EXPRESSION ALLOWED
PUSHJ P,EIRGEN ;MAKE SURE EXPRESSION IS IN REG.
SKIPGE TYPE ;IS THE EXPRESSION INTEGER?
JRST CRTBI1 ;YES, JUST SET CRTVAL
MOVE D,[PUSHJ P,FIXPNT] ;HAVE TO FIX CRTVAL
PUSHJ P,BUILDI ;GENERATE THE FIXPNT INSTRUCTION
CRTBI1: MOVE D,[EXCH N,CRTVAL] ;SET CRTVAL, RETURN OLD VALUE
SETOM TYPE ;CRT IS INTEGER FUNCTION
JRST INLIOU ;CHECK FOR ")", GENERATE INSTUC. IN D
;
; DET FUNCTION
;
DETBI: CAIN C,"(" ;DET FUNCTION.
JRST ARGCH0 ;NO ARGUMENTS
MOVE D,[MOVE N,DETER]
SETZM TYPE ;REAL FUNCTION
PUSHJ P,BUILDI
JRST INLIO1
FLTBI: CAIE C,"(" ;NEEDS AN ARGUMENT
JRST ARGCH0 ;NONE THERE
PUSHJ P,NXCHD ;EAT THE (
PUSHJ P,XFORMN ;GET NUMERIC ARGUMENT
PUSHJ P,EIRGEN ;MOVE TO REG
MOVE D,[PUSHJ P,FLTPNT] ;TO FLOAT
SKIPL TYPE ;IS IT ALREADY REAL?
MOVSI D,(JFCL) ;YES, DUMMY FLOAT
JRST INLIOU ;ALL DONE
LLBI: CAIE C,"(" ;NEED AN ARGUMENT
JRST ARGCH0
PUSHJ P,NXCH
PUSHJ P,GETNUM ;GET LINE NUMBER
FAIL <? Illegal line reference>
MOVE D,N
HRLZ A,N ;CHECK IT OUT
MOVEI R,LINROL
PUSHJ P,SEARCH
FAIL <? Undefined line number >,1
HRLI D,(MOVEI N,) ;OKAY, SET IT UP
SETOM TYPE
JRST INLIOU
LOCBI: SETZM LOCLOF ;LOC FUNCTION.
LOCBI1: CAIE C,"(" ;LOF ENTERS HERE.
JRST ARGCH0
PUSHJ P,NXCH
CAIN C,":"
PUSHJ P,NXCH
PUSHJ P,GETCN0
HRLZI D,(MOVE X1,)
PUSHJ P,BUILDI
MOVE D,[SKIPGE X2,ACTBL-1(X1)]
PUSHJ P,BUILDI
MOVE D,[CAME X2,NEGONE]
PUSHJ P,BUILDI
MOVE D,[JRST FNMX0]
PUSHJ P,BUILDI
MOVE D,[MOVE N,POINT-1(X1)]
SKIPE LOCLOF
MOVE D,[MOVE N,LASREC-1(X1)]
SETOM TYPE
JRST INLIOU
LOFBI: SETOM LOCLOF ;LOF FUNCTION.
JRST LOCBI1
NUMBI: CAIN C,"(" ;NUM FUNCTION.
JRST ARGCH0 ;NO ARGUMENTS
MOVE D,[MOVE N,NUMRES]
PUSHJ P,BUILDI
SETOM TYPE
JRST INLIO1
PIBI: SETZM TYPE
MOVE D,[MOVE N,PIB]
PUSHJ P,BUILDI
JRST INLIO1
SGNBI: CAIE C,"(" ;SGN FUNCTION.
JRST ARGCH0
PUSHJ P,NXCH
PUSHJ P,XFORMN
PUSHJ P,EIRGNP
MOVSI D,(SKIPE N) ;SIGN OF 0 IS ZERO
PUSHJ P,BUILDI ;GENERATE IT
SETOM TYPE ;FUNCTION IS INTEGER
MOVE D,[PUSHJ P,SGNB##] ;CALL SIGN FUNCTION
JRST INLIOU
TIMBI: MOVSI D,(SETZ N,) ;TIM FUNCTION.
PUSHJ P,BUILDI
MOVE D,[RUNTIM N,]
PUSHJ P,BUILDI
MOVE D,[SUB N,BGNTIM]
PUSHJ P,BUILDI
MOVE D,[PUSHJ P,EIFLOT]
PUSHJ P,BUILDI
MOVE D,[FDVRI N,212764]
PUSHJ P,BUILDI
SETZM TYPE
JRST INLIO1
;ROUTINE TO XLATE ARGUMENTS
;RETURNS WITH ARGS ON SEXROL. B IS O IF ONE ARG, -1 IF TWO.
XARG: PUSHJ P,NXCHK ;SKIP PARENTHESIS.
PUSH P,LETSW ;SAVE LETSW WHILE TRANSL ARGS
MOVMS LETSW ;THE COMMA FOLLOWING AN ARG IS NOT LH(LET)!
PUSH P,F
PUSHJ P,XFORMB
JUMPL F,XARG0
XARG3: FAIL <? Nested string vectors>
XARG0: POP P,F
PUSHJ P,GPOSNX
PUSHJ P,SITGEN
PUSHJ P,PUSHPR
MOVEI B,0
TLNN C,F.COMA ;COMMA FOLLOWS?
JRST XARG1 ;NO. ONE ARG.
PUSHJ P,NXCHK ;YES GEN AND SAVE SECOND ARG
PUSH P,F
PUSHJ P,XFORMB
JUMPG F,XARG3
POP P,F
PUSHJ P,GPOSNX
PUSHJ P,SITGEN
PUSHJ P,PUSHPR
MOVNI B,1 ;DBL ARG FLAG
XARG1: POP P,LETSW ;RESTORE LETSW
TLNN C,F.RPRN ;MUST HAVE PARENTHESIS
JRST ERRPRN
JRST NXCHK ;IT DOES. SKIP PAREN AND RETURN.
;ROUTINE TO GEN ARGUMENTS
GENARG: JUMPE B,GENAFN ;ONE OR TWO ARGS?
GENAR0: PUSHJ P,POPPR ;TWO
PUSHJ P,EXCHG
PUSHJ P,GENAF1
GENAFN: PUSHJ P,POPPR
GENAF1: MOVSI D,(JUMP 2,)
SKIPGE TYPE ;REAL
TLZ D,100 ;NO, AC IS ZERO
JRST BUILDA
;ROUTINE TO ANALYZE NEXT ELEMENT
;CALL: PUSHJ P,REGLTR
;RETURNS ROLL PNTR IN B, CODE IN A
;CODE IS: 0-ARRAY, 1-SCALAR, 2-INTRINSIC FCN, 3-DEFINED FCN, 4-FAIL
; 5-STRING VECTOR, 6-STRING VARIABLE, 7-STRING LITERAL.
REGCLT: TLNN C,F.LETT ;CHECK THAT LETTER IS NEXT
JRST ERLETT ;IT WAS NOT
REGLTR: PUSHJ P,SCNLT1 ;LTR TO A, LEFT JUST 7 BIT
HRRI F,SCAROL ;ASSUME SCALAR
SETZM TYPE ;ASSUME REAL
TLNE C,F.LETT ;ANOTHER LETTER?
JRST REGFCN ;YES. GO LOOK FOR FCN REF
PUSHJ P,DIGIT ;ADD IN DIGIT IF ANY
PUSHJ P,DOLLAR ;STRING VARIABLE?
JRST REGSTR ;YES. REGISTER IT.
PUSHJ P,PERCNT ;CHECK FOR PERCENT
PUSHJ P,SETFNO ;MARK NUMERIC IF LEGAL
CAIN C,"("
JRST REGARY
;RETURN HERE IF REGARY SAYS NOT ARRAY
;RETURN HERE IF REGFCN SAYS FOLLOWED BY KEYWORD.
REGL1: TLNE A,1 ;IS THIS A SCALAR?
JRST REGL1A ;NO. DON'T LOOK FOR FCN ARGUMENT
MOVE B,FLARG ;IS THIS A FN ARG?
RELAB1: CAML B,CEARG ;SEARCH UNORDERED ARGROL
JRST REGL1A ;NOT A FN ARG
CAME A,(B)
AOJA B,RELAB1 ;TRY NEXT ROLL ENTRY.
JRST FARGRF ;YES
REGL1A: MOVEI R,VARROL ;NO. SCALAR
PUSHJ P,SEARCH ;IN VARIABLE ROLL?
JRST REGL2 ;NO
HRRZ D,(B) ;YES. GET PNTR TO SCAROL
JRST REGL3
REGL2: MOVEI E,1 ;ADD TO SCALAR ROLL OR VSPROL
PUSHJ P,OPENUP
ADD A,CEIL(F) ;COMPUTE PNTR TO ROLL
SUB A,FLOOR(F)
HRRZ D,A ;SAVE ROLL POINTER
MOVEM A,(B)
MOVEI R,(F) ;PUT NULL ENTRY ON ROLL
MOVEI A,0
PUSHJ P,RPUSH
; B ::= REL LOC OF ROLL ENTRY
REGL3: MOVE B,D ;B ::= REL LOC OF ROLL ENTRY
TLO B,(F) ;MAKE ROLL POINTER AND SKIP
JRST REGSCA
;COME HERE ON REF TO FCN ROL
;CALCULATE ADDRESS OF THIS FUNCTION ARGUMENT.
FARGRF: SUB B,CEARG ;NOW ADDRESS IS -NN FOR FIRST ARG, -1 FOR NNTH ARG, ETC
HRLI B,PSHROL
REGSCA: MOVEI A,1 ;CODE SAYS SCALAR
POPJ P, ;RETURN
SCAREG: HRRI F,SCAROL ;REGISTER THE CONTENTS OF A AS SCALAR
JRST REGL1A
STRREG: HRRI F,VSPROL ;REGISTER AS STRING
PUSHJ P,REGL1A
JRST REGS1 ;FIX TYPE CODE
REGARY: HRRI F,ARAROL ;NUMERICAL ARRAY GOES ON ARAROL.
REGA1: TLO A,1 ;MAKE ARRAY NAME DIFFERENT FROM SCALAR
MOVEI R,VARROL ;LOOK FOR VARIABLE NAME
PUSHJ P,SEARCH
JRST REGA2 ;NOT ALREADY USED
HRRZ D,(B) ;GET POINTER TO ARAROL
JRST REGA3 ;ALREADY USED
REGA2: MOVEI E,1 ;ADD NEW ARRAY NAME TO VARIABLE ROLL
PUSHJ P,OPENUP
ADD A,CEIL(F) ;COMPUTE ARRAY OR STRING VECTOR ROLL POINTER
SUB A,FLOOR(F)
ORI A,400000 ;SET ARRAY FLAG
MOVEM A,(B)
HRRZ D,A ;SAVE ARAROL POINTER
MOVEI R,(F) ;THREE ZEROS ON ARAROL (NULL ENTRY)
MOVEI A,0
PUSHJ P,RPUSH
PUSHJ P,RPUSH
PUSHJ P,RPUSH
REGA3: MOVE B,D ;RECONSTRUCT PNTR
ANDI B,377777 ;B := REL ADDRS IN ARRAY ROLL
HRLI B,(F) ;B := POINTER TO ENTRY ON ROLL
MOVEI A,0 ;ARRAY CODE
POPJ P,
;SUBROUTINE TO REGISTER ARRAY NAME.
;(USED BY DIM,MAT)
ARRAY: HRRI F,ARAROL ;ASSUME ITS NOT A STRING
TLNN C,F.LETT
JRST REGFAL
SETZM TYPE ;ASSUME REAL
PUSHJ P,SCNLT1 ;NAME TO A
PUSHJ P,DIGIT ;GET DIGIT IF ANY
PUSHJ P,DOLLAR ;DOLLAR ?
JRST ARRAY2 ;YES, HANDLE STRING
PUSHJ P,PERCNT ;PERCENT ?
ARRAY0: PUSHJ P,SETFNO ;MARK NUMERIC IF LEGAL
PUSHJ P,REGARY ;FINISH REGISTERING
ARRAY1: MOVE X1,B ;SET DEFAULT TO 2-DIM ARRAY
ADD X1,FLOOR(F)
SKIPN 1(X1)
SETOM 1(X1)
POPJ P,
ARRAY2: PUSHJ P,SETFST ;MARK STRING IF LEGAL
PUSHJ P,REGSVR ;REGISTER STRING VECTOR
JRST ARRAY1 ;SET DEFAULT, IF NECESSARY
VECTOR: PUSHJ P,ARRAY ;REGISTER VECTOR
CAIE A,5 ;WAS A STRING REGISTERED?
JUMPN A,CPOPJ ;WAS AN ARRAY REGISTERED?
MOVE X2,1(X1)
JUMPG X2,VELAB1 ;EXPLICIT DIMENSION?
MOVNI X2,2 ;NO. CALL IT A VECTOR OF UNKNOWN DIM.
MOVEM X2,1(X1)
POPJ P,
VELAB1: TLNE X2,777776 ;IS THIS A ROW VECTOR?
TRNN X2,777776 ;OR A COLUMN VECTOR?
POPJ P, ;YES.
FAIL <? Use vector, not matrix,>
REGSTR: PUSHJ P,SETFST ;MARK STRING IF LEGAL
HRRI F,VSPROL ;POINTER WILL GO ON VARIABLE SPACE ROLL
CAIN C,"(" ;IS IT A STRING VECTOR?
JRST REGSVR ;YES.
PUSHJ P,REGL1 ;REGISTER STRING.
JRST REGS1 ;FIX VARIABLE TYPE CODE.
REGSLT: MOVMS LETSW ;STR LIT.
PUSHJ P,SETFST ;MARK STRING IF LEGAL
PUSHJ P,NXCHD
PUSH P,C
PUSH P,T
SETZ A,
REGSL1: TLNE C,F.QUOT ;COUNT CHARACTERS.
JRST REGSL2
TLZN C,F.CR ;<CR> OR <LF> ?
JRST RGSLX1 ;NO
CAIN C,12 ;<LF> ?
SOSA A ;YES, IGNORE
JRST GRONK ;NO
RGSLX1:
PUSHJ P,NXCHD
AOJA A,REGSL1
REGSL2: MOVEI E,4(A)
MOVN A,A
HRLI A,(A)
MOVE T,CESLT
SUB T,FLSLT
HRRI A,(T)
MOVEI R,LITROL
PUSH P,E
PUSHJ P,RPUSH ;PUSH POINTER ONTO LITERAL ROLL
POP P,E
IDIVI E,5
JUMPE E,REGSL3
MOVEI R,SLTROL ;SET UP SLTROL.
PUSHJ P,BUMPRL
REGSL3: POP P,T
POP P,C
TLZ C,777777
HRLI B,440700
REGSL4: CAIN C,42
JRST REGSL5
CAIE C,12 ;SKIP <LF>
IDPB C,B
ILDB C,T
JRST REGSL4
REGSL5: PUSHJ P,NXCH
MOVEI R,SADROL ;MOVE LITROL ADDRESS ON STR-LIT-ADR ROLL
MOVEI A,0
PUSHJ P,RPUSH
SUB B,FLSAD ;GET REL ADRESS
HRLI B,SADROL ;SET UP POINTER.
MOVEI A,7
JRST SNOEXI
REGSVR: HRRI F,SVRROL ;REGISTER STRING VECTOR
PUSHJ P,REGA1 ;REGISTER AS AN ARRAY
REGS1: CAIE A,4 ;DID REGISTRATION FAIL?
ADDI A,5 ;NO. FIX TYPE CODE.
POPJ P,
DIGIT: TLNN C,F.DIG ;DIGIT FOLLOWS ?
POPJ P, ;NO
DPB C,[POINT 7,A,13] ;YES, STORE IT
JRST NXCH ;AND SKIP IT
DOLLAR: TLNN C,F.DOLL ;IS IT A $ ?
AOSA (P) ;NO, SKIP
TLOA A,10 ;YES, MARK IT
POPJ P, ;RETURN
SETZM TYPE
JRST NXCHK ;GOBBLE IT
PERCNT: SETZM TYPE ;ASSUME REAL
CAME C,[XWD F.STR,"%"] ;IS IT A PERCENT?
POPJ P, ;RETURN
SETOM TYPE ;MARK AS INTEGER
TLO A,4 ;YES, MARK IT
SETOM PFLAG
JRST NXCHK ;NEXT CHARACTER
;NOTE: IF THE SAME VARIABLE NAME IS USED AS A SCALAR, ARRAY,
; STRING VECTOR, AND STRING, IT WILL BE DISTINGUISHED IN "VARROL"
; BY THE FOLLOWING 4-BIT ENDINGS:
; SCALAR 0; ARRAY 1; STRING 10; STRING VECTOR 11.
;TABLE OF MIDSTATEMENT KEYWORDS:
KWTBL:
KWAALL:
KWACIF: ;COMBINED IF KEYWORDS
ASCIZ /AND/
ASCIZ /OR/
ASCIZ /IOR/
ASCIZ /XOR/
ASCIZ /EQV/
ASCIZ /IMP/
KWZCIF:
KWADIF: ASCIZ /THEN/
ASCIZ /GOTO/
KWAAMD: ;ALL POSSIBLE MODIFIERS
ASCIZ /ELSE/
KWAFOR: ;FOR STMT KEYWORDS
ASCIZ /TO/
ASCIZ /STEP/
ASCIZ /BY/
KWAMOD: ;MODIFIER KEYWORDS
ASCIZ /WHILE/
ASCIZ /UNTIL/
KWZFOR: ;END OF FOR KEYWORDS
ASCIZ /IF/
ASCIZ /UNLESS/
ASCIZ /FOR/
KWZMOD:
ASCIZ /USING/
KWAONG:
ASCIZ /GOSUB/
KWZAMD:
KWZALL:
KWTTOP:
;GENERATE SERVICE ROUTINE FOR VARIOUS KEYWORD SEARCHES
DEFINE KWSBEG(U)
< IRP U
<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
ASCIZ /IFOR/ ;I FOR THERE ?
POPJ P, ;NO, ALL'S WELL
POP P,X2 ;YES, RECTIFY PDL
JRST KWDSR3 ;AND IGNORE IT
;REGISTER FUNCTION NAME
;FIRST LETTER HAS BEEN SCANNED
;IT IS POSSIBLE THAT WE HAVE SCANNED A ONE-LETTER VARIABLE NAME
;FOLLOWED BY ONE OF THE KEYWORDS "TO" , "THEN", OR "STEP".
;FIRST WE LOOK AHEAD TO SEE IF THIS IS SO;
;IF IT IS WE GO BACK TO SCALAR CODE.
REGFCN:
PUSHJ P,KWSALL ;LOOK FOR KEYWORDS
JRST REGFX1 ;NONE FOUND
PUSHJ P,SETFNO ;MARK NUMERIC IF LEGAL
JRST REGL1
REGFX1:
;HAVE DETERMINED THAT WE MUST BE SCANNING A FUNCTION NAME
;IF SYNTAX IS LEGAL.
;WE SCAN THE SECOND LETTER AND CHECK FOR
;INTRINSIC OR DEFINED FUNCTION.
PUSHJ P,SCNLT2
JRST REGFAL ;NOT A LETTER
CAMN A,[SIXBIT /FN/] ;DEFINED FUNCTION?
JRST REGDFN ;YES. GO REGISTER DEFINED NAME.
;HERE WE HAVE FN NAME NOT BEGINNING WITH "FN"
;LOOK FOR IT IN TABLE OF INTRINSIC FUNCTIONS.
MOVE X1,[POINT 6,A,11] ;CONSTRUCT WHOLE NAME.
MOVEI R,4
REGF4: TLNN C,F.LETT
JRST REGF5
REGF41:
PUSHJ P,KWSALL ;LOOK FOR KEYWORDS
CAIA ;NONE
JRST REGF9 ;FOUND
TLNN C,F.LCAS
TRC C,40
IDPB C,X1
PUSHJ P,NXCH
SOJG R,REGF4
REGF9: PUSHJ P,SETFNO ;MARK NUMERIC IF LEGAL
JRST REGF6
REGF5: TLNN C,F.DIG
JRST REGF51
CAME A,[SIXBIT/LOG /]
CAMN A,[SIXBIT/LOG1 /]
JRST REGF41
REGF51: TLNN C,F.DOLL
JRST REGF9
PUSH P,X1
PUSHJ P,CHKCOR ;CHECK CORE REQUIREMENTS
POP P,X1
REGF10: MOVEI C,4 ;$ IN SIXBIT.
IDPB C,X1
PUSHJ P,NXCH
PUSHJ P,SETFST ;MARK STRING IF LEGAL
REGF6: CAMN A,[SIXBIT/VAL /]
PUSHJ P,CHKCOR ;CHECK CORE REQUIREMENTS
REGF0: MOVEI R,IFNFLO
REGF7: CAMN A,(R)
JRST REGF8 ;FOUND FN.
AOJ R,RGLAB1
RGLAB1: CAIGE R,IFNCEI
JRST REGF7
JRST REGFAL
REGF8: SUBI R,IFNFLO
MOVE B,IF2FLO(R) ;GET ENTRY IN 2ND TABLE.
MOVMS LETSW ;CAN'T BE LH(LET)
MOVEI A,2 ;INTRINSIC FCN CODE.
POPJ P, ;RETURN "XINFCN" DOES ITS OWN ")" CHECK.
;HERE TO REGISTER DEFINED FUNCTION NAME
;THE "FN" HAS ALREADY BEEN SCANNED
;SCAN IDENTIFYING LETTER AND PUTTING ENTRY IN
;FUNCTION CALL ROLL
REGDFN: PUSHJ P,CHKCOR ;CHECK CORE REQUIREMENTS
REGDF0: PUSHJ P,SCNLT1 ;PUT FUNCTION NAME IN A
PUSHJ P,DIGIT ;CHECK FOR A DIGIT
PUSHJ P,PERCNT ;CHECK FOR A PERCENT
TLNE A,4 ;NO DOLLAR POSSIBLE IF PERCENT
JRST REGDF1
PUSHJ P,DOLLAR ;DOLLAR THERE ?
PUSHJ P,[AOS (P) ;YES
JRST SETFST] ;REGISTER STRING IF LEGAL
REGDF1: PUSHJ P,SETFNO ;MARK NUMERIC IF LEGAL
CAMN A,FUNAME ;IS THIS THE NAME OF THE CURRENT MULTI-LINE FN?
JRST REGFNA ;YES. REGISTER IT AS A SCALAR
MOVE D,A ;NO, REAL FUNCTION CALL. SAVE NAME FOR ARGCHK
MOVMS LETSW
MOVEI R,FCLROL ;FUNCTION CALL ROLL
PUSHJ P,SEARCH ;USED THIS ONE YET?
CAIA
JRST REGFC1 ;ALREADY SEEN A REF
MOVEI E,1
PUSHJ P,OPENUP
MOVEM A,(B)
PUSHJ P,REGFC1 ;SET B UP FOR KLUDGE TEST
MOVE X1,FLSEX ;FIX UP SAVED FCN REFS
REGFC0: CAML X1,CESEX ;KLUDGE!!!
JRST REGFC1+1
HLRZ X2,(X1) ;GET THE ROLL NUMBER
CAIN X2,FCLROL ;FCLROL?
CAMLE B,(X1) ;YES. IS SEXREF NOW WRONG?
AOJA X1,REGFC0 ;NO
AOS (X1) ;YES. CORRECT IT
AOJA X1,REGFC0
REGFC1: SUB B,FLFCL
HRLI B,FCLROL
MOVEI A,3 ;DEFINED FCN CODE
POPJ P, ;DON'T CHECK FOR () YET
CHKPRN: CAIE C,"("
REGFAL: MOVEI A,4 ;FAIL IF NO PAREN
POPJ P,
REGFNA: TLO A,2 ;CREATE SPECIAL NAME FOR CURRENT FUNC.
SKIPGE F ;NUMERIC ?
JRST SCAREG ;REGISTER IT AS A SCALAR
JRST STRREG ;NO, REGISTER AS STRING
SUBTTL SUBROUTINES USED BY GEN ROUTINES
;SETFNO - SET PARTIAL RESULT NUMERIC IF LEGAL
SETFNO: SKIPGE F ;RETURN IF NUMERIC ALREADY
POPJ P,
TLOE F,-1 ;SET NUMERIC, ANY OTHER BITS SET ?
SETFER: FAIL <? Mixed strings and numbers>
POPJ P,
;SETFST - SET PARTIAL RESULT STRING IF LEGAL
SETFST: JUMPL F,SETFER ;HARD LUCK, NUMERIC SPECIFIED
HRLI F,1 ;SET STRING
SETZM TYPE
POPJ P,
;PUSHPR - PUSH PARTIAL RESULT ON SEXROL
PUSHPR: MOVEI R,SEXROL
MOVE A,B ;SAVE POINTER IN A
SKIPE TYPE ;REAL OR INTEGER
TLO A,100000 ;INTEGER
PUSHJ P,RPUSH
SUB B,FLSEX ;MAKE POINTER
TLZ A,100000 ;
TLNN A,ROLMSK ;IS IT A POINTER TO REG?
HRROM B,REGPNT ;YES, SET POINTER FOR SITGEN TO USE
POPJ P,
;POPPR - POP PARTIAL RESULT FROM SEXROL
POPPR: MOVEI R,SEXROL
MOVE B,CESEX
SUBI B,1 ;COMPUTE ADDRS OF TOP OF SEXROL
PUSH P,(B) ;SAVE THE CONTENT
MOVEI E,1
PUSHJ P,CLOSUP
POP P,B ;POPPED POINTER TO B
CLEARM TYPE ;
TLZE B,100000 ;
SETOM TYPE ;
POPPFN: TLNN B,ROLMSK ;POINTER TO REG?
SETZM REGPNT ;YES. CLEAR MEMORY
POPJ P,
;EXCHG - EXCHANGE CURRENT PNTR WITH TOP OF SEXROL
EXCHG: MOVE X1,CESEX
MOVEI X2,-1(X1) ;FIX PNTR IF REG SAVED
SUB X2,FLSEX
TLNN B,ROLMSK
HRROM X2,REGPNT
SKIPGE TYPE ;IS IT AN INTEGER
TLO B,100000 ;YES MARK IT
EXCH B,-1(X1)
CLEARM TYPE ;ASSUME REAL
TLZE B,100000 ;IS IT AN INTEGER?
SETOM TYPE ;YES, SET THE TYPE
JRST POPPFN ;GO FIX PNTR IF REG POPPED
;REGFRE - GUARANTEE THAT NO PART RESULT IS IN REG
REGFRE: SKIPN REGPNT ;SUBEXP IN THE REG?
POPJ P, ;NO
MOVE X1,FLSEX ;YES. COMPUTE WHERE
ADD X1,REGPNT
EXCH B,(X1) ;GET THE POINTER, SAVE CURR PNTR
PUSH P,TYPE ;SAVE THE TYPE
CLEARM TYPE ;ASSUME REAL
TLZE B,100000 ;IS IT INTEGER
SETOM TYPE ;YES, REMEMBER IT
PUSHJ P,SITGEN ;STORE IN TEMP
MOVE X1,FLSEX ;RECOMPUTE LOC IN SEXROL
ADD X1,REGPNT
SKIPGE TYPE ;IS IT INTEGER
TLO B,100000 ;YES, MARK IT
POP P,TYPE ;RESTORE OLD TYPE
EXCH B,(X1)
SETZM REGPNT ;CLOBBER REGPNT SINCE REG IS EMPTY
POPJ P,
;GPOSGE - GUARANTEE POSITIVE GEN
GPOSGE: JUMPGE B,CPOPJ ;RETURN IF ALREADY POSITIVE
;FALL INTO EIRGEN
;EIRGEN - EXP IN REG GEN
EIRGEN: TLNN B,ROLMSK ;ALREADY IN REG?
POPJ P, ;DO NOTHING
ERGNFN: PUSHJ P,REGFRE ;FREE UP REG
MOVSI D,(MOVE N,) ;GET MOVE INSTR
EIRGM2: PUSHJ P,BUILDS ;BUILD MOVE INSTR
CLEAR B,
POPJ P,
;EIRGNP - EXP IN REG GEN POSITIVE
EIRGNP: JUMPGE B,EIRGEN ;POSITIVE?
EIRGP1: TLNE B,ROLMSK ;NO. IN REG?
JRST ERGNFN ;NO. GO MOVE
MOVSI D,(MOVN N,) ;YES,NEGATIVE N
EIRGM3: PUSHJ P,BUILDI
CLEAR B,
POPJ P,
;EIRGNM -- GEN MAG.
EIRGNM: TLNN B,ROLMSK
JRST EIRGM1
TLZ B,400000
PUSHJ P,REGFRE
MOVSI D,(MOVM N,)
JRST EIRGM2
EIRGM1: MOVSI D,(MOVM N,)
JRST EIRGM3
;SIPGEN - STORE IN PERMANENT TEM GEN
SIPGEN: MOVEI R,PTMROL
JRST SITGN1
;SITGEN - STORE IN TEMP GEN
SITGEN: MOVEI R,TMPROL
SITGN1: TLNE B,ROLMSK ;IS EXPR IN REG?
POPJ P, ;NO. DONT DO ANYTHING
MOVEI A,0 ;PREPARE ZERO TO PUSH ON ROLL
MOVSI D,(MOVEM N,) ;GET CORRECT INSTR
JUMPGE B,STLAB1
MOVSI D,(MOVNM N,)
STLAB1: CAIE R,TMPROL ;STORE ON TMPROL?
JRST SITG2 ;NO. USE PTMROL
AOS B,TMPPNT ;WHICH TEMP TO USE?
MOVE X1,FLTMP
ADD X1,B
CAML X1,CETMP ;NEED MORE TMP SPACE?
PUSHJ P,RPUSH ;YES. PUSH A ZERO ONTO TMPROL
MOVE B,TMPPNT ;CONSTRUCT TMP ROLL POINTER
SITG1: HRLI B,(R)
PUSH P,B ;SAVE ADRESS POINTER
PUSHJ P,BUILDA ;BUILD STORE INSTR
POP P,B ;RECONSTRUCT POINTER
POPJ P,
SITG2: PUSHJ P,RPUSH ;PUSH A ZERO ONTO PTMROL
SUB B,FLPTM
JRST SITG1 ;FINISH CONSTRUCTING ADRESS POINTER
;GPOSNX - GUARANTEE POSITIVE AND UNINDEXED GEN
GPOSNX: TLNE B,400000+PSHROL ;NEGATIVE OR INDEXED BY (P)?
PUSHJ P,EIRGNP ;YES. FORCE INTO REG
POPJ P,
BUILDP: TLO D,Q ;INSTRUCTION IS INDEXED BY PLIST POINTER
SUB B,PSHPNT ;ADJUST THE ADDRESS FOR ANY PUSH INSTS GENNED BY
ADDI B,1
HRR D,B ;A CURRENT FN CALL
;ROUTINE TO ADD CODE TO CODROL.
;A WORD IS ASSUMED IN D
;RETURN REL ADDRS IN B
BUILDI: SKIPN RUNFLA ;ARE WE GOING TO RUN?
POPJ P, ;NO, JUST RETURN
MOVEI E,1
MOVEI R,CODROL
PUSHJ P,BUMPRL
MOVEM D,(B)
SUB B,FLCOD
POPJ P,
;BUILD SIGNED INSTRUCTION WITH ADDRESS
;CHECK SIGN IN B AND CHANGE UP CODE BITS
BUILDS: JUMPGE B,BUILDA ;POSITIVE?
TLC D,010000 ;NO. CHANGE MOVE TO MOVN,ETC.
;FALL INTO BUILDA
;BUILDA - BUILD INSTRUCTION WITH LINKED ADDRESS
;INSTRUCTION SKELETON IS IN D, ADDRESS POINTER IS IN B
BUILDA: SKIPN RUNFLA ;ARE WE GOING TO RUN?
POPJ P, ;NO. DONT BUILD
TLZE B,PSHROL ;SPECIAL TEST FOR ROLL WITH ABSOLUTE ADDRESSES
JRST BUILDP ;YES, PSHROL. DO BUILDI INDEXED BY (Q)
TLZ B,400000
JUMPE B,BUILDI ;ITEM IS IN REG . USE ADDRESS ZERO
PUSH P,B ;SAVE THE POINTER
PUSHJ P,BUILDI ;ADD INSTR WITH 0 ADDRS TO CODE
MOVE X1,CECOD ;LOC+1 OF THE INSTR
POP P,X2 ;COMPUTE ADDRS LOCATION
LDB R,[POINT 17,X2,17]
ADD X2,FLOOR(R)
MOVE R,(X2) ;GET NEXT ADDRS IN CHAIN
HRRM R,-1(X1) ;STORE IT IN THE INSTR
SUB X1,FLCOD
SUBI X1,1
HRRM X1,(X2) ;STORE CURR ADDRS IN ROLL PNTD TO
POPJ P,
SUBTTL UTILITY SUBROUTINES
;ROUTINE TO QSA FOR "THEN" OR "GOTO" (USED IN "IF", "ON" STATEMENTS)
THENGO: PUSHJ P,QSA
ASCIZ /THE/
JRST THGOTS
MOVEM T,MULLIN ;SET MULTI-LINE
PUSHJ P,QSA
ASCIZ /N/
JRST THGERR ;BAD SPELLING??
TLNE C,F.TERM
JRST THGERR ;SHOULD BE SOMETHING
POPJ P,
THGOTS: PUSHJ P,QSA
ASCIZ /GOTO/
THGERR: FAIL <? THEN or GO TO were expected>
TLNE C,F.DIG ;DIGIT FOLLOWS ?
POPJ P, ;
ERDIGQ: PUSHJ P,FALCHR
ASCIZ /a digit or "/
;ERROR RETURNS
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 /"/
ERTERM: PUSHJ P,FALCHR
ASCIZ /a line terminator or '/
ERLETT: PUSHJ P,FALCHR
ASCIZ /a letter/
ERLPRN: PUSHJ P,FALCHR
ASCIZ /(/
ERRPRN: PUSHJ P,FALCHR
ASCIZ /)/
EREQAL: PUSHJ P,FALCHR
ASCIZ /=/
ERCOMA: PUSHJ P,FALCHR
ASCIZ /,/
ERSCCM: PUSHJ P,FALCHR
ASCIZ /; or ,/
ERCLCM: PUSHJ P,FALCHR
ASCIZ /: or ,/
FALCHR: PUSH P,C
SKIPN RUNFLA
JRST FAL1
PUSHJ P,INLMES
ASCIZ /
/
FAL1: PUSHJ P,INLMES
ASCIZ /? /
POP P,C
MOVEI C,(C)
CAIE C,11
CAIN C,40
JRST FALSPT
CAIL C,12
CAILE C,15
CAIA
JRST FALFF
CAIL C,41
CAILE C,172
JRST FALNON
PUSHJ P,OUCH
JRST FAL2
FALNON: PUSHJ P,INLMES
ASCIZ /A non-printing character/
JRST FAL2
FALFF: PUSHJ P,INLMES
ASCIZ /A FF,LF,VT, or CR/
JRST FAL2
FALSPT: PUSHJ P,INLMES
ASCIZ /A space or tab/
FAL2: PUSHJ P,INLMES
ASCIZ / was seen where /
MOVE T,(P)
PUSH P,ODF
SETZM ODF
SETZ D,
PUSHJ P,PRINT ;PRINT EXPECTED CHAR OR MESSAGE.
POP P,ODF
SETZM HPOS
POP P,T ;CLEAN UP PLIST.
PUSHJ P,INLMES
ASCIZ / was expected/
PUSHJ P,FAIL2
JRST NXTST1
;COMPILATION ERROR MESSAGES FROM FAIL UUOS.
FAILER: SKIPN RUNFLA ;IS THIS THE FIRST ERROR IN COMPILATION?
JRST FAIL0 ;NO.
PUSHJ P,INLMES ;YES. SETUP <CRLF> TO FOLLOW HEADING.
ASCIZ /
/
FAIL0: PUSHJ P,FAIL1
JRST NXTST1
FAIL1: MOVE T,40
FAILR: MOVEI D,0
PUSHJ P,PRINT
LDB X1,[POINT 4,40,12] ;IS AC FIELD NONZERO?
JUMPE X1,FAIL2
MOVE T,N ;ATTACH NUMBER IN 'N' TO MSG
PUSHJ P,PRTNUM
FAIL2: PUSHJ P,INLMES
ASCIZ / in line /
MOVE T,L
ADD T,FLLIN
HLRZ T,(T)
PUSHJ P,PRTNUM
SKIPE CHAFL2 ;CHAINING?
PUSHJ P,ERRMS3
PUSHJ P,INLMES
ASCIZ /
/
SETZM RUNFLA
SETZM MULLIN ;DELETE MULTI-LINE
POPJ P,
;GET NEXT CHAR, BUT CHECK FOR ILLEGAL CHARS (CHARS THAT COULD ONLY BE IN A STRING)
NXCHK: PUSHJ P,NXCH
TLNE C,F.STR
FAIL <? Illegal character>
POPJ P,
;QUOTE SCAN OR FAIL
;CALL WITH INLINE PATTERN
;GO TO GRONK IF NO MATCH
QSF: POP P,X1
PUSHJ P,QST
JRST GRONK
JRST 1(X1)
;ROUTINES TO GENERATE CODE FOR THE CHANNEL SPECIFIER.
GETCNB: PUSHJ P,NXCH
GETCNC: PUSHJ P,GETCN2
CHKDL1: TLNN C,F.COMA
CAIN C,":"
PJRST NXCH
JRST ERCLCM
GETCN0: PUSHJ P,XFORMN
PUSHJ P,EIRGNP
PUSHJ P,CHKINT ;NEED AN INTEGER
MOVSI D,(CAILE N,)
PUSHJ P,BUILDI
HRRI D,9
PUSHJ P,BUILDI
MOVE D,[JRST CNER1]
JRST BUILDI
GETCNA: PUSHJ P,NXCH
GETCN2: PUSHJ P,GETCN0
MOVE D,[MOVE LP,N]
JRST BUILDI
CHKDEL: TLNN C,F.COMA
CAIN C,";"
PJRST NXCH
JRST NXTSTA
GENTYP: HRLI D,(SKIPN (16))
PUSHJ P,BUILDI
HRLI D,(SETOM (16))
SKIPN WRREFL
HRLI D,(AOS (16))
PUSHJ P,BUILDI
HRLI D,(SKIPL (16))
SKIPN WRREFL
HRLI D,(SKIPG (16))
PJRST BUILDI
GENTP1: CAIN C,":"
PUSHJ P,NXCH
PUSHJ P,GETCNC
MOVE D,[SKIPL ACTBL-1(LP)]
PUSHJ P,BUILDI
MOVE D,[JRST FNMXER]
PJRST BUILDI
CHKCOR: SKIPGE VRFSET
CHKCR1: SKIPE FUNAME
POPJ P,
CLEARM VRFSET
MOVE D,[PUSHJ P,SETCOR]
PJRST BUILDI
MASCHK: PUSHJ P,XFORMS ;GEN STRING EXPRESSION IN REG
PUSHJ P,EIRGNP ;CHECK REG
MASCK1: MOVE D,[PUSHJ P,MASTST]
PUSHJ P,BUILDI
MOVE D,[AOS T,MASAPP] ;
PUSHJ P,BUILDI
MOVE D,[MOVEM N,(T)]
PJRST BUILDI
CMIXM: MOVE X1,CESEX ;PEEK AT FIRST OPERAND
MOVE X2,-1(X1) ;ITS ADDRESS
SKIPL TYPE ;
JRST CMIXM2 ;NO, CHECK SECOND OPERAND
TLZE X2,100000 ;IS SECOND OPERAND INTEGER?
POPJ P, ;YES, NO CONVERSION
TLNE X2,ROLMSK ;IS THE REGISTER FREE
JRST CMIXM1 ;YES, USE IT
CMIXM3: PUSH P,B ;SAVE B
PUSHJ P,REGFRE ;FREE THE REGISTER
POP P,B ;GIVE US B
CMIXM1: PUSHJ P,EIRGEN ;GET THE OPERAND
SETZM TYPE ;MAKE TYPE REAL
PUSH P,B ;SAVE SIGN INFO
MOVE D,[PUSHJ P,FLTPNT] ;
PUSHJ P,BUILDI ;MUST FLOAT IT
POP P,B ;RETURN SIGN INFO
AND D,[XWD MINFLG,0] ;JUST RETURN SIGN
POPJ P, ;AND RETURN
CMIXM2: TLZN X2,100000 ;IS SECOND OPERAND INTEGER
POPJ P, ;YES, NOTHING TO DO
TLNN B,ROLMSK ;IS REGISTER FREE
PUSHJ P,SITGEN ;STORE IT IN TEMP
SETOM MIXFLG ;MARK A MIX MADE
PUSHJ P,EXCHG ;EXCHANGE REGISTERS
JRST CMIXM1 ;NOW FLOAT IT
CMIXER: MOVE X1,TYPE ;GET THE TYPE
CAMN X1,FTYPE ;A MATCH?
POPJ P, ;YES, RETURN
CHKTYP: MOVE D,[PUSHJ P,FIXPNT]
SKIPL FTYPE ;
HRRI D,FLTPNT ;
PJRST BUILDI ;
CHKINN: PUSHJ P,EIRGNP
CAIA
CHKINT: PUSHJ P,EIRGEN
CHKIN1: SKIPGE TYPE ;IS IT AN INTEGER?
JRST CHKIN2 ;YES, NOTHING TO DO
GENINT: MOVE D,[PUSHJ P,FIXPNT] ;NO, FIX IT
PUSHJ P,BUILDI ;OUT WITH IT
SETOM TYPE ;SET TYPE TO INTEGER
CHKIN2: CLEAR B, ;CLEAR B
POPJ P, ;RETURN
;ROUTINE TO START READING NEXT LINE OF PROGRAM
NXLINE: MOVE T,FLLIN
ADDI T,(L)
MOVE T,(T)
MOVS D,T ;SAVE LINE START
HRLI T,440700
MOVE G,FLREF ;SETUP REFROL REFERENCE.
ADDI G,(L)
JRST NXCH
PRTNUM: IDIVI T,^D10
JUMPE T,PRTN1
PUSH P,T1
PUSHJ P,PRTNUM
POP P,T1
PRTN1: MOVEI C,60(T1)
AOS NUMCOT
JRST OUCH
END