Trailing-Edge
-
PDP-10 Archives
-
decuslib10-10
-
43,50516/basddt.mac
There are no other files named basddt.mac in the archive.
TITLE BASDDT
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 .JBINT
TRPLOC
LOC .JBVER
BYTE (3)VWHO(9)VBASIC(6)VMINOR(18)VEDIT
LOC .JB41
JSR UUOH
RELOC
HISEG
EXTERN ERR,ERL,ERRGO,ERRCNT,LINADR,ERLB,ERRB
EXTERN TYPE,FTYPE,PFLAG,AFLAG,INLNFG
EXTERN FLTPNT,FIXPNT
EXTERN EXP1.0,EXP2.0
EXTERN ACTBL,APPEND,ARAROL,ARATOP,ARGROL,ASCIIB,ATANB,BGNTIM
EXTERN BLOCK,CADROL,CATFLG,CEARG,CECAD,CECOD,CECON,CEFCL
EXTERN CEFOR,CEGSB,CEIL,CELAD,CELIN,CELIT,CENTRY,CENXT
EXTERN CEPTM,CESAD,CESEX,CESLT,CESTM,CESVR,CETMP,CEVSP
EXTERN CHAERR,CHAFL2,CHAFLG,CHAHAN,CHAXIT,CHKIMG,CHRB
EXTERN CLOGB,CLSFIL,CNER1,CODROL,COMTIM,COMTOP,CONROL,CORINC
EXTERN COSB,COTB,CRLF,CRTVAL,DATAFF,DATEB,DAYB,DETER,DEVBAS,DOINPT
EXTERN DOREAD,D1E14,D1EM18,DECTAB,ECHOB,LIBFLG
EXTERN EIFLOT,ELSEAD,ELSFLG,ENDIMG,EOF,EXECUT,EXP3.0,EXPB,EXTD
EXTERN FADROL,FCLROL,FCNROL,FILCNT,FILD,FILDIR,FILTYP,FPPN
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,LEFTB,LENB,LETSW,LEXECT,LINEB
EXTERN LINROL,LITROL,LOCLOF,LOGB,LOGNEG,LSAVE,LUXIT
EXTERN MARERR,MARGAL,MARGIN,MARGN,MASAPP,MASTST,MIDB,MINFLG,MTIME
EXTERN MULLIN,NEWOL1,NOTLIN,NUMCOT,NUMRES,ODF,IFIFG,OLDCOD
EXTERN ONCESW,ONGFLG,OPNFIL,OPNFLG,OUTSET,PAGE,PAGEAL
EXTERN PAGLIM,PAKFLG,PIB,PLIST,POINT,POSB,PRDLER,PRTNUM,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,TIMEB,TMPLOW
EXTERN THNCNT,THNELS
EXTERN TMPPNT,TMPROL,TOPSTG,TRNFL2,TRNFLG,TRPLOC,TRUTH,TTYPAG
EXTERN UUOH,VALB,VARFRE,VARROL,VPAKFL,VRFBOT,VRFSET
EXTERN VRFTOP,VSPROL,WRIPRI,WRPRER,WRREFL,XCTON,XRES
EXTERN .JBFF,.JBREL,.JBSA
EXTERN PLTIN,PLTOUT
; VIRTUAL ARRAY LOW SEGMENT EXTERNALS
EXTERN FLVIR,CEVIR,VIRROL,VIRDIM,VIRSIZ
EXTERN LBASIC,UXIT
BASIC=LBASIC
EUXIT=UXIT
;****** EXTERNALS FROM BASLIB (COMLIB)
EXTERN CPOPJ,CPOPJ1,DATCHK,ERACOM
EXTERN ERRMS3,FILNAM,FILNMO,GETNU,GOSR2
EXTERN GETNUM,INLINE,INLMES,LOCKOF,LOCKON,NXCH,NXCHD
EXTERN OUCH,PRINT,PRNNAM,QSA,QST
EXTERN SCNLTN,SEARCH,TTYIN
;****** END EXTERNALS FROM BASLIB (COMLIB)
EXTERN DDCODE,DDSTRT,DDTFLG,RUNDDT,.USREL,.DDREL,.DDFF,.DDSA
EXTERN .DDTMP,DDTCOD,CETXT,FLTXT,PAKFLA,ROLTOP,CEDON
EXTERN CEFAD,FLFAD,CEREF,FLDON,DERRGO,NOLINE
EXTERN DPTROL,DTPROL,FLDPT,FLDTP,CEDPT,CEDTP
EXTERN DLTROL,FLDLT,CEDLT,DITROL,FLDIT,CEDIT
EXTERN STMROL,DONROL,FLVAR,CEVAR,CESCA
EXTERN DDTERR,ONGADR,FIXCON,GOSBER
INTERN DDTGO,DPANIC
DEFINE FAIL (A,AC)<
XLIST
JRST [PUSHJ P,INLMES
ASCIZ \A\
IFN AC,< MOVE T,N
PUSHJ P,PRTNUM>
JRST NXTST3]
LIST
>
DEFINE ERROM(A,B)
< ASCIZ B>
%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
DDTFLO:
Z XBAS-400000+600000(SIXBIT/ BAS/)
Z XCHAN-400000+200000(SIXBIT/ CHA/)
Z XCLOSE-400000+600000(SIXBIT/ CLO/)
Z XCONT-400000(SIXBIT/ CON/)
Z XDEC-400000(SIXBIT/ DEC/)
Z XELSE-400000+200000(SIXBIT/ ELS/)
Z XEND-400000+200000(SIXBIT/ END/)
Z XFOR-400000+200000(SIXBIT/ FOR/)
Z XGOSUB-400000+600000(SIXBIT/ GOS/)
Z XGOTO-400000+600000(SIXBIT/ GOT/)
Z XIF-400000+200000(SIXBIT/ IF /)
Z XINPUT-400000+600000(SIXBIT/ INP/)
Z XLET-400000+200000(SIXBIT/ LET/)
Z XLIST-400000(SIXBIT/ LIS/)
Z XMAR-400000+600000(SIXBIT/ MAR/)
Z XMAT-400000+200000(SIXBIT/ MAT/)
Z XNEXT-400000+600000(SIXBIT/ NEX/)
Z XNOP-400000+600000(SIXBIT/ NOP/)
Z XNOQ-400000+600000(SIXBIT/ NOQ/)
Z XON-400000+200000(SIXBIT/ ON /)
Z XOPEN-400000+600000(SIXBIT/ OPE/)
Z XPAG-400000+600000(SIXBIT/ PAG/)
Z XPRINT-400000+600000(SIXBIT/ PRI/)
Z XQUO-400000+600000(SIXBIT/ QUO/)
Z XRAN-400000+600000(SIXBIT/ RAN/)
Z XREAD-400000+600000(SIXBIT/ REA/)
Z XREM-400000(SIXBIT/ REM/)
Z XREST-400000+200000(SIXBIT/ RES/)
Z XSCRAT-400000+600000(SIXBIT/ SCR/)
Z XSET-400000+200000(SIXBIT/ SET/)
Z XSTART-400000(SIXBIT/ STA/)
Z XSTOP-400000(SIXBIT/ STO/)
Z XUNTIL-400000+600000(SIXBIT/ UNT/)
Z XWHILE-400000+600000(SIXBIT/ WHI/)
Z XWRIT-400000+600000(SIXBIT/ WRI/)
DDTCEI:
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) <
XLIST
<SIXBIT /X/>
LIST
>
IFNFLO:
ZZZ. (ABS)
ZZZ. (ASC)
ZZZ. (ASCII)
ZZZ. (ATN)
ZZZ. (CHR$)
ZZZ. (CLOG)
ZZZ. (COS)
ZZZ. (COT)
ZZZ. (CRT)
ZZZ. (DATE$)
ZZZ. (DAY$)
ZZZ. (DET)
ZZZ. (ECHO)
ZZZ. (ERL)
ZZZ. (ERR)
ZZZ. (EXP)
ZZZ. (FIX)
ZZZ. (FLOAT)
ZZZ. (INSTR)
ZZZ. (INT)
ZZZ. (LEFT$)
ZZZ. (LEN)
ZZZ. (LINE)
ZZZ. (LL)
ZZZ. (LN)
ZZZ. (LOC)
ZZZ. (LOF)
ZZZ. (LOG)
ZZZ. (LOGE)
ZZZ. (LOG10)
ZZZ. (MID$)
ZZZ. (NUM)
ZZZ. (NUM$)
ZZZ. (PI)
ZZZ. (POS)
ZZZ. (RIGHT$)
ZZZ. (RND)
ZZZ. (SGN)
ZZZ. (SIN)
ZZZ. (SLEEP)
ZZZ. (SPACE$)
ZZZ. (SQR)
ZZZ. (SQRT)
ZZZ. (STR$)
ZZZ. (TAN)
ZZZ. (TIM)
ZZZ. (TIME$)
ZZZ. (VAL)
IFNCEI:
%FN=1
DEFINE ZZZ. (X) <
XLIST
OPDEF ZZZZ. [%FN]
ZZZZ.
%FN=%FN+1
LIST
>
DEFINE ZTYPE (A,B,C),<
XLIST
BYTE (9)A,B(18)C
LIST
>
IF2FLO: ZZZ. (ABS)
ZZZ. (ASC)
ZTYPE 4,1,ASCIIB
ZTYPE 2,2,ATANB
ZTYPE 1,4,CHRB
ZTYPE 2,2,CLOGB
ZTYPE 2,2,COSB
ZTYPE 2,2,COTB
ZZZ. (CRT)
ZTYPE 1,0,DATEB
ZTYPE 1,0,DAYB
ZZZ. (DET)
ZTYPE 4,4,ECHOB
ZTYPE 4,0,ERLB
ZTYPE 4,0,ERRB
ZTYPE 2,2,EXPB
ZTYPE 4,2,FIXB
ZZZ. (FLTBI)
XWD IF31,INSTRB
ZTYPE 4,2,INTB
XWD IF32,LEFTB
ZTYPE 4,1,LENB
ZTYPE 4,0,LINEB
ZZZ. (LL)
ZTYPE 2,2,LOGB
ZZZ. (LOC)
ZZZ. (LOF)
ZTYPE 2,2,LOGB
ZTYPE 2,2,LOGB
ZTYPE 2,2,CLOGB
XWD IF33,MIDB
ZZZ. NUM
ZTYPE 1,2,STRB
ZZZ. (PI)
ZTYPE 1,4,POSB
XWD IF32,RIGHTB
ZTYPE 2,0,RNDB
ZZZ. (SGN)
ZTYPE 2,2,SINB
ZTYPE 4,4,SLEEPB
ZTYPE 1,4,SPACEB
ZTYPE 2,2,SQRTB
ZTYPE 2,2,SQRTB
ZTYPE 1,2,STRB
ZTYPE 2,2,TANB
ZZZ. (TIM)
ZTYPE 1,0,TIMEB
ZTYPE 2,1,VALB
IF2CEI:
IF31: XWD 3 ;ARG BLOCK FOR INSTR
XWD -1,-1
XWD 0,+1
XWD 0,+1
IF32: XWD 2 ;ARG BLOCK FOR LEFT$, RIGHT$.
XWD 0,+1
XWD 0,-1
IF33: XWD 3 ;ARG BLOCK FOR MID$
XWD 0,+1
XWD 0,-1
XWD -1,-1
;TABLE OF RELATIONS FOR IFSXLA
DEFINE ZZZ. (X,Y)<
OPDEF ZZZZ. [X]
ZZZZ. (Y)>
RELFLO: ZZZ. 3435B11,CAMGE
ZZZ. 3436B11,CAMN
ZZZ. 74B6,CAMG
ZZZ. 3635B11,CAMLE
ZZZ. 75B6,CAME
ZZZ. 76B6,CAML
RELCEI:
DDTGO: SKIPE DDTERR ;HERE FROM ERROR
JRST NXTST4 ;YES, TREAT LIKE COMPILATION ERROR
MOVEI R,STAROL ;DUMMY UP STAROL
MOVEI X1,DDTFLO ;WITH DDT STATEMENTS
MOVEM X1,FLOOR(R) ;SET FLOOR
MOVEI X1,DDTCEI ;AND CEIL
MOVEM X1,CEIL(R) ;ALL DONE
MOVEI R,RELROL ;MUST ALSO USE THIS RELROL
MOVEI X1,RELFLO ;NEW FLOOR
MOVEM X1,FLOOR(R) ;SET IT
MOVEI X1,RELCEI ;NEW CEIL
MOVEM X1,CEIL(R) ;SET IT
CLEARM DDTFLG ;NO BREAKS YET
MOVEI R,SCAROL ;OPEN UP SCAROL
MOVEI E,5 ;WITH FIVE LOCATIONS
PUSHJ P,BUMPRL ;DO IT
MOVEI R,VARROL ;NOW OPEN UP VARROL
MOVEI E,5 ;WITH FIVE CORRESPONDING LOCATIONS
PUSHJ P,BUMPRL ;DO IT
MOVE X1,CESCA ;CEIL OF SCAROL
SUB X1,FLSCA ;LESS FLOOR GIVES SIZE
SOJ X1, ;CORRECT
HRLI X1,777760 ;LARGEST "ASCII" VARIABLE NAME
MOVE X2,CEVAR ;START OF FIVE LOCATIONS
MOVE A,CESCA ;GET CEIL TO ZERO
MOVEI B,5 ;LOOP COUNTER
DDTSCA: MOVEM X1,-1(X2) ;STORE IT
SUB X1,[XWD 20,1] ;DECREMENT LOCATION AND VARIABLE NAME
SOJ X2, ;DECREMENT VARROL POINTER
CLEARM -1(A) ;ZERO LOCATION
SOJ A, ;DECREMENT SCAROL LOCATION
SOJG B,DDTSCA ;ALL FIVE DONE?
SUBTTL BASDDT "LOADER"
LINKAG: 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.
;
; GET ARRAY REQUIREMENTS
;
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 ;VIRTUAL
JRST LK2B ;YES, IGNORE IT
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,LKLAB4 ;IMPLICIT 2-DIM ARRAY?
HRRI X2,^D11
MOVEI X1,^D121
LKLAB4: 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
JRST LK2C
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 VARAIBLE 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 [PUSHJ P,INLMES
ASCIZ /
? Out of room/
JRST ERRMSG]
;
; GET SPACE FOR DDT
;
LK37: ADD E,CETMP ;CALCULATE TOP OF ARRAY SPACE
MOVEM E,SVRTOP
MOVEM E,VARFRE ;FIRST FREE WORD
MOVE X1,.JBREL ;HIGH NOW
MOVEM X1,.USREL ;USER HIGH
AOJ X1, ;START OF BASDDT
MOVEM X1,.DDSA ;SAVE IT
ADDI X1,17 ;START FOR DDT
MOVEM X1,.DDTMP ;ROOM FOR AC'S
AOJ X1, ;START FOR BASDT CODE
MOVEM X1,DDTCOD ;SAVE IT
ADDI X1,^D100
MOVEM X1,.DDFF
ADD X1,CELAD ;ESTIMATE HOW MUCH CORE WE NEED
SUB X1,FLVAR ;TO MOVE VARROL THRU LADROL
CORE X1, ;GET K FOR DDT
JRST [PUSHJ P,INLMES
ASCIZ /
? Out of room/
JRST ERRMSG]
MOVE X1,.JBREL
MOVEM X1,.DDREL
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
SKIPE CHAFL2
PUSHJ P,ERRMS3
PUSHJ P,INLMES
ASCIZ /
/
AOJA T,LINK0A
LINK0C: MOVE B,FLFOR ;UNSAT FORS?
CAML B,CEFOR
JRST LINK0D
SETZM RUNFLA ;RETURN TO BASIC
PUSHJ P,INLMES
ASCIZ /? FOR without NEXT in line /
MOVE T,(B) ;GET LINE
ADD T,FLLIN
HLRZ T,(T)
PUSHJ P,PRTNUM ;PRINT IT
SKIPE CHAFL2
PUSHJ P,ERRMS3
PUSHJ P,INLMES
ASCIZ /
/
ADDI B,5 ;MORE UNSAT FORS?
JRST LINK0C+1
;
LINK0D: SKIPG DATAFF ;WAS DATA OMITTED?
JRST LINK0E ;NO
PUSHJ P,INLMES
ASCIZ /
? No DATA/
SKIPE CHAFL2
PUSHJ P,ERRMS3
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 [PUSHJ P,INLMES
ASCIZ /
? Illegal line reference in RUN(NH) or CHAIN/
JRST ERRMSG]
SUB B,FLOOR(R)
MOVEM B,RUNLIN
ADD B,FLREF ;IS NOT WITHIN A MULTI-LINE DEF.
SKIPE (B)
JRST [PUSHJ P,INLMES
ASCIZ /
? Illegal line reference in RUN(NH) or CHAIN/
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 IT
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
MOVE A,T
MOVEI B,1
PUSHJ P,LINKUP
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
MOVE A,T
MOVEI B,1
PUSHJ P,LINKUP
LINK6: MOVE T,FLGSB ;LINK GOSUB REFS
MOVE T1,CEGSB
MOVE A,T
MOVEI B,1
PUSHJ P,LINKUP
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,.DDFF
MOVEM X1,FLSEX
MOVEM X1,CESEX
AOS .DDFF
MOVEI R,VARROL
PUSHJ P,SAVROL
MOVE X1,.DDFF
MOVEM X1,CEARG
MOVEM X1,FLARG
AOS .DDFF
MOVEI R,REFROL
PUSHJ P,SAVROL
MOVEI R,FCNROL
PUSHJ P,SAVROL
MOVE X1,.DDFF
AOS .DDFF
MOVEM X1,FLFCL
MOVEM X1,CEFCL
MOVEI R,FADROL
PUSHJ P,SAVROL
MOVE X1,.DDFF
AOS .DDFF
MOVEM X1,FLCAD
MOVEM X1,CECAD
MOVEI R,LADROL
PUSHJ P,SAVROL
MOVEI R,ROLTOP
HRLZI X1,FLSAD
HRRI X1,FLFOR
MOVE X2,.DDFF
MOVEM X2,FLSAD
BLT X1,FLOOR(R)
HRLZI X1,CESAD
HRRI X1,CEFOR
MOVEM X2,CESAD
BLT X1,CEIL(R)
PUSH P,TOPSTG ;SAVE TOPSTG
MOVEI R,STMROL ;NEW TOPSTG
MOVEM R,TOPSTG ;
PUSHJ P,PRESS ;MOVE ALL ROLLS AS FAR DOWN AS WE CAN
POP P,TOPSTG ;RESTORE TOPSTG
PUSHJ P,ZSTOR ;ZERO OUT STORAGE
SKIPGE A,RUNLIN ;START AT DIFFERENT LINE
HRRZ A,FLCOD ;NO
MOVEM A,DDSTRT ;SAVE PROGRAM START
MOVEI A,DDFRST ;PSEUDO START
MOVEM A,RUNLIN ;FAKE OUT BASDDT
JRST EXECUT ;GO DO EXECUTE STUFF NOW
;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
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
ZSTOR: 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
BLTZER: HRL X1,X1 ;ZERO OUT CORE
SETZM (X1)
AOJ X1,
BLT X1,-1(X2)
POPJ P,
;
; SAVE ROLL FOR DDT
;
SAVROL: MOVE X2,CEIL(R) ;START SAVING HERE
MOVE X1,.DDFF ;PUT IT HERE
ADD X2,X1 ;
HRL X1,FLOOR(R) ;SET UP BLT TO MOVE ROLL
SUB X2,FLOOR(R) ;AMOUNT NEEDED TO SAVE
HRRZM X1,FLOOR(R) ;NEW FLOOR
BLT X1,(X2) ;SAVE IT
MOVEM X2,CEIL(R) ;NEW CEIL
MOVEM X2,.DDFF ;NEW FREE FOR DDT
POPJ P,
;
; SLIDE ROLL INTO PLACE FOR RUNTIME
;
SLIDRL: MOVE X2,CEIL(R) ;END SAVE HERE
HRRZ X1,CEIL-1(R) ;SLIDE ROLL DOWN NEXT TO LOWER ROLL
ADD X2,X1
HRL X1,FLOOR(R) ;SET UP BLT TO SLIDE ROLL
SUB X2,FLOOR(R) ;AMOUNT NEEDED
HRRZM X1,FLOOR(R) ;NEW FLOOR
BLT X1,(X2) ;SAVE IT
MOVEM X2,CEIL(R) ;NEW CEIL
POPJ P,
SUBTTL IMMEDIATE MODE PROCESSOR
DDFRST: MOVE A,DDSTRT ;GET PROGRAM START
MOVEM A,RUNLIN ;RESTORE
SETOM DDSTRT ;FORCE START
PUSHJ P,INLMES ;SO TELL USER
ASCIZ /[BASDDT execution]
/
OUTPUT ;SEND THE MESSAGE
SETZM MULLIN ;IN CASE END WAS ON MULTI-LINE
JRST EACHLN ;START DDT
DDTBRK: MOVEM A,DDSTRT ;POP-OFF RETURN
MOVEM A,SORCLN ;SAVE SOURCE LINE NUMBER
MOVE N,.DDSA ;SAVE THE AC'S HERE
BLT N,@.DDTMP ;ALL 17
MOVE X1,ERRGO ;SAVE ANY ON ERROR LABEL
MOVEM X1,DERRGO ;FOR RESTORATION
CLEARM ERRGO ;DO NOT PROCESS ON ERROR IN DDT MODE
SETOM NOLINE ;DO NOT PRINT LINE # ON ERROR
MOVEI X1,STMROL
MOVEM X1,TOPSTG
CLEARM ODF ;SETUP FOR OUTPUT TO TTY
PUSHJ P,INLMES ;TELL USER A STOP
ASCIZ /<STOP># /
MOVE T,SORCLN
HRRZ T,(T) ;GET LINE NUMBER
PUSHJ P,PRTNUM ;PRINT LINE #
PUSHJ P,PCRLF
EACHLN: SETOM VRFSET ;
SETZM INLNFG ;CLEAR INPUT LINE FLAG
CLEARM ODF ;
CLEARM IFIFG ;SETUO FOR TTY INPUT
CLEARM AFLAG ;CLEAR A FLAG
SETZM LOGNEG ;
CLEARM PFLAG ;CLEAR P FLAG
SKIPN MULLIN
JRST ECHL2A
MOVE D,T
JRST EACHL2
ECHL2A: CLEARM THENAD
CLEARM THNCNT
CLEARM ELSFLG
CLEARM ELSEAD
SETZM THNELS
ECHLN1: MOVEI C,">"
PUSHJ P,OUCH
OUTPUT
HRRZS RUNDDT
PUSHJ P,INLINE
HRROS RUNDDT
TLNE C,F.TERM ;JUST A TERMINATOR
JRST ECHLN1 ;YES, FORGET IT
MOVS D,T ;SAVE LINE POINTER
EACHL2: TLNN C,F.LETT ;MUST BE A LETTER
JRST ILLINS
PUSHJ P,SCNLT1 ;SCAN FIRST LTR
CAMN C,[XWD F.STR,"%"]
JRST ELILET ;
CAIE C,"("
TLNE C,F.EQAL+F.COMA+F.DIG+F.DOLL ;ELIDED LETTER?
JRST ELILET ;YES. POSSIBLE ASSUMED "LET"
PUSHJ P,SCNLT2 ;SCAN SECOND LETTER.
JRST ILLINS ;SECOND CHAR WAS NOT A LETTER.
MOVS X1,A
CAIE X1,(SIXBIT /IF/)
CAIN X1,(SIXBIT /ON/)
JRST EACHL1
EACHL3: PUSHJ P,SCNLT3 ;ASSEMBLE THIRD LETTER OF STATEMENT IN A
JRST ILLINS ;THIRD CHAR WAS NOT A LETTER
JRST EACHL1
ELILET: MOVSI A,(SIXBIT /LET/) ;ASSUME A "LET" STATEMENT.
SKIPE T,MULLIN ;MULLIN HAS PTR IF MULTI
JRST ELILT1
MOVS T,D ;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.
EACHL6: MOVE X1,A
SETOM JFCLAD ;NO JFCL YET
SKIPN MULLIN
JRST EACHLA
SKIPN DDCODE
FAIL <? Cannot mix statements>
JRST EACHL7
EACHLA: CLEARM DDCODE ;ASSUME NO CODE PRODUCER
TRNN X1,200000 ;CODE PRODUCER?
JRST EACHL7
SKIPN DDTFLG
FAIL <? Program not STARTed>
MOVE B,DDTCOD
MOVEM B,DDCODE
EACHL7: TRZE X1,200000 ;BASDDT INSTRUCTION?
JRST EACHL9 ;NO
SKIPE MULLIN ;ANY CODE PRODUCERS?
FAIL <? Cannot mix statements>
JRST EACHL8 ;CONTINUE
EACHL9: MOVSI D,(JFCL) ;SET JFCL FOR HANDLING MODIFIERS
PUSHJ P,BUILDI ;DO THE GENERATION
MOVEM B,JFCLAD ;STORE ADDRESS
EACHL8: TRNN X1,400000 ;MORE TO COMMAND?
SOJA X1,EACHL5 ;NO. JUST DISPATCH
PUSHJ P,QST ;CHECK REST OF COMMAND
JRST ILLINS
TRZ X1,400000 ;CLEAR HIGH-ORDER BIT
EACHL5: JRST 400001(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,DDTCOD
MOVSI X2,(JRST) ;PUT JRST
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 X1,DDTCOD ;ADJUST
ADD B,DDTCOD ;ADDRESSES
PUSHJ P,FIXADR ;FIX JUMP
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 DDCODE ;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,DDCODE ;NEXT CODE
MOVE X1,JAROUN ;JUMP AROUND LOC
ADD X1,DDTCOD
PUSHJ P,FIXADR ;JUMP INTO NEXT
SETOM JAROUN ;NO MORE JUMP AROUND
MOVE X1,FTYPE ;TYPE OF FOR INDEX
MOVEM X1,TYPE ;SAVE FOR NEXT CODE
PUSHJ P,NEXCOD ;NEXT CODE
JRST MODMOR ;LOOK FOR MORE
SAVCEN: MOVE X1,DDCODE
SUB X1,DDTCOD ;NEW CENTRY
EXCH X1,(P) ;SAVE IT
JRST (X1)
OLDCEN: PUSHJ P,HALJRS ;JRST TO OLD CENTRY
ADD B,DDTCOD
MOVE X1,CENTRY
ADD X1,DDTCOD
HRRM X1,(B) ;SET ADDRESS
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,DDTCOD
MOVE X1,JFCLAD ;JUMP TO MODIFIERS
ADD X1,DDTCOD
PUSHJ P,FIXADR ;SET ADDRESS
SKIPGE X1,JAROUN ;LAST JUMP AROUND
JRST NXSM3 ;NONE THERE
ADD X1,DDTCOD
MOVE B,DDCODE ;NEXT STMNT
PUSHJ P,FIXADR ;FOR JUMP AROUND
NXSM3: TLNE C,F.TERM ;SEEN TERMINATOR YET
JRST NXSM2 ;
PUSHJ P,QSELS ;
JRST ERTERM ;NO, ABOUT TIME
MOVEM T,MULLIN
JRST NXSM1
NXSM2: SETZB L,MULLIN ;END, UNSET MULTI-LINE
MOVEI D,"\" ;WAS IT
CAIE D,(C) ;BACKSLASH ?
SOJA L,NXSM1 ;NO, REALLY NEXT LINE
MOVEM T,MULLIN ;YES, SET MULTI-LINE
PUSHJ P,NXCH ;GET NEXT CHAR
MOVEI D,"\"
CAIE D,(C)
JRST NXSM1
MOVEM T,MULLIN ;SAVE POINTER
PUSHJ P,NXCH
MOVE B,DDCODE
SKIPE X1,THENAD ;ANY THENS ?
PUSHJ P,LNKTHN ;YES, FIX THEM UP
SKIPE X1,ELSEAD ;ANY ELSES ?
PUSHJ P,LNKTHN ;FIX THEM TOO
SETZM THNCNT ;AND SET BACK ALL THE POINTERS
CLEARM THENAD
SETZM ELSEAD
SETZM THNELS
NXSM1: SKIPGE AFLAG ;
JRST NXSM2A ;
SKIPE VRFSET
JRST NXTST1
NXSM2A: MOVE D,[SETZM VRFBOT]
PUSHJ P,BUILDI
;ENTER HERE FROM ERROR ROUTINE
NXTST1: SKIPE MULLIN ;FINISHED LINE ?
JRST EACHLN ;NO
MOVE B,DDCODE ;FIX UP THENS JRST
SKIPE X1,THENAD
PUSHJ P,LNKTHN ;FIX ADDRESS
SKIPE X1,ELSEAD ;AND ELSES TOO, IF ANY
PUSHJ P,LNKTHN
NXTST2: JUMPE L,EACHLN
NXSM1A: SKIPN DDCODE
JRST EACHLN
MOVE D,[JRST NXTEND]
PUSHJ P,BUILDI
MOVE B,FLFOR
CAMGE B,CEFOR
FAIL <? FOR without NEXT>
PUSH P,T
PUSH P,C
MOVE C,DDTCOD
MOVE T,FLCAD
MOVE T1,CECAD
MOVE A,FLDON
MOVEI B,1
PUSHJ P,LINKUP
MOVE T,FLDPT
MOVE T1,CEDTP
MOVE A,T
MOVEI B,1
PUSHJ P,LINKUP
MOVE T,FLDIT
LNKDD1: CAML T,CEDIT
JRST LNKDD2
HRRZ A,(T)
ADD A,FLDLT
HRRM A,(T)
AOJA T,LNKDD1
LNKDD2: MOVE T,FLSAD
MOVE T1,CESAD
MOVE A,FLDIT
MOVEI B,1
PUSHJ P,LINKUP
POP P,C
POP P,T
JRST @DDTCOD
NXTST4: MOVE N,TOPSTG ;ERROR OCCURRED FROM USER PROGRAM
CAIE N,CODROL ;IF NOT STMROL, IT DID
JRST NXTST3 ;NO, MUST BE FOR BASDDT CODE
MOVE N,.DDSA ;HAVE TO SAVE AC'S
BLT N,@.DDTMP ;SAVE 'EM ALL
SETOM DDSTRT ;DO NOT ALLOW CONTINUE
MOVEI N,STMROL ;RESET TOPSTG FOR BASDDT
MOVEM N,TOPSTG ;SO WE DON'T DESTROY WHAT WE NEED
SETOM NOLINE ;DO NOT PRINT LINE # ON ERROR
NXTST3: CLEARM MULLIN
CLEARM ODF ;OUTPUT TO TTY
CLEARM IFIFG ;INPUT TO TTY
CLEARM DDTERR ;CLEAR ERROR FLAG
PUSHJ P,PCRLF
NXTEND: PUSHJ P,CLEAN
JRST EACHLN
CLEAN: MOVEI R,FORROL
MOVE X1,CEIL-1(R)
HRLZI X2,FLOOR(R)
HRRI X2,FLOOR+1(R)
MOVEM X1,FLOOR(R)
BLT X2,FLDTP
HRLZI X2,CEIL(R)
HRRI X2,CEIL+1(R)
MOVEM X1,CEIL(R)
BLT X2,CEDTP
CLEARM @FLOOR(R)
SETOM TMPPNT
MOVE X1,FLCAD
MOVEM X1,CECAD
MOVE X1,FLSAD
MOVEM X1,CESAD
POPJ P,
FIXADR: HRRM B,(X1) ;YES, FIX ADDRESS
POPJ P, ;RETURN
LNKTHN: ADD X1,DDTCOD ;FIX X1
HRRZ X2,(X1) ;PICK UP THE LINK
HRRM B,(X1) ;FIX ADDRESS
JUMPE X2,CPOPJ ;ANOTHER LINK
MOVE X1,X2 ;YES, SET X1
JRST LNKTHN ;AND CONTINUE
SUBTTL STATEMENT GENERATORS
;
; DEFINE BASDDT
;
XBAS: ASCIZ /DDT/
MOVE D,[JRST NXTEND]
PUSHJ P,BUILDI
JRST NXTSTA
;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
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,[MOVE N,[XWD 5,1]]
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
PUSHJ P,NXCH
PUSHJ P,FORMLN ;YES.
PUSHJ P,CHKINT
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,"%"] ;PERCENT?
PUSHJ P,NXCH ;YES, EAT IT
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?
MOVSI D,(VECFIN)
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
JRST XCLAB1
JRST ILFORM
XCLAB1: 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
MOVSI D,(VECPIN)
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
PUSHJ P,BUILDI
TLNN C,F.COMA ;MORE ?
JRST NXTSTA ;NO
PUSHJ P,GETCNA ;GET EM
JRST XCLOS0
;
; CONTINUE FROM BREAKPOINT REQUEST
;
XCONT: PUSHJ P,QSA ;DID HE INCLUDE "T"
ASCIZ /T/
JFCL ;WHO CARES
SKIPN DDTFLG ;SHOULD HE CONTINUE
FAIL <? Program not STARTed>
TLNN C,F.CR ;JUST CONTINUE
JRST XCONT1 ;NO, NEED LINE NUMBER
SKIPGE DDSTRT ;CAN CONTINUE
FAIL <? Cannot CONTINUE without line number>
JRST XCONT2 ;CONTINUE
XCONT1: PUSHJ P,GETLIN ;GET THE LINE REFERENCE
HRRZM A,DDSTRT ;FOR RETURN
XCONT2: MOVEI R,CODROL
MOVEM R,TOPSTG
MOVE X1,DERRGO ;RESTORE ERRGO
MOVEM X1,ERRGO ;FROM DERRGO
CLEARM NOLINE ;REMOVE BREAK POINT FLAG
HRLZ N,.DDSA ;MUST RESTORE AC'S
BLT N,17 ;RESTORE THEM
SETOM PFLAG ;
JRST @DDSTRT ;CONTINUE
XCONT3: HRRZ N,(A) ;GET GOTO ADDRESS
HRRZM N,DDSTRT
PUSHJ P,CLEAN
JRST XCONT2 ;RELEASE BREAK AND GO
XCONT6: MOVE P,@.DDTMP ;RESTORE ORIGINAL P
MOVE N,A ;RETURN ADDRESS -1
AOJ N, ;RETURN HERE
PUSH P,N ;SET UP RETURN
JRST XCNT4A ;RESUME
XCONT4: MOVE P,@.DDTMP ;RESTORE ORIGINAL P
PUSH P,@ONGADR ;PUSH RETURN ADDRESS
XCNT4A: MOVE N,(A)
HRLI N,(GOSUB) ;SET UP GOSUB
MOVEM N,40 ;FAKE UUO
MOVEI R,CONROL
MOVEM R,TOPSTG
HRLZ N,.DDSA
BLT N,16
PUSH P,[XWD 0,XCONT5]
SETOM PFLAG ;
CLEARM NOLINE ;REMOVE BREAKPOINT FLAG
JRST GOSBER
XCONT5: MOVE N,.DDSA
BLT N,@.DDTMP
MOVEI X1,STMROL
MOVEM X1,TOPSTG
SETZM PFLAG ;
SETOM NOLINE ;BACK IN BREAK POINT CODING
POPJ P,
;
; END STATEMENT
;
XEND: TLNN C,F.CR
FAIL <? END is not last>
SKIPE THNELS
FAIL <? END under conditional>
MOVE D,[JRST DDTXIT] ;COMPILE TERMINATE EXIT
PUSHJ P,BUILDI ;GENERATE IT
JRST NXTSTA ;GO FOR NEXT
;
DDTXIT: CLEARM RUNDDT ;NO MORE DDT
CLEARM DDTFLG ;NO MORE BREAKS
CLEARM NOLINE ;REMOVE BREAKPOINT FLAG
JRST EUXIT ;EXIT
;
; DECLARE STATEMENT
;
XDEC: PUSHJ P,QSA ;DID HE INCLUDE FULL COMMAND
ASCIZ /LARE/
JFCL ;WHO CARES
XDECA: TLNN C,F.LETT ;DID WE SEE A LETTER?
FAIL <? Illegal scalar name>
PUSHJ P,SCNLT1 ;LTR TO A, LEFT JUSTIFY, 7 BIT
PUSHJ P,DIGIT ;CHECK FOR DIGIT
PUSHJ P,PERCNT ;CHECK FOR PERCENT
TLNN C,F.COMA ;SEPARATOR?
TLNE C,F.TERM ;OR TERMINATOR?
JRST XDEC1 ;YES, GO BUILD
FAIL <? Illegal scalar name>
XDEC1: MOVEI R,VARROL ;SETUP TO SEARCH VARROL
PUSHJ P,SEARCH ;IS IT THERE?
CAIA ;NOT THERE, TREMENDOUS
FAIL <? Already defined>
XDEC1A: PUSH P,B ;SAVE LOCATION FOR NEW VARIABLE
PUSH P,A ;SAVE NEW VARIABLE NAME
MOVSI A,777660 ;BASDDT VARAIABLE NAME
XDEC2: PUSHJ P,SEARCH ;IS IT THERE?
JRST XDEC3 ;NOT THERE
POP P,A ;GET NEW VARIABLE NAME
HRR A,(B) ;GET ITS LOCATION
POP P,X1 ;GET LOCATION TO STORE NEW VARIABLE
CAMN B,X1 ;SAME
JRST XDEC3A ;YES
XDEC3B: MOVE X2,-1(B) ;MOVE ROLL DOWN
MOVEM X2,(B) ;ONE WORD MOVED
SOJ B, ;DECREMENT ADDRESS
CAME B,X1 ;LAST ONE MOVED
JRST XDEC3B ;NO, DO NEXT
XDEC3A: MOVEM A,(B) ;STASH IT
TLNE C,F.TERM ;TERMINATOR
JRST NXTSTA ;GO FOR NEXT
PUSHJ P,NXCHK ;SWALLOW COMMA
JRST XDECA ;GO AGAIN
XDEC3: CAML A,[XWD 777760,0] ;ALL LOCATIONS TRIED?
FAIL <? No more temporary locations>
ADD A,[XWD 20,0] ;NEXT VARIABLE
JRST XDEC2 ;CONTINUE
; ELSE STATEMENT
XELSE: MOVEM T,MULLIN ;SAVE POINTER
PUSHJ P,QSA
ASCIZ /E/
JRST ILLINS
SOSGE THNCNT ;IS ELSE LEGAL?
FAIL <? ELSE without THEN>
SKIPE ELSFLG ;SINGLE WORD THEN
JRST XELS0 ;YES, SKIP ADDRESS FIX
MOVE X1,THENAD ;PICK UP THEN LINKAGE
ADD X1,DDTCOD
MOVE B,DDCODE ;ADDRESS FOR THENS JRST
AOJ B, ;ALLOW FOR ELSES JRST OR CAIA
HRRZ X2,(X1)
MOVEM X1,THENAD ;SAVE IT
HRRM B,(X1)
MOVEM X2,THENAD
XELS0: TLNE C,F.DIG ;DIGIT
JRST ELSGO ;YES, LET GO TO HANDLE IT
SKIPE ELSFLG ;SINGLE WORD THEN
JRST XELS1 ;YES,
PUSHJ P,HALJRS ;NO, GEN HALT/JRST
PUSHJ P,FIXELS ;FIX THE ELSE
XELS1: CLEARM ELSFLG ;CLEAR FLAG
JRST NXSM1 ;AND DO NEXT STMNT
ELSGO: MOVSI D,(CAIA) ;SKIP FROM THEN
SKIPN ELSFLG ;UNLESS IT WAS A JRST
PUSHJ P,BUILDI
PUSHJ P,XGOFR ;DO GOTO CODE
SETZM ELSFLG ;UNSET SINGLE WORD THEN
TLNN C,F.CR ;END OF LINE?
CAMN C,[XWD F.APOS,"'"]
JRST NXSM2 ;YES, END IT ALL
PUSHJ P,QSELS ;LOOK FOR ELSE
JRST ERTERM
JRST NXTSTA ;NEXT STATEMENT
FIXTHN: SKIPN X1,THENAD
JRST FIXTH1
ADD B,DDTCOD
HRRM X1,(B)
SUB B,DDTCOD
FIXTH1: MOVEM B,THENAD
POPJ P,
FIXELS: SKIPN X1,ELSEAD
JRST FIXEL1
ADD B,DDTCOD
HRRM X1,(B)
SUB B,DDTCOD
FIXEL1: MOVEM B,ELSEAD
POPJ P,
;
; 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 OF FLOAT IT
JRST XFOR4+1 ;
XFOR2: HLRZ X1,B ;CASE OF A POSITIVE
ANDI X1,ROLMSK ;CONSTANT, FORCE THE
CAIE X1,CADROL ;UPPERBOUND TO BE
CAIN X1,CONROL ;
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
CAIN X1,CONROL
JRST XFLAB2
JRST XFOR6
XFLAB2: 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 ;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,DDCODE ;NEXT LOC
SUB X1,DDTCOD
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
HALJRS: MOVSI D,(JRST) ;ELSE JRST
PUSHJ P,BUILDI
POPJ P,
;GOSUB STATEMENT XLATE
XGOSUB: ASCIZ /UB/
SETZM ONGFLG
XGOS: MOVE D,[JSP A,XCONT6] ;
SKIPE ONGFLG ;
HRRI D,XCONT4 ;
PUSHJ P,BUILDI ;
PUSHJ P,GETLIN ;GET THE LINE REFERENCE
MOVE D,FLGSB ;MAKE SEARCH OF GSBROL
XGOS1A: CAML D,CEGSB ;LOOKED AT ALL
FAIL <? Undefined GOSUB>
CAME A,(D) ;IS THIS IT
AOJA D,XGOS1A ;NO, CHECK NEXT
HRLI D,(JFCL) ;BUILD FAKE GOSUB UUO
PUSHJ P,BUILDI ;GENERATE IT
SKIPN ONGFLG
JRST NXTSTA
TLNN C,F.COMA
JRST XON2
PUSHJ P,NXCHK
JRST XGOS
;GOTO STATEMENT
XGOTO: ASCIZ /O/
PUSHJ P,QSA
ASCIZ /BASDDT/
JRST XGOFIN
JRST XBAS+1
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
PUSH P,B
ADD B,FLREF
PUSH P,(B) ;SAVE REF TO GO TO LINE
MOVE A,SORCLN
HRLZ A,(A)
PUSHJ P,SEARCH
JFCL ;IMPOSSIBLE ERROR
SUB B,FLLIN
ADD B,FLREF ;GET THAT TO CURRENT LINE
POP P,X1
CAME X1,(B) ;SAME ?
FAIL <? Illegal line reference >,1
MOVE D,[JSP A,XCONT3] ;TO RELEASE BREAKPOINT
PUSHJ P,BUILDI ;GENERATE
POP P,B ;RESTORE B
HRLI B,LADROL
MOVSI D,(JFCL) ;NO-OP
PUSHJ P,BUILDA
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 UNDER CONDITIONAL
TLNN C,F.DIG ;NEXT CHAR A DIGIT ?
JRST IFCGO ;NO
PUSHJ P,XGOFR ;USE GOTO CODE TO GEN JRST INSTR
SETOM ELSFLG ;SINGLE WORD THEN FLAG
TLNN C,F.CR ;END OF LINE?
CAMN C,[XWD F.APOS,"'"]
JRST NXSM1 ;YES, DON'T LOOK FOR ELSE
PUSHJ P,QSELS ;ELSE THERE TOO ?
JRST ERTERM
MOVEM T,MULLIN ;YES, MARK MULTI
JRST NXSM1 ;AND LET STATEMENT HANDLER DO IT
IFCGO: PUSHJ P,REVSEN ;REVERSE LOGIC
PUSHJ P,HALJRS ;JRST/HALT AROUND THEN CODE
PUSHJ P,FIXTHN ;FIX THEN ADDRESS
JRST NXSM1
IFCCOD: PUSHJ P,FORMLB ;
MOVE X2,DDCODE ;LAST CODE GENERATED
HLRZ X1,-1(X2) ;CHECK FOR POSSIBLE OPTIMIZATION
CAIE X1,(SETO) ;WAS TDZA AND SETO GENERATED?
JRST IFCOD1 ;NO, MUST TEST TRUTH VALUE
MOVE B,X2 ;NEW ADDRESS
SUBI B,2 ;YES, REMOVE THE TWO INSTRUCTIONS
MOVEM B,DDCODE ;BY SETTING NEW CEIL
SOJ B, ;LAST CODE GENERATED ADDRESS
SUB B,DDTCOD ;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: ADD B,DDTCOD ;ADDRESS OF LAST RELATION
MOVE D,(B) ;CAM??/SKIP? INSTRUCTION
TLC D,4000 ;REVERSE SENSE
MOVEM D,(B) ;PUT BACK
SUB B,DDTCOD ;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: SETZM INPPRI ;NOT INPUT FROM TTY
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, CARRY ON
SETOM INPPRI ;STRING OUTPUT IS NOW LEGAL
TLNN C,F.QUOT ;IS THERE ONE COMING UP
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, CONTINUE
TLNE F,-2 ;MUST BE 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, CONTINUE
TLNN C,F.TERM ;CAN ONLY BE ONE
FAIL <? Line input takes only one string>
PUSH P,B ;SAVE ADDRESS
PUSH P,D ;SAVE OP CODE
MOVE D,[SETOM INLNFG] ;FLAG FOR INPUT LINE
PUSHJ P,BUILDI ;GEN IT
POP P,D ;RESTORE OPCODE
POP P,B ;RESTORE ADDRESS
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
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 FLOAT 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
;
; LIST BREAKPOINTS
;
XLIST: PUSHJ P,QSA ;DID SHE INCLUDE T
ASCIZ /T/ ;WHO CARES
JFCL
TLNN C,F.TERM ;TERMINATOR?
FAIL <? LIST takes no argument>
PUSH P,T ;SAVE BYTE POINTER
PUSH P,C ;SAVE CURRENT CHARACTER
PUSHJ P,INLMES ;LABEL
ASCIZ /STOPs:/
MOVE X1,FLLAD ;START SEARCHING AT LADROL
XLIST1: CAML X1,CELAD ;ALL LOOKED AT?
JRST XLIST3 ;YES, RETURN
HRRE A,(X1) ;GET FIRST LINE
JUMPGE A,XLIST2 ;STOP HERE?
MOVE B,X1 ;GET ADDRESS IN LADROL
SUB B,FLLAD ;ELEMENT IN LADROL
ADD B,FLLIN ;ADDRESS IN LINROL
HLRZ T,(B) ;GET STATEMENT NUMBER
MOVEI C,11
PUSHJ P,OUCH
PUSHJ P,PRTNUM ;PRINT IT
XLIST2: AOJA X1,XLIST1 ;CONTINUE
XLIST3: PUSHJ P,PCRLF ;OUTPUT <CR><LF>
POP P,C ;RESTORE C
POP P,T ;RESTORE T
JRST NXTSTA ;GO FOR NEXT
;
; 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
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
XMAR5: PUSHJ P,FORMLN
PUSHJ P,EIRGEN
PUSHJ P,CHKINT ;MUST BE INTEGER
MOVE D,[PUSHJ P,PAGE]
SKIPN TABLE
HRRI D,MARGN
PUSHJ P,BUILDI
PUSHJ P,CHKDEL
JRST XMAR1
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,DDTCOD ;
HLLZ D,0(B) ;ADDRESS OF MAT UUO
PUSHJ P,CHKFMT ;CHECK FORMAT CHARACTER
XMAT2B: TLNN D,140
JRST GRONK ;FAIL IF ILLEGAL
HLLM D,0(B) ;RESTORE WITH CORRECT AC FIELD
TLNE C,F.TERM ;IS FORMAT CHAR FOLLOWED BY END OF STA?
JRST NXTSTA ;YES.
JRST XMAT2A ;PROCESS NEXT ARRAY NAME
;<MAT SCALE STA> ::= MAT <LETTER>=(<EXPRESSION>)*<LETTER>
XMAT3: PUSH P,[Z NXTSTA] ;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 VECTOR 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
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 ;SAVE THE TYPE
MOVEM X1,FTYPE ;FOR MIXED MODE CHECK
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 ;GET TYPE OF SCALAR
CAME X1,FTYPE ;SAME MODE?
JRST MTYERR ;NO, ERROR
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
VCTOR: PUSHJ P,ARRAY ;REGISTER ARRAY OR VECTOR
CAIE A,5 ;STRING ?
JUMPN A,CPOPJ ;NO, ARRAY ?
MOVE X2,1(X1) ;YES, ONE OR THE OTHER
JUMPG X2,CPOPJ
MOVNI X2,2
MOVEM X2,1(X1)
POPJ P,
;<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 ;IS IT INTEGER?
TLO D,400 ;ES, MARK IT
PUSH P,D
HRLI F,777777
PUSHJ P,ARRAY
JUMPN A,GRONK
PUSHJ P,MATCHK ;CHECK THAT ITS NOT VIRTUAL
MOVE X1,TYPE ;GET THE TYPE
CAME X1,FTYPE ;MIXED MODE?
JRST MTYERR ;YES, FLAG ERROR
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 ;SAVE THE TYPE
MOVEM X1,FTYPE ;FOR MIXED MODE CHECK
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 ;IS IT INTEGER?
TLO D,400 ;YES, MARK IT
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 ;CHECK FOR MIXED MODE
CAME X1,FTYPE ;TYPES MATCH?
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 ;INTEGER MATRIX?
MOVE D,[MOVEI N,1] ;YES, SET UP INTEGER 1
PUSHJ P,BUILDI ;BUILD INST TO GET SCAL FACTOR
POP P,B ;GET SOURCE MAT BACK
PUSH P,[MATSCA]
JRST XMAT9B
;
; 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 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,DDTCOD ;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
;
; 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/
PUSHJ P,QSA
ASCIZ /IZE/
JFCL
MOVE D,[PUSHJ P,RANDER]
PUSHJ P,BUILDI ;BUILD CALL TO RUNTIME RANDOMIZER
JRST NXTSTA
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 ;UNDER THEN OR ELSE ?
FAIL <? NEXT under conditional>
XNEX0: TLNN C,F.TERM ;NEXT WITHOUT ARGUMENT?
JRST XNEX3 ;NO, FOR-NEXT LOOP
MOVE X1,CEFOR ;UNSAT UNTIL/WHILE LOOP
CAMG X1,FLFOR ;CHECK FOR ROLL
FAIL <? NEXT without WHILE/UNTIL>
SETO X2, ;MAKE SURE THIS IS UNTIL/WHILE LOOP
CAME X2,-3(X1) ;-1 FOR INDUCTION VARIABLE
CAMN X2,-2(X1) ;-1 FOR INCREMENT
CAIA ;ALL'S QUIET ON THE EASTERN FRONT
FAIL <? Illegal NEXT statement>
PUSHJ P,POPFOR ;RETURN TEMP PROTECTION
MOVEM B,TMPLOW ;SHOULD NOT CHANGE
MOVEM B,TMPPNT ;
PUSHJ P,POPFOR ;DUMMY INCREMENT
PUSHJ P,POPFOR ;DUMMY INDUCTION
PUSHJ P,POPFOR ;LOPP JRST ADDRESSES
PUSH P,[Z NXTSTA] ;SET UP RETURN
JRST XNEX4 ;LET NEXT CODE HANDLE THE 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 IS WHILE/UNTIL LOOP
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 ;INTEGER?
MOVSI D,(ADD) ;YES, DO INTEGER ADD
PUSHJ P,BUILDA
PUSHJ P,POPFOR ;GET JRST POINTER
XNEX4: MOVE A,DDTCOD ;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,DDTCOD ;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,
;
; 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,FORMLN ;EVALUATE INDEX
PUSHJ P,EIRGNP ;GET IN REG
PUSHJ P,CHKINT ;MUST BE INTEGER
MOVE D,[JSP A,DCTON]
PUSHJ P,BUILDI ;BUILD THE RUNTIME CALL
CLEAR D, ;DUMMY INSTR. FOR NOW
PUSHJ P,BUILDI ;GENERATE IT
ADD B,DDTCOD ;ADDRESS OF THUS DUMMY
MOVEM B,ONGADR ;SAVE IT
TLNE C,F.COMA ;SKIP OPTIONAL COMMA.
PUSHJ P,NXCH
PUSHJ P,QSA
ASCIZ /GOSUB/
JRST XONA
SETOM ONGFLG
JRST XGOS
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 XON2 ;NO
PUSHJ P,NXCHK ;YES. SKIP COMMA
JRST XON1 ;PROCESS NEXT LINE NUMBER
XON2: MOVE B,DDCODE ;NEXT ADDRESS
MOVEM B,@ONGADR ;SET UP LIMIT
JRST NXTSTA ;GO FOR NEXT
DCTON: JUMPLE N,DCTON1 ;LEGAL ARGUMENT FOR ON
MOVEM A,ONGADR ;SAVE UPPER LIMIT
HRRZ T,N
JUMPE T,DCTON1
ASH T,1
ADDI T,(A)
CAMGE T,(A)
JRST -1(T)
DCTON1: FAIL <? ON evaluated out of range>
;
; OPEN STATEMENT
;
XOPEN: ASCIZ /N/
SETOM FILTYP ;FILE TYPE UNKNOWN
SETOM OPNFLG
FILEE8: MOVE D,[PUSHJ P,SETCOR]
PUSHJ P,BUILDI
SETZM VRFSET
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 ;GET FILENAME
JRST FILOP1 ;YES, GO DO FOR INPUT/OUTPUT
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
FILEE5: ADDI B,-60(C)
PUSHJ P,NXCH
TLNN C,F.DIG
JRST FILE55
IMULI B,^D10
JRST FILEE5
FILE55: 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 ;SET FILE TYPE
JRST FILE20 ;BACK TO MAIN CODE
FILSET: SKIPGE FILTYP ;ALREADY SET ?
MOVEM B,FILTYP ;NO, SET IT
CAME B,FILTYP ;YES, IS IT 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 ?
FAIL <? Illegal OPEN stmnt>
SOS INPOUT
FILOP3: PUSHJ P,QSA
ASCIZ /ASFILE/
FILERR: FAIL <? Illegal OPEN stmnt>
FILOP2: MOVEI B,-1 ;ASSUME R. A.
CAIN C,":" ;CORRECT?
JRST FILEE2 ;YES
SETZ B, ;ASSUME SEQ. ACC.
CAMN C,[XWD F.STR,"#"] ;RIGHT?
JRST FILEE2 ;YES
CAME C,[XWD F.STR,"@"] ;VIRTUAL ARRAY
JRST ERCHAN ;GIVE ERROR
SETZM FILTYP
AOSA FILTYP
FILEE2: PUSHJ P,FILSET
PUSHJ P,GETCNA
FILOP9: MOVSI D,(HRREI N,)
HRR D,FILTYP
PUSHJ P,BUILDI
MOVE D,[MOVEM N,FILTYP]
PUSHJ P,BUILDI
MOVE D,[SKIPE ACTBL-1(LP)]
PUSHJ P,BUILDI
MOVE D,[PUSHJ P,CLSFIL]
PUSHJ P,BUILDI
FILOP5: MOVE D,[PUSHJ P,OPNFIL]
PUSHJ P,BUILDI ;OPEN FILE
SKIPG FILTYP ;VIRTUAL ARRAY
SKIPN X1,INPOUT ;MODE SPECIFIED ?
JRST NXTSTA ;NO
JUMPG X1,FILOP6 ;YES, WHICH
MOVE D,[PUSHJ P,SCATH]
SKIPE FILTYP ;OUTPUT, SCRATCH, RANDOM ?
MOVE D,[PUSHJ P,RANSCR]
PUSHJ P,BUILDI
FILPLT: TLNE C,F.TERM ;TERMINATOR
JRST NXTSTA ;NEXT STATEMENT
PUSHJ P,QSA
ASCIZ /TOPLOT/
JRST NXTSTA
SKIPE FILTYP
JRST FILERR
MOVE D,[MOVEM LP,PLTIN]
SKIPG INPOUT
HRRI D,PLTOUT
PUSHJ P,BUILDI
JRST NXTSTA
FILOP6: SKIPE FILTYP ;INPUT, RESTORE, RANDOM ?
JRST FILOP7 ;YES
MOVE D,[PUSHJ P,XRES]
PUSHJ P,BUILDI
JRST FILPLT
FILOP7: MOVNI A,5 ;RANDOM
FILOP8: MOVE D,RESCOD+4(A)
PUSHJ P,BUILDI
AOJL A,FILOP8
JRST NXTSTA
;
; UNTIL WHILE LOOP
;
XUNTIL: ASCIZ /IL/
SETOM LOGNEG ;REVERSE SENSE OF LOGIC
JRST XWHILE+2 ;ONWARD
XWHILE: ASCIZ /LE/
SETZM LOGNEG ;STRAIGHT FORWARD LOGIC
MOVE X1,DDCODE ;WHERE TO GO
SUB X1,DDTCOD ;
SOJ X1, ;
HRLM X1,FORPNT ;SAVE IT
PUSHJ P,IFCCOD ;HANDLE CONDITIONAL
PUSHJ P,REVSEN ;YES, DO IT
PUSHJ P,HALJRS ;NEXT RETURNS
HRRM B,FORPNT ;SAVE FOR NEXT CODE
MOVE A,L ;SAVE STATEMENT FOR POSSIBLE ERROR
MOVEI R,FORROL ;SAVE ON FOR ROLL
PUSHJ P,RPUSH ;
MOVE A,FORPNT ;SAVE JRST POINTER ON FORROL
PUSHJ P,RPUSH ;
SETO A, ;DUMMY INDUCTION AND INCREMENT
PUSHJ P,RPUSH ;
PUSHJ P,RPUSH ;
MOVE A,TMPLOW ;SAVE TEMP PROTECTION
PUSHJ P,RPUSH ;
JRST NXTSTA ;ALL DONE
;
; PRINT AND WRITE STATEMENT
;
XWRIT: ASCIZ /TE/
SETOM WRREFL
JRST XPLAB1
XPRINT: ASCIZ /NT/ ;REST OF COMMAND
CLEARM WRREFL
XPLAB1: 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 ;
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, ;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,XPLAB2
POPJ P,
XPLAB2: 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 ;LOOK FOR MODIFIER
CAIA ;NONE
JRST XWRI7 ;ONE, HANDLE AS TERMINATOR
SETZM PFLAG ;CLEAR % SEEN FLAG
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,";"
JRST XPLAB3
JRST XWRI7
XPLAB3: PUSHJ P,NXCH
TLNN C,F.TERM ;CHECK FOR TERMINATOR
JRST XWRI5
XWRI7: MOVE D,[PUSHJ P,ENDIMG]
PUSHJ P,BUILDI
JRST NXTSTA
XPRRAN: PUSHJ P,GENTP1
PUSHJ P,FORMLB
MOVEM F,IFFLAG
JRST XPRRN2
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
JRST XPRRN1
XPRI1: SKIPE WRREFL
JRST GRONK
MOVSI D,(SETZ LP,) ;TTY OUTPUT
PUSHJ P,BUILDI ;GENERATE
MOVE D,[PUSHJ P,OUTSET] ;SETUP FOR OUTPUT
PUSHJ P,BUILDI ;GENERATE
XPRI0: PUSHJ P,KWSAMD ;MODIFIER FOLLOWS?
TLNE C,F.TERM ;LINE TERMINATOR?
JRST XPCRLF ;YES, JUST WANTS <CR><LF>
CAIA
XPRI2: PUSHJ P,KWSAMD ;MODIFIER
CAIA ;NO
JRST NXTSTA ;YES, GO HANDLE
PUSHJ P,QSA ;TAB FIELD?
ASCIZ /TAB/
JRST XPLAB4
JRST XPRTAB ;YES, GO HANDLE
XPLAB4: TLNN C,F.COMA ;SEPARATOR?
CAIN C,";" ;SEMI-COLON?
JRST PRNDEL ;YES, PRINT DELIMETER
CAIE C,74 ;LEFT ANGLE BRACKET?
JRST PRNEXP ;NO, PRINT EXPRESSION
;
; PRINT DELIMETER
;
PRNDEL: MOVSI D,(PRDL) ;UUO NEEDED FOR DELIMETER
PUSHJ P,CHKFMT ;CHECK THE FORMAT
PUSHJ P,BUILDI ;GENERATE
JRST XPRFIN ;SEE IF MORE
;
; PRINT EXPRESSION
;
PRNEXP: SETZM PFLAG ;CLEAR % SEEN FLAG
PUSHJ P,FORMLB ;GENERATE THE FORMULA
JUMPL F,XPLAB5
MOVSI D,(PRSTR)
JRST XPLAB6
XPLAB5: PUSHJ P,GPOSNX ;MOVE TO REGISTER (IF NEEDED)
MOVSI D,(PRNM) ;SET UP UUO
XPLAB6: PUSHJ P,CHKFMT ;CHECK FORMAT
SKIPGE TYPE ;INTEGER?
TLO D,400 ;YES, MARK IT
PUSHJ P,BUILDA ;GENERATE PRINT UUO
JRST XPRFIN ;GO FOR MORE
;
; PRINT TAB
;
XPRTAB: PUSHJ P,FORMLN ;EVALUATE TAB SUBEXPRESSION
PUSHJ P,EIRGNP ;MOVE IT INTO REG
MOVSI D,(PRNTB) ;CALL THE TAB INTERPRETER
XPRTA1: PUSHJ P,CHKFMT ;CHECK THE FORMAT
PUSHJ P,BUILDI ;BUILD THE INST.
;
; END OF ONE ARGUMENT
;
XPRFIN: TLNE C,F.TERM ;TERMINATOR?
JRST NXTSTA ;YES, TERMINATE
JRST XPRI2 ;LOOP FOR NEXT
;
XPCRLF: MOVE D,[CLEARM 40] ;NO UUO
PUSHJ P,BUILDI ;GENERATE
MOVE D,[PUSHJ P,PRDLER] ;DO SETUP
PUSHJ P,BUILDI ;GENERATE
MOVE D,[PUSHJ P,CRLF] ;DO <CR><LF>
PUSHJ P,BUILDI ;GENERATE
JRST NXTSTA ;GO TERMINATE
;
; REMOVE A BREAKPOINT
;
XREM: PUSHJ P,QSA ;DID HER INCLUDE FULL COMMAND
ASCIZ /OVE/ ;
JFCL ;WHO CARES
TLNN C,F.TERM ;REMOVING ALL
JRST XREM3 ;NO, ONE AT A TIME
PUSH P,T ;SAVE BYTE POINTER
PUSH P,C ;SAVE CURRENT CHARACTER
MOVE X1,FLLAD ;START AT FLOOR OF LADROL
MOVEI R,LADROL ;SETUP R
XREM1: CAML X1,CELAD ;ALL LOOKED AT
JRST XREM2A ;YES, RESTORE T AND C
HRRE A,(X1) ;GET LINE FLAG
JUMPGE A,XREM2 ;NO BREAKPOINT HERE
HLLZS (X1) ;CLEAR BREAKPOINT
HLRZ B,(X1) ;GET REL CODE ADDRESS
ADD B,FLCOD ;ADD IN BASE OF CODE
MOVE A,[JSP A,LINADR] ;RESTORE THIS INSTR.
MOVEM A,(B) ;DO IT
XREM2: AOJA X1,XREM1 ;DO NEXT
XREM2A: POP P,C ;BACK COMES C
POP P,T ;AND T
JRST NXTSTA ;GO FOR NEXT COMMAND
XREM3: PUSHJ P,GETLIN ;GET THE LINE REFERENCE
HLLZS (B) ;CLEAR BREAKPOINT
MOVE B,[JSP A,LINADR] ;RESTORE THIS INSTR.
MOVEM B,(A) ;DO IT
TLNN C,F.COMA ;MORE TO COME
JRST NXTSTA ;NOPE, GO HOME
PUSHJ P,NXCHK ;SWALLOW THIS COMMA
JRST XREM3 ;CONTINUE
;
; RESTORE STATEMENTS.
;
XREST: PUSHJ P,QSA ;RESUME?
ASCIZ /UME/
JRST XRESTA ;NO, MAYBE RESTORE
FAIL <? RESUME not available - please use CONT>
XRESTA: PUSHJ P,QSA ;CHECK FOR RESTORE
ASCIZ /TORE/
JRST ILLINS ;ILLEGAL INSTRUCTION
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
JRST XRES3
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
;
; 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
JRST SRAER5
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
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
JRST XSET
SETCOD: JUMPLE N,SETERR ;SOME OF THE CODE GENERATED.
CAIGE N,1
JRST SETERR
MOVEM N,POINT-1(LP)
;
; START USER'S PROGRAM
;
XSTART: PUSHJ P,QSA ;DID SHE INCLUDE EVERYTHING
ASCIZ /RT/
JFCL ;JUST LIKE A WOMAN
TLNN C,F.TERM ;JUST START
JRST XSTRT1 ;NO, DO LINE NUMBER STUFF
SETOM DDTFLG ;
SETOM PFLAG ;
PUSHJ P,ZSTOR ;ZERO STORAGE
CLEARM NOLINE
JRST @RUNLIN ;START UP
XSTRT1: PUSHJ P,GETLIN ;GET THE LINE REFERENCE
PUSHJ P,ZSTOR ;ZERO STORAGE
HRRZM A,DDSTRT ;SAVE FOR START
SETOM DDTFLG ;
MOVEI R,CODROL ;RESET TOP STODGY ROOL
MOVEM R,TOPSTG ;FOR NON BASDDT
CLEARM NOLINE ;NO BREAK POINTS
SETOM PFLAG ;TURN ON P FLAG
JRST @DDSTRT ;START THE PROGRAM
;
; SET A BREAKPOINT
;
XSTOP: PUSHJ P,QSA ;DID HE INCLUDE P
ASCIZ /P/
JFCL ;WHO CARES
XSTOP1: PUSHJ P,GETLIN ;GET THE LINE REFERENCE
MOVE X1,[JSP A,DDTBRK] ;GET BREAK INSTRUCTION
CAMN X1,(A) ;ALREADY SET?
JRST XSTOP2 ;YES, DON'T SET AGAIN
HLLOS (B) ;MARK AS BREAK
MOVEM X1,(A) ;FOR THIS STATEMENT
XSTOP2: TLNN C,F.COMA ;MORE TO COME?
JRST NXTSTA ;THAT'S ALL
PUSHJ P,NXCHK ;SCAN OFF COMMA
JRST XSTOP1 ;DO NEXT
SUBTTL SERVICE ROUTINES
;
;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,
;
; GET NEXT CHARACTER AND CHECK FOR LEGALITY
;
NXCHK: PUSHJ P,NXCH ;GET NEXT CHARACTER
TLNE C,F.STR ;LEGAL
FAIL <? Illegal character>
POPJ P, ;RETURN
;SCAN INITIAL LETTER, LETTER IS PLACED LEFT
;JUSTIFIED IN A, 7-BIT ASCII.
SCNLT1: HRRZ A,C
ROT A,-7
JRST NXCH
;SCAN SECOND LETTER, NON-SKIP RETURN IF NOT LETTER.
;MAKE 7-BIT LETTER LEFT JUST IN A
;INTO 6-BIT. THAN PUT 6-BIT CURRENT LETTER IN A.
SCNLT2: TLNN C,F.LETT
POPJ P,
SCN2: TLNN A,400000 ;ENTER HERE TO PROCESS NON-LETTER CHARS
TLZA A,200000
TLO A,200000
LSH A,1
MOVE X1,[POINT 6,A,5]
JRST SCNLTN
;ENTER HERE TO SCAN SECOND CHAR EVEN IF BOTH ARE NOT LETTERS.
;SCAN THIRD LETTER, NON-SKIP IF NOT LETTER.
;PUT 6-BIT LETTER TO 3RD 6-BIT FIELD IN A.
SCNLT3: TLNN C,F.LETT
POPJ P,
SCN3: MOVE X1,[POINT 6,A,11]
JRST SCNLTN ;CONTINUE
QSELS: AOS (P) ;ASSUME SUCCESS
PUSH P,C ;SAVE CHAR
PUSH P,T ;AND POINTER
PUSHJ P,QSA
ASCIZ /ELSE/ ;ELSE THER ?
SOS -2(P) ;NO
POP P,T ;RESTORE
POP P,C ;ACS
POPJ P,
ILLINS: FAIL <? Illegal instruction>
;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,SETFNO ;MUST BE NUMERIC
PUSHJ P,REGFRE ;MAKE SURE REGISTER IS FREE
PUSHJ P,CFORM0 ;GET OBJECT OF NOT
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
PUSHJ P,CMIXM ;CHECK FOR MIXED MODE
TLNN B,ROLMSK ;IS RIGHT SIDE ALREADY IN REG
JRST CFORM3 ;YES, COMPARE WITH LEFT SIDE
PUSHJ P,EXCHG ;GET LEFT SIDE IN REG
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
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
PUSHJ P,CMIXM ;CHECK FOR MIXED MODE
SKIPGE (P) ;IS SECOND FACTOR A DIVISOR?
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 ;CHECK LEGALITY
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 ;CANNOT BE L. H.
PUSHJ P,FORMLU ;GEN THE SUBEXPRESSION
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 ;CHECK LEGALITY
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.
HRLI B,CONROL
JRST SNOEXI
FNUM3: MOVE B,FLDON
FNUM3A: CAML B,CEDON
JRST FNUM3B
CAME N,(B)
AOJA B,FNUM3A
SUB B,FLDON
JRST FNUM4
FNUM3B: MOVEI R,DONROL ;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
;ROUTINE TO EVALUATE NUMBER
;T: PNTR TO FIRST CHAR, C: FIRST CHAR
;NON-SKIP IS FAIL RETURN
;RETURN NUMBER IN N
;N: ACCUM NBMR, B: SCA FAC, D: DIG CNT, USE FLGS IN LEFT OF F
EVANUM: SETZB N,B ;CLEAR ACS
MOVEI D,8
MOVEI F,(F) ;CLEAR LH OF F
TLNE C,F.PLUS ;SKIP +
JRST EVAN1
TLNN C,F.MINS ;CHECK FOR -
JRST EVAN2 ;NO
TLO F,F.MIN ;SET MINUS FLG
EVAN1: PUSHJ P,NXCH
EVAN2: TLNN C,F.DIG ;DIGIT?
JRST EVAN3 ;NO
TLO F,F.NUM ;DIGIT SEEN FLAG
JUMPE N,EVAN2A ;DONT COUNT LEADING ZEROS
SOJG D,EVAN2A ;COUNT DIGIT, GO ACCUM IF OK
; REST OF DIGITS ARE INSIGNIFIGANT.
AOJA B,EVAN2B ;LEAD OR TRAIL 0, FUDGE SCA FAC
EVAN2A: IMULI N,^D10 ;ACCUMULATE DIGIT
ADDI N,-60(C)
EVAN2B: TLNE F,F.DOT ;DECIMAL SEEN?
SUBI B,1 ;YES. COUNT DOWN SCALE FACT
JRST EVAN1 ;GO TO NEXT CHAR
EVAN3: TLNN C,F.PER ;NOT DIGIT. DEC PNT?
JRST EVAN4 ;NO.
TLOE F,F.DOT ;YES, SET FLG & CHK ONLY ONE
POPJ P, ;2 DEC PNTS
JRST EVAN1
EVAN4: TLNN F,F.NUM ;DID WE SEE A DIGIT?
POPJ P, ;NO. WHAT A LOUSY NUMBER
MOVEI X1,"E"
CAIE X1,(C) ;EXPLICIT SCALE FACTOR?
JRST EVAN8 ;NO
PUSH P,T
PUSH P,C
EV2: PUSHJ P,NXCH ;DO LOOK AHEAD
TLNE C,F.PLUS ;SCALE FACTOR SIGN
JRST EVAN5
TLNN C,F.MINS
JRST EVAN6
TLO F,F.MXP
EVAN5: PUSHJ P,NXCH
EVAN6: TLNN C,F.DIG ;CHK FOR DIGIT
JRST EVAN6A
POP P,A
POP P,A
MOVEI A,-60(C) ;SAVE FIRST EXPON DIGIT
EV4: PUSHJ P,NXCH
TLNN C,F.DIG ;IS THERE A SECOND DIGIT
JRST EVAN7 ;NO
IMULI A,^D10 ;YES. ACCUMULATE IT
ADDI A,-60(C)
EV5: PUSHJ P,NXCH ;DO LOOK AHEAD
EVAN7: TLNE F,F.MXP ;NEG EXPON?
MOVN A,A ;YES. NEGATE IT
ADD B,A ;ADD TO SCALE FACTOR
JRST EVAN8
EVAN6A: POP P,C
POP P,T
EVAN8: JUMPN B,EVAN8F
TLNE F,F.DOT
JRST EVAN8F
CAME C,[XWD F.STR,"%"] ;PERCENT
JRST EVAN9 ;NO, CHECK PFLAG
SETOM PFLAG ;% SEEN
PUSHJ P,NXCH ;EAT THE %
EVAN9A: SETOM TYPE ;TYPE IS INTEGER
JRST CPOPJ1 ;
EVAN9: SKIPGE PFLAG ;WAS A PERCENT SEEN?
JRST EVAN9A ;YES, THEN THIS IS INTEGER
EVAN8F: JUMPE N,CPOPJ1 ;IGNORE SCALE IF NUMBER IS 0
EVAN8A: MOVE X1,N ;)
IDIVI X1,^D10 ;)REMOVE ANY TRAILING ZEROS
JUMPN X2,EVAN8B ;) IN MANTISSA. (REASON:
MOVE N,X1 ;) SO THAT, E.G., .1,
AOJA B,EVAN8A ;) .10, .100, ..., ARE THE SAME)
EVAN8B: TLO N,233000 ;FLOAT N
FAD N,[0]
SETZM LIBFLG ;CLEAR OVER/UNDERFLOW FLAG.
EVAN8C: CAIGE B,^D15 ;SCALE UP IF .GE. 10^15
JRST EVAN8D
SUBI B,^D14 ;SUBTRACT 14 FROM SCALE FACTOR
FMPR N,D1E14 ;MULTIPLY BY 10^14
JRST EVAN8C ;GO LOOK AT SCALE AGAIN
EVAN8D: CAML B,[EXP -^D4] ;SCALE DOWN IF .LT. 10^-4
JRST EVAN8E
ADDI B,^D18 ;ADD 18 TO SCALE
FMPR N,D1EM18 ;MULTIPLY BY 10^-18
JRST EVAN8D ;GO LOOK AT SCALE AGAIN
EVAN8E: FMPR N,DECTAB(B) ;SCALE N
TLNE F,F.MIN ;MINUS?
MOVN N,N ;YES. NEGATE IT
SKIPE LIBFLG ;SKIP IF NO OVER/UNDERFLOW.
JRST CPOPJ
JRST CPOPJ1 ;SUCCESS RETURN, NUMBER IN N
;FLAGS USED BY EVANUM
F.NUM==200000 ;DIGIT SEEN
F.MIN==100000 ;MINUS SEEN
F.MXP==40000 ;MINUS EXPONENT
F.DOT==20000 ;DECIMAL POINT SEEN
;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
SETOM AFLAG ;NO, MARK A FLAG
XARF2: JUMPE B,XARFFN
SKIPGE F
MOVSI D,(ARFET2)
HRRZ X1,0(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
JUMPL F,XALAB1 ;STRING VECTOR?
PUSHJ P,SITGEN ;YES,SAVE ADDRESS POINTER
XALAB1: 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 FLAG
PUSHJ P,NXCHK
PUSH P,LETSW
MOVMS LETSW
PUSHJ P,FORMLB ;GEN THE ARGUMENT IN REG
POP P,LETSW ;RESTORE LET SWITCH
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 ARGUMENTS NOW
FAIL <? Too many function arguments>
PUSH P,D ;RESAVE
SKIPGE B ;IN REGISTER?
PUSHJ P,EIRGP1 ;YES, TAKE IT OUT
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 ;RETURN 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) ;AND 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...
HLRZS B ;CHECK FOR CONSTANT IN CONROL
CAIE B,CONROL ;IS IT?
JRST ARGCH0 ;TOO BAD
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: FAIL <? Undefined symbol>
;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 TPE
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.
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
XINF01: TLNN C,F.RPRN
JRST ERRPRN
PUSHJ P,NXCH
POP P,D
HRRZI D,(D)
ADD D,[PUSHJ P,3]
SETOM TYPE ;INSTR IS INTEGER
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 NONE GIVEN
PUSHJ P,NXCH ;EAT THE "("
PUSHJ P,XFORMN ;CRT NEEDS NUMERIC ARGUMENT
PUSHJ P,EIRGEN ;MOVE ARGUMENT VALUE INTO REG.
SKIPGE TYPE ;IS ARGUMENT INTEGER?
JRST CRTBI1 ;YES, NO CONVERSION NEEDED
MOVE D,[PUSHJ P,FIXPNT] ;MUST FIX ARGUMENT
PUSHJ P,BUILDI ;DO IT
CRTBI1: MOVE D,[EXCH N,CRTVAL] ;SET CRTVAL, RETURN OLD VALUE
SETOM TYPE
JRST INLIOU ;GENERATE INSTRUC., CHECK FOR ")"
;
; 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,"(" ;MUST HAVE ARG
JRST ARGCH0
PUSHJ P,NXCH
PUSHJ P,GETNUM ;GET IT
FAIL <? Illegal line reference>
MOVE D,N ;STASH NO
HRLZ A,N ;AND CHECK ITS VALIDITY
MOVEI R,LINROL
PUSHJ P,SEARCH
FAIL <? Undefined line number >,1
HRLI D,(MOVEI N,) ;GEN INST.
SETOM TYPE
JRST INLIOU ;AND GO AWAY
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 ZERO IS ZERO
PUSHJ P,BUILDI ;GENERATE INSTRUCTION TO DO SO
MOVE D,[PUSHJ P,SGNB##] ;CALL SGN FUNCTION
SETOM TYPE
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,FORMLB
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,FORMLB
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 OR INTEGER
TLZ D,100 ;INTEGER, CLEAR REAL BIT
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 ;IS IT A LETTER?
JRST ERLETT ;NO, GIVE NEED A LETTER ERROR
REGLTR: PUSHJ P,SCNLT1 ;LTR TO A, LEFT JUST 7 BIT
HRRI F,SCAROL ;ASSUME SCALAR
TLNE C,F.LETT ;ANOTHER LETTER?
JRST REGFCN ;YES. GO LOOK FOR FCN REF
PUSHJ P,DIGIT ;ADD IN DIGIT IF ANY
PUSHJ P,DOLLAR ;STRING VARIABLE?
JRST REGSTR ;YES, REGISTER IT
PUSHJ P,PERCNT ;CHECK FOR PERCNT
PUSHJ P,SETFNO ;AND CHECK LEGALITY
CAIN C,"(" ;POSSIBLE ARRAY
JRST REGARY ;YES, REGISTER ARRAY
;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?
FAIL <? Undefined symbol>
HRRZ D,(B) ;YES. GET PNTR TO SCAROL
; 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
FAIL <? Undefined array>
HRRZ D,(B) ;GET POINTER TO ARAROL
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 FOLLOWS?
JRST ARRAY2 ;YES, HANDLE STRING
PUSHJ P,PERCNT ;PERCENT?
ARRAY0: PUSHJ P,SETFNO ;CHECK FOR LEGALITY
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 array,>
REGSTR: PUSHJ P,SETFST ;MARK STRING IF LEGAL
HRRI F,VSPROL ;POINTER WILL GO ON VSPROL
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 ERQUOT ;NO
RGSLX1: PUSHJ P,NXCHD
AOJA A,REGSL1
REGSL2: CAILE A,^D132 ;TOO LONG ?
FAIL <? String literal too long>
MOVEI E,4(A)
MOVN A,A
HRLI A,(A)
MOVE T,CEDLT
SUB T,FLDLT
HRRI A,(T)
MOVEI R,DITROL
PUSH P,E
PUSHJ P,RPUSH ;PUSH POINTER ONTO LITERAL ROLL
POP P,E
IDIVI E,5
JUMPE E,REGSL3
MOVEI R,DLTROL ;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, RETURN
DPB C,[POINT 7,A,13] ;YES, STORE IT
JRST NXCH ;GET NEXT CHARACTER AND RETURN
DOLLAR: TLNN C,F.DOLL ;IS IT A $?
AOSA (P) ;NO, SKIP RETURN
TLOA A,10 ;YES, MARK IT
POPJ P, ;RETURN
SETZM TYPE
JRST NXCHK ;GET NEXT CHARACTER AND RETURN
PERCNT: SETZM TYPE ;ASSUME REAL
CAME C,[XWD F.STR,"%"]
POPJ P, ;RETURN
TLO A,4 ;YES, MARK IT
SETOM TYPE ;MARK AS INTEGER
SETOM PFLAG ;WE SAW A %
JRST NXCHK ;GET NEXT
;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 OR 4; ARRAY 1 OR 5; STRING 10; STRING VECTOR 11.
;TABLE OF MIDSTATEMENT KEYWORDS:
KWTBL:
KWAALL:
KWACIF: ;COMBINED IF KEYWORDS
ASCIZ /AND/
ASCIZ /OR/
ASCIZ /IOR/
ASCIZ /XOR/
ASCIZ /EQV/
ASCIZ /IMP/
KWZCIF:
ASCIZ /THEN/
ASCIZ /GOTO/
KWAAMD:
ASCIZ /ELSE/
KWAFOR: ;FOR STMT KEYWORDS
ASCIZ /TO/
ASCIZ /STEP/
ASCIZ /BY/
KWAMOD: ;MODIFIER KEYWORDS
ASCIZ /WHILE/
ASCIZ /UNTIL/
KWZFOR: ;END OF FOR KEYWORDS
ASCIZ /IF/
ASCIZ /UNLESS/
ASCIZ /FOR/
KWZMOD:
ASCIZ /USING/
KWAONG:
ASCIZ /GOSUB/
KWZAMD:
KWZALL:
KWTTOP:
;GENERATE SERVICE ROUTINE FOR VARIOUS KEYWORD SEARCHES
DEFINE KWSBEG(U)
< IRP U
<KWS'U: PUSHJ P,KWSTUP
MOVEI X1,KWA'U
MOVEI X2,KWZ'U-1
JRST KWDSR1 > >
KWSBEG<ALL,CIF,FOR,MOD,AMD>
KWDSR1: PUSH P,X2 ;SAVE X2 FROM QST
PUSHJ P,QST ;LOOK FOR NEXT
JRST KWDSR2 ;NOT THERE
POP P,X2 ;RESTORE X2
AOS -4(P) ;FOUND, SKIP RETURN
HRRZM X1,KWDIND ;SAVE INDEX
CAIN X2,KWZALL-1 ;SEARCHING ALL KEYWORDS ?
JRST KWDSR3 ;YES, JUST RETURN
POP P,X2 ;NO, THROW AWAY
POP P,X2 ;CHAR & COUNTER
JRST KWDSR5 ;TO CONTINUE SCAN
KWDSR3: POP P,T ;RESTORE POINTER
POP P,C ;AND CHAR
KWDSR5: POP P,X2 ;X2
POP P,X1 ;AND X1
POPJ P, ;RETURN
KWDSR2: POP P,X2 ;RESTORE X2
MOVE T,(P) ;GET BACK POINTER
MOVE C,-1(P) ;AND CHAR
CAIE X2,(X1) ;FINISHED ?
AOJA X1,KWDSR1 ;NO, TRY AGAIN
JRST KWDSR3 ;YES, GO BACK
KWSTUP: EXCH X1,(P) ;SAVE X1, GET RETURN ADDRESS
PUSH P,X2 ;SAVE X2
PUSH P,C ;SAVE CHAR
PUSH P,T ;AND POINTER
PUSH P,X1 ;AND RETURN ADDRESS
PUSHJ P,QSA ;WAS I FOR THERE
ASCIZ /IFOR/
POPJ P, ;NO, ALL CLEAR
POP P,X2 ;YES, RECTIFY PDL
JRST KWDSR3 ;AND IGNORE IT
;REGISTER FUNCTION NAME
;FIRST LETTER HAS BEEN SCANNED
;IT IS POSSIBLE THAT WE HAVE SCANNED A ONE-LETTER VARIABLE NAME
;FOLLOWED BY ONE OF THE KEYWORDS "TO" , "THEN", OR "STEP".
;FIRST WE LOOK AHEAD TO SEE IF THIS IS SO;
;IF IT IS WE GO BACK TO SCALAR CODE.
REGFCN: PUSHJ P,KWSALL ;LOOK FOR KEYWORDS
JRST REGFX1 ;NONE FOUND
PUSHJ P,SETFNO ;CHECK NUMERIC LEGALITY
JRST REGL1
XLIST
LIST
REGFX1:
;HAVE DETERMINED THAT WE MUST BE SCANNING A FUNCTION NAME
;IF SYNTAX IS LEGAL.
;WE SCAN THE SECOND LETTER AND CHECK FOR
;INTRINSIC OR DEFINED FUNCTION.
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 ;CHECK NUMERIC LEGALITY
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
POP P,X1
REGF10: MOVEI C,4 ;$ IN SIXBIT.
IDPB C,X1
PUSHJ P,NXCH
PUSHJ P,SETFST ;CHECK STRING LEGALITY
REGF6: CAMN A,[SIXBIT/VAL /]
PUSHJ P,CHKCOR
REGF0: MOVEI R,IFNFLO
REGF7: CAMN A,(R)
JRST REGF8 ;FOUND FN.
AOJ R,
CAIGE R,IFNCEI
JRST REGF7
JRST REGFAL
REGF8: SUBI R,IFNFLO
MOVE B,IF2FLO(R) ;GET ENTRY IN 2ND TABLE.
MOVMS LETSW ;CAN'T BE LH(LET)
MOVEI A,2 ;INTRINSIC FCN CODE.
POPJ P, ;RETURN "XINFCN" DOES ITS OWN ")" CHECK.
;HERE TO REGISTER DEFINED FUNCTION NAME
;THE "FN" HAS ALREADY BEEN SCANNED
;SCAN IDENTIFYING LETTER AND PUTTING ENTRY IN
;FUNCTION CALL ROLL
REGDFN: PUSHJ P,CHKCOR
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 PERCNT
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
MOVE D,A ;NO, REAL FUNCTION CALL. SAVE NAME FOR ARGCHK
MOVMS LETSW
MOVEI R,FCNROL ;FUNCTION CALL ROLL
PUSHJ P,SEARCH ;USED THIS ONE YET?
FAIL <? Undefined function>
REGFC1: SUB B,FLOOR(R)
HRLI B,FCNROL
MOVEI A,3 ;DEFINED FCN CODE
POPJ P, ;DON'T CHECK FOR () YET
CHKPRN: CAIE C,"("
REGFAL: MOVEI A,4 ;FAIL IF NO PAREN
POPJ P,
SUBTTL 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 ;CAN'T - NUMERIC SPECIFIED
HRLI F,1 ;MARK STRING
SETZM TYPE
POPJ P, ;RETURN
;PUSHPR - PUSH PARTIAL RESULT ON SEXROL
PUSHPR: MOVEI R,SEXROL
MOVE A,B ;SAVE POINTER IN A
SKIPGE 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 AN 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 AN 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
MOVEI B,0 ;POSITIVE REG POINTER
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
MOVEI B,0 ;POSITIVE REG PNTR
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,DPTROL
JRST SITGN1
;SITGEN - STORE IN TEMP GEN
SITGEN: MOVEI R,DTPROL
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,SILAB1
MOVSI D,(MOVNM N,)
SILAB1: CAIE R,DTPROL ;STORE ON TMPROL?
JRST SITG2 ;NO. USE PTMROL
AOS B,TMPPNT ;WHICH TEMP TO USE?
MOVE X1,FLDTP
ADD X1,B
CAML X1,CEDTP ;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,FLDPT
JRST SITG1 ;FINISH CONSTRUCTING ADRESS POINTER
SUBTTL UTILITY SUBROUTINES
;ROUTINE TO QSA FOR "THEN" OR "GOTO" (USED IN "IF", "ON" STATEMENTS)
THENGO: PUSHJ P,QSA
ASCIZ /THE/
JRST THGOTS
MOVEM T,MULLIN ;SET MULTI-LINE
PUSHJ P,QSA
ASCIZ /N/
JRST THGERR ;BAD SPELLING !
TLNE C,F.TERM
JRST THGERR
POPJ P,
THGOTS: PUSHJ P,QSA
ASCIZ /GOTO/
THGERR: FAIL <? Illegal format where the words THEN or GO TO were expected>
TLNE C,F.DIG ;DIGIT FOLLOWS ?
POPJ P,
PUSHJ P,QSA
ASCIZ /BASDDT/
JRST ERDIGQ
JRST XBAS+1
;ERROR RETURNS
ILFORM: FAIL <? Illegal formula>
ILVAR: FAIL <? Illegal variable>
GRONK: FAIL <? Illegal format>
;COMPILATION ERROR MESSAGES OF THE FORM:
; ? A &1 WAS SEEN WHERE A &2 WAS EXPECTED
;WHERE &1 AND &2 ARE APPROPRIATE MESSAGES OR CHARACTERS.
ERCHAN: PUSHJ P,FALCHR
ASCIZ /# or :/
ERNMSN: PUSHJ P,FALCHR
ASCIZ /#/
ERDLPQ: PUSHJ P,FALCHR
ASCIZ /$ or % or "/
ERQUOT: PUSHJ P,FALCHR
ASCIZ /"/
ERDIGQ: PUSHJ P,FALCHR
ASCIZ /a digit or "/
ERTERM: PUSHJ P,FALCHR
ASCIZ /a line terminator or apostrophe/
ERLETT: PUSHJ P,FALCHR
ASCIZ /a letter/
ERLPRN: PUSHJ P,FALCHR
ASCIZ /(/
ERRPRN: PUSHJ P,FALCHR
ASCIZ /)/
EREQAL: PUSHJ P,FALCHR
ASCIZ /=/
ERCOMA: PUSHJ P,FALCHR
ASCIZ /,/
ERSCCM: PUSHJ P,FALCHR
ASCIZ /; or ,/
ERCLCM: PUSHJ P,FALCHR
ASCIZ /: or ,/
FALCHR: PUSH P,C
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
JRST FALAB1
JRST FALFF
FALAB1: 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/
JRST NXTST3
;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)
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
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
;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,FORMLN
PUSHJ P,EIRGNP
PUSHJ P,CHKINT ;
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,FORMLS ;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
GETLIN: PUSHJ P,GETNUM ;GET A LINE NUMBER
FAIL <? Illegal line reference>
HRLZ A,N ;IS IT DEFINED?
MOVEI R,LINROL ;DON'T KNOW, SEARCH LINROL
PUSHJ P,SEARCH ;WELL, IS IT?
FAIL <? Undefined line number>
SUB B,FLLIN ;FIND POSTION IN LADROL
ADD B,FLLAD ;THIS IS IT
HLRZ A,(B) ;GET REL CODE ADDRESS
ADD A,FLCOD ;ADD START OF REL CODE
POPJ P, ;RETURN
;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: MOVE B,DDCODE
CAMLE B,FLSEX
FAIL <? Not enough room>
AOS DDCODE
MOVEM D,(B)
SUB B,DDTCOD
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: 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,DDCODE ;LOC+1 OF THE INSTR
POP P,X2 ;COMPUTE ADDRS LOCATION
LDB R,[POINT 17,X2,17]
ADD X2,FLOOR(R)
JRST .-6(R)
DEFINE JRSTBL(A),<
XLIST
JRST BLD'A
LIST
>
JRSTBL CON
HALT
HALT
JRSTBL ARA
JRSTBL SVR
HALT
HALT
JRSTBL SCA
JRSTBL VSP
HALT
JRSTBL TMP
HALT
HALT
JRSTBL VAR
HALT
HALT
JRSTBL FCN
HALT
HALT
JRSTBL CAD
JRSTBL LAD
JRSTBL SAD
HALT
HALT
JRSTBL DON
JRSTBL DLT
JRSTBL DIT
JRSTBL DPT
JRSTBL DTP
BLDDON:
BLDTMP:
BLDSCA:
BLDVSP:
BLDSVR:
BLDARA:
BLDVAR:
BLDCON: HRRM X2,-1(X1)
POPJ P,
BLDFCN: HRRZ B,(X2)
ADD B,FLCOD
HRRM B,-1(X1)
POPJ P,
BLDLAD: HLRZ A,(X2)
ADD A,FLCOD
HRRM A,-1(X1)
POPJ P,
BLDDLT:
BLDDIT:
BLDDPT:
BLDDTP:
BLDSAD:
BLDCAD: MOVE R,(X2)
HRRM R,-1(X1)
SUB X1,DDTCOD
SUBI X1,1
HRRM X1,(X2)
POPJ P,
PCRLF: PUSH P,C
MOVEI C,15
PUSHJ P,OUCH
MOVEI C,12
PUSHJ P,OUCH
OUTPUT
POP P,C
POPJ P,
;SUBROUTINES FOR GENERAL ROLL MANIPULATION
CLOSUP: MOVN X1,E ;COMPUTE NEW END OF ROLL
ADDB X1,CEIL(R) ;AND STORE IT
MOVE X2,B ;CONSTRUCT BLT WORD
ADD X2,E
MOVS X2,X2
HRR X2,B
BLT X2,-1(X1) ;MOVE DOWN TOP OF ROLL
POPJ P,
OPEN2: MOVE X2,E ;IS THERE ROOM ABOVE THIS STODGY ROLL?
ADD X2,CEIL(R) ;THE NEW CEILING
CAMLE X2,FLOOR+1(R)
JRST OPENU0 ;NO ROOM, PACK OTHER ROLLS UP
ADDM E,CEIL(R) ;THERE IS ROOM, INCREMENT CEILING
POPJ P,
OPENU0: SUB B,FLOOR(R)
PUSHJ P,PANIC
ADD B,FLOOR(R)
OPENUP: CAMG R,TOPSTG ;OPEN UP THE TOP STODGY ROLL?
JRST OPEN2 ;YES. OPEN UPWARDS, NOT DOWN
MOVN X2,E
MOVE X1,TOPSTG ;DO NOT MOVE STODGY ROLLS
ADD X2,FLOOR+1(X1)
CAMGE X2,CEIL+0(X1)
JRST OPENU0 ;NEED MORE ROOM
HRL X2,FLOOR+1(X1) ;CONSTRUCT BLT WORD
SUB B,E ;FIRST WORD OF GAP
BLT X2,-1(B) ;MOVE ROLLS DOWN
MOVEI X1,1(X1) ;ADJUST POINTERS FOR ROLLS JUST BLT'D.
MOVN X2,E
OPEN1: ADDM X2,FLOOR(X1)
CAML X1,R
POPJ P,
ADDM X2,CEIL(X1)
AOJA X1,OPEN1
;RPUSH - PUSH A ON TOP OF DESIGNATED ROLL
RPUSH: MOVEI E,1
PUSHJ P,BUMPRL ;MAKE ROOM
MOVEM A,(B) ;STORE WORD
POPJ P,
;ROUTINE TO ADD TO END OF ROLL
;E CONTAINS SIZE, R CONTAINS ROLL NUMBER
BUMPRL: MOVE B,CEIL(R)
ADD B,E
CAIE R,ROLTOP
SKIPA X1,FLOOR+1(R)
HRRZ X1,.JBREL
CAMLE B,X1
JRST BUMP1
EXCH B,CEIL(R)
POPJ P,
BUMP1: MOVE B,CEIL(R)
CAIN R,SEXROL
JRST BULAB1
JRST OPENUP
BULAB1: ADDI E,^D10 ;***EXTRA 10 LOCS
PUSHJ P,OPENUP
MOVNI X1,^D10 ;TAKE BACK THE 10 LOCS
ADDM X1,CEIL(R)
POPJ P,
;DPANIC - ROUTINE FOR BASDDT CORE EXPANSION
DPANIC: MOVE C,.DDSA ;START OF BASDDT SEGMENT
ADD C,CORINC ;PLUS EXPANSION FACTOR
HRL C,.DDSA ;SET UP BLT
MOVE T,.JBREL ;HIGH ADDRESS
BLT C,(T) ;MOVE IT
SKIPN DDCODE ;IN MIDST OF BASDDT CODE
JRST DPN5 ;NO, THEN DON'T MOVE
MOVE C,DDTCOD
ADD C,CORINC
MOVE T,DDCODE ;LAST INSTR.
ADD T,CORINC ;PLUS CORE EXPANSION FACTOR
DPN7: CAML C,T ;ALL MOVED?
JRST DPN5 ;YES, NOW ZERO OLD BASDDT AREA
HRRZ T1,(C) ;GET ADDRESS OF INSTR.
CAML T1,DDTCOD ;WITHIN GENERATED CODE
CAMLE T1,.JBREL ;
JRST DPN8 ;NO
ADD T1,CORINC ;ADJUST BY CORE FACTOR
HRRM T1,(C) ;PUT BACK
DPN8: AOJA C,DPN7 ;DO NEXT
DPN5: HRL C,.DDSA ;START OF OLD BASDDT AREA
HRR C,.DDSA ;SET UP FOR BLT
AOJ C, ;IT'S DONE
CLEARM @.DDSA ;CLEAR FIRST LOCATION
MOVE T,.DDREL ;END OF BASDDT AREA
BLT C,(T) ;ZAP IT
MOVEI C,SEXROL
MOVE T,CORINC
DPN3: CAILE C,ROLTOP
JRST DPN2
ADDM T,FLOOR(C)
ADDM T,CEIL(C)
AOJA C,DPN3
DPN2: MOVE C,17
DPN2A: CAMN C,PLIST
JRST DPN6
HRRZ T1,(C)
CAML T1,DDTCOD
CAMLE T1,.JBREL
JRST DPN2B
HLRZ T,(C)
TRZ T,3740 ;MASK OUT PROCESSOR-DEPENDENT BITS
CAIE T,(CAM)
JRST DPN2B
ADD T1,CORINC
HRRM T1,(C)
DPN2B: SUB C,[XWD 1,1]
JRST DPN2A
DPN6: MOVE C,CORINC ;CORE EXPANSION FACTOR
ADDM C,.DDFF ;UPDATE .DDFF
ADDM C,DDTCOD ;UPDATE DDTCOD
ADDM C,.DDSA ;UPDATE .DDSA
ADDM C,.DDTMP ;UPDATE .DDTMP
ADDM C,.DDREL ;UPDATE .DDREL
DPN4: MOVE C,.DDSA ;NEW BASDDT AREA
SOJ C, ;NEW HIGH FOR USER
MOVEM C,.USREL ;SET IT
POPJ P,
;PANIC - ROUTINE TO COMPRESS CORE
PANIC: PUSHJ P,PRESS ;COMPRESS MEMORY
MOVE X2,TOPSTG ;IS THERE ROOM BETWEEN STODGY AND
MOVE X1,FLOOR+1(X2) ;MOVEABLE ONES?
SUB X1,CEIL(X2)
CAML X1,E ;ENOUGH ROOM?
POPJ P,
MOVE X1,.JBREL ;EXPAND BY 1K
ADDI X1,2000
CORE X1,
JRST [PUSHJ P,INLMES
ASCIZ /
? Out of room/
JRST ERRMSG]
MOVE X1,.JBREL
MOVEM X1,.DDREL
JRST PANIC ;OK. GO MOVE ROLLS
PANIC1: ERROM(60,</
? Out of room/>)
PRESS: PUSH P,G ;SAVE AC
PUSH P,A
;ROUTINE TO MOVE ROLLS UP
PRESS5: MOVEI G,ROLTOP ;HIGHEST MOVABLE ROLL
MOVE X1,.JBREL ;X1 IS PREVIOUS FLOOR
;NOTE: TOP WORD OF USR CORE IS LOST
PRESS6: MOVE X2,CEIL(G) ;GET OLD CEIL AND FLOOR
MOVE A,FLOOR(G)
SUBI X2,1 ;SET UP X2 FOR POP LOOP
ORCMI X2,777777
MOVEM X1,CEIL(G) ;NEW CEILING
PRESS7: CAILE A,(X2) ;DONE?
JRST PRESS8
POP X2,-1(X1) ;MOVE ONE WORD
SOJA X1,PRESS7
PRESS8: MOVEM X1,FLOOR(G) ;NEW FLOOR
SOS G ;GO TO NEXT LOWER ROLL
CAMLE G,TOPSTG ;IS THIS ROLL MOVEABLE?
JRST PRESS6 ;YES. GO PRESS IT.
PRES9A: POP P,A
PRESS9: POP P,G ;RESTORE G
POPJ P, ;RETURN
ERRMSG: SETZM RUNDDT ;CANT RUN DDT
SETOM NOLINE ;NO LINE NUMBER TO OUTPUT
JRST GOSR2
END