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