Trailing-Edge
-
PDP-10 Archives
-
basic17f
-
basich.mac
There are no other files named basich.mac in the archive.
TITLE BASIC V17F 23-MAR-81
SUBTTL PARAMETERS AND TABLES
;***COPYRIGHT (C) 1969,1970,1971,1972,1973,1974,1975,1976,1977,1978,
;***1979,1980,1981
;***BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
COMMENT /
THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
TRANSFERRED.
THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
CORPORATION.
DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
/
PAGE
;********** EDIT HISTORY **********
;VERSION 17F 23-MAR-81/MRB
;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
;
; 144-152 RESERVED FOR DIGITAL
; 153 10936 PROBLEMS ON "RND" FUNCTION WITH KI AND KA PROCESSORS.
; 154 10815 NESTED FN'S SOMETIMES PICK UP THEIR ARGUMENTS
; INCORRECTLY.
; 155 10935 INVERTING MATRICIES OF GREATER THAN 65
; SHOULD GIVE ERROR MESSAGE.
; 156 10379 INPUTTING SUBSCRIPTED VARIABLES FROM TTY: SOMETIMES
; FAILS AFTER THE USER HAS TYPED INCORRECT INPUT.
; 157 10329 WHEN INPUTTING FROM A SEQUENTIAL ACCESS FILE
; CHARACTERS XON(17) XOFF(19) ARE IGNORED AND A
; STRING WHICH BEGINS WITH AN APOSTROPHE(39) CAUSES
; THE REST OF THE STRING TO BE IGNORED.
; 160 RESERVED FOR DEC.
; 161 RESERVED FOR DEC.
; 162 11331 ERROR MESSAGE "FOR WITHOUT NEXT IN LINE n"
; SOMETIMES CONTAINS EMBEDDED GARBAGE AFTER THE WORD
; NEXT.
; 163 12307 PROGRAMS WHICH CONTAIN FILE STATMENTS SOMETIMES
; ILL MEM REF OR ILL UUO BECAUSE THE BOUNTARIES OF
; THE VARIOUS STORAGE AREAS IN CORE ARE NOT ADJUSTED
; CORRECTLY AT THE END OF THE VCHBUF ROUTINE.
; 164 11863 WRITING A CONCATENATED STRING WHOSE SIZE IS A
; MULTIPLE OF 5 TO A QUOTED FILE CAUSES AN ILL MEM
; REF AT EXECUTION TIME.
; 165 11456 STRANGE ERROR MESSAGES ARE RETURNED WHEN LINE
; NUMBERS CONTAIN MORE THAN 5 DIGITS.
; 166 12124 SETTING A MATRIX TO THE TRANSPOSE OF ITSELF IS TREATED
; AS A SPECIAL CASE BY THE COMPILER AND A PHANTOM MATRIX
; IS CREATED TO STORE THE INTERMEDIATE RESULT. HOWEVER,
; THE AREA SET ASIDE FOR MATRICIES DOES NOT INCLUDE SPACE
; FOR THE PHANTOM MATRIX ALTHOUGH IT IS INTENDED TO. THIS
; CAUSES THE LAST MATRIX DEFINED IN THE PROGRAM TO BE
; PUSHED OUT OF THE MATRIX AREA INTO THE STRING VECTOR
; AREA, WHICH CAUSES AN ILL MEM REF IF BASIC TRIES TO
; PRINT THE DISLOCATED MATRIX.
; 167 RESERVED FOR DEC.
; 170 RESERVED FOR DEC.
; 171 RESERVED FOR DEC.
; 172 RESERVED FOR DEC.
; 173 12133 RANDOM ACCESS SCRATCH DOES NOT SAVE FILE PROTECTIONS.
; PROTECTIONS ARE NOT PRESERVED BECAUSE AN UPDATE ENTER
; DOES NOT MODIFY THE PROTECTION. THE OLD PROTECTION
; SHOULD BE USED ON THE PREVIOUS ENTER.
; 174 11666 IN PRINT USING ROUTINES ROUNDING UP IS INCORRECT.
; 175 RESERVED FOR DEC.
; 176 RESERVED FOR DEC.
; 177 12207 INPUTTING AN UNACCEPTABLE CONSTANT TO AN INPUT STATMENT
; FOR A SUBSCRIPTED NUMERIC VARIABLE MESSES UP THE
; PUSHDOWN LIST AND THEREFORE RESULTS IN VARIOUS FAILURES.
; 200 14272 HAVE BASIC GIVE A MORE APPROPRIATE ERROR MESSAGE WHEN
; IT CANT TRANSLATE A CHAIN STATIMENT.
; 201 14347 SEE EDIT 164.
; 202 14639 BASIC CANNOT QUEUE FILES WHEN SPOOLING IS SET OFF
; IN THE MONITOR.
; 203 15275 BASIC WITH EDIT 173 INSTALLED PRODUCES A DATE75 BUG.
; 204 15274 CORRECTIONS TO EDIT 177.
; 205 15779 RESEQUENCE COMMAND LOOSES TABS AND SPACES APPEARING
; AFTER REFERENCES TO OTHER LINE NUMBERS IN A BASIC
; PROGRAM COMMAND LINE.
; 206 16982 IF THE TTY IS ASSIGNED DSK THE TTYIN ROUTINE OPENS
; TTY NO CHECK IS MADE FOR VALID DEVICE AND WILL
; REMAIN IN A RUN STATE.
; 207 17564 ADD CODE TO HANDLE "MAT INPUT" OF A MATRIX.
; 210 17870 REMOVE TEST THAT FOURCES A NUMBER TO PRINT IN
; EXPONIENTIAL NOTATION. (THE TEST WAS INACCURATE)
; 211 18404 ILL MEM REF WHEN EXECUTING COMPLEX STRING CONCATENATIONS
; 212 NONE EDIT 206 DOES NOT RETURN CORRECTLY TO THE MONITOR
; DOESNT ALLOW FOR A CONTINUE
; 213 19625 A RANDOM ACCESS FILE CAN GET DAMAGED IF THE USER TYPES
; A ^C WHILE UPDATING THE FILE.
; 214 18618 CALLING STRING FUNCTIONS WITH ILLEGAL ARGUMENTS
; PRODUCES AN ILL MEM REF.
; 215 NONE ATTEMPTING TO WRITE A NUMERIC RANDOM ACCESS RECORD
; HIGHER THAN 2**18 PRODUCES A SYSTEM ERROR.
; 216 20413 ONE EXTRA DATA LINE IS WRITTEN TO A LINE NUMBERED FILE.
; 217 20514 EDIT 207 IMPLEMENTS MAT INPUT STATEMENT FOR MATRICIES
; BUT HAS THE SIDE EFFECT THAT A REFERENCE TO A
; UNDIMENSIONED VECTOR PRODUCES AN ARRAY OF (10,10).
; 220 20881 DOING A SCRATCH OF A RANDOM ACCESS FILE CAN PRODUCE
; A SYSTEM ERROR.( replaced by edit 227)
; 221 21838 OPENING A SEQUENTIAL ACCESS FILE IN RANDOM ACCESS MODE
; USING THE FILES STATMENT CAUSES GARBAGE TO BE WRITTEN
; TO THE FILE
; 222 22126 BASIC DETECTS A RECURSIVE SUBROUTINE CALL ONLY AFTER THE
; SECOND CALL IS MADE.
; 223 NONE CODE CHANGES FOR MACRO V52 AND V53 PLUS ALL KNOWN
; REVISION HISTORY.
; 224 23511 LOW SEGMENT COMMON I/O INSTRUCTIONS ARE BEING
; OVERWRITTEN RESULTING IN EXECUTION OF ILL UUOS.
; 225 23510 THE CORE MANAGEMENT ROUTINES CAN LOSE TRACK OF WHERE
; DYNAMICALLY ALLOCATED APPEND BLOCKS BEGIN, RESULTING
; IN AN ILL MEM REF WHILE ADDRESSING WITH RANDOM APPEND
; BLOCK DATA. ALSO, APPEND BLOCK STRING CAN BECOME LOST
; DURING CORE EXPANSION, CAUSING RANDOM CONCATENATION
; OPERATIONS TO FAIL.
; 226 23006 IF AN INPUT STATMENT IS TERMINATED BY A ^Z, GIVE
; AND END OF FILE MESSAGE AND EXIT CLOSING ALL FILES.
; 227 23648 ?SYSTEM ERRORS RANDOMLY OCCUR WHEN DOING SCRATCHES OF
; RANDOM FILES. ACTUALLY DUE TO A MONITOR BUG, BUT
; CORRECTABLE BY SPECIFING A WORD COUNT BEFORE DOING
; INITIAL WRITE TO THE RANDOM FILE.(REPLACES EDIT 220)
; 230 24424 THE RESULT OF A FLOATING DIVIDE CHECK CAN END UP BEING
; MINUS INFINITY WHEN IT SHOULD BE POSITIVE. MAKE THE
; DIVIDE CHECK ROUTINE PRESERVE THE SIGN DURING FIXUP.
; 231 24323 RESEQUENCE COMMAND DOES NOT DETECT SOME INVALID
; ARGUMENTS SUCH AS IN ILLEGAL STARTING LINE NUMBER
; OR A ZERO INCREMENT.
; 232 24808 THE SPECIAL CASE OF "IF ASC(") GOTO NNN" TRIPS UP THE
; RESEQUENCER, TREATS THE REST OF THE AFTER THE QUOTE
; AS A STRING LITERAL.
; 233 NONE STOP CORE MANAGER FROM ALLOCATING EXTRA CORE WHEN
; NOT NECESSARY, ALSO WLIMINATE SOME OBSCURE BUGS IN THE
; CORE MANAGER WHICH COULD CAUSE STRING CURRUPTION.
; 234 27169 THE CATALOG COMMAND SHOULD LIST FILES IN THE DEFAULT
; DIRECTORY PATH OR THE PATH ASSOCIATED WITH THE SPECIFIED
; DEVICE. TO ALLOW WORKING IN SFD'S ALSO THE SAVE/REPLACE
; CODE SHOULD NOT LOSE TRACK OF A FILE JUST WRITTEN WHILE
; IN A SFD.
; 235 27382 ASSIGNING "NUL: TTY:" CAUSES BASIC TO LOOP AT STARTUP.
; 236 NONE SAVE X1 IN MEMORY INSTEAD OF ON THE STACK DURING APR
; INTERUPT PROCESSING THIS IS IN CASE IT WAS DDT THAT
; CAUSED THE INTERUPT(P WILL NOT BE THE STACK POINTER)
; 237 28292 PRINT USING SPECIFING A NUMERIC IMAGE WITH NO DECIMAL
; OR EXPONENT CAUSES MANY 8 DIGIT INTEGER NUMBERS TO BE
; PRINTED OUT WITH THE LAST DIGIT INCORRECT.
; 240 29079 ATTEMPTING TO INVERT A MATRIX GREATER THAN 64 BY 64
; CAUSED AN ILL MEM REF VECT1 AND VECT2 WHICH HOLDS EACH
; PIVOT POINT AS IT IS FOUND WAS 64 WORDS LONG.
; 241 XXXXX MODIFIED QUEUE TO BE ABLE TO QUEUE FILES IN UP TO
; 5 SFD'S. USES THE NEW QUEUE. MONITOR CALL(MAKES THE
; PRODUCT DEPENDENT ON THE 7.01 MONITOR).ALSO, IMPROVED
; THE METHOD BASIC CHECKS FOR SYSTEM SPOOLING.
; 242 XXXXX FIX EDIT 162
; 243 06475 FIXED PROBLEMS IN EDIT 224 AT QLSPEC:
; IN LOW SEGMENT.
; 244 XXXXX REPLACED OLD CODE TO MAKE QUEUE COMMAND WORK
; WITH FIELD IMAGE OF GALAXY (V2) 02-OCT-81.
;
;********** [END OF EDIT HISTORY] **********
;
IFNDEF GLXV4,<GLXV4==0> ;[244]SET TO ZERO FOR GALAXY VERSION 2
;[244]OR LESS, SET TO ONE FOR GALAXY
;[244]VERSIONS AFTER 2.
.JBINT=134
LOC .JBINT
TRPLOC
.JBVER=137
VERNUM=001706000244
LOC .JBVER
VERNUM
RELOC
HISEG
MLON
;AC DEFINITIONS
;PRINCIPAL USES:
N=0 ;RUNTIME ACCUMULATOR REGISTER
T=1 ;POINTER TO NXCH
T1=2
A=3 ;SEARCH ARGUMENT
B=4 ;POINTER AFTER SEARCH
C=5 ;XWD CHARACTER-FLAGS,CHAR
D=6 ;BUILD INSTS HERE
F=7 ;FLAGS
E=10
G=11
R=12 ;POINTER TO ROLL BEING USED
X1=13 ;)
X2=14 ;)TEMP REGS
Q=15 ;PUSHDOWN LIST FOR FNX ARGS.
L=16
LP=16
P=17 ;PUSHDOWN LIST
;[206] NEED EQUATES
DV.TTY=1B14 ;[206]USED TO TEST FOR TTY
DV.DSK=1B1 ;[235]DEVCHR BIT FOR DSK:
DV.DTA=1B11 ;[235]DEVCHR BIT FOR DTA: (DECTAPES)
INTERN CMDCEI,CMDFLO,DECCEI,DECFLO,RELCEI,RELFLO,STACEI
INTERN STAFLO,UUOHAN,TRPMSG
EXTERN MARGIN,FLOAT,REAINP,WRREFL,WRIPRI,FIRSFL,QLSPEC,PARAM,HEDFLG
EXTERN UFD,OBDSK2,FILNM,IBF,COPFLG,EOFFLG,RANTST,RANCNT
EXTERN DSKSYS,CATFLG,DEVICE,ININI1,OBF,FILD1,TRAIL,LEAD,EXTFG
EXTERN NEWOL1,SPEC,USGFLG,FILFLG,PROTEC,.HELPR,CORINC,MONLVL,DSKSYS
EXTERN CECAD,CECON,CEFCL,CEFOR,CEGSB,CENXT,DEVBAS,BATCH
EXTERN CEPTM,CESAD,CESEX,CESTM,CEVSP,FLARA,STOTRP,RNDIDX,RNDDAT
EXTERN FLCAD,FLCON,FLFCL,FLFOR,FLGSB,FLLIT,FLSLT,CESLT,CELIT
EXTERN FLNXT,FLPTM,FLSAD,FLSCA,FLSEX,FLSTM,FLVSP
EXTERN CELAD,FLLAD,FILCNT,REATMP,CURBAS
EXTERN CECOD,FLCOD,CETMP,FLTMP,CEARG,FLARG,CESVR,FLSVR
EXTERN CETXT,FLTXT,CELIN,FLLIN,BGNTIM,STARFL
EXTERN ARAROL ,ARATOP ,ARGROL ,C3 ,CADROL ,CEIL ,CMDROL ,CODROL
EXTERN COMTOP ,CONROL ,CURDEV ,CUREXT ,CURNAM ,DATAFF ,DATLIN ,DECROL
EXTERN ELECT1,ELECT2,ELECT3 ;[207]
EXTERN DETER ,DRMBUF ,ELETOP ,ES2 ,FADROL ,FCLROL ,FCNLNK ,FCNROL
EXTERN FILDIR ,FLOOR ,FMTPNT ,FORROL ,FRSTLN ,FUNAME ,FUNLOW ,FUNSTA
EXTERN GSBROL ,HPOS ,INPFLA ,.JBFF ,.JBOPC ,.JBREL ,.JBREN
EXTERN .JBSA ,LADROL ,LASTLN ,LINROL ,LITROL
EXTERN LOWEST ,LOWSTA ,LZ ,MINFLG ,NUMRES ,NXTROL
EXTERN OLDFLA ,ONCESW ,PAKFLA ,PINPUT ,PIVOT ,PLIST ,PREAD ,PSHPNT
EXTERN PSHROL ,PTMROL ,REGPNT ,RELROL ,RENFLA ,ROLMSK ,ROLTOP ,RUNFLA
EXTERN PTHBLK,QUEBLK,QUELEN,FILBLK ;[234] PATH BLOCK
EXTERN SADROL ,SB1M1 ,SB2M1 ,SCAROL ,SEQPNT ,SEXROL ,STAROL ,STMROL,SLTROL
EXTERN SVRBOT ,SVRROL ,SVRTOP ,SX ,TABVAL ,TEMP1 ,TEMP2,ZONFLG
EXTERN TEMP3 ,TMPLOW ,TMPPNT ,TMPROL ,TOPSTG ,TTYBUF ,TXTROL
EXTERN TYO ,VARFRE ,VARROL ,VECT1 ,VECT2 ,VPAKFL
EXTERN VSPROL,TYI,PAKFLG,SJOBSA,SJOBRL,SWAPSS,CHAFLG
EXTERN LETSW,MTIME,TABLE,QUOTBL,PAGLIM,INNDSK,OUTTDS
EXTERN BLOCK,EXTD,MODBLK,STRLEN,LASREC,POINT,TRPLOC
EXTERN MASAPP,NUMMSP,NUMAPP,APPLST,VRFBOT,VRFTOP,SRTDBA,GTSTS
EXTERN APPMAX ;[224] MAX APPEND SIZE
EXTERN STRFCN,STRPTR,STRCTR,VALPTR,FILTYP,COMTIM,VRFBTB
EXTERN FLREF,CEREF,REFROL,CHAFL2,USETOD,USETID
EXTERN IBDSK,RUNLIN,STWDSK,STQDSK,TEMLOC,IFFLAG,VRFSET
EXTERN TTYPAG,MARWAI,PAGCNT,IBDSK2,MIDSAV,LOCLOF
EXTERN UUOH,.JBAPR,.JBTPC,UXFLAG,CLOSED,RENAMD,IFIFG,ODF
EXTERN EX1,LIBFLG,INDSK,STODSK,REVFL,RETUR1,PINPNM,INVFLG
EXTERN INVLIM ;[240] INVERSE LIMIT
EXTERN INVLRG,SAVE1,SAVI,RENSW,TRNFLG,TRNFL2,SORCLN,QLIST
EXTERN SAVEX1 ;[236]TEMP FOR APR INTERUPTS
EXTERN DREL,INITO,FILD,ACTBL,LOK,LOKUP,LINB0,OUTDSK
EXTERN STADSK,OBDSK,ENT,ENTDSK,BA,IFNFLG,QUOFL1,NUMCOT,QUOFLG
STAFLO:
Z XCHAN+20000(SIXBIT / CHA/)
Z XDATA+40000(SIXBIT / DAT/)
Z XDEF+40000(SIXBIT / DEF/)
Z XDIM(SIXBIT / DIM/)
Z XEND(SIXBIT / END/)
Z XFILE+40000(SIXBIT/ FIL/)
Z XFNEND+60000(SIXBIT / FNE/)
Z XFOR+20000(SIXBIT / FOR/)
Z XGOSUB+60000(SIXBIT / GOS/)
Z XGOTO+40000(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 XPAG+60000(SIXBIT / PAG/)
Z XPRINT+60000(SIXBIT / PRI/)
Z XQUO+60000(SIXBIT / QUO/)
Z XRAN+60000(SIXBIT / RAN/)
Z XREAD+60000(SIXBIT / REA/)
Z NXTST1(SIXBIT / REM/)
Z XREST+60000(SIXBIT / RES/)
Z XRETRN+60000(SIXBIT / RET/)
Z XSCRAT+60000(SIXBIT/ SCR/)
Z XSET+20000(SIXBIT / SET/)
Z XSTOP+40000(SIXBIT / STO/)
Z XWRIT+60000(SIXBIT/ WRI/)
STACEI:
;TABLE OF BASIC COMMANDS
DEFINE YYY (A,B)<
EXP SIXBIT /A/ + 'A'ER + 'B'0000>
CMDFLO: YYY BYE
YYY CAT
YYY COP
YYY DEL
YYY GOO
YYY HEL
YYY KEY
YYY LEN
YYY LIS
YYY MON
YYY NEW
YYY OLD
YYY QUE
YYY REN
YYY REP
YYY RES
YYY RUN
YYY SAV
YYY SCR
YYY SYS
YYY TAP
YYY UNS
YYY WEA
CMDCEI:
;CHARACTER TYPE TABLE.
;FLAGS IN LEFT HALF OF CTTAB+<LETTER> FOR <LETTER> BELOW 100,
;FLAGS IN RIGHT HALF OF CTTAB+<LETTER-100> OTHERWISE.
DEFINE WWW (FL,VAL)<
XLIST
FL=< Z 0,(VAL)>
LIST>
WWW F.APOS,1B0 ; '
WWW F.COMA,1B1 ; ,
WWW F.CR,1B2 ; <RETURN, OR LF,VT,FFEED>
WWW F.DIG,1B3 ; <NUMERAL>
WWW F.DOLL,1B17
WWW F.EQAL,1B4 ; =
WWW F.ESC,1B5 ; <ESCAPE OR ALTMODE>
WWW F.LCAS,1B6 ; <LOWER CASE LETTER>
WWW F.LETT,1B7 ; <LOWER OR UPPER CASE LETTER>
WWW F.STR,1B8 ; (
WWW F.MINS,1B9 ; -
WWW F.PER,1B10 ; .
WWW F.PLUS,1B11 ; +
WWW F.QUOT,1B12 ; "
WWW F.RPRN,1B13 ; )
WWW F.SLSH,1B14 ; /
WWW F.STAR,1B15 ; *
WWW F.SPTB,1B16 ; <SPACE OR TAB>
F.NU=0 ;ASCII CODES THAT ARE TREATED AS NULLS.
F.OTH=0 ;OTHER CHARACTERS ANALYSED BY BASIC WITHOUT THE USE OF FLAGS.
F.TERM=F.CR+F.APOS ;EITHER TERMINATES THE ANALYZABLE PORTION OF A BASIC STATEMENT.
CTTAB:
XWD F.NU, F.STR ;NULL , @
XWD F.STR, F.LETT ; , A
XWD F.STR, F.LETT ; , B
XWD F.STR, F.LETT ; , C
XWD F.STR, F.LETT ; , D
XWD F.STR, F.LETT ; , E
XWD F.STR, F.LETT ; , F
XWD F.STR, F.LETT ; , G
XWD F.STR, F.LETT ; , H
XWD F.SPTB, F.LETT ;TAB , I
XWD F.CR, F.LETT ;LF , J
XWD F.CR, F.LETT ;VER.TAB, K
XWD F.CR, F.LETT ;FFEED , L
XWD F.CR, F.LETT ;CR , M
XWD F.STR, F.LETT ; , N
XWD F.STR, F.LETT ; , O
XWD F.STR, F.LETT ; , P
XWD F.STR, F.LETT ; , Q
XWD F.STR, F.LETT ; , R
XWD F.STR, F.LETT ; , S
XWD F.STR, F.LETT ; , T
XWD F.STR, F.LETT ; , U
XWD F.STR, F.LETT ; , V
XWD F.STR, F.LETT ; , W
XWD F.STR, F.LETT ; , X
XWD F.STR, F.LETT ; , Y
XWD F.STR, F.LETT ; , Z
XWD F.ESC, F.STR ;ESC , [
XWD F.STR, F.STR ; , \
XWD F.STR, F.STR ; , ]
XWD F.STR, F.OTH ; , ^
XWD F.STR, F.OTH ; , _
XWD F.SPTB, F.STR ;SPACE , <ACCENT GRAVE>
XWD F.STR, F.LETT+F.LCAS ; ! , <LOWER CASE> A
XWD F.QUOT, F.LETT+F.LCAS ; " , <LOWER CASE> B
XWD F.STR, F.LETT+F.LCAS ; # , <LOWER CASE> C
XWD F.DOLL, F.LETT+F.LCAS ; $ , <LOWER CASE> D
XWD F.STR, F.LETT+F.LCAS ; % , <LOWER CASE> E
XWD F.OTH, F.LETT+F.LCAS ; & , <LOWER CASE> F
XWD F.APOS, F.LETT+F.LCAS ; ' , <LOWER CASE> G
XWD F.OTH, F.LETT+F.LCAS ; ( , <LOWER CASE> H
XWD F.RPRN, F.LETT+F.LCAS ; ) , <LOWER CASE> I
XWD F.STAR, F.LETT+F.LCAS ; * , <LOWER CASE> J
XWD F.PLUS, F.LETT+F.LCAS ; + , <LOWER CASE> K
XWD F.COMA, F.LETT+F.LCAS ; , , <LOWER CASE> L
XWD F.MINS, F.LETT+F.LCAS ; - , <LOWER CASE> M
XWD F.PER, F.LETT+F.LCAS ; . , <LOWER CASE> N
XWD F.SLSH, F.LETT+F.LCAS ; / , <LOWER CASE> O
XWD F.DIG, F.LETT+F.LCAS ; 0 , <LOWER CASE> P
XWD F.DIG, F.LETT+F.LCAS ; 1 , <LOWER CASE> Q
XWD F.DIG, F.LETT+F.LCAS ; 2 , <LOWER CASE> R
XWD F.DIG, F.LETT+F.LCAS ; 3 , <LOWER CASE> S
XWD F.DIG, F.LETT+F.LCAS ; 4 , <LOWER CASE> T
XWD F.DIG, F.LETT+F.LCAS ; 5 , <LOWER CASE> U
XWD F.DIG, F.LETT+F.LCAS ; 6 , <LOWER CASE> V
XWD F.DIG, F.LETT+F.LCAS ; 7 , <LOWER CASE> W
XWD F.DIG, F.LETT+F.LCAS ; 8 , <LOWER CASE> X
XWD F.DIG, F.LETT+F.LCAS ; 9 , <LOWER CASE> Y
XWD F.OTH, F.LETT+F.LCAS ; : , <LOWER CASE> Z
XWD F.OTH, F.STR ; ; , <LEFT BRACE>
XWD F.OTH, F.STR ; < , <VERTICAL BAR>
XWD F.EQAL, F.STR ; = , <RIGHT BRACE>
XWD F.OTH, F.STR ; > , <TILDE>
XWD F.STR, F.STR ; ? , <RUBOUT>
DEFINE FAIL (A,AC)<
XLIST
XWD 001000+AC'00,[ASCIZ /A/]
LIST
>
%OPD=1 ;OPDEF UUO COUNTER
DEFINE OPCNT (A)<
%OPD=%OPD+1
IFG %OPD-37,<PRINTX <TOO MANY UUO'S>>
OPDEF A [<%OPD>B8]>
OPCNT (PRNM)
OPCNT (PRDL)
OPCNT (PRNTB)
OPCNT (GOSUB)
OPCNT (ARFET1)
OPCNT (ARFET2)
OPCNT (ARSTO1)
OPCNT (ARSTO2)
OPCNT (ARSTN1)
OPCNT (ARSTN2)
OPCNT (DATA)
OPCNT (ADATA1)
OPCNT (ADATA2)
OPCNT (SDIM)
OPCNT (MATRD)
OPCNT (MATPR)
OPCNT (MATSCA)
OPCNT (MATCON)
OPCNT (MATIDN)
OPCNT (MATTRN)
OPCNT (MATINV)
OPCNT (MATADD)
OPCNT (MATSUB)
OPCNT (MATMPY)
OPCNT (MATZER)
OPCNT (STRUUO)
OPCNT (SVRADR)
OPCNT (PRSTR)
OPCNT (DONFOR)
OPCNT (MATINP)
MAXUUO=%OPD
OPDEF QUEUE. [CALLI 201]
STAR=.
LOC 41
JSR UUOH
RELOC STAR
UUOHAN: PUSH P,UUOH ;RETURN ADDRS ON PUSH-DOWN LIST
LDB X1,[POINT 9,40,8]
IFL MAXUUO-37, <
CAILE X1,MAXUUO
JRST INLSYS ;ILLEGAL UUO.
>
UUOTBL: JRST .(X1)
JRST FAILER
JRST PRNMER
JRST PRDLER
JRST PRNTBR
JRST GOSBER
JRST AFT1ER
JRST AFT2ER
JRST AST1ER
JRST AST2ER
JRST ASN1ER
JRST ASN2ER
JRST DSKRT
JRST ADT1ER
JRST ADT2ER
JRST SDIMER
JRST MTRDER
JRST MTPRER
JRST MTSCER
JRST MTCNER
JRST MTIDER
JRST MTTNER
JRST MTIVER
JRST MTADER
JRST MTSBER
JRST MTMYER
JRST MTZRER
JRST SUUOEX
JRST SAD1ER
JRST PRSTRR
JRST FORCOM
JRST MATIN
DSKRT: LDB X1,[POINT 4,40,12]
JRST .+1(X1)
JRST DATAER ;DATA 0, UUO.
JRST RANUM ;DATA 1, -- R.A.
JRST RANUM1 ;DATA 2, -- R.A.
JRST RANUM2 ;DATA 3, -- R.A.
JRST RANSTR ;DATA 4, -- R.A.
SUUOEX: LDB X1,[POINT 4,40,12] ;STRING UUOS USE THE AC FIELD
CAILE X1,MASUUO ;AS AN EXTENSION OF THE OPCODE.
HALT .
UUOSTR: JRST .(X1)
JRST PUTSTR
JRST COMSTR
JRST INSTR
JRST GETVEC
JRST PUTVEC
JRST STRCHA
MASUUO=.-UUOSTR-1
OPDEF STRSTO [STRUUO 1,]
OPDEF STRIF [STRUUO 2,]
OPDEF STRIN [STRUUO 3,]
OPDEF VECFET [STRUUO 4,]
OPDEF VECPUT [STRUUO 5,]
OPDEF STOCHA [STRUUO 6,]
;TABLE OF INTRINSIC FUNCTIONS
DEFINE ZZZ. (X) <
<SIXBIT /X/> ;[223]NEEDED BY MACRO V53
>
IFNFLO:
ZZZ. (ABS)
ZZZ. (ASC)
ZZZ. (ATN)
ZZZ. (CHR$)
ZZZ. (CLOG)
ZZZ. (COS)
ZZZ. (COT)
ZZZ. (DET)
ZZZ. (EXP)
ZZZ. (INSTR)
ZZZ. (INT)
ZZZ. (LEFT$)
ZZZ. (LEN)
ZZZ. (LN)
ZZZ. (LOC)
ZZZ. (LOF)
ZZZ. (LOG)
ZZZ. (LOGE)
ZZZ. (LOG10)
ZZZ. (MID$)
ZZZ. (NUM)
ZZZ. (RIGHT$)
ZZZ. (RND)
ZZZ. (SGN)
ZZZ. (SIN)
ZZZ. (SPACE$)
ZZZ. (SQR)
ZZZ. (SQRT)
ZZZ. (STR$)
ZZZ. (TAN)
ZZZ. (TIM)
ZZZ. (VAL)
IFNCEI:
%FN=1
DEFINE ZZZ. (X) <
OPDEF ZZZZ. [%FN]
ZZZZ.
%FN=%FN+1
>
IF2FLO:
ZZZ. (ABS)
ZZZ. (ASC)
XWD -1,ATANB
XWD -1,CHRB
XWD -1,CLOGB
XWD -1,COSB
XWD -1,COTB
ZZZ. (DET)
XWD -1,EXPB
XWD IF31,INSTRB
XWD -1,INTB
XWD IF32,LEFTB
XWD +1,LENB
XWD -1,LOGB
ZZZ. (LOC)
ZZZ. (LOF)
XWD -1,LOGB
XWD -1,LOGB
XWD -1,CLOGB
XWD IF33,MIDB
ZZZ. (NUM)
XWD IF32,RIGHTB
XWD 0,RNDB
ZZZ. (SGN)
XWD -1,SINB
XWD -1,SPACEB
XWD -1,SQRTB
XWD -1,SQRTB
XWD -1,STRB
XWD -1,TANB
ZZZ. (TIM)
XWD +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 LINNUM
SUBTTL COMMAND SCANNER AND EDITOR
;COLD START
BASIC: JRST 1,.+2
JRST 1,.+1
SETO A, ;****REMOVE THESE 3 INSTRUCTIONS
TTCALL 6,A ;****(BUT NOT THE LABEL BASIC)
RESET
TTCALL 7,A ;****WHEN 5.03 IS NO LONGER SUPPORTED.
MOVE P,PLIST
SETZM IFIFG
SETZM QUOTBL
SETZM COMTIM
SETZM MARWAI
MOVEI X1,^D72
MOVEM X1,MARGIN
MOVEI X1,^D9
SETZM ACTBL-1(X1)
SOJG X1,.-1
SETZM HPOS
SETZM TRPLOC+2
SETZM TRPLOC+3
SETOM PAGLIM
SETZM CHAFLG
SETZM CHAFL2
SETZM UXFLAG
SETZB LP,ODF
SETZM MTIME
SETOM RENFLA ;ALLOW REENTERS.
SKIPN ONCESW ;FIRST TIME, SET THINGS UP
JRST BASI1
SETZM CURNAM
PJOB X1, ;BATCHED?
HRLZI X1,(X1)
HRRI X1,40
SETZM BATCH
GETTAB X1,
JRST BASI3
TLNN X1,000200
JRST .+3
SETZM .JBINT ;BATCH, DON'T TRAP ON CONTROL C.
SETOM BATCH
BASI3: SETZM RANCNT
HLRZ T,.JBSA
MOVEM T,SJOBSA
MOVEM T,FLTXT ;TXTROL ON BOTTOM OF FREE SPACE
MOVEM T,CETXT
MOVE T,.JBREL ;LINROL ON TOP
MOVEM T,SJOBRL
MOVEM T,FLLIN
MOVEM T,CELIN
SETZM PAKFLG ;DON'T HAVE TO CRUNCH CORE YET.
HRRZI T,REENTR
HRRM T,.JBREN
SETZM DSKSYS
SETZM SWAPSS
HRLZI X1,400000
MOVEM X1,MONLVL ;MONLVL CONTAINS THE
MOVE X1,[XWD 17,11] ;PROTECTION CODE "DON'T DELETE"
GETTAB X1, ;BIT APPROPRIATE TO THE MONITOR
JRST BASI2 ;LEVEL UNDER WHICH BASIC IS RUNNING.
TLNN X1,(7B9)
JRST BASI0
HRLZI T,100000
MOVEM T,MONLVL
BASI0: TLNE X1,200000
SETOM SWAPSS ;SWAPPING SYSTEM.
TLNE X1,400000
SETOM DSKSYS ;DISK SYSTEM.
BASI2: SETZM ONCESW
BASI1: PUSHJ P,TTYIN ;SET UP BUFFERS AND INIT TTY
SKIPE CURNAM
JRST UXIT
SETZM RUNFLA
PUSHJ P,INLMES
ASCIZ /
READY, FOR HELP TYPE HELP.
/
FIXUP: OUTPUT ;WRITE LAST MESSAGE
SKIPE CURNAM
JRST CLR
MOVE X1,[SIXBIT /DSK/] ;INITIALIZE BASIC WITH
MOVEM X1,CURDEV ;CURRENT DEVICE==DSK
MOVE X1,[SIXBIT /BAS/] ;CURRENT EXT==BAS
MOVEM X1,CUREXT
SETZM CURBAS ;CURRENT DEV < > FAKED BAS.
MOVE X1,[SIXBIT /NONAME/]
MOVEM X1,CURNAM ;CURRENT NAME==NONAME
CLR: SETZM IFIFG
SETZM ODF
MOVEI X1,OVFLCM ;IGNORE OVFLOW DURING COMMANDS.
HRRM X1,.JBAPR
MOVEI X1,10 ;SETUP ARITH OVFLOW TRAP
APRENB X1,
MOVEI X1,TXTROL
MOVEM X1,TOPSTG ;EDIT TIME. ONLY TXTROL IS STODGY.
; ;OTHER ROLLS MOVE.
MOVE T,CELIN ;CLOBBER ALL COMPILE ROLLS WITH "CELIN"
MOVEI X1,LINROL ;PROTECT TXTROL +LINROL FROM CLOBBER:
PUSHJ P,CLOB
;FALL INTO MAINLP
;MAIN LOOP FOR EDITOR/MONITOR
MAINLP: MOVE P,PLIST
PUSHJ P,LOCKOF ;TURN OFF REENTR LOCK
SKIPE CHAFLG ;CHAINING?
JRST OLDER ;YES.
PUSHJ P,INLINE ;READ A LINE
PUSHJ P,GETDNM ;LOOK FOR SEQUENCE NO
JRST COMMAN ;NONE. GO INTERPRET COMMAND
SKIPE PAKFLG ;CRUNCH CORE?
PUSHJ P,SCRER3 ;YES.
;HERE, WE HAVE SEQUENCED LINE INPUT. NUMBER IS IN N,
;POINTER TO FIRST CHAR AFTER NUMBER IS IN T
PUSHJ P,LOCKON
PUSHJ P,ERASE
PUSHJ P,INSERT
PUSHJ P,LOCKOF
JRST MAINLP
;HERE ON COMMAND
COMMAN: MOVEI R,CMDROL
TLNE C,F.CR ;TEST FOR NULL COMMAND
JRST MAINLP
PUSHJ P,SCNLT1 ;SCAN COMMAND
PUSHJ P,SCNLT2
JRST COMM1 ;SECOND CHAR NOT A LETTER
PUSHJ P,SCNLT3
JRST COMM1 ;THIRD CHAR NOT A LETTER
;NOW THE FIRST THREE LETTERS OF THE COMMAND ARE PACKED IN LH OF A.
PUSHJ P,SEARCH ;LOOK FOR COMMAND
JRST COMM1 ;NOT FOUND
HRRZ X1,(B)
JRST (X1)
;"GOODBY" OR "BYE"
GOOER: PUSHJ P,QSA ;"GOODBYE"
ASCIZ /DBYE/
JRST BYEER ;AND "BYE"
BYEER: MOVE A,[XWD 17,11] ;BYE AND GOO ARE NOT IMPLEMENTED
GETTAB A, ;FOR NON-LOGIN SYSTEMS--SO
JRST .+1 ;FIND OUT WHAT TYPE OF SYSTEM
TLNE A,100000 ;BASIC IS RUNNING UNDER.
JRST BYEER5 ;LOGIN SYSTEM--GO EXECUTE.
MOVEI T,NOTIMP ;NON-LOGIN SYSTEM--SEND MESSAGE OUT.
JRST ERRMSG
BYEER5: MOVSI A,(SIXBIT /SYS/)
MOVEM A,FILDIR
MOVE A,[SIXBIT /LOGOUT/]
MOVEM A,FILDIR+1
SETZM FILDIR+2
SETZM FILDIR+3
SETZM FILDIR+4
SETZM FILDIR+5
MOVSI A,1
HRRI A,FILDIR
RUN A,
MOVEI T,BY1
JRST ERRMSG
BY1: ASCIZ /
? LOGOUT FAILED -- TRY AGAIN
/
;"CATALOG" OR "CAT"
; RESULTS IN A LISTING OF USER PROGRAMS ON TTY
CATER: PUSHJ P,QSA
ASCIZ /ALOG/
JRST .+1
SETZM CATFLG ;CATFLG IS ZERO FOR DSK, NE 0 FOR DTA'S.
SETZM DEVBAS ;DEVBAS IS ZERO FOR DEVICE NOT BAS.
MOVSI A,(SIXBIT/DSK/)
TLNE C,F.CR
JRST CAT2
PUSHJ P,ATOMSZ
JUMPE A,CAT000
MOVE B,A
DEVCHR B,
JUMPN B,CAT01
CAMN A,[SIXBIT/BAS/]
JRST CAT00
MOVE T,A
JRST NOGETD
CAT000: CAME C,[XWD F.STAR,"*"]
JRST CAT0
PUSHJ P,NXCH
CAME C,[XWD F.STAR,"*"]
JRST COMM1
PUSHJ P,NXCH
CAME C,[XWD F.STAR,"*"]
JRST COMM1
PUSHJ P,NXCH
MOVSI A,(SIXBIT/BAS/)
MOVE B,A
DEVCHR B,
JUMPN B,CAT01
CAT00: SETOM DEVBAS ;< 0 SAYS NON-EXIST. DEV BAS.
CAT0: MOVSI A,(SIXBIT/DSK/)
CAT01: CAIN C,72
PUSHJ P,NXCH
TLNN C,F.CR
JRST COMM1
CAT2: MOVEM A,DEVICE
DEVCHR A,
JUMPN A,CAT3
MOVE T,DEVICE
JRST NOGETD
CAT3: TLNE A,200100
JRST .+3
MOVEI T,CATFAL
JRST ERRMSG
TLNN A,200000
SETOM CATFLG
MOVEI N,IBF ;ININI1: 14
MOVEM N,DEVICE+1 ;DEVICE:
MOVEI N,14 ;DEVICE+1: IBF
MOVEM N,ININI1
OPEN 3,ININI1 ;TRY TO GET THE CAT DEVICE.
JRST [MOVE T,DEVICE
SKIPE DEVBAS
MOVSI T,(SIXBIT/BAS/)
JRST NOGETD]
MOVEI N,DRMBUF
MOVEM N,.JBFF
INBUF 3,1
INIT 2,1 ;INIT THE TTY FOR LISTING.
SIXBIT /TTY/
XWD OBF,
JRST [MOVEI T,(SIXBIT/TTY/)
JRST NOGETD]
MOVEI N,LINB2
MOVEM N,.JBFF
OUTBUF 2,1
PUSHJ P,CLRF
SKIPN CATFLG
JRST DSKHAN
DTAHAN: USETI 3,144 ;POINT TO THE DIRECTORY BLOCK.
INPUT 3,
STATUS 3,D
TRNE D,740000 ;ERROR?
JRST CATERR ;YES.
MOVEI X2,^D82 ;NO.
MOVEI B,^D22
MOVEM B,CATFLG
ADD X2,IBF+1 ;SET UP BYTE POINTERS TO FILENAMES
ADD B,X2 ;AND EXTENSIONS.
CATLP: ILDB N,X2
ILDB 1,B
JUMPE N,CATTST ;GO TO CATTST IF NO FILENAME HERE.
MOVEM N,FILNM
HLLZM 1,FILNM+1
PUSHJ P,CLSTU3 ;OUTPUT FILENAME AND EXT.
CATTST: SOSG CATFLG ;ONLY 22 FILES ON A DECTAPE.
JRST UXIT
JRST CATLP
DSKHAN: SKIPL DEVBAS ;FAKED DEVICE BAS?
JRST DSKH0
MOVE T1,[XWD 5,1] ;YES.
JRST DSKH1
DSKH0: MOVE T1,DEVICE ;NO. PREPARE FOR LOOKUP.
;**; [234] @ DSKH0 + 1L, REPLACE 9 LINES, EGM, 28-MAR-79
MOVEM T1,PTHBLK ;[234] SETUP PATH BLOCK
SETZM PTHBLK+1 ;[234] CLEAR UNUSED
SETZM PTHBLK+2 ;[234] WORDS OF BLOCK
MOVE T1,[^D8,,PTHBLK] ;[234] ROOM FOR 5 SFDS
PATH. T1, ;[234] GET CURRENT PATH
JRST [ MOVE T1,DEVICE ;[234] CAN'T - TRY OLD WAY
DEVPPN T1, ;[234] GET PPN OF DEVICE
SKIPA ;[234] THAT DOESN'T WORK EITHER
JRST DSKH1 ;[234] GO SETUP FOR UFD
MOVE T1,DEVICE ;[234] GET CURRENT DEVICE BACK
MOVE N,T ;[234] GET SPECIFIED DEVICE
CAMN T1,[SIXBIT/SYS/] ;[234] IS CURRENT DEVICE SYS?
SKIPA T1,[XWD 1,4] ;[234] YES - USE SYS: PPN
GETPPN T1, ;[234] NO - GET PPN OF DEVICE
CAMN N,[SIXBIT/BAS/] ;[234] IS SPECIFIED DEVICE BAS?
MOVE T1,[XWD 5,1] ;[234] YES - USE BAS: PPN
JRST DSKH1] ;[234] AND SETUP FOR UFD
SKIPE PTHBLK+3 ;[234] IS PATH THRU ANY SFDS
JRST DSKH2 ;[234] YES - SETUP FOR SFD
MOVE T1,PTHBLK+2 ;[234] NO - GET DEVICE PPN
DSKH1: MOVEM T1,UFD ;UFD : P# ,P#
MOVSI N,(SIXBIT/UFD/) ;UFD+1:SIXBIT /UFD/
MOVEM N,UFD+1 ;UFD+2:
SETZM UFD+2
MOVE N,[XWD 1,1] ;UFD+3: 1 ,, 1
MOVEM N,UFD+3
;**; [234] @ DSKH1 + 6L, ADD 13 LINES, EGM, 28-MAR-79
JRST DSKH3 ;[234] GO DO LOOKUP
DSKH2: SETZ T, ;[234] INIT COUNTER
SKIPN T1,PTHBLK+7(T) ;[234] SEARCH FOR LAST SFD
SOJA T,.-1 ;[234] WE KNOW THERE IS AT LEAST 1
MOVEM T1,UFD ;[234] SAVE AS FILENAME
SETZM PTHBLK+7(T) ;[234] REMOVE FROM PATH BLOCK
MOVSI N,(SIXBIT /SFD/) ;[234] LOOK IN SFD
MOVEM N,UFD+1 ;[234] FOR FILES
SETZM UFD+2 ;[234]
MOVEI N,PTHBLK ;[234] SETUP PATH POINTER
MOVEM N,UFD+3 ;[234] FOR LOOKUP
SETZM PTHBLK+1 ;[234] DON'T NEED PATH FLAGS
DSKH3: LOOKUP 3,UFD ;[234]LOOKUP DIRECTORY
JRST DSKERR
JRST CLSTU1
DSKERR: PUSHJ P,INLMES
ASCIZ /
? FILE /
SETZM ODF
SETZM HPOS
HLRZ T,DEVICE
CAIN T,<SIXBIT/ DSK/>
JRST DSKER1
MOVE T,DEVICE
PUSHJ P,PRNSIX
MOVSI T,320000
PUSHJ P,PRNSIX
DSKER1: HLRZ T,UFD
PUSHJ P,PRTOCT
MOVSI T,14
PUSHJ P,PRNSIX
HRRZ T,UFD
PUSHJ P,PRTOCT
HLRZ T,UFD+1
CAIN T,<SIXBIT/ BAS/>
JRST DSKER2
TLO T,16
PUSHJ P,PRNSIX
DSKER2: PUSHJ P,INLMES
ASCIZ / NOT FOUND
/
OUTPUT
JRST BASIC
CLSTU1: SOSLE IBF+2
JRST CLSTU5
CLSTU2: INPUT 3, ;FOR ERROR AND EOF CHECK
STATUS 3,D
TRNN D,760000 ;ERROR OR EOF?
JRST CLSTU5 ;NO.
TRZE D,20000 ;YES, EOF?
JRST UXIT ;YES, EOF.
CATERR: MOVEI T,INLSYS ;NO, ERROR.
JRST ERRMSG
CLSTU5: ILDB N,IBF+1
JUMPE N,CLSTU2
MOVEM N,FILNM
SOS IBF+2
ILDB X2,IBF+1
HLLZM X2,FILNM+1
PUSHJ P,CLSTU3 ;OUTPUT FILENAME AND EXT.
JRST CLSTU1
CLSTU3: MOVEI G,6
MOVE N,FILNM
PUSHJ P,SIXOUT
MOVE N,FILNM+1
JUMPE N,CLRF
JUMPE G,CLSTU4
MOVEI X1,40
PUSHJ P,PUT
SOJG G,.-1
CLSTU4: MOVEI X1,56
PUSHJ P,PUT
MOVEI G,3
PUSHJ P,SIXOUT
JRST CLRF
SIXOUT: MOVE L,[POINT 6,0]
SIX02: ILDB X1,L
JUMPE X1,CPOPJ
ADDI X1,40
PUSHJ P,PUT
SOJ G,
TLNN L,770000
POPJ P,
JRST SIX02
CLRF: MOVEI X1,15
PUSHJ P,PUT
MOVEI X1,12
PUT: SOSG OBF+2 ;PREPARE OUTPUT
OUTPUT 2,
IDPB X1,OBF+1
POPJ P,
;"COPY" HAS THE FORM:
;
; COPY DEVICE:FILENAME.EXT > DEVICE:FILENAME.EXT
;
;COPER USES THE FILENAME ANALYZER ROUTINE FILNAM AND THE FLAG COPFLG
;WHEN ANALYZING ITS TWO ARGS. COPER SETS COPFLG TO -1 BEFORE
;CALLING FILNAM AND THEN ENTERS FILNAM AT FILNM1. ALL OTHER ROUTINES
;THAT USE FILNAM ENTER THROUGH AN ENTRY POINT THAT SETS
;COPFLG TO 0. COPFLG IS USED BY FILNAM IN THE SPECIAL CASE IN WHICH
;A DEVICE BUT NOT A FILENAME IS SPECIFIED. WHEN FILNAM IS FINISHED
;PROCESSING THAT SPECIAL CASE, IT SETS COPFLG TO 0.
COPER: PUSHJ P,QSA
ASCIZ /Y/
JRST .+1
SETOM COPFLG
PUSHJ P,FILNM1 ;PROCESS THE FIRST ARG.
JUMP IBF+1
MOVEI A,">"
CAIE A,(C)
JRST COMM1
PUSHJ P,NXCH
MOVE A,COPFLG
MOVEM A,CATFLG ;STORE TEMPORARILY IN CATFLG.
SETZM IBF ;IBF: 0
MOVEI N,TYI ;IBF+1: DEVICE
MOVEM N,IBF+2 ;IBF+2: TYI
MOVE N,FILDIR
MOVEM N,FILD1 ;FILD1: FILENAME
MOVE N,FILDIR+1 ;FILD1+1: EXT,,0
MOVEM N,FILD1+1 ;FILD1+2: 0
SETZM FILD1+2 ;FILD1+3: [ , ]
MOVE N,FILDIR+3
MOVEM N,FILD1+3
COPER0: SETOM COPFLG ;PROCESS THE SECOND ARG.
PUSH P,DEVBAS ;SAVE FOR ERROR MESSAGE.
PUSHJ P,FILNM1
JUMP OBF+1 ;OBF: 20 ;USER WORD COUNT IS SET.
TLNN C,F.CR
JRST COMM1
MOVE A,DEVBAS
POP P,DEVBAS
MOVEI N,20 ;OBF+1: DEVICE
MOVEM OBF ;OBF+2: TYO,,0
MOVEI N,TYO
HRLZM N,OBF+2 ;FILDIR: AS FILD1, PLUS <>.
MOVE N,IBF+1
DEVCHR N, ;CHECK THE FIRST DEVICE.
JUMPN N,COPER1
COPERR: SKIPN T,DEVBAS
MOVE T,IBF+1
JRST NOGETD
COPER1: TLNE N,2 ;CAN THE DEVICE DO INPUT?
JRST .+3 ;YES.
MOVEI T,NOIN ;NO.
JRST ERRMSG
TLNN N,4 ;IS IT A DIRECTORY DEVICE?
JRST .+3 ;NO, GO AHEAD.
SKIPN CATFLG ;YES. WAS AN EXPLICIT FILENAME GIVEN?
JRST COMM1 ;NO--YOU LOSE.
MOVE N,OBF+1 ;YES, OKAY. NOW CHECK THE
DEVCHR N, ;ANALOGOUS THINGS FOR THE
JUMPN N,COPR0 ;OUTPUT DEVICE.
COPERX: SKIPN T,A
MOVE T,OBF+1
JRST NOGETD
COPR0: TLNE N,1
JRST .+3
MOVEI T,NOOUT
JRST ERRMSG
TLNN N,4
JRST .+3
SKIPN COPFLG
JRST COMM1
OPEN 1,IBF
JRST COPERR
LOOKUP 1,FILD1
JRST [SKIPN T,DEVBAS
MOVE T,IBF+1
MOVEM T,SAVE1
MOVE T,FILD1
MOVEM T,FILDIR
MOVE T,FILD1+1
MOVEM T,FILDIR+1
JRST NOGETF]
OPEN 2,OBF
JRST COPERX
SKIPG MONLVL
JRST COPR4
LOOKUP 2,FILDIR ;5 SERIES.
JRST COPR1
HLLZ N,FILDIR+2 ;USE EXISTING < >.
TLZ N,777
JRST COPR2
COPR1: MOVE N,[XWD 12,16] ;USE STANDARD < >.
GETTAB N,
JRST [SETZM FILDIR+2
JRST COPR3]
COPR2: TLNN N,700000
IOR N,MONLVL
MOVEM N,FILDIR+2
COPR3: HLLZS FILDIR+1
CLOSE 2,
COPR4: ENTER 2,FILDIR
JRST NOSAVE
PUSH P,E ;SET UP THE BUFFERS.
MOVEI E,1015 ;4 BUFFERS + 1.
PUSHJ P,PANIC
POP P,E
MOVE N,CETXT
MOVEM N,.JBFF
INBUF 1,2
PUSHJ P,COPER2 ;FOR A DESCRIPTION OF THE FOLLOWING
JRST COPER5 ;CODE, SEE MEMO #100-365-033-00,
COPER2: OUT 2, ;SECTION 2.2.1.
JRST .+3 ;OUTPUT OKAY.
GETSTS 2,N ;OUTPUT ERROR.
JRST OUTERR
MOVE N,TYO+2
IDIVI N,5
JUMPE T,.+2
ADDI N,1
HRRZ T,TYO
ADDI T,1
MOVEM N,(T) ;STORE THE WORD COUNT.
ADD N,T ;N AND T CONTAIN RESPECTIVELY
ADDI T,1 ;THE 1ST AND LAST LOCS TO BE FILLED
EXCH N,T ;WITH DATA IN THIS OUTPUT AREA.
POPJ P,
COPER5: IN 1,
JRST COPER3 ;INPUT OKAY.
GETSTS 1,N ;INPUT ERROR OR EOF.
TRNE N,020000
JRST COPEND ;EOF
MOVEI T,INLSYS ;INPUT ERROR.
JRST ERRMSG
COPER3: HRRZ T1,TYI
ADDI T1,1
HRRZ A,(T1)
JUMPE A,COPER5 ;NO DATA WORDS IN THIS BUFFER.
ADD A,T1 ;T1 AND A CONTAIN RESPECTIVELY THE 1ST
ADDI T1,1 ;AND LAST LOCS FROM WHICH DATA CAN BE
COPER6: MOVE B,T ;TRANSFERRED IN THIS INPUT AREA.
SUB B,N ;B CONTAINS SIZE OF OUTPUT AREA -1.
MOVE C,A
SUB C,T1 ;C CONTAINS SIZE OF INPUT AREA -1.
CAMG B,C ;COMPARE OUT SIZE TO IN SIZE.
JRST COPER4
ADD C,N ;OUT SIZE > IN SIZE.
HRL N,T1
BLT N,(C)
MOVEI N,1(C) ;RESET 1ST LOC TO BE FILLED WORD.
JRST COPER5 ;GO BACK FOR MORE INPUT.
COPER4: HRL N,T1 ;OUT SIZE <= IN SIZE.
BLT N,(T)
ADD T1,B
ADDI T1,1 ;RESET 1ST LOC TO BE TRANSFERRED WORD.
PUSHJ P,COPER2 ;OUTPUT.
CAMG T1,A ;CAN MORE BE TAKEN FROM THIS IN BUFFER?
JRST COPER6 ;YES.
JRST COPER5 ;NO.
COPEND: OUT 2, ;END OF FILE SEEN.
JRST .+3
GETSTS 2,N
JRST OUTERR
CLOSE 2, ;(OUTPUT DEVICE WILL BE RELEASED
RELEASE 1, ;VIA "BASIC").
SKIPL MONLVL
JRST BASIC ;5 SERIES MONITOR.
JRST PROCOD ;4 SERIES--PROTECTION CODE MUST BE SET.
;DELETE (DEL) ROUTINE
DELER: PUSHJ P,QSA
ASCIZ /ETE/
JRST .+1
TLNE C,F.CR ;DOES DELETE HAVE ANY ARGUMENTS?
JRST BADDEL ;NO. DONT ALLOW.
DELIM: PUSHJ P,GETNUM
JRST COMM1
MOVEM N,FRSTLN
SETOM PAKFLA ;MARK FACT THAT THERE IS A HOLE.
TLNN C,F.CR
TLNE C,F.COMA
JRST DELIM2
TLNN C,F.MINS
JRST COMM1
PUSHJ P,NXCH
PUSHJ P,GETNUM
JRST COMM1
DELIM2: SKIPE PAKFLG ;CRUNCH CORE?
PUSHJ P,SCRER3 ;YES.
MOVEM N,LASTLN
PUSH P,C
PUSHJ P,DELL1
POP P,C
TLNN C,F.COMA
JRST DELIM3
PUSHJ P,NXCH
JRST DELIM
DELIM3: TLNE C,F.CR
JRST UXIT
JRST COMM1
DELL1: MOVE A,FLLIN ;FIND FIRST LINE TO DELETE
DELL2: CAML A,CELIN
POPJ P, ;THERE IS NONE
HLRZ N,(A) ;GET LINE NO
CAMLE N,LASTLN ;DONE?
POPJ P,
CAMGE N,FRSTLN
AOJA A,DELL2
PUSHJ P,LOCKON
PUSHJ P,ERASE
PUSHJ P,LOCKOF
JRST DELL1 ;GO LOOK FOR FIRST LINE AGAIN
;WEAVE COMMAND
WEAER: PUSHJ P,QSA
ASCIZ /VE/
JRST .+1
PUSHJ P,FILNAM
JUMP NEWOL1
OPEN SPEC
JRST [SKIPN T,DEVBAS
MOVE T,NEWOL1
JRST NOGETD]
LOOKUP FILDIR
JRST [SKIPN T,DEVBAS
MOVE T,NEWOL1
MOVEM T,SAVE1
JRST NOGETF]
SKIPE PAKFLG ;CRUNCH CORE?
PUSHJ P,SCRER3 ;YES.
GETT2: SETZM BADGNN
INBUF 1
GETT1: PUSHJ P,INLINE
PUSHJ P,GETDNM
JRST [TLNN C,F.CR
JRST BADGET
JRST GETT1]
MOVEM N,BADGNN ;LAST GOOD LINE WEAVED
PUSHJ P,LOCKON
PUSHJ P,ERASE
PUSHJ P,INSERT
PUSHJ P,LOCKOF
JRST GETT1
;THIS ROUTINE PICKS UP A LINE NUMBER AND STOPS ON THE FIRST
;NON-DIGIT CHARACTER, INCLUDING SPACES AND TABS.
;IT IS USED BY OLD, WEAVE, AND MAINLP.
GETDNM: MOVEI X1,5
TLNN C,F.DIG
POPJ P,
MOVEI N,-60(C)
GETD1: MOVE G,T
PUSHJ P,NXCHS
SOJE X1,CPOPJ1
TLNN C,F.DIG
JRST CPOPJ1
IMULI N,^D10
ADDI N,-60(C)
JRST GETD1
;HELP.
HELER: PUSHJ P,QSA
ASCIZ /P/
JRST .+1
HRRZ A,.JBREL
MOVEM A,.JBFF
MOVE T,[SIXBIT/BASIC/]
PUSHJ P,.HELPR
PUSHJ P,TTYIN
JRST BASIC
;LENGTH OF PROGRAM IN CORE.
LENER: PUSHJ P,QSA
ASCIZ /GTH/
JRST .+1
PUSHJ P,LOCKON ;ROUTINE TO CALCULATE PROGRAM LENGTH IN CHARS.
PUSHJ P,PRESS ;NOTE#### LENGTH DOES NOT INCLUDE
PUSHJ P,LOCKOF ;LINE NUMBERS!
MOVE T,CETXT
SUB T,FLTXT
IMULI T,5
SETZM HPOS
PUSHJ P,PRTNUM
PUSHJ P,INLMES
ASCIZ / CHARACTERS
/
OUTPUT
JRST FIXUP
;TTCALL DEFINITION FOR "TAPE" AND "KEY"
OPDEF TTCALL [51B8]
;TTY BACK TO KEYBOARD
BIT16=2
KEYER: SETO A,
TTCALL 6,A
TLZ A,BIT16
TTCALL 7,A
JRST BASIC
;TTY INTO PAPERTAPE READER
TAPER: PUSHJ P,QSA
ASCIZ /E/
JRST .+1
SETO A,
TTCALL 6,A
TLO A,BIT16
TTCALL 7,A
JRST BASIC
;ROUTINE TO LIST FILE
LISER: PUSHJ P,QSA
ASCIZ /T/
JRST .+1
SETZI F, ;ASSUME NO HEADING DESIRED.
PUSHJ P,QSA
ASCIZ /NH/
SETOI F, ;HEADING IS DESIRED, OR CMD ERROR
SETZM REVFL
PUSHJ P,QSA
ASCIZ /REV/
JRST .+2
SETOM REVFL
NUMER: PUSHJ P,LINLIM ;GET LINE LIMITS OR ERROR
SKIPE RETUR1
PUSHJ P,NXCH
JUMPE F,LISTX ;SKIP HEADING-
PUSH P,T
PUSH P,C
PUSHJ P,INLMES ;NO, PRINT IT.
ASCIZ /
/
PUSHJ P,LIST01 ;TYPE THE HEADING
PUSHJ P,INLMES ;AND A FEW BLANK LINES
ASCIZ /
/
POP P,C
POP P,T
LISTX: SKIPE REVFL
JRST LIST4
JRST LIST1
LIST01: PUSH P,T ;SAVE POINTER TO INPUT LINE
PUSH P,C ;SAVE CURRENT CHAR.
SKIPN CURBAS
JRST .+3
MOVSI T,(SIXBIT/BAS/)
JRST LIST04
HLRZ T,CURDEV
CAIN T,<SIXBIT / DSK/> ;PRINT DEVICE ONLY IF UNCOMMON.
JRST LIST02
MOVE T,CURDEV
LIST04: PUSHJ P,PRNSIX ;PRINT THE DEVICE NAME
MOVSI T,320000 ;PRINT THE
PUSHJ P,PRNSIX ;:.
LIST02: MOVE T,CURNAM
PUSHJ P,PRNSIX
HLRZ T,CUREXT ;DONT PRINT EXT. UNLESS UNCOMMON
CAIN T,<SIXBIT / BAS/>
JRST LIST03
TLO T,16 ;INSERT SIXBIT "." BEFORE EXT
PUSHJ P,PRNSIX
LIST03: PUSHJ P,TABOUT ;EXECUTE A FORMAT ","
MSTIME X1,
IDIVI X1,^D60000
IDIVI X1,^D60
MOVEI A,":" ;THE SEPARATION CHAR BETWEEN FIELDS.
PUSHJ P,PRDE2
PUSHJ P,TABOUT ;ANOTHER FORMAT ","
DATE X1,
IDIVI X1,^D31
AOJ X2,
MOVE A,X1
IDIVI A,^D12
AOJ B,
ADDI A,^D64
MOVE T,X2
PUSHJ P,LIST06
MOVEI C,"-"
PUSHJ P,OUCH
MOVEI T,DATTBL-1(B)
SETZ D,
PUSHJ P,PRINT
MOVEI C,"-"
PUSHJ P,OUCH
MOVE T,A
PUSHJ P,LIST06
POP P,C ;RECOVER INPUT CHAR
POP P,T ;RECOVER INPUT POINTER
POPJ P,
LIST06: IDIVI T,^D10
MOVEI C,60(T)
PUSHJ P,OUCH
MOVEI C,60(T1)
JRST OUCH
LIST1: PUSH P,C
PUSH P,T
SETZM HPOS
MOVE A,FLLIN
LIST2: CAML A,CELIN ;READ LINE LIMITS
JRST LIST3 ;DONE IF NO MORE
HLRZ T,(A) ;T := LINE NO
CAMG T,LASTLN
CAMGE T,FRSTLN ;AFTER FIRST TO PRINT?
AOJA A,LIST2 ;NO
SKIPE RENSW ;FOR SAVE/REPLACE ONLY
JRST .+3 ;(NOT FOR LIST) SET UP THE
PUSHJ P,PRTNUM ;LINE NUMBER AS A
JRST LIST25 ;SEQUENCE NUMBER.
MOVE T,TYO+2
JUMPLE T,LIST22
IDIVI T,5
JUMPE T1,LIST22
SETZ C, ;PAD WITH NULLS SO THAT THE LINE
PUSHJ P,OUCH ;NUMBER STARTS IN A NEW WORD.
SOJG T1,.-2
LIST22: HLRZ T,(A)
SETZM NUMCOT
PUSHJ P,PRTNUM
MOVE T,NUMCOT
SUBI T,5
MOVE T1,@TYO+1
JUMPE T,LIST23
LIST21: LSH T1,-7 ;PAD WITH LEADING ZEROES (RE-
TLO T1,300000 ;QUIRED BY THE LINED CUSP).
IBP TYO+1
SOS TYO+2
AOJL T,LIST21
LIST23: TRO T1,1 ;SET THE "SEQ. NO." BIT.
MOVEM T1,@TYO+1
LIST25: MOVE T,(A)
MOVEI D,15 ;QUOTE CHAR
PUSHJ P,PRINT
PUSHJ P,INLME1
ASCIZ /
/
AOJA A,LIST2
LIST3: POP P,T
POP P,C
CLOSE
SETZI F,
SKIPE RETUR1
JRST NUMER
SETZM REVFL
SKIPE RENSW
JRST RENFIL
JRST BASIC
LIST4: PUSH P,C
PUSH P,T
SETZM HPOS
MOVE A,CELIN
CAMG A,FLLIN
JRST LIST3
SOJ A,
LIST5: HLRZ T,(A)
CAML T,FRSTLN
CAMLE T,LASTLN
JRST LIST6
PUSHJ P,PRTNUM
MOVE T,(A)
MOVEI D,15
PUSHJ P,PRINT
PUSHJ P,INLME1
ASCIZ /
/
LIST6: SOJ A,
CAMGE A,FLLIN
JRST LIST3
JRST LIST5
TABOUT: PUSH P,LP ;ROUTINE TO TAB OVER TO
SETZ LP, ;ABOUT THE NEXT ZONE, FOR THE HEADING
MOVE A,HPOS ;TYPEOUT.
IDIVI A,^D14
JUMPE B,.+3
SUBI B,^D14
MOVNS B
MOVEI C," "
PUSHJ P,OUCH ;AT LEAST ONE SPACE OUT.
SOJG B,.-2
POP P,LP
POPJ P,
DATTBL: ASCIZ /JAN/ ;TABLE OF MONTHS, USED BY HEADING TYPEOUT.
ASCIZ /FEB/
ASCIZ /MAR/
ASCIZ /APR/
ASCIZ /MAY/
ASCIZ /JUN/
ASCIZ /JUL/
ASCIZ /AUG/
ASCIZ /SEP/
ASCIZ /OCT/
ASCIZ /NOV/
ASCIZ /DEC/
NEWER: SETZM OLDFLA ;FLAG WOULD BE -1 FOR "OLD" REQUEST.
TLNN C,F.CR
JRST NEWOL4
PUSHJ P,INLMES
ASCIZ /NEW /
JRST NEWOLD
OLDER: SETOM OLDFLA
SKIPN CHAFLG ;CHAINING?
JRST OLDER1 ;NO.
MOVEI T,DRMBUF
MOVEM T,.JBFF
JRST NEWOL3
OLDER1: TLNN C,F.CR
JRST NEWOL4
PUSHJ P,INLMES
ASCIZ /OLD /
NEWOLD: PUSHJ P,INLMES
ASCIZ /FILE NAME--/
OUTPUT
PUSHJ P,INLINE
NEWOL4: PUSHJ P,FILNAM
JUMP NEWOL1
TLNN C,F.CR
JRST COMM1
SKIPN OLDFLA ;OLDFILE NAME?
JRST NEWOL2 ;NO. ASSUME NEW NAME IS OK FOR NOW.
NEWOL3: OPEN SPEC ;YES
JRST [SKIPN T,DEVBAS
HLRZ T,NEWOL1
JRST NOGETD] ;ILLEGAL DEV NAME. BOMB CURNAM.
MOVE C,NEWOL1
DEVCHR C, ;CAN THIS DEVICE
TLNE C,2 ;INPUT?
JRST .+3 ;YES.
MOVEI T,NOIN ;NO.
JRST ERRMSG
LOOKUP FILDIR ;REALLY AN OLD FILE?
JRST [SKIPN T,DEVBAS
MOVE T,NEWOL1
MOVEM T,SAVE1
JRST NOGETF] ;CAN'T FIND FILE.
NEWOL2: MOVE C,[XWD F.CR,15]
PUSHJ P,LINL1 ;HAVING ACCEPTED THE NAME, DO A "DELETE"
PUSHJ P,SCRER1
PUSHJ P,NAMOVE ;ACCEPT NEW CURRENT FILNAM
MOVE X1,NEWOL1
MOVEM X1,CURDEV
SKIPE CHAFLG ;CHAINING?
SETOM CHAFL2 ;YES, SET ERROR MESSAGE FLAG.
SKIPE OLDFLA
JRST GETT2 ;OLD FILE. FINISH BY GETTING IT.
JRST BASIC
;ROUTINE TO QUEUE FILES FOR THE LINE PRINTER.
INTERN QUEUEN,QUEUEM
QUEUEN=SIXBIT/BASIC/
QUEUEM=QUEUEN_-^D18
QUEER: PUSHJ P,QSA
ASCIZ /UE/
JRST .+1
SETZM HEDFLG ;[241]FLAG TO OUTPUT "FILES QUEUED:
QUEER0: ;[241]
;[241] Check to see if system is useing queing
;[241] by checking to see if QUASAR is running.
;[241] if not go output error message.
;[241]
MOVE A,[XWD 2,126] ;[241]GET [SYSTEM]QUASAR
GETTAB A, ;[241]PID'S
JRST NOTIMQ ;[241]ERROR RETURN
JUMPN A,QUEER1 ;[241]IF NOT = 0 ITS OK
NOTIMQ: MOVEI T,NOTIMP ;[241]ELSE, NO QUEING.
JRST ERRMSG ;[241]OUTPUT ERROR MESSAGE.
;**;[244] AT:NOTIMQ+2, ADD CONDITIONAL ASSEMBLY, MRB, 02-OCT-81
;[244]
;[244] IF GLXV4 SET TO 1 ASSEMBLE THIS CODE
;[244]
IFN GLXV4,<
;[244]FOR GALAXY AFTER VERSION 2
QUEER1: ;[241]USE THIS CODE
;[241] Find the default path of this job.
;[241] no errors allowed.
;[241]
MOVE A,[XWD 0,-1] ;[241]SET UP ARG BLOCK TO
MOVEM A,PTHBLK ;[241]READ DEFAULT PATH.
MOVEI A,10 ;[241]CLEAR THE REST OF THE
SETZM PTHBLK+1(A) ;[241]BECAUSE THATS WHERE WERE
SOJG A,.-1 ;[241]GOING TO STORE THE PATH.
MOVE A,[XWD 11,PTHBLK];[241]SET UP AC FOR CALL
PATH. A, ;[241]GET THE PATH FROM MONITOR.
JRST NOGETD ;[241]ERROR RETURN
SETZM PTHBLK ;[241]CLEAR OUT BECAUSE THE
SETZM PTHBLK+1 ;[241]LOOKUP WANTS THEM 0.
MOVEI A,6 ;[241]MOVE IT OVER TO QUEBLK
MOVE E,PTHBLK+1(A) ;[241]
MOVEM E,FILBLK+2(A) ;[241]
SOJG A,.-2 ;[241]
SETZ E, ;[241]
QUEER2: ;[241]
;[241] Check for the existance of the file
;[241] on the default PPN.
;[241] if not there PUSHJ to QTNFND.
;[241]
PUSHJ P,FILNMO ;[241]GET THE FILE NAME AND EXT.
JUMP SAVE1 ;[241]ERROR RETURN (BAD NAME).
OPEN 1,SAVI ;[241]OPEN CHANNEL 1 FOR LOOKUP
JRST [MOVE T,SAVE1 ;[241]COULDNT OPEN
JRST NOGETD] ;[241]OUTPUT ERROR MESSAGE.
MOVE A,FILDIR ;[241]GET THE FILE NAME AND
MOVEM A,QLSPEC+2 ;[241]PUT IN ARG BLOCK FOR LOOKUP
MOVEM A,FILBLK+1 ;[241]SAVE FOR QUEUE. TOO
MOVE A,FILDIR+1 ;[241]AND THE SAME FOR THE
MOVEM A,QLSPEC+3 ;[241]EXTENTION.
MOVEM A,FILBLK+2 ;[241]SAVE FOR QUEUE. TOO
MOVE A,[XWD 0,PTHBLK];[241]GET THE ADDRESS OF PATH
MOVEM A,QLSPEC+1 ;[241]BLOCK AND SAVE IT.
MOVEI A,16 ;[241]ARG BLOCK LENGTH
MOVEM A,QLSPEC ;[241]
MOVEI A,12 ;[241]CLEAR OUT THE REST
SETZM QLSPEC+4(A) ;[241]OF THE ARG BLOCK.
SOJG A,.-1 ;[241]
LOOKUP 1,QLSPEC ;[241]LOOK FOR THE FILE
JRST [PUSHJ P,QNTFND;[241]
JRST QNTFN3] ;[241]FILE NOT FOUND.
SETZM QUEBLK+6 ;[241]ZERO COPIES FLAG
SETZM QUEBLK+10 ;[241]ZERO DISPOSITION FLAG
SETZM QUEBLK+12 ;[241]ZERO PAGE LIMIT FLAG
MOVE A,QLSPEC+16 ;[241]GET THE DEVICE NAME
MOVEM A,FILBLK ;[241]AND SAVE IT FOR QUEUE.
QUESWH: ;[241]
;[241] check to see if there are any switches
;[241] to be processed.
;[241]
TLNN C,F.SLSH ;[241]PROCESS ANY SWITCHES
JRST QUEFIN ;[241]NO MORE SWITCHES
PUSHJ P,NXCH ;[241]
QUECOP: ;[241]
;[241] Process the COPIES switch here.
;[241]
TLNN C,F.DIG ;COPIES SWITCH
JRST QUEUNS
HRRZI B,-60(C)
PUSHJ P,NXCH
TLNN C,F.DIG
JRST QUEER4 ;ONLY ONE DIGIT.
IMULI B,12
ADDI B,-60(C)
PUSHJ P,NXCH
CAILE B,^D63 ;.LT. 63 COPIES REQUESTED?
JRST .+3 ;YES
TLNN C,F.DIG
JRST QUEER4
MOVEI T,QCOP63 ;YES
JRST ERRMSG
QUEER4: JUMPE B,QCOP63
MOVE A,QUEBLK+6 ;[241]
JUMPG A,.+2 ;[241]DUPLICATE SWITCH?
JRST .+3 ;NO.
QDUPLC: MOVEI T,QUEDUP ;YES
JRST ERRMSG
MOVEM B,QUEBLK+6 ;[241]SAVE NUMBER OF COPIES
PUSHJ P,QSAX
ASCIZ /COPIES/
JRST QUESWH ;GO TO NEXT SWITCH.
QUEUNS: ;[241]
;[241] Unsave switch. flages for
;[241] deletion after printing.
;[241]
MOVEI B,"U" ;UNSAVE SWITCH.
CAIE B,(C)
JRST QUELIM
PUSHJ P,NXCH
PUSHJ P,QSAX
ASCIZ /NSAVE/
MOVE A,QUEBLK+10 ;[241]
JUMPE A,.+2 ;[241]DUPLICATE SWITCH?
JRST QDUPLC ;YES.
MOVEI B,1 ;[241]NO.
MOVEM B,QUEBLK+10 ;[241]SAVE IN ARG BLOCK
JRST QUESWH ;TO TO NEXT SWITCH.
QUELIM: ;[241]
;[241] The LIMIT switch. limits the number of
;[241] pages in a print request.
;[241]
MOVEI B,"L" ;LIMIT SWITCH.
CAIE B,(C)
JRST COMM1
PUSHJ P,NXCH
PUSHJ P,QSAX
ASCIZ /IMIT/
MOVE A,QUEBLK+12 ;[241]
JUMPG A,QDUPLC ;DUPLICATE SWITCH.
MOVEI D,3
TLNN C,F.DIG
JRST COMM1
HRRZI B,-60(C)
QULIM1: PUSHJ P,NXCH
TLNN C,F.DIG
JRST QULIM2
IMULI B,^D10
ADDI B,-60(C)
SOJG D,QULIM1
PUSHJ P,NXCH
TLNN C,F.DIG
JUMPN B,QULIM4
QULIM3: MOVEI T,QLIMLG
JRST ERRMSG
QULIM2: JUMPE B,QULIM3
QULIM4: MOVEM B,QUEBLK+12 ;[241]SAVE IN ARG BLOCK
JRST QUESWH ;GO TO NEXT SWITCH
QUEFIN: ;[241]
;[241] All done with switches.
;[241] check defaults and queue file.
;[241]
TLNN C,F.CR ;[241]BETTER BE NOTING LEFT
TLNE C,F.COMA ;[241]IN THIS ARG
JRST .+2 ;[241]
JRST COMM1 ;[241]
MOVE A,QUEBLK+12 ;[241]PAGE LIMITS
JUMPG A,.+3 ;[241]
MOVEI A,^D200 ;[241]DEFAULT SETTING
MOVEM A,QUEBLK+12 ;[241]
MOVE A,QUEBLK+10 ;[241]FILE DISPOSITION(UNSAVE)
JUMPGE A,.+3 ;[241]
MOVEI A,0 ;[241]DEFAULT SETTING (PRESERVE)
MOVEM A,QUEBLK+10 ;[241]
MOVE A,QUEBLK+6 ;[241]NUMBER OF COPIES
JUMPG A,.+3 ;[241]
MOVEI A,1 ;[241]DEFAULT SETTING
MOVEM A,QUEBLK+6 ;[241]
QUECAL: MOVE A,[XWD QUELEN,QUEBLK];[241]
QUEUE. A, ;[241]
JRST QNTFND ;[241]
SKIPE HEDFLG
JRST QUCAL1
PUSHJ P,INLMES
ASCIZ /
FILES QUEUED:
/
OUTPUT
SETOM HEDFLG
QUCAL1: PUSHJ P,TTYIN
PUSHJ P,PRNNAM ;OUTPUT FILENAME
PUSHJ P,INLMES
ASCIZ/
/
OUTPUT
TLNE C,F.CR ;IF THE NEXT CHARACTER
JRST UXIT ;ISN'T A LINE
PUSHJ P,NXCH ;TERMINATOR, IT IS
JRST QUEER2 ;[241]GUARANTEED TO BE A COMMA.
QNTFND: PUSHJ P,INLMES ;HERE WHEN FILE NOT FOUND
ASCIZ/
? FILE /
PUSHJ P,PRNNAM
PUSHJ P,INLMES
ASCIZ / NOT FOUND/
OUTPUT
SETZM HEDFLG
POPJ P,
QNTFN2: PUSHJ P,NXCH ;SKIP TO THE
QNTFN3: TLNE C,F.CR ;NEXT ARGUMENT, OR
JRST UXIT ;THE END OF THE
TLNN C,F.COMA ;COMMAND
JRST QNTFN2
PUSHJ P,NXCH
JRST QUEER2 ;[241]
;**;[244] AT:QNTFN3+6, ADD CONDITIONAL ASSEMBLY, MRB, 02-OCT-81
> ;[244]END OF CONDITIONAL ASSEMBLY
;[244]FOR GALAXY AFTER VERSION 2
;[244]
;[244] IF GLXV4 IS SET TO ZERO ASSEMBLE THIS CODE
;[244]
IFE GLXV4,<
EXTERN QUEUER
;[244]IF GALAXY VERSION 2 OR LESS
;[244]USE THIS CODE
;
;**;[244] AT:QUEER1, REPLACE CODE FOR OLDER VERSIONS OF GALAXY, MRB 02-OCT-81
QUEER1: SETZM HEDFLG ;ZERO THE HEADING FLAG.
QUELOP: MOVEI A,40 ;ZERO THE PARAMETER AREA.
SETZM PARAM-1(A)
SOJG A,.-1
PUSHJ P,FILNMO ;GET THE FILENAME ARGUMENT
JUMP SAVE1
OPEN 1,SAVI
JRST [MOVE T,SAVE1
JRST NOGETD]
MOVE A,FILDIR ;SET UP FOR THE EXTENDED
MOVEM A,QLSPEC+2 ;LOOKUP, AND SOME
MOVEM A,PARAM+5 ;LOCATIONS IN THE PARAMETER
MOVEM A,PARAM+33 ;AREA AS WELL.
HLLZ A,FILDIR+1
MOVEM A,QLSPEC+3
MOVEM A,PARAM+34
;[244] ADDED SFD'S TO LOOKUP
FX244: MOVEI A,-1 ;[244]SET UP FOR READ PATH
MOVEM A,PARAM+23 ;[244]USING THE PATH UUO
MOVE A,[XWD 11,PARAM+23];[244]INTO THE QUEUER
PATH. A, ;[244]ARG BLOCK AREA
JFCL
SETZM PARAM+24 ;[244]CLEAR OUT FLAGS
MOVEI A,PARAM+23 ;[244]MOVE ADDR OF BLOCK
MOVEM A,QLSPEC+1 ;[244]FOR THE LOOKUP CALL
MOVE A,PARAM+25 ;[244]AND TO REQUESTOR PPN
MOVEM A,PARAM+4
MOVEI A,16
MOVEM A,QLSPEC
MOVEI A,12
SETZM QLSPEC+4(A)
SOJGE A,.-1
LOOKUP 1,QLSPEC
JRST [PUSHJ P,QNTFND
JRST QNTFN3] ;FILE NOT FOUND.
MOVE A,QLSPEC+16
MOVEM A,PARAM+24
QUESWH: TLNN C,F.SLSH ;PROCESS ANY SWITCHES
JRST QUEFIN ;NO MORE SWITCHES
PUSHJ P,NXCH
QUECOP: TLNN C,F.DIG ;COPIES SWITCH
JRST QUEUNS
HRRZI B,-60(C)
PUSHJ P,NXCH
TLNN C,F.DIG
JRST QUEER4 ;ONLY ONE DIGIT.
IMULI B,12
ADDI B,-60(C)
PUSHJ P,NXCH
CAILE B,^D63 ;.LT. 63 COPIES REQUESTED?
JRST .+3 ;YES
TLNN C,F.DIG
JRST QUEER4
MOVEI T,QCOP63 ;YES
JRST ERRMSG
QUEER4: JUMPE B,QCOP63
MOVE A,PARAM+37
TRNN A,77 ;DUPLICATE SWITCH?
JRST .+3 ;NO.
QDUPLC: MOVEI T,QUEDUP ;YES
JRST ERRMSG
DPB B,[XWD 000600,PARAM+37]
PUSHJ P,QSAX
ASCIZ /COPIES/
JRST QUESWH ;GO TO NEXT SWITCH.
QUEUNS: MOVEI B,"U" ;UNSAVE SWITCH.
CAIE B,(C)
JRST QUELIM
PUSHJ P,NXCH
PUSHJ P,QSAX
ASCIZ /NSAVE/
MOVE A,PARAM+37
TRNE A,700 ;DUPLICATE SWITCH?
JRST QDUPLC ;YES.
MOVEI B,2 ;NO.
DPB B,[XWD 060200,PARAM+37]
JRST QUESWH ;GO TO NEXT SWITCH.
QUELIM: MOVEI B,"L" ;LIMIT SWITCH.
CAIE B,(C)
JRST COMM1
PUSHJ P,NXCH
PUSHJ P,QSAX
ASCIZ /IMIT/
HLRZ A,PARAM+21
JUMPN A,QDUPLC ;DUPLICATE SWITCH.
MOVEI D,3
TLNN C,F.DIG
JRST COMM1
HRRZI B,-60(C)
QULIM1: PUSHJ P,NXCH
TLNN C,F.DIG
JRST QULIM2
IMULI B,^D10
ADDI B,-60(C)
SOJG D,QULIM1
PUSHJ P,NXCH
TLNN C,F.DIG
JUMPN B,QULIM4
QULIM3: MOVEI T,QLIMLG
JRST ERRMSG
QULIM2: JUMPE B,QULIM3
QULIM4: HRLM B,PARAM+21
JRST QUESWH ;GO TO NEXT SWITCH
QUEFIN: TLNN C,F.CR ;BETTER BE NOTHING LEFT
TLNE C,F.COMA ;IN THIS ARG.
JRST .+2
JRST COMM1
PUSH P,C
PUSH P,T
HLRZ A,PARAM+21 ;SET UP REST OF PARAMETER
JUMPN A,.+3 ;AREA.
MOVEI A,^D200
HRLM A,PARAM+21 ;DEFAULT--200 PAGES.
HRRZ A,PARAM+37
MOVEI B,1
TRNN A,700
DPB B,[XWD 060300,PARAM+37] ;DEFAULT--PRESERVE
TRNN A,77
DPB B,[XWD 000600,PARAM+37] ;DEFAULT--1 COPY.
QUECON: LDB B,[XWD 000600,PARAM+37]
HRLZI A,010000
HLLM A,PARAM+37
IMUL B,QLSPEC+5
IDIVI B,^D1024
ADDI B,1
HRRM B,PARAM+21 ;BLOCKS*COPIES/8.
HRRZI A,111000
ADDM A,PARAM+37 ;SINGLE SPACING, ASCII.
HRRZI A,501
MOVEM A,PARAM+1 ;BASIC=5,CREATE.
MOVE A,[XWD 023014,1] ;1 FILE IN REQUEST
MOVEM A,PARAM+2
MOVSI A,(SIXBIT/LPT/) ;LPT REQUEST.
MOVEM A,PARAM+3
MOVE A,[XWD 12,16]
GETTAB A,
HRLZI A,055000
TLO A,012
HLRZM A,PARAM+7
MOVEI A,1
MOVEM A,PARAM+36
PJOB B, ;JOB NUMBER.
HRLI A,(B)
HRRI A,33
GETTAB A,
SETZ A,
MOVEM A,PARAM+15 ;CHARGE NUMBER
HRLI A,(B)
HRRI A,31
GETTAB A,
SETZ A,
MOVEM A,PARAM+16 ;FIRST HALF OF USER'S NAME.
HRLI A,(B)
HRRI A,32
GETTAB A,
SETZ A,
MOVEM A,PARAM+17 ;SECOND HALF
QUECAL: HRRZ A,.JBREL
MOVEM A,.JBFF
MOVE T,[XWD 40,PARAM]
PUSHJ P,QUEUER
POP P,T
POP P,C
SKIPE HEDFLG
JRST QUCAL1
PUSHJ P,INLMES
ASCIZ /
FILES QUEUED:
/
OUTPUT
SETOM HEDFLG
QUCAL1: PUSHJ P,TTYIN
PUSHJ P,PRNNAM ;OUTPUT FILENAME
PUSHJ P,INLMES
ASCIZ/
/
OUTPUT
TLNE C,F.CR ;IF THE NEXT CHARACTER
JRST UXIT ;ISN'T A LINE
PUSHJ P,NXCH ;TERMINATOR, IT IS
JRST QUELOP ;GUARANTEED TO BE A COMMA.
QNTFND: PUSHJ P,INLMES ;HERE WHEN FILE NOT FOUND
ASCIZ/
? FILE /
PUSHJ P,PRNNAM
PUSHJ P,INLMES
ASCIZ / NOT FOUND/
OUTPUT
SETZM HEDFLG
POPJ P,
QNTFN2: PUSHJ P,NXCH ;SKIP TO THE
QNTFN3: TLNE C,F.CR ;NEXT ARGUMENT, OR
JRST UXIT ;THE END OF THE
TLNN C,F.COMA ;COMMAND
JRST QNTFN2
PUSHJ P,NXCH
JRST QUELOP
;**;[244] AT:QNTFN3, ADD CONDITIONAL ASSEMBLY, MRB 02-OCT-81
> ;[244]END OF CONDITIONAL ASSEMBLY
;[244]FOR GALAXY VERSIONS 2 OR BEFORE
;ROUTINE TO CHANGE CURRENT NAME
RENER: PUSHJ P,QSA
ASCIZ /AME/
JRST .+1
TLNN C,F.CR ;IS THERE A NAME TO RENAME TO?
JRST RENA1 ;YES
PUSHJ P,INLMES ;PROMPT USER FOR A NAME
ASCIZ /FILE NAME--/
OUTPUT
PUSHJ P,INLINE ;THERE BETTER BE A NAME NOW.
RENA1: SETZM OLDFLA ;REQUEST FOR NEW FILE
PUSHJ P,FILNAM
JUMP CURDEV ;SAVE DEVICE IN CURNAM
TLNN C,F.CR
JRST COMM1
PUSHJ P,NAMOVE ;SET CURINFO FROM FILDIR
JRST UXIT
;REPLACE.
REPER: PUSHJ P,QSA
ASCIZ /LACE/
JRST .+1
SETOM OLDFLA
JRST SAVFIL
;ROUTINE TO RENUMBER THE BASIC PROGRAM THAT IS IN CORE.
;THE COMMAND IS
; RESEQUENCE NN,MM,LL
;WHERE NN IS THE FIRST NUMBER AND LL IS THE STEP VALUE.
;IF OMITTED, LL, OR BOTH NUMBERS=10
;ALL LINE NUMBERS LESS THAN MM WILL NOT BE RESEQUENCED. MM MUST NOT
;BE GREATER THAN NN
;A NUMBER IS A LINE NUMBER IF:
;IT IS THE FIRST ATOM ON A LINE.
; IT FOLLOWS AN ATOM BEGINNING WITH THE LETTERS:
; "GOS" OR "GOT" OR "THE"
;ALSO, AFTER THE ATOM "GOTO" HAS BEEN IDENTIFIED, THE NUMBER
;FOLLOWING A COMMA IS A LINE NUMBER.
;REENTRY IS NOT ALLOWED DURING "RESEQUENCE".
RESER: PUSHJ P,QSA
ASCIZ /EQUENCE/
JRST .+1
SETZM USGFLG
PUSHJ P,LIMITS
MOVE N,LASTLN ;GET THE SECOND NUMBER(::=LOWEST)
HRRZM N,LOWEST
MOVEI N,^D10 ;IF FIRST ARG=0, ASSUME FIRST LINE=10
SKIPN FRSTLN
MOVEM N,FRSTLN
TLNE C,F.CR ;[231] END OF COMMAND?
JRST RES1 ;[231] YES- LET INCREMENT = ^D10
TLNN C,F.COMA ;[231] NO - FOUND DELIMITER?
JRST COMM1 ;[231] NOPE - COMMAND ERROR
PUSHJ P,NXCH
PUSHJ P,GETNUM
JRST COMM1
SKIPN N ;[231] IS THERE A REAL INCREMENT?
MOVEI N,^D10 ;[231] NO USE DEFAULT
RES1: SKIPE PAKFLG ;CRUNCH CORE?
PUSHJ P,SCRER3 ;YES.
MOVEM N,LASTLN ;SAVE INCREMENT
HRLZ A,LOWEST ;SEARCH FOR FIRST LINE TO CHANGE
MOVEI R,LINROL
PUSHJ P,SEARCH
JFCL
CAMN B,FLLIN ;RESEQ ALL LINES?
JRST SEQ0 ;YES.
HLRZ N,-1(B) ;NO. MAKE SURE LINE ORDER WILL NOT CHANGE
CAMGE N,FRSTLN
JRST SEQ0
MOVEI T,RESERR
JRST ERRMSG
SEQ0: MOVN X2,B
ADD X2,CELIN ;THIS IS THE NUMBER OF LINES TO RESEQ
SUBI X2,1
IMUL X2,LASTLN
ADD X2,FRSTLN
CAILE X2,^D99999
JRST SEQOV
PUSHJ P,LOCKON ;DONT ALLOW REENTRY.
MOVE E,CELIN ;COMPUTE NUMBER OF LINES
SUB E,B
JUMPE E,UXIT ;NOTHING TO RENUMBER
MOVN L,E
MOVSI L,(L)
SUB B,FLLIN
MOVEM B,LOWSTA
HRR L,B
PUSH P,L ;SAVE L FOR SECOND LOOP.
HRL B,B
SUB L,B
;THE LOOP THAT COPIES EACH LINE FOLLOWS:
SEQ2: MOVE D,[POINT 7,LINB0] ;BUILD EACH LINE IN LINB0. THEN REINSERT IT.
MOVEM D,SEQPNT
HRRZ F,L
ADD F,FLLIN
HRRZ T,(F)
HRLI T,440700 ;POINTER TO OLD LINE IS IN G
;F USED AS A FLAG REGISTER FOR " ' ETC.
;THE FLAGS ARE
REST.F=1 ;COPY THE REST (APOST SEEN)
TOQU.F=2 ;COPY TO QUOTE SIGN
COMM.F=4 ;LINE NUMBER FOLLOWS ANY COMMA
NUM.F=10 ;NEXT NUMBER IS LINE NUMBER
PUSH P,T
PUSHJ P,NXCH
CAIN C,":"
JRST SEQ21
PUSHJ P,QSA
ASCIZ /DATA/
JRST .+2
SEQ21: TLO F,REST.F ;IMAGE OR DATA STA.--SET "APOST SEEN".
POP P,T
;THE CHARACTER/ATOM LOOP:
SEQ3: PUSHJ P,NXCHD ;GET NEXT CHAR, EVEN IF SPACE OR TAB
SEQ31: TLNE C,F.CR
JRST SEQCR
TLNE C,F.QUOT ;TEST FOR QUOTE CHAR
TLCA F,TOQU.F ;REVERSE QUOTE SWITCH AND COPY THIS CHAR
TLNE F,TOQU.F
JRST SEQ5
JRST SEQ52
SEQ5: SKIPN USGFLG
JRST SEQCPY
TLZ F,NUM.F
SETZM USGFLG
JRST SEQCPY
SEQ52: TLNE C,F.APOS
TLOA F,REST.F ;APOST SEEN, COPY REST
TLNE F,REST.F
JRST SEQ5
MOVE G,T ;SAVE POINTER
TLNN F,NUM.F ;EXPECTING A LINE NUMBER?
JRST SEQ57 ;NO. LOOK FOR KEYW ATOMS
TLNE C,F.DIG
JRST SEQ56
SKIPN USGFLG
JRST SEQ5
CAMN C,[1000000043] ;SPECIAL HANDLING FOR USING STAS,
JRST SEQ53 ;FROM HERE UP TO SEQ56.
TLNE C,F.SPTB
JRST SEQCPY
TLZ F,NUM.F
JRST SEQ5
SEQ53: IDPB C,SEQPNT
PUSHJ P,NXCHD
TLNE C,F.CR
JRST SEQCR
TLNE C,F.SPTB
JRST SEQ53
TLNE C,F.DIG
JRST SEQ54
TLZ F,NUM.F
JRST SEQ5
SEQ54: IDPB C,SEQPNT
PUSHJ P,NXCHD
TLNE C,F.CR
JRST SEQCR
TLNE C,F.SPTB
JRST SEQ54
CAIE C,":"
TLNE C,F.COMA
JRST .+2
JRST SEQ5
SEQ55: IDPB C,SEQPNT
PUSHJ P,NXCHD
TLNE C,F.SPTB
JRST SEQ55
TLNN C,F.DIG
JRST SEQ5
SEQ56: SKIPE USGFLG
SETZM USGFLG
JRST SEQNUM
SEQ57: SETZM USGFLG
TLNE F,COMM.F
TLNN C,F.COMA
JRST .+3
TLO F,NUM.F ;THIS COMMA IMPLIES NUMBER TO FOLLOW
JRST SEQCPY
PUSHJ P,ALPHSX ;PUT NEXT ALL-LETTER ATOM IN A
MOVEI B,SEQTND-SEQTBL ;SET INDEX FOR TABLE OF KEYWORDS PRECEDING LINE NUMBERS
MOVE T,G ;RESET CHAR POINTER TO START OF ATOM.
CAMN A,SEQTBL(B)
TLOA F,NUM.F+COMM.F ;WE FOUND A KEYWORD
SOJGE B,.-2
CAME A,[SIXBIT /USING/]
JRST SEQ6 ;[232]TRY 1 MORE SPECIAL CASE CHECK
TLO F,NUM.F
SETOM USGFLG
LDB C,T
IDPB C,SEQPNT
MOVEI A,4
PUSHJ P,NXCHS
IDPB C,SEQPNT
SOJG A,.-2
JRST SEQ3
SEQ6: CAME A,[SIXBIT /ASC/];[232]FUNCTION ASC?
JRST SEQCP1 ;[232]NO GO ON
IBP T ;[232]YES ADVANCE 2 CHARS
IBP T ;[232]2ND CHAR ADVANCE
PUSHJ P,NXCH ;[232]TRY TO GET OPENING PAREN
TLNE C,F.CR ;[232]EOL?
JRST SEQ61 ;[232]YES--FINISH UP
PUSHJ P,NXCH ;[232]NOW TRY FOR ARG CHAR
TLNE C,F.QUOT ;[232] IS IT A QUOTE?
TLO F,TOQU.F ;[232]YES FAKE PRIOR QUOTE
SEQ61: MOVE T,G ;[232]RESET POINTER TO START
SEQCP1: LDB C,T
SEQCPY: IDPB C,SEQPNT
JRST SEQ3
SEQTBL: SIXBIT /GOSUB/ ;TABLE OF KEYWORDS PRECEDING LINE NUMBERS
SIXBIT /GOTO/
SEQTND: SIXBIT /THEN/
SEQNUM: PUSH P,G ;SAVE POINTER IN CASE OF "GLOBAL" LINE NUMBER
PUSHJ P,GTNUMB ;[205]GET NUMBER DONT IGNORE TABS,ECT
HALT .
CAMGE N,LOWEST
JRST SEQB1 ;DONT RESEQ THIS NUMBER
MOVEI R,LINROL
HRLZ A,N
PUSHJ P,SEARCH
JRST SEQBAD
SUB B,FLLIN
SUB B,LOWSTA
IMUL B,LASTLN
ADD B,FRSTLN ;THIS IS THE NEW LINE NUMBER
MOVE X1,B
PUSHJ P,MAKNUM ;DEPOSIT THE NUMBER IN LINB0
POP P,X1 ;CLEAR PLIST A LITTLE
TLZ F,NUM.F
LDB C,T
PUSHJ P,NXCHD2
JRST SEQ31
SEQBAD: PUSH P,N
PUSHJ P,INLMES
ASCIZ /
? UNDEFINED LINE NUMBER /
POP P,T ;PRINT "GLOBAL" LINE NUMBER
PUSHJ P,PRTNUM
PUSHJ P,INLMES
ASCIZ / IN LINE /
HLRZ T,(F)
PUSHJ P,PRTNUM
PUSHJ P,INLMES
ASCIZ /
/
OUTPUT
SEQB1: POP P,T ;POINT TO BAD NUMBER OR NUMBER
LDB C,T ;WHICH DOES NOT HAVE TO BE
TLZ F,NUM.F ;RESEQUENCED.
JRST SEQCPY ;COPY IT
SEQCR: SETZM USGFLG
IDPB C,SEQPNT
HLRZ N,(F)
PUSHJ P,ERASE ;ERASE OLD LINE COPY
MOVE T1,SEQPNT ;POINT TO END OF LINE FOR NEWLIN
PUSHJ P,NEWLIN ;INSERT NEW ONE WITH OLD LINE NUMBER.
AOBJN L,SEQ2 ;DO NEXT LINE
POP P,L
ADD L,FLLIN
MOVE N,FRSTLN
HRLM N,(L)
ADD N,LASTLN
AOBJN L,.-2
JRST UXIT ;FINISHED. ALLOW REENTRY.
SEQOV: PUSHJ P,INLMES
ASCIZ /
? COMMAND ERROR (LINE NUMBERS MAY NOT EXCEED 99999)
/
JRST FIXUP
;ROUTINE TO SAVE PROGRAM
SAVER: PUSHJ P,QSA
ASCIZ /E/
JRST .+1
SETZM OLDFLA ;SAVE "NEW" FILE ONLY
SAVFIL: PUSHJ P,FILNAM ;REPLACE ENTERS HERE.
JUMP SAVE1
TLNN C,F.CR
JRST COMM1
PUSHJ P,LIMITS
MOVE A,SAVE1 ;CAN THE DEVICE
DEVCHR A, ;BE
TLNE A,1 ;OUTPUT TO?
JRST .+3 ;YES.
MOVEI T,NOOUT
JRST ERRMSG
OPEN SAVI
JRST [SKIPN T,DEVBAS
MOVE T,SAVE1 ;ILLEGAL DEVICE NAME
JRST NOGETD]
PUSHJ P,LOCKON ;DONT ALLOW REENTRY UNTIL
;SAVE IS CHANGED TO BUILD TEMP FILE AND RENAME.
SKIPE OLDFLA ;TRYING TO SAVE NEW FILE?
JRST SAVE3
TLNN A,4 ;YES, DOES THE DEVICE HAVE A DIR?
JRST SAVE2 ;NO.
MOVE A,FILDIR+3
LOOKUP FILDIR ;YES, DOES THE FILE EXIST?
JRST [MOVEM A,FILDIR+3
JRST SAVE2] ;NO, GOOD
MOVEI T,NOTNEW
JRST ERRMSG
SAVE3: LOOKUP FILDIR ;IS THIS REALLY AN OLDFILE?
JRST [SKIPE A,DEVBAS ;NO, GRONK.
MOVEM A,SAVE1
JRST NOGETF]
SAVE2: CLOSE ;OTHERWISE REPLACE WILL APPEND.
HLLZS FILDIR+1 ;LEVEL D FIX.
SKIPN OLDFLA
JRST SAVE4
HLLZ A,FILDIR+2 ;SAVE < > FOR REPLACE.
TLZ A,777
MOVEM A,FILDIR+2
JRST SAVE5
SAVE4: SETZM FILDIR+2
SAVE5: MOVE A,FILDIR+3 ;[234] SAVE PPN OF FILE
ENTER FILDIR
JRST NOSAVE
MOVEM A,FILDIR+3 ;[234] RESTORE LOOKUP PATH
OUTBUF 1
SETOM RENSW
JRST LIST1
RENFIL: SETZM RENSW
MOVE A,SAVE1
DEVCHR A, ;ONLY SET THE PROTECTION FOR DISK.
TLNE A,4
TLNE A,100
JRST BASIC
OPEN SAVI
JRST [SKIPN T,DEVBAS
MOVE T,SAVE1
JRST NOGETD]
PROCOD: HLLZS FILDIR+1
SETZM FILDIR+2
LOOKUP FILDIR
JRST NOGETF
HLLZ A,FILDIR+2
TLZ A,777
SKIPL MONLVL
TLNN A,700000
IOR A,MONLVL ;MONLVL CONTAINS THE APPROPRIATE
MOVEM A,FILDIR+2 ;"DON'T DELETE" BIT.
HLLZS FILDIR+1
RENAME FILDIR
JRST .+2
JRST BASIC
MOVEI T,NOREN
JRST ERRMSG
NOREN: ASCIZ /
? FILE SAVED BUT NOT PROTECTED/
;ROUTINE TO CLEAR TXTROL.
SCRER: PUSHJ P,QSA
ASCIZ /ATCH/
JRST .+1
TLNN C,F.TERM
JRST COMM1
PUSH P,[EXP UXIT]
SCRER1: SKIPN SWAPSS ;ENTRY POINT FOR NEW, OLD, AND SCRATCH
JRST SCRER2 ;TO CRUNCH CORE FOR A SWAPPING SYSTEM.
MOVE X1,.JBREL
CAILE X1,377777
JRST SCRER2 ;DON'T CRUNCH--ERRORS WILL RESULT.
MOVE X1,SJOBRL
CORE X1,
JRST .+1
MOVE X1,SJOBSA
MOVEM X1,FLTXT ;WIPE OUT LINROL AND TXTROL.
MOVEM X1,CETXT
MOVE X1,.JBREL
MOVEM X1,FLLIN
MOVEM X1,CELIN
SETZM PAKFLG
POPJ P,
SCRER2: MOVE X1,FLTXT ;WIPE OUT LINROL AND TXTROL.
MOVEM X1,CETXT
MOVE X1,FLLIN
MOVEM X1,CELIN
POPJ P,
SCRER3: PUSH P,X1 ;ENTRY POINT FOR EDITS TO CRUNCH CORE
MOVE X1,.JBREL ;THEY ONLY GET HERE FOR SWAPPING SYSTEMS.
CAILE X1,377777
JRST SCRER5 ;DON'T CRUNCH--ERRORS WILL RESULT.
MOVE X1,CELIN ;SAVE LINROL AND TXTROL.
CAMG X1,SJOBRL ;CELIN > ORIGINAL .JBREL?
SKIPA X1,SJOBRL
ADDI X1,2000 ;ALLOW SOME EXTRA SPACE.
CAML X1,.JBREL
JRST SCRER5
SCRER4: CORE X1,
JRST .+1
SCRER5: SETZM PAKFLG
POP P,X1
POPJ P,
;ROUTINES TO RETURN TO THE SYSTEM.
SYSER: PUSHJ P,QSA
ASCIZ /TEM/
JRST .+1
EXIT
MONER: PUSHJ P,QSA
ASCIZ /ITOR/
JRST .+1
EXIT 1,
JRST BASIC
;ROUTINE TO UNSAVE FILES "UNS" OR "UNSAVE"
UNSER: PUSHJ P,QSA
ASCIZ /AVE/
JRST .+1
SETZM HEDFLG ;PRINT HEADING WHEN HEDFLG =0.
UNS3: TLNN C,F.CR
JRST UNS1
PUSHJ P,FILNAM ;DSK:CURFIL.CUREXT.
UNSVFL: JUMP SAVE1
PUSHJ P,UNSER1
JRST BASIC
UNS1: TLNN C,F.COMA
JRST UNS2
PUSHJ P,FILNAM ;DSK:CURFIL.CUREXT.
JUMP SAVE1
PUSHJ P,UNSER1
JRST UNS6
UNS2: PUSHJ P,FILNAM ;MORE OR LESS REAL FILENAME.
JUMP SAVE1
TLNE C,F.CR ;CHECK LEGAL FORM BEFORE DOING ANYTHING.
JRST .+3
TLNN C,F.COMA
JRST COMM1
MOVE A,SAVE1
DEVCHR A, ;DEVICE MUST BE DISK OR DECTAPE.
TLNN A,200100
JRST UNS4 ;FAIL.
PUSHJ P,UNSER1
UNS5: TLNE C,F.CR
JRST BASIC
TLNN C,F.COMA
JRST COMM1
UNS6: PUSHJ P,NXCH
JRST UNS3
UNS4: PUSHJ P,INLMES
ASCIZ /
? UNSAVE DEVICE MUST BE DISK OR DECTAPE, FILE /
SKIPE A,DEVBAS
MOVEM A,SAVE1
PUSHJ P,PRNNAM
OUTPUT
SETZM HEDFLG
JRST UNS5
UNSATP:
UNSER1: OPEN SAVI
JRST UNER1
LOOKUP FILDIR ;LOOKUP THE FILENAME
JRST UNER2
CLOSE
MOVE A,FILDIR
SETZM FILDIR
RENAME FILDIR ;ZERO DIRECTORY ENTRY
JRST UNER3
SKIPE HEDFLG
JRST UNSR12
PUSHJ P,INLMES
ASCIZ /
FILES UNSAVED:
/
OUTPUT
SETOM HEDFLG
UNSR12: PUSHJ P,TTYIN
MOVEM A,FILDIR
SKIPE A,DEVBAS
MOVEM A,SAVE1
PUSHJ P,PRNNAM
PUSHJ P,INLMES
ASCIZ /
/
OUTPUT
POPJ P,
UNER1: PUSHJ P,INLMES ;ERROR MESSAGES.
ASCIZ /
? NO SUCH DEVICE /
SKIPE A,DEVBAS
MOVEM A,SAVE1
PUSHJ P,PRNNAM
UNEROU: OUTPUT
SETZM HEDFLG
POPJ P,
UNER2: SKIPE A,DEVBAS
MOVEM A,SAVE1
PUSHJ P,QNTFND
JRST UNEROU
UNER3: PUSHJ P,INLMES
ASCIZ /
? FILE /
MOVEM A,FILDIR
SKIPE A,DEVBAS
MOVEM A,SAVE1
PUSHJ P,PRNNAM
PUSHJ P,INLMES
ASCIZ / COULD NOT BE UNSAVED/
JRST UNEROU
SUBTTL COMMAND SUBROUTINES
;ROUTINE TO PICK UP FILE NAME AND SET UP FOR DSK ACTION.
;THE FLAG COPFLG IS EXPLAINED AT THE COPY ROUTINE COPER.
FILNAM: SETZM COPFLG
FILNM1: POP P,B ;COPER ENTERS HERE, WITH COPFLG = -1.
SETZM DEVBAS
MOVEI A,<SIXBIT / DSK/>
HRLI A,<SIXBIT / BAS/>
HRLZM A,@(B)
HLLZM A,FILDIR+1
SETZM FILDIR+2
SETZM FILDIR+3
MOVEI X2,FILDIR
PUSHJ P,ATOMSZ
SETZM STARFL ;=0, MEANS DEVICE NOT YET SEEN.
MOVEI X1,":" ;DEVICE INDICATOR.
CAIE X1,(C)
JRST FILN1
JUMPE A,COMM2
SETOM STARFL ;<0, MEANS EXPLICIT DEVICE SEEN.
MOVEM A,DEVBAS
MOVEM A,@(B)
PUSHJ P,NXCH
PUSHJ P,ATOMSZ
SKIPL COPFLG
JRST FILN1
JUMPN A,FILN1
SETZM COPFLG
JRST 1(B)
FILNMO: POP P,B ;ENTRY POINT FOR NO DEVICE ALLOWED.
MOVEI A,<SIXBIT/ DSK/>
HRLZM A,@(B)
SETZM COPFLG
HRRI A,<SIXBIT / BAS/>
HRLZM A,FILDIR+1
MOVEM A,STARFL ;>0, MEANS NO DEVICE ALLOWED.
MOVEI X2,FILDIR
PUSHJ P,ATOMSZ
FILN1: TLNN C,F.PER ;PERIOD SEEN?
JRST FILN2
JUMPE A,COMM2
MOVEM A,FILDIR
MOVEI X2,FILDIR+1
PUSHJ P,NXCH
PUSHJ P,ATOMSZ
FILN2: JUMPN A,FILN3
CAIE X2,FILDIR
JRST FILN3
HRRZ A,B
CAIN A,SAVFIL+1 ;ONLY SAVE AND UNSAVE CAN OMIT THE FILENAME.
JRST FILN9
CAIL A,UNSER
CAILE A,UNSATP
JRST COMM2
FILN9: MOVE A,CURNAM
MOVEM A,FILDIR
HLLZ A,CUREXT
MOVEM A,FILDIR+1
JRST FILN5
FILN3: CAIN X2,FILDIR
JRST FILN4
TRNE A,777777 ;ONLY 3 CHARACTERS ALLOWED
JRST COMM2 ;IN THE EXT.
FILN4: MOVEM A,(X2)
FILN5: SKIPLE STARFL ;POSSIBLE ***?
JRST FILN6 ;NO.
SKIPL STARFL
JRST FILN51
MOVE A,DEVBAS ;ALREADY SEEN A DEVICE.
CAME A,[SIXBIT/BAS/]
JRST FILN6
FILN50: DEVCHR A,
JUMPN A,FILN6
MOVE A,[XWD 5,1]
MOVEM A,FILDIR+3
MOVEI A,<SIXBIT/ DSK/>
HRLZM A,@(B)
MOVSI A,(SIXBIT/BAS/)
MOVEM A,DEVBAS ;FOR USE BY ERROR MESSAGES, ETC.
JRST FILN61
FILN51: CAME C,[XWD F.STAR,"*"]
JRST FILN6
PUSH P,T
PUSHJ P,NXCH
CAME C,[XWD F.STAR,"*"]
JRST FILN7
PUSHJ P,NXCH
CAME C,[XWD F.STAR,"*"]
JRST FILN7
MOVSI A,(SIXBIT /BAS/)
HLLZM A,@(B)
POP P,C ;CLEAN UP PLIST.
PUSHJ P,NXCH
JRST FILN50
FILN7: POP P,T
MOVE C,[XWD F.STAR,"*"]
FILN6: SETZM DEVBAS ;< > 0 SAYS FAKED DEVICE BAS.
FILN61: MOVEI A,DRMBUF
MOVEM A,.JBFF
JRST 1(B)
COMM2: SKIPN COMTIM ;COMMAND TIME?
JRST COMM1 ;YES.
SKIPL COMTIM ;EXECUTION TIME?
JRST CHAER1 ;YES.
FAIL <? ILLEGAL FILENAME> ;MUST BE COMPILE TIME.
;ROUTINE TO CONVERT NEXT ATOM TO SIXBIT
ALPHSX: SKIPA D,[Z (F.LETT)]
ATOMSZ: HRLZI D,F.LETT+F.DIG
HRRZI B,(B) ;SET LH OF A+1 TO 0.
MOVEI A,0
MOVE X1,[POINT 6,A]
ATOMS1: TDNN C,D
POPJ P,
PUSHJ P,SCNLTN ;PACK THIS LETTER INTO A.
JFCL ;SCNLTN HAS SKIP RETURN.
TLNE X1,770000
JRST ATOMS1
POPJ P,
NAMOVE: MOVE X1,FILDIR
MOVEM X1,CURNAM
MOVE X1,FILDIR+1
MOVEM X1,CUREXT
SETZM CURBAS
SKIPE DEVBAS
SETOM CURBAS
POPJ P,
;ROUTINES TO SET LINE LIMITS
LIMITS: TLNE C,F.CR
JRST LIMIT1
PUSHJ P,GETNUM
LIMIT1: MOVEI N,0
MOVEM N,FRSTLN
TLNE C,F.CR
JRST LIMIT2
TLNN C,F.COMA
JRST COMM1
PUSHJ P,NXCH
PUSHJ P,GETNUM
LIMIT2: MOVSI N,1
MOVEM N,LASTLN
POPJ P,
LINLIM: SETZM RETUR1
SKIPN REVFL
TLNE C,F.CR
JRST LINL3
PUSHJ P,GETNUM
LINL1: MOVEI N,0
MOVEM N,FRSTLN
TLNN C,F.CR
JRST LINL4
LINL6: MOVEM N,LASTLN
POPJ P,
LINL4: TLNN C,F.COMA
JRST LINL5
SETOM RETUR1
JRST LINL6
LINL5: TLNN C,F.MINS
JRST COMM1
PUSHJ P,NXCH
PUSHJ P,GETNUM
MOVSI N,1
MOVEM N,LASTLN
HRRZ C,C
CAIN C,54
SETOM RETUR1
POPJ P,
LINL3: SETZM FRSTLN
MOVSI N,1
MOVEM N,LASTLN
POPJ P,
;A NONPRINTING ROUTINE SIMILAR TO PRTNUM:
MAKNUZ: SETZM @SEQPNT ;CLEAR JUNK BEFORE LINE NO CALC
MAKNUM: IDIVI X1,^D10
JUMPE X1,MAKN1
PUSH P,X2
PUSHJ P,MAKNUM
POP P,X2
MAKN1: MOVEI X2,60(X2)
IDPB X2,SEQPNT
POPJ P,
;ROUTINE TO ERASE LINE. LINE NO IN N.
ERASE: HRLZ A,N ;LOOK FOR LINE
MOVEI R,LINROL
PUSHJ P,SEARCH
POPJ P, ;NONE. GO TO INSERTION
MOVE D,(B) ;PICK UP LOC OF LINE
HRLI D,440700 ;MAKE BYTE POINTER
MOVEI T1,0 ;TO USE IN DEPOSITING
ERAS1: ILDB C,D ;GET CHAR
DPB T1,D ;CLOBBER IT
CAIE C,15 ;CARRIAGE RET?
JRST ERAS1 ;NO. GO FOR MORE
SETOM PAKFLA ;MARK FACT THAT THERE IS A HOLE
MOVEI E,1 ;REMOVE ENTRY FROM LINE TABLE
JRST CLOSUP
;HERE WE HAVE A LINE OF INPUT AND THERE IS NO EXISTING LINE
INSERT: MOVE T1,[POINT 7,LINB0]
MOVE T,G ;RESTORE PNTR TO 1ST CHR
INSE2: ILDB C,T ;GET NEXT CHAR
INSE3: CAIN C,15 ;CHECK FOR CAR RET
JRST INSE4
IDPB C,T1
JRST INSE2
INSE4: JUMPL T1,CPOPJ ;CR SEEN. DONE IF JUST DELETION
IDPB C,T1 ;STORE THE CR
MOVEI C,0 ;CLEAR REST OF WORD
TLNE T1,760000
JRST .-3
JRST NEWLIN
;AT THIS POINT, N CONTAINS A LINE NUMBER AND LINB0 CONTAINS
;A NON-EMPTY INSERTED LINE. T1 CONTAINS ADDRESS OF LAST
;WORD OF THE LINE.
NEWLIN: MOVEI T1,(T1) ;COMPUTE LINE LENGTH
SUBI T1,LINB0-1
ADD T1,CETXT ;COMPUTE NEW CEILING OF TEXT ROLL
CAMGE T1,FLLIN ;ROOM FOR LINE PLUS LINROL ENTRY?
JRST NEWL1 ;YES
NEWL0: SUB T1,CETXT ;ASK FOR MORE CORE
MOVE E,T1
ADDI E,1
PUSHJ P,PANIC
ADD T1,CETXT
NEWL1: MOVE D,CETXT ;LOC OF NEW LINE
MOVE T,D ;CONSTRUCT BLT PNTR
HRLI T,LINB0
BLT T,-1(T1) ;MOVE THE LINE
MOVEM T1,CETXT ;STORE NEW CEILING
;HERE, LINE IS IN PLACE, ITS LOC IN D, LINE NUMBER IN N.
;MUST STILL PUT LINE NUMBER IN LINROL.
NEWNBR: PUSH P,D ;*****JUST IN CASE*****
MOVEI R,LINROL
HRLZ A,N
PUSHJ P,SEARCH
JRST .+2
HALT . ;*****IMPOSSIBLE CONDITION*****
MOVEI E,1
PUSHJ P,OPENUP ;MAKE ROOM FOR IT
POP P,D ;*****OTHER HALF OF JUST IN CASE*****
HRRI A,(D) ;CONSTRUCT LINROL ENTRY
MOVEM A,(B) ;STORE ENTRY
POPJ P, ;ALL DONE
SUBTTL ERROR MESSAGES
;ERROR MESSAGE ROUTINE.
;
;AC T ENTERS WITH THE LOC OF THE MESSAGE.
;ALL OTHER AC'S, EXCEPT P, CAN BE DESTROYED.
ERRMSG: SETZM ODF
SETZM HPOS
PUSHJ P,TTYIN
SETZ D, ;END ON NULL.
PUSHJ P,PRINT ;PRINT MESSAGE.
SKIPG COMTIM ;[227]EXECUTING?
JRST ERRMS1 ;[227]NO--NO LINE NUMBER
PUSHJ P,INLMES ;[227]YES-TELL WHICH LINE
ASCIZ / IN LINE / ;[227]
MOVE T,SORCLN ;[227]GET SOURCE LINE NUMBER
PUSHJ P,PRTNUM ;[227]PRINT IT
ERRMS1: SKIPE CHAFL2 ;[227]CONTINUE CHAINING?
JRST .+3
OUTPUT ;NO.
JRST UXIT
ERRMS2: PUSH P,[Z UXIT] ;YES, ADD DEV, FILENM, ETC.
ERRMS3: PUSHJ P,INLMES
ASCIZ / IN /
PUSH P,ODF
SETZM ODF
SKIPN CURBAS
JRST .+3
MOVSI T,(SIXBIT/BAS/)
JRST ERRM35
HLRZ T,CURDEV
CAIN T,<SIXBIT/ DSK/>
JRST ERRMS4
MOVE T,CURDEV ;DEV MAY BE > 3 LETTERS.
ERRM35: PUSHJ P,PRNSIX
MOVEI T,32
PUSHJ P,PRNSIX
ERRMS4: MOVE T,CURNAM
PUSHJ P,PRNSIX
HLRZ T,CUREXT
CAIN T,<SIXBIT/ BAS/>
JRST .+3
TLO T,16
PUSHJ P,PRNSIX
POP P,ODF
OUTPUT
SETZM HPOS
POPJ P,
NOOUT: ASCIZ /
? CANNOT OUTPUT TO THIS DEVICE/
NOIN: ASCIZ /
? CANNOT INPUT FROM THIS DEVICE/
COMM1: PUSHJ P,INLMES
ASCIZ /
? WHAT?
READY
/
JRST FIXUP
BADDEL: PUSHJ P,INLMES ;DELETE COMMAND HAD NO ARGUMENTS.
ASCIZ /
? DELETE COMMAND MUST SPECIFY WHICH LINES TO DELETE
/
JRST FIXUP
NOSAVE: PUSHJ P,TTYIN
PUSHJ P,INLMES
ASCIZ "
? CANNOT OUTPUT "
MOVE T,FILDIR
PUSHJ P,PRNSIX
HLRZ T,FILDIR+1
CAIN T,<SIXBIT/ BAS/>
JRST .+3
TLO T,16
PUSHJ P,PRNSIX
OUTPUT
SETZM HPOS
JRST BASIC
QCOP63: ASCIZ /
? > 63 OR < 1 COPIES REQUESTED IN QUEUE ARGUMENT
/
QUEDUP: ASCIZ /
? DUPLICATE SWITCH IN QUEUE ARGUMENT
/
QLIMLG: ASCIZ /
? PAGE LIMIT > 9999 OR < 1 IN QUEUE ARGUMENT
/
CATFAL: ASCIZ /
? CATALOG DEVICE MUST BE DISK OR DECTAPE
/
NOTIMP: ASCIZ /
? THIS COMMAND IS NOT IMPLEMENTED FOR THIS MONITOR
/
INERR1: ASCIZ /
? LINE TOO LONG/
NOGETF: PUSHJ P,QNTFND
JRST BASIC
TTYIN: PUSH P,T
MOVEI T,TTYBUF ;SET UP TTY BUFFS
MOVEM T,.JBFF
INIT 1
SIXBIT /TTY/
XWD TYO,TYI
HALT .-3
INBUF 1
OUTBUF 1
SETZ T, ;[206]SET UP TO CHECK FOR
DEVCHR T, ;[206]A TTY DEVICE
TLNE T,(DV.TTY) ;[206][235]MUST BE A TTY DEVICE
TLNE T,(DV.DSK!DV.DTA);[235]AND NO OTHERS (IE. NUL)
JRST [OUTSTR [ASCIZ /?COMMAND DEVICE NOT A TTY - ABORT -
/]
EXIT 1, ;[206]DEVICE NOT LEGAL SO ERROR AND EXIT
JRST BASIC] ;[212]RETURN TO COLD START FOR CONTINUE'S
POP P,T
POPJ P,
EXTERN BADGNN
BADGET: TTCALL 3,ASCMSG
MOVE X1,[POINT 7,BADGNN]
MOVEM X1,SEQPNT
MOVE X1,BADGNN ;LAST GOOD LINE NUMBER.
TLNN X1,-1 ;HAS IT BEEN CHANGED ALREADY?
PUSHJ P,MAKNUZ ;NO, MAKE THE NUMBER
TTCALL 3,BADGNN
SKIPN CHAFL2 ;CHAINING?
JRST BADG4 ;NO.
TTCALL 3,ASCIN ;YES.
SKIPN CURBAS
JRST BADG0
MOVEI C,[ASCIZ/BAS/]
JRST BADG1
BADG0: HLRZ T,CURDEV
CAIN T,<SIXBIT/ DSK/>
JRST BADG11
MOVE C,CURDEV
PUSHJ P,UNPACK
BADG1: TTCALL 3,(C)
TTCALL 3,ASCCLN
BADG11: MOVE C,CURNAM
PUSHJ P,UNPACK
TTCALL 3,(C)
HLRZ C,CUREXT
CAIN C,<SIXBIT/ BAS/>
JRST BADG4
TTCALL 3,ASCPER
HLLZ C,CUREXT
PUSHJ P,UNPACK
TTCALL 3,(C)
BADG4: TTCALL 3,ASCCR
JRST GETT1
ASCMSG: ASCIZ/% MISSING LINE NUMBER FOLLOWING LINE /
ASCIN: ASCIZ / IN /
ASCCLN: ASCIZ /:/
ASCPER: ASCIZ /./
ASCCR: ASCIZ /
/
NOGETD: SETZM ODF
PUSH P,T
PUSHJ P,INLMES
ASCIZ /
? NO SUCH DEVICE /
POP P,T
PUSHJ P,PRNSIX
OUTPUT
JRST UXIT
NOLIN: ASCIZ /
? NO SUCH LINE IN RUN(NH) OR CHAIN/
ILLIN: ASCIZ /
? ILLEGAL LINE REFERENCE IN RUN(NH) OR CHAIN/
NOTNEW: ASCIZ /
? DUPLICATE FILE NAME. REPLACE OR RENAME/
RESERR: ASCIZ /
? COMMAND ERROR (YOU MAY NOT OVERWRITE LINES OR CHANGE THEIR ORDER)
/
OUTERR: MOVEI T,INLSYS ;OUTERR EXPECTS THE STATUS BITS IN N.
TRNE N,040000
MOVEI T,OUTQMS
TRNE N,400000
MOVEI T,OUTLMS
JRST ERRMSG
OUTLMS: ASCIZ /
? DEVICE IS WRITE LOCKED/
OUTQMS: ASCIZ /
? QUOTA EXCEEDED OR BLOCK NO. TOO LARGE ON OUTPUT DEVICE/
SUBTTL COMPILER MAIN LOOP
;BEGINNING OF COMPILATION
RUNER: SETOM COMTIM
MOVEI A,0
PUSHJ P,QSA ;IS IT RUNNH
ASCIZ /NH/
MOVEI A,1 ;NO, PRINT HEADING
SETOM RUNLIN
TLNE C,F.CR ;IS THERE A LINE NUMBER ARGUMENT?
JRST RUNER3 ;NO, LEAVE RUNLIN SET TO -1.
PUSHJ P,GETDNM
JRST COMM1
TLNN C,F.CR
JRST COMM1
MOVEM N,RUNLIN ;YES, STORE THE LINE NUMBER IN RUNLIN.
RUNER3: JUMPE A,RUNNH ;SHALL WE PRINT THE HEADING?
PUSHJ P,INLMES
ASCIZ /
/
PUSHJ P,LIST01 ;PRINT HEADING SANS <RETURN>
OUTPUT
PUSHJ P,INLMES
BYTE (7) 15,12,12 ;SKIP TWO LINES
RUNNH: MOVEI X1,^D9 ;CHAIN ENTRY POINT.
RUNNH1: SETZM ACTBL-1(X1)
SETZM FILD-1(X1)
SETZM EXTD-1(X1)
SOJG X1,RUNNH1
SETOM VRFSET
SETOM COMTIM
SETZM FILCNT
SKIPN CHAFLG
JRST .+3 ;NO.
MOVE P,PLIST
PUSHJ P,TTYIN
SKIPE SWAPSS ;SET THE CORE CRUNCHING FLAG IF
SETOM PAKFLG ;THIS IS A SWAPPING SYSTEM.
PUSHJ P,LOCKON ;PROTECT REST OF COMPILATION
PUSHJ P,PRESS ;GUARANTEE SOURCE DOESN'T MOVE!!!
MOVEI X1,CODROL ;COMPILE TIME.
MOVEM X1,TOPSTG ;TXT,LIN,CODROLS ARE STODGY. OTHERS MOVE.
MOVEI R,LINROL
PUSHJ P,SLIDRL ;SLIDE LINROL DOWN NEXT TO TXTROL.
JRST RUNER1
SLIDRL: MOVE X2,CEIL(R)
HRRZ X1,CEIL-1(R) ;SLIDE ROLL DOWN NEXT TO LOWER ROLL
ADD X2,X1
HRL X1,FLOOR(R) ;SET UP BLT TO MOVE ROLL
SUB X2,FLOOR(R)
HRRZM X1,FLOOR(R) ;SET NEW ROLL FLOOR
BLT X1,(X2)
MOVEM X2,CEIL(R)
POPJ P,
RUNER1: MOVEM X2,FLCOD
MOVEM X2,CECOD ;CODROL IS ALSO PACKED IN PLACE.
MOVEI X1,CODROL ;PREPARE TO CLOBBER ALL ROLLS ABOVE CODROL
MOVE T,.JBREL ;USE THIS VALUE.
PUSHJ P,CLOB ;DO THE CLOBBERING.
MOVEI F,0 ;CLEAR COMPILATION FLAGS
SKIPE CHAFLG ;CHAINING?
JRST RUNER0 ;YES, DON'T DISTURB THE TIME.
MOVEI T,0 ;SET UP AC FOR RUNTIM.
RUNTIM T, ;GET TIME OF START.
MOVEM T,MTIME ;SAVE TIME AT START OF RUNER
RUNER0: SETOM RUNFLA
SETZM DATAFF ;CLEAR DATA FLAG
SETOM TMPLOW ;NO TEMPORARIES USED YET.
MOVEI F,REFROL ;CREATE A ROLL OF ZEROS
PUSHJ P,ZERROL
;NOW MARK THIS ROLL TO SHOW WHAT PARTS OF THIS PROG ARE INSIDE OF FUNCTIONS:
LUKDEF: MOVEI A,LUKD0 ;SCAN FOR NEXT "DEF" STA
LUKD0: PUSHJ P,NXLINE ;PREPARE TO READ THE NEXT LINE.
MOVEI X1,[ASCIZ/DEFFN/]
PUSHJ P,QST ;IS IT A "DEF" STA?
JRST LUKD3 ;NO. GO ON TO NEXT LINE
HRRZ B,C ;YES. SAVE FN NAME.
MOVEI A,LUKD2
LUKD1: PUSHJ P,NXCH ;NOW LOOK FOR EQUAL SIGN
TLNE C,F.TERM
JRST LUKD3 ;NO EQUAL. ITS A MULTILINE DEF.
TLNN C,F.EQAL
JRST LUKD1 ;TRY NEXT CHAR.
JRST LUKD24 ;ITS A ONE LINE DEF. IGNORE IT.
LUKD2: MOVEI A,.+2 ;MARK EVERY LINE OF THIS MULTILINE FN!
ROT B,-7 ;PUT FUNCTION NAME IN FIRST CHAR POSITION
PUSHJ P,NXLINE
MOVEM B,(G) ;NOW THIS LINE CONTAINS THE NAME OF ITS FN.
MOVEI X1,[ASCIZ /FNEND/]
PUSHJ P,QST ;END OF THE FN?
JRST .+2
LUKD24: MOVEI A,LUKD0 ;YES. SCAN FOR NEXT DEF.
LUKD3: AOBJN L,(A) ;GET NEXT LINE, IF THERE IS ONE.
JRST RUNER2
;FINISHED MARKING FUN LINES. NOW SET UP A CLEAR LADROL...
RUNER2: MOVEI F,LADROL
PUSHJ P,ZERROL
JRST EACHLN
;ROUTINE TO MAKE A ROLL OF ZEROS =IN LNTH TO LINROL.
ZERROL: MOVE R,F
MOVE E,CELIN ;COMPUTE LENGTH OF ROLL
SUB E,FLLIN
JUMPE E,NOEND ;NOTHING TO DO
MOVN L,E ;SAVE FOR LINE CNTR.
MOVSI L,(L)
PUSHJ P,BUMPRL ;ADD TO (EMPTY) ROLL
MOVE T,FLOOR+(F) ;CLEAR IT TO 0S
SETZM (T)
HRL T,T
ADDI T,1
MOVE T1,CEIL+(F)
CAILE T1,(T) ;SUPPRESS BLT IF ONLY 1 LINE
BLT T,-1(T1)
POPJ P,
;SO FAR, WE HAVE SET UP LADROL FOR ADDRESSES & CHAINS FOR LABLES
;ALSO, L IS A WORD TO AOBJN & COUNT THROUGH LINES.
;BEGIN COMPILATION OPERATIONS FOR EACH LINE
EACHLN: MOVE P,PLIST ;FIX P LIST IN CASE LAST INST FAILED
PUSHJ P,LOCKOF ;CHECK REENTER REQUEST
PUSHJ P,LOCKON
MOVE X1,TMPLOW
MOVEM X1,TMPPNT ;NO UNPROTECTED TEMPORARIES USED YET.
SETZM LETSW
SETZM TRNFLG ;NOT YET SEEING MAT TRN.
SETZM REGPNT ;REG IS FREE
SETZM PSHPNT ;NO "PUSH" INSTS GENERATED YET
SETOM VRFSET
SKIPN FUNAME ;IN MIDST OF MULTI-LINE FUNCTION
JRST .+3
MOVMS VRFSET
JRST EACHL2
MOVE X1,FLARG ;NO FUNCTION ARGS YET
MOVEM X1,CEARG
EACHL2: PUSHJ P,NXLINE ;SET UP POINTER TO THIS LINE.
MOVSI A,(SIXBIT /REM/) ;PREPARE FOR COMMENT
CAIE C,":" ;IMAGE = REM.
TLNE C,F.TERM ;NULL STATEMENT?
JRST EACHL1 ;YES. ELIDED "REM" (FIRST CHAR WAS AN APOSTROPHE)
TLNN C,F.LETT ;[165]
JRST ILLINS ;[165]
PUSHJ P,SCNLT1 ;SCAN FIRST LTR
CAIE C,"("
TLNE C,F.EQAL+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.EQAL ;IS FOURTH CHAR AN '=' SIGN?
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
CAMN A,[624555000000] ;FIX FOR REM
HRRZ C,C ;TWO LINES.
JRST EACHL1
ELILET: MOVSI A,(SIXBIT /LET/) ;ASSUME A "LET" STATEMENT.
MOVS T,D ;GO BACK TO THE FIRST LETTER.
HRLI T,440700
PUSHJ P,NXCHK
;HERE, FIRST 3 LTRS OF VERB (SIXBIT) ARE IN A. USE TBL LOOKUP AND DISPATCH.
EACHL1: MOVEI R,STAROL
PUSHJ P,SEARCH ;LOOK IN STATEMENT TYPE TABLE
JRST ILLINS ;NO SUCH, GO BITCH
HRRZ A,(B) ;FOUND.
MOVE X1,CECOD ;PUT REL ADDRS IN LADROL
SUB X1,FLCOD
MOVE X2,FLLAD
ADDI X2,(L)
HRLM X1,(X2)
HRLI D,(MOVEI L,)
TRZN A,20000 ;EXECUTABLE?
JRST EACHL6
PUSHJ P,BUILDI ;FORCE STORE OF SOURCE LINE
MOVE D,[MOVEM L,SORCLN] ;NUMBER IN SORCLN.
PUSHJ P,BUILDI
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: TLNN C,F.TERM ;CHECK FOR END OF LINE
JRST ERTERM
SKIPE VRFSET
JRST NXTST1
MOVE D,[SETZM VRFBOT]
PUSHJ P,BUILDI
;ENTER HERE FROM ERROR ROUTINE
NXTST1: AOBJN L,EACHLN
NOEND: MOVEI T,NOEND1 ;IF NONE, DIDNT SEE END
JRST ERRMSG
NOEND1: ASCIZ /
? NO END INSTRUCTION/
;END OF COMPILE/EXECUTE PHASE
REUXIT: SETZM MTIME
UXIT: SETZM CHAFL2
SETZM CHAFLG ;ZERO CHAIN FLAG UNLESS WE ARE
CHAXIT: SETZM FUNAME ;REALLY CHAINING.
SETZM COMTIM
SETZM HPOS
MOVE P,PLIST
SETZM NUMCOT
SETZB LP,IFIFG
SKIPN UXFLAG ;END OF PROG EXECUTION?
JRST UXIT5 ;NO.
SETOM ODF
MOVEI LP,^D9
UXIT3: SKIPL A,ACTBL-1(LP)
JRST .+3
PUSHJ P,CLSRAN
JRST UXIT49
CAIE A,3
JRST UXIT49
SETZM 40
SETZM WRIPRI-1(LP) ;[216]CLEAR TABLE ENTRY FOR THIS CHN.
PUSHJ P,PRDLER
SKIPE HPOS(LP)
PUSHJ P,CRLF3
UXIT49: SOJG LP,UXIT3
SETZM ODF
PUSHJ P,PRDLER
UXIT5: SETZM ODF
DEFINE R(A)
< IRP A
< RELEASE ^D<A>, >>
R<1,2,3,4,5,6,7,8,9> ;DISK DATA FILES 1-9
SKIPN UXFLAG ;END OF PROGRAM EXECUTION?
JRST UXIT1 ;NO.
SETZM UXFLAG ;YES.
SETZM MARWAI
MOVEI X1,^D72
MOVEM X1,MARGIN
SETZM QUOTBL
SETZM HPOS
SETOM PAGLIM
MOVEI X1,^D9
UXIT2: SKIPL A,ACTBL-1(X1) ;ACTBL ENTRY = 3 IF FILE
CAIN A,3
JRST UXIT21 ;IS BEING WRITTEN.
SOJG X1,UXIT2
JRST UXIT1
UXIT21: PUSH P,[Z UXIT4]
UXIT6: MOVE X2,FILD-1(X1)
MOVEM X2,LOK
MOVE X2,EXTD-1(X1)
MOVEM X2,LOK+1
HLRZ X2,BA-1(X1)
MOVEM X2,.JBFF
XCT INITO-1(X1)
JRST [MOVE T,OPS1+1
JRST NOGETD] ;OUTPUT MESSAGE "NO SUCH DEVICE"
DPB X1,[POINT 4,LOKUP,12] ;AND GIVE UP BECAUSE
HLLZS LOK+1 ;ALL DEVICES ARE THE SAME.
SETZM LOK+2
SETZM LOK+3
XCT LOKUP
JRST .+1
UXIT7: HLLZ X2,LOK+2
TLZ X2,777 ;MAKE SURE ONLY PROTECTION FOR DATE75
SKIPL MONLVL
TLNN X2,700000
IOR X2,MONLVL ;MONLVL CONTAINS THE "DON'T DELETE " BIT.
MOVEM X2,LOK+2
HLLZS LOK+1
DPB X1,[POINT 4,RENAMD,12]
XCT RENAMD
JRST .+1 ;RENAME FAILS FOR DECTAPES.
POPJ P,
UXIT4: SOJG X1,UXIT2 ;RETURN HERE FROM RENFAL MESSAGE.
JRST CHAXIT
UXIT1: SETZM RUNFLA
PUSHJ P,TTYIN ;INIT TTY IN CASE OF ^O.
SKIPE CHAFLG ;CHAINING?
JRST FIXUP ;YES.
SKIPE MTIME ;IS THERE SOME RUN TIME?
PUSHJ P,RTIME
PUSHJ P,INLMES
ASCIZ /
READY
/
JRST FIXUP ;GO TO MAIN LOOP AFTER CLEARING ROLLS
SUBTTL PROGRAM "LOADER"
;HERE AFTER END STATEMENT
LINKAG: MOVEI R,CONROL ;SLIDE RUNTIME ROLLS DOWN INTO PLACE.
PUSHJ P,SLIDRL
CAIGE R,TMPROL
AOJA R,.-2 ;SLIDE NEXT ROLL.
MOVEM X2,VARFRE ;FIRST FREE LOC IS CEIL OF TMPROL.
MOVE E,CETMP ;CHECK ARRAY REQUIREMENTS
MOVE T,FLARA
SETZM TRNFL2
SETZM TRNFLG
JRST LK2A
LK1: HLRZ X1,(T) ;KNOW SIZE?
JUMPN X1,LK2 ;YES, JUMP
SKIPG 2(T) ;DON'T SET UP FAKE MATRIX
JRST .+3 ;YET, BUT REMEMBER WHICH ONE
MOVEM T,TRNFLG ;IT IS.
JRST LK2
MOVSI X2,^D11 ;(11,1) IS STANDARD DIM
AOJ X2,
MOVEI X1,^D11
MOVE A,1(T)
CAMGE T,FLSVR ;DEFAULT SIZE OF STRING VECTORS IS (11,1)
AOJE A,.+2 ;IMPLICIT 2-DIM ARRAY?
JRST .+3
HRRI X2,^D11
MOVEI X1,^D121
MOVEM X2,1(T)
HRLM X1,(T) ;STORE SIZE
LK2: ADD E,X1 ;ADD LENGTH TO IT
SKIPL 2(T)
JRST .+3
CAMLE X1,TRNFL2 ;TRNFL2 CONTAINS THE SPACE NEEDED
MOVEM X1,TRNFL2 ;BY THE LRGST ARRAY SET = ITS OWN TRN.
ADDI T,3 ;ON TO NEXT ENTRY
CAMG T,FLSVR ;IS THIS ONE A STRING VECTOR?
JRST LK2A ;NO.
HLRZ X2,-1(T) ;LOOK AT FIRST DIMENSION
SOJLE X2,LK2A ;IS IT 1(AND THUS A VECTOR)?
HRRZ X2,-1(T) ;NO. LOOK AT SECOND DIMENSION
SOJLE X2,LK2A ;IS IT 1(AND THUS A VECTOR)?
SETZM RUNFLA ;NO. FATAL ERROR.
PUSHJ P,INLMES
ASCIZ /
? STRING VECTOR IS 2-DIM ARRAY/
SKIPE CHAFL2 ;CHAINING?
PUSHJ P,ERRMS3
LK2A: CAME T,FLSVR ;[166]BEGINNING OF SVRROL SCAN?
JRST LK2C ;[166]
SKIPN X2,TRNFLG ;[166]
JRST LK2B ;[166]
MOVE X1,TRNFL2 ;[166]
HRLM X1,(X2) ;[166]
ADD E,X1 ;[166]
LK2B: MOVEM E,SVRBOT ;[166]
LK2C: CAMGE T,CESVR ;[166]
JRST LK1 ;[166]
LK3: SETOM VPAKFL ;DONT TRY TO PRESS VARAIBLE SPACE NOW!
SUB E,CESVR ;WE NEED THIS MANY LOCS
LK35: MOVE X1,VARFRE ;IS THERE ROOM FOR (E) LOCS?
ADDI X1,(E)
CAMGE X1,.JBREL
JRST LK37
MOVE X1,.JBREL
ADDI X1,2000
CORE X1,
JRST [MOVEI T,PANIC1
JRST ERRMSG]
JRST LK35
LK37: ADD E,CETMP ;CALCULATE TOP OF ARRAY SPACE.
MOVEM E,SVRTOP ;SAVE IT.
MOVEM E,VARFRE ;THIS IS ALSO FIRST FREE WORD.
LK4: MOVE T,FLFCL
MOVEI R,FCNROL
LINK0A: CAML T,CEFCL
JRST LINK0C ;NO MORE FCN CALLS
HLLZ A,(T) ;LOOK UP FUNCTION
PUSHJ P,SEARCH
JRST LINK0B ;UNDEFINED
MOVE A,(B) ;DEFINED. GET ADDRESS.
HRLM A,(T)
AOJA T,LINK0A
LINK0B: SETZM RUNFLA
PUSHJ P,INLMES
ASCIZ /
? UNDEFINED FUNCTION -- FN/
LDB C,[POINT 7,A,6]
ADDI C,40
PUSHJ P,OUCH
SKIPE CHAFL2
PUSHJ P,ERRMS3
PUSHJ P,INLMES
ASCIZ /
/
AOJA T,LINK0A
LINK0C: MOVE B,FLFOR ;UNSAT FORS?
CAML B,CEFOR
JRST LINK0D
PUSHJ P,INLMES ;[162]
ASCIZ /? FOR WITHOUT NEXT/ ;[162]
MOVE L,(B) ;GET POINTER TO LINE NUMBER
PUSHJ P,FAIL2 ;[162]PRINT ERROR MSG
ADDI B,5 ;MORE UNSAT FORS?
JRST LINK0C+1
LINK0D: SKIPG DATAFF ;WAS DATA OMITTED?
JRST LINK0E ;NO
PUSHJ P,INLMES
ASCIZ /
? NO DATA/
SKIPE CHAFL2
PUSHJ P,ERRMS3
LINK0G: SETZM RUNFLA
LINK0E: SKIPGE RUNLIN ;LINE NUMBER ARG IN RUN(NH) COMMAND?
JRST LINK0F ;NO.
HRLZ A,RUNLIN ;YES. MAKE SURE IT EXISTS AND
MOVEI R,LINROL
PUSHJ P,SEARCH
JRST [MOVEI T,NOLIN
JRST ERRMSG]
SUB B,FLOOR(R)
MOVEM B,RUNLIN
ADD B,FLREF ;IS NOT WITHIN A MULTI-LINE DEF.
SKIPN (B)
JRST LINK0F
MOVEI T,ILLIN
JRST ERRMSG
LINK0F: SKIPN RUNFLA ;GO INTO EXECUTION?
JRST UXIT ;NO
MOVE C,FLCOD
;CODE ROLL IS IN PLACE. C CONTAINS ITS FLOOR
LINK0: MOVE T,FLFCL ;LINK FCN CALLS
MOVE T1,CEFCL
MOVE A,FLCOD
MOVEI B,0
PUSHJ P,LINKUP
LINK1A: MOVE T,FLARA ;LINK ARRAY REFS
MOVE T1,CESVR
MOVE A,T
MOVEI B,3
PUSHJ P,LINKUP
LINK1B: MOVE T,FLARA ;STORE ARRAY ADDRESSES IN ARAROL
MOVE G,CETMP
JRST LINK1D
LINK1C: HLRZ X1,(T) ;GET ARRAY LENGTH
HRRM G,(T) ;STORE ABS ADDRS
ADD G,X1 ;COMPUTE ADDRS OF NEXT ARRAY
ADDI T,3 ;GO TO NEXT ENTRY
LINK1D: CAMGE T,T1
JRST LINK1C
LINK1: MOVE T,FLCAD ;LINK CONST REFS
MOVE T1,CECAD
MOVE A,FLCON
MOVEI B,1
PUSHJ P,LINKUP
LINK2: MOVE T,FLPTM ;LINK TEMPORARY REFS (PERM AND TEMP)
MOVE T1,CETMP
MOVE A,T
MOVEI B,1
PUSHJ P,LINKUP
LINK3: MOVE T,FLLAD ;LINK GOTO DESTINATIONS
MOVE T1,CELAD
MOVE A,FLCOD
MOVEI B,0
PUSHJ P,LINKUP
LINK4: MOVE T,FLSCA ;LINK SCALARS
MOVE T1,CEVSP
MOVE A,T
MOVEI B,1
PUSHJ P,LINKUP
LINK6: MOVE T,FLGSB ;LINK GOSUB REFS
MOVE T1,CEGSB
MOVE A,T
MOVEI B,1
PUSHJ P,LINKUP
MOVE T,FLGSB
LINK7: CAML T,T1 ;PUT SUBRTN ADDRSES IN GSBROL
JRST LINK8
HLRZ X1,(T)
ADD X1,FLLAD
HLRZ X1,(X1)
ADD X1,C
MOVEM X1,(T)
AOJA T,LINK7
LINK8: MOVE T,FLNXT ;LINK REVERSE REFS IN FORS
MOVE T1,CENXT
MOVE A,FLCOD
MOVEI B,0
PUSHJ P,LINKUP
LINK9: MOVE T,FLLIT ;LINK LITROL TO SLTROL.
LINK91: CAML T,CELIT
JRST LINK92
HRRZ A,(T)
ADD A,FLSLT
HRRM A,(T)
AOJA T,LINK91
LINK92: MOVE T,FLSAD ;LINK POINTERS TO LITROL
MOVE T1,CESAD
MOVE A,FLLIT
MOVEI B,1
PUSHJ P,LINKUP
SKIPGE X1,RUNLIN ;GET LOC TO START BEFORE
JRST LINKZ ;LADROL IS ZEROED.
ADD X1,FLLAD
HLRZ X1,(X1)
ADD X1,FLCOD
MOVEM X1,RUNLIN
LINKZ: MOVE X1,FLSCA ;ZERO OUT SCALARS AND STRING VARS
MOVE X2,CEVSP
PUSHJ P,BLTZER
MOVE X1,CETMP ;ZERO OUT ARRAY ELEMENTS AND STRING VECTORS.
MOVE X2,ARATOP
PUSHJ P,BLTZER
;BEGIN EXECUTION
EXECUT: SETOM FCNLNK ;[222]INITIALIZE FCN CALLS
PUSHJ P,RESTOR ;SET TO START AT BEGINNING OF DATA
MOVEI R,0 ;POINTER TO GOSUB RTRN
PUSHJ P,INLMES ;RETURNS SIGNAL END OF COMPILATION.
ASCIZ /
/
OUTPUT
;INITIALIZE SOME SWITCHES:
SETZM INPFLA ;NO INPUT CURRENTLY BEING READ
MOVEI X1,1
MOVEM X1,COMTIM
SETZM FILFLG
HRRZ X1,VARFRE ;SET UP FILES.
MOVEM X1,.JBFF
MOVEI X1,9
SETZM PROTEC-1(X1)
SOJG X1,.-1
MOVEI X1,9
EXEC6: SKIPN A,ACTBL-1(X1)
JRST EXEC11 ;NO FILE ON THIS CHANNEL.
EXEC0: HRRZ T1,.JBFF
HRLM T1,BA-1(X1)
SETZM @FILMOD-1(X1) ;MODE IS ASCII FOR SEQ.
JUMPG A,EXEC7 ;FILES AND STRING R.A. FILES,
MOVEI T1,34 ;BINARY FOR NUMERIC R.A. FILES.
SKIPL STRLEN-1(X1) ;SET USER WORD COUNT FOR R.A. FILES.
MOVEI T1,20
MOVEM T1,@FILMOD-1(X1)
EXEC7: XCT INITO-1(X1)
JRST [MOVE T,OPS1+1
JRST NOGETD]
DPB X1,[POINT 4,LOKUP,12]
MOVE N,FILD-1(X1)
MOVEM N,LOK
MOVE N,EXTD-1(X1)
MOVEM N,LOK+1
SETZM LOK+2
SETZM LOK+3
PUSH P,N ;CHECK FOR CORE BEFORE INBUFS.
HRRZ N,.JBFF
ADDI N,406
CAMG N,.JBREL
JRST EXEC71 ;OKAY
MOVE N,.JBREL
ADDI N,2000
CORE N,
JRST [SETZM ACTBL-1(X1)
SETZM RUNFLA
MOVEI T,PANIC1
JRST ERRMSG] ;ABORT
EXEC71: POP P,N
JUMPL A,EXEC8 ;SEQ. OR R.A.?
DPB X1,[POINT 4,IBDSK2,12] ;SEQ.
XCT IBDSK2
SETZM PROTEC-1(X1)
XCT LOKUP
JRST [HRRZ T1,LOK+1
TRZ T1,777770
JUMPN T1,LOOKFL
MOVEI T1,2
JRST .+2]
MOVEI T1,1
MOVEM T1,ACTBL-1(X1) ;SET UP ACTBL.
CAIE T1,1
JRST EXEC72
HLLZ T1,LOK+2 ;SAVE < >.
TLZ T1,777
MOVEM T1,PROTEC-1(X1)
EXEC72: HRRZ T1,.JBFF
HRRM T1,BA-1(X1) ;SET UP BA.
JRST EXEC12
EXEC8: DPB X1,[POINT 4,IBDSK,12] ;RANDOM ACCESS.
XCT IBDSK
HLLZM N,ENT+1
MOVE N,FILD-1(X1)
MOVEM N,ENT
DPB X1,[POINT 4,OBDSK,12]
XCT OBDSK
DPB X1,[POINT 4,ENTDSK,12]
SETZM ENT+2
SETZM ENT+3
SETZM PROTEC-1(X1)
XCT LOKUP ;DOES FILE EXIST NOW.
JRST [MOVE T1,.JBFF
HRRZ A,LOK+1
JUMPN A,LOOKFL
JRST EXEC9]
HLLZ T1,LOK+2
TLZ T1,777
MOVEM T1,PROTEC-1(X1)
MOVEM T1,ENT+2
MOVE T1,.JBFF
XCT ENTDSK ;YES.
JRST ENFFAL
DPB X1,[POINT 4,OUTTDS,12] ;SET UP BUFFER.
XCT OUTTDS
JRST .+2
JRST EXEC86
DPB X1,[POINT 4,INNDSK,12] ;SET UP BUFFER.
XCT INNDSK
JRST EXEC81
EXEC89: DPB X1,[POINT 4,STODSK,12]
XCT STODSK
JRST EXEC91 ;NULL FILE--SAME AS NON-EXISTENT.
EXEC86: SETZM ACTBL-1(LP)
MOVEI T,INLSYS ;SYSTEM ERROR.
JRST ERRMSG
EXEC81: MOVE T1,-403(T1) ;GET FIRST WORD.
TLNN T1,377777
JRST EXEC83
EXEC82: PUSH P,.JBFF
PUSH P,[Z EXNAME]
EXNAM: PUSHJ P,INLMES
ASCIZ /
? FILE /
EXNAM2: MOVE T,FILD-1(X1)
MOVEM T,FILDIR
MOVE T,EXTD-1(X1)
MOVEM T,FILDIR+1
SETZM SAVE1
JRST PRNNAM
EXNAME: PUSHJ P,INLMES
ASCIZ / IS NOT RANDOM ACCESS IN LINE /
EXNAM1: MOVE T,BLOCK-1(X1)
PUSHJ P,PRTNUM
SKIPE CHAFL2
PUSHJ P,ERRMS3
OUTPUT
POP P,.JBFF
SETZM RUNFLA
SKIPE FILFLG
JRST UXIT
JRST EXEC12
EXEC83: HRRZM T1,LASREC-1(X1)
MOVE T1,.JBFF
SKIPGE A,STRLEN-1(X1) ;NUMERIC OR STRING.
JRST EXEC85 ;NUMERIC.
MOVE T1,-402(T1) ;STRING.
CAMGE T1,[000001000000]
JRST EXEC82
JUMPN A,EXEC84
MOVEM T1,STRLEN-1(X1)
HRRZI T1,(T1)
CAIG T1,^D132
CAIGE T1,1
JRST EXEC82
JRST EXEC10
EXEC84: CAME A,T1
JRST .+3
MOVEM A,STRLEN-1(X1)
JRST EXEC10
PUSH P,.JBFF
PUSHJ P,EXNAM
PUSHJ P,INLMES
ASCIZ / RECORD LENGTH OR TYPE DOES NOT MATCH IN /
JRST EXNAM1
EXEC85: SKIPE -402(T1)
JRST EXEC82
SETOM STRLEN-1(X1)
JRST EXEC10
EXEC9: XCT ENTDSK ;NON-EXISTENT FILE.
JRST ENFFAL
DPB X1,[POINT 4,OUTTDS,12] ;SET UP BUFFER.
XCT OUTTDS
JRST .+2
JRST EXEC86
EXEC91: SETZM LASREC-1(X1)
MOVE A,.JBFF ;CLEAR OUTPUT BUFFER.
SUBI A,200
SETZM -1(T1)
SOJ T1,.+1
CAIE T1,(A)
JRST .-3
SKIPL A,STRLEN-1(X1) ;NUMERIC OR STRING?
JRST EXEC92 ;STRING.
HRLZI A,400000 ;NUMERIC.
MOVEM A,(T1)
JRST EXEC93
EXEC92: JUMPN A,.+2
MOVE A,[XWD ^D8,^D34]
MOVEM A,1(T1)
MOVEM A,STRLEN-1(X1)
EXEC93: MOVEI A,200 ;SET THE WORD COUNT.
HRRM A,-1(T1)
DPB X1,[POINT 4,OUTTDS,12]
XCT OUTTDS
JRST EXEC94 ;OUTPUT THE HEADER RECORD.
DPB X1,[POINT 4,GTSTS,12]
XCT GTSTS
JRST [SETZM ACTBL-1(X1)
JRST OUTERR]
EXEC94: DPB X1,[POINT 4,CLOSED,12]
XCT CLOSED
HLLZS LOK+1
SETZM LOK+2
SETZM LOK+3
XCT LOKUP
JRST [HRRZ T1,LOK+1
TRZ T1,777770
JRST LOOKFL]
HLLZS ENT+1
SETZM ENT+2
LDB T1,[POINT 9,PROTEC-1(X1),8]
DPB T1,[POINT 9,ENT+2,8]
SETZM ENT+3
XCT ENTDSK
JRST ENFFAL
HLRZ T1,BA-1(X1)
MOVEM T1,.JBFF
DPB X1,[POINT 4,IBDSK,12]
DPB X1,[POINT 4,OBDSK,12]
XCT IBDSK
XCT OBDSK
DPB X1,[POINT 4,OUTTDS,12]
DPB X1,[POINT 4,INNDSK,12]
XCT OUTTDS
JRST .+2
JRST EXEC86
XCT INNDSK
JRST .+2
JRST EXEC86
EXEC10: HRRZ T1,.JBFF
HRRM T1,BA-1(X1)
JRST EXEC12
EXEC11: SETZM BA-1(X1)
EXEC12: SKIPGE FILFLG ;DON'T LOOP--IF ONCE
JRST OPNFL4 ;ONLY FILE STATEMENT.
SOJG X1,EXEC6 ;GO BACK TO LOOP.
MOVE X1,.JBFF
MOVEM X1,VARFRE
JRST EXEC1
LOOKFL: PUSH P,.JBFF
PUSHJ P,INLMES
ASCIZ /
? CANNOT LOOKUP FILE /
JRST ENTLOK
ENFFAL: PUSH P,.JBFF
PUSHJ P,INLMES
ASCIZ /
? CANNOT ENTER FILE /
ENTLOK: PUSHJ P,EXNAM2
PUSHJ P,INLMES
ASCIZ / IN LINE /
SETZM ACTBL-1(X1)
JRST EXNAM1
EXEC1: PUSHJ P,BASORT ;SORT THE TABLE BA INTO SRTDBA.
MOVEI X1,^D9
EXEC2: SETZM PINPNM-1(X1)
SETZM WRIPRI-1(X1)
SETZM REAINP-1(X1)
SETZM BLOCK-1(X1)
SETZM MODBLK-1(X1)
SETZM POINT-1(X1)
AOS POINT-1(X1)
SETZM EOFFLG-1(X1)
SOJG X1,EXEC2
MOVEI N,^D72
MOVEI X1,^D9
EXEC3: SETZM HPOS(X1)
SETOM FIRSFL(X1)
SETZM TABVAL(X1)
SETZM FMTPNT(X1)
SETZM MARWAI(X1)
SETOM PAGLIM(X1)
SETZM QUOTBL(X1)
SETOM ZONFLG(X1)
MOVEM N,MARGIN(X1)
SOJGE X1,EXEC3
SKIPE RUNFLA ;[221] SKIP IF AN ERROR HAS OCCURED
SETOM UXFLAG
SETOM NUMRES ;NO MAT INPUT HAS OCCURRED YET
SETZ N, ;ARG FOR RANDOM NUMBER SET UP.
PUSHJ P,RANDOM ;INITIALIZE THE "STANDARD" RANDOM NUMBERS.
MOVEI X1,OVTRAP
HRRM X1,.JBAPR
MOVEI X1,10
APRENB X1,
PUSHJ P,LOCKOF ;EXECUTION MAY BE INTERRUPTED.
SETZM IFIFG
SETZM ODF
MOVEI Q,MASAPP
MOVEM Q,MASAPP
MOVE Q,QLIST
SETZM INVFLG
SETZM VRFBOT
SKIPN RUNFLA
JRST UXIT
SETZ X1, ;SET THE CORE INCREMENT AS A FUNCTION
MOVE A,FLSVR ;OF THE NUMBER OF STRING VARIABLES IN
EXEC31: CAML A,CESVR ;THE PROGRAM.
JRST EXEC33
HLRZ X2,(A)
ADDI X1,(X2) ;ADD IN THE ARRAYS.
ADDI A,3
JRST EXEC31
EXEC33: HRRZ X2,CEVSP
SUB X2,FLVSP
ADDI X1,(X2) ;ADD IN THE SCALARS.
MOVEI A,2000
CAIG X1,^D200
JRST EXEC35
MOVEI A,4000
CAILE X1,^D500
MOVEI A,6000
EXEC35: MOVEM A,CORINC
SKIPE CHAFLG ;CHAINING?
JRST EXEC4 ;YES. DON'T DISTURB TIME.
SETZ A,
RUNTIM A,
MOVEM A,BGNTIM
EXEC4: SKIPGE A,RUNLIN ;BEGIN EXECUTION---
JRST @FLCOD ;AT THE BEGINNING.
JRST (A) ;AT A LINE NUMBER.
;SUBROUTINE TO LINK ROLL ENTRIES
;CALL WITH A=ORG OF VALUE ROLL, B=INCREMENT (0 IF EXPLICIT REL LOC)
;T=FLOOR OF SRC ROLL, T1=CEIL OF SRC ROLL
LINKUP: MOVE X2,A
MOVSI X1,C
LNKP1: CAML T,T1 ;FINISHED ROLL?
POPJ P,
HRRZ A,(T) ;FIRST LOC IN CHAIN
JUMPN B,.+3 ;EXPLICIT ADDRS?
HLRZ X2,(T) ;YES. COMPUTE IT
ADD X2,C
JUMPE A,LNKP3 ;SPECIAL CASE--CHAIN VOID
LNKP2: HRR X1,A ;ONE LINK IN CHAIN
HRRZ A,@X1
HRRM X2,@X1
JUMPN A,LNKP2
LNKP3: JUMPN B,.+2 ;EXPLICIT ADDRS?
AOJA T,LNKP1 ;YES, JUST BUMP ROLL PNTR
ADD T,B ;NO, ADD EXPLICIT INCREMENT
ADD X2,B ; (ALSO TO DEST ROLL)
JRST LNKP1
BLTZER: HRL X1,X1 ;ZERO OUT CORE
SETZM (X1)
AOJ X1,
BLT X1,-1(X2)
POPJ P,
SUBTTL STATEMENT GENERATORS
;CHAIN STATEMENT.
;
;CHAIN HAS TWO FORMS:
;
; CHAIN DEV:FILENM.EXT, LINE NO.
; OR
; CHAIN <STRING EXPRESSION>, LINE NO.
;
;IN EACH CASE, ",LINE NO." IS OPTIONAL.
;
;XCHAIN IS REACHED FROM XCHAN.
XCHAIN: PUSHJ P,QSA
ASCIZ /IN/
JRST ILLINS
SKIPE FUNAME
JRST .+4
MOVE D,[PUSHJ P,SETCOR]
PUSHJ P,BUILDI
SETZM VRFSET
TLNN C,F.DIG+F.LETT
JRST XCHAI1
MOVEI A,5
PUSH P,T
PUSH P,C
XCHA0: PUSHJ P,NXCH
TLNE C,F.DIG+F.LETT
SOJG A,XCHA0
JUMPN A,XCHA01
PUSHJ P,NXCH
XCHA01: SETZ A,
TLNN C,F.COMA+F.TERM+F.PER
CAIN C,":"
SETO A,
POP P,C
POP P,T
JUMPE A,XCHAI1
XCHAI2: PUSHJ P,FILNAM ;PROCESS FORM 1.
JUMP CATFLG
MOVSI D,(HRLI N,) ;THE CODE BEING GENERATED
HLR D,CATFLG ;IS DESCRIBED IN MEMO
PUSHJ P,BUILDI ;#100-365-033-00.
MOVSI D,(HRRI N,)
HRR D,CATFLG
PUSHJ P,BUILDI
MOVE D,[MOVEM N,NEWOL1]
PUSHJ P,BUILDI
MOVSI D,(HRLI N,)
HLR D,FILDIR
PUSHJ P,BUILDI
MOVSI D,(HRRI N,)
HRR D,FILDIR
PUSHJ P,BUILDI
MOVE D,[MOVEM N,FILDIR]
PUSHJ P,BUILDI
MOVSI D,(HRLZI N,)
HLR D,FILDIR+1
PUSHJ P,BUILDI
MOVE D,[MOVEM N, FILDIR+1]
PUSHJ P,BUILDI
MOVE D,[SETZM FILDIR+2]
PUSHJ P,BUILDI
SKIPN DEVBAS
JRST XCHA21
MOVE D,[MOVE N,[XWD 5,1]]
PUSHJ P,BUILDI
MOVE D,[MOVEM N,FILDIR+3]
PUSHJ P,BUILDI
MOVE D,[SETOM DEVBAS]
XCHA20: PUSHJ P,BUILDI
JRST XCHAI5 ;GO LOOK FOR LINE NO. ARG.
XCHA21: MOVE D,[SETZM FILDIR+3]
PUSHJ P,BUILDI
MOVE D,[SETZM DEVBAS]
JRST XCHA20
XCHAI1: PUSHJ P,FORMLS ;PROCESS FORM 2.
PUSHJ P,EIRGNP
MOVE D,[AOS T,MASAPP]
PUSHJ P,BUILDI
MOVE D,[MOVEM N,(T)]
PUSHJ P,BUILDI
XCHAI7: MOVE D,[PUSHJ P,CHAHAN]
PUSHJ P,BUILDI
XCHAI5: TLNE C,F.TERM ;LINE NO. ARG?
JRST XCHAI6 ;NO.
TLNN C,F.COMA
FAIL <? CHAIN ARGUMENTS ILLEGAL> ;[200][173]
PUSHJ P,NXCH
PUSHJ P,FORMLN ;YES.
PUSHJ P,EIRGEN
MOVE D,[JUMPL N,CHAERR]
PUSHJ P,BUILDI
MOVE D,[PUSHJ P,IFIX]
PUSHJ P,BUILDI
MOVE D,[CAILE N,303237]
PUSHJ P,BUILDI
MOVE D,[JRST CHAERR]
PUSHJ P,BUILDI
SKIPA D,[MOVEM N,RUNLIN]
XCHAI6: MOVE D, [SETOM RUNLIN]
PUSHJ P,BUILDI
MOVE D, [SETOM CHAFLG]
PUSHJ P,BUILDI
MOVE D,[JRST CHAXIT]
PUSHJ P,BUILDI
JRST NXTSTA
;CHANGE STATEMENT
; CHANGE <VECTOR> TO <STRING>
; OR
;CHANGE <STRING> TO <VECTOR>
;COMPILES A FETCH AND PUT WHICH INTERFACE WITH THE "PUTSTR" ROUTINE
XCHAN: PUSHJ P,QSA ;CHANGE OR CHAIN?
ASCIZ /NGE/
JRST XCHAIN ;NOT CHANGE.
TLNN C,F.LETT
JRST XCHAN1
PUSH P,C
PUSH P,T
PUSHJ P,NXCH
TLNE C,F.DIG
PUSHJ P,NXCH
PUSHJ P,QSA
ASCIZ /TO/
JRST XCHAN3
POP P,T
POP P,C
HRLI F,0
PUSHJ P,VECTOR
JUMPN A,GRONK
MOVSI D,(VECFET)
PUSHJ P,BUILDA ;GENERATE VECTOR FETCH
PUSHJ P,QSF ;"TO" MUST FOLLOW
ASCIZ /TO/
HRLI F,1
TLNN C,F.LETT
JRST ERLETT
PUSHJ P,ATOM
CAIE A,5
CAIN A,6
JRST .+2
JRST ILFORM
MOVSI D,(STOCHA)
XCHAN2: PUSHJ P,BUILDA ;BUILD APPROPRIATE STORE UUO
JRST NXTSTA
XCHAN3: POP P,T
POP P,C
XCHAN1: PUSHJ P,FORMLS ;PROCESS STRING NAME
PUSHJ P,EIRGNP
PUSHJ P,QSF
ASCIZ /TO/
HRLI F,0
PUSHJ P,VECTOR ;REGISTER VECTOR NAME
JUMPN A,GRONK
MOVSI D,(VECPUT)
JRST XCHAN2 ;GO BUILD STORE UUO
;DATA STATEMENT
;<DATA STA>::= DATA <DEC NBR!STRING> [,<DEC NBR!STRING>...]
;NOTE: A DATA STRING ::= " <ANY CHARS EXCEPT CR,LF> "
; OR ::= <A LETTER><ANY CHARS EXCEPT COMMA OR APOST,CR,LF>
;NO CODE IS GENERATED FOR A DATA STATEMENT
;RATHER, THE DATA STATEMENT IN THE SOURCE
;TEXT ARE REREAD AT RUN TIME.
XDATA: ASCIZ /A/
SKIPL DATAFF ;ALREADY SEEN DATA?
MOVEM L,DATAFF ;NO. REMEMBER WHERE FIRST ONE IS
SETZM INPFLA
PUSHJ P,DATCHK ;CHECK FOR LEGAL DATA
FAIL <? DATA NOT IN CORRECT FORM>
JRST NXTSTA
;SUBROUTINE TO CHECK DATA LINE
;ALSO CALLED AT RUN TIME TO CHECK INPUT LINE
;(NOTE.. <RETURN> NOT CHECKED AFTER INPUT LINE)
DATCHK: TLNN C,F.LETT+F.QUOT ;LETTER OR QUOT SIGN FIRST
JRST DATCH2 ;NO, EVALUATE NUMBER
PUSH P,[DATCH3] ;YES, ASSUME STRING AND SKIP OVER
JRST SKIPDA
DATCH2: PUSH P,X1
PUSHJ P,EVANUM
JRST [POP P,X1
POPJ P,]
POP P,X1
DATCH4: CAIE C,"&" ;IF "&", ASSUME MATINPUT TERM
TLNE C,F.CR ;MORE?
JRST CPOPJ1 ;NO. RETURN
SKIPE INPFLA ;FOR READ AND MAT READ
JRST .+3 ;BUT NOT FOR INPUT OR MAT
TLNE C,F.TERM ;INPUT, STOP ALSO ON AN
JRST CPOPJ1 ;APOSTROPHE.
TLNN C,F.COMA ;DID FIELD END CORRECTLY?
POPJ P, ;NO. ERROR
PUSHJ P,NXCH ;YES. SKIP COMMA
TLNE C,F.TERM
JRST CPOPJ1
JRST DATCHK ;AND GO TO NEXT ITEM.
DATCH3: POPJ P,
JRST DATCH4
;DEF STATEMENT
;<DEF STA> ::= DEF FN<LETTER>(<ARGUMENT>) = <EXPRESSION>
;GENERATED CODE IS:
; JRST <A> ;JUMP AROUND DEF
; XWD 0,0 ;CONTROL WORD
; MOVEM N,(B) ;SAVE ARGUMENT IN TEMPORARY
; ...
; (EVALUATE EXPRESSION)
; JRST RETURN ;GO TO RETURN SUBROUTINE
;<A>: ... ;INLINE CODING CONTINUES...
;SEE GOSUB STATEMENT FOR USE OF CONTROL WORD.
;DURING EXPRESSION EVALUATION, LOCATION
;FUNARG CONTAINS ASCII REPRESENTATION OF ARGUMENT NAME.
;ROUTINES CALLED BY FORMLN CHECK FOR USE OF ARGUMENT AND RETURN POINTER
;TO FIRST WORD ON TEMPORARY ROLL.
;PRIOR TO GEN OF FIRST EXPRESSION EVALUATION, THE "REAL" TEMPORARY
;ROLL IS SAVED ON "STMROL" AND AN EMPTY "TEMROL" IS CREATED.
;AFTERWARDS, THE NEW "TEMROL" ENTRIES ARE ADDED TO THE PERMANENT
;TEMPORARY ROLL "PTMROL" AND "TEMROL" IS RESTORED.
;THUS EACH DEFINED FUNCTION HAS ITS OWN SET OF TEMPORARIES
;AND CANNOT CONFLICT WITH TEMPORARIES USED BY THE EXPRESSION
;BEING EVALUATED AT THE POINT OF THE CALL.
;NOTE. SPECIAL CASE: CHECK FOR FUNCTION DEF AS LAST LINE OF PROGRAM
;SUPPRESSES GEN OF "JRST" INSTR. COMPILATION WILL FAIL
;("NO END STATEMENT"); HOWEVER THE WORD AFTER LADROL WOULD BE
;CLOBBERED IF "JRST" WERE GENNED.
XDEF: ASCIZ /FN/ ;HANDLE THE FN PART AUTOMATICALLY
SKIPE FUNAME ;ARE WE IN MIDST OF MULTI-LINE DEF?
FAIL <? NESTED DEF>
MOVEI D,1
MOVEM D,VRFSET
MOVSI D,(JFCL) ;MAKE SURE NOT FIRST WRD OF CODE
MOVE X1,CECOD
CAMG X1,FLCOD
PUSHJ P,BUILDI
TLNN C,F.LETT ;MAKE SURE LETTER FOLLOWS.
JRST ERLETT
PUSHJ P,SCNLT1 ;SCAN FCN NAME.
PUSH P,A ;SAVE FCN NAME WITH COUNT OF ZERO ARGUMENTS
MOVEM A,FUNAME ; FN'NAME IN BODY OF FUNCTION
;ADD FUNCTION NAME TO FCNROL
XDEF1: MOVEI R,FCNROL ;LOOK FOR FCN NAME IN FCNROL
PUSHJ P,SEARCH
JRST .+3
SETZM FUNAME
FAIL <? FUNCTION DEFINED TWICE>
MOVEI E,1 ;ADD TO FCNROL
PUSHJ P,OPENUP
ADD A,CECOD ;CONSTRUCT PNTR TO CONTROL WORD
SUB A,FLCOD ;STORE IN FCNROL ENTRY.
ADDI A,1
MOVEM A,(B)
MOVE B,L ;GET JRST DESTINATION
AOBJP B,.+1 ;DONT GEN JRST IF LAST LINE OF SOURCE.
MOVSI D,(JRST)
PUSHJ P,BUILDI ;GEN JRST INSTR.
MOVEM B,FUNSTA ;REMEMBER WHERE THIS JRST IS
MOVEI D,0 ;BUILD ZERO CONTROL WORD
PUSHJ P,BUILDI
;SCAN FOR ARGUMENT NAME.
XDEF2: CAIE C,"(" ;ANY ARGUMENTS?
JRST XDEF4 ;NO
XDEF2A: PUSHJ P,NXCHK ;SKIP "("
PUSHJ P,SCNLT1 ;ASSEMBLE ARGUMENT NAME
TLNN C,F.DIG
JRST .+3
DPB C,[POINT 7,A,13]
PUSHJ P,NXCHK
MOVEI R,ARGROL ;NOW ADD THIS NAME TO THE ARGUMENT LIST
MOVE B,FLARG ;NOW CHECK ARGROL, FOR TWO IDENTICAL ARGS
XDEF2C: CAML B,CEARG
JRST XDEF2D
CAME A,(B)
AOJA B,XDEF2C
SETZM FUNAME
JRST GRONK
XDEF2D: MOVEI E,1 ;ADD NEW ARG TO ROLL
PUSHJ P,OPENUP
MOVEM A,(B)
AOS (P) ;COUNT THE ARGUMENT
TLNE C,F.COMA ;ANY MORE ARGS?
JRST XDEF2A ;YES
XDEF3: TLNN C,F.RPRN ;FOLLOWING PARENTHESIS?
JRST [SETZM FUNAME
JRST ERRPRN] ;NO.
PUSHJ P,NXCHK ;YES. SKIP IT.
XDEF4: PUSHJ P,ARGCHK ;CHECK FOR RIGHT NUMBER OF ARGUMENTS
;GEN CODE TO EVALUATE EXPRESSION.
MOVE X1,FLTMP ;SAVE TEMP ROLL AS STMROL
MOVEM X1,FLSTM
MOVEM X1,CETMP ;AND EMPTY TMPROL
MOVE X1,TMPLOW ;SAVE TEMP POINTER
MOVEM X1,FUNLOW
SETOM TMPLOW
SETOM TMPPNT
TLNN C,F.EQAL ;MULTI LINE FN?
JRST XDEFM ;YES
PUSHJ P,NXCHK ;NO. SKIP EQUAL SIGN
SETZM FUNAME ;SIGNAL THAT THIS IS NOT A MULTI-LINE FN
PUSHJ P,FORMLN ;GEN THE EXPRESSION
PUSHJ P,EIRGNP ;GET IT IN REG
;NOW BUILD AN INSTRUCTION THAT WILL TELL RETURN HOW MANY ARGS TO POP
;OFF THE PUSH LIST
POP P,B ;ARGCHK PUT THE ADDRESS OF A CONSTANT IN HERE
XDEFE: MOVSI D,(MOVE T,)
PUSHJ P,BUILDA
MOVE X2,CETMP ;RESTORE TMPROL, SAVE TEMPORARIES FOR FCN
MOVE X1,CESTM
MOVEM X2,CEPTM
MOVEM X2,FLTMP
MOVEM X1,CETMP
MOVEM X1,FLSTM
HRRE X1,FUNLOW ;RESTORE TMPLOW
MOVEM X1,TMPLOW
HRRZ X1,FUNSTA ;-1(X1) IS LOC OF JRST AROUND FUNCTION
ADD X1,FLCOD
HRRZ X2,CECOD ;JRST TO THE NEXT INST TO BE CODED
ADDI X2,1
HRRM X2,(X1)
MOVE D,[JRST FRETRN]
JRST XRET1 ;USE RETURN CODE TO BUILD INST
XDEFM: POP P,X1 ;MULTI-LINE DEF. SAVE THE ARGCOUNT PARAMETER FOR FNEND
HRLM X1,FUNSTA
MOVE X1,CEFOR ;SAVE NUMBER OF ACTIVE FORS
SUB X1,FLFOR ;FOR A CHECK OF FORS HALF IN DEF
HRLM X1,FUNLOW
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 < 0 IF THE MATRIX IS SET EQUAL TO ITS OWN TRN,
;>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/
JRST .+1
SETZI F, ;ALLOW STRING VECTORS.
PUSHJ P,ARRAY ;REGISTER ARRAY NAME
CAIE A,5 ;STRING VECTOR? ELSE..
JUMPN A,GRONK ;NON-0 RESULT FLAG-SYNTAX ERROR.
CAIE C,"(" ;CHECK OPENING PAREN
JRST ERLPRN
ADD B,FLOOR(F) ;COMPUTE LOC OF ROLL ENTRY
SKIPLE X1,1(B) ;DIMENSION FLAG SHOULD BE 0 OR -1 OR -2.
FAIL <? VARIABLE DIMENSIONED TWICE>
MOVEM X1,TEMLOC
PUSHJ P,NXCHK ;SKIP PARENTHESIS
PUSHJ P,GETNU ;FIRST DIMENSION
JRST GRONK ;NOT A NUMBER
JUMPN N,.+2
SETZM TEMLOC
HRRZ D,N ;SAVE FIRST DIM
AOBJN D,.+1 ;D::= XWD <FIRST DIM+1>,1
MOVSM D,1(B) ;STORE IN ARAROL (IN CASE 1 DIM)
MOVEI N,1 ;IN CASE ONE DIMENSION
TLNN C,F.COMA ;TWO DIMS?
JRST XDIM1 ;NO
PUSHJ P,NXCHK ;YES. SKIP COMMA.
JUMPN A,GRONK ;STRING VECTOR HAS TWO DIMS?
PUSHJ P,GETNU ;GET SECOND DIM
JRST GRONK ;NOT A NUMBER
JUMPN N,.+2
SETZM TEMLOC
ADDI N,1
HRL D,N ;NOW D HAS XWD <COLS+1>,<ROWS+1>
MOVSM D,1(B) ;STORE IN ROLL SWAPPED
MOVNI X1,2
CAMN X1,TEMLOC
FAIL <? VECTOR CANNOT BE ARRAY>
XDIM1: IMULI N,(D) ;COMPUTE LENGTH OF ARRAY
HRLM N,0(B) ;STORE IN ROLL
XDIMFN: TLNN C,F.RPRN ;CHECK CLOSING PAREN
JRST ERRPRN
PUSHJ P,NXCHK ;LOOK FOR COMMA
TLNN C,F.COMA
JRST NXTSTA ;NO. DONE WITH THIS STATEMENT.
PUSHJ P,NXCHK ;SKIP THE COMMA.
JRST XDIM ;KEEP SCANNING.
;END STATEMENT
;<END STA> ::= END
XEND: MOVE X1,FLLIN ;CHECK THAT IT IS LAST STA
ADDI X1,1(L)
CAME X1,CELIN
FAIL <? END IS NOT LAST>
SKIPN FUNAME
JRST XEND1
PUSHJ P,INLMES
ASCIZ /
? NO FNEND FOR DEF FN/
MOVEI T,FUNAME
SETZ D,
PUSHJ P,PRINT
SKIPE CHAFL2 ;CHAINING?
JRST ERRMS2 ;YES.
PUSHJ P,INLMES
ASCIZ/
/
JRST UXIT
XEND1: MOVE D,[JRST UXIT] ;COMPILE TERMINAL EXIT
PUSHJ P,BUILDI
JRST LINKAG ;GO FINISH UP AND EXECUTE
;FOR STATEMENT
;CALCULATE INITIAL, STEP, AND FINAL VALUES
;
;SET INDUCTION VARIABLE TO INITIAL VALUE
;AND JUMP TO END IF IND VAR > 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)
;<REL. ADRS IN CODROL OF JRST TO END OF-NEXT>
; <POINTER TO INDUCTION VARIABLE>
; <POINTER TO INCREMENT>
; <CURRENT VALUE OF TMPLOW>
XFOR: TLNN C,F.LETT ;MAKE SURE VARIABLE IS FIRST.
JRST ERLETT
MOVE A,L ;SAVE L FOR POSSIBLE ERROR MSG
MOVEI R,FORROL
PUSHJ P,RPUSH
HRLI F,777777
PUSHJ P,REGLTR ;REGISTER ON SCAROL
CAIN A,1 ;BETTER BE SCALAR
TLNN C,F.EQAL ;BETTER HAVE EQUAL
JRST EREQAL
PUSHJ P,NXCHK ;SKIP EQUAL SIGN.
PUSH P,B ;SAVE THE VARIABLE POINTER
PUSHJ P,FORMLN ;GEN THE INITIAL VALUE
PUSHJ P,EIRGNP
MOVSI D,(MOVEM N,) ;GEN STORE INITIAL IN VARIABLE
MOVE B,(P)
PUSHJ P,BUILDA
PUSHJ P,QSF ;LOOK FOR "TO"
ASCIZ /TO/
PUSHJ P,FORMLN ;GEN THE UPPER BOUND.
JUMPL B,XFOR4 ;EXCEPT FOR THE SPECIAL
HLRZ X1,B ;CASE OF A POSITIVE
ANDI X1,ROLMSK ;CONSTANT, FORCE THE
CAIN X1,CADROL ;UPPERBOUND TO BE
JRST .+3 ;STORED IN A
XFOR4: PUSHJ P,EIRGEN ;PERMANENT
PUSHJ P,SIPGEN ;TEMPORARY.
PUSH P,B ;REMEMBER WHERE IT IS
TLNN C,F.TERM ;IS THERE A STEP CLAUSE?
JRST XFOR2 ;LOOK FOR EXPLICIT "STEP"
MOVE T,[POINT 7,[BYTE (35)"STEP1"(7)15]]
PUSHJ P,NXCHK ;GET "S" IN CASE OF CR ;IMPLICIT "STEP1"
XFOR2: PUSHJ P,QSA ;LOOK FOR "BY"
ASCIZ /BY/
JRST .+2
JRST .+3
PUSHJ P,QSF ;LOOK FOR "STEP"
ASCIZ /STEP/
PUSHJ P,FORMLN ;XLATE AND GEN INCREMENT
SETZM CATFLG ;CATFLG=0 SAYS STEP IS NOT A CONSTANT.
HLRZ X1,B
ANDI X1,ROLMSK
CAIE X1,CADROL
JRST XFOR6
SETOM CATFLG ;EXCEPT FOR THE SPECIAL
JRST .+3 ;CASE OF A CONSTANT,
XFOR6: PUSHJ P,EIRGEN ;SAVE THE STEP VALUE
PUSHJ P,SIPGEN ;IN A PERMANENT TEMP.
EXCH B,0(P) ;EXCH WITH TOP OF PDL
PUSH P,B ;SAVE LOC OF UPPER BOUND
MOVE B,-2(P) ;GET INDUCTION VAR IN REG
PUSHJ P,EIRGEN
SKIPE CATFLG
JRST XFOR3
MOVE B,-1(P) ;GET THE INCREMENT POINTER
MOVSI D,(DONFOR) ;BUILD DONFOR EXCEPT FOR A
PUSHJ P,BUILDA ;CONSTANT STEP.
XFOR3: MOVE X1,-1(P)
POP P,B ;BUILD COMPARE INSTR (IT
MOVSI D,(CAMLE N,) ;DOESN'T MATTER WHAT IT
SKIPGE X1 ;IS IF DONFOR IS THERE).
MOVSI D,(CAMGE)
PUSHJ P,BUILDA
MOVSI D,(JRST) ;DUMMY JRST INSTRUCTION
PUSHJ P,BUILDI
MOVE A,CECOD
SUB A,FLCOD ;SAVE LOC FOR NEXT'S JRST
SKIPE RUNFLA ;WAS JRST ACTUALLY
MOVEI A,-2(A) ;NO. DONT ALLOW SPACE FOR IT.
MOVEI R,FORROL
PUSHJ P,RPUSH
POP P,A
EXCH A,(P)
PUSHJ P,RPUSH ;SAVE INDUCTION VARIABLE
EXCH A,(P) ;GET INCREMENT
PUSHJ P,RPUSH
POP P,B ;GET POINTER TO INDUCTION VARIABLE.
MOVSI D,(MOVEM N,) ;BUILD THE STORE THAT WILL BE USED
PUSHJ P,BUILDA ;BY NEXT.
MOVEI R,FORROL
MOVE A,TMPLOW ;SAVE THIS LEVEL OF PROTECTION TO BE RESTORED BY NEXT
PUSHJ P,RPUSH
MOVE A,TMPPNT ;PROTECT TEMPS USED BY THIS "FOR"
MOVEM A,TMPLOW ;IN THE RANGE OF THE FOR.
JRST NXTSTA
;FNEND STATEMENT
;<FNEND STA> ::= FNEND
XFNEND: ASCIZ /ND/
SKIPN A,FUNAME ;MUST FOLLOW A MULTI-LINE FN DEF
FAIL <? FNEND BEFORE DEF>
SETZM FUNAME ;SIGNAL END OF FN
TLO A,(177B13) ;ASSEMBLE THE SCALAR NAME OF THE RESULT
HRLI F,-1
PUSHJ P,SCAREG ;REGISTER IT AS A SCALAR
PUSHJ P,EIRGNP ;GET THE RESULT IN REG
HLRZ B,FUNSTA ;RECOVER THE ADDRESS OF THE ARGUMENT COUNT
HRLI B,CADROL
HLRZ X1,FUNLOW ;THIS IS # OF WDS IN FORROL AT START OF DEF
ADD X1,FLFOR
CAME X1,CEFOR ;ARE ALL NEXTS INSIDE OF DEF COMPLETE?
FAIL <? FNEND BEFORE NEXT>
JRST XDEFE ;FINISH UP END OF FN
;GOSUB STATEMENT XLATE
XGOSUB: ASCIZ /UB/
SKIPE FUNAME
FAIL <? GOSUB WITHIN DEF>
PUSHJ P,GETNUM ;READ STATEMENT NUMBER
JRST GRONK
HRLZ A,N
MOVEI R,LINROL ;LOOK UP LINE NO
PUSHJ P,SEARCH
FAIL <? UNDEFINED LINE NUMBER >,1
SUB B,FLLIN ;SUCCESS. SAVE REL LOC IN LINROL
HRLZ A,B
MOVEI R,GSBROL
PUSHJ P,SEARCH
JRST .+2
JRST XGOS1
MOVEI E,1
PUSHJ P,OPENUP
MOVEM A,(B)
XGOS1: SUB B,FLGSB
HRLI B,GSBROL
MOVSI D,(GOSUB)
PUSHJ P,BUILDA
JRST NXTSTA
;GOTO STATEMENT
XGOTO: ASCIZ /O/
XGOFIN: PUSH P,[Z NXTSTA] ;BUILD GOTO AND END STA
XGOFR: PUSHJ P,GETNUM ;BUILD GOTO AND RETURN
FAIL <? ILLEGAL LINE REFERENCE >
HRLZ A,N ;LOOK FOR DESTINATION
MOVEI R,LINROL
PUSHJ P,SEARCH
FAIL <? UNDEFINED LINE NUMBER >,1
SUB B,FLLIN ;NOW CHECK FOR JUMP INTO/OUTOF FUNCTION
MOVE X1,FLREF
ADD X1,B
MOVE X1,(X1)
CAME X1,FUNAME ;BOTH MUST BE ZERO OR SAME FUNCTION.
FAIL <? ILLEGAL LINE REFERENCE >,1
MOVE D,CECOD
CAME D,FLCOD
JRST XGO1
PUSH P,B ;SPECIAL FIX FOR LOADER,
MOVSI D,(JFCL) ;IN CASE GO IS FIRST INSTRUCTION.
PUSHJ P,BUILDI
POP P,B
XGO1: HRLI B,LADROL
MOVSI D,(JRST)
PUSHJ P,BUILDA ;BUILD INSTR
POPJ P,
;IF STATEMENT
;<IF STA>::=IF <NUM FORMULA> <RELATION> <NUM FORMULA> THEN <LINE NUMBER>
; OR
; ::= IF <STRING FORMULA><RELATION><STRING FORMULA> THEN <LINE NUMBER>
; OR
; ::=IF END <CHANNEL SPEC> THEN <LINE NUMBER>
;RELATION IS LOOKED UP IN TABLE (RELROL)
;WHICH RETURNS INSTRUCTION TO BE EXECUTED
;IF ONE OF THE EXPRESSIONS BEING COMPARED IS
;IN THE REG, THAT ONE WILL BE COMPARED AGAINST
;THE OTHER IN MEMORY. IF NECESSARY, THE
;INSTRUCTION IS CHANGED TO ITS CONTRAPOSITIVE
;BY FUDGING BITS IN THE OP CODE
;IF STATEMENT
XIF: PUSHJ P,QSA
ASCIZ/END/
JRST IFSX7 ;HERE FOR NORMAL IF STATEMENTS.
CAIE C,":" ;HERE FOR IF END STATEMENT.
JRST XIF1 ;SEQ. ACCESS IF END.
PUSHJ P,GETCNA ;R.A. IF END.
MOVNI A,4
XIF2: MOVE D,IFNCOD+4(A)
PUSHJ P,BUILDI
AOJL A,XIF2
JRST IFSX5
IFNCOD: SKIPL ACTBL-1(LP) ;CODE GENERATED.
JRST FNMXER
MOVE N,LASREC-1(LP)
CAMGE N,POINT-1(LP)
XIF1: CAME C,[XWD F.STR,"#"]
JRST ERCHAN
PUSHJ P,GETCNA
MOVE D,[PUSHJ P,EOF]
PUSHJ P,BUILDI
JRST IFSX5
IFSX7: PUSHJ P,FORMLB ;LEFT SIDE, MAY BE A STRING.
HLLZM F,IFFLAG ;SAVE TYPE.
PUSHJ P,GPOSGE ;MAKE SURE IT IS POSITIVE
PUSHJ P,PUSHPR ;SAVE IT
PUSHJ P,SCNLT1 ;FIRST CHAR OF RELATION IN A.
MOVEI X1,">"
CAIE X1,(C) ;NEXT CHAR ">"?
TLNE C,F.EQAL ;OR "="?
PUSHJ P,SCN2 ;PUT TWO CHAR RELATION IN A(SIXBIT)
JFCL
MOVEI R,RELROL ;RELATION TABLE
PUSHJ P,SEARCH
FAIL <? ILLEGAL RELATION>
HRLZ D,(B) ;SAVE RELATION INSTR
PUSH P,D
PUSHJ P,FORMLB ;RIGHT SIDE, MAY ALSO BE A STRING
XOR F,IFFLAG
JUMPGE F,IFSX2
FAIL <? MIXED STRINGS AND NUMBERS>
IFSX2: PUSHJ P,GPOSGE
TLNN B,ROLMSK ;IS RIGHT SIDE IN REG?
JRST IFSX4 ;YES, LEAVE IT
PUSHJ P,EXCHG ;NO. SWAP WITH LEFT SIDE.
MOVE D,0(P) ;FUDGE INSTRUCTION FOR CONTRAPOSITIVE RELATION.
TLNE D,1000 ;(EQUAL, NOT EQUAL DON'T CHANGE.)
TLC D,6000 ;(OTHERS DO).
MOVEM D,0(P)
IFSX4:
SKIPL IFFLAG ;NUMERIC COMPARE?
JRST IFSX6 ;NO, STRING.
PUSHJ P,EIRGNP ;MOVE TO REG
PUSHJ P,POPPR ;GET OTHER SIDE BACK
POP P,D ;GET STASHED OP CODE
PUSHJ P,BUILDA ;BUILD COMPARE INSTRUCTION
IFSX5: TLNE C,F.COMA ;SKIP OPTIONAL COMMA.
PUSHJ P,NXCH
PUSHJ P,THENGO ;LOOK FOR "THEN" OR "GOTO"
JRST XGOFIN ;USE GOTO CODE TO GEN JRST INSTR
IFSX6: PUSHJ P,EIRGNP ;SETUP ONE STRING
PUSHJ P,POPPR ;GET OTHER ONE BACK
MOVSI D,(STRIF) ;STRING COMPARE UUO
PUSHJ P,BUILDA ;COMPARE UUO WITH OTHER STRING ADDRESS
POP P,D
PUSHJ P,BUILDI ;BUILD THE RELATION
JRST IFSX5 ;FINISH UP (THE OTHER STR POINTER WILL BE IN N)
;INPUT STATEMENT
;<INPUT STA> ::= INPUT (<SCALAR> ! <ARRAY REF>)[,(<SCALAR>!<ARRAY REF>)...]
XINPUT: ASCIZ /UT/
CAIN C,":" ;INPUT, INPUT#, AND INPUT: STATEMENTS.
JRST XINRAN
CAME C,[XWD F.STR,"#"]
JRST XINP5
SETZM WRREFL
JRST .+2
XINPT0: SETOM WRREFL ;READ# STATEMENTS.
PUSHJ P,GETCNA
MOVE D,[PUSHJ P,INSET]
PUSHJ P,BUILDI
CAIN C,":"
JRST .+3
TLNN C,F.COMA
JRST ERCLCM
PUSHJ P,NXCH
MOVE D,[SKIPN REAINP-1(LP)]
PUSHJ P,BUILDI
MOVE D,[SETOM REAINP-1(LP)]
SKIPN WRREFL
MOVE D,[AOS REAINP-1(LP)]
PUSHJ P,BUILDI
MOVE D,[SKIPL REAINP-1(LP)]
SKIPN WRREFL
MOVE D,[SKIPG REAINP-1(LP)]
PUSHJ P,BUILDI
MOVE D,[JRST REINER]
PUSHJ P,BUILDI
JRST XIN6
XINP5: MOVSI D,(SETZ LP,)
PUSHJ P,BUILDI
MOVE D,[PUSHJ P,INSET]
PUSHJ P,BUILDI
XIN6: MOVE D,[PUSHJ P,DOINPT];FETCH SETUP INSTR.
JRST XINP0
;ENTER HERE FROM READ STATEMENT.
INUUO: DATA (DATA 1,)
ADATA1 (DATA 2,)
ADATA2 (DATA 3,)
STRIN (DATA 4,)
XINP0: SETZM WRREFL
PUSHJ P,BUILDI ;CONSTRUCT SETUP INSTR
XINP1: TLNN C,F.LETT ;CHECK THAT LETTER IS NEXT.
JRST ERLETT
SETZI F, ;STRINGS MAY BE INPUT
PUSHJ P,REGLTR ;GET VARIABLE
SKIPN IFFLAG
MOVEM F,IFFLAG
SKIPN WRREFL
JRST XINP9
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
HRLZ D,INUUO
SKIPN WRREFL
HLLZ D,INUUO
PUSHJ P,BUILDA
JRST XINP3
XINP2: PUSH P,B ;SAVE VARIABLE POINTER
PUSHJ P,XARG ;XLATE ARGS
HRLZ D,INUUO+1
SKIPN WRREFL
HLLZ D,INUUO+1
JUMPE B,XINP2A
HRRZ X1,(P) ;GET ADDRESS OF VARIABLE 2-WD BLOCK
ADD X1,FLARA
SKIPN 1(X1) ;MARK 2-DIM
SETOM 1(X1)
HRLZ D,INUUO+2
SKIPN WRREFL
HLLZ D,INUUO+2
XINP2A: EXCH B,(P) ;SAVE NO OF ARGS, GET VARIABLE
PUSHJ P,BUILDA ;BUILD DATA INSTR
POP P,B ;GET NO OF ARGS
PUSHJ P,GENARG
XINP3: TLNN C,F.COMA ;MORE?
CAIN C,";"
JRST .+2
JRST NXTSTA ;NO
PUSHJ P,NXCHK ;YES. SKIP COMA
JRST XINP1
XINP6: PUSHJ P,FLET2 ;STRING. FINISH REGISTERING
HRLZ D,INUUO+3
SKIPN WRREFL
HLLZ D,INUUO+3
PUSHJ P,BUILDA ;BUILD, WITH ADDRESS
JRST XINP3
XINRAN: PUSHJ P,GETCNA ;R.A. STATEMENT.
MOVE D,[SKIPL ACTBL-1(LP)]
PUSHJ P,BUILDI
MOVE D,[JRST FNMXER]
PUSHJ P,BUILDI
TLNN C,F.COMA
CAIN C,":"
JRST .+2
JRST ERCLCM ;MUST BE >= 1 ARG.
PUSHJ P,NXCH
SETZM IFFLAG
SETOM WRREFL
JRST XINP1
;LET STATEMENT
XLET: SETOM LETSW ;LOOK FOR A LHS.
PUSHJ P,FORMLB
MOVEM F,IFFLAG ;STORE TYPE (STR OR NUM) IN IFFLAG.
TLNN C,F.EQAL ;MUST BE A RHS OR ANOTHER LHS.
JRST EREQAL
XLET0: SKIPL LETSW ;FAIL IF THIS FORMULA IS NOT A VARIABLE.
JRST GRONK
SKIPGE IFFLAG ;STR?
JRST .+3 ;NO.
PUSHJ P,PUSHPR ;YES. REMEMBER ADDR OF RESULT POINTER.
JRST XLET1
CAIE A,1 ;FOR NUM LETS, IF THE LHS IS A LIST OR
JRST XLET1 ;TABLE, FORMLA HAS STORED AC B AND A
PUSH P,[EXP 1] ;FLAG ON PLIST. IF THE LHS IS A SCALAR,
PUSH P,B ;PUT THE FLAG AND AC B ON PLIST HERE.
XLET1: PUSHJ P,NXCHK ;SKIP EQUAL SIGN.
SOS LETSW ;COUNT THIS LHS, AND
PUSHJ P,FORMLB ;LOOK FOR ANOTHER.
XOR F,IFFLAG
JUMPGE F,XLET1A
FAIL <? MIXED STRINGS AND NUMBERS>
XLET1A: TLNE C,F.EQAL ;IF NO =, TEMP. ASSUME THIS IS A RHS.
JRST XLET0
MOVMS LETSW ;FINISHED SCANNING.
SOS LETSW
SKIPL IFFLAG ;STRING LET STA?
JRST XLET4 ;YES.
PUSHJ P,EIRGEN ;NO, GET RESULT IN REG
MOVEM B,TEMP1 ;SAVE THE NEGATIVE RESULT CHECK
XLET1B: MOVE D,[MOVEM N, (MOVNM N,)]
SKIPG -1(P) ;FLAGS ON PLIST ARE --
MOVE D,[ARSTO1 N, (ARSTN1 N,)] ; 0 FOR LIST
SKIPL -1(P) ; 1 FOR SCALAR
JRST XLET2 ; -1 FOR TABLE.
MOVE D,[ARSTO2 N, (ARSTN2 N,)]
MOVE X1,0(P) ;DEFAULT ARRAY SIZE (10,10)
ADD X1,FLARA
SKIPN 1(X1)
SETOM 1(X1)
XLET2: SKIPGE TEMP1 ;CHECK FOR NEGATIVE RESULT
MOVS D,D ;NEGATIVE. GET CORRECT INSTR.
POP P,B ;RESTORE RESULT PNTR
PUSHJ P,BUILDA ;BUILD STORE INSTR
POP P,B ;CHECK TRASH FROM PUSHLIST.
JUMPG B,XLET2B ;ARRAY REF?
PUSHJ P,GENARG ;YES. GEN ARGS FIRST.
XLET2B: SOSLE LETSW
JRST XLET1B ;THERE IS ANOTHER LHS.
JRST NXTSTA
XLET4: PUSHJ P,EIRGNP
PUSHJ P,POPPR ;GET ADDRESS OF LEFT HALF POINTER BACK
PUSH P,B
MOVSI D,(STRSTO) ;BUILD THE STRING MOVE INSTRUCTION.
PUSHJ P,BUILDA
POP P,B
SOSLE LETSW
JRST XLET4 ;THERE IS ANOTHER LHS.
JRST NXTSTA
;MARGIN AND MARGIN ALL STATEMENTS.
;
;THIS ROUTINE IS ALSO USED BY THE PAGE AND PAGE ALL STATEMENTS,
;SINCE THEY GENERATE IDENTICAL CODE, EXCEPT FOR THE PUSHJ AT
;THE END OF THE CODE FOR EACH ARGUMENT. FOR A DESCRIPTION OF THE
;CODE GENERATED, SEE MEMO #100-365-033-00.
XMAR: ASCIZ /GIN/
SETZM TABLE ;TELLS THAT THIS IS REALLY MARGIN (ALL).
XMAR0: PUSHJ P,QSA ;ENTRY POINT FOR PAGE (ALL).
ASCIZ /ALL/
JRST XMAR6 ;MARGIN OR PAGE.
TLNE C,F.TERM ;MARGIN ALL OR PAGE ALL.
JRST ERTERM ;ALL MUST HAVE ARG.
PUSHJ P,FORMLN ;GENERATE CODE FOR THE ARG.
PUSHJ P,EIRGEN
MOVE D,[PUSHJ P,MARGAL]
SKIPE TABLE
MOVE D,[PUSHJ P,PAGEAL]
PUSHJ P,BUILDI
JRST NXTSTA
XMAR6: TLNE C,F.TERM
JRST ERTERM
XMAR1: HRRZ A,C
CAIE A,"#" ;CHANNEL SPECIFIER?
JRST XMAR2 ;NO, MUST BE TTY.
PUSHJ P,GETCNA
TLNE C,F.COMA ;DELIM MUST BE , OR :
JRST XMAR3
CAIE C,":"
JRST ERCLCM
XMAR3: PUSHJ P,NXCH
XMAR5: PUSHJ P,FORMLN
PUSHJ P,EIRGEN
MOVE D,[PUSHJ P,PAGE]
SKIPN TABLE
MOVE D,[PUSHJ P,MARGN]
PUSHJ P,BUILDI
TLNE C,F.COMA ;DELIM AFTER ARG MUST BE , OR ;
JRST XMAR4
CAIE C,";"
JRST NXTSTA
XMAR4: PUSHJ P,NXCH
JRST XMAR1
XMAR2: HRLZI D,(MOVEI LP,)
PUSHJ P,BUILDI
JRST XMAR5
;MAT STATEMENT
;MAT STATEMENTS DIVIDE INTO A NUMBER OF DIFFERENT
;STATEMENTS (MAT READ, ...) THESE POSSIBILITIES ARE TESTED
;ONE AT A TIME BY CALLS TO QSA.
;<MAT READ STA> ::= MAT READ <LETTER>[(<EXP>,<EXP>)] [,<LETTER>[(<EXP>,<EXP>...]]
XMAT: HLLI F, ;ALLOW STRINGS FOR READ,PRINT,INPUT
PUSHJ P,QSA ;MAT READ?
ASCIZ /READ/
JRST XMAT2 ;NO. GO TRY MAT PRINT
XMAT1: HRLI F,0
PUSHJ P,ARRAY ;GET ARRAY NAME
CAIE A,5 ;STRING VECTOR?
JUMPN A,GRONK
MOVSI D,(MATRD)
SKIPL DATAFF ;DATA SEEN?
HLLOS DATAFF ;NO. SET NO DATA FLAG
PUSHJ P,XMACOM ;GO CHECK DIMENSIONS AND BUILD UUO.
TLNN C,F.COMA ;IS THERE ANOTHER ARRAY TO READ?
JRST NXTSTA ;NO.
PUSHJ P,NXCHK ;YES. SKIP COMMA
TLNE C,F.TERM ;END OF ARRAY LIST?
JRST NXTSTA ;YES.
JRST XMAT1
;<MAT PRINT STA>::= MAT PRINT <LETTER>[(<EXP>,<EXP>)] [[;!,] <LETTER>[(<EXP>,<EXP>)...]
XMAT2: PUSHJ P,QSA ;MAT PRINT?
ASCIZ /PRINT/
JRST XMAT3 ;NO. MUST HAVE VARIABLE NAME.
XMAT2A: HRLI F,0
PUSHJ P,ARRAY ;REGISTER NAME
CAIE A,5 ;STRING VECTOR?
JUMPN A,GRONK
MOVSI D,(MATPR)
PUSHJ P,CHKFMT ;CHECK FORMAT CHARACTER
XMAT2B: TLNN D,140
JRST GRONK ;FAIL IF ILLEGAL
PUSHJ P,XMACOM ;GO CHECK DIMENSIONS AND BUILD UUO
TLNE C,F.TERM ;IS FORMAT CHAR FOLLOWED BY END OF STA?
JRST NXTSTA ;YES.
JRST XMAT2A ;PROCESS NEXT ARRAY NAME
;<MAT SCALE STA> ::= MAT <LETTER>=(<EXPRESSION>)*<LETTER>
XMAT3: PUSH P,[Z NXTSTA] ;ALL REMAINING MAT STATEMENTS MAY HAVE
;ONE OPERAND, BUT NOT A LIST OF THEM.
PUSHJ P,QSA
ASCIZ /INPUT/
JRST XMAT3A
PUSHJ P,VCTOR ;[217][207]REGISTER ARRAY OR VECTOR NAME
CAIE A,5 ;STRING VECTOR?
JUMPN A,GRONK ;OR NUMBER VECTOR?
MOVSI D,(MATINP) ;YES. BUILD MAT INPUT
JRST BUILDA
XMAT3A: HRLI F,-1 ;REMAINING MATOPS CANT HAVE STRINGS.
PUSHJ P,ARRAY ;REGISTER THE VARIABLE
JUMPN A,GRONK ;CHECK FOR ILLEGAL ARRAY NAME.
TLNN C,F.EQAL ; CHECK FOR EQUAL SIGN.
JRST EREQAL
PUSHJ P,NXCHK ;SKIP EQUAL.
CAIE C,"(" ;SCALAR MULTIPLE?
JRST XMAT4 ;NO
PUSHJ P,NXCHK ;SKIP PARENTHESIS
PUSH P,B
PUSHJ P,FORMLN ;YES. GEN MULTIPLE
PUSHJ P,EIRGNP
PUSHJ P,QSF ;SKIP MULTIPLY SIGN
ASCIZ /)*/
PUSH P,[MATSCA] ;GET OP CODE.
JRST XMAT9A
VCTOR: PUSHJ P,ARRAY ;[217] REGISTER ARRAY OR VECTOR.
CAIE A,5 ;[217] WAS A STRING REGISTERED ?
JUMPN A,CPOPJ ;[217] NO--WAS AN ARRAY REGISTERED?
MOVE X2,1(X1) ;[217] YES--PROCEED
JUMPG X2,CPOPJ ;[217]
MOVNI X2,2 ;[217]
MOVEM X2,1(X1) ;[217]
POPJ P, ;[217] RETURN
;<MAT SETUP STA> ::= MAT ZER!CON!IDN <LETTER>[(<EXPRESSION>,<EXPRESSION>)]
XMAT4: PUSHJ P,QSA ;MAT ZER?
ASCIZ /ZER/
JRST XMAT5 ;NO.
MOVSI D,(MATZER) ;YES.
JRST XMACOM
XMAT5: PUSHJ P,QSA ;MAT CON?
ASCIZ /CON/
JRST XMAT6
MOVSI D,(MATCON) ;YES.
JRST XMACOM
XMAT6: PUSHJ P,QSA ;MAT IDN?
ASCIZ /IDN/
JRST XMAT7 ;NO
MOVSI D,(MATIDN) ;YES.
;COMMON GEN FOR MAT ZER,CON,IDN,REA
XMACOM: CAIE C,"(" ;EXPLICIT DIMENSIONS?
JRST XMAT9D ;NO.
PUSH P,B ;SAVE B,D.
PUSH P,D
PUSHJ P,XARG ;TRANSLATE ARGUMENTS
PUSH P,B ;SAVE COUNT OF ARGUMENTS
MOVE B,-2(P) ;GET BACK THE REGISTRY OF THE ARRAY.
MOVSI D,(SDIM) ;BUILD SDIM INSTR.
PUSHJ P,BUILDA
POP P,B ;GET THE ARGUMENT COUNT.
JUMPN B,XMACO1 ;ONE ARG OR TWO?
PUSHJ P,GENAFN ;ONE. FAKE DIMENSIONS OF (N,0).
MOVE D,[JUMP 2,ONCESW]
PUSHJ P,BUILDI
JRST XMAT9C
XMACO1: PUSHJ P,GENAR0 ;GEN ARGS
JRST XMAT9C ;RESTORE AC,S AND BUILD.
XMACMI:
;<MAT FCN STA> ::= MAT<LETTER> = INV!TRN (<LETTER>)
XMAT7: PUSHJ P,QSA ;MAT INV?
ASCIZ /INV(/
JRST XMAT8 ;NO
MOVSI D,(MATINV) ;YES. GET OP CODE.
JRST XMITCM
XMAT8: PUSHJ P,QSA ;MAT TRN?
ASCIZ /TRN(/
JRST XMAT9 ;NO.
MOVSI D,(MATTRN) ;YES. GET OP CODE.
MOVEM B,TRNFLG
XMITCM: PUSH P,B ;FINISH MAT INV,TRN.
PUSH P,D
HRLI F,777777
PUSHJ P,ARRAY
JUMPN A,GRONK
PUSHJ P,QSF
ASCIZ /)/
CAME B,TRNFLG
JRST XMAT9B
ADD B,FLOOR(F) ;THIS IS MAT A = TRN (A).
SETOM 2(B) ;MARK A.
MOVE B,TRNFLG ;FAKE IT OUT BY USING AN
MOVSI D,(MOVEI T1,) ;INVISIBLE MATRIX FOR TEMPORARY
PUSHJ P,BUILDA ;STORAGE.
HRLZI A,552640
PUSHJ P,ARRAY0
POP P,D
PUSH P,B
ADD B,FLOOR(F)
AOS 2(B)
MOVE B,(P)
PUSHJ P,BUILDA
JRST XMAT11
;<MAT OPERATOR STA>::=MAT <LETTER>=<LETTER>+!-!*<LETTER>
XMAT9: PUSH P,B ;SAVE RESULT LOCATION
HRLI F,777777
PUSHJ P,ARRAY
JUMPN A,GRONK
MOVEI D,0 ;LETTER FOLLOWED BY OPERATOR
TLNN C,F.PLUS+F.MINS+F.STAR
JRST XMAT10 ;NO OPERATOR. MUST BE MAT COPY
TLNN C,F.MINS+F.STAR
MOVSI D,(MATADD)
TLNN C,F.PLUS+F.STAR
MOVSI D,(MATSUB)
TLNN C,F.PLUS+F.MINS
MOVSI D,(MATMPY)
PUSH P,D ;SAVE OPERATION
PUSHJ P,NXCHK ;SKIP OPERATOR
MOVSI D,(MOVEI T,) ;GEN T:= ADRS OF FIRST ARRAY
PUSHJ P,BUILDA ;ENTER HERE FROM SCALAR MULTIPLE
XMAT9A: HRLI F,777777
PUSHJ P,ARRAY ;SECOND ARRAY
JUMPN A,GRONK ;NOT ARRAY NAME
;ENTER HERE FROM MAT INV, TRN
XMAT9B: MOVSI D,(MOVEI T1,)
PUSHJ P,BUILDA
XMAT9C: POP P,D
POP P,B
XMAT9D: JRST BUILDA ;RETURN TO NXTSTA (OR TO PROCESS NEXT ITEM IN PRINT,READ, OR INPUT LIST.)
XMAT10: PUSH P,B ;FOR MAT COPY, FAKE MAT B=(1)*A
XMAT11: MOVE D,[MOVSI N,(1.0)];PUT CONSTANT 1.0 IN REG FOR SCALE
PUSHJ P,BUILDI ;BUILD INST TO GET SCAL FACTOR
POP P,B ;GET SOURCE MAT BACK
PUSH P,[MATSCA]
JRST XMAT9B
;NEXT STATEMENT
;<NEXT STA> ::= NEXT <SCALAR>
;EXPECT TO FIND 5-WORD ENTRY ON TOP OF FORROL
;DISCRIBING INDUCTION VARIABLE AND LOOP ADDRESS
;WORD IS PUSHED ON NXTROL OF FOLLOWING FORM:
; (<REL ADRS OF TOP OF LOOP>) <REL ADRS OF JRST TO IT>
;THIS WORD USED TO FIX UP REFERENCE AT END OF
;COMPILATION.
XNEXT: ASCIZ /T/
XNEX0: HRLI F,777777
PUSHJ P,REGLTR
CAIE A,1 ;BETTER BE SCALAR
JRST GRONK
MOVE X1,CEFOR ;UNSAT FOR?
CAMG X1,FLFOR
FAIL <? NEXT WITHOUT FOR>
CAME B,-3(X1) ;CHECK INDUCTION VARIABLE
FAIL <? NEXT WITHOUT FOR>
XNEX1: PUSHJ P,POPFOR
MOVEM B,TMPLOW ;RESTORE PREVIOUS LEVEL OF TEMPORARY PROTECTION
MOVEM B,TMPPNT ;BECAUSE THIS IS THE END OF THE "FOR" RANGE .
PUSHJ P,POPFOR ;GEN INCREMENT TO REG
PUSHJ P,EIRGEN
PUSHJ P,POPFOR ;FADR TO INDUCTION VAR
MOVSI D,(FADR)
PUSHJ P,BUILDA
PUSHJ P,POPFOR ;GET LOC OF RETURN
MOVEI X1,1(B) ;ADD TO ADDRS CHAIN OF NEXT WORD
ADD X1,FLCOD
MOVE X2,CECOD
ADDI X2,1
HRRM X2,(X1)
XNEX2: MOVSI A,(B) ;ADD WORD TO NXTROL FOR LINKAGE
MOVEI R,NXTROL
PUSHJ P,RPUSH
SUB B,FLNXT
HRLI B,NXTROL
MOVSI D,(JRST) ;BUILD JRST INSTR
PUSHJ P,BUILDA
PUSHJ P,POPFOR ;POP OFF THE SAVED VALUE OF L
TLNN C,F.COMA ;STACKED NEXT?
JRST NXTSTA ;NO.
PUSHJ P,NXCH ;YES.
JRST XNEX0
;SUBR TO POP TOP OF FORROL. USED ONLY BY XNEXT.
POPFOR: SOS X1,CEFOR ;POP TOP OF FORROL
MOVE B,(X1)
POPJ P,
;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/
MOVE N,[SETOM PAGLIM] ;NOPAGE(ALL).
MOVEM N,TABLE
XNOP8: PUSHJ P,QSA ;(NO)QUOTE(ALL) ENTERS HERE.
ASCIZ /ALL/
JRST .+2
JRST XNOP1
SETZM TTYPAG ;ONLY SET THE TTY ONCE PER STATEMENT.
TLNN C,F.TERM
JRST XNOP2
XNOP0: SKIPE TTYPAG
JRST NXTSTA
MOVE D,TABLE
PUSHJ P,BUILDI
JRST NXTSTA
XNOP2: TLNN C,F.COMA ;DELIMITER?
CAIN C,";"
JRST XNOP5
XNOP6: CAMN C,[XWD F.STR,"#"]
PUSHJ P,NXCH
XNOP4: PUSHJ P,GETCN2
MOVE D,TABLE
TLO D,000016 ;AND IN (LP).
PUSHJ P,BUILDI
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.
TLNE C,F.TERM ;FINISHED?
JRST XNOP0 ;YES, ALMOST.
TLNN C,F.COMA ;DELIMITER?
CAIN C,";"
JRST XNOP5
JRST XNOP6
XNOP5: SKIPN TTYPAG
PUSHJ P,XNOP7
JRST XNOP3
XNOP7: MOVE D,TABLE
PUSHJ P,BUILDI
SETOM TTYPAG
POPJ P,
XNOP1: TLNN C,F.TERM ;(ALL) STATEMENTS
JRST ERTERM
MOVE D,[MOVEI LP,9]
PUSHJ P,BUILDI
MOVE D,TABLE
TLO D,000016 ;AND IN (LP).
PUSHJ P,BUILDI
ADD B,FLCOD
HRLZI D,(SOJG LP,) ;"SOJG LP,.-1"
HRR D,B
PUSHJ P,BUILDI
JRST NXTSTA
;NOQUOTE AND NOQUOTE ALL STATEMENTS.
;
;THESE STATEMENTS USE THE NOPAGE ROUTINE, XNOP, WHICH SEE.
XNOQ: ASCIZ /UOTE/
MOVE N,[SETZM QUOTBL]
MOVEM N,TABLE
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,FORMLN ;EVALUATE INDEX
PUSHJ P,EIRGNP ;GET IN REG
MOVE D,[JSP A,XCTON]
PUSHJ P,BUILDI ;BUILD THE RUNTIME CALL
SETZI D, ;BUILD ADDRESS OF NEXT STATEMENT
MOVE B,L
AOBJP B,.+3 ;DONT BUILD IF LAST STATEMENT
HRLI B,LADROL
PUSHJ P,BUILDA
TLNE C,F.COMA ;SKIP OPTIONAL COMMA.
PUSHJ P,NXCH
PUSHJ P,THENGO ;TEST FOR "THEN" OR "GOTO"
XON1: PUSHJ P,XGOFR ;BUILD A JRST TO THE NEXT NAMED STATEMENT
TLNN C,F.COMA ;MORE?
JRST NXTSTA ;NO
PUSHJ P,NXCHK ;YES. SKIP COMMA
JRST XON1 ;PROCESS NEXT LINE NUMBER
;FILE AND FILES STATEMENTS.
;
;FILES STATEMENTS SET UP INFORMATION FOR THE LOADER, AS FOLLOWS:
;THE ACTBL ENTRY IS +1 FOR SEQ. ACCESS FILES, -1 FOR R.A. FILES.
;THE STRLEN ENTRY CONTAINS THE RECORD LENGTH FOR STRING R.A.
;FILES (OR 0 IF THE STRING R.A. FILE DID NOT SPECIFY A
;RECORD LENGTH) AND 400000,,0 FOR NUMERIC R.A. FILES. THE
;BLOCK ENTRY CONTAINS THE SOURCE STATEMENT LINE NUMBER IN CASE THE
;LOADER NEEDS IT FOR AN ERROR MESSAGE.
XFILE: ASCIZ /E/
PUSHJ P,QSA
ASCIZ /S/ ;FILE OR FILES?
JRST FILEE ;FILE.
XFIL1: MOVEI B,";" ;FILES.
CAIE B,(C)
TLNE C,F.COMA
JRST XFIL10
PUSHJ P,FILNMO ;GET FILENAME.
JUMP SAVE1
AOS A,FILCNT
CAILE A,9
FAIL <? TOO MANY FILES>
MOVEI D,9
MOVE X1,FILDIR
MOVE X2,FILDIR+1
CAMN X1,FILD-1(D) ;SEARCH FOR DUPLICATE NAME.
JRST .+3
SOJG D,.-2
JRST XFIL35
CAME X2,EXTD-1(D)
JRST .-3
PUSHJ P,INLMES
ASCIZ /
? FILE /
PUSHJ P,PRNNAM
PUSHJ P,INLMES
ASCIZ / ON MORE THAN ONE CHANNEL/
PUSH P,C
PUSHJ P,FAIL2
POP P,C
XFIL35: MOVEM X1,FILD-1(A)
MOVEM X2,EXTD-1(A)
MOVE X2,L ;SAVE SOURCE LINE
ADD X2,FLLIN ;NUMBER IN CASE THE
HLRZ X2,(X2) ;LOADER NEEDS IT.
MOVEM X2,BLOCK-1(A)
MOVEI B,"%" ;TYPE OF FILE--
CAIE B,(C)
JRST XFIL36
HRLZI B,400000 ;R.A. NUMERIC.
MOVEM B,STRLEN-1(A)
PUSHJ P,NXCH
JRST XFIL39
XFIL36: TLNN C,F.DOLL
JRST XFIL37
PUSHJ P,NXCH ;R.A. STRING.
SETZ B,
TLNN C,F.DIG ;GET THE RECORD LENGTH.
JRST XFIL32
PUSHJ P,XFIL30
JRST XFIL38
CAILE B,^D132
JRST XFILER
PUSHJ P,NXCH
JRST XFIL38
XFIL30: HRRZI B,-60(C)
PUSHJ P,NXCH
TLNN C,F.DIG
POPJ P,
IMULI B,^D10
ADDI B,-60(C)
PUSHJ P,NXCH
TLNN C,F.DIG
POPJ P,
IMULI B,^D10
ADDI B,-60(C)
JRST CPOPJ1
XFIL38: JUMPE B,XFILER
XFIL32: MOVEM B,STRLEN-1(A)
JUMPE B,XFIL39
MOVEI X1,4(B)
IDIVI X1,5
ADDI X1,1
HRLM X1,STRLEN-1(A)
XFIL39: SETOM ACTBL-1(A) ;MAKE ACTBL ENTRY = -1 FOR R.A.
JRST XFIL7
XFIL37: AOS ACTBL-1(A) ;MAKE ACTBL ENTRY = +1 FOR SEQ. ACCESS.
XFIL7: TLNE C,F.TERM
JRST NXTSTA
MOVEI B,";"
CAIE B,(C)
TLNE C,F.COMA
JRST XFIL8
JRST ERSCCM
XFIL10: AOS B,FILCNT
CAILE B,9
FAIL <? TOO MANY FILES>
XFIL8: PUSHJ P,NXCH
TLNN C,F.TERM
JRST XFIL1
XFIL9: AOS B,FILCNT
CAILE B,9
FAIL <? TOO MANY FILES>
JRST NXTSTA
FILEE: MOVE D,FLLIN
ADDI D,(L)
MOVS D,(D)
HRLI D,(MOVEI L,)
PUSHJ P,BUILDI
MOVE D,[MOVEM L,SORCLN]
PUSHJ P,BUILDI
SKIPE FUNAME
JRST FILEE0
MOVE D,[PUSHJ P,SETCOR]
PUSHJ P,BUILDI
SETZM VRFSET
FILEE0: CAIN C,":" ;TYPE OF ARG IS?
JRST FILEE1 ;R.A.
CAME C,[XWD F.STR,"#"]
JRST ERCHAN
SETZM FILTYP ;SEQ. ACCESS.
JRST FILEE2
FILEE1: SETOM FILTYP
FILEE2: PUSHJ P,GETCNA
CAIE C,":" ;SKIP DELIMITER.
TLNE C,F.COMA
JRST .+2
JRST ERCLCM
PUSHJ P,NXCH
MOVE D,[SETZM FILTYP]
SKIPE FILTYP
MOVE D,[SETOM FILTYP]
PUSHJ P,BUILDI
MOVE D,[SKIPE ACTBL-1(LP)]
PUSHJ P,BUILDI
MOVE D,[PUSHJ P,CLSFIL]
PUSHJ P,BUILDI
TLNN C,F.QUOT
JRST FILE21
PUSH P,C
PUSH P,T
PUSHJ P,QSKIP
JRST GRONK
TLNN C,F.COMA
TLNE C,F.TERM
JRST FILEE4
CAIN C,";"
JRST FILEE4
POP P,T
POP P,C
FILE21: PUSHJ P,FORMLS ;GET FILENM ARG.
PUSHJ P,EIRGNP
MOVE D,[AOS T,MASAPP]
PUSHJ P,BUILDI
MOVE D,[MOVEM N,(T)]
PUSHJ P,BUILDI
MOVE D,[PUSHJ P,OPNFIL]
PUSHJ P,BUILDI
CAIE C,";" ;SKIP DELIMITER.
TLNE C,F.COMA
JRST FILEE3
JRST NXTSTA
FILEE3: PUSHJ P,NXCH
JRST FILEE0 ;PROCESS NEXT ARG.
FILEE4: POP P,T ;CHECK SYNTAX OF ARG NOW, SINCE IT IS A CONSTANT.
POP P,C
PUSH P,T
PUSH P,C
PUSHJ P,NXCH
PUSHJ P,FILNMO ;FILENM.EXT FORM?
JUMP SAVE1
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 FILEE7
FILE45: MOVEI A,3
SETZ B,
PUSHJ P,NXCH
TLNN C,F.DIG
JRST XFILR1
FILEE5: TLNN C,F.DIG
JRST FILEE6
SOJL A,GRONK
IMULI B,^D10
ADDI B,-60(C)
PUSHJ P,NXCH
JRST FILEE5
FILEE6: CAIL A,3
JRST GRONK
JUMPE B,XFILER
CAILE B,^D132
XFILER: FAIL (? STRING RECORD LENGTH > 132 OR < 1);[223]FOR MACRO V52
XFILR1: TLNN C,F.QUOT
JRST ERDIGQ
FILEE7: POP P,C ;RESTORE BYTE POINTER AND
POP P,T ;CHARACTER IN C.
JRST FILE21 ;BACK TO MAIN CODE.
;RUNTIME ROUTINE TO CLOSE FILES FOR FILE STATEMENTS.
CLSFIL: SKIPG X2,ACTBL-1(LP) ;SEQ. OR R.A.?
JRST CLSRAN
CAIE X2,3 ;SEQ.
JRST CLSSE1
SETOM ODF
SKIPE HPOS(LP)
PUSHJ P,CRLF3 ;END CURRENT LINE.
CLSSE1: DPB LP,[POINT 4,DREL,12]
XCT DREL
MOVEI X1,3
CAME X1,ACTBL-1(LP)
POPJ P,
MOVEI X1,(LP) ;FILE IS IN WRITE MODE,
PUSHJ P,UXIT6 ;SO SET UP PROTECTION CODE.
XCT DREL
POPJ P,
CLSRAN: MOVE X2,BLOCK-1(LP) ;R.A.
SKIPE MODBLK-1(LP)
PUSHJ P,OUTRAN
MOVEI X2,1
PUSHJ P,INRAN ;[227]
; HRRM X2,USETID-1(LP) ;[220][227] SET UP USETI
; XCT USETID-1(LP) ;[220][227] POINT TO BLOCK 1
; DPB LP,[POINT 4,INNDSK,12];[220][227] GET BLOCK 1
; XCT INNDSK ;[220][227]..
; JRST CLSRN0 ;[220][227] PROCEED
; PUSHJ P,CHKSTS ;[220][227] FIND OUT WHY THE IN FAILED
; JRST .+2 ;[220][227] ERROR PROCEED
; POPJ P, ;[220][227] EOF. RETURN
; SETZM ACTBL-1(LP) ;[220][227] RESET ACTBL ENTRY
; MOVEI T,INLSYS ;[220][227] GIVE SYSTEM ERROR
; JRST ERRMSG ;[220][227] MESSAGE
;CLSRN0:
HRLZ X2,BA-1(LP) ;[220][227]
HRRZ X1,3(X2)
CAMN X1,LASREC-1(LP) ;NEED TO UPDATE LAST REC. NO.?
JRST CLSRN1
MOVE X1,LASREC-1(LP) ;YES.
HRRM X1,3(X2)
MOVEI X2,1
PUSHJ P,OUTRAN
CLSRN1: PUSH P,B ;LAST BLOCK NEEDS COUNT NE 200?
PUSH P,T
PUSH P,T1
MOVE T,LASREC-1(LP)
SKIPG STRLEN-1(LP)
JRST CLSRN2
HLRZ B,STRLEN-1(LP) ;STR FILE.
MOVEI X1,^D128
IDIVI X1,(B)
IDIVI T,(X1)
MOVEI T1,1(T1)
IMULI T1,(B)
JRST CLSR22
CLSRN2: MOVEI T,1(T) ;NUM. FILE.
IDIVI T,^D128
MOVEI T1,1(T1)
CLSR22: MOVEI X2,1(T)
PUSHJ P,INRAN
HLRZ X1,BA-1(LP)
HRRZ T,2(X1)
CAIN T,(T1)
JRST CLSRN3 ;NO, NEEDS 200, WHICH IT ALREADY HAS.
HRRM X2,USETOD-1(LP) ;YES, NEEDS NE 200 COUNT.
XCT USETOD-1(LP)
HRLI X2,3(X1)
MOVEI X1,206(X1)
HRRI X2,(X1)
BLT X2,177(X1)
HRRM T1,-1(X1) ;SET THE COUNT.
DPB LP,[POINT 4, OUTTDS,12]
XCT OUTTDS
JRST CLSRN3
DPB LP,[POINT 4, GTSTS,12]
XCT GTSTS
JRST [SETZM ACTBL-1(LP)
JRST OUTERR]
CLSRN3: POP P,T1
POP P,T
POP P,B
MOVEI X2,3
MOVEM X2,ACTBL-1(LP)
JRST CLSSE1
;RUNTIME ROUTINE TO OPEN FILES FOR THE FILE STATEMENT.
OPNFIL: PUSHJ P,STRPL1 ;GET STR + 1 SPACE.
JRST CHAER1
SOS MASAPP
PUSHJ P,FILNMO ;GET FILENM.EXT.
JUMP SAVE1
PUSH P,T
PUSH P,C
SETZM FILD-1(LP) ;CHECK FOR DUPLICATE NAME.
MOVEI D,9
MOVE X1,FILDIR
MOVE X2,FILDIR+1
CAMN X1,FILD-1(D)
JRST .+3
SOJG D,.-2
JRST OPNFL1
CAME X2,EXTD-1(D)
JRST .-3
JRST OPNER2
OPNFL1: MOVEM X1,FILD-1(LP)
MOVEM X2,EXTD-1(LP)
HLRZ T,BA-1(LP) ;GET BUFFERS.
JUMPN T,OPNFL2
PUSHJ P,VCHBUF
HRLM T,BA-1(LP)
ADDI T,406
HRRM T,BA-1(LP)
PUSHJ P,BASORT
HLRZ T,BA-1(LP)
OPNFL2: MOVEM T,.JBFF
POP P,C
POP P,T
MOVE N,VALPTR
CAME N,T ;SEQ. OR R.A.?
JRST OPNFL6 ;R.A. OR ERROR.
SKIPE FILTYP ;SEQ.
JRST FNMX1
MOVEI A,1
OPNFL3: MOVEM A,ACTBL-1(LP) ;SET UP FOR EXEC.
MOVE X1,SORCLN
MOVEM X1,BLOCK-1(LP)
MOVEI X1,(LP)
SETOM FILFLG
JRST EXEC0
OPNFL4: POP P,Q ;RETURN HERE FROM EXEC.
MOVEI X2,.+2
JRST RESACS ;RESTORE THE AC'S.
SKIPL ACTBL-1(LP) ;CLEAR AND SET UP FLAGS.
JRST OPNFL5
SETZM BLOCK-1(LP)
SETZM MODBLK-1(LP)
MOVEI X1,1
MOVEM X1,POINT-1(LP)
POPJ P,
OPNFL5: MOVEI X1,^D72
MOVEM X1,MARGIN(LP)
SETZM MARWAI(LP)
SETOM PAGLIM(LP)
SETZM QUOTBL(LP)
MOVEI X1,(LP)
JRST XRES01
OPNFL6: MOVEI X2,"%" ;R.A. OR ERROR.
CAIE X2,(C)
JRST OPNFL8
HRLZI X1,400000
MOVEM X1,STRLEN-1(LP)
PUSHJ P,NXCH
OPNF11: SKIPN FILTYP
JRST FNMX1
MOVE N,VALPTR
CAME N,T
JRST CHAER1
SETO A,
JRST OPNFL3
OPNFL8: TLNN C,F.DOLL
JRST CHAER1
PUSHJ P,NXCH
SETZ B,
TLNE C,F.DIG
JRST .+3
SETZM STRLEN-1(LP)
JRST OPNF11
PUSHJ P,XFIL30
JRST OPNFL9
CAILE B,^D132
JRST OPNER4
PUSHJ P,NXCH
OPNFL9: JUMPE B,OPNER4
OPNF10: MOVEM B,STRLEN-1(LP)
ADDI B,4
IDIVI B,5
ADDI B,1
HRLM B,STRLEN-1(LP)
JRST OPNF11
OPNER2: PUSHJ P,INLMES
ASCIZ /
? FILE /
SETZM SAVE1
PUSHJ P,PRNNAM
PUSHJ P,INLMES
ASCIZ / ON MORE THAN ONE CHANNEL/
JRST GOSR2
OPNER4: PUSHJ P,INLMES
ASCIZ /
? STRING RECORD LENGTH > 132 OR < 1/
JRST GOSR2
DEFINE R(A)
<IRP A
< EXP OPS'A
EXTERN OPS'A>>
FILMOD: R<1,2,3,4,5,6,7,8,9>
DEFINE R(A)
< IRP A
< EXP DO'A+1 >>
OUTPT: R<1,2,3,4,5,6,7,8,9>
DEFINE R(A)
< IRP A
< EXP DO'A+2
EXTERN DO'A >>
OUTCNT: R<1,2,3,4,5,6,7,8,9>
DEFINE R(A)
< IRP A
< EXP DI'A+1
EXTERN DI'A >>
INPT: R<1,2,3,4,5,6,7,8,9>
DEFINE R(A)
< IRP A
< EXP DI'A+2 >>
INCNT: R<1,2,3,4,5,6,7,8,9>
DEFINE R(A)
< IRP A
< POINT 7,LINB'A
EXTERN LINB'A >>
LINPT: R<0,1,2,3,4,5,6,7,8,9>
INSET: JUMPN LP,.+3 ;TTY?
SETZM IFIFG ;YES.
POPJ P,
SKIPG X1,ACTBL-1(LP) ;NO. GET CORRESPONDING ACCESS CODE.
JRST FNMXER
CAIE X1,1 ;IF NOT EQUAL TO 1, FILE NOT OK FOR READING
JRST ILRD ;ILLEGAL READ ERROR MESSAGE
SETOM IFIFG
POPJ P,
;END OF FILE TEST.
EOF: SKIPG X2,ACTBL-1(LP) ;ACTBL ENTRY = 1 MEANS A READABLE FILE.
JRST FNMXER
CAIE X2,1
JRST EOF6
SETOM IFIFG
EOF30: SKIPN T,PINPNM-1(LP) ;CHECK THE LINE BUFFER.
JRST EOF3
PUSHJ P,DELAWY
TLNN C,F.CR
JRST EOF0
SETZM PINPNM-1(LP)
EOF3: SETZ X1, ;NEED ANOTHER LINE. NXIN5 WILL CHECK
PUSHJ P,NXIN5 ;TO SEE IF IT SHOULD COME BACK HERE BY
EOF32: JRST EOF30 ;LOOKING FOR EOF32 ON PLIST.
EOF31: POP P,X1 ;BACK HERE FROM INLINE; CLEAR PUSH LIST.
POP P,X1
POP P,X1
SETZM IFIFG
POPJ P,
EOF0: SETZM IFIFG
SKIPN REAINP-1(LP) ;WARN READ# STATEMENTS TO SKIP
SETOM EOFFLG-1(LP) ;A LINE NUMBER; PROBLEM ONLY ARISES
JRST CPOPJ1 ;IF MODE WAS NOT SET WHEN IF END# WAS EXECUTED.
EOF6: PUSHJ P,TTYIN
PUSHJ P,INLMES
ASCIZ /
? IF END ASKED FOR UNREADABLE FILE/
JRST GOSR2
;RESTORE.
XRES: SKIPG X2,ACTBL-1(LP) ;GET ACCESS CODE.
JRST FNMXER
CAIE X2,3
JRST XRES0
SETOM ODF
SKIPE HPOS(LP)
PUSHJ P,CRLF3
XRES0: DPB LP,[POINT 4,DREL,12] ;DEPOSIT CHANNEL NUMBER FOR RELEASE
XCT DREL ;DO RELEASE
HLRZ X2,BA-1(LP) ;GET BUFFER ADDRESS
MOVEM X2,.JBFF
SETZM @FILMOD-1(LP) ;SET MODE TO ASCII.
XCT INITO-1(LP) ;INIT THAT CHANNEL
JRST [MOVE T,OPS1+1
JRST NOGETD]
DPB LP,[POINT 4, IBDSK, 12]
XCT IBDSK
MOVE X2,FILD-1(LP) ;GET FILE NAME
MOVEM X2,LOK ;SET FOR LOOKUP
MOVE X2,EXTD-1(LP)
MOVEM X2,LOK+1
SETZM LOK+2
SETZM LOK+3 ;ZERO PJ-PG
DPB LP,[POINT 4,LOKUP,12] ;SET CHANNEL FOR LOOKUP
XCT LOKUP ;DO LOOKUP
JRST LOKFAL
MOVE X2,ACTBL-1(LP)
CAIE X2,3
JRST XRES00
MOVEI X1,(LP)
PUSHJ P,UXIT7
MOVEI X2,1
MOVEM X2,ACTBL-1(LP)
JRST XRES0
XRES00: MOVEI X2,1
MOVEM X2,ACTBL-1(LP) ;SET ACCESS TABLE FOR READ
XRES01: SETZM PINPNM-1(LP)
SETZM REAINP-1(LP)
SETZM EOFFLG-1(LP)
SETZM ODF
POPJ P,
;SCRATCH STATEMENT
;FORMAT
; SCRATCH Q4,Q7,Q8
;WHERE Q IS # OR :. Q MAY BE OMITTED, IN WHICH CASE # IS ASSUMED.
XSCRAT: ASCIZ /ATCH/
SRAER5: CAIN C,":"
JRST SRAER3 ;R.A. ARGUMENT.
CAMN C,[XWD F.STR,"#"] ;SEQ. ACCESS ARGUMENT.
PUSHJ P,NXCH
PUSHJ P,GETCN2
MOVE D,[PUSHJ P,SCATH]
SRAER4: PUSHJ P,BUILDI ;BUILD SCRATCH
TLNN C,F.COMA ;SKIP DELIMITER.
CAIN C,";"
JRST .+2
JRST NXTSTA
PUSHJ P,NXCH
JRST SRAER5
SRAER3: PUSHJ P,GETCNA ;R.A. ARGUMENT.
MOVE D,[PUSHJ P,RANSCR]
JRST SRAER4
;SCRATCH
SCATH: SKIPG X2,ACTBL-1(LP) ;GET ACCESS CODE
JRST FNMXER
HLRZ X2,BA-1(LP) ;GET BUFFER ADDRESS
MOVEM X2,.JBFF
SETZM @FILMOD-1(LP) ;SET MODE TO ASCII.
XCT INITO-1(LP) ;DO INIT
JRST [MOVE T,OPS1+1
JRST NOGETD]
DPB LP,[POINT 4,OBDSK2,12] ;SET CHANNEL FOR OUTBUF
XCT OBDSK2 ;DO "OUTBUF"
MOVE X2,FILD-1(LP) ;GET FILE NAME
MOVEM X2,ENT ;SET FOR ENTER
MOVE X2,EXTD-1(LP)
HLLZM X2,ENT+1
SETZM ENT+2
LDB T1,[POINT 9,PROTEC-1(LP),8]
DPB T1,[POINT 9,ENT+2,8]
SETZM ENT+3
DPB LP,[POINT 4,ENTDSK,12] ;SET CHANNEL FOR ENTER
XCT ENTDSK ;DO ENTER
JRST ENFAIL ;ENTER FAILED
DPB LP,[POINT 4,OUTDSK,12] ;SET FOR DUMMY OUTPUT
XCT OUTDSK ;DO DUMMY OUTPUT
MOVEI X2,3 ;FILE OK FOR WRITING
MOVEM X2,ACTBL-1(LP) ;TELL ACCESS TABLE
MOVEI X2,^D990
MOVEM X2,LINNUM-1(LP)
SETZM WRIPRI-1(LP)
SETZM HPOS(LP)
SETOM FIRSFL(LP)
SETZM FMTPNT(LP)
SETZM PAGCNT(LP)
SETZM TABVAL(LP)
SETOM ZONFLG(LP)
POPJ P,
;R.A. RUNTIME SCRATCH.
RANSCR: SKIPL ACTBL-1(LP)
JRST FNMXER
SETZM LOK
DPB LP,[POINT 4,RENAMD,12] ;ERASE FILE.
XCT RENAMD
JRST RANSRF
MOVE X1,FILD-1(LP)
MOVEM X1,ENT
MOVEM X1,LOK
MOVE X1,EXTD-1(LP)
HLLZM X1,ENT+1
HLLZM X1,LOK+1
SETZM ENT+2
LDB X1,[POINT 9,PROTEC-1(LP),8] ;[203]PRESERVE PROTECTION
DPB X1,[POINT 9,ENT+2,8] ;[203]ACROSS ENTER
SETZM ENT+3
DPB LP,[POINT 4,ENTDSK,12]
XCT ENTDSK
JRST ENFAIL
HLRZ X1,BA-1(LP)
ADDI X1,203
MOVEM X1,.JBFF ;SET UP HEADER RECORD.
DPB LP,[POINT 4,OBDSK,12]
XCT OBDSK
DPB LP,[POINT 4,OUTTDS,12]
XCT OUTTDS
JRST .+2
JRST RANSC5
MOVE X2,.JBFF
SOJ X2,.+1
RANSC1: SETZM (X2)
SOJ X2,.+1
CAIL X2,3(X1)
JRST RANSC1
SKIPG X1,STRLEN-1(LP)
JRST .+3
MOVEM X1,2(X2)
JRST .+3
HRLZI X1,400000
MOVEM X1,1(X2)
RANSC3: MOVEI X1,200 ;[227]SET UP WORD COUNT
MOVEM X1,(X2) ;[227]FOR INITIAL WRITE
DPB LP,[POINT 4,OUTTDS,12]
XCT OUTTDS
JRST RANSC4
RANSC5: DPB LP,[POINT 4,GTSTS,12]
XCT GTSTS
JRST [SETZM ACTBL-1(LP)
JRST OUTERR]
RANSC4: DPB LP,[POINT 4,CLOSED,12]
XCT CLOSED
SETZM LOK+2
SETZM LOK+3
DPB LP,[POINT 4,LOKUP,12]
XCT LOKUP
JRST LKFAIL
HLLZS ENT+1
SETZM ENT+2 ;[173]
SETZM ENT+3
XCT ENTDSK
JRST ENFAIL
HLRZ X1,BA-1(LP)
MOVEM X1,.JBFF
DPB LP,[POINT 4,IBDSK,12]
XCT IBDSK
XCT OBDSK
DPB LP,[POINT 4,OUTTDS,12]
XCT OUTTDS
JRST .+2
JRST RANSC5
DPB LP,[POINT 4,INNDSK,12]
XCT INNDSK
JRST .+2 ;[227]
JRST EXEC86 ;[227]
; JRST RANSC6 ;[220][227] PROCEED
; PUSHJ P,CHKSTS ;[220][227] CHECK WHY FAILED
; JRST EXEC86 ;[220][227] ERROR
;RANSC6: SETZM BLOCK-1(LP) ;[220][227]
SETZM BLOCK-1(LP)
SETZM MODBLK-1(LP)
SETZM LASREC-1(LP)
MOVEI X1,1
MOVEM X1,POINT-1(LP)
POPJ P,
; [220] /CHKSTS/ -ROUTINE TO CHECK STATUS OF CHANNEL IN (LP)
;
; SKIP RETURNS IF EOF REACHED. AND NON-SKIP RETURN IF ERROR
;
; USES ACCUMULATOR X1
;CHKSTS: DPB LP,[POINT 4,GTSTS,12];[220][227]SET CHANEL FOR GETSTS
; MOVEI X1,X1 ;[220][227] ADDRESS TO
; HRRM X1,GTSTS ;[220][227] PUT STATUS BITS IN
; XCT GTSTS ;[220][227] GET FILE STATUS
; TRNN X1,74B23 ;[220][227] EOF OR ERROR ?
; AOS (P) ;[220][227] EOF, GIVE SKIP
; POPJ P, ;[220][227] RETURN
;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,GETCN2
MOVE D,[SKIPL ACTBL-1(LP)]
PUSHJ P,BUILDI
MOVE D,[JRST FNMXER]
PUSHJ P,BUILDI
CAIE C,":" ;SKIP DELIMITER.
TLNE C,F.COMA
JRST .+2
JRST ERCLCM
PUSHJ P,NXCH
PUSHJ P,FORMLN ;GET VALUE FOR POINTER.
PUSHJ P,EIRGNP
MOVNI A,5
XSET2: MOVE D,SETCOD+5(A)
PUSHJ P,BUILDI
AOJL A,XSET2
TLNN C,F.COMA ;ANOTHER ARG.?
CAIN C,";"
JRST .+2 ;BETTER BE.
JRST NXTSTA
PUSHJ P,NXCH
JRST XSET
SETCOD: JUMPLE N,SETERR ;SOME OF THE CODE GENERATED.
PUSHJ P,IFIX
CAIGE N,1
JRST SETERR
MOVEM N,POINT-1(LP)
SETERR: PUSHJ P,INLMES
ASCIZ /
? SET ARGUMENT/
JRST OUTBND
;THIS ROUTINE SORTS THE BOUNDARIES OF THE DISK BUFFERS INTO THE
;TABLE SRTDBA, FROM THE TABLE BA. SRTDBA IS IN ASCENDING ORDER,
;EXCEPT THAT ANY ZEROES ARE AT THE TOP, SO THAT IF NO BUFFERS
;ARE PRESENT SRTDBA CAN BE USED AS A FLAG WORD.
;BASORT DESTROYS AC'S C,E,X1, AND X2.
BASORT: MOVE X1,[XWD BA,SRTDBA]
BLT X1,SRTDBA+8
MOVEI E,8
BASOR1: MOVE X1,SRTDBA(E)
MOVEI C,(E)
BASOR2: MOVE X2,SRTDBA-1(C)
CAMG X2,X1
JRST BASOR3
MOVEM X2,SRTDBA(E)
MOVEM X1,SRTDBA-1(C)
MOVE X1,X2
BASOR3: SOJG C,BASOR2
SOJG E,BASOR1
BASOR4: SKIPE SRTDBA(C)
JRST BASOR5
AOJ C,.+1
CAIG C,8
JRST BASOR4
POPJ P,
BASOR5: JUMPE C,CPOPJ
MOVEI E,10
JRST PAKBL0
;WRITE AND PRINT STATEMENTS
;CAUSES DATA TO BE OUTPUT TO THE DISK OR TTY.
XWRIT: ASCIZ /TE/
SETOM WRREFL
JRST .+3
XPRINT: ASCIZ /NT/
SETZM WRREFL
CAIN C,":"
JRST XPRRAN ;R.A. STATEMENT.
PUSHJ P,QSA
ASCIZ /USING/
JRST XWRI1
CAME C,[XWD F.STR,"#"] ;USING STATEMENT. IMAGE NEXT?
JRST XWRI2 ;YES.
PUSHJ P,XWRCHA ;NO, CHANNEL NEXT.
TLNN C,F.COMA
CAIN C,":"
JRST .+2
JRST ERCLCM
PUSHJ P,NXCH
PUSHJ P,XWRIMG ;IMAGE MUST BE NEXT.
JRST XWRI5 ;GO TO GEN THE ARGS AND FINISH.
XWRI2: PUSHJ P,XWRIMG ;GET IMAGE.
JRST XWRI6 ;MUST BE TTY STATEMENT, GET ARGS & FINISH.
XWRI1: CAME C,[XWD F.STR,"#"]
JRST XPRI1 ;NOT USING, NOT #, MUST BE SIMPLE PRINT.
PUSHJ P,XWCHA ;CHANNEL.
TLNE C,F.TERM
JRST XPRI0 ;NOT USING STATEMENT - GO TO PRINT# OR WRITE#.
TLNN C,F.COMA
CAIN C,":"
PUSHJ P,NXCH
TLNE C,F.TERM
JRST XPRI0 ; ''
PUSHJ P,QSA
ASCIZ /USING/
JRST XPRI0 ; ''
MOVE D,[PUSHJ P,IMGLIN]
PUSHJ P,BUILDI
PUSHJ P,XWRIMG ;GET IMAGE.
JRST XWRI5 ;GO TO GEN ARGS AND FINISH.
XWRIMG: TLNE C,F.DIG ;HANDLE IMAGE.
JRST XWRIM2 ;LINE NUMBER FORM.
XWRIM1: PUSHJ P,FORMLS
PUSHJ P,EIRGNP
TLNN C,F.COMA
JRST ERCOMA
PUSHJ P,NXCH
JRST XWRIM4
XWRIM2: PUSH P,C ;LINE NUMBER FORM.
PUSH P,T
PUSHJ P,GETNUM ;GET THE NUMBER.
JRST .+1
TLNN C,F.COMA
JRST ERCOMA
XWRIM3: POP P,D
POP P,D
HRLZ A,N
MOVEI R,LINROL ;SEARCH FOR THE LINE IT SPECIFIES.
PUSHJ P,SEARCH
FAIL <? UNDEFINED LINE NUMBER >,1
PUSH P,T
MOVE B,(B)
HRRZI T,(B)
HRLI T,440700
XWRIM7: ILDB C,T ;LOOK FOR A LEADING ":", WHICH
CAIN C,":" ;SAYS--THIS IS REALLY AN IMAGE LINE.
JRST XWRIM8
CAIE C," "
CAIN C,11
JRST XWRIM7
FAIL <? SPECIFIED LINE IS NOT AN IMAGE>
XWRIM8: SETZ A,
PUSHJ P,NXCHD
PUSH P,C
PUSH P,T
TLNE C,F.CR
FAIL <? NO CHARACTERS IN IMAGE>
AOJ A,.+1 ;PUT THE IMAGE IN THE TABLE
PUSHJ P,NXCHD ;OF STRING CONSTANTS.
TLNN C,F.CR
AOJA A,.-2
MOVEI E,4(A)
MOVN A,A
HRLI A,(A)
MOVE T,CESLT
SUB T,FLSLT
HRRI A,(T)
MOVEI R,LITROL
PUSH P,E
PUSHJ P,RPUSH
POP P,E
IDIVI E,5
MOVEI R,SLTROL
PUSHJ P,BUMPRL
POP P,T
POP P,C
HRLI B,440700
XWRIM9: CAIN C,15
JRST XWRM10
IDPB C,B
ILDB C,T
JRST XWRIM9
XWRM10: MOVEI R,SADROL
MOVEI A,
PUSHJ P,RPUSH
SUB B,FLSAD
HRLI B,SADROL
MOVSI D,(MOVE N,)
PUSHJ P,BUILDA
POP P,T
PUSHJ P,NXCH
XWRIM4: MOVE D,[PUSHJ P,CHKIMG]
JRST BUILDI
XWRCHA: TDZA D,D ;DISK STATEMENT.
XWCHA: SETO D,
PUSH P,D
PUSHJ P,GETCNA
MOVE D,[PUSHJ P,OUTSET]
PUSHJ P,BUILDI
MOVE D,[SKIPN WRIPRI-1(LP)]
PUSHJ P,BUILDI
MOVE D,[SETOM WRIPRI-1(LP)]
SKIPN WRREFL
MOVE D,[AOS WRIPRI-1(LP)]
PUSHJ P,BUILDI
MOVE D,[SKIPL WRIPRI-1(LP)]
SKIPN WRREFL
MOVE D,[SKIPG WRIPRI-1(LP)]
PUSHJ P,BUILDI
MOVE D,[JRST WRPRER]
PUSHJ P,BUILDI
SKIPN WRREFL
JRST XWCHA1
MOVE D,[MOVE N,MARGIN(LP)]
PUSHJ P,BUILDI
MOVE D,[CAMGE N,SEVEN]
PUSHJ P,BUILDI
MOVE D,[JRST MARERR]
PUSHJ P,BUILDI
XWCHA1: POP P,D
JUMPE D,.+2
POPJ P,
MOVE D,[PUSHJ P,IMGLIN]
JRST BUILDI
XWRI6: MOVSI D,(SETZ LP,)
PUSHJ P,BUILDI
MOVE D,[PUSHJ P,OUTSET]
PUSHJ P,BUILDI
MOVE D,[PUSHJ P,IMGLIN]
PUSHJ P,BUILDI
XWRI5: PUSHJ P,FORMLB ;GEN THE ARGS.
PUSHJ P,EIRGNP
MOVE D,[PUSHJ P,SCNIMN]
JUMPL F,.+2
MOVE D,[PUSHJ P,SCNIMS]
PUSHJ P,BUILDI
TLNN C,F.COMA
CAIN C,";"
JRST .+2
JRST XWRI7
PUSHJ P,NXCH
JRST XWRI5
XWRI7: MOVE D,[PUSHJ P,ENDIMG]
PUSHJ P,BUILDI
JRST NXTSTA
XPRRAN: PUSHJ P,GETCNA ;R.A. STATEMENT.
MOVE D,[SKIPL ACTBL-1(LP)]
PUSHJ P,BUILDI
MOVE D,[JRST FNMXER]
PUSHJ P,BUILDI
TLNN C,F.COMA
CAIN C,":"
JRST .+2
JRST ERCLCM
PUSHJ P,NXCH
PUSHJ P,FORMLB
MOVEM F,IFFLAG
JRST XPRRN2
XPRRN1: PUSHJ P,NXCH
PUSHJ P,FORMLB
XOR F,IFFLAG
JUMPGE F,XPRRN2
FAIL <? MIXED STRINGS AND NUMBERS>
XPRRN2: PUSHJ P,EIRGNP
MOVE D,[PUSHJ P,RNNUMO]
SKIPL IFFLAG
HRRI D,RNSTRO
PUSHJ P,BUILDI
TLNN C,F.COMA
CAIN C,":"
JRST XPRRN1
JRST NXTSTA
SEVEN: OCT 7
XPRI1: SKIPE WRREFL
JRST GRONK
MOVSI D,(SETZ LP,) ;TTY.
PUSHJ P,BUILDI
MOVE D,[PUSHJ P,OUTSET]
PUSHJ P,BUILDI
XPRI0: TLNE C,F.TERM ;NON-USING STATEMENTS FROM HERE ON.
JRST XPCRLF
XPRI2: PUSHJ P,QSA
ASCIZ /TAB/ ;TAB FIELD?
JRST .+2 ;NO, ASSUME EXPRESSION OR DELIMITER.
JRST XPRTAB ;YES, DO THE TAB
TLNN C,F.COMA
CAIN C,";"
JRST PRNDEL
CAIE C,"<"
JRST PRNEXP
;PRINT DELIMITER.
PRNDEL: MOVSI D,(PRDL)
PUSHJ P,CHKFMT
PUSHJ P,BUILDI
JRST XPRFIN
;PRINT EXPRESSION
PRNEXP: PUSHJ P,FORMLB ;GEN THE EXPRESSION
JUMPL F,.+3 ;STR?
MOVSI D,(PRSTR) ;YES.
JRST .+3
PUSHJ P,GPOSNX ;MOVE TO REG IF UNCOMPLEMENTED OR INDEXED.
MOVSI D,(PRNM) ;SET UP OP CODE
PUSHJ P,CHKFMT ;SET FORMAT CODE
PUSHJ P,BUILDA ;GEN PRINT UUO
JRST XPRFIN ;GO FOR MORE
;PRINT TAB
XPRTAB: PUSHJ P,FORMLN ;EVALUATE TAB SUBEXPRESSION
PUSHJ P,EIRGNP ;MOVE IT INTO REG
MOVSI D,(PRNTB) ;CALL THE TAB INTERPRETER
XPRTA1: PUSHJ P,CHKFMT
PUSHJ P,BUILDI ;YES, BUILD THE INST.
XPRFIN: TLNE C,F.TERM ;CR AT END OF LINE?
JRST NXTSTA
JRST XPRI2 ;NO. GO FOR MORE
;HERE FOR PRINT WITH NO ARGUMENTS. GEN CARRIAGE RETURN.
XPCRLF: MOVE D,[SETZM 40]
PUSHJ P,BUILDI
MOVE D,[PUSHJ P,PRDLER]
PUSHJ P,BUILDI
MOVE D,[PUSHJ P,CRLF]
PUSHJ P,BUILDI
JRST NXTSTA
;CHECK FORMAT CHAR (PRINT AND MAT PRINT)
CHKFMT: TLNE C,F.TERM
TLO D,40 ;CR ... AC = 1
CAIN C,";" ;SC ... AC = 2
TLO D,100 ;CMA ... AC = 3
TLNE C,F.COMA ;<PA> ... AC = 4
TLO D,140
CAIE C,"<"
JRST CHKFM2
HRRZ C,(P)
CAIN C,XMAT2B ;MAT STATEMENT CANNOT USE
JRST GRONK ;<PA>.
PUSHJ P,NXCH
PUSHJ P,QSA
ASCIZ /PA>/
JRST GRONK
TLO D,200
POPJ P,
CHKFM2: TLNN D,140 ;WAS THERE A FMT CHAR?
TLO D,100 ;NO. ASSUME ";"
CAIE C,";"
TLNE C,F.COMA ;SKIP FMT CHAR IF THERE WAS ONE.
JRST NXCHK ;YES. SKIP
POPJ P,
OUTSET: JUMPN LP,.+3 ;TTY?
SETZM ODF ;YES.
POPJ P,
SKIPG X2,ACTBL-1(LP) ;GET ACCESS CODE
JRST FNMXER
CAIE X2,3 ;OPEN FOR WRITING?
JRST ILWRT ;NO
SETOM ODF
POPJ P,
;PAGE AND PAGE ALL STATEMENTS.
;
;CODE FOR THESE STATEMENTS IS COMPILED BY THE MARGIN AND
;MARGIN ALL ROUTINE, XMAG, WHICH SEE.
XPAG: ASCIZ /E/
SETOM TABLE
JRST XMAR0
;QUOTE AND QUOTE ALL STATEMENTS.
;
;CODE FOR THESE STATEMENTS IS COMPILED BY THE NOPAGE AND NOPAGE ALL
;ROUTINE, XNOP, WHICH SEE.
XQUO: ASCIZ /TE/
MOVE N,[SETOM QUOTBL]
MOVEM N,TABLE
JRST XNOP8
;RANDOM IZE STATEMENT
XRAN: ASCIZ /DOM/
PUSHJ P,QSA
ASCIZ /IZE/
JRST .+1
TLNN C,F.TERM
JRST GRONK
MOVE D,[PUSHJ P,RANDER]
PUSHJ P,BUILDI ;BUILD CALL TO RUNTIME RANDOMIZER
JRST NXTSTA
;READ STATEMENT
XREAD: ASCIZ /D/
CAIN C,":"
JRST XINRAN
CAMN C,[1000000043]
JRST XINPT0
SKIPL DATAFF ;DATA SEEN YET?
HLLOS DATAFF ;NO. SET NO DATA FLAG.
MOVSI D,(SETZ LP,)
PUSHJ P,BUILDI
MOVE D,[PUSHJ P,INSET]
PUSHJ P,BUILDI
MOVE D,[PUSHJ P,DOREAD]
JRST XINP0 ;GO FINISH WITH INPUT CODE
;RESTORE STATEMENTS.
XREST: ASCIZ /TORE/
TLNN C,F.DOLL+F.STAR+F.TERM
CAMN C,[XWD F.STR,"%"]
JRST XREST1
XRES3: CAIN C,":"
JRST XRES5 ;R.A. ARG.
CAMN C,[1000000043]
PUSHJ P,NXCH
PUSHJ P,GETCN2 ;RESTORE# STATEMENT.
MOVE D,[PUSHJ P,XRES]
PUSHJ P,BUILDI
XRES6: TLNN C,F.COMA
CAIN C,";"
JRST .+2
JRST NXTSTA
PUSHJ P,NXCH
JRST XRES3
XRES5: PUSHJ P,GETCNA ;R.A. ARG.
MOVNI A,4
XRES7: MOVE D,RESCOD+4(A)
PUSHJ P,BUILDI
AOJL A,XRES7
JRST XRES6
RESCOD: SKIPL ACTBL-1(LP) ;SOME OF THE CODE GENERATED.
JRST FNMXER
MOVEI N,1
MOVEM N,POINT-1(LP)
XREST1: MOVE D,[PUSHJ P,RESTON] ;DATA RESTORE STATEMENT.
CAMN C,[XWD F.STR,"%"]
JRST XRES2
TLNN C,F.STAR+F.DOLL
SOJA D,XRES1
TLNE C,F.DOLL ;RESTORE ONLY STRINGS?
ADDI D,1
XRES2: PUSHJ P,NXCHK ;SKIP $ OR * OR %
XRES1: PUSHJ P,BUILDI
JRST NXTSTA
;RETURN STATEMENT XLATE
XRETRN: ASCIZ /URN/
SKIPE FUNAME
FAIL <? RETURN WITHIN DEF>
MOVE D,[JRST RETURN]
XRET1: PUSHJ P,BUILDI ;XDEF ENTERS HERE TO COMPLETE A FN DEF.
JRST NXTSTA
;STOP STATEMENT
XSTOP: ASCIZ /P/
MOVE D,[JRST UXIT]
PUSHJ P,BUILDI
JRST NXTSTA
;GEN CODE TO EVALUATE FORMULA
;POINTER TO (POSSIBLY NEGATIVE) RESULT RETURNED IN B
;THIS LOOP HANDLES SUMS OF TERMS, CALLS TERM TO HANDLE PRODUCTS
;AND SO ON
;THE ENTRY POINT FORMLN REGARDS ONLY NUMERIC FORMULAS AS LEGAL.
;THE ENTRY POINT FORMLS REGARDS ONLY STRING FORMULAS AS LEGAL.
;THE ENTRY POINT FORMLB WILL ACCEPT EITHER A STRING OR A NUMERIC FORMULA.
;THE ENTRY POINT FORMLU EXPECTS THE LEGALITY TO BE DEFINED EXTERNALLY.
FORMLS: HRLZI F,1
JRST FORMLU
FORMLB: TDZA F,F
FORMLN: SETOI F,
FORMLU: 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
JUMPL F,FORM3
TLNE F,777777
JRST ILFORM
HRLI F,777777
JRST FORM3
FORM2: JUMPL F,FORM3
FORM21: PUSHJ P,EIRGNP
SKIPL VRFSET
JRST FORM4
SKIPE FUNAME
JRST FORM4
MOVE D,[PUSHJ P,SETCOR]
PUSHJ P,BUILDI
SETZM VRFSET
FORM4: MOVE D,[AOS T,MASAPP]
PUSHJ P,BUILDI
MOVE D,[MOVEM N,(T)]
PUSHJ P,BUILDI
PUSHJ P,TERM
PUSHJ P,EIRGNP
MOVE D,[PUSHJ P,APPEND]
PUSHJ P,BUILDI
SETZ B,
TLNN C,F.PLUS
POPJ P,
JRST FORM21
FORM3: PUSHJ P,PUSHPR ;PART RESLT TO SEXROL
PUSHJ P,TERM ;GEN SECOND TERM
TLNE B,ROLMSK ;IS SECOND TERM IN REG?
PUSHJ P,EXCHG ;NO. LETS DO FIRST TERM FIRST
PUSHJ P,EIRGEN ;FIRST SUMMAND TO REG
PUSH P,B ;SAVE SIGN INFORMATION
PUSHJ P,POPPR ;GET SECOND SUMMAND
SKIPGE (P) ;IS CONTENT OR REG NEGATIVE?
TLC B,MINFLG ;YES, NEGATE SECOND SUMMAND
MOVSI D,(FADR N,) ;FETCH INSTRUCTION
PUSHJ P,BUILDS ;BUILD ADD OR SUB INSTR
POP P,B ;REG PNTR WITH SIGN
AND B,[XWD MINFLG,0]
JRST FORM1 ;GO LOOK FOR MORE SUMMANDS
;LOOP TO GEN CODE FOR MULTIPLY AND DIVIDE
;CALLS FACTOR TO HANDLE EXPRESSIONS INVOLVING ONLY INFIX OPS AND "^"
TERM: PUSHJ P,FACTOR ;GEN FIRST FACTOR
;ENTER HERE FOR MORE FACTORS
TERM1: TLNN C,F.STAR+F.SLSH ;MUL OR DIV FOLLOWS?
POPJ P, ;NO, DONE WITH TERM.
JUMPL F,.+4
TLNE F,777777
JRST ILFORM
HRLI F,777777
MOVMS LETSW ;THIS CANT BE LH(LET)
HRRZS 0(P) ;SET MUL FLAG.
TLNN C,F.STAR ;IS IT MULTIPLY?
HRROS 0(P) ;NO. SET DIV FLAG
TERM2: PUSHJ P,NXCHK ;SKIP OVER CONNECTIVE
PUSHJ P,PUSHPR ;STASH PARTIAL RESULT ON SEXROL
PUSHJ P,FACTOR ;GEN NEXT FACTOR
SKIPGE (P) ;IS SECOND FACTOR A DIVISOR?
PUSHJ P,SITGEN ;YES. IT CANNOT STAY IN REG.
TLNE B,ROLMSK ;IS SECOND FACTOR IN REG?
PUSHJ P,EXCHG ;NO. LETS GET FIRST FACTOR.
MOVE X1,CESEX ;PEEK AT DIVISOR OR SECOND FACTOR.
MOVE X2,-1(X1)
TLZE X2,MINFLG ;IS IT MINUS?
TLC B,MINFLG ;YES. CHANGE SIGNS OF BOTH.
MOVEM X2,-1(X1) ;NOW DIVISION OR SECOND FACTOR IS PLUS.
PUSHJ P,EIRGEN ;GEN FIRST FACTOR OR DIVIDEND
PUSH P,B ;SAVE SIGN INFORMATION
PUSHJ P,POPPR ;GET SECOND OPERAND
MOVSI D,(FMPR N,) ;GET CORRECT INSTRUCTION
SKIPGE -1(P)
MOVSI D,(FDVR N,)
PUSHJ P,BUILDA ;BUILD MUL OR DIV INSTR
POP P,B ;REG PNTR WITH SIGN
JRST TERM1 ;GO LOOK FOR MORE FACTORS
;GEN CODE FOR ATOMIC FORMULAS, EXPONENTIATION, AND INFIX SIGNS
;SIGN IS STASHED IN LH OF PUSH-DOWN LIST WORD WITH RETURN ADDRS
;EXPLICIT SIGN IS NOT USED UNTIL AFTER EXPONENTIATION
;IS CHECKED FOR.
FACTOR: PUSH P,C ;STASH SIGN IN PUSH LIST.
TLNN C,F.MINS ;EXPLICIT MINUS SIGN?
JRST FACT2 ;NO.
JUMPL F,.+4
TLNE F,777777
JRST ILFORM
HRLI F,777777
TLC C,F.PLUS+F.MINS ;YES. PRETEND IT WAS PLUS CALLING ATOM.
MOVMS LETSW ;AND THIS CANNOT BE LH OF LET.
FACT2: PUSHJ P,ATOM ;GEN FIRST ATOM
FACT2A: CAIN C,"^" ;EXPONENT FOLLOWS?
JRST FACT3A ;YES.
TLNN C,F.STAR ;MAYBE.
JRST SNOEXI ;NO. GO NOTE SIGN AND RETURN.
MOVEM T,X1
PUSHJ P,NXCHK
TLNE C,F.STAR
JRST FACT3A ;YES.
MOVE T,X1 ;NO. GO NOTE SIGN AND RETURN.
MOVE C,[XWD F.STAR, "*"]
JRST SNOEXI
FACT3A: JUMPL F,.+4
TLNE F,777777
JRST ILFORM
HRLI F,777777
MOVMS LETSW ;THIS CANT BE LH(LET)
PUSHJ P,NXCHK ;YES. SKIP EXPONENTIATION SIGN
PUSHJ P,PUSHPR ;STASH BASE ON SEXROL
PUSHJ P,ATOM ;GEN THE EXPONENT
PUSHJ P,EXCHG ;EXCHANGE BASE AND EXPONENT
PUSHJ P,EIRGNP ;GET POSITIVE BASE IN REG
PUSHJ P,POPPR ;GET EXPONENT IN AC1
MOVSI D,(MOVE 1,)
PUSHJ P,BUILDS
MOVE D,[PUSHJ 17,EXP3.0]
PUSHJ P,BUILDI ;BUILD CALL TO EXPONENTIATION ROUTINE
MOVEI B,0 ;ANSWER LANDS IN REG
JRST FACT2A
;SIGN NOTE AND EXIT
;COMPLEMENT SIGN IF "-" AND APPROPRIATE FLAGS ON PD LIST.
;THEN RETURN FROM SUBROUTINE.
SNOEXI: POP P,X1
TLNE X1,F.MINS ;IS SAVED SIGN MINUS?
TLC B,MINFLG ;YES. COMPLEMENT
POPJ P,
;GEN CODE FOR SIGNED ATOM.
ATOM: PUSH P,C ;SAVE SIGN INFO.
TLNE C,F.PLUS ;EXPLICIT SIGN?
JRST ATOM1
TLNN C,F.MINS
JRST ATOM2
JUMPL F,.+4
TLNE F,777777
JRST ILFORM
HRLI F,777777
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
PUSHJ P,FORMLU ;GEN THE SUBEXPRESSION
TLNN C,F.RPRN ;BETTER HAVE MATCHING PAREN
JRST ILFORM ;NO. GRONK.
PUSHJ P,NXCHK ;SKIP PARENTHESIS
JRST SNOEXI ;GO TEST SIGN AND RETURN.
;HERE WHEN ATOMIC FORMULA IS A NUMBER
FNUMBR: JUMPL F,.+4
TLNE F,777777
JRST ILFORM
HRLI F,777777
MOVMS LETSW
PUSH P,F
PUSHJ P,EVANUM ;EVALUATE NUMBER (IN N)
FAIL <? ILLEGAL CONSTANT>
POP P,F
MOVE X1,0(P) ;GET SIGN FLAG
CAIE C,"^" ;EXPONENT FOLLOWS?
TLNN X1,F.MINS ;OR IS IT PLUS ANYWAY?
JRST FNUM1 ;YES. DONT FUDGE SIGN
TLNN C,F.STAR ;CHECK FOR OTHER KIND OF EXPONENT.
JRST FNUM5 ;NO, NOT THIS KIND OF EXP EITHER.
MOVEM T,B
PUSHJ P,NXCH
MOVE T,B
TLNE C,F.STAR
JRST FNUM1 ;YES, EXPONENT.
MOVE C,[XWD F.STAR,"*"]
FNUM5: MOVN N,N ;NEGATE NUMBER
SETZM 0(P) ;AND CLEAR SIGN INFO.
FNUM1: MOVE B,FLCON ;SEARCH CONSTANT ROLL
FNUM2: CAML B,CECON ;(UNSORTED--CANT USE SEARCH)
JRST FNUM3 ;NOT FOUND
CAME N,(B) ;THIS ONE?
AOJA B,FNUM2 ;NO. GO TO NEXT.
SUB B,FLCON ;FOUND. CALC REL ADDRESS IN CONROL.
JRST FNUM4
FNUM3: MOVEI R,CONROL ;PUSH ON CONROL
MOVE A,N
PUSHJ P,RPUSH
MOVEI R,CADROL ;PUT ADDRS ON CONST ADDRS ROLL
MOVEI A,0
PUSHJ P,RPUSH
SUB B,FLCAD ;GET REL ADDRS
FNUM4: HRLI B,CADROL ;MAKE POINTER
JRST SNOEXI ;GO LOOK AT SIGN AND RETURN.
NNUM: PUSH P,[EXP 1] ;REGISTER THE CONSTANT IN "N"
JRST FNUM1
;XLATE AND GEN ATOMIC FORMULA BEGINNING WITH LETTER
FLETTR: PUSHJ P,REGLTR
FLET1: JRST .+1(A)
JRST XARFET ;ARRAY REF
JRST SNOEXI ;SCALAR. JUST RETURN
JRST XINFCN ;INTRINSIC FCN
JRST XDFFCN ;DEFINED FCN
JRST ILVAR
JRST XARFET ;STRING VECTOR. PROCESS WITH ARRAY CODE!
JRST SNOEXI ;POINTER IS IN B FOR BUILDING.
FLET2: PUSH P,[EXP 1] ;PUSH AN IMPLICIT PLUS SIGN ON PLIST
JRST FLET1 ;FINISH REGISTERING VARIABLE.
XARFET: PUSH P,A
PUSH P,B
PUSHJ P,REGFRE ;FREE REG
PUSHJ P,XARG
JUMPG F,XARF1 ;STRING VECTOR?
SKIPL LETSW ;NO, IS IT LH OF ARRAY-LET?
JRST XARF1 ;DO A FETCH AS USUAL.
TLNN C,F.EQAL ;IS IT DEFINITELY LH OF ARRAY-LET?
JRST XARF1 ;NO.
POP P,X1 ;YES. DON'T FETCH! RETURN TO LH(LET)
POP P,A
SUB P,[XWD 6,6] ;ADJUST THE PUSHLIST TO ESC FORMLS
MOVE A,1(P)
PUSH P,B ;SAVE THE ARGUMENT FLAG
PUSH P,X1 ;SAVE THE ARRAY POINTER
JRST (A)
XARF1: MOVSI D,(ARFET1)
JUMPL F,.+2 ;STR VECTOR?
MOVSI D,(SVRADR) ;YES. FETCH STRING POINTER ADDRESS.
JUMPE B,XARFFN
JUMPL F,.+2
FAIL <? STRING VECTOR HAS 2 DIMS>
MOVSI D,(ARFET2)
MOVE X1,-1(P) ;MARK DOUBLE ARRAY
ADD X1,FLOOR(F)
SKIPN 1(X1)
SETOM 1(X1)
XARFFN: EXCH B,0(P)
PUSHJ P,BUILDA
POP P,B
PUSHJ P,GENARG
MOVEI B,0 ;REG POINTER
JUMPL F,.+2 ;STRING VECTOR?
PUSHJ P,SITGEN ;YES,SAVE ADDRESS POINTER
POP P,A
JRST SNOEXI
;GEN FUNCTION CALLS
XDFFCN: PUSH P,D ;SAVE FCN NAME
PUSHJ P,REGFRE ;SAVE ANY SUBEXPRESSION
PUSHJ P,PUSHPR ;SAVE FUNCTION LOCATION
MOVE D,[PUSHJ P,SAVACS]
PUSHJ P,BUILDI
CAIE C,"(" ;ANY ARGS?
JRST XDFF2 ;NO
PUSH P,PSHPNT ;[154]INITIALIZE COUNT OF PUSH INSTS GENNED
XDFF1: PUSHJ P,NXCHK
PUSH P,LETSW
MOVMS LETSW
PUSHJ P,FORMLN ;GEN THE ARGUMENT IN REG
POP P,LETSW
JUMPGE B,.+2
PUSHJ P,EIRGP1
MOVSI D,(PUSH Q,) ;BUILD ARGUMENT PUSH
PUSHJ P,BUILDA
AOS PSHPNT ;COUNT THE PUSH
AOS -1(P) ;[154]ALSO SAVE THE COUNT FOR CHECK OF ARGS
TLNE C,F.COMA ;MORE ARGS?
JRST XDFF1 ;YES
TLNN C,F.RPRN ;CHECK FOR MATCHING PAREN
JRST ERRPRN
POP P,PSHPNT ;[154]RESET THE PUSH COUNT AGAIN
PUSHJ P,NXCHK ;SKIP PAREN
XDFF2: PUSHJ P,ARGCHK ;CHECK FOR RIGHT NUMBER OF ARGUMENTS
POP P,X1 ;GET RID OF POINTER TO ARG# CONSTANT
PUSHJ P,POPPR ;GET BACK FUNCTION LOC
MOVSI D,(GOSUB)
PUSHJ P,BUILDA ;GEN THE CALL
MOVEI B,0 ;ANSWER IS IN REG
JRST SNOEXI
;ROUTINE TO CHECK NUMBER OF ARGUMENTS AND CREATE A CONSTANT TO POP THEM
;OFF THE PUSH LIST. CALLED WITH XWD FCNAME,# OF ARGS
;AT LOCATION -1(P) RETURNS WITH A POINTER TO CONSTANT
;AT THAT LOCATION.
ARGCHK: HRRZ N,-1(P)
HRL N,N ;N NOW CONTAINS THE CONSTANT TO SUBTRACT FROM P
PUSHJ P,NNUM ;REGISTER THIS CONSTANT
MOVE N,-1(P) ;GET FCN NAME
MOVEM B,-1(P) ;SAVE ADDRESS OF CONSTANT
HRR N,B ;ASSEMBLE FADROL ENTRY...
HLLZ A,N ;SETUP SEARCH ARGUMENT
MOVEI R,FADROL ; XWD FCNAME,CONSTANT ADDRESS
PUSHJ P,SEARCH
JRST ARGCH1 ;FIRST TIME FCN SEEN. PUT ENTRY IN ROLL
CAMN N,(B) ;FCN SEEN BEFORE. SAME NUMBER OF ARGS?
POPJ P,
SETZM FUNAME
ARGCH0: FAIL <? INCORRECT NUMBER OF ARGUMENTS>
ARGCH1: MOVEI E,1 ;ADD FCN REF TO FADROL
PUSHJ P,OPENUP
MOVEM N,(B)
POPJ P,
;INTRINSIC FUNCTION GENERATOR.
XINFCN: PUSH P,B ;SAVE FCN LOC
PUSHJ P,REGFRE ;PROTECT ANY PARTIAL RESULT
POP P,B
PUSH P,B
TLNE B,777777
JRST XINF2 ;>= 1 ARG, LIB. ROUTINE.
CAIGE B,%FN
JRST XINF4 ;INLINE CODE.
CAIE C,"(" ;OP. ARG, LIB. ROUTINE.
JRST XINF1
PUSHJ P,NXCH ;DO NOT PUT A STR
PUSH P,F
PUSHJ P,FORMLB ;ARG IN MASAPP, BECAUSE
POP P,F ;THESE LIB. ROUTINES DO NOT
XINF0: TLNN C,F.RPRN ;CLEAR IT.
JRST ERRPRN
PUSHJ P,NXCH
XINF1: POP P,D
HRLI D,(PUSHJ P,)
XINF11: PUSHJ P,BUILDI
MOVEI B,0
JRST SNOEXI
XINF2: CAIE C,"(" ;>= 1 ARG, LIB. ROUTINE.
JRST ARGCH0
HLRE D,B
MOVM D,D
PUSH P,F
CAIE D,1
JRST XINF21
HLLZ F,B
MOVEI X1,1
JRST XINF22
XINF21: HLRZ D,B
MOVE X1,(D)
CAIN X1,3
JRST XINF3
XINF20: HRLZ F,1(D) ;[214](CHECK ARGS) NOT MID$ OR INSTR.
XINF22: PUSH P,X1 ;ALL ARGS ARE REQUIRED.
PUSH P,D
PUSHJ P,NXCH
PUSHJ P,FORMLU
PUSHJ P,EIRGNP
JUMPL F,XINF23 ;STR?
MOVE D,[AOS T,MASAPP]
PUSHJ P,BUILDI
MOVE D,[MOVEM N,(T)]
PUSHJ P,BUILDI
XINF23: POP P,D
POP P,X1
SOJN X1,.+3
POP P,F
JRST XINF0
TLNN C,F.COMA
JRST ERCOMA
AOJA D,XINF20
XINF3: SKIPG 1(D)
JRST XINF31
PUSHJ P,XINST1 ;MID$.
PUSHJ P,XINNUM
POP P,F ;RESTORE F.
TLNN C,F.COMA
JRST XINF0
MOVE D,[PUSH P,N]
PUSHJ P,BUILDI
PUSHJ P,XINNM1
HRLI F,1 ;RESTORE F.
JRST XINF01
XINF31: PUSHJ P,NXCH ;INSTR.
SKIPN FUNAME
SKIPL VRFSET
JRST .+4
MOVE D,[PUSHJ P,SETCOR]
PUSHJ P,BUILDI
SETZM VRFSET
PUSHJ P,FORMLB
PUSHJ P,EIRGNP
JUMPG F,XINF34
MOVE D,[PUSH P,N]
PUSHJ P,BUILDI
JRST XINF32
XINF34: MOVE D,[AOS T,MASAPP]
PUSHJ P,BUILDI
MOVE D,[MOVEM N,(T)]
PUSHJ P,BUILDI
PUSHJ P,XINSTR
POP P,F
JRST XINF0
XINF32: PUSHJ P,XINSTR
PUSHJ P,XINSTR
POP P,F
XINF01: TLNN C,F.RPRN
JRST ERRPRN
PUSHJ P,NXCH
POP P,D
HRRZI D,(D)
ADD D,[PUSHJ P,3]
JRST XINF11
XINSTR: TLNN C,F.COMA ;SUBR FOR STR ARG.
JRST ERCOMA
XINST1: PUSHJ P,NXCH
PUSHJ P,FORMLS
PUSHJ P,EIRGNP
MOVE D,[AOS T,MASAPP]
PUSHJ P,BUILDI
MOVE D,[MOVEM N,(T)]
JRST BUILDI
XINNUM: TLNN C,F.COMA ;SUBR FOR NUMERIC ARGUMENT.
JRST ERCOMA
XINNM1: PUSHJ P,NXCH
PUSHJ P,FORMLN
JRST EIRGNP
XINF4: POP P,B
JRST .(B) ;IN LINE CODE.
JRST ABSBI
JRST ASCBI
JRST DETBI
JRST LOCBI
JRST LOFBI
JRST NUMBI
JRST SGNBI
JRST TIMBI
;IN LINE FUNCTION GENERATORS.
ABSBI: CAIE C,"(" ;ABS FUNCTION.
JRST ARGCH0
PUSHJ P,NXCH
PUSHJ P,FORMLN
PUSHJ P,EIRGNM
TLNN C,F.RPRN
JRST ERRPRN
JRST INLIO2
INLIOU: TLNN C,F.RPRN
JRST ERRPRN
INLIO0: PUSHJ P,BUILDI
INLIO2: PUSHJ P,NXCH
INLIO1: MOVEI B,0
JRST SNOEXI
ASCBI: CAIE C,"(" ;ASC FUNCTION.
JRST ARGCH0
SETZ X2,
PUSHJ P,NXCHD
TLNN C,F.RPRN
JRST ASCB11
PUSH P,T
PUSHJ P,NXCH
TLNN C,F.RPRN
JRST ASCBI0
POP P,T
JRST ASCBI3
ASCB11: TLNN C,F.SPTB
JRST ASCBI3
MOVE X1,C ;BLANKS AND TABS.
ASCBI1: PUSHJ P,NXCHD ;IF ONLY BLANKS ARE
TLNE C,F.RPRN ;PRESENT, THE ARG IS A
JRST ASCBI2 ;BLANK. IF ONLY BLANKS
TLNE C,F.CR ;AND TABS ARE PRESENT, THE
ASCBI0: FAIL <? ILLEGAL ARGUMENT FOR ASC FUNCTION> ;ARG IS
TLNN C,F.SPTB ;A TAB. O'E, THE BLANKS
JRST ASCBI3 ;AND TABS ARE IGNORED.
CAME C,X1
CAMN C,X2
JRST ASCBI1
MOVE X2,C
JRST ASCBI1
ASCBI2: MOVE C,X1
JUMPE X2,.+2
MOVE C,[XWD F.SPTB,11]
PUSH P,T
HRRZ A,C
PUSHJ P,NXCH
TLNE C,F.RPRN
JRST ASCB21
POP P,T
ROT A,-7
JRST ASCBI5
ASCB21: POP P,T
HRLZI A,500000
JRST ASCBI5
ASCBI3: PUSHJ P,SCNLT1
TLNE C,F.RPRN
JRST ASCBI5 ;1 CHAR ARG.
TLNE C,F.TERM
JRST ILFORM
PUSHJ P,SCN2
JUMP
TLNE C,F.RPRN
JRST ASCBI6 ;2 CHAR CODE.
TLNE C,F.TERM
JRST ILFORM
PUSHJ P,SCN3
JUMP
TLNN C,F.RPRN
JRST ERRPRN
JRST ASCBI6 ;THREE CHAR CODE.
ASCBI5: PUSH P,N ;SET UP IN LINE CODE.
LDB N,[POINT 7,A,6]
ASCB51: PUSHJ P,IFLOAT
HLRZ D,N
POP P,N
ASCB52: HRLI D,(HRLZI N,)
JRST INLIO0 ;EXIT.
ASCBI6: PUSH P,N ;SEARCH.
HLRZ A,A
MOVEI X1,ASCFLO
ADDI X1,1
ASCBI7: HLRZ X2,-1(X1)
CAIN A,(X2)
JRST ASCBI8
HRRZ X2,-1(X1)
CAIN A,(X2)
JRST ASCBI9
CAIGE X1,ASCCEI
AOJA X1,ASCBI7
JRST ASCBI0
ASCBI8: SUBI X1,ASCFLO
MOVEI N,2(X1)
CAIG X1,^D10
MOVEI N,-1(X1)
JRST ASCB51
ASCBI9: SUBI X1,ASCFLO
MOVEI N,22(X1)
CAIN X1,^D15
MOVEI N,^D127
JRST ASCB51
;TABLE OF CODES FOR THE ASC FUNCTION.
ASCFLO: SIXBIT /NULDC3/
SIXBIT /SOHDC4/
SIXBIT /STXNAK/
SIXBIT /ETXSYN/
SIXBIT /EOTETB/
SIXBIT /ENQCAN/
SIXBIT /ACKEM /
SIXBIT /BELSUB/
SIXBIT /BS ESC/
SIXBIT /HT FS /
SIXBIT /CR GS /
SIXBIT /SO RS /
SIXBIT /SI US /
SIXBIT /DLESP /
SIXBIT /DC1DEL/
SIXBIT /DC2 /
ASCCEI:
DETBI: CAIE C,"(" ;DET FUNCTION.
JRST DETBI1
PUSHJ P,NXCH
PUSHJ P,FORMLB
HRLI F,777777 ;RESTORE F.
MOVE D,[MOVE N,DETER]
JRST INLIOU
DETBI1: MOVE D,[MOVE N,DETER]
PUSHJ P,BUILDI
JRST INLIO1
LOCBI: SETZM LOCLOF ;LOC FUNCTION.
LOCBI1: CAIE C,"(" ;LOF ENTERS HERE.
JRST ARGCH0
PUSHJ P,NXCH
CAIN C,":"
PUSHJ P,NXCH
PUSHJ P,GETCN0
HRLZI D,(MOVE X1,)
PUSHJ P,BUILDI
MOVE D,[SKIPL ACTBL-1(X1)]
PUSHJ P,BUILDI
MOVE D,[JRST FNMX0]
PUSHJ P,BUILDI
MOVE D,[MOVE N,POINT-1(X1)]
SKIPE LOCLOF
MOVE D,[MOVE N,LASREC-1(X1)]
PUSHJ P,BUILDI
MOVE D,[PUSHJ P,IFLOAT]
JRST INLIOU
LOFBI: SETOM LOCLOF ;LOF FUNCTION.
JRST LOCBI1
NUMBI: CAIE C,"(" ;NUM FUNCTION.
JRST NUMBI1
PUSHJ P,NXCH
PUSHJ P,FORMLB
HRLI F,777777 ;RESTORE F.
MOVE D,[MOVE N,NUMRES]
JRST INLIOU
NUMBI1: MOVE D,[MOVE N,NUMRES]
PUSHJ P,BUILDI
JRST INLIO1
SGNBI: CAIE C,"(" ;SGN FUNCTION.
JRST ARGCH0
PUSHJ P,NXCH
PUSHJ P,FORMLN
PUSHJ P,EIRGNP
HRRZ D,CECOD
ADDI D,5
HRLI D,(JUMPE N,) ;0 FOR 0.
PUSHJ P,BUILDI
MOVE D,[HRLZI T,201400]
PUSHJ P,BUILDI
HRRZ D,CECOD
ADDI D,2
HRLI D,(JUMPG N,) ;1.0 FOR > 0.
PUSHJ P,BUILDI
MOVE D,[MOVN T,T] ;-1.0 FOR < 0.
PUSHJ P,BUILDI
MOVE D,[MOVE N,T]
JRST INLIOU
TIMBI: MOVSI D,(SETZ N,) ;TIM FUNCTION.
PUSHJ P,BUILDI
MOVE D,[RUNTIM N,]
PUSHJ P,BUILDI
MOVE D,[SUB N,BGNTIM]
PUSHJ P,BUILDI
MOVE D,[PUSHJ P,IFLOAT]
PUSHJ P,BUILDI
MOVE D,[FDVRI N,212764]
PUSHJ P,BUILDI
JRST INLIO1
;ROUTINE TO XLATE ARGUMENTS
;RETURNS WITH ARGS ON SEXROL. B IS O IF ONE ARG, -1 IF TWO.
XARG: PUSHJ P,NXCHK ;SKIP PARENTHESIS.
PUSH P,LETSW ;SAVE LETSW WHILE TRANSL ARGS
MOVMS LETSW ;THE COMMA FOLLOWING AN ARG IS NOT LH(LET)!
PUSH P,F
PUSHJ P,FORMLB
JUMPL F,XARG0
XARG3: FAIL <? NESTED STRING VECTORS>
XARG0: POP P,F
PUSHJ P,GPOSNX
PUSHJ P,SITGEN
PUSHJ P,PUSHPR
MOVEI B,0
TLNN C,F.COMA ;COMMA FOLLOWS?
JRST XARG1 ;NO. ONE ARG.
PUSHJ P,NXCHK ;YES GEN AND SAVE SECOND ARG
PUSH P,F
PUSHJ P,FORMLB
JUMPG F,XARG3
POP P,F
PUSHJ P,GPOSNX
PUSHJ P,SITGEN
PUSHJ P,PUSHPR
MOVNI B,1 ;DBL ARG FLAG
XARG1: POP P,LETSW ;RESTORE LETSW
TLNN C,F.RPRN ;MUST HAVE PARENTHESIS
JRST ERRPRN
JRST NXCHK ;IT DOES. SKIP PAREN AND RETURN.
;ROUTINE TO GEN ARGUMENTS
GENARG: JUMPE B,GENAFN ;ONE OR TWO ARGS?
GENAR0: PUSHJ P,POPPR ;TWO
PUSHJ P,EXCHG
PUSHJ P,GENAF1
GENAFN: PUSHJ P,POPPR
GENAF1: MOVSI D,(JUMP 2,)
JRST BUILDA
;ROUTINE TO ANALYZE NEXT ELEMENT
;CALL: PUSHJ P,REGLTR
;RETURNS ROLL PNTR IN B, CODE IN A
;CODE IS: 0-ARRAY, 1-SCALAR, 2-INTRINSIC FCN, 3-DEFINED FCN, 4-FAIL
; 5-STRING VECTOR, 6-STRING VARIABLE, 7-STRING LITERAL.
REGLTR: PUSHJ P,SCNLT1 ;LTR TO A, LEFT JUST 7 BIT
HRRI F,SCAROL ;ASSUME SCALAR
TLNE C,F.LETT ;ANOTHER LETTER?
JRST REGFCN ;YES. GO LOOK FOR FCN REF
TLNN C,F.DIG ;DIGIT FOLLOWS?
JRST REGARY ;NO, GO CHECK FOR ARRAY
DPB C,[POINT 7,A,13];ADD DIGIT TO NAME
PUSHJ P,NXCHK ;GO ON TO NEXT CHAR
TLNE C,F.DOLL ;STRING VARIABLE?
JRST REGSTR ;YES. REGISTER IT.
CAIN C,"("
JRST REGARY
JUMPL F,REGL1
TLNE F,777777
JRST ILFORM
HRLI F,777777
;RETURN HERE IF REGARY SAYS NOT ARRAY
;RETURN HERE IF REGFCN SAYS FOLLOWED BY KEYWORD.
REGL1: TLNE A,17 ;IS THIS A SCALAR?
JRST REGL1A ;NO. DON'T LOOK FOR FCN ARGUMENT
MOVE B,FLARG ;IS THIS A FN ARG?
CAML B,CEARG ;SEARCH UNORDERED ARGROL
JRST REGL1A ;NOT A FN ARG
CAME A,(B)
AOJA B,.-3 ;TRY NEXT ROLL ENTRY.
JRST FARGRF ;YES
REGL1A: MOVEI R,VARROL ;NO. SCALAR
PUSHJ P,SEARCH ;IN VARIABLE ROLL?
JRST REGL2 ;NO
HRRZ D,(B) ;YES. GET PNTR TO SCAROL
JRST REGL3
REGL2: MOVEI E,1 ;ADD TO SCALAR ROLL OR VSPROL
PUSHJ P,OPENUP
ADD A,CEIL(F) ;COMPUTE PNTR TO ROLL
SUB A,FLOOR(F)
HRRZ D,A ;SAVE ROLL POINTER
MOVEM A,(B)
MOVEI R,(F) ;PUT NULL ENTRY ON ROLL
MOVEI A,0
PUSHJ P,RPUSH
; B ::= REL LOC OF ROLL ENTRY
REGL3: MOVE B,D ;B ::= REL LOC OF ROLL ENTRY
TLO B,(F) ;MAKE ROLL POINTER AND SKIP
JRST REGSCA
;COME HERE ON REF TO FCN ROL
;CALCULATE ADDRESS OF THIS FUNCTION ARGUMENT.
FARGRF: SUB B,CEARG ;NOW ADDRESS IS -NN FOR FIRST ARG, -1 FOR NNTH ARG, ETC.
HRLI B,PSHROL
REGSCA: MOVEI A,1 ;CODE SAYS SCALAR
POPJ P, ;RETURN
SCAREG: HRRI F,SCAROL ;REGISTER THE CONTENTS OF A AS SCALAR
JRST REGL1A
REGARY: CAIE C,"("
TLNE C,F.DOLL ;ARRAY OR POSSIBLE SRVECTOR REF?
JRST REG1
JUMPL F,REGL1
TLNE F,777777
JRST ILFORM
HRLI F,777777
JRST REGL1 ;NO. TREAT AS SCALAR
REG1: TLNN C,F.DOLL ;STRING VARIABLE?
JRST REG2
JUMPL F,ILFORM
HRLI F,1
JRST REGSTR
REG2: JUMPL F,REGA0
TLNE F,777777
JRST ILFORM
HRLI F,777777
REGA0: HRRI F,ARAROL ;NUMERICAL ARRAY GOES ON ARAROL.
REGA1: TLO A,1 ;MAKE ARRAY NAME DIFFERENT FROM SCALAR
MOVEI R,VARROL ;LOOK FOR VARIABLE NAME
PUSHJ P,SEARCH
JRST REGA2 ;NOT ALREADY USED
HRRZ D,(B) ;GET POINTER TO ARAROL
JRST REGA3 ;ALREADY USED
REGA2: MOVEI E,1 ;ADD NEW ARRAY NAME TO VARIABLE ROLL
PUSHJ P,OPENUP
ADD A,CEIL(F) ;COMPUTE ARRAY OR STRING VECTOR ROLL POINTER
SUB A,FLOOR(F)
ORI A,400000 ;SET ARRAY FLAG
MOVEM A,(B)
HRRZ D,A ;SAVE ARAROL POINTER
MOVEI R,(F) ;THREE ZEROS ON ARAROL (NULL ENTRY)
MOVEI A,0
PUSHJ P,RPUSH
PUSHJ P,RPUSH
PUSHJ P,RPUSH
REGA3: MOVE B,D ;RECONSTRUCT PNTR
ANDI B,377777 ;B := REL ADDRS IN ARRAY ROLL
HRLI B,(F) ;B := POINTER TO ENTRY ON ROLL
MOVEI A,0 ;ARRAY CODE
POPJ P,
;SUBROUTINE TO REGISTER ARRAY NAME.
;(USED BY DIM,MAT)
ARRAY: HRRI F,ARAROL ;ASSUME ITS NOT A STRING
TLNN C,F.LETT
JRST REGFAL
PUSHJ P,SCNLT1 ;NAME TO A
TLNE C,F.DOLL ;STRING VECTOR?
JRST ARRAY2 ;YES, HANDLE DIFFERENTLY
TLNE C,F.DIG
JRST ARRAY4
ARRAY0: JUMPL F,.+4
TLNE F,777777
JRST ILFORM
HRLI F,777777
PUSHJ P,REGA0 ;FINISH REGISTERING
ARRAY1: MOVE X1,B ;SET DEFAULT TO 2-DIM ARRAY
ADD X1,FLOOR(F)
SKIPN 1(X1)
SETOM 1(X1)
POPJ P,
ARRAY4: DPB C,[POINT 7,A,13]
PUSHJ P,NXCHK
TLNN C,F.DOLL
JRST ARRAY0
ARRAY2: JUMPL F,ILFORM
HRLI F,1
PUSHJ P,NXCHK ;SKIP THE DOLLAR SIGN.
PUSHJ P,REGSVR ;REGISTER STRING VECTOR
JRST ARRAY1 ;SET DEFAULT, IF NECESSARY
VECTOR: PUSHJ P,ARRAY ;REGISTER VECTOR
CAIE A,5 ;WAS A STRING REGISTERED?
JUMPN A,CPOPJ ;WAS AN ARRAY REGISTERED?
MOVE X2,1(X1)
JUMPG X2,.+4 ;EXPLICIT DIMENSION?
MOVNI X2,2 ;NO. CALL IT A VECTOR OF UNKNOWN DIM.
MOVEM X2,1(X1)
POPJ P,
TLNE X2,777776 ;IS THIS A ROW VECTOR?
TRNN X2,777776 ;OR A COLUMN VECTOR?
POPJ P, ;YES.
FAIL <? USE VECTOR, NOT ARRAY,>
REGSTR: JUMPL F,ILFORM ;REGISTER STRING, IF STRING IS LEGAL
HRLI F,1
TLO A,10 ;MAKE STRING NAME DIFFERENT FROM OTHER NAMES.
HRRI F,VSPROL ;POINTER WILL GO ON VARIABLE SPACE ROLL
TLNE C,F.DOLL ;SKIP DOLLAR SIGN?
PUSHJ P,NXCHK ;SKIP DOLLAR SIGN
CAIN C,"(" ;IS IT A STRING VECTOR?
JRST REGSVR ;YES.
PUSHJ P,REGL1 ;REGISTER STRING.
JRST REGS1 ;FIX VARIABLE TYPE CODE.
REGSLT: MOVMS LETSW ;STR LIT.
JUMPL F,ILFORM
HRLI F,1
PUSHJ P,NXCHD
PUSH P,C
PUSH P,T
SETZ A,
REGSL1: TLNE C,F.QUOT ;COUNT CHARACTERS.
JRST REGSL2
TLNE C,F.CR
JRST GRONK
PUSHJ P,NXCHD
AOJA A,REGSL1
REGSL2: MOVEI E,4(A)
MOVN A,A
HRLI A,(A)
MOVE T,CESLT
SUB T,FLSLT
HRRI A,(T)
MOVEI R,LITROL
PUSH P,E
PUSHJ P,RPUSH ;PUSH POINTER ONTO LITERAL ROLL
POP P,E
IDIVI E,5
JUMPE E,REGSL3
MOVEI R,SLTROL ;SET UP SLTROL.
PUSHJ P,BUMPRL
REGSL3: POP P,T
POP P,C
TLZ C,777777
HRLI B,440700
REGSL4: CAIN C,42
JRST REGSL5
IDPB C,B
ILDB C,T
JRST REGSL4
REGSL5: PUSHJ P,NXCH
MOVEI R,SADROL ;MOVE LITROL ADDRESS ON STR-LIT-ADR ROLL
MOVEI A,0
PUSHJ P,RPUSH
SUB B,FLSAD ;GET REL ADRESS
HRLI B,SADROL ;SET UP POINTER.
MOVEI A,7
JRST SNOEXI
QSKIP: PUSHJ P,NXCH ;SKIP TO NEXT QUOTE CHAR.
TLNE C,F.CR ;TERMINAL QUOTE MISSING?
POPJ P, ;YES
TLNN C,F.QUOT ;END OF STRING?
JRST QSKIP ;NO, GO ON.
PUSHJ P,NXCH ;YES. GET NEXT CHAR AND RETURN.
JRST CPOPJ1
REGSVR: HRRI F,SVRROL ;REGISTER STRING VECTOR
TLO A,11 ;MAKE NAME DIFFERENT FROM THE OTHERS
TLNE C,F.DOLL ;DOLLAR SIGN?
PUSHJ P,NXCHK ;YES, SKIP IT
PUSHJ P,REGA1 ;REGISTER AS AN ARRAY
REGS1: CAIE A,4 ;DID REGISTRATION FAIL?
ADDI A,5 ;NO. FIX TYPE CODE.
POPJ P,
;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: ASCII /BY/
ASCII /GOTO/
ASCII /STEP/
ASCII /THEN/
ASCII /TO/
ASCII /USING/
KWTTOP:
;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: PUSH P,C ;SAVE T,C AROUND LOOK-AHEAD.
PUSH P,T
MOVEI X1,KWTBL ;TBL OF KEYWORDS
REGF1: PUSHJ P,QST ;TEST THIS KEYWORD.
JRST REGF2
POP P,T
POP P,C ;KEYWORD FOUND; ASSUME ONE-LETTER SCALAR.
JUMPL F,.+4
TLNE F,777777
JRST ILFORM
HRLI F,777777
JRST REGL1
REGF2: MOVEI X1,1(X1) ;NOT CURRENT KEYWORD
MOVE T,(P) ;RESTORE POINTERS DESTROYED BY QST
MOVE C,-1(P)
CAIGE X1,KWTTOP ;MORE TO TEST?
JRST REGF1 ;YES
POP P,T ;NO, NOT KEYWORD.
POP P,C
;HAVE DETERMINED THAT WE MUST BE SCANNING A FUNCTION NAME
;IF SYNTAX IS LEGAL.
;WE SCAN THE SECOND LETTER AND CHECK FOR
;INTRINSIC OR DEFINED FUNCTION.
PUSHJ P,SCNLT2
JRST REGFAL ;NOT A LETTER
CAMN A,[SIXBIT /FN/] ;DEFINED FUNCTION?
JRST REGDFN ;YES. GO REGISTER DEFINED NAME.
;HERE WE HAVE FN NAME NOT BEGINNING WITH "FN"
;LOOK FOR IT IN TABLE OF INTRINSIC FUNCTIONS.
MOVE X1,[POINT 6,A,11] ;CONSTRUCT WHOLE NAME.
MOVEI R,4
REGF4: TLNN C,F.LETT
JRST REGF5
REGF41: PUSH P,X1 ;LOOK AHEAD TO SEE IF WE HAVE
PUSH P,C ;RUN INTO A KEYWORD.
PUSH P,T
MOVEI X1,KWTBL
REGF3: PUSHJ P,QST
JRST REGF31
POP P,T ;FOUND.
POP P,C
POP P,X1
JRST REGF9
REGF31: MOVEI X1,1(X1)
MOVE T,(P)
MOVE C,-1(P)
CAIGE X1,KWTTOP
JRST REGF3
POP P,T
POP P,C
POP P,X1
TLNN C,F.LCAS
TRC C,40
IDPB C,X1
PUSHJ P,NXCH
SOJG R,REGF4
REGF9: JUMPL F,.+4
TLNE F,777777
JRST ILFORM
HRLI F,777777
JRST REGF6
REGF5: TLNN C,F.DIG
JRST REGF51
CAME A,[SIXBIT/LOG /]
CAMN A,[SIXBIT/LOG1 /]
JRST REGF41
REGF51: TLNN C,F.DOLL
JRST REGF9
SKIPN FUNAME
SKIPL VRFSET
JRST REGF10
MOVE D,[PUSHJ P,SETCOR]
PUSH P,X1
PUSHJ P,BUILDI
POP P,X1
SETZM VRFSET
REGF10: MOVEI C,4 ;$ IN SIXBIT.
IDPB C,X1
PUSHJ P,NXCH
JUMPL F,ILFORM
HRLI F,1
REGF6: CAME A,[SIXBIT/VAL /]
JRST REGF0
SKIPN FUNAME
SKIPL VRFSET
JRST REGF0
MOVE D,[PUSHJ P,SETCOR]
PUSHJ P,BUILDI
SETZM VRFSET
REGF0: MOVEI R,IFNFLO
REGF7: CAMN A,(R)
JRST REGF8 ;FOUND FN.
AOJ R,.+1
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: JUMPL F,.+4
TLNE F,777777
JRST ILFORM
HRLI F,777777
SKIPN FUNAME
SKIPL VRFSET
JRST .+4
MOVE D,[PUSHJ P,SETCOR]
PUSHJ P,BUILDI
SETZM VRFSET
PUSHJ P,SCNLT1 ;PUT FUNCTION NAME IN A
CAMN A,FUNAME ;IS THIS THE NAME OF THE CURRENT MULTI-LINE FN?
JRST REGFNA ;YES. REGISTER IT AS A SCALAR
MOVE D,A ;NO, REAL FUNCTION CALL. SAVE NAME FOR ARGCHK
MOVMS LETSW
MOVEI R,FCLROL ;FUNCTION CALL ROLL
PUSHJ P,SEARCH ;USED THIS ONE YET?
JRST .+2
JRST REGFC1 ;ALREADY SEEN A REF
MOVEI E,1
PUSHJ P,OPENUP
MOVEM A,(B)
PUSHJ P,REGFC1 ;SET B UP FOR KLUDGE TEST
MOVE X1,FLSEX ;FIX UP SAVED FCN REFS
REGFC0: CAML X1,CESEX ;KLUDGE!!!
JRST REGFC1+1
HLRZ X2,(X1) ;GET THE ROLL NUMBER
CAIN X2,FCLROL ;FCLROL?
CAMLE B,(X1) ;YES. IS SEXREF NOW WRONG?
AOJA X1,REGFC0 ;NO
AOS (X1) ;YES. CORRECT IT
AOJA X1,REGFC0
REGFC1: SUB B,FLFCL
HRLI B,FCLROL
MOVEI A,3 ;DEFINED FCN CODE
POPJ P, ;DON'T CHECK FOR () YET
CHKPRN: CAIE C,"("
REGFAL: MOVEI A,4 ;FAIL IF NO PAREN
POPJ P,
REGFNA: TLO A,(177B13) ;CREATE SPECIAL NAME FOR CURRENT FUNCTION
JRST SCAREG ;REGISTER IT AS A SCALAR
SUBTTL SUBROUTINES USED BY GEN ROUTINES
;PUSHPR - PUSH PARTIAL RESULT ON SEXROL
PUSHPR: MOVEI R,SEXROL
MOVE A,B ;SAVE POINTER IN A
PUSHJ P,RPUSH
SUB B,FLSEX ;MAKE POINTER
TLNN A,ROLMSK ;IS IT A POINTER TO REG?
HRROM B,REGPNT ;YES, SET POINTER FOR SITGEN TO USE
POPJ P,
;POPPR - POP PARTIAL RESULT FROM SEXROL
POPPR: MOVEI R,SEXROL
MOVE B,CESEX
SUBI B,1 ;COMPUTE ADDRS OF TOP OF SEXROL
PUSH P,(B) ;SAVE THE CONTENT
MOVEI E,1
PUSHJ P,CLOSUP
POP P,B ;POPPED POINTER TO B
POPPFN: TLNN B,ROLMSK ;POINTER TO REG?
SETZM REGPNT ;YES. CLEAR MEMORY
POPJ P,
;EXCHG - EXCHANGE CURRENT PNTR WITH TOP OF SEXROL
EXCHG: MOVE X1,CESEX
MOVEI X2,-1(X1) ;FIX PNTR IF REG SAVED
SUB X2,FLSEX
TLNN B,ROLMSK
HRROM X2,REGPNT
EXCH B,-1(X1)
JRST POPPFN ;GO FIX PNTR IF REG POPPED
;REGFRE - GUARANTEE THAT NO PART RESULT IS IN REG
REGFRE: SKIPN REGPNT ;SUBEXP IN THE REG?
POPJ P, ;NO
MOVE X1,FLSEX ;YES. COMPUTE WHERE
ADD X1,REGPNT
EXCH B,(X1) ;GET THE POINTER, SAVE CURR PNTR
PUSHJ P,SITGEN ;STORE IN TEMP
MOVE X1,FLSEX ;RECOMPUTE LOC IN SEXROL
ADD X1,REGPNT
EXCH B,(X1)
SETZM REGPNT ;CLOBBER REGPNT SINCE REG IS EMPTY
POPJ P,
;GPOSGE - GUARANTEE POSITIVE GEN
GPOSGE: JUMPGE B,CPOPJ ;RETURN IF ALREADY POSITIVE
;FALL INTO EIRGEN
;EIRGEN - EXP IN REG GEN
EIRGEN: TLNN B,ROLMSK ;ALREADY IN REG?
POPJ P, ;DO NOTHING
ERGNFN: PUSHJ P,REGFRE ;FREE UP REG
MOVSI D,(MOVE N,) ;GET MOVE INSTR
EIRGM2: PUSHJ P,BUILDS ;BUILD MOVE INSTR
MOVEI B,0 ;POSITIVE REG POINTER
POPJ P,
;EIRGNP - EXP IN REG GEN POSITIVE
EIRGNP: JUMPGE B,EIRGEN ;POSITIVE?
EIRGP1: TLNE B,ROLMSK ;NO. IN REG?
JRST ERGNFN ;NO. GO MOVE
MOVSI D,(MOVN N,) ;YES,NEGATIVE N
EIRGM3: PUSHJ P,BUILDI
MOVEI B,0 ;POSITIVE REG PNTR
POPJ P,
;EIRGNM -- GEN MAG.
EIRGNM: TLNN B,ROLMSK
JRST EIRGM1
TLZ B,400000
PUSHJ P,REGFRE
MOVSI D,(MOVM N,)
JRST EIRGM2
EIRGM1: MOVSI D,(MOVM N,)
JRST EIRGM3
;SIPGEN - STORE IN PERMANENT TEM GEN
SIPGEN: MOVEI R,PTMROL
JRST SITGN1
;SITGEN - STORE IN TEMP GEN
SITGEN: MOVEI R,TMPROL
SITGN1: TLNE B,ROLMSK ;IS EXPR IN REG?
POPJ P, ;NO. DONT DO ANYTHING
MOVEI A,0 ;PREPARE ZERO TO PUSH ON ROLL
MOVSI D,(MOVEM N,) ;GET CORRECT INSTR
JUMPGE B,.+2
MOVSI D,(MOVNM N,)
CAIE R,TMPROL ;STORE ON TMPROL?
JRST SITG2 ;NO. USE PTMROL
AOS B,TMPPNT ;WHICH TEMP TO USE?
MOVE X1,FLTMP
ADD X1,B
CAML X1,CETMP ;NEED MORE TMP SPACE?
PUSHJ P,RPUSH ;YES. PUSH A ZERO ONTO TMPROL
MOVE B,TMPPNT ;CONSTRUCT TMP ROLL POINTER
SITG1: HRLI B,(R)
PUSH P,B ;SAVE ADRESS POINTER
PUSHJ P,BUILDA ;BUILD STORE INSTR
POP P,B ;RECONSTRUCT POINTER
POPJ P,
SITG2: PUSHJ P,RPUSH ;PUSH A ZERO ONTO PTMROL
SUB B,FLPTM
JRST SITG1 ;FINISH CONSTRUCTING ADRESS POINTER
;GPOSNX - GUARANTEE POSITIVE AND UNINDEXED GEN
GPOSNX: TLNE B,400000+PSHROL ;NEGATIVE OR INDEXED BY (P)?
PUSHJ P,EIRGNP ;YES. FORCE INTO REG
POPJ P,
BUILDP: TLO D,Q ;INSTRUCTION IS INDEXED BY PLIST POINTER
SUB B,PSHPNT ;ADJUST THE ADDRESS FOR ANY PUSH INSTS GENNED BY
ADDI B,1
HRR D,B ;A CURRENT FN CALL
;ROUTINE TO ADD CODE TO CODROL.
;A WORD IS ASSUMED IN D
;RETURN REL ADDRS IN B
BUILDI: SKIPN RUNFLA ;ARE WE GOING TO RUN?
POPJ P, ;NO. DONT GEN CODE
MOVEI E,1
MOVEI R,CODROL
PUSHJ P,BUMPRL
MOVEM D,(B)
SUB B,FLCOD
POPJ P,
;BUILD SIGNED INSTRUCTION WITH ADDRESS
;CHECK SIGN IN B AND CHANGE UP CODE BITS
BUILDS: JUMPGE B,BUILDA ;POSITIVE?
TLC D,010000 ;NO. CHANGE MOVE TO MOVN,ETC.
;FALL INTO BUILDA
;BUILDA - BUILD INSTRUCTION WITH LINKED ADDRESS
;INSTRUCTION SKELETON IS IN D, ADDRESS POINTER IS IN B
BUILDA: SKIPN RUNFLA ;ARE WE GOING TO RUN?
POPJ P, ;NO. DONT BUILD
TLZE B,PSHROL ;SPECIAL TEST FOR ROLL WITH ABSOLUTE ADDRESSES
JRST BUILDP ;YES, PSHROL. DO BUILDI INDEXED BY (Q)
TLZ B,400000
JUMPE B,BUILDI ;ITEM IS IN REG . USE ADDRESS ZERO
PUSH P,B ;SAVE THE POINTER
PUSHJ P,BUILDI ;ADD INSTR WITH 0 ADDRS TO CODE
MOVE X1,CECOD ;LOC+1 OF THE INSTR
POP P,X2 ;COMPUTE ADDRS LOCATION
LDB R,[POINT 17,X2,17]
ADD X2,FLOOR(R)
MOVE R,(X2) ;GET NEXT ADDRS IN CHAIN
HRRM R,-1(X1) ;STORE IT IN THE INSTR
SUB X1,FLCOD
SUBI X1,1
HRRM X1,(X2) ;STORE CURR ADDRS IN ROLL PNTD TO
POPJ P,
SUBTTL UTILITY SUBROUTINES
;SUBROUTINES FOR GENERAL ROLL MANIPULATION
CLOSUP: MOVN X1,E ;COMPUTE NEW END OF ROLL
ADDB X1,CEIL(R) ;AND STORE IT
MOVE X2,B ;CONSTRUCT BLT WORD
ADD X2,E
MOVS X2,X2
HRR X2,B
BLT X2,-1(X1) ;MOVE DOWN TOP OF ROLL
POPJ P,
CLOB: MOVEI T1,COMTOP ;ROUTINE TO CLOBBER ALL MOVEABLE ROLLS
MOVEM T,FLOOR(T1) ;T CONTAINS CLOBBER VALUE.
MOVEM T,CEIL(T1)
CAILE T1,1(X1) ;DO NOT CLOBBER ROLLS <=(X1)
SOJA T1,.-3
POPJ P,
OPEN2: MOVE X2,E ;IS THERE ROOM ABOVE THIS STODGY ROLL?
ADD X2,CEIL(R) ;THE NEW CEILING
CAMLE X2,FLOOR+1(R)
JRST OPENU0 ;NO ROOM, PACK OTHER ROLLS UP
ADDM E,CEIL(R) ;THERE IS ROOM, INCREMENT CEILING
POPJ P,
OPENU0: SUB B,FLOOR(R)
PUSHJ P,PANIC
ADD B,FLOOR(R)
OPENUP: CAMG R,TOPSTG ;OPEN UP THE TOP STODGY ROLL?
JRST OPEN2 ;YES. OPEN UPWARDS, NOT DOWN
MOVN X2,E
MOVE X1,TOPSTG ;DO NOT MOVE STODGY ROLLS
ADD X2,FLOOR+1(X1)
CAMGE X2,CEIL+0(X1)
JRST OPENU0 ;NEED MORE ROOM
HRL X2,FLOOR+1(X1) ;CONSTRUCT BLT WORD
SUB B,E ;FIRST WORD OF GAP
BLT X2,-1(B) ;MOVE ROLLS DOWN
MOVEI X1,1(X1) ;ADJUST POINTERS FOR ROLLS JUST BLT'D.
MOVN X2,E
OPEN1: ADDM X2,FLOOR(X1)
CAML X1,R
POPJ P,
ADDM X2,CEIL(X1)
AOJA X1,OPEN1
;RPUSH - PUSH A ON TOP OF DESIGNATED ROLL
RPUSH: MOVEI E,1
PUSHJ P,BUMPRL ;MAKE ROOM
MOVEM A,(B) ;STORE WORD
POPJ P,
;ROUTINE TO ADD TO END OF ROLL
;E CONTAINS SIZE, R CONTAINS ROLL NUMBER
BUMPRL: MOVE B,CEIL(R)
ADD B,E
CAIE R,ROLTOP
SKIPA X1,FLOOR+1(R)
HRRZ X1,.JBREL
CAMLE B,X1
JRST BUMP1
EXCH B,CEIL(R)
POPJ P,
BUMP1: MOVE B,CEIL(R)
CAIE R,CODROL
CAIN R,SEXROL
JRST .+2
JRST OPENUP
ADDI E,^D10 ;***EXTRA 10 LOCS
PUSHJ P,OPENUP
MOVNI X1,^D10 ;TAKE BACK THE 10 LOCS
ADDM X1,CEIL(R)
POPJ P,
;BINARY SEARCH OF SORTED ROLL
;CALL WITH KEY IN A
;RETURN IN B ADDRS OF FIRST
;ENTRY NOT LESS THAN KEY
;SKIP RETURN IF LEFT SIDES EQUAL
SEARCH: MOVE B,FLOOR(R)
SKIPA X1,CEIL(R)
SEAR1: MOVEI B,1(X2)
CAIGE B,(X1)
JRST SEAR2
CAML B,CEIL(R)
POPJ P,
JRST SEAR3
SEAR2: MOVEI X2,@X1
ADD X2,B
ASH X2,-1
CAMLE A,(X2)
JRST SEAR1
HRRI X1,0(X2)
CAIGE B,(X1)
JRST SEAR2
SEAR3: HLLZ X2,(B)
CAMN X2,A
AOS (P)
POPJ P,
;ROUTINE TO QSA FOR "THEN" OR "GOTO" (USED IN "IF", "ON" STATEMENTS)
THENGO: PUSHJ P,QSA
ASCIZ /THEN/
JRST .+2
POPJ P,
PUSHJ P,QSA
ASCIZ /GOTO/
FAIL <? ILLEGAL FORMAT WHERE THE WORDS THEN OR GO TO WERE EXPECTED>
POPJ P,
;COMMON SUBROUTINE RETURNS
CPOPJ1: AOS (P)
CPOPJ: POPJ P,
;ERROR RETURNS
ILFORM: FAIL <? ILLEGAL FORMULA>
ILVAR: FAIL <? ILLEGAL VARIABLE>
GRONK: FAIL <? ILLEGAL FORMAT>
ILLINS: FAIL <? INITIAL PART OF STATEMENT NEITHER MATCHES A STATEMENT KEYWORD NOR HAS A FORM LEGAL FOR AN IMPLIED LET--CHECK FOR MISSPELLING>
;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
SKIPN RUNFLA
JRST FAL1
PUSHJ P,INLMES
ASCIZ /
/
FAL1: PUSHJ P,INLMES
ASCIZ /? /
POP P,C
MOVEI C,(C)
CAIE C,11
CAIN C,40
JRST FALSPT
CAIL C,12
CAILE C,15
JRST .+2
JRST FALFF
CAIL C,41
CAILE C,172
JRST FALNON
PUSHJ P,OUCH
JRST FAL2
FALNON: PUSHJ P,INLMES
ASCIZ /A NON-PRINTING CHARACTER/
JRST FAL2
FALFF: PUSHJ P,INLMES
ASCIZ /A FF,LF,VT, OR CR/
JRST FAL2
FALSPT: PUSHJ P,INLMES
ASCIZ /A SPACE OR TAB/
FAL2: PUSHJ P,INLMES
ASCIZ / WAS SEEN WHERE /
MOVE T,(P)
PUSH P,ODF
SETZM ODF
SETZ D,
PUSHJ P,PRINT ;PRINT EXPECTED CHAR OR MESSAGE.
POP P,ODF
SETZM HPOS
POP P,T ;CLEAN UP PLIST.
PUSHJ P,INLMES
ASCIZ / WAS EXPECTED/
PUSHJ P,FAIL2
JRST NXTST1
;COMPILATION ERROR MESSAGES FROM FAIL UUOS.
FAILER: SKIPN RUNFLA ;IS THIS THE FIRST ERROR IN COMPILATION?
JRST FAIL0 ;NO.
PUSHJ P,INLMES ;YES. SETUP <CRLF> TO FOLLOW HEADING.
ASCIZ /
/
FAIL0: PUSHJ P,FAIL1
JRST NXTST1
FAIL1: MOVE T,40
FAILR: MOVEI D,0
PUSHJ P,PRINT
LDB X1,[POINT 4,40,12] ;IS AC FIELD NONZERO?
JUMPE X1,FAIL2
MOVE T,N ;ATTACH NUMBER IN 'N' TO MSG
PUSHJ P,PRTNUM
FAIL2: PUSHJ P,INLMES
ASCIZ / IN LINE /
MOVE T,L
ADD T,FLLIN
HLRZ T,(T)
PUSHJ P,PRTNUM
SKIPE CHAFL2 ;CHAINING?
PUSHJ P,ERRMS3
PUSHJ P,INLMES
ASCIZ /
/
SETZM RUNFLA
POPJ P,
;ROUTINES TO ALLOW AND DELAY REENTRY.
;LOCKON TEMPORARILY PREVENTS REENTRY
;LOCKOF ALLOWS REENTRY AND REENTERS IF THERE IS A STANDING REQUEST
;REENTR MAKES A REENTRY OR MAKES A REQUEST AND CONTINUES
LOCKON: SKIPGE RENFLA
SETZM RENFLA ;TURN ON REENTER PROTECT
POPJ P,
LOCKOF: SKIPLE RENFLA
JRST BASIC ;ACT ON OLD REENTER REQUEST
SETOM RENFLA ;ALLOW REENTER
POPJ P,
REENTR: SKIPL RENFLA
JRST REENT1
SKIPLE COMTIM
JRST REUXIT ;CLOSE FILES.
JRST BASIC ;REENTER IF ALLOWED
REENT1: AOS RENFLA ;MAKE REQUEST BY SETTING FLAG PLUS
JRST 2,@.JBOPC
;ROUTINE TO READ CHARACTER, SKIPPING BLANKS
;CALL: MOVE T,<POINTER TO CHAR BEFORE FIRST>
; PUSHJ P,NXCH
; ... RETURN, C:= (<FLAGS>)CHARACTER
NXCHS: ILDB C,T ;DOESNT SKIP TAB OR BLANK
CAIE C," "
CAIN C,11
POPJ P,
JRST .+2 ;SKIP INTO NXCH
NXCH: ILDB C,T ;FETCH NEXT CHARACTER
HLL C,CTTAB(C) ;GET FLAGS FROM CTTAB
TRNE C,100
HRL C,CTTAB-100(C)
TLNE C,F.SPTB ;SPACE OR TAB?
JRST NXCH ;YES. IGNORE
POPJ P,
NXCHD: ILDB C,T
NXCHD2: HLL C,CTTAB(C)
TRNE C,100
HRL C,CTTAB-100(C)
POPJ P,
;GET NEXT CHAR, BUT CHECK FOR ILLEGAL CHARS (CHARS THAT COULD ONLY BE IN A STRING)
NXCHK: PUSHJ P,NXCH
TLNE C,F.STR
FAIL <? ILLEGAL CHARACTER>
POPJ P,
;SCAN INITIAL LETTER, LETTER IS PLACED LEFT
;JUSTIFIED IN A, 7-BIT ASCII.
SCNLT1: HRRZ A,C
ROT A,-7
JRST NXCH
;SCAN SECOND LETTER, NON-SKIP RETURN IF NOT LETTER.
;MAKE 7-BIT LETTER LEFT JUST IN A
;INTO 6-BIT. THAN PUT 6-BIT CURRENT LETTER IN A.
SCNLT2: TLNN C,F.LETT
POPJ P,
SCN2: TLNN A,400000 ;ENTER HERE TO PROCESS NON-LETTER CHARS
TLZA A,200000
TLO A,200000
LSH A,1
MOVE X1,[POINT 6,A,5]
JRST SCNLTN
;ENTER HERE TO SCAN SECOND CHAR EVEN IF BOTH ARE NOT LETTERS.
;SCAN THIRD LETTER, NON-SKIP IF NOT LETTER.
;PUT 6-BIT LETTER TO 3RD 6-BIT FIELD IN A.
SCNLT3: TLNN C,F.LETT
POPJ P,
SCN3: MOVE X1,[POINT 6,A,11]
;NOW PUT 6-BIT LETTER INTO A, ADJUSTING LOWER CASE, INCREMENTING POINTER.
SCNLTN: TLNN C,F.LCAS
TRC C,40
IDPB C,X1
AOS (P)
JRST NXCH
;THIS ROUTINE IS USED AT RUNTIME BY THE READ# STATEMENTS.
;DELAWY SKIPS THROUGH DELIMITERS AND STOPS ON THE FIRST
;NON-TAB, NON-SPACE, NON-COMMA.
DELAWY: LDB C,T
JUMPE C,.-1
PUSHJ P,NXCHD2
TLNN C,F.COMA+F.SPTB
POPJ P,
PUSHJ P,NXCH
JRST .-3
;THIS ROUTINE UNPACKS THE SIXBIT CHARACTERS IN AC C INTO
;ASCIZ IN ACS T AND T1.
;SCRATCH ACS ARE X1, X2, A, AND B.
;AC C IS SET UP AT THE END TO CONTAIN THE ADDRESS T.
UNPACK: SETZB T,T1 ;BE SURE OF TRAILING NULLS.
MOVE X1,[POINT 6,C,]
MOVE X2,[POINT 7,T,]
MOVEI B,6
UNPCK1: ILDB A,X1
JUMPE A,UNPCK2
ADDI A,40
IDPB A,X2
SOJG B,UNPCK1
UNPCK2: MOVEI C,T
POPJ P,
;QUOTE SCAN AND TEST
;CALL WITH PATTERN ADDRS IN X1
;SKIP IF EQUAL. C,T UPDATED TO LAST CHAR SCANNED.
QST: HRLI X1,440700 ;MAKE BYTE PNTR TO PATTERN
QST1: ILDB X2,X1 ;GET PATTERN CHAR
JUMPE X2,CPOPJ1 ;DONE ON NULL
SUBI X2,(C)
JUMPE X2,.+4 ;DO CHARACTERS MATCH?
TLNE C,F.LCAS ;NO. LOWER CASE LETTER?
CAME X2,[ EXP -40] ;YES. SAME LETTER OF ALPHABET?
JRST QST2 ;NO. MATCH FAILS
PUSHJ P,NXCH
JRST QST1
QST2: ILDB X2,X1 ;ON FAIL
JUMPN X2,.-1 ;SKIP TO NULL
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)
;QUOTE SCAN UNTIL FAIL.
;CALL WITH INLINE PATTERN.
QSAX: POP P,X1
PUSHJ P,QST
JRST 1(X1)
JRST 1(X1)
;QUOTE SCAN WITH ANSWER
;CALL WITH INLINE PATTERN
;SKIP ON SUCCESS ;ON FAIL, RETURN WITH C,T RESTORED
QSA: POP P,X1 ;GET PATTERN ADDRESS
PUSH P,C ;SAVE C,T
PUSH P,T
PUSHJ P,QST ;SAVE STRING
JRST .+2
JRST QSA1 ;MATCH
POP P,T ;NO MATCH. BACK UP
POP P,C
JRST 1(X1)
QSA1: POP P,X2
POP P,X2
JRST 2(X1)
;ROUTINE TO READ NEXT INTEGER FROM SCANNED LINE
;CALL: MOVE T,POINTER TO FIRST CHAR
; PUSHJ P,GETNUM
; ... FAIL RETURN
; ... SUCCESS RETURN, INTEGER IN N
GETNU: TDZA X1,X1 ;GET A NUMBER OF ANY LENGTH.
GETNUM: MOVEI X1,5 ;GET A NUMBER OF AT MOST 5 DIGS
MOVE X2,[PUSHJ P,NXCH];[205]IGNORE BLANKS
JRST GNNOB ;[205]GET NUMBER NO BLANKS
GTNUMB: MOVEI X1,5 ;[205]ALWAYS A LINE NUMBER
MOVE X2,[PUSHJ P,NXCHS];[205]AND KEEP SPACING
GNNOB: TLNN C,F.DIG ;[205]NUMERAL?
POPJ P, ;NO. FAIL RETURN
MOVEI N,-60(C) ;YES. ACCUMULATE FIRST DIGIT
GETN1: MOVE G,T ;SAVE PNTR FOR USE BY INSERT
XCT X2 ;[205]USE PROPER PROCEDURE TO GET NEXT CHAR
SOJE X1,CPOPJ1 ;EXIT IF FIVE DIGITS ALREADY
TLNN C,F.DIG ;NUMERAL?
JRST CPOPJ1 ;NO. RETURN.
IMULI N,^D10 ;YES. ACCUMULATE NUMBER
ADDI N,-60(C)
JRST GETN1 ;GO FOR MORE
;ROUTINES TO GENERATE CODE FOR THE CHANNEL SPECIFIER.
GETCN0: PUSHJ P,FORMLN
PUSHJ P,EIRGNP
MOVE D,[PUSHJ P,IFIX]
PUSHJ P,BUILDI
MOVSI D,(CAILE N,)
PUSHJ P,BUILDI
MOVE D,[CAILE N,9]
PUSHJ P,BUILDI
MOVE D,[JRST CNER1]
JRST BUILDI
GETCNA: PUSHJ P,NXCH
GETCN2: PUSHJ P,GETCN0
MOVE D,[MOVE LP,N]
JRST BUILDI
;ROUTINE TO READ A LINE INTO LINB0
;CALL: PUSHJ P,INLINE
INLINE: PUSH P,X1
SETZB X1,T1
SKIPE IFIFG
SKIPA T,LINPT(LP)
MOVE T,LINPT
JRST INLI1A
INLI1: ILDB C,TYI+1 ;GET CHAR
JRST INLB
INLA: SOSGE @INCNT-1(LP)
JRST DSKIN
ILDB C,@INPT-1(LP)
INLB: CAIE C,15 ;CR??
CAIN C,0
SOJA T1,INLI1A
SKIPE COMTIM ;[157]
JRST INLB0 ;[157]
CAIE C,21 ;IGNORE XON,XOFF
CAIN C,23
SOJA T1,INLI1A
INLB0: CAIG C,14 ;[157]LINE TERMINATOR?
CAIGE C,12
JRST .+2
JRST INLI2 ;YES. GO FINISH UP
CAIG T1,^D142 ;ROOM FOR CHAR+1 MORE?
JRST INLB1 ;YES.
SKIPE IFIFG ;DISK?
JRST INERR ;YES, ERROR EXIT.
MOVEI T,INERR1 ;NO, ERROR EXIT.
JRST ERRMSG
INLB1: IDPB C,T ;STORE CHAR
INLI1A: SKIPE IFIFG
AOJA T1,INLA
SOSLE TYI+2 ;MORE INPUT?
AOJA T1,INLI1 ;YES. BUMP COUNT AND GO GET MORE
INPUT
STATZ 20000
JRST [SKIPLE COMTIM ;[226] EXECUTING?
JRST EOFFL ;[226] YES--END WITH EOF ERROR
SKIPN CHAFLG
JRST BASIC
JRST RUNNH]
STATO 740000
AOJA T1,INLI1
SKIPE IFIFG
SETZM ACTBL-1(LP)
MOVEI T,INLSYS
JRST ERRMSG
INLSYS: ASCIZ /
? SYSTEM ERROR/
INLI2: MOVEI C,15 ;DONE. PUT CR IN BFR.
IDPB C,T
POP P,X1
RESCAN: SKIPN IFIFG
SKIPA T,LINPT
MOVE T,LINPT(LP)
SKIPE IFIFG
JRST INLI8
SETZM HPOS ;CARRIAGE POSITION := LFT MRGN
JRST NXCH ;GET FIRST CHAR AND RETURN
INLI8: SETZM HPOS(LP)
JRST NXCH
;ROUTINE TO START READING NEXT LINE OF PROGRAM
NXLINE: MOVE T,FLLIN
ADDI T,(L)
MOVE T,(T)
MOVS D,T ;SAVE LINE START
HRLI T,440700
MOVE G,FLREF ;SETUP REFROL REFERENCE.
ADDI G,(L)
JRST NXCH
DSKIN: DPB LP,[POINT 4,INDSK,12] ;DISK INPUT
XCT INDSK
DPB LP,[POINT 4,STADSK,12]
XCT STADSK
JRST [HRRZ T,-2(P)
CAIE T,EOF32
JRST EOFFAL
JRST EOF31]
DPB LP,[POINT 4,STODSK,12]
XCT STODSK
JRST INLA
SETZM ACTBL-1(LP)
MOVEI T,INLSYS
JRST ERRMSG
;PRINTING SUBROUTINES
;PRINT TO QUOTE CHAR
;CALL: MOVE T,<ADDRS OF MSG>
; MOVE D,<QUOTE CHAR>
; PUSHJ P,PRINT
;CALL: MOVE T,<ADDRS OF MSG>
; MOVE D,<QUOTE CHAR>
; PUSHJ P,PRINT
;ALTERNATE CALL: PRINT1, IF BYTE PNTR IN T.
PRINT: HRLI T,440700
PRINT1: ILDB C,T
CAMN C,D
POPJ P,
PUSHJ P,OUCH ;OUTPUT THE CHAR
JRST PRINT1
OUCH0: PUSH P,C
AOS HPOS(LP)
MOVE C,MARGIN(LP)
SKIPGE QUOTBL(LP) ;QUOTE MODE?
JRST OUCH4 ;YES.
CAML C,HPOS(LP) ;NO.
JRST OUCH3
PUSHJ P,PCRLF
JUMPN LP,.+2
OUTPUT
JRST OUCH5
OUCH4: CAML C,HPOS(LP)
JRST .+3
POP P,C
JRST PTXER2
OUCH3: SOS HPOS(LP)
OUCH5: POP P,C
OUCH: SKIPE ODF ;DISK?
JRST DSKOT ;YES.
SKIPLE TYO+2 ;NO.
JRST OUCH1
OUTPUT
MOVEM N,TEMLOC
GETSTS 0,N
TRNE N,740000
JRST OUTERR
MOVE N,TEMLOC
OUCH1: SOS TYO+2
IDPB C,TYO+1
AOS HPOS
POPJ P,
DSKOT: SKIPG @OUTCNT-1(LP)
JRST DOS
SOS @OUTCNT-1(LP)
IDPB C,@OUTPT-1(LP)
AOS HPOS(LP)
POPJ P,
DOS: DPB LP,[POINT 4,OUTTDS,12]
XCT OUTTDS
JRST DSKOT
SETZM ACTBL-1(LP)
DPB LP,[POINT 4,GTSTS,12]
XCT GTSTS
JRST OUTERR
;ROUTINE TO PRINT SIXBIT CHARACTERS IN ACCUM "T".
;IGNORES BLANKS.
PRNSIX: MOVE T1,[POINT 6,T]
ILDB C,T1
JUMPE C,PRNS1 ;SKIP A BLANK
ADDI C,40
PUSHJ P,OUCH
PRNS1: TLNE T1,770000 ;ALL SIX PRINTED?
JRST PRNSIX+1
POPJ P,
;UTILITY ROUTINE TO PRINT OUT "DEV:FILENM.EXT".
;FOR USE BY VARIOUS ERROR MESSAGES.
;DEV IS IN SAVE1, FILENM IN FILDIR, AND EXT IN FILDIR+1.
;IF LH(SAVE1)=0, DEV IS NOT PRINTED. DSK: AND .BAS ARE
;OMITTED.
PRNNAM: PUSH P,C
PUSH P,T
PUSH P,ODF
SETZM ODF
HLRZ T,SAVE1
JUMPE T,PRNAM1
CAIN T,<SIXBIT / DSK/>
JRST PRNAM1
MOVE T,SAVE1
PUSHJ P,PRNSIX
MOVSI T,320000
PUSHJ P,PRNSIX
PRNAM1: MOVE T,FILDIR
PUSHJ P,PRNSIX
HLRZ T,FILDIR+1
CAIN T,<SIXBIT / BAS/>
JRST PRNAM2
TLO T,16
PUSHJ P,PRNSIX
PRNAM2: POP P,ODF
POP P,T
POP P,C
POPJ P,
;SPECIAL DECIMAL PRINT ROUTINE. PRINTS X1,X2 AS DECIMAL NUMBERS
;SEPARATED BY THE CHARACTER IN ACCUM "A".
;IF X1 OR X2 ARE ZERO, THEY PRINT AS "00".
PRDE2: MOVE T,X1
PUSHJ P,PRDE1
MOVE C,A
PRDE2A: PUSHJ P,OUCH
MOVE T,X2
MOVEI A,177
PRDE1: MOVEI C,"0" ;A ONE DIGIT NUMBER?
CAIG T,^D9
PUSHJ P,OUCH ;YES. PUT OUT LEADING ZERO.
JRST PRTNUM
;SPECIAL RUNTIME PRINTER
RTIME: PUSHJ P,INLMES
ASCIZ /
TIME: /
SETZ X1, ;SET UP AC FOR RUNTIM.
RUNTIM X1, ;GET TIME NOW.
SUB X1,MTIME ;GET ELAPSED TIME.
IDIVI X1,^D10 ;REMOVE THOUSANDTHS.
IDIVI X1,^D100 ;SECS TO X1, TENTHS AND HUNDREDS TO X2.
MOVE T,X1 ;OUTPUT THE
PUSHJ P,PRTNUM ;SECONDS.
MOVEI C,"." ;OUTPUT ., THE TENTHS,
PUSHJ P,PRDE2A ;AND THE HUNDREDTHS.
PUSHJ P,INLMES
ASCIZ / SECS.
/
SETZM MTIME
OUTPUT
POPJ P,
;NUMBER PRINTER (PRINTS INTEGER IN T)
PRTNUX: MOVEI X1,3
SKIPE STRFCN
JRST PRTNX4
JRST PRTNX3
PRTNX1: MOVEI X1,4(B) ;CHECK ROOM FOR INT. OF THIS SIZE " "
SKIPN STRFCN
PRTNX3: PUSHJ P,CHROOM
PRTNX4: PUSHJ P,PSIGN
PRTNX2: IDIVI T,^D10
JUMPE T,PRTN0
PUSH P,T1
PUSHJ P,.-3
POP P,T1
PRTN0: MOVEI C,60(T1)
AOS NUMCOT
SKIPE STRFCN
JRST DPBSTR
JRST OUCH0
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
;OCTAL NUMBER PRINTER.
PRTOCT: IDIVI T,10
JUMPE T,PRTOC1
PUSH P,T1
PUSHJ P,PRTOCT
POP P,T1
PRTOC1: MOVEI C,60(T1)
AOS NUMCOT
JRST OUCH
;ROUTINE USED BY OUTNUM FOR STRB.
DPBSTR: EXCH T,STRPTR
IDPB C,T
EXCH T,STRPTR
SOS STRCTR
POPJ P,
PSIGN: MOVEI C," " ;PRINT "SIGN" (BLANK OR MINUS)
JUMPL N,PSIGN2
SKIPE STRFCN
POPJ P,
JRST OUCH0
PSIGN2: SKIPE STRFCN
JRST PSIGN4
SKIPL QUOTBL(LP)
JRST PSIGN3
MOVEI C," "
PUSHJ P,OUCH0
PSIGN3: MOVEI C,"-"
JRST OUCH0
PSIGN4: MOVEI C,"-"
JRST DPBSTR
;MESSAGE PRINTER
INLMES: PUSHJ P,TTYIN
INLME1: SETZM HPOS
EXCH T,(P) ;GET MSG ADR AND SAVE T.
PUSH P,C
PUSH P,ODF
SETZM ODF
MOVEI D,0 ;END ON NULL
PUSHJ P,PRINT ;PRINT THE MESSAGE
POP P,ODF
POP P,C
EXCH T,(P)
SETZM HPOS
JRST CPOPJ1 ;RTN AFTER MSG.
SUBTTL CORE COMPRESSION AND EXPANSION
;PANIC - ROUTINE TO COMPRESS CORE
PANIC: PUSHJ P,PRESS ;COMPRESS MEMORY
MOVE X2,TOPSTG ;IS THERE ROOM BETWEEN STODGY AND
MOVE X1,FLOOR+1(X2) ;MOVEABLE ONES?
SUB X1,CEIL(X2)
CAML X1,E ;ENOUGH ROOM?
POPJ P,
MOVE X1,.JBREL ;EXPAND BY 1K
ADDI X1,2000
CORE X1,
JRST [MOVEI T,PANIC1
JRST ERRMSG] ;CANT
JRST PANIC ;OK. GO MOVE ROLLS
PANIC1: ASCIZ /
? OUT OF ROOM/
PRESS: PUSH P,G ;SAVE AC
PUSH P,A
SKIPN PAKFLA ;ARE LINES PACKED?
JRST PRESS5 ;YES
SETZM PAKFLA
MOVE X1,FLTXT ;LOOK FOR EMPTY SPACE
PRESS2: CAML X1,CETXT ;THROUGH LOOKING?
JRST PRESS5
SKIPE (X1) ;A FREE WORD?
AOJA X1,PRESS2 ;NO
MOVEI X2,1(X1) ;YES
PRESS3: CAML X2,CETXT
JRST PRESS4 ;FREE TO END
SKIPN (X2)
AOJA X2,PRESS3 ;LOOK FOR NON-FREE WORD
SUB X1,X2 ;X1 :=-LNG OF MOVE
MOVE A,FLLIN
PRES3A: CAML A,CELIN ;MOVE DOWN THE REFERENCES
JRST PRES3B ;IN THE LINE ROLL.
HRRZ G,(A)
CAML G,X2
ADDM X1,(A)
AOJA A,PRES3A
PRES3B: MOVE G,CETXT ;MOVE DOWN THE TEXT ROLL.
ADD G,X1
MOVEM G,CETXT
ADD X1,X2
HRL X2,X1
MOVSS X2
BLT X2,-1(G)
JRST PRESS2
PRESS4: MOVEM X1,CETXT
;ROUTINE TO MOVE ROLLS UP
PRESS5: MOVEI G,ROLTOP ;HIGHEST MOVABLE ROLL
MOVE X1,.JBREL ;X1 IS PREVIOUS FLOOR
;NOTE: TOP WORD OF USR CORE IS LOST
PRESS6: MOVE X2,CEIL(G) ;GET OLD CEIL AND FLOOR
MOVE A,FLOOR(G)
SUBI X2,1 ;SET UP X2 FOR POP LOOP
ORCMI X2,777777
MOVEM X1,CEIL(G) ;NEW CEILING
PRESS7: CAILE A,(X2) ;DONE?
JRST PRESS8
POP X2,-1(X1) ;MOVE ONE WORD
SOJA X1,PRESS7
PRESS8: MOVEM X1,FLOOR(G) ;NEW FLOOR
SOS G ;GO TO NEXT LOWER ROLL
CAMLE G,TOPSTG ;IS THIS ROLL MOVEABLE?
JRST PRESS6 ;YES. GO PRESS IT.
POP P,A
PRESS9: POP P,G ;RESTORE G
POPJ P, ;RETURN
;UTILITY ROUTINE TO SET UP VRFBOT AND VRFTOP.
SETCOR: PUSH P,X2
SETZM VRFBOT
SKIPN SRTDBA
JRST SETCO3
PUSH P,T1
PUSH P,T
PUSH P,A
PUSH P,C
SETCO1: MOVE X2,VARFRE
MOVEI T1,^D200(X2)
MOVEI T,^D200
SETZ A,
PUSHJ P,VSUB1
CAMG T1,.JBREL
JRST SETCO2
PUSHJ P,VPANIC
JRST SETCO1
SETCO2: MOVEM T1,VRFBOT
MOVEM T1,VRFBTB
POP P,C
POP P,A
POP P,T
POP P,T1
JRST SETCO5
SETCO3: MOVE X2,VARFRE
ADDI X2,^D200
CAMG X2,.JBREL
JRST .+3
PUSHJ P,VPANIC
JRST SETCO3
MOVEM X2,VRFBOT
MOVEM X2,VRFBTB
SETCO5: HRRZ X2,.JBREL
MOVEM X2,VRFTOP
POP P,X2
POPJ P,
;THIS ROUTINE OBTAINS SPACE IN THE "FREE CORE AREA" FOR REAL STRINGS,
;APPEND BLOCKS, THE TEMPORARY STRINGS WHICH ARE THE RESULTS OF
;STRING FUNCTIONS, AND BUFFERS FOR DATA FILES. IT HAS SIX ENTRY POINTS:
;VCHCKC AND VCHCKW FOR REAL STRINGS, VCHTSC AND VCHTSW FOR TEMPORARY
;STRINGS, VCHAPP FOR APPEND BLOCKS, AND VCHBUF FOR DATA FILES.
;STRINGS HAVE TWO ENTRY POINTS SO THAT THEY MAY REQUEST SPACE IN UNITS
;OF EITHER CHARACTERS OR WORDS. THE REQUEST IS IN AC T. NO OTHER
;AC'S ARE DESTROYED. THE LOCATION OF THE LOWER BOUND OF THE OBTAINED
;SPACE IS RETURNED IN AC T.
LITLEN=^D27
VCHCKC: PUSH P,T1 ;ENTRY POINT--REAL STRINGS.
JUMPE T,VCHCK1
ADDI T,4
IDIVI T,5
JRST VCHCK2
VCHCKW: PUSH P,T1 ;ENTRY POINT--REAL STRINGS.
JUMPN T,.+2
VCHCK1: MOVEI T,LITLEN
VCHCK2: MOVE T1,VARFRE
ADDI T1,(T)
SKIPN VRFBOT
JRST VCHCK5
CAMG T1,VRFBTB
JRST VCHCK7
JRST VCHCK6
VCHCK5: CAMG T1,.JBREL
JRST VCHCK7
VCHCK6: PUSHJ P,VPANIC
JRST VCHCK2
VCHCK7: SKIPE SRTDBA ;ANY BUFFERS?
JRST VCHCK3 ;YES.
MOVE T,VARFRE ;NO.
MOVEM T1,VARFRE
JRST VOUT
VCHCK3: PUSH P,X2
PUSH P,X1
PUSH P,A
PUSH P,C
VCHCK4: MOVE X2,VARFRE ;GET OUT OF THE WAY OF THE BUFFERS,
MOVEI T1,(X2)
ADDI T1,(T)
SETZ A, ;BY MOVING UP.
PUSHJ P,VSUB1
SKIPN VRFBOT
JRST VCHCK8
CAMG T1,VRFBTB
JRST VCHCK0
JRST VCHCK9
VCHCK8: CAMG T1,.JBREL
JRST VCHCK0
VCHCK9: PUSHJ P,VPANIC
JRST VCHCK4
VCHCK0: MOVEM T1,VARFRE
VOUT2: MOVEI T,(X2)
VOUT0: POP P,C
POP P,A
POP P,X1
VOUT1: POP P,X2
VOUT: POP P,T1
POPJ P,
VCHAPP: PUSH P,T1 ;ENTRY POINT--APPEND BLOCKS.
VCHAP2: MOVE T1,VRFBOT
ADDI T1,^D47
CAMG T1,VRFTOP
JRST .+3
PUSHJ P,VPANIC
JRST VCHAP2
SKIPE SRTDBA ;ANY BUFFERS?
JRST VCHAP1 ;YES.
MOVE T,VRFBOT ;NO.
MOVEM T1,VRFBOT
JRST VOUT ;NO.
VCHAP1: PUSH P,X2
PUSH P,X1
PUSH P,A
PUSH P,C
VCHAP3: MOVE X2,VRFBOT
MOVEI T1,(X2)
ADDI T1,^D47
HRRZI T,^D47
SETZ A,
PUSHJ P,VSUB1 ;GET OUT OF THEIR WAY BY MOVING UP.
CAMG T1,VRFTOP
JRST .+3
PUSHJ P,VPANIC
JRST VCHAP3
MOVEM T1,VRFBOT
JRST VOUT2
VCHBUF: PUSH P,T1 ;ENTRY POINT--DATA FILE BUFFERS.
PUSH P,X2
VCHBF4: SKIPN T1,VRFBOT ;LOWER BOUND IS VRFBOT, IF IT
MOVE T1,VARFRE ;EXISTS, OTHERWISE IT IS VARFRE.
MOVEI T,406
ADDI T1,(T)
MOVE X2,VRFTOP
SKIPN VRFBOT
MOVE X2,.JBREL
CAIG T1,(X2)
JRST .+3
PUSHJ P,VPANIC
JRST VCHBF4
SKIPE SRTDBA ;ANY BUFFERS?
JRST VCHBF2 ;YES.
SKIPE T,VRFBOT ;NO.
JRST VCHBF3
MOVE T,VARFRE
MOVEM T1,VARFRE
JRST VOUT1
VCHBF3: MOVEM T1,VRFBOT
JRST VOUT1
VCHBF2: PUSH P,X1
PUSH P,A
PUSH P,C
VCHBF5: SETZ A,
SKIPN T1,VRFBOT
MOVE T1,VARFRE
MOVEI X2,(T1)
ADDI T1,(T)
PUSHJ P,VSUB1 ;GET OUT OF THEIR WAY BY MOVING UP.
MOVE X1,VRFTOP
SKIPN VRFBOT
MOVE X1,.JBREL
CAIG T1,(X1)
JRST VOUT2 ;[163]
PUSHJ P,VPANIC
JRST VCHBF5 ;[163]
VCHTSC: PUSH P,T1 ;ENTRY POINT--TEMP. STRINGS.
JUMPE T,VCHTS1
ADDI T,4
IDIVI T,5
JRST VCHTS2
VCHTSW: PUSH P,T1
JUMPN T,.+2
VCHTS1: MOVEI T,LITLEN
VCHTS2: MOVE T1,VRFTOP
ADDI T1,1
SUBI T1,(T)
CAML T1,VRFBOT
JRST .+3
PUSHJ P,VPANIC
JRST VCHTS2
SKIPE SRTDBA ;ANY BUFFERS?
JRST VCHTS3 ;YES.
MOVEI T,(T1) ;NO.
SUBI T1,1
MOVEM T1,VRFTOP
JRST VOUT
VCHTS3: PUSH P,X2
PUSH P,X1
PUSH P,A
PUSH P,C
VCHTS4: MOVE T1,VRFTOP
ADDI T1,1
HRRZI X2,(T1)
SUBI X2,(T)
MOVE A,T
SETZ T,
PUSHJ P,VSUB1 ;GET OUT OF THE WAY OF THE BUFFERS BY MOVING DOWN.
MOVE T,A
CAML X2,VRFBOT
JRST .+3
PUSHJ P,VPANIC
JRST VCHTS4
MOVEI X1,-1(X2)
MOVEM X1,VRFTOP
JRST VOUT2
;SUBROUTINE TO GET OUT OF THE WAY OF THE BUFFERS.
VSUB1: SETZ C, ;X2 HAS LOWER BOUND.
VSUB11: HRRZ X1,SRTDBA(C) ;T1 HAS UPPER BOUND.
JUMPE X1,CPOPJ ;T OR A HAS LENGTH, DEPENDING ON
CAIG X1,(X2) ;DIRECTION OF TRAVEL.
JRST VSUB12
HLRZ X1,SRTDBA(C)
CAIL X1,(T1)
JRST VSUB12
JUMPN A,VSUB13 ;GOING DOWN OR UP?
HRRZ T1,SRTDBA(C) ;GOING UP.
HRRZI X2,(T1)
ADDI T1,(T)
JRST VSUB12
VSUB13: HLRZ T1,SRTDBA(C) ;GOING DOWN.
HRRZI X2,T1
SUBI X2,(A)
VSUB12: AOJ C,.+1
CAIGE C,9
JRST VSUB11
POPJ P,
VPANIC: PUSH P,R
PUSH P,X1
PUSH P,X2
PUSH P,G
PUSH P,A
PUSH P,C
PUSH P,E
PUSH P,T1
PUSH P,T
SKIPN VPAKFL
PUSHJ P,VPRESS
VPAN3: MOVE G,VRFBTB ;[225]
SKIPN VRFBOT
MOVE G,.JBREL
MOVE X2,VARFRE
MOVEI T,^D200 ;[225] USE SAME VALUE AS SETCOR
SETZ A,
MOVEI T1,^D200(X2) ;[225] SINCE SETCOR SETS VRFBTB
PUSHJ P,VSUB1
SOJ T1,.+1
CAIG T1,(G)
JRST [SKIPN X2,VRFBOT
JRST VPAN92
CAMN X2,VRFBTB
JRST VPAN30
JRST VPN21]
SKIPE X2,VRFBOT
CAME X2,VRFBTB
JRST VPAN32
CAML T1,VRFTOP ;[233] ENCROACHING ON TEMP STRINGS?
JRST VPAN32
VPAN30: ADDI T1,1
MOVEM T1,VRFBTB
MOVEM T1,VRFBOT
JRST VPN2
VPAN32: PUSH P,T1
PUSHJ P,VPAN16
SKIPE VRFBOT
JRST VPAN33
POP P,T1
CAMLE T1,.JBREL
JRST VPAN32
JRST VPAN92
VPAN33: POP P,T1 ;[233]
SKIPN A,APPLST
JRST VPAN30
SETZ E,
VPAN34: MOVE C,APPLST(A)
CAILE C,(T1)
JRST .+3
AOJ E,.+1
SOJG A,VPAN34
JUMPE E,VPAN30
MOVE X2,VRFBOT
MOVEI T,^D47
SETZ A,
MOVEI T1,^D47(X2)
PUSHJ P,VSUB1
MOVEI X2,(T1)
SOJG E,.-3
SUBI T1,1
VPAN35: CAMG T1,VRFTOP
JRST VPAN36
PUSH P,T1
PUSHJ P,VPAN16
POP P,T1
JRST VPAN35
VPAN36: MOVEI E,1
ADDI T1,1
MOVEM T1,VRFBOT
VPAN37: SUBI T1,^D47
HRL T1,APPLST(E)
PUSH P,T1
PUSH P,T
MOVEI T,^D46(T1)
BLT T1,(T)
POP P,T
POP P,T1
MOVE C,MASAPP
SUBI C,MASAPP
JUMPE C,VPAN38
HRRZ A,MASAPP(C)
CAMN A,APPLST(E)
HRRM T1,MASAPP(C)
SOJG C,.-3
VPAN38: AOJ E,.+1
CAMLE E,APPLST
JRST VPAN39
MOVEI T1,(T1)
MOVEI X2,-^D47(T1)
SETZ T,
MOVEI A,^D47
PUSHJ P,VSUB1
JRST VPAN37
VPAN39: MOVEM T1,VRFBTB
;**; [233] @ VPAN39 + 1L, ADDED 29 LINES, EGM, 24-JUL-78
JRST VPN2 ;[233] DONE WITH MOVING UP APP BLKS
VPN21: ADDI T1,1 ;[233] START OF APPEND BLOCK SPACE
CAMN T1,VRFBTB ;[233] ANY CHANGE?
JRST VPN2 ;[233] NO - NOTHING TO DO
MOVEM T1,VRFBTB ;[233] YES - SAVE NEW START ADDRESS
MOVE E,APPLST ;[233] ANY APPEND BLOCKS
JUMPE E,VPN25 ;[233] NO - END = START
VPN22: MOVEI X2,(T1) ;[233] LOWER ADDR OF NEW BLOCK
ADDI T1,^D47 ;[233] UPPER ADDR OF NEW BLOCK + 1
MOVEI T,^D47 ;[233] MOVING UP
SETZ A, ;[233] NOT DOWN
PUSHJ P,VSUB1 ;[233] SKIP PAST ANY BUFFERS
SUBI T1,^D47 ;[233] NEW APP BLK. START ADDR.
PUSH P,T1 ;[233] SAVE AROUND BLT
HRL T1,APPLST(E) ;[233] ADDR. OF CURRENT BLK.
MOVEI T,^D46(T1) ;[233] END OF NEW BLK.
BLT T1,(T) ;[233] MOVE 1 APPEND BLOCK DOWN
POP P,T1 ;[233] RESTORE NEW BLOCK PTR.
MOVE C,MASAPP ;[233] DETERMINE NUMBER OF MASTER
SUBI C,MASAPP ;[233] APPEND BLOCKS
JUMPE C,VPN24 ;[233] NONE - CONTINUE MOVE DOWN
VPN23: HRRZ A,MASAPP(C) ;[233] GET MASTER APP. BLK. KEY
CAMN A,APPLST(E) ;[233] DOES IT POINT TO MOVED APP. BLK.?
HRRM T1,MASAPP(C) ;[233] YES - POINT IT TO NEW ADDR.
SOJG C,VPN23 ;[233] CHECK ALL MASTER APP. BLKS.
VPN24: MOVEI T1,^D47(T1) ;[233] ADVANCE PAST NEW APP. BLK.
SOJG E,VPN22 ;[233] MOVE DOWN EACH EXISTING APP. BLK
VPN25: MOVEM T1,VRFBOT ;[233] WHEN DONE - MARK END OF BLKS.
VPN2: MOVEI R,^D10
MOVEI T,^D47
SETZ A,
MOVE X2,VRFBOT
MOVEI T1,^D47(X2)
PUSHJ P,VSUB1
MOVEI X2,(T1)
SOJG R,.-3
SUBI T1,1
VPN3: CAMG T1,VRFTOP
JRST VPAN92
PUSH P,T1
PUSHJ P,VPAN16
POP P,T1
JRST VPN3
VPAN16: MOVE X2,.JBREL ;GET MORE CORE AND MOVE UP TEMP STRS.
MOVE C,CORINC
ADDI C,(X2)
CORE C,
JRST [MOVEI T,PANIC1
JRST ERRMSG]
SKIPN VRFBOT
POPJ P,
MOVE C,VRFTOP
CAIE C,(X2)
JRST .+4
MOVE C,.JBREL
MOVEM C,VRFTOP
POPJ P,
PUSHJ P,VPRES1
MOVE X1,.JBREL
MOVEI T,10
VPAN41: HRRZ T1,SRTDBA(T)
JUMPN T1,VPAN42
SOJGE T,VPAN41
JRST VPAN43
VPAN42: MOVEI T1,-1(T1)
CAMLE T1,VRFTOP
JRST VPAN44
SETO T,
VPAN43: MOVE T1,VRFTOP
VPAN44: MOVEI R,(X1)
SUBI R,(X2)
SKIPN C,NUMMSP
JRST VPAN5
VPAN45: HRRZ E,MASAPP(C) ;UPDATE MASTER APP BLK.
CAILE E,(T1)
CAILE E,(X2)
JRST .+3
ADDI E,(R)
HRRM E,MASAPP(C)
SOJG C,VPAN45
VPAN5: SKIPN C,APPLST
JRST VPAN56
VPAN51: MOVE A,APPLST(C) ;UPDATE OTHER APP BLKS.
HRRZ E,(A)
HRRZI G,(A)
ADDI E,(G)
VPAN55: HRRZ A,(E)
CAILE A,(T1)
CAILE A,(X2)
JRST .+3
ADDI A,(R)
HRRM A,(E)
SOJ E,.+1
CAIE E,(G)
JRST VPAN55
SOJG C,VPAN51
VPAN56: HRLI T1,1(T1)
ADDI R,1(T1)
HRRI T1,(R)
PUSH P,T1
BLT T1,(X1)
POP P,T1
MOVEI X1,-1(T1)
JUMPL T,VPAN6
VPAN58: HLRZ X2,SRTDBA(T)
SUBI X2,1
CAMG X2,VRFTOP
JRST VPAN6
SOJL T,VPAN57
HRRZ T1,SRTDBA(T)
CAIN T1,1(X2)
JRST VPAN58
SOJA T1,VPAN44
VPAN57: MOVE T1,VRFTOP
JRST VPAN44
VPAN6: HRRZM X1,VRFTOP
POPJ P,
VPAN92: POP P,T
POP P,T1
POP P,E
POP P,C
POP P,A
POP P,G
POP P,X2
POP P,X1
POP P,R
POPJ P,
;PACK DOWN ROUTINE.
VPRESS: PUSH P,[Z VPR4]
VPRES1: MOVE A,MASAPP
SUBI A,MASAPP
MOVEM A,NUMMSP ;COUNT OF KEYS IN MASTER APPEND BLOCK.
SETZM NUMAPP ;COUNT OF KEYS IN ALL OTHER APP. BLKS.
SETZM APPLST ;COUNT OF OTHER APP. BLKS.
SKIPN A,VRFBOT
POPJ P,
SETZB G,E ;E IS INDEX FOR APPLST.
SKIPN SRTDBA ;BUFFERS IN THE WAY?
JRST VLOPF1 ;NO.
VLOOP: HLRZ C,SRTDBA+10(G) ;FIND THE APPEND BLKS, WHICH ARE
JUMPE C,VLOPFN
CAIL C,(A) ;BETWEEN VRFBTB AND VRFBOT.
JRST VLOPFN
HRRZ C,SRTDBA+10(G)
CAMG C,VRFBTB
JRST VLOPFN
PUSHJ P,VCHPBK ;A BUFFER IS IN THE APP BLK SPACE.
HLRZ A,SRTDBA+10(G)
CAMGE A,VRFBTB
JRST VLOOP4 ;NO APP BLKS. LEFT.
VLOPFN: SOJ G,.+1
CAML G,[777777777770]
JRST VLOOP
VLOPF1: MOVE C,VRFBTB ;POSSIBLY NO BUFFERS WERE SEEN.
PUSH P,[Z VLOOP4]
VCHPBK: SUBI A,^D47 ;CUT UP THIS KNOWN SPACE.
CAIGE A,(C)
POPJ P,
CAIL E,APPMAX ;[224] IS APPEND LIST FILLED UP?
JRST APPFUL ;[224] YES -- GIVE ERROR
MOVEM A,APPLST+1(E)
AOJ E,.+1
JRST VCHPBK
VLOOP4: MOVEM E,APPLST ;STORE COUNT OF APP BLKS.
SETZ A, ;FIND NO. OF KEYS.
JUMPE E,VLOOP5
MOVE X1,APPLST(E)
HRRZ X1,(X1) ;[225] GET COUNT OF STRING PTR$
ADDI A,(X1)
SOJG E,.-3
VLOOP5: MOVEM A,NUMAPP
POPJ P,
APPFUL: PUSHJ P,INLMES ;[224]TELL USER STATIC SPACE IS FULL
ASCIZ /
?OUT OF STATIC LIST SPACE/
JRST GOSR2 ;[224]GIVE LINE AND END EXECUTION
VPR4: MOVE G,SVRTOP ;SET UP LOWER BOUND.
SETZ C,
MOVEI E,10
SKIPN SRTDBA ;ANY BUFFERS?
JRST VPR00 ;NO.
VPR5: HLRZ A,SRTDBA(C)
CAIN G,(A) ;GET ABOVE THE BUFFERS.
JRST .+3
PUSHJ P,PAKBLK
JRST VPR00
HRRZ G,SRTDBA(C)
AOJ C,.+1
CAIG C,10
JRST VPR5
SETZM SRTDBA(E) ;ABOVE ALL THE BUFFERS, SO "ERASE" THEM.
SOJGE E,.-1
JRST VPR00
PAKBLK: JUMPE C,CPOPJ
PAKBL0: SETZ X1, ;SET UP SRTDBA SO THAT
SUBI E,(C) ;THE NEXT HIGHEST BUFFER
PAKBL1: MOVE X2,SRTDBA(C) ;IS IN THE FIRST LOCATION,
MOVEM X2,SRTDBA(X1) ;AND "ERASE" THE LOWER BUFFERS.
SETZM SRTDBA(C)
AOJ X1,.+1
AOJ C,.+1
SOJGE E,PAKBL1
CAILE X1,10
POPJ P,
SETZM SRTDBA(X1)
AOJA X1,.-3
VPR00: MOVEM G,VARFRE
VPR0: HRRZI X2,-1 ;THE LOWEST ADDRESS WILL GO INTO X1
MOVE A,FLVSP ;A POINTS TO EACH ENTRY ON THE ROLL.
SETZI X1, ;X1 WILL GET THE LOC OF NEXT LOWEST POINTER
VPR1: CAMN A,CEVSP ;STARTING TO SCAN SVRROL, OR STILL IN VSPROL?
MOVE A,SVRBOT
CAML A,SVRTOP
JRST VPR2 ;SEARCH FOR MINIMUM IS OVER.
HRRZ E,(A) ;GET POINTER ADDRESS.
JUMPE E,VPR11 ;NULL POINTER?
CAIL E,(G) ;HAVE WE MOVED THIS STRING ALREADY?
CAIG X2,(E) ;NO, IS IT A LOWER STRING ADDRESS?
VPR11: AOJA A,VPR1 ;NO. LOOK AT NEXT STRING.
MOVE X1,A ;WE HAVE FOUND A STRING WITH LOWER ADDRESS.
MOVE X2,E
AOJA A,VPR1
VPR2: JUMPE X1,VPR3 ;ANY MORE STRINGS TO MOVE?
HLRE E,(X1) ;CALCULATE WORD LENGTH..
JUMPN E,.+3 ;IS THIS A NULL STRING?
SETZM (X1) ;YES. IGNORE IT.
JRST VPR0
HRL G,(X1) ;GET THE OLD ADDRESS OF THIS STRING
MOVN E,E ;GET WORD LENGTH
ADDI E,4
PUSH P,G
IDIVI E,5
POP P,G
ADDI E,-1(G)
HRRZI X2,(G)
HRRZ C,(X1) ;[225] GET CURRENT ADDRESS OF STRING
CAMN X2,C ;[225] IS IT SAME AS NEW ONE?
JRST VPR28
SKIPN SRTDBA ;POSSIBLY BUFFERS IN THE WAY?
JRST VPR23 ;NO.
SETZ C,
VPR21: HLRZ X2,SRTDBA(C)
JUMPE X2,VPR22
CAILE X2,(E)
JRST VPR22
SUBI E,-1(G)
HRR G,SRTDBA(C)
ADDI E,-1(G)
AOJ C,.+1
CAIG C,10
JRST VPR21
MOVEI E,10
SETZM SRTDBA(E)
SOJGE E,.-1
JRST VPR23
VPR22: JUMPE C,VPR23
PUSH P,E
PUSH P,X1
MOVEI E,10
PUSHJ P,PAKBL0 ;WIND DOWN THE BUFFERS.
POP P,X1
POP P,E
VPR23: HRRZ X2,(X1) ;GET THE OLD STRING ADDRESS
HRRM G,(X1) ;STORE THE NEW ADDRESS IN THE MAIN KEY.
PUSH P,G
BLT G,(E) ;MOVE THE STRING DOWN
POP P,G
SKIPN X1,NUMMSP ;UPDATE MASTER APP BLK?
JRST VPR25 ;NO NEED.
MOVE X1,MASAPP ;[233]GET NUMBER OF MASAPP KEYS
SUBI X1,MASAPP ;[233]SINCE NUMBER CAN CHANGE
VPR24: HRRZ A,MASAPP(X1) ;POSSIBLY.
CAIE A,(X2)
JRST .+3
HRRM G,MASAPP(X1)
SOS NUMMSP
SOJG X1,VPR24
VPR25: SKIPN NUMAPP ;UPDATE OTHER APP BLKS?
JRST VPR28 ;NO NEED.
PUSH P,E ;POSSIBLY.
MOVE X1,APPLST
VPR26: HRRZ A,APPLST(X1)
HRRZ C,(A)
ADDI C,(A)
VPR27: HRRZ E,(C)
CAIE E,(X2)
JRST .+3
HRRM G,(C)
SOS NUMAPP
SOJ C,.+1
CAILE C,(A)
JRST VPR27
SOJG X1,VPR26
POP P,E
VPR28: AOS G,E ;LOOK FOR A HIGHER ADDRESS NEXT TIME
MOVEM E,VARFRE
JRST VPR0
VPR3: PUSHJ P,BASORT ;RESTORE SRTDBA
SETOM VPAKFL ;STRINGS ARE TIGHTLY PACKED
POPJ P,
SUBTTL DECIMAL NUMBER EVALUATE/PRINT
;ROUTINE TO EVALUATE NUMBER
;T: PNTR TO FIRST CHAR, C: FIRST CHAR
;NON-SKIP IS FAIL RETURN
;RETURN NUMBER IN N
;N: ACCUM NBMR, B: SCA FAC, D: DIG CNT, USE FLGS IN LEFT OF F
EVANUM: SETZB N,B ;CLEAR ACS
MOVEI D,8
MOVEI F,(F) ;CLEAR LH OF F
TLNE C,F.PLUS ;SKIP +
JRST EVAN1
TLNN C,F.MINS ;CHECK FOR -
JRST EVAN2 ;NO
TLO F,F.MIN ;SET MINUS FLG
EVAN1: SKIPN IFIFG
JRST EV1
PUSHJ P,NXCHD
JRST .+2
EV1: PUSHJ P,NXCH
EVAN2: TLNN C,F.DIG ;DIGIT?
JRST EVAN3 ;NO
TLO F,F.NUM ;DIGIT SEEN FLAG
JUMPE N,EVAN2A ;DONT COUNT LEADING ZEROS
SOJG D,EVAN2A ;COUNT DIGIT, GO ACCUM IF OK
; REST OF DIGITS ARE INSIGNIFIGANT.
AOJA B,EVAN2B ;LEAD OR TRAIL 0, FUDGE SCA FAC
EVAN2A: IMULI N,^D10 ;ACCUMULATE DIGIT
ADDI N,-60(C)
EVAN2B: TLNE F,F.DOT ;DECIMAL SEEN?
SUBI B,1 ;YES. COUNT DOWN SCALE FACT
JRST EVAN1 ;GO TO NEXT CHAR
EVAN3: TLNN C,F.PER ;NOT DIGIT. DEC PNT?
JRST EVAN4 ;NO.
TLOE F,F.DOT ;YES, SET FLG & CHK ONLY ONE
POPJ P, ;2 DEC PNTS
JRST EVAN1
EVAN4: TLNN F,F.NUM ;DID WE SEE A DIGIT?
POPJ P, ;NO. WHAT A LOUSY NUMBER
MOVEI X1,"E"
CAIE X1,(C) ;EXPLICIT SCALE FACTOR?
JRST EVAN8 ;NO
SKIPN IFIFG
JRST EV2
PUSHJ P,NXCHD
JRST .+2
EV2: PUSHJ P,NXCH ;DO LOOK AHEAD
TLNE C,F.PLUS ;SCALE FACTOR SIGN
JRST EVAN5
TLNN C,F.MINS
JRST EVAN6
TLO F,F.MXP
EVAN5: SKIPN IFIFG
JRST EV3
PUSHJ P,NXCHD
JRST .+2
EV3: PUSHJ P,NXCH
EVAN6: TLNN C,F.DIG ;CHK FOR DIGIT
POPJ P,
MOVEI A,-60(C) ;SAVE FIRST EXPON DIGIT
SKIPN IFIFG
JRST EV4
PUSHJ P,NXCHD
JRST .+2
EV4: PUSHJ P,NXCH
TLNN C,F.DIG ;IS THERE A SECOND DIGIT
JRST EVAN7 ;NO
IMULI A,^D10 ;YES. ACCUMULATE IT
ADDI A,-60(C)
SKIPN IFIFG
JRST EV5
PUSHJ P,NXCHD
JRST .+2
EV5: PUSHJ P,NXCH ;DO LOOK AHEAD
EVAN7: TLNE F,F.MXP ;NEG EXPON?
MOVN A,A ;YES. NEGATE IT
ADD B,A ;ADD TO SCALE FACTOR
EVAN8: JUMPE N,CPOPJ1 ;IGNORE SCALE IF NUMBER IS 0
EVAN8A: MOVE X1,N ;)
IDIVI X1,^D10 ;)REMOVE ANY TRAILING ZEROS
JUMPN X2,EVAN8B ;) IN MANTISSA. (REASON:
MOVE N,X1 ;) SO THAT, E.G., .1,
AOJA B,EVAN8A ;) .10, .100, ..., ARE THE SAME)
EVAN8B: TLO N,233000 ;FLOAT N
FAD N,[0]
SETZM LIBFLG ;CLEAR OVER/UNDERFLOW FLAG.
EVAN8C: CAIGE B,^D15 ;SCALE UP IF .GE. 10^15
JRST EVAN8D
SUBI B,^D14 ;SUBTRACT 14 FROM SCALE FACTOR
FMPR N,D1E14 ;MULTIPLY BY 10^14
JRST EVAN8C ;GO LOOK AT SCALE AGAIN
EVAN8D: CAML B,[EXP -^D4] ;SCALE DOWN IF .LT. 10^-4
JRST EVAN8E
ADDI B,^D18 ;ADD 18 TO SCALE
FMPR N,D1EM18 ;MULTIPLY BY 10^-18
JRST EVAN8D ;GO LOOK AT SCALE AGAIN
EVAN8E: FMPR N,DECTAB(B) ;SCALE N
TLNE F,F.MIN ;MINUS?
MOVN N,N ;YES. NEGATE IT
SKIPE LIBFLG ;SKIP IF NO OVER/UNDERFLOW.
JRST CPOPJ
JRST CPOPJ1 ;SUCCESS RETURN, NUMBER IN N
;ROUTINE TO PRINT NUMBER
OUTSRF: SETOM STRFCN
JRST .+2
OUTNUM: SETZM STRFCN
MOVM T,N
JUMPE T,PRTNUX
PUSH P,E ;DO NOT CLOBBER E (FOR MATRIX)
MOVEI E,0 ;CHANGE IN EXPONENT
OUTN1A: CAMG T,D1E14 ;SCALE IF .GT. 10^14
JRST OUTN1B
ADDI E,^D18 ;ADD 18 TO SCALE
FMPR T,D1EM18 ;AND MULTIPLY BY 10^-18
JRST OUTN1A
OUTN1B: CAML T,D1EM4 ;SCALE IF .LT. 10^-4
JRST OUTN1C
SUBI E,^D14 ;SUBTRACT 14 FROM SCALE
FMPR T,D1E14 ;AND MULT BY 10^14
JRST OUTN1B ;GO SEE IF MORE SCALING
OUTN1C: MOVE A,T ;LOOK UP IN DEC ROLL
MOVEI R,DECROL
PUSHJ P,SEARCH
JFCL ;DONT CARE IF FOUND
CAME A,(B) ;FUDGE BY 1 IF EXACT MATCH
SUBI B,1
SUBI B,DECTAB ;FIND DIST FROM MIDDLE
JUMPN E,OUTN2 ;(NOT INTEGER IF WE SCALED)
CAIGE B,^D8 ;CHK 8 DIG INTEGER
CAIGE B,0
JRST OUTN2
CAML T,FIXCON ;IS THIS 2^26?
JRST OUTN1D ;YES, ITS 27 BIT INT.
MOVE X1,T
FAD X1,FIXCON ;INTEGER?
FSB X1,FIXCON
CAME X1,T
JRST OUTN2 ;NOT SUCH (LOST FRACTIONAL PART)
FAD T,FIXCON ;SUCH. FIX NUMBER
TLZ T,377400
OUTN1D: TLZ T,377000 ;(IN CASE 27-BIT INTEGER)
POP P,E ;RESTORE E
JRST PRTNX1
OUTN2: FDVR T,DECTAB(B) ;GET MANTISSA
FMPR T,DECTAB+5
MOVEM T,EXTFG ;SAVE FOR "EXACT" CHECK.
FADR T,FIXCON
TLZ T,377400 ;FIX
CAMGE T,INTTAB+6
JRST OUTN21
IDIVI T,^D10 ;ROUNDING MADE 7 DIGITS
ADDI B,1 ;MAKE IT 6 AGAIN
OUTN21: CAIL T,^D100000 ;ROUNDING MADE 5 DIGITS?
JRST OUTN22
IMULI T,^D10 ;YES. MAKE 6 AGAIN
SUBI B,1
OUTN22: ADDB B,E ;ADD TOGETHER TWO PARTS OF SCALE
AOJ E,
CAIG E,6
CAMG E,[OCT -6]
JRST OUTN3 ;TO OUTN3 FOR E<=-6 OR 6<E.
JUMPL E,OUTN23 ;TO OUTN23 FOR -6<E<0.
MOVEI X1,^D10 ;HERE FOR 0<=E<=6.
SKIPN STRFCN ;CHECK ROOM FOR A DEC NO. WITH NO EXP.
PUSHJ P,CHROOM
SETZ B, ;B IS A FLAG FOR DNPRNT. 0 MEANS NO EXP.
PUSHJ P,PSIGN
JUMPE E,OUTN25 ;FINISH
JRST OUTN27 ;UP.
OUTN23: MOVE T1,EXTFG ;[210]HERE FOR -6<E<0. FIND
MOVM E,E
PUSH P,T
IDIV T,INTTAB(E)
JUMPE T1,OUTN24
POP P,T
JRST OUTN3 ;NOT "EXACT".
OUTN24: POP P,T1 ;"EXACT".
MOVEI X1,^D10 ;CHECK ROOM FOR A DEC NO. WITH NO EXP.
SKIPN STRFCN
PUSHJ P,CHROOM
SETZ B, ;B IS DNPRNT FLAG. 0 MEANS NO EXP.
PUSHJ P,PSIGN
OUTN25: MOVEI C,"0" ;OUTPUT "0" AND ".".
SKIPN STRFCN
JRST .+3
PUSHJ P,DPBSTR
JRST .+2
PUSHJ P,OUCH0
PUSHJ P,DNPRN2
JUMPE E,OUTN27
OUTN26: MOVEI C,"0" ;OUTPUT LEADING 0'S AFTER ".".
SKIPN STRFCN
JRST .+3
PUSHJ P,DPBSTR
JRST .+2
PUSHJ P,OUCH0
SOJG E,OUTN26
OUTN27: PUSHJ P,DNPRNT ;OUTPUT NO.
POP P,E ;RESTORE E.
POPJ P, ;EXIT.
OUTN3: MOVEI E,1 ;HERE FOR NOS. WHICH NEED EXPONENTS.
MOVEI X1,^D14 ;CHECK FOR ROOM FOR A DEC NO. + EXP.
PUSH P,B
SKIPN STRFCN
PUSHJ P,CHROOM
POP P,B
PUSHJ P,PSIGN
PUSHJ P,DNPRNT
POP P,E ;RESTORE E
MOVEI C,"E" ;OUTPUT EXPONENT.
SKIPN STRFCN
JRST .+3
PUSHJ P,DPBSTR
JRST .+2
PUSHJ P,OUCH0
OUTN6: MOVEI C,"+"
JUMPGE B,.+2 ;SPIT OUT SIGN
MOVEI C,"-"
SKIPN STRFCN
JRST .+3
PUSHJ P,DPBSTR
JRST .+2
PUSHJ P,OUCH0
MOVM T,B ;USE PRTNX2 TO PRINT EXPON
JRST PRTNX2
;SUBROUTINE USED BY OUTNUM TO PRINT DECIMAL NUMBER. PRINTS
;SIX DIGITS (INTEGER IN T) WITH CONTENTS(E) DIGITS
;TO THE LEFT OF DECIMAL POINT
DNPRNT: MOVEI D,-1 ;SIGNAL TRAILING ZERO UNLESS...
JUMPE B,.+2 ;E-NOTATION
MOVEI D,0
DNPRN0: IDIVI T,^D10 ;GET LAST DIGIT
JUMPE T,DNPRN1 ;IS IT FIRST?
JUMPN T1,.+2 ;NON ZERO DIGIT?
SKIPA T1,D ;NO, STASH ZERO OR TRAILZERO
MOVEI D,0 ;YES. TRAILER IS OVER.
HRLM T1,(P) ;NO. STASH DIGIT
PUSHJ P,DNPRN0 ;CALL DNPRNT RECURSIVELY
HLRE T1,(P) ;RESTORE DIGIT
JUMPGE T1,DNPRN1 ;ORDINARY DIGIT?
JUMPLE E,CPOPJ ;NO, TRAILZERO. AFTER DECIMAL POINT?
MOVEI T1,0 ;NO, STASH A ZERO.
DNPRN1: MOVEI C,60(T1) ;PRINT DIGIT
SKIPN STRFCN
JRST .+3
PUSHJ P,DPBSTR
JRST .+2
PUSHJ P,OUCH0
SOJN E,CPOPJ ;COUNT DIGITS. POINT NEXT?
DNPRN2: MOVEI C,"." ;YES. PRINT POINT
SKIPE STRFCN
JRST DPBSTR
JRST OUCH0
;POWER-OF-TEN TABLE.
D1EM18: OCT 105447113564 ;10^-18
DECFLO:
D1EM4: OCT 163643334273 ;10^-4
OCT 167406111565
OCT 172507534122
OCT 175631463146
DECTAB: DEC 1.0 ;10^0
DEC 1.0E1
DEC 1.0E2
DEC 1.0E3
DEC 1.0E4
DEC 1.0E5
DEC 1.0E6
DEC 1.0E7
DEC 1.0E8 ;[237] 233575360400
DEC 1.0E9
DEC 1.0E10
DEC 1.0E11
OCT 250721522451 ;10^12
OCT 254443023471
D1E14: OCT 257553630410 ;10^14
DECCEI:
MAXEXP=^D38
DECFIX: EXP 225400000000
FIXCON: EXP 233400000000
;FLAGS USED BY DECIMAL READER/PRINTER
F.NUM=200000 ;DIGIT SEEN
F.MIN=100000 ;MINUS SEEN
F.MXP=40000 ;MINUS EXPONENT
F.DOT=20000 ;DECIMAL POINT SEEN
SUBTTL RUN-TIME ROUTINES
;RUN-TIME GOSUB ROUTINES
GOSBER: MOVE X1,@40
MOVE R,FCNLNK
HRLM R,@40 ;SAVE PRECEDING CALL
MOVE R,40 ;FETCH CURRENT CALL
MOVEM R,FCNLNK
TRNN X1,777777 ;IF FCN, BEGINS AT CTRL WRD + 1
HRRI X1,1(R)
TLNN X1,777777 ;CHECK RECURSIVE CALL
JRST (X1)
PUSHJ P,INLMES ;RECURSIVE CALL
ASCIZ /
? SUBROUTINE OR FUNCTION CALLS ITSELF/
GOSR2: PUSH P,[Z UXIT] ;PRINT LINE NUMBER AND END EXECUTION
GOSR3: PUSHJ P,INLMES
ASCIZ / IN LINE /
MOVE T,SORCLN ;PRINT LINE NUMBER AND CONTINUE EXECUTION.
PUSH P,ODF
SETZM ODF
PUSHJ P,PRTNUM
POP P,ODF
SKIPE CHAFL2 ;CHAINING?
PUSHJ P,ERRMS3
GOSR6: PUSHJ P,INLMES
ASCIZ /
/
OUTPUT
POPJ P,
FORCOM: MOVEI X1,313 ;RUNTIME COMPARE FIX-DONT USE IF CON
SKIPGE @40
ADDI X1,2
DPB X1,[POINT 9,@(P),8] ;SET UP COMPARE FOR ENTIRE LOOP
POPJ P,
XCTON: JUMPLE N,XCTON1 ;IS ON ARGUMENT <=0?
FAD N,FIXCON
HRRZ T,N ;GET INTEGER PART
JUMPE T,XCTON1
ADDI T,(A) ;GET THE "GOTO" ADDRESS
CAMGE T,(A) ;IS IT IN RANGE?
JRST @(T) ;YES, GOGO
XCTON1: PUSHJ P,INLMES
ASCIZ /
? ON EVALUATED OUT OF RANGE/
JRST GOSR2
;HERE ON OVFLOW ERROR
OVTRAP: MOVEM X1,SAVEX1 ;[236]SAVE THIS REG IN CASE FALSE ALARM.
HRRZ X1,.JBTPC ;GET TRAP ADDRESS.
CAML X1,FLCOD ;TRAP IN USER PROG?
CAMLE X1,CECOD
JRST OVFIG2 ;NO. FALSE TRAP.(NOT BY USER)
MOVE X1,.JBTPC ;GET TRAP FLAGS.
TLNE X1,(1B11) ;UNDERFLOW?
JRST UNTRAP ;YES
TLNE X1,(1B12) ;ZERO DIVIDE?
JRST DVTRAP ;YES.
TLNN X1,(1B3)
JRST OVFIG2 ;NOT OVFLOW EITHER. IGNORE.
OVTR0: PUSHJ P,INLMES
ASCIZ /
% OVERFLOW/
OVTR2: SKIPL N ;[230]NEG OVFLOW?
HRLOI N,377777 ;[230]LRG NUMBER
SKIPG N
MOVE N,MIFI ;LRG NEG NUMBER
OVTR1: PUSHJ P,GOSR3
OVFIG2: MOVEI X1,10
APRENB X1,
SETOM LIBFLG
MOVE X1,SAVEX1 ;[236]RESTORE X1
JRST @.JBTPC
OVFLCM: MOVEM X1,SAVEX1 ;[236]SAVE X1
JRST OVFIG2
UNTRAP: PUSHJ P,INLMES
ASCIZ /
% UNDERFLOW/
SETZI N, ;RESULT IS ZERO.
JRST OVTR1
DVTRAP: PUSHJ P,INLMES
ASCIZ /
% DIVISION BY ZERO/
JRST OVTR2
;ANALYZE THE FILENAME ARGUMENT FOR CHAIN.
CHAHAN: PUSHJ P,STRPL1 ;GET STR PLUS TERM DOLL SIGN
JRST CHAER1 ;SO FILNAM WILL STOP.
PUSHJ P,FILNAM
JUMP NEWOL1
CAME T,VALPTR ;STOPPED IN RIGHT PLACE?
JRST CHAER1
POP P,Q
MOVEI X2,.+2
JRST RESACS
SOS MASAPP
POPJ P,
RETURN: SETZB T,IFNFLG ;GOSUB RETURN, NOTHING ON PLIST.
JRST .+2
FRETRN: SETOM IFNFLG ;IFNFLG DISTINGUISHES BETWEEN "RETURN"
MOVE R,FCNLNK ;AND END OF FNX PROCESSING.
JUMPL R,BADRET ;[222]CHECK RETURN TOO FAR
MOVS X1,(R) ;FETCH LINK BACK
HRRZS (R) ;MARK SUBR NOT IN USE
HRREI R,(X1) ;[222]MARK SUBR NOT IN USE
MOVEM R,FCNLNK
POP P,X2 ;SAVE REAL RETURN LOCATION
SUB Q,T ;POP ANY ARGUMENTS OFF THE PUSH LIST
SKIPN IFNFLG
JRST (X2) ;RETURN
RESACS: POP P,T ;RESTORE AC'S, EXCEPT 0, X2, AND P.
POP P,T1
POP P,SORCLN
POP P,A
POP P,B
POP P,C
POP P,D
POP P,F
POP P,ODF
POP P,E
POP P,G
POP P,R
POP P,X1
POP P,L
JRST (X2)
SAVACS: POP P,X2
PUSH P,N
HRRZ N,P
SUBI N,PLIST
CAILE N,250
JRST MNYDEF
POP P,N
SAVCS1: PUSH P,L
PUSH P,X1
PUSH P,R
PUSH P,G
PUSH P,E
PUSH P,ODF
PUSH P,F
PUSH P,D
PUSH P,C
PUSH P,B
PUSH P,A
PUSH P,SORCLN
PUSH P,T1
PUSH P,T
JRST (X2)
MNYDEF: PUSHJ P,INLMES
ASCIZ /
? TOO MANY FN'S/
JRST GOSR2
BADRET: PUSHJ P,INLMES
ASCIZ /
? RETURN BEFORE GOSUB/
JRST GOSR2
;R.A. OUTPUT ROUTINE.
RNSTRO: SKIPG STRLEN-1(LP) ;STR FILE?
JRST RNERR1 ;NO. FAIL.
HLRZ B,STRLEN-1(LP) ;B=NO. WORDS/REC.
MOVEI X1,^D128
IDIVI X1,(B)
MOVE A,POINT-1(LP) ;X1=NO. RECS/BLK.
MOVEI T,(A)
IDIVI T,(X1) ;T = BLK NO. - 1.
IMULI T1,(B) ;T1 = NO. OF WRDS INTO BLK.
JRST RNNUM1
RNNUMO: SKIPL STRLEN-1(LP) ;NUM FILE?
JRST RNERR1 ;NO. FAIL.
MOVE A,POINT-1(LP)
MOVE T,A ;[215]T = BLK NO. - 1.
ADDI T,1 ;[215] -1. (SINCE NO BLK 0)
IDIVI T,^D128 ;T1 = NO. OF WRDS INTO BLK.
RNNUM1: AOJ T,.+1
CAMN T,BLOCK-1(LP) ;CUR BLK?
JRST RNNUM4 ;YES.
SKIPN MODBLK-1(LP) ;NO -- NEED TO OUTPUT
JRST RNNUM2 ;CUR BLK?
MOVE X2,BLOCK-1(LP) ;YES.
PUSHJ P,OUTRAN
RNNUM2: CAMG A,LASREC-1(LP) ;IS NEW REC WITHIN FILE?
JRST RNNUM3 ;YES.
MOVE A,LASREC-1(LP) ;NO. IS IT WITHIN THE LAST BLOCK?
SKIPG STRLEN-1(LP)
ADDI A,1 ;[215] OFF BY ONE
SKIPG STRLEN-1(LP)
MOVEI X1,^D128
IDIVI A,(X1)
CAIN T,1(A)
JRST RNNUM3 ;YES.
RNNM25: HLRZ A,BA-1(LP)
MOVEI B,177 ;CLEAR OUT NEW BLK.
SETZM 3(A)
AOJ A,.+1
SOJGE B,.-2
JRST RNNM31 ;[213]
RNNUM3: MOVE X2,T ;OR GET NEW BLK.
PUSHJ P,LOCKON ;[231]SET INTERLOCK
PUSHJ P,INRAN
RNNM31: MOVEM T,BLOCK-1(LP) ;[213]
PUSHJ P,LOCKOF ;[213]REMOVE INTERLOCK
RNNUM4: MOVE A,POINT-1(LP)
CAMLE A,LASREC-1(LP)
MOVEM A,LASREC-1(LP)
HLRZ A,BA-1(LP)
ADDI A,3(T1)
SKIPL STRLEN-1(LP)
JRST RNNUM5
MOVEM N,(A) ;OUTPUT NUM.
RNNOUT: AOS POINT-1(LP)
SETOM MODBLK-1(LP)
POPJ P,
RNNUM5: TLNN N,777777 ;OUTPUT STR.
JRST RNNM12
TLNE N,377777
JRST RNNUM6
MOVE T,N
MOVE N,(T)
TLNN N,777777
JRST RNNM12
RNNUM6: JUMPG N,RNNUM9
HLRE T,N
MOVM T,T
HRRZ B,STRLEN-1(LP)
CAMLE T,B
JRST RNERR2
MOVEM T,(A)
ADDI A,1
HRL A,N
SOJL T,RNNOUT
IDIVI T,5
ADDI T,(A)
BLT A,(T)
JRST RNNOUT
RNNUM9: MOVE X1,N ;APP BLK.
PUSHJ P,LENAPB
HRRZ B,STRLEN-1(LP)
CAMLE N,B
JRST RNERR2
MOVEM N,(A)
ADDI A,1
HRLI A,440700 ;A HAS NEW PNTR.
HLRE E,X1
HRRZI X1,(X1)
RNNM10: HRR X2,1(X1)
HRLI X2,440700 ;X2 IS AN OLD PNTR.
HLRE T1,1(X1)
JUMPE T1,RNNM11
ILDB C,X2
IDPB C,A
AOJL T1,.-2
RNNM11: SOJLE E,RNNOUT
AOJA X1,RNNM10
RNNM12: SETZM (A)
JRST RNNOUT
;UTILITY ROUTINE TO INPUT A BLOCK FOR A R.A. FILE. THE DESIRED
;BLOCK NUMBER IS IN X2.
INRAN: HRRM X2,USETID-1(LP)
XCT USETID-1(LP)
DPB LP,[POINT 4,INNDSK,12]
XCT INNDSK
POPJ P,
SETZM ACTBL-1(LP)
MOVEI T,INLSYS
JRST ERRMSG
;UTILITY ROUTINE TO TRANSFER A BLOCK FROM A R.A. INPUT BUFFER TO THE
;OUTPUT BUFFER FOR THAT CHANNEL. THE BLOCK NUMBER IS IN X2.
OUTRAN: PUSH P,X1
HRRM X2,USETOD-1(LP)
XCT USETOD-1(LP)
HLRZ X2,BA-1(LP)
ADDI X2,3
HRLI X2,(X2)
MOVEI X1,203
ADDI X1,(X2)
HRRI X2,(X1)
BLT X2,177(X1)
MOVEI X2,200
HRRM X2,-1(X1)
DPB LP,[POINT 4,OUTTDS,12]
POP P,X1
XCT OUTTDS
POPJ P,
SETZM ACTBL-1(LP)
DPB LP,[POINT 4,GTSTS,12]
XCT GTSTS
JRST OUTERR
;RUNTIME ROUTINE FOR THE PAGE STATEMENT.
;PAGE SIZE IS IN AC N, IN FLOATING POINT.
PAGE: CAMGE N,ONE ;PAGE SIZE MUST BE 1.0
JRST PAGERR ;OR GREATER.
PUSHJ P,IFIX
PAGE0: MOVEM N,PAGLIM(LP)
JUMPE LP,PAGE1 ;TTY IS ALWAYS IN "OUTPUT MODE".
MOVE T1,ACTBL-1(LP) ;FILE. IS IT WRITEABLE?
CAIE T1,3
JRST PAGE2
PAGE1: PUSH P,ODF
SETZM ODF
JUMPE LP,.+2
SETOM ODF
SKIPN HPOS(LP) ;NEED TO END CURRENT LINE?
JRST PAGE3 ;NO.
MOVEI C,15
PUSHJ P,OUCH
MOVEI C,12
PUSHJ P,OUCH
PAGE3: MOVEI C,14
PUSHJ P,OUCH
SETOM FIRSFL(LP)
POP P,ODF
PAGE2: SETZM PAGCNT(LP)
SETZM HPOS(LP)
SETZM TABVAL(LP)
SETZM FMTPNT(LP)
POPJ P,
;RUNTIME ROUTINE FOR THE PAGE ALL STATEMENT.
;PAGE SIZE IS IN AC N, IN FLOATING POINT.
PAGEAL: CAMGE N,ONE ;PAGE SIZE MUST BE 1.0
JRST PAGERR ;OR GREATER.
PUSHJ P,IFIX
MOVEI LP,9
PAGEL1: PUSHJ P,PAGE0
SOJG LP,PAGEL1
POPJ P,
;RUNTIME ROUTINE FOR THE MARGIN STATEMENT.
;MARGIN SIZE IS IN AC N, IN FLOATING POINT.
MARGN: CAML N,ONE ;MARGIN MUST BE >=1 AND <=132.
CAML N,ONE33
JRST MARER1
PUSHJ P,IFIX
MOVEM N,MARWAI(LP)
POPJ P,
ONE33: 133.0
ONE28: 128.0
MINONE: -1.0
;RUNTIME ROUTINE FOR THE MARGIN ALL STATEMENT.
;MARGIN SIZE IS IN AC N, IN FLOATING POINT.
MARGAL: CAML N,ONE ;MARGIN MUST BE >= 1 AND <= 132.
CAML N,ONE33
JRST MARER1
PUSHJ P,IFIX
MOVEI LP,9
MOVEM N,MARWAI(LP)
SOJG LP,.-1
POPJ P,
;SEMI-IFIX ROUTINE.
;IFIX EXPECTS A NON-NEGATIVE FLOATING POINT NUMBER IN AC N
;AND RETURNS A FIXED POINT INTEGER IN AC N.
IFIX: PUSH P,T
PUSH P,T1
MOVE T,N
MULI T,400
SETZM LIBFLG
ASH T1,-243(T)
MOVE N,T1
POP P,T1
POP P,T
SKIPN LIBFLG
POPJ P,
HRLOI N,377777
POPJ P,
;SEMI-IFLOAT ROUTINE.
;IFLOAT EXPECTS A NON-NEGATIVE FIXED POINT NUMBER IN AC N AND
;RETURNS A FLOATING POINT NUMBER IN AC N.
IFLOAT: PUSH P,T
SETZ T,
LSHC N,-^D8
LSH T,-^D9
TLO N,243000
TLO T,210000
FADR N,T
POP P,T
POPJ P,
;RUN-TIME ROUTINES FOR READ AND INPUT
DOREAD: MOVE R,[XWD NXREAD,PREAD]
SETZM INPFLA ;READ, NOT INPUT
POPJ P, ;SET UP TO READ
DOINPT: SKIPN IFIFG
SETZM PINPUT ;FORCE NEW LINE
MOVE R,[XWD NXINPT,PINPUT]
POP P,INPFLA ;SAVE ERROR RETURN
JRST @INPFLA
;ROUTINE TO GET A DATA WORD
DATAER: SKIPN IFIFG
JRST DATAE1
SKIPN T,PINPNM-1(LP)
JRST NXINPT
SKIPGE REAINP-1(LP)
SKIPN EOFFLG-1(LP) ;SEE NOTE IN IF END# ROUTINE.
JRST .+3
SETZ X1,
JRST NXIN4
PUSHJ P,DELAWY
JRST DATR0
DATAE1: SKIPN T,(R) ;MORE ON SAME LINE?
JRST DATR1 ;NO
PUSHJ P,NXCH ;PUT FIRST CHAR OF NEXT NUMBER IN C
SKIPE INPFLA ;CHECK TO SEE IF THIS IS REALLY
JRST DATR0 ;THE "ONE OPTIONAL TRAILING COMMA"
TLNE C,F.TERM ;ALLOWED IN DATA STATEMENTS.
JRST DATR1
DATR0: PUSHJ P,EVANUM
DATR00: PUSHJ P,SSKIP ;[177]IT WASN'T A NUMBER, TRY NEXT
PUSH P,X1
HRRZ X1,40
MOVEM N,(X1) ;STORE THE DATA WORD.
POP P,X1
SKIPE IFIFG
PUSHJ P,DELAWY
SKIPN INPFLA ;[157]END OF LINE TEST.
TLNN C,F.TERM ;[157]
TLNE C,F.CR ;[157]
SETZI T,
SKIPN IFIFG
JRST DATAE2
MOVEM T,PINPNM-1(LP)
JRST DATR01
DATAE2: MOVEM T,(R)
DATR01:SKIPN T ;[156]END OF A LINE?
SKIPN INPFLA ;[156]YES, IS THIS INPUT?
POPJ P, ;[156]RETURN VIA POPJ
MOVE X1,UUOH ;[156]PICK UP RETURN ADDRESS
MOVEM X1,INPFLA ;[156]YES, RESTART NEXT ERROR FROM HERE.
POPJ P, ;[156]RETURN
DATR1: MOVS X1,R ;DISPATCH ADDRS FOR MORE DATA
JRST (X1)
;ROUTINE TO GET A DATA STRING
INSTR:
SDATAE: SKIPN IFIFG
JRST SDAT1
SKIPN T,PINPNM-1(LP)
JRST NXSINP
SKIPGE REAINP-1(LP)
SKIPN EOFFLG-1(LP) ;SEE NOTE IN IF END# ROUTINE.
JRST .+3
MOVEI X1,1
JRST NXIN4
PUSHJ P,DELAWY
JRST SDATR0
SDAT1: MOVE T,1(R) ;GET CURRENT LINE POINTER
SKIPE INPFLA ;INPUT,INSTRUCTION?
MOVE T,(R) ;YES, SHARE POINTER WITH NUMBER DATA
SKIPN T ;MORE ON CURRENT STRING DATA LINE?
JRST SDATR1 ;NO. HUNT FOR NEXT DATA LINE
PUSHJ P,NXCH ;GET FIRST CHAR
SKIPE INPFLA ;CHECK TO SEE IF THIS IS REALLY
JRST SDATR0 ;THE "ONE OPTIONAL TRAILING COMMA"
TLNE C,F.TERM ;ALLOWED IN DATA STATEMENTS.
JRST SDATR1
SDATR0: PUSHJ P,REDSTR ;READ THE STRING AND STORE IT
PUSHJ P,SSKIP ;BAD STRING
SKIPE IFIFG
PUSHJ P,DELAWY
SKIPN INPFLA ;[157]END OF LINE TEST.
TLNN C,F.TERM ;[157]
TLNE C,F.CR ;[157]
SETZI T,
SKIPN IFIFG
JRST SDAT2
MOVEM T,PINPNM-1(LP)
JRST DATR01
SDAT2: MOVEM T,1(R) ;SAVE STRING DATA POINTER.
SKIPE INPFLA ;INPUT?
MOVEM T,(R) ;YES , SHARE POINTER
JRST DATR01
SDATR1: MOVS X1,R ;DISPATCH ADDRESS FOR STRING DATA..
JRST 1(X1)
;GET AN ARRAY DATA WORD
ADT1ER: PUSH P,40 ;DATAER NEEDS STORE LOC
SETZM 40
ADT1PD: PUSHJ P,DATAER ;[177]
POP P,40
JRST AST1ER ;GO STORE THE WORD
ADT2ER: PUSH P,40
SETZM 40
ADT2PD: PUSHJ P,DATAER ;[177]
POP P,40
JRST AST2ER
;GO TO NEXT LINE OF DATA
NXREAD: TDZA X1,X1 ;GET NEXT DATA LINE FOR NUMBER ITEM
NSRSTR: MOVEI X1,1 ;GET NEXT DATA LINE FOR STRING ITEM
MOVE T,DATLIN(X1) ;GET NXT DATA LINE NO
AOBJP T,NXRE2 ;JUMP IF OUT OF DATA
MOVEM T,DATLIN(X1)
HRRZ T,(T) ;GET ADDRS OF SOURCE LINE
HRLI T,440700
PUSHJ P,NXCH
PUSH P,X1
PUSHJ P,QSA ;LOOK FOR "DATA"
ASCIZ /DATA/
JRST [POP P,X1
JRST NXREAD+2]
POP P,X1
JUMPG X1,SDATR0 ;GO GET STRING?
JRST DATR0 ;NO, GO GET NUMBER
;REQUEST NEXT LINE OF INPUT
NXVINP: SETOI X1, ;GET LINE AND RETURN TO "MATIN"
JRST NXIN1
NXINPT: TDZA X1,X1 ;GET A LINE OF INPUT; NUMBER ITEM NEXT
NXSINP: MOVEI X1,1 ;GET A LINE OF INPUT; STRING ITEM NEXT
NXIN1: SKIPN IFIFG
SETZB LP,ODF
JUMPN LP,NXIN5
PUSH P,A ;OUTPUT ANY FORMATTING BEFORE THE "?".
PUSH P,B
PUSH P,X1
PUSH P,X2
PUSH P,40
SETZM 40
PUSHJ P,PRDLER
POP P,40
SETZ X1,
PUSHJ P,CHROOM
PUSHJ P,INLMES
ASCIZ / ?/
OUTPUT
PUSHJ P,PCRLF3
SETZM FMTPNT
POP P,X2
POP P,X1
POP P,B
POP P,A
NXIN5: MOVE T,LINPT(LP) ;IF END# ENTERS HERE.
PUSHJ P,INLINE ;READ THE LINE AND GET FIRST CHAR.
TLNE C,F.CR ;NULL LINE?
JUMPL X1,CPOPJ1 ;YES. ALLOW THIS ON MAT INPUT
NXIN4: MOVE T,LINPT(LP)
JUMPE LP,NXIN6
NXIN8: PUSHJ P,NXCH
TLNE C,F.CR
JRST NXIN5
SKIPL REAINP-1(LP) ;EXPECT A LINE NUMBER?
JRST NXIN6 ;NO.
MOVEI A,4
TLNN C,F.DIG
JRST IMP
PUSHJ P,NXCHD
TLNN C,F.DIG
JRST .+3
SOJGE A,.-3
JRST IMP
TLNE C,F.CR ;EMPTY LINE?
JRST NXIN5 ;YES.
TLNE C,F.SPTB ;DELIMITER AFTER LINE NUMBER
JRST NXIN3 ;MUST BE A SPACE, A TAB, OR THE LETTER D.
HRRZ A,C
CAIE A,"D"
JRST IMP
NXIN3: PUSH P,T
PUSHJ P,NXCH
TLNN C,F.CR
JRST .+3
POP P,T ;LINE NO. FOLLOWED BY EMPTY LINE.
JRST NXIN5
POP P,T
MOVEI C,40
DPB C,T
NXIN6: SKIPN IFIFG
JRST NXIN2
MOVEM T,PINPNM-1(LP)
JRST NXIN9
NXIN2: MOVEM T,PINPUT
PUSHJ P,DATCHK ;CHECK
JRST .+1
NXIN9: HRRZ T,(P)
CAIN T,EOF32
POPJ P, ;BACK TO IF END#.
SETZM EOFFLG-1(LP)
JUMPE X1,DATAER ;GET NUMBER ITEM
JUMPG X1,SDATAE ;GET STRING ITEM
POPJ P,
INPERP: POP P,X1 ;GET RID OF CALL TO NXVINP!
INPERR: SKIPE IFIFG
JRST IMP
PUSHJ P,INLMES
ASCIZ /
? INPUT DATA NOT IN CORRECT FORM/
SKIPE CHAFL2 ;CHAINING?
PUSHJ P,ERRMS3
PUSHJ P,INLMES
ASCIZ /--PLEASE RETYPE
/
SETZM PINPUT
INPER1: HRRZ X1,INPFLA
JRST (X1) ;START LINE OVER.
;R.A. READ/INPUT ROUTINES.
RANUM1: PUSH P,40 ;NUM 1 DIM.
SETZM 40
PUSHJ P,RANUM
POP P,40
JRST AST1ER
RANUM2: PUSH P,40 ;NUM 2 DIM.
SETZM 40
PUSHJ P,RANUM
POP P,40
JRST AST2ER
RANSTR: SKIPG STRLEN-1(LP) ;STR.
JRST RNERR1
MOVE T,POINT-1(LP)
CAMLE T,LASREC-1(LP)
JRST EOFFL
HLRZ B,STRLEN-1(LP)
MOVEI X1,^D128
IDIVI X1,(B) ;X1=NO. OF RECS/BLK.
IDIVI T,(X1) ;T=BLK NO. - 1.
IMULI T1,(B) ;T1=NO. OF WORDS INTO BLK.
JRST RANNM1
RANUM: SKIPL STRLEN-1(LP) ;NUM.
JRST RNERR1
MOVE T,POINT-1(LP)
CAMLE T,LASREC-1(LP)
JRST EOFFL
AOJ T,.+1
IDIVI T,^D128
RANNM1: AOJ T,.+1
CAMN T,BLOCK-1(LP)
JRST RANNM3
SKIPN MODBLK-1(LP)
JRST RANNM2
MOVE X2,BLOCK-1(LP)
PUSHJ P,OUTRAN
RANNM2: MOVEI X2,(T)
PUSHJ P,LOCKON ;[213]SET INTERLOCK
PUSHJ P,INRAN
MOVEM T,BLOCK-1(LP)
SETZM MODBLK-1(LP)
PUSHJ P,LOCKOF ;[213]REMOVE INTERLOCK
RANNM3: HLRZ A,BA-1(LP)
ADDI A,3(T1)
SKIPL STRLEN-1(LP)
JRST RANNM4
MOVE T,(A) ;READ NO.
HRRZ X1,40
MOVEM T,(X1)
AOS POINT-1(LP)
POPJ P,
RANNM4: MOVE T,(A) ;READ STR.
CAIG T,^D132
JUMPGE T,.+2
JRST RNERR3
PUSHJ P,PNTADR
SKIPE (X1)
SETZM VPAKFL
JUMPN T,RANNM5
SETZM (X1)
JRST RANNM6
RANNM5: PUSHJ P,VCHCKC
MOVE X2,(A)
HRLI T,1(A)
MOVEI X2,-1(X2)
PUSH P,Q
IDIVI X2,5
POP P,Q
ADDI X2,(T)
PUSH P,T
BLT T,(X2)
POP P,T
HRRM T,(X1)
MOVN T,(A)
HRLM T,(X1)
MOVEI X2,1(X2)
HRRM X2,VARFRE
RANNM6: AOS POINT-1(LP)
POPJ P,
;USING STATEMENT ROUTINES
;CHKIMG SETS UP THE STARTING AND CURRENT POINTER TO THE IMAGE IN MASAPP,
;THE TOTAL AND THE CURRENT NUMBER OF CHARS IN THE IMAGE IN B AND X2,
;AND BEGFLG IN T1. THE CURRENT POINTER IS ALSO IN X1.
CHKIMG: TLNN N,777777 ;GET IMAGE KEY.
JRST IMGER1
TLNE N,377777
JRST CHKIM1
MOVE T,N
MOVE N,(T)
TLNN N,777777
JRST IMGER1
CHKIM1: JUMPL N,CHKIM2
PUSHJ P,STRETT
TLNN N,777777
JRST IMGER1
CHKIM2: HLRE B,N
MOVM B,B
CAILE B,^D132
JRST IMGER2
MOVEI X2,(B)
HRLI N,440700
AOS T1,MASAPP ;SAVE ORIGINAL AND CURRENT POINTERS
MOVEM N,(T1) ;ON MASAPP TO PROTECT THEM FROM
AOS T1,MASAPP ;SHIFTING CORE.
MOVEM N,(T1)
SETO T1,
POP P,X1
PUSH P,B
PUSH P,X2
PUSH P,T1
JRST (X1)
IMGLIN: SETZM 40
PUSHJ P,PRDLER
MOVE G,HPOS(LP) ;END LINE IF NECESSARY.
ADD G,TABVAL(LP)
JUMPN G,CHKIM3
SKIPE G,MARWAI(LP)
MOVEM G,MARGIN(LP)
PUSHJ P,NUMINS
JRST CRLF1
CHKIM3: JUMPE LP,.+3
CAIN G,^D6
SKIPL WRIPRI-1(LP)
JRST .+2
POPJ P,
PUSH P,X2
PUSHJ P,PCRLF
JUMPN LP,.+2
OUTPUT
POP P,X2
POPJ P,
;MISC. UTILITY ROUTINES FOR USING STATEMENTS.
NXCHU: ILDB C,X1 ;GET NEXT CHAR OF IMAGE.
HLL C,CTTAB(C)
TRNE C,100
HRL C,CTTAB-100(C)
SOJ X2,.+1 ;DECREMENT COUNTER.
POPJ P,
SCNOUT: PUSH P,F ;OUTPUT A CHAR.
MOVE F,HPOS(LP)
CAIL F,^D132 ;USING MARGIN IS 132.
JRST SCNER3
POP P,F
JRST OUCH
IMGAPZ: JUMPN LEFT,CPOPJ1 ;USED BY IMGAPS.
JUMPN EXTEND,CPOPJ1
JUMPN RIGHT,CPOPJ1
JUMPN CENTER,CPOPJ1
POPJ P,
;SCNIMG LOOKS FOR NEXT FIELD.
;X1 IS A FLAG THAT PREVENTS LOOPING IF AN IMAGE WITH NO FIELDS IS SEEN.
SCNIMN: TDZA A,A ;ARG IS NUMBER.
SCNIMS: SETO A, ;ARG IS STRING.
POP P,X1
POP P,T1
POP P,X2
POP P,B
PUSH P,X1
MOVE X1,MASAPP ;RETRIEVE CURRENT POINTER.
MOVE X1,(X1)
SCNIM1: JUMPN X2,SCNIM2 ;CHAR LEFT IN IMAGE?
JUMPN T1,SCNER1 ;NO--ANY FIELDS SEEN?
MOVE X1,MASAPP ;YES, OKAY. O'E, FAIL.
MOVE X1,-1(X1) ;MOVE PNTR AND
MOVE X2,B ;CHAR COUNT BACK TO BEGINNING.
SETO T1,
PUSH P,X2
PUSHJ P,PCRLF ;END LINE, BEGIN NEW LINE.
JUMPN LP,.+2
OUTPUT
POP P,X2
SCNIM2: PUSHJ P,NXCHU
SCNIM0: TLNN C,F.APOS
JRST SCNIM3
JUMPE A,SCNER2 ;APOS SEEN, BETTER BE STR ARG.
SETZ T1,
PUSHJ P,IMGAPS
SCNEND: MOVE A,MASAPP ;PROTECT POINTER.
MOVEM X1,(A)
POP P,X1
PUSH P,B
PUSH P,X2
PUSH P,T1
JRST (X1) ;BACK TO USER CODE.
SCNIM3: PUSHJ P,SCNIM6
JRST SCNIM1
JRST .+2
JRST SCNIM0
JUMPN A,SCNER2
SETZ T1,
PUSHJ P,IMGPND
JRST SCNEND
SCNIM6: TLNN C,F.DOLL+F.STAR
CAMN C,[XWD F.STR,43]
JRST SCNIM4
SCNM35: JRST SCNOUT ;PRINTABLE CHAR.
SCNIM4: JUMPE X2,SCNOUT
MOVE G,C
PUSHJ P,NXCHU
CAMN C,G
JRST CPOPJ1
EXCH C,G
PUSHJ P,SCNOUT
MOVE C,G
POP P,G
JRST 2(G)
;ENDIMG ENDS A USING STATEMENT.
ENDIMG: POP P,C
POP P,T1
POP P,X2
POP P,B
PUSH P,C
MOVE X1,MASAPP
MOVE X1,(X1)
ENDIM3: JUMPE X2,ENDIM1 ;OUTPUT PRINTABLE CHARS
PUSHJ P,NXCHU ;UP TO THE NEXT FIELD.
ENDIM0: TLNE C,F.APOS
JRST ENDIM1
PUSHJ P,SCNIM6
JRST ENDIM3
JRST ENDIM1
JRST ENDIM0
ENDIM1: PUSHJ P,PCRLF ;END LINE.
ENDIM2: JUMPN LP,.+2
OUTPUT
SETZM FMTPNT(LP)
SETOM ZONFLG(LP)
SOS MASAPP
SOS MASAPP
POPJ P,
;IMGAPS ANALYZES STR FIELD AND OUTPUTS STR.
CENTER=G
EXTEND=E
LEFT=D
RIGHT=R
IMGAPS: TLNN N,777777 ;GET OUTPUT STR KEY.
JRST IMGA1
TLNE N,377777
JRST IMGAP1
MOVE T,N
MOVE N,(T)
JRST IMGAPS
IMGAP1: JUMPLE N,.+2
PUSHJ P,STRETT
IMGA1: SETZB CENTER,EXTEND ;CLEAR FLAGS.
SETZB LEFT,RIGHT
IMGAP0: JUMPE X2,IMGAP4 ;FIND C, E, L, AND R'S.
MOVE F,X1
PUSHJ P,NXCHU
TLNE C,F.LETT
JRST IMGAP2
IMGP01: MOVE X1,F
AOJA X2,IMGAP4
IMGAP2: TLZ C,777777
CAIE C,"L"
JRST IMGA21
JUMPN LEFT,.+2
PUSHJ P,IMGAPZ
AOJA LEFT,IMGAP0
IMGA21: CAIE C,"E"
JRST IMGA22
JUMPN EXTEND,.+2
PUSHJ P,IMGAPZ
AOJA EXTEND,IMGAP0
IMGA22: CAIE C,"C"
JRST IMGP23
JUMPN CENTER,.+2
PUSHJ P,IMGAPZ
AOJA CENTER,IMGAP0
IMGP23: CAIE C,"R"
JRST IMGP01
JUMPN RIGHT,.+2
PUSHJ P,IMGAPZ
AOJA RIGHT,IMGAP0
JRST IMGP01
IMGAP4: JUMPE LEFT,.+2
IMGA41: AOJA LEFT,IMGAP5
JUMPE EXTEND,.+2
AOJA EXTEND,IMGAP5
JUMPE CENTER,.+2
AOJA CENTER,IMGAP5
JUMPE RIGHT,IMGA41
AOJA RIGHT,IMGAP5
IMGAP5: HLRE F,N ;HAVE ANALYZED FIELD.
MOVM F,F
HRLI N,440700 ;GET PTR AND CHAR COUNT FOR ARG
SKIPN T,LEFT ;IN N AND F.
SKIPE T,EXTEND
JRST .+3
SKIPN T,CENTER
MOVE T,RIGHT
CAIGE F,(T)
JRST IMGAP6
JUMPN EXTEND,.+2 ;OVERFLOW.
MOVEI F,(T)
IMGP51: ILDB C,N
PUSHJ P,SCNOUT
SOJG F,.-2
POPJ P,
IMGAP6: SUBI T,(F)
JUMPE CENTER,IMGAP7 ;CENTER.
IDIVI T,2
ADDI T1,(T)
JUMPE T,IMGP61
MOVEI C," "
PUSHJ P,SCNOUT
SOJG T,.-1
IMGP61: MOVEI T,(T1)
SETZ T1, ;RESTORE FLAG.
JRST IMGAP8
IMGAP7: JUMPE RIGHT,IMGAP8 ;RIGHT.
JUMPE T,IMGP71
MOVEI C," "
PUSHJ P,SCNOUT
SOJG T,.-1
IMGP71: JUMPE F,IMGP82
JRST IMGP51
IMGAP8: JUMPE F,IMGP81 ;LEFT OR EXTEND.
ILDB C,N
PUSHJ P,SCNOUT
SOJG F,.-2
IMGP81: JUMPE T,IMGP82
MOVEI C," "
PUSHJ P,SCNOUT
SOJG T,.-1
IMGP82: POPJ P,
;IMGPND ANALYZES NUM FIELD AND THEN CALLS IMGINT, IMGDEC, OR IMGEXP.
COMMA=G
EXPON=E
LCOUNT=D
RCOUNT=R
IMGPND: MOVEI LCOUNT,2 ;SET UP FLAGS.
SETZB COMMA,EXPON
SETZB RCOUNT,TRAIL
MOVEM C,LEAD ;SAVE TYPE OF FIELD.
IMGPN2: JUMPE X2,IMGINT ;SORT THRU #,$, *, AND COMMAS
MOVE F,X1 ;IN LH OF FIELD.
PUSHJ P,NXCHU
CAME C,[XWD F.STR,43]
CAMN C,LEAD
AOJA LCOUNT,IMGPN2
TLNN C,F.COMA
JRST IMGP21
SETO COMMA,
AOJA LCOUNT,IMGPN2
IMGP21: TLNE C,F.PER ;NOT LH ANYMORE; DEC PT?
JRST IMGPN3
TLNE C,F.MINS ;-?
JRST IMGP22
MOVE X1,F
AOJA X2,IMGINT
IMGP22: SETOM TRAIL
JRST IMGINT
IMGPN3: JUMPE X2,IMGDEC ;MUST BE DEC OR EXP FIELD, SINCE ".".
MOVE F,X1
PUSHJ P,NXCHU
CAME C,[XWD F.STR,43] ;SORT THRU #,$,*, AND COMMAS IN RH.
CAMN C,LEAD
AOJA RCOUNT,IMGPN3
TLNN C,F.COMA
JRST IMGP31
SETO COMMA,
AOJA RCOUNT,IMGPN3 ;-?
IMGP31: TLNN C,F.MINS
JRST .+3
SETOM TRAIL
JRST IMGDEC
CAIN C,"^" ;POSSIBLY EXPON?
JRST IMGP32
MOVE X1,F
AOJA X2,IMGDEC
IMGP32: MOVEI EXPON,1
IMGPN4: JUMPN X2,IMGP41 ;REALLY 4 UP-ARROWS?
ADDI X2,(EXPON)
IMGP40: SUBI EXPON,5
IBP X1
AOJL EXPON,.-1
HRRI X1,-1(X1)
JRST IMGDEC
IMGP41: PUSHJ P,NXCHU
CAIE C,"^"
AOJA EXPON,IMGP40 ;NOT REALLY EXPON FIELD.
AOJ EXPON,.+1
CAIGE EXPON,4
JRST IMGPN4
JUMPE X2,IMGEXP ;SEEN 4 UP-ARROWS.
MOVE F,X1
PUSHJ P,NXCHU
TLNE C,F.MINS ;ALSO -?
JRST .+3
MOVE X1,F
AOJA X2,IMGEXP
SETOM TRAIL
JRST IMGEXP
;IMGINT OUTPUTS NUMBER WITHOUT DECIMAL POINT AND WITHOUT EXPON.
IMGINT: PUSH P,[Z IMGIN3]
IMG0: MOVE C,LEAD ;IF THE NO. WILL BE MINUS AND
CAMG N,MINONE ;THE SIGN LEADS AND THE FIELD IS
SKIPE TRAIL ;* OR $, FAIL BECAUSE ILLEGAL.
JRST .+3
TLNE C,F.DOLL+F.STAR
JRST IMGER4
MOVEI F,(LCOUNT) ;F = NO. OF PLACES FOR DIGITS AND COMMAS.
TLNE C,F.DOLL
SOJA F,CPOPJ ;$ TAKES ONE PLACE.
SKIPN TRAIL
CAME C,[XWD F.STR,43]
POPJ P,
SOJA F,CPOPJ
IMGIN3: MOVE A,N ;A HAS ARG.
MOVM N,N ;N HAS /ARG/.
CAML N,ONE
JRST IMGN31
MOVEI C,1 ;ANSWER IS 0.
SETZ COMMA,
SETZB N,A
JRST IMGIN7
IMGN31: PUSH P,[Z IMGIN1]
IMGDE2: SETZ C,
CAML N,DECTAB+8 ;[237] EXACTLY REPRESENTABLE
JRST IMGD10 ;[237] NO CHECK FOR SCALING
CAMGE N,FIXCON ;[237] IS IT A 27 BIT INTEGER?
JRST IMGD09 ;[237] NO TRUNCATION MAY BE NEEDED
TLZ N,377000 ;[237] YES CONVERT TO INTEGER
MOVEI C,8 ;[237] 8 DIGITS TO PRINT
POP P,0(P) ;[237] CLEAN UP STACK
JRST IMGN45 ;[237] GO CHECK FIELD WIDTH
IMGD09: FAD N,FIXCON ;[237]
FSB N,FIXCON
JRST IMGD11 ;[237] FIND NUMBER OF DIGITS TO PRINT
IMGD10: CAMG N,D1E14
JRST IMGD11
ADDI C,^D14
FDVR N,D1E14
JRST IMGD10
IMGD11: MOVEI T,^D14
CAML N,DECTAB(T)
JRST IMGD12
SOJGE T,.-2
SETZ T,
MOVE N,DECTAB
IMGD12: ADDI C,1(T)
CAILE C,8 ;[237] IS NUMBER 8 DIGITS OF LESS
POPJ P, ;[237] NO- SCALE AND FIX THE HARD WAY
FAD N,FIXCON ;[237] YES- CONVERT TO
TLZ N,377400 ;[237] APPROPRIATE INTEGER
POP P,0(P) ;[237] CLEAN UP STACK
JRST IMGN45 ;[237] AND GO CHECK FIELD WIDTH
IMGIN1: FDVR N,DECTAB(T)
FMPR N,DECTAB+8 ;FORCE 9 DIGITS.
CAMGE N,DECTAB+8
MOVE N,DECTAB+8
CAMGE N,DECTAB+9
JRST IMGN44
MOVE N,DECTAB+8
AOJ C,IMGN44
IMGN44: MOVE T,N
MULI T,400
ASH T1,-243(T)
MOVE N,T1
IMGN45: PUSH P,[Z IMGIN7] ;[237]
IMG1: JUMPE COMMA,IMGIN5 ;COMMA BECOMES NO. OF ,'S TO BE OUTPUT.
MOVEI T,-1(C)
IDIVI T,3
MOVEI COMMA,(T)
IMGIN5: MOVEI T,(COMMA) ;CHECK TO SEE IF IT OVERFLOWS THE FIELD.
ADDI T,(C)
CAIG T,(F)
POPJ P,
PUSH P,C
JUMPL A,IMGIN6
SKIPE TRAIL
JRST IMGIN6
MOVE C,LEAD
CAME C,[XWD F.STR,43]
JRST IMGIN6
CAIG T,1(F)
JRST IMGN76
IMGIN6: MOVEI C,"&" ;OVERFLOWS THE FIELD.
PUSHJ P,SCNOUT
EXCH T,LCOUNT ;WIDEN FIELD.
CAIN T,(F)
JRST IMGN76
MOVE C,LEAD
TLNE C,F.DOLL
JRST IMGN73
CAME C,[XWD F.STR,43]
JRST IMGN76
JUMPGE A,IMGN76
IMGN73: AOJA LCOUNT,.+1
IMGN76: POP P,C
POPJ P,
IMGIN7: PUSH P,[Z IMGIN8]
IMG2: MOVEI T,(LCOUNT) ;OUTPUT EVERYTHING BEFORE THE DIGITS.
MOVEI T1,(C)
ADDI T1,(COMMA)
SUBI T,(T1) ;T = LEADING PLACES.
MOVE T1,LEAD
CAMN T1,[XWD F.STR,43]
JRST IMGN71
TLNE T1,F.DOLL
JRST IMGN72
JUMPE T,CPOPJ ;* FIELD.
PUSH P,C
MOVEI C,"*"
PUSHJ P,SCNOUT
SOJG T,.-1
POP P,C
POPJ P,
IMGN71: JUMPE T,CPOPJ ;# FIELD.
SKIPN TRAIL
JUMPL A,IMGN74
PUSH P,C
MOVEI C," "
PUSHJ P,SCNOUT
SOJG T,.-1
POP P,C
POPJ P,
IMGN72: SKIPA T1,[777777777777] ;$ FIELD.
IMGN74: MOVEI T1,0
PUSH P,C
SOJLE T,IMGN75
MOVEI C," "
PUSHJ P,SCNOUT
SOJG T,.-1
IMGN75: MOVEI C,"-"
JUMPE T1,.+2
MOVEI C,"$"
PUSHJ P,SCNOUT
POP P,C
POPJ P,
IMGIN8: JUMPN N,IMGN81 ;NOW OUTPUT DIGITS.
PUSH P,C
MOVEI C,"0"
PUSHJ P,SCNOUT
POP P,C
JRST IMGIN9
IMGN81: PUSH P,[Z IMGIN9]
INTOUT: JUMPE COMMA,IMGN80 ;GENERAL OUTPUT ROUTINE FOR DIGITS AND COMMAS.
MOVEI T,-1(C) ;AT ENTRY, C= NO. OF DIGITS REQ,
IDIVI T,3 ;N=/NUMBER/, COMMA=0 UNLESS ,'S TO BE OUTPUT.
IMULI T,3 ;T, T1, AND N ARE DESTROYED.
MOVEI T1,(C)
SUBI T1,(T) ;N.B. - N HAS THE LEADING DIGITS.
IMGN80: MOVE T,N
MOVE N,T1
PUSH P,C
PUSH P,A
MOVEI A,(C)
PUSHJ P,.+2
JRST IMGN84
IDIVI T,^D10
JUMPE T,IMGN82
PUSH P,T1
PUSHJ P,.-3
POP P,T1
IMGN82: JUMPE COMMA,IMGN87
JUMPLE A,IMGN87
JUMPN N,IMGN83
MOVEI C,","
PUSHJ P,SCNOUT
MOVEI N,3
IMGN83: SOJ N,.+1
IMGN87: SOJL A,.+3
MOVEI C,60(T1)
PUSHJ P,SCNOUT
POPJ P,
IMGN84: JUMPLE A,IMGN86
IMGN89: JUMPE COMMA,IMGN88
JUMPN N,IMGN85
MOVEI C,","
PUSHJ P,SCNOUT
MOVEI N,3
IMGN85: SOJ N,.+1
IMGN88: MOVEI C,"0"
PUSHJ P,SCNOUT
SOJG A,IMGN89
IMGN86: POP P,A
POP P,C
POPJ P,
IMGIN9: SETZ T1, ;RESTORE FLAG.
SKIPN TRAIL
POPJ P,
MOVEI C," " ;OUTPUT TRAILING SIGN.
JUMPGE A,.+2
MOVEI C,"-"
JRST SCNOUT
;IMGDEC OUTPUTS NUMBERS WITH DECIMAL POINTS BUT WITHOUT EXPONENTS.
IMGDEC: PUSHJ P,IMG0 ;ERROR CHECKING AND CALC
;F=NO. OF PLACES FOR DIGITS AND COMMAS.
JUMPE N,IMGX16
PUSH P,N
MOVE A,N
PUSHJ P,IMGEX1
POP P,N
MOVSI T1,(0.5) ;ROUND.
JUMPG C,IMGD34
CAILE RCOUNT,9
JRST IMGD21
IMGD20: FDVR T1,DECTAB(RCOUNT)
JRST IMGD26
IMGD21: MOVM C,C
ADDI C,9
CAILE C,(RCOUNT)
JRST IMGD20
IMGD31: CAIG C,^D14
JRST IMGD32
FDVR T1,D1E14
SUBI C,^D14
JRST IMGD31
IMGD32: FDVR T1,DECTAB(C)
JRST IMGD26
IMGD34: ADDI C,(RCOUNT)
CAIGE C,9
JRST IMGD20
SUBI C,9(RCOUNT)
JUMPGE C,IMGD27
MOVM C,C
JRST IMGD32
IMGD27: CAIG C,^D14
JRST IMGD28
FMPR T1,D1E14
SUBI C,^D14
JRST IMGD27
IMGD28: FMPR T1,DECTAB(C)
IMGD26: MOVM N,N
FAD N,T1 ;[174]
JUMPL A,.+2
SKIPA A,N
MOVN A,N
PUSHJ P,IMGEX1
JUMPL C,IMGDE6
MOVEI T1,(RCOUNT)
ADDI T1,(C)
IMGD61: CAILE T1,9
MOVEI T1,9 ;T1 IS NO. OF DIGITS REQ.
JRST IMGD62
IMGDE6: MOVEI T1,1(RCOUNT)
ADD T1,C
JUMPGE T1,IMGD61
SETZ T1,
IMGD62: ADDI T,1
SUBI T,(T1)
JUMPE T,IMGD51
JUMPL T,IMGD52
FDVR N,DECTAB(T)
JRST IMGD51
IMGD52: MOVM T,T
FMPR N,DECTAB(T)
IMGD51: FAD N,FIXCON
FSB N,FIXCON
JUMPN T1,.+3
SETZ N,
JRST IMGD53
CAMGE N,DECTAB-1(T1)
MOVE N,DECTAB-1(T1)
CAMGE N,DECTAB(T1)
JRST .+3
MOVE N,DECTAB-1(T1)
AOJ C,.+1
IMGD53: PUSH P,A
MOVEI A,(T1)
MOVE T,N
MULI T,400
ASH T1,-243(T)
MOVE T,T1
SETZB T1,N
JUMPLE C,IMGD64
CAIL C,(A)
JRST IMGD69
SUBI A,(C)
IDIV T,INTTAB(A)
MOVEI N,(A)
JUMPE T1,.+4
CAMGE T1,INTTAB(A)
SOJA A,.-1
SUBI N,1(A)
JRST IMGD69
IMGD64: MOVE T1,T
SETZ T,
MOVM N,C
CAILE N,(RCOUNT)
MOVEI N,(RCOUNT)
IMGD69: POP P,A
JUMPGE A,IMGDE7 ;CHECK AGAIN FOR NEG. * OR $ FIELD.
SKIPE TRAIL
JRST IMGDE7
PUSH P,N
MOVE N,LEAD
TLNE N,F.DOLL+F.STAR
JRST .+3
POP P,N
JRST IMGDE7
POP P,N
JUMPN T,IMGER4
JUMPN T1,IMGER4
IMGDE7: PUSH P,T1
PUSH P,N
JUMPG C,.+2
MOVEI C,1
PUSH P,T
PUSHJ P,IMG1
PUSHJ P,IMG2 ;OUTPUT EVERYTHING BEFORE THE DIGITS.
POP P,N
PUSHJ P,INTOUT ;OUTPUT LH DIGITS AND COMMAS.
MOVEI C,"."
PUSHJ P,SCNOUT
POP P,N
POP P,T
PUSHJ P,INTTRA ;OUTPUT RH SIDE.
JRST IMGIN9
IMGX16: SETZB COMMA,A ;ZERO ARG.
MOVEI C,1
PUSHJ P,IMG2 ;LEADING *,$, ETC.
PUSHJ P,IMGX17
JRST IMGIN9
;IMGEXP OUTPUTS NUMBERS WITH DECIMAL POINTS AND EXPONENTS.
IMGEXP: MOVE T,LEAD
TLNE T,F.STAR+F.DOLL
JRST IMGER3
JUMPE N,IMGEX8
MOVEI F,(LCOUNT) ;F= NO. OF PLACES FOR DIGITS IN LH.
SKIPN TRAIL
SOJ F,.+1
JUMPE COMMA,IMGEX4
MOVEI T,-1(F)
IDIVI T,4
SUBI F,(T)
AOJ T,.+1
IMULI T,3
CAILE F,(T)
MOVEI F,(T)
IMGEX4: MOVEI T1,(F)
ADDI T1,(RCOUNT)
CAILE T1,9
MOVEI T1,9
PUSH P,[Z IMGEX2]
MOVE A,N ;NUMBER TO A.
IMGEX1: MOVM N,N ;/NUMBER/ TO N.
SETZ C, ;C = TRUE EXPONENT.
IMGE51: CAMG N,D1E14
JRST IMGE50
ADDI C,^D14
FDVR N,D1E14
JRST IMGE51
IMGE50: CAML N,ONE
JRST IMGE52
SUBI C,^D14
FMPR N,D1E14
JRST IMGE50
IMGE52: MOVEI T,^D14
CAML N,DECTAB(T)
JRST IMGE53
SOJGE T,.-2
MOVE N,DECTAB
SETZ T,
IMGE53: ADDI C,1(T)
POPJ P,
IMGEX2: SUBI T,-1(T1)
JUMPE T,IMGE54
JUMPL T,.+3
FDVR N,DECTAB(T)
JRST IMGE54
MOVM T,T
FMPR N,DECTAB(T)
IMGE54: FADRI N,200400 ;ROUND.
FAD N,FIXCON
FSB N,FIXCON
PUSH P,[Z IMGEX9]
IMGDIV: CAMGE N,DECTAB-1(T1) ;GET LH AND RH IN
MOVE N,DECTAB-1(T1) ;T AND T1 IN FIXED POINT.
CAMGE N,DECTAB(T1)
JRST IMGEX7
MOVE N,DECTAB-1(T1)
AOJ C,IMGEX7
IMGEX7: MOVE T,N
CAIL F,(T1)
JRST IMGE71
PUSH P,A
MOVEI A,(T1)
SUBI A,(F)
MULI T,400
ASH T1,-243(T)
MOVE T,T1
IDIV T,INTTAB(A)
MOVEI N,(A)
JUMPE T1,.+4
CAMGE T1,INTTAB(A)
SOJA A,.-1
SUBI N,1(A)
POP P,A
POPJ P, ;T HAS LEADING NUMBER OF DIGITS.
IMGE71: MULI T,400 ;T1 HAS TRAILING NO. OF DIGITS.
ASH T1,-243(T)
MOVE T,T1 ;N HAS NO. OF LEADING ZEROES IN FRONT OF T1.
SETZB T1,N
POPJ P,
IMGEX9: SUBI C,(F)
CAIGE C,^D100
CAMG C,[-^D100]
JRST .+2
JRST IMGE91
PUSH P,C
MOVEI C,"&"
PUSHJ P,SCNOUT
POP P,C
IMGE91: SKIPE TRAIL
JRST IMGX10
PUSH P,C
MOVEI C," "
JUMPGE A,.+2
MOVEI C,"-"
PUSHJ P,SCNOUT
POP P,C
IMGX10: PUSH P,C
MOVEI C,(F) ;NO. OF DIGITS TO C.
PUSH P,T1
PUSH P,N
MOVE N,T ;N = NUMBER.
PUSHJ P,INTOUT
MOVEI C,"."
PUSHJ P,SCNOUT
POP P,N
POP P,T
PUSH P,[Z IMGX12]
INTTRA: JUMPE RCOUNT,CPOPJ ;OUTPUT RH SIDE.
JUMPLE N,INTTR0
MOVEI C,"0"
PUSHJ P,SCNOUT
SOJ RCOUNT,.+1
SOJG N,.-2
JUMPE RCOUNT,CPOPJ
INTTR0: PUSHJ P,.+2
JRST INTTR2
IDIVI T,^D10
JUMPE T,INTTR1
PUSH P,T1
PUSHJ P,.-3
POP P,T1
INTTR1: SOJL RCOUNT,CPOPJ
MOVEI C,60(T1)
JRST SCNOUT
SOJA RCOUNT,CPOPJ
INTTR2: JUMPLE RCOUNT,CPOPJ
MOVEI C,"0"
PUSHJ P,SCNOUT
SOJG RCOUNT,.-1
POPJ P,
IMGX12: POP P,N
IMGX11: MOVEI C,"E" ;PRINT EXPONENT.
PUSHJ P,SCNOUT
MOVEI C,"+"
JUMPGE N,.+2
MOVEI C,"-"
PUSHJ P,SCNOUT
MOVM T,N
IDIVI T,^D10
CAIGE T,^D10
JRST IMGX13
PUSH P,T1
IDIVI T,^D10
MOVEI C,60(T)
PUSHJ P,SCNOUT
MOVE T,T1
POP P,T1
IMGX13: MOVEI C,60(T)
PUSHJ P,SCNOUT
MOVEI C,60(T1)
PUSHJ P,SCNOUT
JRST IMGIN9
IMGEX8: SOJ LCOUNT,.+1 ;EXP FIELD IS 0.
MOVEI C," "
PUSHJ P,SCNOUT
SOJG LCOUNT,.-1
PUSH P,[Z IMGE81]
IMGX17: MOVEI C,"0"
PUSHJ P,SCNOUT
MOVEI C,"."
PUSHJ P,SCNOUT
JUMPE RCOUNT,CPOPJ
MOVEI C,"0"
PUSHJ P,SCNOUT
SOJG RCOUNT,.-1
POPJ P,
IMGE81: SETZB N,A
JRST IMGX11
INTTAB: ^D1
^D10
^D100
^D1000
^D10000
^D100000
^D1000000
^D10000000
^D100000000
^D1000000000
;RESTORE DATA POINTER
RESTOR: PUSHJ P,RESTOS ;RESTORE BOTH NUMBERS AND STRINGS
RESTON: TDZA X1,X1 ;RESTORE NUMERIC DATA
RESTOS: MOVEI X1,1 ;RESTORE STRINGS
MOVE T,DATAFF
ADD T,FLLIN
SUB T,[XWD 1,1]
MOVEM T,DATLIN(X1)
SETZM PREAD(X1) ;CLEAR CURRENT LINE POINTER
POPJ P,
NXRE2: PUSHJ P,INLMES ;OUT OF DATA
ASCIZ /
? OUT OF DATA/
HRRZ T,L
JRST GOSR2
INERR: PUSHJ P,INLMES
ASCIZ/
? DATA FILE LINE TOO LONG/
JRST GOSR2
PTXER1: PUSHJ P,INLMES
ASCIZ /
? ILLEGAL CHARACTER IN STRING/
JRST GOSR2
FNMX0: MOVEI LP,(X1)
FNMXER: SKIPN ACTBL-1(LP)
JRST FNR
FNMX1: PUSHJ P,INLMES
ASCIZ /
? MIXED RANDOM & SEQ. ACCESS/
JRST GOSR2
PTXER2: PUSHJ P,INLMES
ASCIZ /
? OUTPUT ITEM TOO LONG FOR LINE/
JRST GOSR2
IMP: PUSHJ P,INLMES
ASCIZ /
? BAD DATA/
JRST GOSR2
FNR: PUSHJ P,INLMES
ASCIZ/
? FILE NEVER ESTABLISHED - REFERENCED/
JRST GOSR2
LKFAIL: PUSHJ P,INLMES
ASCIZ /
? FAILURE ON LOOKUP/
JRST GOSR2
ENFAIL: PUSHJ P,INLMES
ASCIZ /
? FAILURE ON ENTER/
JRST GOSR2
ILWRT: CAIE X2,1
JRST ILWRT1
PUSHJ P,INLMES
ASCIZ %
? ATTEMPT TO WRITE# OR PRINT# TO A FILE WHICH IS IN READ# OR INPUT# MODE%
JRST GOSR2
ILWRT1: PUSHJ P,INLMES
ASCIZ %
? ATTEMPT TO WRITE# OR PRINT# TO A FILE WHICH HAS NOT BEEN SCRATCH#ED%
JRST GOSR2
ILRD: CAIE X1,3
JRST ILRD1
PUSHJ P,INLMES
ASCIZ %
? ATTEMPT TO READ# OR INPUT# FROM A FILE WHICH IS IN WRITE# OR PRINT# MODE%
JRST GOSR2
ILRD1: PUSHJ P,INLMES
ASCIZ %
? ATTEMPT TO READ# OR INPUT# FROM A FILE WHICH DOES NOT EXIST%
JRST GOSR2
RANSRF: PUSHJ P,INLMES
ASCIZ /
? CANNOT ERASE FILE ON CHANNEL /
RAN2: HRRZ T,LP
PUSHJ P,PRTNUM
JRST GOSR2
LOKFAL: SETZM ODF
PUSHJ P,INLMES
ASCIZ/
? FILE NOT FOUND BY RESTORE COMMAND/
JRST GOSR2
EOFFAL: POP P,X1
EOFFL: PUSHJ P,INLMES
ASCIZ/
? EOF/
JRST GOSR2
CHAERR: PUSHJ P,INLMES
ASCIZ /
? LINE NUMBER/
JRST OUTBND
RNERR1: PUSHJ P,INLMES
ASCIZ /
? MIXED STRINGS AND NUMBERS/
JRST GOSR2
RNERR2: PUSHJ P,INLMES
ASCIZ /
? OUTPUT STRING LENGTH > RECORD LENGTH/
JRST GOSR2
RNERR3: PUSHJ P,INLMES
ASCIZ /
? FILE NOT IN CORRECT FORM/
JRST GOSR2
CHAER1: PUSHJ P,INLMES
ASCIZ /
? ILLEGAL FILENAME/
JRST GOSR2
WRPRER: PUSHJ P,INLMES
ASCIZ "
? MIXED WRITE#/PRINT#"
JRST GOSR2
SCNER1: PUSHJ P,INLMES
ASCIZ /
? NO FIELDS IN IMAGE/
JRST GOSR2
SCNER2: PUSHJ P,INLMES
ASCIZ /
? ATTEMPT TO OUTPUT A NUMBER TO A STRING FIELD OR A STRING TO A NUMERIC FIELD/
JRST GOSR2
SCNER3: PUSHJ P,INLMES
ASCIZ /
? OUTPUT LINE > 132 CHARACTERS/
JRST GOSR2
IMGER1: PUSHJ P,INLMES
ASCIZ /
? NO CHARACTERS IN IMAGE/
JRST GOSR2
IMGER2: PUSHJ P,INLMES
ASCIZ /
? > 132 CHARACTERS IN IMAGE/
JRST GOSR2
IMGER3: PUSHJ P,INLMES
ASCIZ /
? EXPONENT REQUESTED FOR * OR $ FIELD/
JRST GOSR2
IMGER4: PUSHJ P,INLMES
ASCIZ /
? ATTEMPT TO OUTPUT A NEGATIVE NUMBER TO A * OR $ FIELD/
JRST GOSR2
MARERR: PUSHJ P,INLMES
ASCIZ /
? MARGIN TOO SMALL/
JRST GOSR2
REINER: PUSHJ P,INLMES
ASCIZ "
? MIXED READ#/INPUT#"
JRST GOSR2
MARER1: PUSHJ P,INLMES
ASCIZ /
? MARGIN /
OUTBND: PUSHJ P,INLMES
ASCIZ / OUT OF BOUNDS/
JRST GOSR2
PAGERR: PUSHJ P,INLMES
ASCIZ /
? PAGE LENGTH/
JRST OUTBND
CNER1: PUSHJ P,INLMES
ASCIZ /
? CHANNEL NUMBER IS <1 OR >9/
JRST GOSR2
TRPMSG: SKIPL RENFLA ;CONTROL C TRAP.
JRST TRPMS0
SETZM TRPLOC+2 ;CLEAR TO ALLOW NEXT INTERRUPT.
SKIPLE COMTIM
JRST REUXIT
JRST BASIC
TRPMS0: AOS RENFLA
PUSH P,TRPLOC+2
POP P,STOTRP
SETZM TRPLOC+2 ;CLEAR TO ALLOW NEXT INTERRUPT.
JRST 2,@STOTRP
;RUNTIME MAT INPUT ROUTINE
MATIN: SETZM IFIFG
PUSHJ P,DOINPT ;SETUP INPUT LOOP
HRRZ X1,40 ;GET VECTOR 2-WD BLOCK ADDRESS
HRRZ X2,(X1) ;GET ADDRESS OF FIRST ELEMENT
HRRZ T,1(X1) ;[207]GET COLUMN DIMENSION
SOJE T,.+2 ;[207]ADJUST COUNT DONT CHANGE IF 0
ADDI X2,1(T) ;[207]ELSE SKIP OVER COL 0
MOVEM T,ELECT1 ;[207]SET MASTER COUNT
MOVEM T,ELECT2 ;[207]AND RUNNING COUNT
MOVEM X2,NUMRES ;SAVE THIS VALUE FOR COUNTING ELEMENTS LATER
HLRZ X1,(X1) ;GET MAXIMUM VECTOR SIZE
ADD X1,X2 ;UPPER BOUND OF VECTOR
SUBI X1,1
MOVEM X1,ELETOP ;SAVE FOR COMPARISON LATER
HRRM X2,40 ;SET UP ELEMENT ADDRESS FOR DATA ROUTINES
MATIN1: MOVEI X1,MATIN4 ;POINT "INPUT ERR" TO SPECIAL ROUTINE
HRL X1,ELECT2 ;[207]GET CURRENT COUNT
HRLZM X1,ELECT3 ;[207]AND REMEMBER IT...
HRL X1,40 ;REMEMBER FIRST ELEMENT ON LINE
MOVEM X1,INPFLA
PUSHJ P,NXVINP ;INPUT THE LINE
MATIN5: JRST .+2 ;THERE IS ANOTHER ELEMENT.
JRST MATIN6 ;NULL LINE. NO MORE ELEMENTS.
HRRZ X1,40 ;MAY WE ACCEPT ANOTHER ELEMENT?
CAML X1,ELETOP
JRST MATIN3 ;NO
SKIPN ELECT1 ;[207]VECTOR?
JRST MTIN5A ;[207]YES, SKIP
SOSL ELECT2 ;[207]CHECK IF TIME TO SKIP ELEMENT 0
JRST MTIN5A ;[207]ITS NOT
MOVE T,ELECT1 ;[207]RESET THE COUNT
SUBI T,1 ;[207]BACK OFF ONE
MOVEM T,ELECT2 ;[207]
MTIN5A: AOS 40 ;[207]POINT TO NEXT ELEMENT
PUSH P,[EXP MATIN2] ;YES. SETUP RETURN FROMDATA ROUTINE
CAML X1,SVRBOT ;NUMBER OR STRING VECTOR?
JRST SDATAE ;STRING
JRST DATAER ;NUMBER
MATIN2: TLNE C,F.CR ;END OF INPUT?
JRST MATIN6 ;YES, SET UP "NUM" FUNCTION AND RETURN.
CAIE C,"&"
JRST MATIN7
MOVE T,(R)
PUSHJ P,NXCH
TLNN C,F.CR
JRST INPERR
JRST MATIN1
MATIN7: TLNN C,F.COMA
JRST INPERR
MOVE T,(R)
PUSHJ P,NXCH
TLNE C,F.CR
JRST MATIN6
CAIE C,"&"
JRST MATIN5
PUSHJ P,NXCH
TLNN C,F.CR
JRST MATIN5
JRST MATIN1
MATIN3: PUSHJ P,INLMES
ASCIZ /
? TOO MANY ELEMENTS/
SKIPE CHAFL2
PUSHJ P,ERRMS3
PUSHJ P,INLMES
ASCIZ /-- RETYPE LINE
/
JRST INPER1
MATIN4: HLRZ X1,INPFLA ;AN ERROR HAS OCCURRED. START LINE OVER
HRRM X1,40 ;WITH SAME ELEMENT
MOVE X1,ELECT3 ;[207]GET REMEMBERED COUNT
MOVEM X1,ELECT2 ;[207]AND RESTORE IT
JRST MATIN1
MATIN6: HRRZ X1,40 ;CALCULATE NUMBER OF ELEMENTS
SUB X1,NUMRES
TLO X1,233400 ;FLOAT RESULT
FSB X1,FIXCON
MOVEM X1,NUMRES
POPJ P,
REDSTR: SKIPE INPFLA
JRST REDS9
TLNN C,F.LETT+F.QUOT
POPJ P,
REDS9: SKIPN IFIFG
SKIPN INPFLA
JRST .+3
TLNE C,F.COMA ;TEST FOR LEADING COMMA FOR INPUT.
POPJ P,
AOS (P) ;THIS IS A LEGITIMATE STRING
PUSH P,G
PUSH P,E
PUSHJ P,GETSTR
MOVEI N,(X1)
MOVE G,T
SETZ T,
PUSHJ P,VCHCKC ;MAKE SPACE
EXCH G,T
SKIPN IFIFG
JRST REDS4
MOVEI X1,F.COMA+F.CR+F.SPTB+F.QUOT
JRST REDS3
REDS4: MOVEI X1,F.COMA+F.CR ;ASSUME A STRING WITHOUT QUOTES
SKIPN INPFLA
ADDI X1,F.APOS
REDS3: SETZM QUOFL1
TLNN C,F.QUOT ;IS IT A QUOT STRING?
JRST REDS1 ;NO
SETOM QUOFL1
MOVEI X1,F.QUOT+F.CR
PUSHJ P,NXCHD ;SKIP QUOTE
REDS1: MOVE X2,N
SKIPE (X2) ;NEW STRING?
SETZM VPAKFL ;NO, GARBAGE NOW EXISTS
SETZ X2, ;INITIALIZE COUNT.
HRRI F,(G) ;GET FREE LOCATION
PUSH P,T
MOVE T,N
HRRM F,(T)
POP P,T
REDS2: TLNN C,(X1)
JRST REDS6
SKIPE QUOFL1
JRST REDQOT
TLNN C,F.QUOT
JRST REDS8
REDS7: POP P,E
POP P,G
SOS (P)
POPJ P,
REDQOT: TLNN C,F.QUOT
JRST REDS7
PUSHJ P,NXCHD
JRST REDS8
REDS6: IDPB C,F ;STORE A CHAR
PUSHJ P,NXCHD
SOJA X2,REDS2 ;COUNT THE CHAR
REDS8: HRRZ X1,F ;GET NEW FREE LOCATION
POP P,E
MOVE G,N
JUMPN X2,REDS82
SETZM (G)
JRST REDS84
REDS82: HRLM X2,(G)
AOJ X1,
HRRM X1,VARFRE
REDS84: POP P,G
POPJ P,
SSKIP: SKIPE INPFLA ;IS THIS INPUT OR READ?
JRST SSKP1 ;INPUT. CANT SKIP ANY FIELDS
PUSHJ P,SKIPDA ;SKIP OVER A DATA FIELD
HALT . ;IMPOSSIBLE ERROR
POP P,X1
TLNE C,F.TERM ;END OF DATA LINE?
JRST -10(X1) ;YES. FORCE DATA SEARCH
JRST -7(X1) ;RETURN TO DATAER OR SDATAE
SSKP1: ADD P,[XWD -2,-2] ;CLEAN UP PUSH LIST
SKIPE IFIFG ;[177]
JRST INPERR ;[177]
HRRZ X1,2(P) ;[177]CHECK PATH TO HERE
CAIE X1,DATR00+1 ;[177]THRU DATR00?
JRST INPERR ;[177]NO
HRRZ X1,1(P) ;[177]NEXT STEP
CAIE X1,ADT1PD+1 ;[177]THRU ADT1PD OR
CAIN X1,ADT2PD+1 ;[177]ADT2PD
SUB P,[XWD 2,2] ;[204][177]YES, CLEAN STACK
JRST INPERR
;ROUTINE THAT SKIPS OVER ONE DATA FIELD
SKIPDA: TLNE C,F.QUOT ;QUOTE STRING?
JRST QSKIP ;YES, USE QSKIP ROUTINE
TLNE C,F.COMA+F.TERM ;FIELD TERMINATOR?
JRST CPOPJ1
PUSHJ P,NXCH
JRST .-3
SUBTTL RUN-TIME ROUTINES FOR PRINTING
FINPNT: MOVE X1,FMTPNT(LP) ;FINISH WITH CR?
CAIE X1,1
POPJ P,
SETOM ZONFLG(LP)
PUSHJ P,PCRLF
FINPT4: JUMPN LP,.+2
OUTPUT
POPJ P,
PCRLF: MOVEI C,15 ;ROUTINE TO END A LINE AND
PUSHJ P,OUCH ;POSSIBLY BEGIN A NEW LINE.
MOVEI C,12
PUSHJ P,OUCH
PCRLF3: SETZM TABVAL(LP)
SETZM HPOS(LP)
SKIPG C,PAGLIM(LP)
JRST PCRLF2
AOS PAGCNT(LP)
CAME C,PAGCNT(LP)
JRST PCRLF2
MOVEI C,14
PUSHJ P,OUCH
SETZM HPOS(LP)
SETZM PAGCNT(LP)
PCRLF2: SKIPE C,MARWAI(LP)
MOVEM C,MARGIN(LP)
PCRLF1: JUMPE LP,FINPT3
MOVE C,MARGIN(LP)
CAIL C,^D7
JRST .+3
SKIPGE WRIPRI-1(LP)
JRST MARERR
FINPT3: HRRZ X2,(P)
CAIE X2,FINPT4
CAIN X2,CRLF8
POPJ P,
CAIE X2,ENDIM2
PUSHJ P,NUMINS
POPJ P,
CRLF: MOVE C,HPOS(LP) ;ROUTINE USED BY "EMPTY" OUTPUT
ADD C,TABVAL(LP) ;STATEMENTS, AND RESTORE AND UXIT.
JUMPE C,CRLF4
JUMPE LP,CRLF5
CAIN C,^D6
SKIPL WRIPRI-1(LP)
JRST .+2
JRST CRLF3
CRLF5: PUSHJ P,PCRLF
CRLF8: JRST CRLF2
CRLF4: PUSHJ P,PCRLF2
CRLF3: MOVEI C,15
PUSHJ P,OUCH
MOVEI C,12
PUSHJ P,OUCH
SETZM TABVAL(LP)
SETZM FMTPNT(LP)
SKIPG T,PAGLIM(LP)
JRST CRLF2
AOS PAGCNT(LP)
CAME T,PAGCNT(LP)
JRST CRLF2
MOVEI C,14
PUSHJ P,OUCH
SETZM PAGCNT(LP)
CRLF2: SETZM HPOS(LP)
CRLF1: SETZM TABVAL(LP)
SETZM FMTPNT(LP)
JUMPN LP,.+2
OUTPUT
SETOM FIRSFL(LP)
POPJ P,
;RUN-TIME NUMBER PRINTER
PRNMER: PUSHJ P,TABBR
PUSHJ P,FIRCHK
SKIPGE TABVAL(LP)
PUSHJ P,PCRLF
PUSHJ P,NUMINS
MOVE N,@40 ;GET THE NUMBER
PUSHJ P,OUTNUM
AOS TABVAL(LP) ;CAUSE A SPACE TO FOLLOW NUMBER.
SETZM ZONFLG(LP)
JRST FINPNT
;RUN-TIME TAB PRINTER
PRNTBR: PUSHJ P,TABBR
PUSHJ P,FIRCHK
SKIPGE B,TABVAL(LP) ;IGNORE ZERO AND MINUS TABS.
PUSHJ P,PCRLF
JUMPL N,FINPNT
PUSHJ P,NUMINS
PUSHJ P,IFIX
MOVE X1,N
MOVE N,MARGIN(LP)
IDIV X1,N
SUB X2,HPOS(LP)
SUB X2,TABVAL(LP)
JUMPL X2,FINPNT
ADDM X2,TABVAL(LP)
SETOM ZONFLG(LP)
JRST FINPNT
;RUNTIME DELIMITER SPACING ROUTINE.
PRDLER: SKIPE X1,FMTPNT(LP)
CAIN X1,4
SETOM ZONFLG(LP)
PUSHJ P,TABBR
SKIPGE TABVAL(LP)
PUSHJ P,PCRLF
PUSHJ P,NUMINS
PUSHJ P,FIRCHK
JRST FINPNT
FIRCHK: SKIPN FIRSFL(LP)
JRST .+3
PUSHJ P,PCRLF1
SETZM FIRSFL(LP)
SKIPN T,HPOS(LP)
JRST MARCH2
JUMPE LP,CPOPJ
CAIN T,^D6
SKIPL WRIPRI-1(LP)
POPJ P,
MARCH2: SKIPE T,MARWAI(LP)
MOVEM T,MARGIN(LP)
POPJ P,
NUMINS: JUMPE LP,CPOPJ
SKIPGE WRIPRI-1(LP) ;NEED A LINE NUMBER?
SKIPE HPOS(LP)
POPJ P, ;NO.
MOVEI X2,12 ;YES.
ADDB X2,LINNUM-1(LP)
CAILE X2,^D99999
JRST NUMLRG
PUSH P,T
MOVE T,@OUTCNT-1(LP)
JUMPLE T,NUMIN2
IDIVI T,5
JUMPE T1,NUMIN2
SETZ C, ;PAD WITH NULLS SO THAT THE LINE
PUSHJ P,OUCH ;NUMBER STARTS IN A NEW WORD.
SOJG T1,.-2
NUMIN2: MOVE T,LINNUM-1(LP)
SETZM NUMCOT
PUSHJ P,PRTNUM
MOVEI T,5
MOVEM T,HPOS(LP)
MOVE T,NUMCOT
SUBI T,5
MOVE T1,@OUTPT-1(LP)
MOVE T1,(T1)
JUMPE T,NUMIN3
NUMIN4: LSH T1,-7 ;PAD WITH LEADING ZEROES (RE-
TLO T1,300000 ;QUIRED BY THE LINED CUSP).
IBP @OUTPT-1(LP)
SOS @OUTCNT-1(LP)
AOJL T,NUMIN4
NUMIN3: TRO T1,1 ;SET THE "SEQ. NO." BIT.
MOVE T,@OUTPT-1(LP)
MOVEM T1,(T)
POP P,T
MOVEI C,11 ;TAB.
PUSHJ P,OUCH
POPJ P,
NUMLRG: PUSHJ P,TTYIN
PUSHJ P,INLMES
ASCIZ /
? ATTEMPT TO WRITE A LINE NUMBER > 99,999/
JRST GOSR2
;TAB CONTROL
;"TABBR" ANALYSES THE LAST FORMAT CHARACTER USING "TABB0", "TABB1", AND
;"TABB3", WHICH HANDLE THE <PA>, COMMA, AND SEMICOLON, RESPECTIVELY.
;"TABVAL" CONAINS THE NUMBER OF SPACES WAITING TO BE TYPED OUT
;(OR IS NEGATIVE IF A <RETURN> MUST FOLLOW.)
CHROOM: MOVE B,TABVAL(LP)
ADD X1,B ;TOTAL SPACE NEEDED FOR FIELD
ADD X1,HPOS(LP)
CAML X1,MARGIN(LP)
JRST PCRLF ;NO ROOM, GO TO NEXT LINE.
JUMPL B,PCRLF
JUMPE B,CPOPJ ;NO SPACING TO DO.
MOVEI C," " ;HERE TO PUT OUT SPACES
PUSHJ P,OUCH
SOJG B,.-2
SETZM TABVAL(LP)
POPJ P,
TABBR: LDB X1,[POINT 4,40,12]
EXCH X1,FMTPNT(LP) ;GET OLD POSITION AND SAVE NEW FORMAT
SKIPGE A,TABVAL(LP)
POPJ P,
ADD A,HPOS(LP)
JRST .+1(X1)
POPJ P, ;NO FMT CHAR
POPJ P, ;<CR> WAS TYPED WHEN FIRST SEEN.
JRST TABB3 ;SEMICOLON
JRST TABB1 ;COMMA
TABB0: PUSH P,FMTPNT(LP) ;<PA>
PUSHJ P,PAGE1
POP P,FMTPNT(LP)
POPJ P,
TABB1: MOVE X1,MARGIN(LP)
JUMPE LP,.+3
SKIPGE WRIPRI-1(LP) ;FIRST ZONE STARTS AFTER LINE NUMBER.
SUBI X1,6
IDIVI X1,^D14
SUBI X1,1
IMULI X1,^D14
JUMPE LP,.+3
SKIPGE WRIPRI-1(LP)
SUBI A,6
CAMLE A,X1
JRST SETCR
IDIVI A,^D14
JUMPE B,.+3
SETOM ZONFLG(LP)
JRST TABB2
SKIPN ZONFLG(LP)
JRST .+3
MOVEI B,^D14
JRST TABB31
SETOM ZONFLG(LP)
POPJ P,
TABB2: SUBI B,^D14
MOVNS B
TABB31: ADDM B,TABVAL(LP)
POPJ P,
TABB3: MOVE X1,MARGIN(LP)
CAML A,X1
JRST SETCR
POPJ P,
SETCR: SETOM TABVAL(LP) ;FORCE <RETURN TO BE NEXT>
POPJ P,
SUBTTL RUN-TIME STRING MANIPULATION ROUTINES.
;GETSTR IS CALLED WITH THE ADDRESS OF A POINTER IN REG.
;THE ROUTINE SETS UP THE POINTER IN F, AND THE NEGATIVE COUNT OR
;(FOR LITERAL STRINGS) A POSITIVE QUANTITY IN G. (G=0 IF NULL STRING)
GETSTR: PUSHJ P,PNTADR ;GET ADDRESS OF STRING POINTER
MOVE F,(X1)
HLRE G,F ;PUT NEGATIVE CHAR LENGTH IN G, IF NOT APP BLK OR 0.
JUMPG G,CPOPJ
HRLI F,440700 ;NOTAPP BLK, INITIALIZE POINTER.
POPJ P,
;ROUTINE TO SET UP A NUMBER VECTOR INSTEAD OF A STRING
GETVEC: HRRZ F,@40 ;THE LEFT SIDE OF (F) IS ZERO, IMPLYING VECTOR ADR,
MOVE G,(F) ;GET VECTOR LENGTH
JUMPL G,GETVF ;NEGATIVE?
FAD G,FIXCON ;FIX THE LENGTH
TLZ G,777400
HLRZ X1,@40 ;DOES THE LENGTH EXCEED VECTOR BOUNDS?
MOVNS G
ADD X1,G
JUMPLE X1,.+2
AOJA F,CPOPJ ;NO. POINT TO FIRST "CHAR" AND RETURN
GETVF: PUSHJ P,INLMES
ASCIZ /
? IMPOSSIBLE VECTOR LENGTH/
JRST GOSR2
;ROUTINE TO GET NEXT VECTOR ELE AS A CHARACTER
GETEL: AOJG G,CPOPJ ;IS THERE ANOTHER ELEMENT?
MOVE C,(F) ;YES. GET IT
JUMPL C,GETELF ;TOO SMALL TO BE AN ASCII
PUSH P,R
LDB R,[POINT 8,C,8] ;GET EXPONENT
TLZ C,777000 ;TURN IT OFF
LSH C,-233(R) ;SHIFT INTO INTEGER POSTION
POP P,R
CAIGE C,^D128
CAIGE C,0
JRST GETELF
CAIG C,^D13
CAIGE C,^D10
AOJA F,CPOPJ1
JRST GETELF
AOJA F,CPOPJ1 ;BUMP ELEMENT POINTER AND RETURN
GETELF: PUSHJ P,INLMES
ASCIZ /
? ILLEGAL CHAR SEEN/
JRST GOSR2
;ROUTINE TO STORE "NUMERIC" CHARS INTO A STR.
STRCHA: PUSHJ P,PNTADR
MOVM T,G ;GETVEC SET UP F AND G.
PUSH P,X1
PUSHJ P,VCHCKC
POP P,X1
SKIPE (X1)
SETZM VPAKFL
MOVEM T,(X1)
HRLM G,(X1)
HRLI T,440700
STRCH1: PUSHJ P,GETEL
JRST CPOPJ
IDPB C,T
JRST STRCH1
;ROUTINE TO MOVE "STRING" CHARS INTO A VECTOR
PUTVEC: TLNN N,777777
JRST PUTV3
TLNE N,377777
JRST PUTV2
MOVE T,N
MOVE N,(T)
JRST PUTV3
PUTV2: JUMPLE N,PUTV3
PUSHJ P,STRETT
PUTV3: HLRE G,N
HRRZ F,N
HRLI F,440700
HRRZ X1,40
HRRZ N,(X1) ;SAVE FIRST LOC ADDRESS FOR LENGTH STORE
HLRZ X2,(X1) ;GET SIZE
HRRZ X1,(X1)
PUTV1: JUMPE G,PUTV9 ;GET CHAR.
ILDB C,F
AOJ G,.+1
SOJL X2,PUTVF ;ROOM FOR ANOTHER CHAR?
TLO C,233400 ;YES. FLOAT IT
FSB C,FIXCON
MOVEM C,1(X1)
AOBJP X1,PUTV1 ;COUNT CHARS IN LEFT HALF OF X1
PUTV9: HLRZ X1,X1 ;GET SIZE
HRLI X1,233400 ;FLOAT IT
FSB X1,FIXCON
MOVE X2,N
MOVEM X1,(X2) ;FIRST ELEMENT GETS SIZE
POPJ P,
PUTVF: PUSHJ P,INLMES
ASCIZ /
? NO ROOM FOR STRING/
JRST GOSR2
;STORE STR FOR LET STATEMENT.
PUTSTR: TLNN N,777777
JRST PUTST2
TLNE N,377777
JRST PUTST1
MOVE T,N
MOVE N,(T)
JRST PUTSTR
PUTST1: JUMPG N,PUTST4
PUTST2: HLRE G,N
JUMPN G,PUTST5
PUSHJ P,PNTADR
SKIPE (X1)
SETZM VPAKFL
SETZM (X1)
POPJ P,
PUTST5: MOVM T,G
AOS F,MASAPP
MOVEM N,(F)
PUSHJ P,VCHCKC
MOVE N,(F)
SOS MASAPP
HRRZ F,N
HRLI F,440700
PUSHJ P,PNTADR
SKIPE (X1)
SETZM VPAKFL
HRRZM T,(X1)
HRLM G,(X1)
HRLI T,440700
PUTST3: ILDB C,F
IDPB C,T
AOJL G,PUTST3
POPJ P,
PUTST4: PUSHJ P,STRETR
MOVE T,N
PUSHJ P,PNTADR
SKIPE (X1)
SETZM VPAKFL
MOVEM T,(X1)
POPJ P,
;COMSTR COMPARES TWO STRINGS. ONE HAS BEEN FETCHED. THE POINTER
;TO THE OTHER IS IN REG. THE COMPARE RELATION IS IN (P)
;COMSTR GETS A PAIR OF CHARS, ONE FROM EACH STRING, USING "GETPCH".
;WHEN IT REACHES THE END OF ONE OR BOTH STRINGS, OR WHEN IT FINDS
;AN UNEQUAL CHAR PAIR, THE ROUTINE USES THIS PAIR OF CHARACTERS
;WHILE EXECUTING THE RELATION (NOTE: FIRST, HOWEVER, A CHECK IS MADE
;FOR TRAILING BLANKS).
COMSTR: TLNN N,777777
JRST COMST2
TLNE N,377777
JRST COMST1
MOVE T,N
MOVE N,(T)
JRST COMST2
COMST1: JUMPLE N,COMST2
PUSHJ P,STRETT
COMST2: AOS F,MASAPP
MOVEM N,(F)
PUSHJ P,PNTADR
MOVE N,(X1)
TLNN N,777777
JRST COMST3
JUMPLE N,COMST3
PUSHJ P,STRETT
COMST3: HRRZ F,N
HLRE G,N
HRLI F,440700
SOS T,MASAPP
MOVE T,1(T)
HLRE T1,T
HRLI T,440700
IFST1: PUSHJ P,GETPCH ;GET PAIR OF CHARS IN (A) AND (C)
JUMPG X2,IFST3 ;HAVE BOTH STRINGS ENDED?
JUMPE X2,IFST2 ;HAS ONE STRING ENDED?
CAMN C,A ;ARE THESE TWO CHARS THE SAME?
JRST IFST1 ;YES. LOOK AT NEXT PAIR
IFST2: SETOI X2, ;CHECK BOTH STRINGS FOR TRAILING BLANKS
CAIN C," " ;IS THIS CHAR A BLANK?
PUSHJ P,IFST4 ;YES, GO CHECK STRING
PUSHJ P,EXCH6 ;LOOK AT OTHER STRING
AOJLE X2,.-3
IFST3: HLLZ X1,@(P) ;GET RELATION
AOS (P)
IOR X1,[Z A,C] ;SETUP COMPARE
XCT X1
POPJ P, ;RETURN AND "GOTO"
JRST CPOPJ1 ;RETURN AND STAY IN LINE
IFST4: JUMPN G,.+3 ;IS BLANK REALLY A TRAILING BLANK?
SETO C,
POPJ P,
ILDB C,F
AOJ G,.+1
CAIN C," " ;IS NEXT CHAR A BLANK?
JRST IFST4 ;YES KEEP LOOKING
IFST5: MOVEI C," " ;NO. USE BLANK FOR COMPARE
POPJ P,
;ROUTINE TO GET A PAIR OF CHARS
GETPCH: SETOI X2, ;COUNT TERMINATED STRINGS IN X2
PUSHJ P,GETCH
PUSHJ P,EXCH6 ;LOOK AT OTHER STRING
PUSHJ P,GETCH
EXCH6: EXCH T,F ;MOVE OTHER STRING INFO TO (C),(F),(G)
EXCH T1,G
EXCH A,C
POPJ P,
GETCH: JUMPE G,.+3
ILDB C,F
AOJA G,CPOPJ
SETO C,
AOJA X2,CPOPJ
;PRSTRR PRINTS A STRING WHOSE POINTER IS ADDRESSED IN (40)
PRSTRR: PUSHJ P,TABBR
PUSHJ P,FIRCHK
MOVEI X1,0
PUSHJ P,CHROOM
PUSHJ P,NUMINS
SKIPE QUOTBL(LP) ;QUOTE MODE?
JRST PRSTDS ;YES.
PUSH P,G ;SAVE G (FOR MAT READ AND PRINT)
PUSHJ P,GETSTR ;SETUP STRING FETCH
JUMPLE G,PRST1
MOVE N,(X1)
PUSHJ P,STRETT
HLRE G,N
HRR F,N
HRLI F,440700
PRST1: JUMPE G,PRST2
SETZM ZONFLG(LP)
PRST3: ILDB C,F
PUSHJ P,OUCH0 ;PRINT CHAR
AOJL G,PRST3
PRST2: POP P,G
JRST FINPNT
PRSTDS: PUSHJ P,GETSTR ;QUOTE MODE
JUMPLE G,PRST4
MOVE N,(X1)
PUSHJ P,STRETT
HLRE G,N
HRR F,N
HRLI F,440700
PRST4: MOVMS G,G
PUSH P,F
PUSH P,G
JRST PRTXD1
PRTXD8: MOVEI C," " ;OUTPUT A DELIMITER.
PUSHJ P,OUCH
PUSHJ P,PRTXD4
JUMPE G,PRTXD3
PRTXD5: ILDB C,F
PUSHJ P,OUCH
SOJG G,PRTXD5
PRTXD3: PUSHJ P,PRTXD4
JRST FINPNT
PRTXD4: SKIPN QUOFLG ;OUTPUT A QUOTE?
POPJ P, ;NO.
MOVEI C,42 ;YES.
JRST OUCH
PRTXD1: SETZM QUOFLG ;QUOFLG NE 0 SAYS MUST
SETZM ZONFLG(LP)
PRTXD9: MOVE X1,MARGIN(LP) ;WRITE THIS STRING WITH QUOTES.
SUBI X1,1
SUB X1,HPOS(LP)
JUMPG X1,.+3
PUSHJ P,PCRLF
JRST PRTXD9
SETO X2,
JUMPE G,PRTXD2
PRTXD7: SOJGE G,.+2 ;[164][201]SEE IF FINISHED
JRST PRTXD0 ;[164][201]YES, RETURN
ILDB C,F ;[164][201]NO,GET NEXT CHAR
CAIN C,42
JRST PTXER1
HLL C,CTTAB(C)
TRNE C,100
HRL C,CTTAB-100(C)
TLNE C,F.CR ;IF STR CONTAINS SPACE, TAB,
JRST PTXER1 ;OR COMMA, IT MUST BE WRITTEN WITH QUOTES.
TLNN C,F.SPTB+F.COMA
JRST PRTXD6
SKIPN QUOFLG
PRTXD2: SUBI X1,2 ;ONCE ONLY, SUBTRACT THE 2 SPACES
SETOM QUOFLG ;THE QUOTES TAKE UP.
PRTXD6: SOJGE X1,PRTXD7
JUMPE X2,PTXER2 ;STRING IS TOO LONG FOR LINE.
MOVE D,MARGIN(LP)
SUB D,HPOS(LP)
SUB D,X1
PUSHJ P,PCRLF
ADD D,HPOS(LP)
CAML D,MARGIN (LP)
JRST PTXER2
MOVE X1,MARGIN(LP)
SUB X1,D
SETZ X2,
JRST PRTXD7
PRTXD0: POP P,G
POP P,F
JRST PRTXD8
;ROUTINE TO PUT ADDRESS OF POINTER IN REG
PNTADR: HRRZ X1,40 ;GET UUO ADDRESS
MOVE X2,(X1)
JUMPGE X2,CPOPJ ;ALL DONE IF THIS IS 0 OR AN APP BLK.
TLNN X2,377777 ;ALL DONE IF THIS IS NEGATIVE COUNT
MOVEI X1,(X2)
POPJ P,
;STRRET IS A UTILITY ROUTINE WHICH RETRIEVES A STRING FROM
;AN APPEND BLOCK AND CREATES THE ACTUAL STRING EITHER IN THE
;TEMPORARY STRING AREA OR IN THE REAL STRING AREA, DEPENDING ON
;WHICH OF THE ENTRY POINTS STRETT AND STRETR IS USED. STRRET EXPECTS
;THE APPEND KEY IN AC N. IT RETURNS THE ANSWER KEY IN AC N. IT
;DESTROYS NO AC'S EXCEPT T.
STRETT: SETOM REATMP ;STORE IN TEMP SPACE.
JRST .+2
STRETR: SETZM REATMP ;STORE IN REAL SPACE.
PUSH P,X1
PUSH P,X2
PUSH P,T1
PUSH P,C
PUSH P,E
MOVE X1,N ;SAVE APP KEY.
PUSHJ P,LENAPB
MOVE T,N ;LENGTH TO T FOR CORE MANAGER.
SKIPN REATMP
JRST .+3
PUSHJ P,VCHTSC ;GET SPACE FOR THE STRING.
JRST .+2 ;LOWER BOUND IS RETURNED IN T.
PUSHJ P,VCHCKC
MOVN N,N
HRLZ N,N
HRRI N,(T) ;ALMOST ANSWER KEY.
HLRZ E,X1
HRLI T,440700 ;DESTINATION POINTER.
HRRZI X1,(X1)
STRET1: HRR X2,1(X1)
HRLI X2,440700 ;ORIGINAL POINTER.
HLRE T1,1(X1) ;LOOP COUNTER.
JUMPE T1,STRET2
ILDB C,X2
IDPB C,T
AOJL T1,.-2
STRET2: AOJ X1,.+1
SOJG E,STRET1
POP P,E
POP P,C
POP P,T1
POP P,X2
POP P,X1
POPJ P, ;EXIT.
;UTILITY ROUTINE TO HANDLE THE "+" OPERATOR FOR STRINGS.
APPEND: MOVE T,MASAPP
MOVE T,(T)
TLNN T,777777
JRST APPOU1 ;T IS NULL STR.
TLNN N,777777
JRST APPOU2 ;N IS NULL STR.
TLNE T,377777
JRST APPND1
MOVE T,(T)
TLNN T,777777
JRST APPOU1 ;T IS NULL STR.
APPND1: PUSH P,X1
TLNE N,377777
JRST APPND2
MOVE X1,N
MOVE N,(X1)
TLNN N,777777
JRST APPOU3 ;N IS NULL STR.
APPND2: JUMPG T,APPND3
JUMPG N,APPND4
MOVE X1,MASAPP ;BOTH REAL.
MOVEM N,1(X1) ;PROTECT THE KEYS.
MOVEM T,(X1)
AOS MASAPP
PUSHJ P,VCHAPP ;GET AN APP BLK.
MOVE N,(X1) ;SET UP THE BLK.
MOVEM N,1(T)
MOVE N,1(X1)
MOVEM N,2(T)
HRLI N,2
HLRZM N,(T)
HRRI N,(T) ;KEY IN N.
SOS MASAPP
JRST APPOU0 ;EXIT.
APPND3: PUSH P,X2
JUMPG N,APPND5
HLRZ X1,T ;T IS APP BLK, N IS REAL.
HRRZ X2,T
ADDI X1,1(X2)
MOVEM N,(X1) ;STORE T.
AOS (X2)
HRL N,(X2) ;KEY IN N.
HRRI N,(T)
JRST APPOUT ;EXIT.
APPND4: PUSH P,X2 ;N IS REAL, T IS APP BLK.
HLRZ X1,N
HRRZ X2,N
ADDI X1,(X2)
MOVEM T,(X2) ;STORE T IN ZEROTH LOC IN N.
HLRZ T,N
AOJ T,.+1
HRL N,T
APPN41: MOVE X2,(X1)
MOVEM X2,1(X1)
SOJ X1,.+1
SOJG T,APPN41
HRLZM N,1(X1) ;[211]COUNT IN THE APP BLOCK
JRST APPOUT ;EXIT.
APPND5: HLRZ X1,T ;BOTH N AND T ARE APP BLKS.
HRRZ X2,T
ADDI X2,1(X1)
HRRZ X1,N
HRLI X2,1(X1)
HLRZ X1,N
ADDB X1,(N) ;[211]UPDATE IN APP BLK
HRLM X1,T ;[211]NEW COUNT INTO POINTER T
ADDI X1,(T)
BLT X2,(X1)
MOVE N,T ;[211]UPDATED TO KEY INN
APPOUT: POP P,X2
APPOU0: POP P,X1
APPOU1: SOS MASAPP
POPJ P,
APPOU3: POP P,X1
APPOU2: MOVE N,T
SOS MASAPP
POPJ P,
SUBTTL SUBSCRIPTED VARIABLE FETCH/STORE ROUTINES
;MATRIX ELEMENT FETCH/STORE UUO ROUTINES
SAD1ER: MOVE D,[JRST SADEND] ;FETCH ADR OF ARRAY ELEMENT
JRST AFT1ER+1
ASN1ER: MOVE D,[MOVNM N,(A)] ;NEGATIVE ARRAY STORE
JRST .+3
AST1ER: SKIPA D,[MOVEM N,(A)] ;POSITIVE ARRAY STORE
AFT1ER: MOVSI D,A(MOVE N,) ;ARRAY FETCH
MOVEI A,0 ;PSEUDO LEFT HALF
MOVE B,40 ;ARRAY ADDRESS
HRRZ C,1(B) ;TRY RIGHT DIMENSION
TRNN C,777776 ;ROW VECTOR?
HLRZ C,1(B) ;NO, MUST BE COLUMN VECTOR
JRST AFT2C ;FINISH UP WITH 2-DIM CODE
ASN2ER: MOVE D,[MOVNM N,(A)] ;NEGATIVE ARRAY STORE
JRST .+3
AST2ER: SKIPA D,[MOVEM N,(A)] ;POSITIVE ARRAY STORE
AFT2ER: MOVSI D,A(MOVE N,) ;ARRAY FETCH
MOVE B,40 ;ARRAY ADDRESS
HLRZ C,1(B) ;LEFT DIMENSION
PUSHJ P,SUBSCR ;GET AND FIX SUBSCRIPT IN E
HRRZ A,1(B)
IMUL A,E ;LEFT SCRIPT TIMES RIGHT DIM!
HRRZ C,1(B) ;RIGHT DIMENSION
AFT2C: PUSHJ P,SUBSCR ;GET AND FIX SUBSCRIPT IN E
ADD A,E ;ADD TO LEFT DIM
ADD A,(B) ;ADD ARRAY ADDRS
XCT D ;DO THE OPERATION
POPJ P, ;RETURN
SADEND: HRRZI N,(A) ;PUT STRING VECTOR POINTER ADDRESS IN N
TLO N,(1B0) ;MAKE IT LOOK LIKE AN ADDRESS, NOT A POINTER
POPJ P,
;ROUTINE TO FETCH AND CHECK SUBSCRIPT
;CALL: MOVE C,DIMENSION
; PUSHJ P,SUBSCR
SUBSCR: MOVE E,@-1(P) ;GET SUBSCRIPT
AOS -1(P) ;SKIP ARGUMENT
MOVE E,(E)
FAD E,[XWD 233400,0];FIX SUBSCRIPT
TLZ E,777400
CAMGE E,C ;CHECK DIMENSION
POPJ P,
;ON ERROR, FALL INTO DIMERR
;DIMENSION ERR ROUTINE
DIMERR: PUSHJ P,INLMES
ASCIZ /
? DIMENSION ERROR/
JRST GOSR2
SUBTTL MATRIX OPERATION RUN-TIME ROUTINES
;SET MATRIX DIMENSION -- SDIM UUO
SDIMER: MOVSI C,1 ;DONT FAIL IN SUBSCR
PUSHJ P,SUBSCR ;FIRST DIM
HRLZ A,E ;SAVE IT
PUSHJ P,SUBSCR ;SECOND DIM
HRR A,E
AOBJP A,MS0CHK ;GO CHECK DIMS AND STORE THEM
;MATRIX OPERATION SETUP ROUTINE
;USE ENTRY POINT MS2 IF 2 ARGS, MS1 IF 1 ARG, MS0 OR MS0CHK IF 0 ARGS.
;ALL ENTRIES EXPECT MS0 EXCEPT DIMENSION [XWD ROWS,COLS]
; OF DESTINATION TO BE SET UP IN A AND CHECK FOR ROOM
; AND SET DIMENSION OF DESTINATION.
;AT CALL, LOCATION 40 CONTAINS THE ADDRS OF DESTINATION DOPE VECTOR,
; RIGHT SIDE OF T1 CONTAINS ADDRS OF DOPE VECTOR FOR ARG 1
; RIGHT SIDE OF T CONTAINS ADDRS OF DOPE VECTOR FOR ARG 2
;RIGHT SIDES OF T1,T,B ARE REPLACED WITH ADDRESSES OF ELEMENTS 0,0
; OF ARG 1, ARG 2, DEST, RESPECTIVELY, WITHOUT CHANGING LEFT SIDES,
; AND THE RESULTS ARE STORED IN TEMP1, TEMP2, AND TEMP3, RESPECTIVELY.
;THE MAXIMUM ROW NUMBER OF DEST IS STORED IN SB1M1, THE MAXIMUM
; COLUMN NUMBER OF DEST IS STORED IN SB2M1
;E, T1, AND G ARE SET TO FIRST ROW NUMBER, FIRST COL NUMBER,
; AND RELATIVE LOCATION OF FIRST ELEMENT, RESPECTIVELY
;IT IS INTENDED THAT E, T1, G, TEMP1, TEMP2, TEMP3 BE SET UP FOR
; IMMEDIATE CALL TO MLP, AND THAT ELEMENTS OF FIRST
; ARGUMENT, SECOND ARGUMENT, AND DESTINATION BE ACCESSED
; BY INDIRECT ADDRESSING THROUGH TEMP1, TEMP2, AND TEMP3, RESPECTIVELY.
MS2: HRR T,(T) ;ADDRS OF FIRST ARG
MS1: HRR T1,(T1) ;ADDRS OF SECOND OR ONLY ARG
MS0CHK: HRR B,40 ;DOPE VECTOR OF DEST
HLLZ X1,A ;CHECK NEW DIMENSION
IMULI X1,(A) ;X1 := (TOTAL SIZE)0
CAMLE X1,0(B) ;IS THERE ROOM IN ARRAY?
JRST DIMERR ;NO. DIMENSION ERROR
MOVEM A,1(B) ;STORE NEW DIMENSION
MS0: HRR B,40 ;ENTER HERE FOR NO DIM CHECK
MOVE A,1(B) ;FETCH DIMENSIONS
SUB A,[XWD 1,1] ;E := (MAX ROW)MAX COL
HLRZM A,SB1M1 ;FIRST DIMENSION -1
HRRZM A,SB2M1 ;SECOND DIMENSION -1
HRR B,(B) ;ADDRS OF DEST (LEAVE IN B FOR MINV)
MOVEM T1,TEMP1 ;STORE FIRST XCT INSTRUCTION
MOVEM T,TEMP2 ;STORE SECOND XCT INSTRUCTION
MOVEM B,TEMP3 ;STORE THIRD XCT INSTRUCTION
;NOW SETUP E, T1, AND G FOR "MLP"
SKIPE E,SB1M1 ;MORE THAN 0'TH ROW?
MOVEI E,1 ;YES. USE FIRST
SKIPE T1,SB2M1 ;MORE THAN 0'TH COL
MOVEI T1,1 ;YES. USE FIRST
MOVE G,SB2M1 ;CALCULATE FIRST ELT OF RESLT
ADDI G,1
IMULI G,(E)
ADDI G,(T1)
POPJ P,
;MATRIX OPERATION MAIN LOOP
;ON CALLING, T, T1, G ARE SET UP TO ROW NUMBER, COL NUMBER, AND
; REL LOC OF CURRENT ELEMENT IN DESTINATION MATRIX.
;MLP EXECUTES THE CONTENT OF TEMP1, TEMP2, TEMP3 FOR EACH
; ELEMENT OF CURRENT ROE. AT END OF ROW, MLP RETURNS
; WITHOUT SKIP TO ALLOW ONCE-PER-ROW OPERATIONS TO BE PERFORMED.
; WHEN ALL ROWS HAVE BEEN PROCESSED, MLP RETURNS WITH SKIP.
;NOTE SPECIAL CODING SO THAT ROW AND COLUMN VECTORS ARE
; HANDLED CORRECTLY.
MLP: XCT TEMP1
XCT TEMP2
XCT TEMP3
SKIPN INVFLG
JRST MLP2
PUSH P,G
MOVM G,A
CAMLE G,INVLRG
MOVEM G,INVLRG
POP P,G
MLP2: ADDI G,1
CAMGE T1,SB2M1
AOJA T1,MLP
SKIPE SB2M1 ;MORE THAN A 0'TH COL?
AOJA G,.+2 ;YES. SKIP 0'TH COL
TDZA T1,T1 ;NO. SET TO USE 0'TH COL
MOVEI T1,1 ;YES AGAIN. SET TO USE COL 1.
CAML E,SB1M1 ;ALL ROWS USED?
AOS (P) ;YES. SET FOR SKIP RETURN
AOJA E,CPOPJ ;BUMP ROW AND RETURN
;MATRIX READ ROUTINE
;SET UP AND CALL MLP. FOR EACH ELEMENT, THE FOLLOWING
;ARE PERFORMED:
; TEMP1: PUSHJ P,MTRELT
; TEMP2: ... ;(SKIPPED)
; TEMP3: MOVEM N,<DEST>(G)
;MTRELT READS A NUMBER INTO N
MTRDER: SETZM IFIFG
MOVE T1,[PUSHJ P,MTRELT]
PUSHJ P,DOREAD
HRRZ X1,@40 ;GET ADRESS OF ZEROTH ELEMENT
CAML X1,SVRBOT ;IS THIS A STRING VECTOR?
JRST MTRDS ;ELEMENTS WILL BE STRINGS.
HRLI B,G(MOVEM N,)
MTRD1: PUSHJ P,MS0 ;SET UP FOR LOOP
SETZM 40 ;NOP THE STORE THAT DATAER USES
MTRD2: PUSHJ P,MLP ;EXECUTE LOOP
JRST .-1 ;NO ACTION ON ROW
POPJ P,
;ROUTINE CALLED BY MTRDER TO PRINT AN ELEMENT
MTRELT: PUSHJ P,DATAER
JRST CPOPJ1 ;SKIP SECOND XCT
MTRDS: MOVSI T1,(SKIPA)
MOVSI B,G(STRIN)
JRST MTRD1
;MATRIX PRINT ROUTINE
;SET UP AND CALL MLP:
; TEMP1: PUSH P,T
; TEMP2: PRNM <FORMAT CODE>,<DEST>(G)
; TEMP3: POP P,T
MTPRER: MOVE T1,[PUSH P,T1] ;TO SAVE T1 AROUND PRNM
PUSHJ P,MS0 ;SET UP FOR LOOP
HLL B,40 ;PICK UP UUO AC FIELD
TLZ B,777000 ;CONSTRUCT PRNM INSTR
SKIPN SB2M1 ;COLUMN VECTOR?
JRST .+3 ;YES. ALLOW <CR> FORMAT
TLNN B,(Z 16,) ;OH, NO. TREAT <RET> FORMAT ==<COMA> FORMAT.
HRLI B,(Z 3,)
HRRZ X1,@40
CAMGE X1,SVRBOT ;NUMBER ARRAY?
TLO B,G(PRNM) ;YES, SETUP NUMBER UUO
CAML X1,SVRBOT ;STRING ARRAY?
TLO B,G(PRSTR) ;YSE SEUP STRING PRINT UUO.$
MOVEM B,TEMP2 ;SET UP TEMP2 AND TEMP3
MOVE X1,[POP P,T1]
MOVEM X1,TEMP3
SETZM ODF
SETZB LP,HPOS
SETZM TABVAL
SETZM FMTPNT
MTP2D: PUSHJ P,MTP3D ;TWO BLANK LINES
MTP1D: SKIPE SB2M1 ;FOR THE SPECIAL CASE OF A COLUMN
JRST MTP5D ;VECTOR IN COMMA OR SEMICOLON
MOVE LP,TEMP2
TLNN LP,(Z 16,) ;FORMAT, DON'T ZERO THE FLAGS
JRST MTP5D ;BECAUSE WE ARE IN THE MIDDLE OF THE ROW.
SETZ LP,
JRST MTP4D
MTP5D: SETZB LP,HPOS
SETZM TABVAL
SETZM FMTPNT
MTP4D: PUSHJ P,MLP ;PRINT A ROW
JRST MTPRE1 ;NOW SEE WHETHER TO SPACE BETW ROWS
MTP3D: PUSHJ P,INLMES
ASCIZ /
/
OUTPUT
SETZM HPOS
SETZM TABVAL
SETZM FMTPNT
POPJ P,
MTPRE1: SKIPE SB1M1 ;VECTOR OR ARRAY?
SKIPN SB2M1
JRST MTP1D ;ARRAY... SPACE BETW ROWS
JRST MTP2D ;VECTOR...DONT SPACE BETW ROWS
;MATRIX ADD AND SUBTRACT ROUTINES
;SET UP AND CALL MLP:
; TEMP1: MOVE N,<ARG 2>(G) ;OR MOVN
; TEMP2: FADR N,<ARG 1>(G)
; TEMP3: MOVEM N,<DEST>(G)
MTADER: TLOA T1,G(MOVE N,) ;MAKE ADD INSTR (T LOADED WITH MOVEI)
MTSBER: HRLI T1,G(MOVN N,) ;MAKE SUBTRACT INSTR
HRLI T,G(FADR N,) ;FETCH
HRLI B,G(MOVEM N,)
MOVE A,1(T) ;GET AND CHECK DIMENSIONS OF ARGS
CAME A,1(T1)
JRST DIMERR
PUSHJ P,MS2 ;SET UP MATRIX LOOP
JRST MTRD2 ;FINISH -- NO EACH ROW RTN
;MATRIX SCALE ROUTINE
;SET UP AND CALL MLP:
; TEMP1: MOVE A,<ARG 1>(G)
; TEMP2: FMPR A,N
; TEMP3: MOVEM A,<DEST>(G)
MTSCER: HRLI T1,G(MOVE A,)
MOVSI T,(FMPR A,N)
MTSC1: HRLI B,G(MOVEM A,)
MOVE A,1(T1)
PUSHJ P,MS1
JRST MTRD2
;MATRIX ZERO, IDENTITY, AND ONE ROUTINES
;SET UP AND CALL MLP:
; ..IDEN.. ..ZERO.. ..ONE..
; TEMP1: SETZM@TEMP3 SETZM @TEMP3 CAIA
; TEMP2: CAMN T,T1 CAIA ...
; TEMP3: MOVEM A,<DEST>(G)......................
MTIDER: SKIPA T,[CAMN E,T1]
MTZRER: MOVSI T,(CAIA)
SKIPA T1,[SETZM @TEMP3]
MTCNER: MOVSI T1,(CAIA)
MTCN1: HRLI B,G(MOVEM D,)
MOVSI D,(DEC 1.0) ;CONSTANT 1.0 TO STORE
JRST MTRD1 ;GO FINISH WITH READ CODE
;MATRIX TRANSPOSE ROUTINE
;SET UP AND CALL MLP:
;A CONTAINS RELATIVE LOC OF CURRENT ELE IN SOURCE
; TEMP1 : FETCH SOURCE ELEMENT
; TEMP2 : UPDATE SOURCE INDEX
; TEMP3 : STORE DESTINATION ELEMENT
MTTNER: MOVS A,1(T1) ;FETCH DESTINATION DIMENSION
HRLI T1,A(MOVE N,)
HLRZ T,A ;E := ADDI A,<NBR ROWS>
HRLI T,(ADDI A,)
HRLI B,G(MOVEM N,)
PUSHJ P,MS1 ;SET UP AND CHK DIMENSION
MTTN1: MOVE A,SB1M1 ;A := <NBR ROWS>*COL + ROW
ADDI A,1
IMUL A,T1
ADD A,E
PUSHJ P,MLP ;MOVE A ROW
JRST MTTN1
POPJ P,
;MATRIX MULTIPLY ROUTINE
;SET UP AND CALL MLP
;FOR EACH ELEMENT OF DESTINATION MATRIX, CALL SUBROUTINE
; MYELT TO FORM THE DOT PRODUCT OF THE APPROPRIATE ROW AND COLUMN
MTMYER: MOVE A,1(T) ;CHECK DIMENSIONS
HLRZ D,1(T1) ;D := INNER DIMENSION
CAIE D,(A) ;SAME AS FIRST ARG?
JRST DIMERR ;NO
HRR A,1(T1)
HRLI T1,T1(MOVEI X2,) ;TO COMPUTE ADDRS OF 1ST ELT 2ND ARG
HRLI T,(MOVEI X1,) ;DITTO 1ST ARG
HRLI B,G(MOVEM N,) ;STORE INSTR
PUSHJ P,MS2 ;SETUP NEW DIMENSIONS AND MLP ARGS
MOVEI X1,1(A) ;PREPARE TO SKIP ROW ZERO IF..
CAIE D,1 ;INNER DIM=1?
ADDM X1,TEMP1
MOVE B,[PUSHJ P,MYELT] ;CALL TO ELT COMPUTATION
EXCH B,TEMP2
CAIE D,1 ;INNER DIM 1? (IE PROD OF VECTORS)
ADDI B,1 ;NO. SKIP 0'TH COL OF 1'ST ARG
JUMPE E,MTMY2 ;DONT SKIP FIRST ROW IF ONLY 1
MTMY1: ADDM D,B ;NEXT ROW OF FIRST ARG
MTMY2: PUSHJ P,MLP
JRST MTMY1
POPJ P,
;SUBROUTINE TO COMPUTE ELEMENT OF PRODUCT
;X1 CONTAINS ADDRS OF 1ST ELT OF 1ST ARG FOR DOT PRODUCT,
; AFTER FIRST XCT BELOW, X2 CONTAINS ADDRS OF SAME FOR 2ND ARG
MYELT: XCT B
MOVEI N,0 ;TO ACCUMULATE DOT PRODUCT
MOVEI C,-1(D) ;NUMBER OF ADDS= REAL INNER DIMENSION
MYEL1: PUSH P,R
MOVE R,(X1) ;PRODUCT OF 2 ELTS
FMPR R,(X2)
FADR N,R ;ADD INTO DOT PRODUCT
ADDI X2,1(A) ;NEXT ROW OF 2ND ARG
POP P,R
SOJLE C,CPOPJ ;DONE?
AOJA X1,MYEL1 ;NO. TO NEXT ELT
SUBTTL RUN-TIME MATRIX INVERTER
;SUBROUTINE TO CALL MATRIX INVERTER
MTIVER: SETOM INVFLG
SETZM INVLRG
MOVS A,1(T1) ;MAKE SURE SQUARE MATRIX
CAME A,1(T1)
JRST DIMERR
CAMLE A,INVLIM ;[240] LIMIT FOR INVERSION IS
JRST INVERR ;[240] MAT SIZE OF INVLIM
HRLI T1,G(SKIPA A,) ;MOVE DESTINATION
PUSHJ P,MTSC1 ;(USE MTCNER CODE)
SKIPE SB1M1 ;GO INVERT UNLESS ONLY ELT IS (0,0)
JRST MINVB
SUBI B,3
MOVEM B,TEMP3 ;ONLY ELEMENT IS (0,0)
AOS SB1M1 ;FOOL MINV INTO THINKING ITS (1,1)
JRST MINVB
;THIS PORTION OF THE MAT INVERSE PROG RUNS IN ACS 0-7
JLOOP:
PHASE 0
ZERO: CAMN JX,NT ;SKIP SAME COL
JRST JXIT
MOVE IX,@TEMP1 ;A(I,J)=A(I,J)+A(NT,J)*A(I,NT)
FMPR IX,(KX) ;***
MOD: FADRM IX,0(JX) ;ADDR MODIFIED BY OUTER LOOP
JXIT: CAMGE JX,SB1M1 ;LOOP DONE?
AOJA JX,ZERO
JRST IXIT2 ;YES RETURN
DEPHASE
;SOME AC DEFS FOR MINV
NT=10 ;OUTERMOST LOOP INDEX
IX=11 ;I SUBSCRIPT
JX=12 ;J SUBSCRIPT
KX=13 ;SCRATCH INDEX REG
LX=14 ; " " "
TAC1=16 ; " (MUST BE SAVE & RESTORED)
;MAIN ROUTINE ENTERS HERE TO SET UP REGS
;THE MAIN PUROPSE OF THIS ROUTINE IS TO FIND AND STORE PIVOT POINTS
;
;ROUTINE EXPECTS 1) ARRAY ADDR IN TEMP3
; 2) ORDER OF ARRAY IN SB1M1
;ROUTINE USES 1) VECT1(NT) & VECT2(NT) TO HOLD EACH PIVOT POINT
; AS IT IS FOUND
; 2) SB2M1 AS CNT OF ELEMENTS / ROW
MINVB: SETZM LIBFLG
SETZM INVFLG
HRRZS TEMP3 ;MAKE SURE ADDR ONLY
PUSH P,TAC1
MOVE TAC1,SB1M1 ;GET ORDER
ADDI TAC1,1 ;ADD ONE FOR 0'TH ROW & COL
MOVEM TAC1,SB2M1 ;SAVE IN SB2
MOVSI TAC1,(1.0) ;INIT DETERM.
MOVEM TAC1,DETER
HRLZI TAC1,JX ;SET INDEX REG IN
HLLZM TAC1,TEMP1 ;TEMP1 FOR INDIRECT
MOVE TAC1,[XWD JLOOP,ZERO]
BLT TAC1,7 ;PUT JLOOP INTO ACS
MOVEI NT,1 ;INITIALIZE OUTER LOOP
MINVLP: MOVE TAC1,NT
IMUL TAC1,SB2M1 ;CALC (NT,NT) SUBSCR
ADD TAC1,NT
ADD TAC1,TEMP3 ;***
MOVEM TAC1,TEMP2 ;SAVE IT FOR LATER
CAMN NT,SB1M1 ;LAST ITER?
JRST FOUND1 ;SAVE SEARCH STUFF
MOVM TAC1,(TAC1) ;GET A(NT,NT)
MOVE IX,NT ;INITIALIZE SEARCH
LUPI: MOVE KX,SB2M1 ;CALC I INDEX
IMUL KX,IX
ADD KX,TEMP3 ;***
MOVE JX,NT ;INIT J INDEX
LUPJ: MOVE LX,KX
ADD LX,JX ;FINISH INDEX FOR ELEMENT
MOVM LX,(LX) ;GET IT
CAMGE LX,TAC1 ;IS IT LARGER THAN PRESENT
JRST LUPEND ;NO
MOVE TAC1,LX ;YES SAVE IT
MOVEM IX,VECT1(NT) ;AND INDEXES
MOVEM JX,VECT2(NT)
LUPEND: CAMGE JX,SB1M1 ;END OF J LOOP LOGIC
AOJA JX,LUPJ
CAMGE IX,SB1M1
AOJA IX,LUPI
FOUND: CAMN NT,VECT1(NT)
MOVNS DETER
CAMN NT,VECT2(NT)
MOVNS DETER
PUSHJ P,FSWAP
FOUND1: SKIPN INVLRG ;TEST FOR SINGULARITY.
JRST SING
FOUND2: MOVE TAC1,@TEMP2 ;GET PIVOT ELEMENT
MOVEM TAC1,PIVOT ;SAVE IT
FMPRB TAC1,DETER ;PERPETUATE DETERM
JUMPE TAC1,SING
MOVSI TAC1,(1.0) ;1./A(NT,NT)
FDVRM TAC1,PIVOT ;***
MOVEI IX,1 ;SET UP I
ILOOP: CAMN IX,NT ;SKIP SAME ROW
JRST IXIT ;AS PIVOT ROW
MOVE LX,SB2M1 ;CALCULATE ALL ROW OFFSETS
IMUL LX,IX
ADD LX,TEMP3 ;LX= IX*N+A
MOVE KX,LX
ADD KX,NT ;KX=LX+NT
MOVN TAC1,PIVOT ;GET -PIVOT
FMPRM TAC1,(KX) ;A(I,NT)=A(I,NT)/(-A(NT,NT))
MOVEI JX,1 ;SET J LOOP START
MOVE TAC1,SB2M1
IMUL TAC1,NT
ADD TAC1,TEMP3 ;TAC=NT*N+A
HRRM TAC1,TEMP1 ;STORE FOR @TEMP1(JX)
HRR MOD,LX ;SAT ADDR IN INNER LOOP
PUSH P,IX
JRST ZERO ;GO
IXIT2: POP P,IX
IXIT: CAMGE IX,SB1M1 ;RETURN HERE FROM ACS
AOJA IX,ILOOP
MOVEI JX,1 ;SET LOOP FOR LAST COL
MOVE TAC1,PIVOT ;GET PIVOT
LCOL: FMPRM TAC1,@TEMP1 ;A(NT,J)=A(NT,J)/A(NT,NT)
CAMGE JX,SB1M1 ;DONE
AOJA JX,LCOL
MOVEM TAC1,@TEMP2 ;A(NT,NT)=PIVOT
CAMGE NT,SB1M1 ;INVERSE DONE?
AOJA NT,MINVLP ;NOPE, ITER AGAIN
;HERE WHEN INVERSE DONE PUT MATRIX BACK TOGETHER
MOVE NT,SB1M1 ;DO LOOP IN REVERSE ORDER
INVFIX: SOJLE NT,OUT ;FINISHED
PUSHJ P,BSWAP ;SWAP ROW - COL IN REV.
JRST INVFIX
BSWAP: MOVE KX,VECT2(NT)
MOVE LX,VECT1(NT) ;SET REGS
JRST SWAP
FSWAP: MOVE KX,VECT1(NT)
MOVE LX,VECT2(NT)
SWAP: MOVE TAC1,NT
IMUL TAC1,SB2M1
IMUL KX,SB2M1 ;CALC BOTH ROW OFFSETS
ADD TAC1,TEMP3
ADD KX,TEMP3 ;***
MOVEI JX,1
HRLI TAC1,JX
HRLI KX,JX
SWP1: MOVE IX,@TAC1
EXCH IX,@KX ;EXCHANGE ITEMS IN ROWS
MOVEM IX,@TAC1
CAMGE JX,SB1M1
AOJA JX,SWP1
MOVEI IX,1
MOVE TAC1,NT
MOVE KX,SB2M1
ADD KX,TEMP3 ;GET COL ADDR
HRLI TAC1,KX
HRLI LX,KX
SWP2: MOVE JX,@LX
EXCH JX,@TAC1
MOVEM JX,@LX
CAML IX,SB1M1 ;CHECK DONE
POPJ P, ;RETURN
ADD KX,SB2M1 ;TO NEXT COL
AOJA IX,SWP2
;HERE TO RETURN OR MAKE SINGULAR
SING: SETZB ZERO,DETER
PUSHJ P,INLMES
ASCIZ /
% SINGULAR MATRIX INVERTED/
PUSHJ P,GOSR3
OUT: SKIPE LIBFLG
JRST OUT2
OUT3: POP P,TAC1
POPJ P,0
OUT2: PUSHJ P,INLMES
ASCIZ /
% OVER OR UNDERFLOW OCCURRED DURING MAT INV/
PUSHJ P,GOSR3
JRST OUT3
INVERR: PUSHJ P,INLMES ;[240] TRIED TO INV MAT > INVLIM
ASCIZ /
?MATRIX TOO BIG TO INVERT/
JRST GOSR2
SUBTTL INTRINSIC FUNCTIONS (ADAPTED FROM LIB40)
;FLOATING POINT SINGLE PRECISION ARCTANGENT FUNCTION
;ATAN(X) = X(B0+A1(Z+B1-A2(Z+B2-A3(Z+B3)**-1)**-1)**-1)
;WHERE Z=X^2, IF 0<X<=1
;IF X>1, THEN ATAN(X) = PI/2 - ATAN(1/X)
;IF X>1, THEN RH(A) =-1, AND LH(A) = -SGN(X)
;IF X<1, THEN RH(A) = 0, AND LH(A) = SGN(X)
ATANB: ;ENTRY TO ARCTANGENT ROUTINE
MOVM T, N ;GET ABSF OF ARGUMENT
CAMG T, A1 ;IF A<2^-33, THEN RETURN WITH...
POPJ P, ;ATAN(X)=X
HLLO B, N ;SAVE SIGN, SET RH(A) = -1
CAML T, A2 ;IF A>2^33, THEN RETURN WITH
JRST AT4 ;ATAN(X) = PI/2
MOVSI T1, (1.0) ;FORM 1.0 IN T1
CAMG T, T1 ;IS ABSF(X)>1.0?
TRZA B, -1 ;IF T .LE. 1.0, THEN RH(A) = 0
FDVM T1, T ;B IS REPLACED BY 1.0/B
TLC B, (B) ;XOR SIGN WITH .G. 1.0 INDICATOR
MOVEM T, C3 ;SAVE THE ARGUMENT
FMP T, T ;GET B^2
MOVE T1, KB3 ;PICK UP N CONSTANT
FAD T1, T ;ADD B^2
MOVE N, KA3 ;ADD IN NEXT CONSTANT
FDVM N, T1 ;FORM -A3/(B^2 + B3)
FAD T1, T ;ADD B^2 TO PARTIAL SUM
FAD T1, KB2 ;ADD B2 TO PARTIAL SUM
MOVE N, KA2 ;PICK UP -A2
FDVM N, T1 ;DIVIDE PARTIAL SUM BY -A2
FAD T1, T ;ADD B^2 TO PARTIAL SUM
FAD T1, KB1 ;ADD B1 TO PARTIAL SUM
MOVE N, KA1 ;PICK UP A1
FDV N, T1 ;DIVIDE PARTIAL SUM BY A1
FAD N, KB0 ;ADD B0
FMP N, C3 ;MULTIPLY BY ORIGINAL ARGUMENT
TRNE B, -1 ;CHECK .G. 1.0 INDICATOR
FSB N, PIOT ;ATAN(N) = -(ATAN(1/A)-PI/2)
JRST .+2 ;SKIP
AT4: MOVE N, PIOT ;GET PI/2 AS ANSWER
NEGANS: SKIPGE B ;LH(A)= -SGN(T) IF B>1.0
MOVNS N ;NEGATE ANSWER
POPJ P, ;EXIT
A1: 145000000000 ;2**-33
A2: 233000000000 ;2**33
KB0: 176545543401 ;0.1746554388
KB1: 203660615617 ;6.762139240
KB2: 202650373270 ;3.316335425
KB3: 201562663021 ;1.448631538
KA1: 202732621643 ;3.709256262
KA2: 574071125540 ;-7.106760045
KA3: 600360700773 ;-0.2647686202
PIOT: 201622077325 ;PI/2
;FLOATING POINT TRUNCATION FUNCTION
;TRUNCATES FRACTIONAL PART OF FLOATING POINT NUMBER
;AND RETURNS ANSWER AS N FLOATING POINT NUMBER. THE
;ALGORITHM MAKES USE OF THE NORMALIZING PROPERTIES OF FAD.
;ROUTINE EXITS WITH (T)=ZERO IF NUMBER WAS AN INTEGER.
INTB: MOVE B,N ;SAVE ARGUMENT
MOVMS N ;GET ABSF(ARG)
SKIPGE B ;NEGATIVE?
FAD N,ALMST1 ;YES. MAKE AINT[-2.3]=-3 ETC.
CAML N,MOD1 ;IS ARGUMENT<=2**26?
JRST NEGANS ;YES; IT MUST BE AN INTEGER ALREADY
FAD N,MOD1
FSB N,MOD1 ;NOW FRACTIONAL PART HAS BEEN LOST
JRST NEGANS ;CHECK SIGN AND EXIT.
MOD1: XWD 233400,000000 ; 2**26
ALMST1: XWD 200777,777777 ;1.0-<SMALLEST QUANTITY>
;COMMON LOG FUNCTION (LOG TO THE BASE 10).
CLOGB: JUMPE N,LZERO
PUSHJ P,LOGB2 ;GET LOGE(N).
FMPR N,[XWD 177674,557305] ;MULTIPLY BY LOG10(E).
POPJ P,
;FLOATING POINT SINGLE PRECISION LOGARITHM FUNCTION
;LOG(ABSF(X)) IS CALCULATED BY THE SUBROUTINE, AND AN
;ARGUMENT OF ZERO IS RETURNED AS MINUS INFINITY. THE ALGORITHM IS
;LOGE(X) = (I + LOG2(F))*LOGE(2)
;WHERE X = (F/2)*2^(I+1), AND LOG2(F) IS GIVEN BY
;LOG2(F) = C1*Z + C3*Z^3 + C5*Z^5 - 1/2
;AND Z = (F-SQRT(2))/(F+SQRT(2))
LOGB: JUMPE N, LZERO ;CHECK FOR ZERO ARGUMENT
LOGB2: JUMPG N,LOGB3
JRST ALOGB1 ;SEND ERROR MESSAGE, GET ABS(ARG).
LOGB3: CAMN N, ONE ;CHECK FOR 1.0 ARGUMENT
JRST ZERANS ;IT IS 1.0 RETURN ZERO ANS.
ASHC N, -33 ;SEPARATE FRACTION FROM EXPONENT
ADDI N, 211000 ;FLOAT THE EXPONENT AND MULT. BY 2
MOVSM N, C3 ;NUMBER NOW IN CORRECT FL. FORMAT
MOVSI N, 567377 ;SET UP -401.0 IN N
FADM N, C3 ;SUBTRACT 401 FROM EXP.*2
ASH T, -10 ;SHIFT FRACTION FOR FLOATING
TLC T, 200000 ;FLOAT THE FRACTION PART
FAD T, L1 ;B = T-SQRT(2.0)/2.0
MOVE N, T ;PUT RESULTS IN N
FAD N, L2 ;A = N+SQRT(2.0)
FDV T, N ;B = B/A
MOVEM T, LZ ;STORE NEW VARIABLE IN LZ
FMP T, T ;CALCULATE Z^2
MOVE N, L3 ;PICK UP FIRST CONSTANT
FMP N, T ;MULTIPLY BY Z^2
FAD N, L4 ;ADD IN NEXT CONSTANT
FMP N, T ;MULTIPLY BY Z^2
FAD N, L5 ;ADD IN NEXT CONSTANT
FMP N, LZ ;MULTIPLY BY Z
FAD N, C3 ;ADD IN EXPONENT TO FORM LOG2(X)
FMP N, L7 ;MULTIPLY TO FORM LOGE(X)
POPJ P, ;EXIT
LZERO: PUSHJ P,INLMES
ASCIZ /
% LOG OF ZERO/
PUSHJ P,GOSR3 ;PRINT LINE NUMBER.
MOVE N, MIFI ;PICK UP MINUS INFINITY
POPJ P, ;EXIT
;COMMON EXITS:
ZERANS: SETZI N, ;MAKE ARG ZERO
POPJ P, ;EXIT
;CONSTANTS FOR ALOGB
ONE: 201400000000
L1: 577225754146 ;-0.707106781187
L2: 201552023632 ;1.414213562374
L3: 200462532521 ;0.5989786496
L4: 200754213604 ;0.9614706323
L5: 202561251002 ;2.8853912903
ALOGB1: PUSH P,N ;SAVE ARGUMENT
PUSHJ P,INLMES
ASCIZ /
% LOG OF NEGATIVE NUMBER/
PUSHJ P,GOSR3 ;PRINT LINE NUMBER
POP P,N ;GET ARG
MOVMS N,N
JRST LOGB3 ;USE ABS VALUE.
L7: 200542710300 ;0.69314718056
MIFI: XWD 400000,000001 ;GOAL POSTS. LARGEST NEGATIVE NUMBER.
;FLOATING POINT SINGLE PRECISION SINE AND COSINE FUNCTION
;THE ARGUMENT IS IN RADIANS.
;ENTRY POINTS ARE SIN AND COS.
;COS CALLS SIN TO CALCULATE SIN(PI/2 + X)
;THE ROUTINE CALCULATES SINES AFTER REDUCING THE ARGUMENT TO
;THE FIRST QUADRANT AND CHECKING THE OVERFLOW BITS TO DETERMINE
;THE QUADRANT OF THE ORIGINAL ARGUMENT
;000 - 1ST QUADRANT
;001 - 2ND QUADRANT, X=-(X-PI)
;010 - 3RD QUADRANT, X=-(X-PI)
;011 - 4TH QUADRANT, X=X-3*PI/2-PI/2
;THE ALGORITHM USES N MODIFIED TAYLOR SERIES TO CALCULATE
;THE SINE OF THE NORMALIZED ARGUMENT.
COSB: SETZM LIBFLG ;ENTRY TO COSINE RADIANS ROUTINE
FADR N,PIOT ;ADD PI/2
SKIPE LIBFLG ;FALL INTO SINE ROUTINE.
JRST SINLRG
SINB: ;ENTRY TO SINE RADIANS ROUTINE
MOVEM N, SX ;SAVE THE ARG
MOVM T,N ;GET ABS OF ARGUMENT
CAMG T, SP2 ;SINX = X IF X<2^-10
POPJ P, ;EXIT WITH ANS=ARG
FDVR T, PIOT ;DIVIDE X BY PI/2
CAMG T, ONE ;IS X/(PI/2) < 1.0?
JRST S2 ;YES, ARG IN 1ST QUADRANT ALREADY
MULI T, 400 ;NO, SEPARATE FRACTION AND EXP.
CAILE T,232
JRST SINLRG
ASH T1, -202(T) ;GET X MODULO 2PI
MOVEI T, 200 ;PREPARE FLOATING FRACTION
ROT T1, 3 ;SAVE 3 BITS TO DETERMINE QUADRANT
LSHC T, 33 ;ARGUMENT NOW IN RANGE (-1,1)
FADRI T,0 ;NORMALIZE THE ARGUMENT
JUMPE T1, S2 ;REDUCED TO FIRST QUAD IF BITS 00
TLCE T1, 1000 ;SUBTRACT 1.0 FROM ARG IF BITS ARE
FSBRI T,201400 ;01 OR 11
TLCE T1, 3000 ;CHECK FOR FIRST QUADRANT, 01
TLNN T1, 3000 ;CHECK FOR THIRD QUADRANT, 10
MOVNS T ;01,10
S2: SKIPGE SX ;CHECK SIGN OF ORIGINAL ARG
MOVNS T ;SIN(-X) = -SIN(X)
MOVEM T, SX ;STORE REDUCED ARGUMENT
FMPR T, T ;CALCULATE X^2
MOVE N, SC9 ;GET FIRST CONSTANT
FMP N, T ;MULTIPLY BY X^2
FAD N, SC7 ;ADD IN NEXT CONSTANT
FMP N, T ;MULTIPLY BY X^2
FAD N, SC5 ;ADD IN NEXT CONSTANT
FMP N, T ;MULTIPLY BY X^2
FAD N, SC3 ;ADD IN NEXT CONSTANT
FMP N, T ;MULTIPLY BY X^2
FAD N, PIOT ;ADD IN LAST CONSTANT
S2B: FMPR N, SX ;MULTIPLY BY X
POPJ P, ;EXIT
SC3: 577265210372 ;-0.64596371106
SC5: 175506321276 ;0.07968967928
SC7: 606315546346 ;0.00467376557
SC9: 164475536722 ;0.00015148419
SP2: 170000000000 ;2**-10
SINLRG: PUSHJ P,INLMES
ASCIZ /
% MAGNITUDE OF SIN OR COS ARG TOO LARGE TO BE SIGNIFICANT/
PUSHJ P,GOSR3
SETZ N,
POPJ P,
;FLOATING POINT SINGLE PRECISION SQUARE ROOT FUNCTION
;THE SQUARE ROOT OF THE ABSOLUTE VALUE OF THE ARGUMENT IS
;CALCULATED. THE ARGUMENT IS WRITTEN IN THE FORM
; X= F*(2**2B) WHERE 0<F<1
;SQRT(X) IS THEN CALCULATED AS (SQRT(X))*(2**B)
;SQRT(F) IS CALCULATED BY N LINEAR APPROXIMATION, THE NATURE
;OF WHICH DEPENDS ON WHETHER 1/4 < F < 1/2 OR 1/2 < F < 1,
;FOLLOWED BY TWO ITERATIONS OF NEWTON'S METHOD.
SQRTB: MOVE T, N ;PICK UP THE ARGUMENT IN T
JUMPL T,SQRMIN ;SQRT OF NEGATIVE NUMBER?
JUMPE T,SQRT1 ;CHECK FOR ARGUMENT OF ZERO
SQRTB0: ASHC T, -33 ;PUT EXPONENT IN T, FRACTION IN T1
SUBI T, 201 ;SUBTRACT 201 FROM EXPONENT
ROT T, -1 ;CUT EXP IN HALF, SAVE ODD BIT
HRRM T,EX1 ;SAVE FOR FUTURE SCALING OF ANS
;IN FSC N,. INSTRUCTION
LSH T, -43 ;GET BIT SAVED BY PREVIOUS INST.
ASH T1, -10 ;PUT FRACTION IN PROPER POSITION
FSC T1, 177(T) ;PUT EXPONENT OF FRACT TO -1 OR 0
MOVEM T1, N ;SAVE IT. 1/4 < F < 1
FMP T1, SQCON1(T) ;LINEAR FIRST APPROX,DEPENDS ON
FAD T1, SQCON2(T) ;WHETHER 1/4<F<1/2 OR 1/2<F<1.
MOVE T, N ;START NEWTONS METHOD WITH FRAC
FDV T, T1 ;CALCULATE X(0)/X(1)
FAD T1, T ;X(1) + X(0)/X(1)
FSC T1, -1 ;1/2(X(1) + X(0)/X(1))
FDV N, T1 ;X(0)/X(2)
FADR N, T1 ;X(2) + X(0)/X(2)
XCT EX1
SQRT1: POPJ P, ;EXIT
SQCON1: 0.8125 ;CONSTANT, USED IF 1/4<FRAC<1/2
0.578125 ;CONSTANT, USED IF 1/2<FRAC<1
SQCON2: 0.302734 ;CONSTANT, USED IF 1/4<FRAC<1/2
0.421875 ;CONSTANT, USED IF 1/2<FRAC<1
SQRMIN: PUSH P,T ;SAVE ARG
PUSHJ P,INLMES
ASCIZ /
% SQRT OF NEGATIVE NUMBER/
PUSHJ P,GOSR3 ;PRINT LINE NUMBER
POP P,T ;GET ARG
MOVMS T
JRST SQRTB0 ;USE ABSOLUTE VALUE
;TAN - SINGLE PRECISION TANGENT ROUTINE.
;
;BASED ON ACM ALGORITHM 229, (COMM. ACM, 7, MAY 1964, J. MORELOCK).
;METHOD:
;
;TAN(N*(PI/2)+A) = -(1/TAN(A)) IF N IS ODD,
;TAN(N*(PI/2)+A) = TAN(A) IF N IS EVEN.
;
;/A/ IS <= 0.5*(PI/2).
;ON ENTRY, THE ARG IS IN AC N.
;ON EXIT, THE ANSWER IS IN AC N.
;COTAN (X)=TAN(PI/2-X)
COTB: JUMPE N,TANB1
MOVNS N ;CALCULATE -X...
FADR N,PIOT ;PLUS PI/2
TANB: PUSH P,T1
MOVM T1,N
CAMG T1,[3.464102E-4] ;A CHECK FOR TAN(X)=X,
JRST TAN55 ;MORE OR LESS.
PUSH P,T
PUSH P,A
FDVR T1,PIOT
MOVEI T,1
CAMGE T1,[XWD 200400,000000] ;REDUCE ARG?
JRST TAN2 ;NO NEED.
TAN0: MOVE T,T1 ;YES.
MULI T1,400
SETZM LIBFLG
ASH A,-243(T1)
SKIPN LIBFLG
JRST TAN05
SETZ N,
JRST TAN52
TAN05: MOVE T1,T
ANDI A,1 ;A POINTS TO QUADRANT.
JUMPE A,.+2
MOVN N,N
FSBRI T1,200400
MULI T1,400
EXCH T1,A
MOVEI T,0
CAIL A,233
TDZA T1,T1
ASHC T,-200(A)
ANDI T,1 ;T POINTS TO INVERSION.
LSH T1,-10
TLO T1,200000
FSBRI T1,200400
MOVM T1,T1
TAN1: JUMPGE N,.+2 ;ORIGINAL ARG OR QUADRANT
MOVN T1,T1 ;REQUIRES NEGATIVE.
MOVE N,T1
FMPR N,PIOT
MOVM A,N
CAMGE A,[3.464102E-4]
JRST TAN6
TAN2: PUSH P,B ;ROUTINE TO CALC TAN(A),
MOVE A,N ;BASED ON ACM ALGORITHM
FMPR A,A ;REFERENCED ABOVE.
MOVE B,A
FDVRI B,572340 ;-18.
FADRI B,204700 ;14.
MOVN T1,A
FDVR T1,B
FADRI T1,204500 ;10.
MOVN B,A
FDVR B,T1
FADRI B,203600 ;6.
MOVN T1,A
FDVR T1,B
FADRI T1,202400 ;2.
FMPRI N,202400
FMPR N,T1
FMPR T1,T1
FSBR T1,A
FDVR N,T1
POP P,B
TAN6: SETZM LIBFLG
JUMPN T,TAN52 ;IF T =0, INVERT.
HRLZI T,201400
FDVRM T,N
SKIPE LIBFLG
PUSHJ P,TANB1
TAN52: POP P,A
POP P,T
TAN55: POP P,T1
TAN4: POPJ P,
TANB1: PUSH P,N
PUSHJ P,INLMES
ASCIZ ?
% TAN OF PI/2 OR COTAN OF ZERO?
PUSHJ P,GOSR3 ;PRINT LINE NUMBER AND EXIT WITH LARGE ANSWER.
POP P,N
JUMPL N,.+3
HRLOI N,377777
POPJ P,
MOVE N,MIFI
POPJ P,
;FLOATING POINT SINGLE PRECISION EXPONENTIAL FUNCTION
;THE ARGUMENT IS RESTRICTED TO THE FOLLOWING RANGE
; -88.028<X<88.028
;IF X<-88.028, THE PROGRAM RETURNS ZERO AS THE ANSWER
;IF X>88.028, THE PROGRAM RETURNS +INFINITY AS THE ANSWER
;THE RANGE OF THE ARGUMENT IS REDUCED AS FOLLOWS:
;EXP(X) = 2**(X*LOG(B)BASE2) = 2**(M+F)
;WHERE M IS AN INTEGER AND F IS N FRACTION
;2**M IS CALCULATED BY ALGEBRAICALLY ADDING M TO THE EXPONENT
;OF THE RESULT OF 2**F. 2**F IS CALCULATED AS
;2**F = 2(0.5+F(A+B*F^2 - F-C(F^2 + D)**-1)**-1
;THE ROUTINE HAS THE FOLLOWING CALLING SEQUENCE:
; PUSHJ P, EXP
;
;THE ARGUMENT IS IN N
;THE ANSWER IS RETURNED IN ACCUMULATOR N
EXPB: ;ENTRY TO EXPONENTIAL ROUTINE
MOVE T, N ;PICK UP THE ARGUMENT IN T
MOVM N, T ;GET ABSF(X)
CAMLE N, E7 ;IS ARGUMENT IN PROPER RANGE?
JRST EXTOLG ;EXP TOO LARGE.;##MSG +CON OR STOP?
EXP1: SETZM ES2 ;INITIALIZE ES2
MULI T, 400 ;SEPARATE FRACTION AND EXPONENT
TSC T, T ;GET N POSITIVE EXPONENT
MUL T1, E5 ;FIXED POINT MULTIPLY BY LOG2(B)
ASHC T1, -242(T) ;SEPARATE FRACTION AND INTEGER
AOSG T1 ;ALGORITHM CALLS FOR MULT. BY 2
AOS T1 ;ADJUST IF FRACTION WAS NEGATIVE
HRRM T1, EX1 ;SAVE FOR FUTURE SCALING
ASH A, -10 ;MAKE ROOM FOR EXPONENT
TLC A, 200000 ;PUT 200 IN EXPONENT BITS
FADB A, ES2 ;NORMALIZE, RESULTS TO A AND ES2
FMP A, A ;FORM X^2
MOVE N, E2 ;GET FIRST CONSTANT
FMP N, A ;E2*X^2 IN N
FAD A, E4 ;ADD E4 TO RESULTS IN A
MOVE T, E3 ;PICK UP E3
FDV T, A ;CALCULATE E3/(F^2 + E4)
FSB N, T ;E2*F^2-E3(F^2 + E4)**-1
MOVE T1, ES2 ;GET F AGAIN
FSB N, T1 ;SUBTRACT FROM PARTIAL SUM
FAD N, E1 ;ADD IN E1
FDVM T1, N ;DIVIDE BY F
FAD N, E6 ;ADD 0.5
XCT EX1 ;SCALE THE RESULTS
POPJ P, ;EXIT
E1: 204476430062 ;9.95459578
E2: 174433723400 ;0.03465735903
E3: 212464770715 ;617.97226953
E4: 207535527022 ;87.417497202
E5: 270524354513 ;LOG(B), BASE 2
E6: 0.5
E7: 207540071260 ;88.028
EXTOLG: JUMPG T,EXTOL1
PUSHJ P,INLMES
ASCIZ /
% UNDERFLOW IN EXP/
PUSHJ P,GOSR3
SETZ N,
POPJ P,
EXTOL1: PUSHJ P,INLMES
ASCIZ /
% OVERFLOW IN EXP/
PUSHJ P,GOSR3 ;PRINT LINE NUMBER
HRLOI N,377777 ;GET LARGEST ANSWER AND RETURN.
POPJ P,
;SINGLE PRECISION EXP.2 FUNCTION
;THIS ROUTINE CALCULATES A FLOATING POINT NUMBER TO A FIXED
;POINT POWER. THE CALCULATION IS A**B, WHERE T IS OF THE FORM
; T=Q(0) + Q(1)*2 + Q(2)*4 + ...WHERE Q(I)=0 OR 1
;THE BASE IS IN ACCUMULATOR N
;AND THE EXPONENT IS IN ACCUMULATOR (N+1) WHEN THE ROUTINE IS
;CALLED. THE ANSWER IS RETURNED IN ACCUMULATOR N.
;EXP.2 IS CALLED ONLY BY EXP.3. IT IS GUARANTEED THAT THE
;BASE AND THE EXPONENT ARE NON-ZERO.
EXP2.0: PUSH P,T ;SAVE FOR OVER/UNDERFLOW CHECKING.
PUSH P,N
SETZM LIBFLG ;CLEAR THE OVER/UNDERFLOW FLAG.
MOVSI T1,(1.0)
JUMPGE T,FEXP2
MOVMS T
FDVRM T1,N
MOVSI T1,(1.0)
JRST FEXP2
FEXP1: FMP N, N ;FORM A**N, FLOATING POINT
LSH T, -1 ;SHIFT EXPONENT FOR NEXT BIT
FEXP2: TRZE T, 1 ;IS THE BIT ON?
FMP T1, N ;YES, MULTIPLY ANSWER BY A**N
JUMPN T, FEXP1 ;UPDATE A**N UNLESS ALL THROUGH
MOVE N, T1 ;PICK UP RESULT FROM T1
SKIPE LIBFLG ;IF OVER/UNDERFLOW,
JRST FEXP4 ;GO TO FEXP4.
POP P,T ;CLEAR OFF PLIST. DO NOT POP INTO N!!!!
POP P,T ;(BECAUSE THE ANSWER IS IN N).
POPJ P, ;EXIT
FEXP4: POP P,N ;OVER/UNDERFLOW ROUTINE.
POP P,T
MOVM T1,N
CAMG T1,ONE
JRST .+3 ;/BASE/>1,EXP>0 MEANS OVER.
JUMPG T,.+3 ;/BASE/>1,EXP<0 MEANS UNDER.
JRST EXP3D3 ;/BASE/<1,EXP>0 MEANS UNDER.
JUMPG T,EXP3D3 ;/BASE/<1,EXP<0 MEANS OVER.
JUMPG N,.+3 ;THIS IS OVER. WHAT IS THE SIGN?
TRNE T,1
JRST FEXP5
PUSHJ P,EXP3D2
HRLOI N,377777
POPJ P,
FEXP5: PUSHJ P,EXP3D2
MOVE N,MIFI
POPJ P,
;SINGLE PRECISION FORTRAN IV EXP.3 FUNCTION
;THIS ROUTINE CALCULATES A FLOATING POINT NUMBER RAISED TO A
;FLOATING POINT POWER. THE CALCULATION IS
; A**B= EXP(B*LOG(N))
;IF THE EXPONENT IS AN INTEGER THE
;RESULT WILL BE COMPUTED USING "EXP2.0" .
;THE CALLING SEQUENCE FOR THE ROUTINE IS AS FOLLOWS:
; PUSHJ P, EXP3.0
;THE BASE IS IN ACCUMULATOR N
;AND THE EXPONENT IS IN ACCUMULATOR (N+1) WHEN THE ROUTINE
;IS CALLED. THE RESULT IS RETURNED IN ACCUMULATOR N.
EXP3.0: JUMPE T,EXP3A ;IS EXPONENT ZERO?
JUMPN N,EXP3A0 ;IS BASE ZERO?
JUMPL T,EXPB3 ;ERROR IF BASE=0, EXP <0.
POPJ P, ;IMMED. RETURN IF BASE=0, EXP>=0.
EXP3A0: MOVM A,T ;SET UP ABS VAL OF EXPON FOR SHIFTING
JUMPL N,EXP3C ;IS BASE NEGATIVE?
EXP3A1: MOVEI T1,0 ;CLEAR AC T1 TO ZERO
LSHC T1,11 ;SHIFT 9 PLACES LEFT
SUBI T1,200 ;TO OBTAIN SHIFTING FACTOR
JUMPLE T1,EXP3GO ;IS T1 > 0
HRRZ B,T1 ;SET UP B AS AN INDEX REG.
CAILE B,43
JRST EXP3GO
MOVEI T1,0 ;CLEAR OUT AC T1
LSHC T1,(B) ;SHIFT LFT BY CONTENTS OF B
JUMPN A,EXP3GO ;IS EXPONENT AN INTEGER ?
SKIPGE T ;YES, WAS IT NEG. ?
MOVNS T1 ;YES, NEGATE IT
MOVE T,T1 ;MOVE INTEGER INTO T
JRST EXP2.0 ;OBTAIN RESULT USING EXP2.0
EXP3GO: PUSH P,T ;SAVE EXPONENT
PUSHJ P,LOGB ;CALCULATE LOG OF N
SETZM LIBFLG ;CLEAR THE OVER/UNDERFLOW FLAG.
FMPR N,(P) ;CALCULATE B*LOG(N)
POP P,T ;RESTORE EXP.
SKIPE LIBFLG ;EXP3D AND EXP3D1 ARE ERROR ROUTINES.
JRST EXP3D
MOVM T,N
CAMLE T,E7
JRST EXP3D1
PUSHJ P, EXPB ;CALCULATE EXP(B*LOG(N))
POPJ P, ;RETURN
EXP3D: MOVM T,N
CAML T,ONE
JRST EXP3A ;UNDERFLOW IN ARG TO EXP MEANS ANS=1.
EXP3D1: JUMPL N,EXP3D3 ;OVERFLOW MEANS OVER/UNDER IN ANS.
EXP3D2: PUSHJ P,INLMES
ASCIZ /
% OVERFLOW/
JRST LRGNS1
EXP3D3: PUSHJ P,INLMES
ASCIZ /
% UNDERFLOW/
PUSHJ P,GOSR3
SETZ N,
POPJ P,
EXP3A: MOVSI N,(1.0) ;ANSWER IS 1.0
POPJ P,
EXPB3: PUSHJ P,INLMES
ASCIZ /
% ZERO TO A NEGATIVE POWER/
LRGNS1: PUSHJ P,GOSR3
HRLOI N,377777 ;LARGEST ANSWER.
POPJ P,
EXP3C: MOVE X1,A
FAD X1,FIXCON
FSB X1,FIXCON
CAMN A,X1
JRST EXP3A1 ;NEGATIVE BASE, INTEGRAL POWER
PUSH P,N ;SAVE ARGUMENTS
PUSH P,T
PUSHJ P,INLMES
ASCIZ /
% ABSOLUTE VALUE RAISED TO POWER/
PUSHJ P,GOSR3
POP P,T
POP P,N
EXP3C0: MOVMS N
JRST EXP3A0
SUBTTL INTRINSIC FUNCTIONS
;CHRB IS THE LIBRARY ROUTINE FOR CHR$.
CHRB: CAMGE N,ONE28 ;ARG MUST TRUNCATE TO >= 0
CAMG N,MINONE ;AND < 128.
JRST CHRERR
JUMPGE N,.+2
TDCA N,N
PUSHJ P,IFIX
CAIG N,^D13
CAIGE N,^D10
JRST .+2
JRST PTXER1 ;ILLEGAL LF, FF, VT CHARACTER.
MOVEI T,1
PUSHJ P,VCHTSW ;GET SPACE FOR STRING.
LSH N,^D29
MOVEM N,(T)
HRRZI N,(T)
HRLI N,777777
POPJ P,
CHRERR: PUSHJ P,INLMES
ASCIZ /
? CHR$ ARGUMENT/
JRST OUTBND
;INSTRB IS THE LIBRARY ROUTINE FOR INSTR.
INSTRB: MOVEI N,1 ;ENTRY POINT.
JRST INSTR1
JUMP
POP P,T
POP P,N
PUSH P,T
CAMGE N,ONE ;ENTRY POINT.
JRST INSERR
PUSHJ P,IFIX
INSTR1: PUSH P,X1
PUSH P,X2
PUSH P,F
MOVE F,N ;START POSITION IN F.
SOS N,MASAPP
PUSHJ P,LENBF ;GET LEN OF 1ST STR.
AOS MASAPP
AOS X2,MASAPP
CAMG F,N ;LEN < START POSITION?
JRST INSTR3 ;NO.
INSOUT: SETZ N,
INSOU1: POP P,F
POP P,X2
POP P,X1
SOS MASAPP
SOS MASAPP
POPJ P,
INSTR3: MOVE X1,-1(X2)
PUSH P,C
MOVE C,N ;FIRST LEN IN C.
MOVE N,MASAPP
PUSHJ P,LENBF ;GET LENGTH OF 2ND STR.
AOS MASAPP
JUMPN N,INSTR4 ;NULL?
POP P,C ;YES.
MOVEI N,(F)
PUSHJ P,IFLOAT
JRST INSOU1
INSTR4: MOVE X2,(X2)
PUSH P,G
PUSH P,A
PUSH P,B
PUSH P,E
PUSH P,T1
MOVE G,N ;2ND LEN IN G.
MOVE A,MASAPP ;GET ANY APPD STRS
TLNN X1,777777 ;IN TEMP. SPACE.
JRST INSTR6 ;ALSO KEYS IN THE
TLNE X1,377777 ;FORM -N,LOC.
JRST INSTR5
MOVE X1,(X1)
TLNN X1,777777
JRST INSTR6
INSTR5: JUMPLE X1,INSTR6
MOVE N,X1
PUSHJ P,STRETT
MOVE X1,N
MOVE X2,(A)
INSTR6: TLNN X2,777777
JRST INSTR8
TLNE X2,377777
JRST INSTR7
MOVE X2,(X2)
TLNN X2,777777
JRST INSTR8
INSTR7: JUMPLE X2,INSTR8
MOVEM X1,-1(A)
MOVE N,X2
PUSHJ P,STRETT
MOVE X2,N
MOVE X1,-1(A)
INSTR8: MOVEI A,(F) ;SEARCH.
MOVEI B,1
INST85: MOVEI N,-1(A) ;GET C(A)TH CHAR OF 1ST
IDIVI N,5 ;STR TO T1 AND C(B)TH
ADDI N,(X1) ;CHAR OF 2ND STR TO E.
HLL N,INSPTR(T)
LDB T1,N
MOVEI N,-1(B)
IDIVI N,5
ADDI N,(X2)
HLL N,INSPTR(T)
LDB E,N
CAIE T1,(E) ;CHARS EQUAL?
JRST INST11 ;NO.
AOJ B,.+1 ;YES.
CAIG B,(G) ;FINISHED WITH 2ND STR?
JRST INSTR9 ;NO.
MOVEI N,(F) ;YES.
PUSHJ P,IFLOAT
INSOU2: POP P,T1
POP P,E
POP P,B
POP P,A
POP P,G
POP P,C
JRST INSOU1
INSTR9: AOJ A,.+1
CAIG A,(C) ;AT END OF 1ST STR?
JRST INST85 ;NO.
INST11: AOJ F,.+1 ;YES. TRY AGAIN FROM NEXT PLACE.
CAIG F,(C) ;NO MORE PLACES?
JRST INSTR8
SETZ N, ;NO MORE. FAIL.
JRST INSOU2
440700000000
INSPTR: 350700000000
260700000000
170700000000
100700000000
010700000000
INSERR: PUSHJ P,INLMES
ASCIZ /
? INSTR ARGUMENT/
JRST OUTBND
;LEFTB IS THE LIBRARY ROUTINE FOR LEFT$.
LEFTB: CAMGE N,ONE ;ARG MUST BE >= 1.
JRST LEFERR
PUSHJ P,IFIX
SOS T,MASAPP
MOVE T,1(T) ;STRING KEY TO AC 1.
TLNE T,777777
JRST LEFTB1
LEFOU1: SETZ N, ;NULL ANSWER.
POPJ P,
LEFTB1: JUMPL T,LEFTB2
EXCH T,N ;APP BLK. IS KEY.
JRST LEFTB4
LEFTB2: TLNE T,377777
JRST LEFTB3
MOVE T,(T)
TLNN T,777777
JRST LEFOU1
LEFTB3: PUSH P,T1
HLRE T1,T
EXCH N,T
MOVN T,T
CAMLE T,T1
HRL N,T
POP P,T1
POPJ P, ;EXIT.
LEFTB4: PUSH P,T1
PUSH P,X1
MOVE T1,N ;SAVE KEY IN T1.
MOVE X1,T ;SAVE REQ. LEN IN X1.
PUSHJ P,LENAPB
CAILE N,(X1)
JRST LEFTB5
MOVE N,T1
JRST LEFOU2
LEFTB5: HRRZ T,T1
LEFTB6: HLRE N,1(T) ;SUCCESSIVELY "SUBTRACT"
ADD X1,N ;SUBSTRINGS UNTIL
JUMPLE X1,LEFTB7 ;X1 BECOMES <= 0.
AOJA T,LEFTB6
LEFTB7: JUMPE X1,LEFTB8
SUB X1,N ;TRUNCATE THE SUBSTRING KEY.
MOVN X1,X1
HRLM X1,1(T)
LEFTB8: SUBI T,-1(T1) ;TRUNCATE THE BLOCK.
MOVEM T,(T1)
HRLM T,T1
MOVE N,T1
LEFOU2: POP P,X1
POP P,T1
POPJ P, ;EXIT.
LEFERR: PUSHJ P,INLMES
ASCIZ /
? LEFT$ ARGUMENT/
JRST OUTBND
;LEN ROUTINE.
LENB: SETZM FLOAT
JRST .+2
LENBF: SETOM FLOAT
SOS T,MASAPP
MOVE N,+1(T)
TLNE N,777777 ;NULL STRING?
JRST LENB4 ;NO.
LENB2: SETZ N, ;YES, NULL STRING.
POPJ P,
LENB4: JUMPG N,LENAPP ;APPEND KEY?
TLNE N,377777 ;NO. REAL KEY?
JRST LENB3 ;YES, REAL KEY.
MOVE T,N ;NO, NOT REAL KEY, SO
MOVE N,(T) ;RETRIEVE THE REAL KEY.
JUMPGE N,LENB2 ;MUST BE EITHER NULL STRING OR
LENB3: HLRE N,N ;LENGTH IN LH.
MOVM N,N
JRST LENAP2
LENAPP: PUSHJ P,LENAPB ;APPEND KEY.
LENAP2: SKIPN FLOAT
PUSHJ P,IFLOAT
POPJ P,
LENAPB: PUSH P,X1 ;LENGTH OF STRING IN APP BLK ROUTINE.
PUSH P,X2
HLRZ T,N
HRRZ X1,N
SETZ N,
SOJL T,LENAP1 ;T HAS NUMBER OF KEYS.
HLRE X2,1(X1)
SUB N,X2 ;ADD UP THE LENGTHS
AOJA X1,.-3
LENAP1: CAILE N,^D132 ;CHECK LENGTH <= 132.
JRST LENERR
POP P,X2
POP P,X1
POPJ P,
LENERR: PUSHJ P,INLMES
ASCIZ /
? STRING FORMULA > 132 CHARACTERS/
JRST GOSR2
;MIDB IS THE LIBRARY ROUTINE FOR MID$.
MIDB: HRLOI T,377777 ;ENTRY POINT.
MOVEM T,MIDSAV
JRST MIDB1
CAMGE N,ONE ;ENTRY POINT.
JRST MIDERR
PUSHJ P,IFIX ;MIDSAV TEMPORARILY CONTAINS THE
MOVEM N,MIDSAV ;REQUESTED LENGTH.
POP P,T ;CLEAR PLIST AND ALSO GET ARG.
POP P,N
PUSH P,T
MIDB1: CAMGE N,ONE
JRST MIDERR
PUSHJ P,IFIX
SOJ N,.+1
PUSH P,C
MOVE C,N
PUSHJ P,LENBF
AOS MASAPP
SUBI N,(C) ;TOTAL LENGTH + 1 - STARTING POINT.
JUMPLE N,MIDB2
CAMLE N,MIDSAV
MOVE N,MIDSAV
EXCH N,C
MOVE T,MASAPP ;C HAS LEN OF SUBSTR, N HAS START POINT.
JRST RIENTY ;GO TO RIGHT$ ROUTINE.
MIDB2: SETZ N,
JRST RIGOU1
MIDERR: PUSHJ P,INLMES
ASCIZ /
? MID$ ARGUMENT/
JRST OUTBND
;RIGHTB IS THE LIBRARY ROUTINE FOR RIGHT$. IT IS ALSO
;USED BY MID$.
RIGHTB: CAMGE N,ONE ;ARG MUST BE >= 1.
JRST RIGERR
PUSHJ P,IFIX
PUSH P,C
MOVE C,N ;TOTAL LENGTH REQ. IN C.
PUSHJ P,LENBF
AOS T,MASAPP
CAILE N,(C) ;REQ. LEN >= ACTUAL LEN?
JRST RIGHT1 ;NO.
MOVE N,(T) ;YES. RETURN THE ENTIRE STR.
JRST RIGOU1
RIGHT1: SUBI N,(C) ;START PLACE -1 IN N.
RIENTY: PUSH P,T1 ;MID$ ENTERS HERE.
PUSH P,A
PUSH P,X1
PUSH P,X2
MOVE T1,(T) ;ORIGINAL KEY IN T1.
JUMPLE T1,RIGHT3
MOVE X1,N ;APPEND KEY.
MOVE X2,T
MOVE N,T1
PUSHJ P,STRETT ;GET APPENDED STRING
MOVE T1,N ;INTO TEMP. SPACE.
MOVE T,X2
MOVE N,X1
JRST RIGHT2
RIGHT3: TLNN T1,377777 ;NON-APP KEY.
MOVE T1,(T1)
HRRZI T1,(T1)
CAML T1,VARFRE ;CAN THIS STR BE WRITTEN OVER?
JRST RIGHT2 ;YES.
MOVEI T,(C) ;NO.
PUSHJ P,VCHTSC ;GET ROOM FOR NEW STR.
HRRZI A,(T) ;NEW LOW WORD TO A.
MOVE T1,MASAPP ;GET KEY
MOVE T1,(T1) ;AGAIN IN T1.
TLNE T1,377777
JRST .+3
SKIPA T1,(T1)
RIGHT2: MOVEI A,(T1) ;NEW LOW WORD IS OLD LOW WORD.
RIGH15: IDIVI N,5 ;N HAS START CHAR -1.
ADDI N,(T1) ;T1 HAS OLD START WORD.
JUMPN T,RIGH16 ;BLT OR ILDB?
HRL N,N ;BLT.
HRRI N,(A) ;A HAS NEW START WORD.
MOVEI X1,4(C) ;C HAS TOTAL SUBSTR. LENGTH.
IDIVI X1,5 ;MOVE THIS MANY WORDS.
ADDI X1,-1(A)
PUSH P,N
BLT N,(X1)
POP P,N
MOVN C,C
HRL N,C ;KEY TO N.
JRST RIGOUT
RIGH16: HLL N,INSPTR-1(T) ;ILDB.
HRRZI T,(A)
HRLI A,440700
MOVN C,C
HRL T,C ;KEY TO T.
ILDB T1,N
IDPB T1,A
AOJL C,.-2
MOVE N,T ;KEY TO N.
RIGOUT: POP P,X2
POP P,X1
POP P,A
POP P,T1
RIGOU1: POP P,C
SOS MASAPP
POPJ P,
RIGERR: PUSHJ P,INLMES
ASCIZ /
? RIGHT$ ARGUMENT/
JRST OUTBND
;SPACEB IS THE LIBRARY ROUTINE FOR SPACE$.
SPACEB: CAML N,ONE ;ARG MUST BE >= 1 AND
CAML N,ONE33 ;<= 132 CHARACTERS.
JRST SPACER
PUSHJ P,IFIX
PUSH P,X1
PUSH P,X2
MOVE T,N
PUSHJ P,VCHTSC ;GET SPACE FOR STRING.
MOVE X1,N ;SAVE NEGATIVE STRING LENGTH.
SUBI X1,1
IDIVI X1,5
ADDI X1,(T)
MOVE X2,[ASCIZ / /]
MOVN N,N
HRL N,N
HRR N,T
MOVEM X2,(T)
AOJ T,.+1
CAIG T,(X1)
JRST .-3
POP P,X2
POP P,X1
POPJ P, ;EXIT.
SPACER: PUSHJ P,INLMES
ASCIZ /
? SPACE$ ARGUMENT/
JRST OUTBND
;STRB IS THE LIBRARY ROUTINE FOR STR$.
STRB: MOVEI T,3
PUSHJ P,VCHTSW ;GET SPACE FOR A THREE WORD
HRLI T,440700 ;STRING.
MOVEM T,STRPTR ;SET UP BYTE POINTER.
SETZM STRCTR
MOVEI X2,.+2
JRST SAVCS1
PUSH P,Q
PUSH P,T
PUSHJ P,OUTSRF ;FORM STRING
POP P,N
HRL N,STRCTR ;SET UP ADDRESS KEY.
POP P,Q
MOVEI X2,.+2 ;RESTORE AC'S.
JRST RESACS
POPJ P, ;EXIT.
;VALB IS THE LIBRARY ROUTINE FOR VAL.
VALB: PUSHJ P,STRPL1
JRST VALERR
JRST VALB6
STRPL1: MOVE T,MASAPP
MOVE T,(T)
TLNN T,777777
POPJ P,
TLNE T,377777 ;REAL KEY?
JRST VALB2
MOVE T,(T)
TLNN T,777777
POPJ P,
VALB2: POP P,N
PUSHJ P,SAVACS
PUSH P,Q
MOVE Q,N
MOVE N,T
HLRE T,N
JUMPG N,VALB4
MOVM T,T ;NON-APP KEY.
MOVEI X1,(T) ;SAVE NO. OF CHARS. IN X1.
IDIVI T,5
ADDI T,1 ;TRANSFER THE STRING AND
HRRZ X2,N ;GUARANTEE ROOM FOR "$"
CAML X2,VARFRE ;TERMINATING CHARACTER.
JUMPN T1,VALB5 ;NO NEED TO TRANSFER IF IT IS
MOVE X2,MASAPP
MOVEM N,(X2)
PUSHJ P,VCHTSW ;ALREADY IN TEMP SPACE WITH
HRLI T,440700 ;ROOM FOR "$".
MOVE X2,MASAPP
MOVE X2,(X2)
HRLI X2,440700
HRRI N,(T) ;NEW KEY IN N.
VALB3: ILDB T1,X2 ;TRANSFER.
IDPB T1,T
SOJG X1,VALB3
JRST VALB5 ;STRING IS SET UP, GO TO EVANUM.
VALB4: HRRZ X2,N ;APP. KEY.
ADDI T,(X2)
HLRE X1,(T)
SOJ X1,.+1
HRLM X1,(T)
PUSHJ P,STRETT ;TRANSFER THE STRING.
HLRE X1,N
CAMN X1,[-1]
JRST VALERR
AOJ X1,.+1
HRLI N,(X1)
VALB5: HRRZ T1,N ;GET BYTE POINTER TO LAST
HLRE X1,N ;CHAR + 1 INTO T.
MOVM X1,X1
IDIVI X1,5
ADDI T1,(X1)
HRLI T1,440700
IBP T1
SOJGE X2,.-1
MOVEI X2,"$"
DPB X2,T1 ;DEPOSIT "$" TO GUARANTEE
MOVEM T1,VALPTR ;THAT EVANUM STOPS.
HRR T,N
HRLI T,440700
PUSHJ P,NXCH ;FIRST CHAR TO C.
MOVEI T1,1(Q)
POP P,Q
PUSH P,Q
JRST (T1)
VALB6: PUSHJ P,EVANUM
JRST VALERR ;FAIL.
CAME T,VALPTR ;STOPPED AT RIGHT PLACE?
JRST VALERR ;NO.
POP P,Q ;YES. RESTORE AC'S.
MOVEI X2,.+2
JRST RESACS
SOS MASAPP
POPJ P, ;EXIT.
VALERR: PUSHJ P,INLMES
ASCIZ /
? VAL ARGUMENT NOT IN CORRECT FORM/
JRST GOSR2
SUBTTL RANDOM NUMBER ROUTINES.
;THIS IS THE RANDOMIZE STATEMENT ROUTINE.
RANDER: MSTIME N,
CAME N,RANTST
JRST RANDR2
AOS RANCNT
MOVE T1,RANCNT
ADDI N,117
SOJG T1,.-1
JRST .+3
RANDR2: MOVEM N,RANTST
SETZM RANCNT
IMUL N,N ;USE THE 31 LOW ORDER BITS OF MILLISECS IN DAY ^2
TLZ N,760000 ;FALL INTO THE DATA SETUP.
;THIS ROUTINE INITIALIZES THE RANDOM NUMBER GENERATOR DATA LOCATIONS
;(RNDDAT TO RNDDAT+6) AT THE START OF EXECUTION AND IS ALSO USED BY
;THE RANDOMIZE STATEMENT ROUTINE RANDER TO RESET THE LOCATIONS.
;ITS ALGORITHM IS UNKNOWN.
;IT EXPECTS AN ARGUMENT IN AC N.
RANDOM: XOR N,[013702175435] ;MAGIC STARTING NUMBER.
TLZ N,760000
JUMPE N,.-2
MOVSI T1,-7 ;OUTER LOOP INDEX.
RAND2: MOVNI A,6 ;INNER LOOP INDEX.
RAND3: MOVE T,N
ROT T,13
XOR T,N
ROT T,-6
LSHC N,6
AOJN A,RAND3
MOVEM N,RNDDAT(T1)
ADD T1,[000001000001]
JUMPL T1,RAND2
MOVE N,[-7,,-4] ;INITIALIZE INDEX LOCATION FOR
MOVEM N,RNDIDX ;RND FUNCTION.
POPJ P,
;RND FUNCTION.
RNDB: MOVE T1,RNDIDX ;GET INDEX TO DATA LOCATIONS.
MOVE N,RNDDAT+7(T1)
TRNN T1,400000 ;IF RH >= 0, GO BACK TO START OF TABLE.
MOVE N,RNDDAT(T1)
ADDB N,RNDDAT+4(T1)
AOBJN T1,RNDB1
CAIE T1,3 ;[153]
SKIPA T1,[-1,2] ;[153]
MOVE T1,[-7,,-4]
RNDB1: MOVEM T1,RNDIDX
LSH N,-9
JUMPE N,RNDB
TLO N,200000
FADRI N,200000 ;NORMALIZE.
POPJ P,
LIT
END BASIC