DEFINE * /--- FILE TYPE = E * /--- BLOCK DEFINE 00 000 81/07/13 01.10 IDENT DEFINE LCC OVERLAY(1,1) * TITLE -DEFINE- COMMAND TITLE * * CST * * DEFINE$ OVFILE * * EXT ECSPRTY,COMPNAM,CSYMADD EXT KEYTYPE,ERRORC,NXTC,COMCONT,HOLDEFN EXT SEGREAD,UNSREAD,SEGFLG EXT CHARERR,BADPAR,DECERR,VARERR EXT LOGERR,FORMERR,EQERR,OCTERR EXT ALFERR,INDXERR,DEFERR,SEGERR EXT COMPERR,LNGERR,LITERR,TEMPERR EXT KLOCAL * * * /--- BLOCK DEFINE 00 000 76/06/07 15.09 TITLE READIN FOR -DEFINE- COMMAND * * -DEFREAD- * READIN ROUTINE FOR -DEFINE- COMMAND * * USE OF BUFFERS - * * *VARS* CONTAINS SEVEN CHARACTER DEFINE * NAMES WITH 18 BIT GETVAR CODES LOWER IN ORDER * BY FIRST CHARACTER * * *TOKBUF* (ECS RESIDENT TABLE) * CONTAINS 12 BIT TOKENS ASSOCIATED WITH NON * PRIMITIVE DEFINES ** ADTYPES REQUIRE TWO 12 BIT BYTES - THE FIRST * BYTE HAS THE UPPER BIT SET TO INDICATE ADTYPE ** UNNAMED LONG LITERALS REQUIRE A WHOLE WORD * FOLLOWING THEIR ADTYPES - THE FIRST BYTE OF THEIR * ADTYPES HAVE THE SECOND TO THE UPPER BIT SET ** NAMED LONG LITERALS REQUIRE A WHOLE WORD * * * ECS DATA STRUCTURE * * THE ECS DEFINE BUFFER IS PARTITIONED INTO PAIRS OF * NAME AND TOKEN BUFFERS. THE DEFINE SET THAT IS CURRENTLY * ACTIVE HAS ALL THE UNUSED SPACE IN THE DEFINE BUFFER * LOCATED BETWEEN THE END OF ITS TOKEN BUFFER AND THE * BEGINNING OF ITS NAME BUFFER. FOR EXAMPLE; * * START OF ECS DEFINE BUFFER * TOKENS FOR DEFINE SET A * NAMES FOR DEFINE SET A * TOKENS FOR DEFINE SET B * NAMES FOR DEFINE SET B * TOKENS FOR DEFINE SET C * UNUSED SPACE * NAMES FOR DEFINE SET C * END OF ECS DEFINE BUFFER * * WHEN ANOTHER DEFINE SET IS ACTIVATED, THE TOKEN AND * NAME BUFFERS ARE MOVED SO THAT THE UNUSED SPACE IS BETWEEN * THAT DEFINE SETS TOKEN AND NAME BUFFER. FOR EXAMPLE; * * START START * TOKEN A TOKEN A * NAME A NAME A * TOKEN B TOKEN B * NAME B UNUSED SPACE -DEFINE- SET B IS NOW ACTIVE * TOKEN C NAME B * UNUSED SPACE TOKEN C * NAME C NAME C * END END * * AS A -DEFINE- COMMAND IS PROCESSED, THE STARTING LOCATION * OF THE NAMES DECREASES AS NAMES ARE ADDED AND THE ENDING * LOCATION OF THE TOKENS INCREASES AS TOKENS ARE ADDED UNTIL * THERE IS NO UNUSED SPACE, AT WHICH TIME A CONDENSE ERROR * IS ISSUED AND NO MORE DEFINES ARE PROCESSED UNTIL ONE * OR MORE DEFINE SETS ARE PURGED. * * * NAME BUFFER * * THE NAME BUFFER CONTAINS AN ALPHABETICAL LIST OF ALL * SYMBOLS GIVEN DEFINITIONS IN THE DEFINE SET SO FAR. * EACH SYMBOL IS LEFT JUSTIFIED IN A WORD, USING A MAXIMUM * /--- BLOCK DEFINE 00 000 76/06/07 15.09 * OF 7 CHARACTERS. THE BOTTOM 3 CHARACTERS CONTAIN INFO * DESCRIBING THE FUNCTION OF THE SYMBOL, CALLED THE SYMBOLS * GETVAR CODE. THIS CODE CONSISTS OF 4 BITS OF TYPE * INFORMATION AND 14 BITS OF ADDRESS INFORMATION. FOR ALL * EXCEPT SIMPLE VARIABLE TYPES OR LITERAL TYPES OF LESS THAN * 15 BITS, THE ADDRESS INFORMATION POINTS TO THE WORD IN * THE TOKEN BUFFER WHERE A DESCRIPTION OF THE DEFINE BEGINS * (SEE DISCUSSION OF TOKENS BELOW). THE ADDRESS INFORMATION * FOR SIMPLE VARIABLES INDICATES THE NUMBER OF THE VARIABLE * BEING REFERENCED; FOR 14 BIT LITERALS, THE LITERAL ITSELF * IS THE ADDRESS. * * TOKEN BUFFER * * THE TOKEN BUFFER CONTAINS COMPLEX DEFINITIONS OF SYMBOLS * IN THE NAME TABLE. FOR ALL EXCEPT LITERALS OF MORE THAN * 14 BITS, THESE DEFINITIONS ARE OF THE FORM; * * * * FOR 60 BIT LITERALS, ALL THAT IS STORED IS THE LITERAL * ITSELF. * THE NON60-BIT LITERAL ELEMENTS OF THE TOKEN BUFFER ARE * 12 BIT OR 24 BIT BYTES, PACKED FROM HIGH TO LOW ORDER * BITS OF WORDS. THE IS ALWAYS LEFT * JUSTIFIED SO THAT THE GETVAR CODE ASSOCIATED WITH THE * SYMBOL MAY POINT DIRECTLY TO THE FIRST WORD OF THE * SYMBOLS DEFINITION. FOR ALL EXCEPT THE ARGUMENT COUNT, * 12 BIT TOKENS CORRESPOND TO LEXICAL ELEMENTS OF THE * DEFINITION CALLED OPERATORS. INCLUDED IN THIS CATEGORY ARE * SEPARATORS SUCH AS PARENTHESIS, COMMAS, END OF LINES, ETC. * AS WELL AS SYSTEM DEFINED SYMBOLS (INT, ZRECS, +, -, ^O,). * 24 BIT TOKENS ARE OF TWO TYPES; 1) ARGUMENT TOKENS, THE * TOP 12BIT BYTE OF WHICH HAS A UNIQUE VALUE NOT CORRESPOND- * ING TO ANY OPERATOR, AND THE BOTTOM 12 BIT BYTE THE NUMBER * OF THE ARGUMENT AS IT APPEARS IN THE ARGUMENT LIST;2) * ADTYPE TOKENS, WITH THE 2**LITSHFT BIT SET AND THE BOTTOM 18 * BITS CONTAINING A GETVAR CODE FOR A SIMPLE VARIABLE OR * LITERAL. 60 BIT LITERALS THAT APPEAR IN THE DEFINITION OF * A SYMBOL THAT IS NOT REDUCABLE TO A SINGLE LITERAL ITSELF, * HAVE THE 2**LITSHFT BIT SET INDICATING THAT THE REST * OF THE CURRENT TOKEN WORD IS IRRELEVANT, THE LITERAL * APPEARS IN THE NEXT WORD IN THE TOKEN BUFFER AND THE NEXT * TOKEN WILL BE LEFT JUSTIFIED IN THE WORD AFTER THE * LITERAL. *** WARNING *** IN ALL OTHER CONTEXTS, THE * 2**LITSHFT BIT SET IN AN ADTYPE MEANS THAT THE LONG LITERAL * RESIDES IN *LITS* (THE LITERAL STACK GENERATED BY *LEX* * AND *DEFLEX*. *** WARNING *** * * /--- BLOCK DEFINE 00 000 80/03/27 23.09 * WHEN THE DEFINITION OF A SYMBOL CONTAINS A PREVIOUSLY * DEFINED SYMBOL, THE TOKEN BUFFER REPRESENTATION OF * THE DEFINITION CONTAINS THE TOKENS FOR THE PREVIOUSLY * DEFINED SYMBOL ENCLOSED BY PARENTHESIS TOKENS. * * * EXAMPLE DEFINE SET NAME AND TOKEN BUFFERS * * DEFINE ABC=7 * DEF=N1 * VECT(X)=N(X+100) * LIT='7ABCDEF'7+1 * FUNCT(X,Y)=SIN(Y+LIT-VECT(X)"DEF+'7GEHI'7) * * TOKEN BUFFER (* INDICATES START OF WORD) * *0001 0077 0015 03760000 *0002 40000144 0016 0001 * *01020304050600000001 * *0002 0051 0015 03760001 *0002 40040002 0003 0015 *0077 * 0015 0015 03760000 *0016 0002 40000144 0016 *0016 * 0013 40100001 0002 *60040011 *07051011000000000000 * *0016 0001 * * NAME BUFFER * * ABC 000007 * DEF 100001 * FUNCT 200003 * LIT 040002 * VECT 200000 * * * CM NAME PAGING * * A CM BUFFER IS USED DURING BINARY CHOP SEARCHES FOR * DEFINED NAMES. IN DEFINE SETS WITH NAME BUFFERS LARGER * THAN THE CM BUFFER, THE ECS NAME BUFFER IS DIVIDED UP INTO * PAGES THE SAME SIZE AS THE CM BUFFER. THESE PAGES ARE * READ INTO CM AS NEEDED FOR THE BINARY CHOP. * CM TABLES * * *TOKADDS* CONTAINS THE ECS LOCATIONS OF TOKEN BUFFERS * *NAMADDS* CONTAINS THE ECS LOCATIONS OF NAME BUFFERS * (TOKADDS(N)) IS ALWAYS LESS THAN OR EQUAL TO (TOKADDS(N+1)) * (NAMADDS(N)) IS ALWAYS LESS THAN OR EQUAL TO (NAMADDS(N+1)) * *TOKLENS* CONTAINS THE LENGTHS OF TOKEN BUFFERS * *NAMLENS* CONTAINS THE LENGTH OF NAME BUFFERS * *SETNAMS* CONTAINS THE NAMES OF DEFINE SETS * * THERE IS AN ENTRY IN EACH TABLE WITH AN INDEX OF -1. THESE * ENTRIES DESCRIBE THE NULL DEFINE SET WHICH IS OPENED WHEN * NO DEFINE SET IS ACTIVE. THIS MAKES MUCH OF THE CODE MORE * ELEGANT AND EFFICIENT BY AVOIDING SPECIAL CASES. * * *PGTBL* CONTAINS THE LAST NAME OF EACH PAGE IN THE NAME * BUFFER. THIS IS TO SPEED UP THE PROCESS OF FINDING * WHICH PAGE SHOULD BE CM RESIDENT IF THE PAGE IN ECS COULD * NOT CONTAIN THE NAME BEING SEARCHED FOR. * * * AT THE END OF CONDENSATION THE DEFINE SET NAMED * *STUDENT* IS APPENDED TO THE LESSON BINARY - OTHER * DEFINES ARE NOT AVAIABLE IN STUDENT MODE * * DEFOV OVRLAY SA1 OVARG1 X1 = CALL TYPE SB1 X1 JP B1+DEFJMP JUMP TO DEFINE OPTION * DEFJMP EQ DEFNIN BEGIN DEFINE SET + EQ PURGELU PURGE LOCAL DEFINE SET FOR NEW + EQ ELN1 RETURN FROM SEGOV + EQ PURGELD PURGE LOCAL DEFINE SET FOR GBL * * /--- BLOCK DEFINE 00 000 80/05/19 22.16 DEFNIN CALL SETSET SET TO CURRENT DEFINE SET SX6 VARS SA6 PVARS POINTER TO DEFN NAME LIST SX7 -2 *UNITS* NOT ACTIVE SA7 NUNITS MX6 0 SA6 UDMODE NO INTERPRETATION OF *UNITS* SA6 COMPNAM SA6 CSYMADD SA1 COMMAND SA2 COMCONT SEE IF CONTINUED COMMAND BX2 X1-X2 ZR X2,DEFRD JUMP IF CONTINUED * /--- BLOCK D050 00 000 80/03/23 08.25 * SA1 LOCAL ZR X1,D025 IF NOT LOCAL SET * *+ EQ * + SA1 KLOCAL X1 = LOCAL SET NAME BX6 X1 SA6 KBLANK LOCAL SET HANDLING LIKE BLANK SX6 60 NO BITS LEFT IN 0TH WORD SA6 LSHIFT SA6 LBYTES LOCAL BYTE SIZE MX6 0 0TH WORD SA6 LVARN SA6 MERGEL ASSUME MERGE OPTION NOT USED SX6 100000B LOCAL TYPE IS INTEGER SA6 LTYPE SX6 1 SIGNED SA6 LSIGN SA1 DSET SAVE CURRENT SET NUMBER BX6 X1 SA6 GSET GLOBAL SET NUMBER * SAVE UNIT TAG SA1 WORDPT BX6 X1 SA6 LWRDPT SA0 TAG SA1 ATEMPEC X1 = ADDR OF TEMP ECS BX0 X1 WE TAGLTH+1 WRITE OUT -UNIT- W/ARGS RJ ECSPRTY SA0 LUNIT SAVE -UNIT- COMMAND W/ARGS RE TAGLTH+1 RJ ECSPRTY RJ =XGETLINE D025 SA1 WORDPT SAVE WORDPT BX6 X1 SA6 OLDPT CALL GETNAME,9 GET NAME OF DEFINE SET ** ZR X6,DEFR0 JUMP IF NO NAME=BLANK SET SX7 DEFNAML NUMBER OF NAMES TO SEARCH SA1 LOCAL IX7 X7+X1 IF LOCAL SET, INCLUDE *MERGE* RJ DEFNAMS CHECK FOR SPECIAL NAME NZ X7,D170 JUMP IF SPECIAL NAME FOUND * * SB2 7 GT B1,B2,ERR7 ERROR IF NAME OVER 7 CHARS * SA1 LOCAL NZ X1,D100 IF LOCAL SET * * * SPECIAL NAMES= SEGMENT(SEGFLG=1), SEGMENTV(3), UNITS(4), * ARRAY(4), ARRAYSEG(5), ARRAYSEGV(6), COMPLEX(7), * SEGMENTF(8), PURGE(9) * SX0 X2-OPCOMMA IF TERMINATOR IS COMMA ZR X0,DEFR1 JUMP , THIS IS SET NAME D050 SA1 LOCAL NZ X1,D100 IF LOCAL SET, NO NAMED SETS * SX3 X2-EOL ZR X3,DEFR1 IF SETNAME EOL * ZR X3,DEFR1 JUMP IF SETNAME(EOL) D100 SA1 OLDPT THIS IS DEFINE NAME BX6 X1 RESET -WORDPT- SA6 WORDPT * /--- BLOCK D050 00 000 80/03/23 08.25 EQ DEFR0 USE BLANK SET * D170 SA1 LOCAL ZR X1,D171 IF NOT LOCAL SET * SX0 X7-DEFNAML-1 ZR X0,DEFL0 IF LOCAL MERGE OPTION * EQ D100 TREAT AS NORMAL DEFINE LINE * * /--- BLOCK D050 00 000 80/03/23 06.44 D171 SX0 X7-DEFNAML ZR X0,PURGE JUMP IF PURGE OPTION SX3 X2-OPCOMMA ZERO IF ENDS WITH COMMA ** FOLLOWING IS CAUSED BY DIFF BETWEEN TREATMENT OF ** SEGMENT AND UNITS/ARRAY/COMPLEX * MAYBE SHOULD CHANGE ZR X3,D172 IF IT DOES, IS SPECIAL NAME SX0 X7-1 ZERO IF SEGMENT NZ X0,D050 JUMP IF NOT, ALLOW UNITS=V1 EQ ERR8 SEGMENT MUST END WITH COMMA D172 SA1 KBLANK BX6 X1 ASSUME BLANK SET RJ =XFINDSET PL B1,DSEG1 JUMP IF SET EXISTS RJ NEWSET * DSEG1 RJ =XGETSET BRING IN THE SET SA1 SEGFLG SX1 X1-3 ZR X1,UNSREAD JUMP IF -UNITS- EQ SEGREAD JUMP IF SEGMENT/ARRAY/COMPLEX * DEFL0 SX6 1 SA6 MERGEL FLAG MERGE OPTION SELECTED * DEFR0 SA1 KBLANK BLANK NAME (UNNAMED SET) BX6 X1 * DEFR1 BX7 X2 SAVE TERMINATOR CODE SA7 ENDKEY RJ =XFINDSET SEE IF SET ALREADY EXISTS PL B1,DEFR2 JUMP IF ALREADY EXISTS RJ NEWSET INITIALIZE A NEW SET RJ =XGETSET OPEN IT UP AND BRING IT IN SA1 LOCAL ZR X1,DEFL5 IF NOT LOCAL SET * SA1 MERGEL ZR X1,DEFRD IF NO MERGED SET, BEGIN SET * CALL GETNAME,8 BX7 X2 SAVE ENDKEY SA7 ENDKEY SA3 GSET X3 = PREVIOUS GLOBAL SET NUM SB1 X3 B1 = PREVIOUS GLOBAL SET NUM SA1 KPREVN X1 = *PREVIOUS* KEYWORD BX1 X1-X6 ZR X1,DEFL10 IF PREVIOUS SET TO BE MERGED SA1 KGLOBAL X1 = *GLOBAL* KEYWORD BX1 X1-X6 NZ X1,DEFL05 IF NAME IS NOT *GLOBAL* PL B2,DEFL05 IF NAME IS NOT *GLOBAL';* SX7 EOL SET TERMINATING CHAR SA7 ENDKEY EQ DEFL10 DO THE MERGE * DEFL05 SX3 X2-EOL ZR X3,DEFR1A ANOTHER SETNAME IF EOL * SX3 X2-OPCOMMA NZ X3,ERR8 IF BAD TERMINATION * EQ DEFR1A * MERGEL DATA 0 MERGE OPTION FLAG FOR LOCAL SET * DEFL5 BSS 0 SA1 ENDKEY SX2 X1-OPCOMMA NZ X2,ENDLIN CONTINUE IF NOT COMMA CALL GETNAME,7 GET NEXT NAME SX3 X2-EOL ZR X3,DEFR1A ANOTHER SET NAME IF EOL SX3 X2-OPCOMMA NZ X3,DEFRDA ANOTHER DEFINE IF NOT COMMA * /--- BLOCK DEFR1A 00 000 75/02/11 20.31 * DEFR1A SX7 X2 SAVE TERMINATOR SA7 ENDKEY ZR X6,ERR8 ERROR EXIT IF NO SET RJ =XFINDSET SEARCH FOR OLD SET DEFL10 NG B1,ERR8 ERROR IF NO SET SX7 B1 SA7 ODSET SAVE OLD SET NUMBER SA1 DSET SB2 X1 SA1 UNTLENS+B1 *NDEFU* BX7 X1 SA7 UNTLENS+B2 SA2 B2+TOKADDS (X2)=ECS ADDR OF NEW SET TOKENS SA1 B1+TOKADDS (X1)=ECS ADDR OF OLD SET TOKENS SA3 B1+TOKLENS (X3)=ECS LENG OF OLD SET TOKENS IX4 X2+X3 MUST BE LESS THAN OR EQUAL TO SA5 NAMADDS+B2 IX4 X5-X4 NG X4,ERR4 IF NOT ENOUGH ROOM IN BUFFER BX7 X3 SA7 B2+TOKLENS SA0 VARS (A0)=ADDR OF MOVE BUFFER SB1 VARLONG (B1)=LENGTH OF MOVE BUFFER RJ =XMVECS MOVE TOKENS TO NEW DEFINE SET SA1 ODSET SB1 X1 SA1 DSET SB2 X1 SA2 B2+NAMADDS (X2)=ECS ADDR OF NEW SET NAMES SA1 B1+NAMADDS (X1)=ECS ADDR OF OLD SET NAMES SA3 B1+NAMLENS (X3)=ECS LENG OF OLD SET NAMES IX2 X2-X3 (X2)=NEW ADDR OF NEW SET NAMES SA4 TOKADDS+B2 SEE IF ENOUGH ROOM IN BUFFER SA5 TOKLENS+B2 IX4 X4+X5 MUST NOT BE GT NAMADDS+B2 IX4 X2-X4 NG X4,ERR4 IF NOT ENOUGH ROOM BX7 X2 SA7 B2+NAMADDS BX7 X3 SA7 B2+NAMLENS SA0 VARS (A0)=ADDR OF MOVE BUFFER SB1 VARLONG (B1)=LENGTH OF MOVE BUFFER RJ =XMVECS MOVE NAMES TO NEW DEFINE SET SA1 DSET SB1 X1 RJ =XSETSET BRING IN NEW DEFINE SET SA1 ENDKEY EQ ENDLIN * * /--- BLOCK DEFR2 00 000 80/03/23 06.50 ODSET BSS 1 * DEFR2 RJ =XGETSET BRING IN THE SET * DEFR3 SA1 ENDKEY EQ ENDLIN SEE IF NEED NEW LINE * DEFRD CALL GETNAME,9 GET NAME OF DEFINE * FOLLOWING CHECKS FOR -DEFINE- ENDING IN COMMA * AND TRAILING BLANKS SX7 X2-EOL CHECK FOR EOL TERMINATOR BX7 X7+X6 AND NO NAME ZR X7,ELN1 END-OF-LINE OK DEFRDA ZR X6,ERR7 ERROR IF NO NAME SA6 DEFNAME SX7 DEFNAML-1 DO NOT LOOK FOR *PURGE* RJ DEFNAMS CHECK FOR SPECIAL NAMES ZR X7,DEFRDAB JUMP IF NOT SX0 X7-3 NG X0,SEGREAD JUMP IF SEGMENT SX1 X2-OPCOMMA CHECK IF TERMINATOR=COMMA NZ X1,DEFRDB IF NOT, MUST BE UNITS=V1 ETC. ZR X0,UNSREAD REMOTE EXIT IF UNITS SX0 X7-DEFGNML-1 NG X0,SEGREAD IF ARRAY/COMPLEX * SA1 LOCAL ZR X1,DEFRDB IF NOT LOCAL SET * * CONDENSING LOCAL DEFINE SET ',X,Y,S';', FORM * X = (INTEGER,FLOATING) * Y = SEGMENT SIZE (INTEGER ONLY) * S = SIGNED SEGMENT IF PRESENT * SX6 100000B X6 = PRESET N GETVAR TYPE SX0 X0-1 NG X0,DEFL20 IF INTEGER DECLARATION * SX6 5B X6 = V GETVAR TYPE LX6 15 DEFL20 SA6 TLTYPE TEMPORARY LTYPE RJ COLON X0 = -1 IF COLON IS LAST CHAR NG X0,DEFL100 IF FULL WORD DECLARATION * RJ SAVEO SAVE WORDPT ETC. RJ =XRTOKNAM MAKE READY FOR *INITDEF* RJ =XCOMPILE MX0 -XCODEAL BX0 X0*X1 MUST BE SHORT LITERAL BX6 X1 SA2 OLDINX RESTORE INX BX7 X2 SA7 INX ZR X0,DEFL30 IF X6 IS SHORT LITERAL * DEFL25 RJ RESTO BACK UP POINTERS TO KEYWORD AND SA2 WORDPT SET X2 TO CORRECT ENDKEY SA2 X2-1 SA2 X2+KEYTYPE EQ DEFRDB ASSUME IT A DEFINE NAME * DEFL30 SA6 TLBYTES TEMPORARY LOCAL BYTE SIZE RJ COLON X0 = -1 IF COLON LAST CHAR NG X0,DEFL110 IF UNSIGNED DECLARATION * CALL GETNAME,7 X6 = SIGN OPTION ZR X6,DEFL25 ASSUME ITS A DEFINED NAME * SA3 KSIGN CHECK FOR SIGNED SEGMENT BX3 X6-X3 * /--- BLOCK DEFR2 00 000 80/03/23 06.50 ZR X3,DEFL40 IF SIGNED DECLARATION * SA3 KS CHECK FOR ABBREVIATED SIGN BX3 X6-X3 NZ X3,DEFL25 IF NOT ,S ASSUME DEFINED NAME * DEFL40 RJ COLON PL X0,DEFL25 MUST END IN COLON * SX6 1 SA6 TLSIGN TEMPORARY LOCAL VAR SIGN EQ DEFL120 BEGIN INTEGRITY CHECK * * /--- BLOCK DEFR2 00 000 80/03/23 06.47 DEFL100 SX6 60 60 BIT DECLARATION SA6 TLBYTES SX6 1 HAS TO BE SIGNED SA6 TLSIGN EQ DEFL200 SET DECLARATION PARAMETERS * DEFL110 SX6 0 UNSIGNED SA6 TLSIGN * DEFL120 SA1 TLBYTES CHECK BYTE SIZE NG X1,BADCNT IF BYTE SIZE LT 0 ZR X1,BADCNT IF BYTE SIZE EQ 0 * SX2 61 IX1 X1-X2 PL X1,BADCNT IF BYTE SIZE GT 60 * SA2 TLTYPE SX2 X2-100000B ZR X2,DEFL200 IF INTEGER, EVERYTHING OK * SX1 X1+1 NZ X1,BADCNT IF FLOATING BYTE SIZE NE 60 * DEFL200 SA1 TLTYPE TYPE OF LOCAL VAR BX6 X1 SA6 LTYPE SA1 TLBYTES LENGTH OF BYTE BX6 X1 SA6 LBYTES SA1 TLSIGN UN/SIGNED BX6 X1 SA6 LSIGN EQ DEFRD CONTINUE SINCE MORE TO COME * * TLTYPE DATA 0 TLBYTES DATA 0 TLSIGN DATA 0 * /--- BLOCK DEFR2 00 000 80/03/23 06.49 * * -COLON- * * LOOK AT LAST TWO CHARACTER CODES TO CHECK FOR * A COLON * * ON RETURN X0 = -1 IF COLON, 0 IF NOT * COLON EQ * SX0 B0 PRESET X0 TO NOT COLON SA2 WORDPT SA2 X2-1 SX2 X2-77B LAST CHAR - ; NZ X2,COLON IF NOT COLON * SA2 A2-1 SX2 X2-70B LAST CHAR - SHIFT NZ X2,COLON IF NOT COLON * SX0 -1 IT WAS A COLON EQ COLON * * * -SAVEO- * * SAVE ALL INFORMATION NECESSARY TO DO A COMPILE * LOOK AHEAD IN THE *OLD* BUFFER * SAVEO EQ * SA2 WORDPT SAVE WORDPT BX6 X2 SA6 OWORDPT SA2 INX SAVE INX BX6 X2 SA6 OLDINX SA2 LASTKEY SAVE LASTKEY BX6 X2 SA2 OLDLAST EQ SAVEO * * * -RESTO- * * RESTORE INFORMATION SAVED BEFORE LOOK AHEAD * FROM *OLD* BUFFER * RESTO EQ * SA2 OWORDPT RESTORE WORDPT BX6 X2 SA6 WORDPT SA2 OLDINX RESTORE INX BX6 X2 SA6 INX SA2 OLDLAST RESTORE LASTKEY BX6 X2 SA6 LASTKEY EQ RESTO * * DEFRDAB NG B2,BADTYP IF ILLEGAL TYPE DECLARATION * DEFRDB SX7 X2 SAVE TERMINATOR SA7 ENDKEY * /--- BLOCK DEFR2 00 000 76/08/01 23.59 SA1 DSET CURRENT SET NUMBER NG X1,ERR9 MX6 0 SA6 NARGS CLEAR ARGUMENT COUNT SA6 NADS CLEAR ADTYPE COUNT SA6 NOPS CLEAR OPERATION COUNT SX3 X2-OPASIGN OK IF ASSIGNMENT ARROW ZR X3,DNAME SX3 X2-OP= OK IF EQUAL SIGN ZR X3,DNAME SX3 X2-OP( OK IF L PAREN (FUNCTION) ZR X3,DNAME SA1 LOCAL X1 = LOCAL SET FLAG ZR X1,ERR1 IF NOT PROCESSING LOCAL SET * SX3 X2-OPCOMMA COMMA LEGAL IN LOCAL SET ZR X3,DNAME IF COMMA * SX3 X2-EOL EOL LEGAL IN LOCAL SET NZ X3,ERR1 OTHERWISE, ILLEGAL CHARACTER * * DNAME CALL SYMCHK,DEFNAME SX7 -1 SET VSEEK TO NO EXPANSION SA7 VSKMODE MX6 0 SA6 UDMODE NO INTERPRETATION OF *UNITS* SA1 DEFNAME BX6 X1 PUT NAME IN X6 FOR CALL RJ =XVSEEK SEE IF NAME ALREADY DEFINED SA1 ADTYPE PL X1,ERR6 ERROR IF DUPLICATE NAME SA7 DEFNLOC STORE LOCATION TO INSERT DEFN RJ =XINITLEX SETUP FOR PROGRAM -LEX- SA1 ENDKEY SX2 X1-OP( CHECK TERMINATOR KEY NZ X2,DEFIN JUMP IF NOT FUNCTION DEFINE * * /--- BLOCK ARGDO 00 000 77/01/26 20.37 * * SA1 LOCAL ZR X1,ARGDO IF NOT LOCAL SET * RJ SAVEO SAVE COMPILATION LOCATION RJ =XRTOKNAM RJ =XLEX IS NEXT LEXICAL ITEM DEFINED SA1 OP NZ X1,DEFL280 IF AN OPERATOR, ASSUME CONSTANT * SA1 ADTYPE NG X1,DEFL290 IF UNDEFINED, ASSUME AN ARG * DEFL280 RJ RESTO RESTORE TO PRE-LEX CONDITION SA1 WORDPT POINT TO LEFT PAREN SX6 X1-1 SA6 A1 RJ =XCOMPILE SA2 OLDINX RESTORE INX BX6 X2 SA6 INX MX0 -XCODEAL BX0 X0*X1 X0 = GETVAR W/ZEROED ADDRESS ZR X0,DEFL300 IF A SHORT LITERAL * DEFL290 RJ RESTO RESTORE COMPILATION SX7 -1 SET VSEEK TO NO EXPANSION SA7 VSKMODE MX6 0 SA6 UDMODE RJ =XINITLEX EQ ARGDO CONTINUE WITH ARGUMENTS * DEFL300 BSS 0 * * * ADD LOCAL VECTOR DEFINE * SA2 LBYTES X2 = BYTE SIZE SX3 X2-60 NZ X3,DEFL500 IF HORIZONTAL SEGMENT * * FULL WORD VECTOR * SA2 LVARN X2 = NUMBER OF LOCALS SO FAR IX6 X1+X2 INDEX OF LAST VAR IN THIS ARRAY BX7 X1 SAVE VECTOR LENGTH RJ =XLBOUND CHECK ITS BOUNDS SA6 A2 STORE NEW NUMBER OF LOCALS BX6 X2 SAVE OLD NUMBER OF LOCALS SA6 OLVARN * * SIMULATE ',ARRAY,XXX(YYY)=NL(ZZZ)', WHERE ',XXX', IS * DEFINE NAME AND ',YYY', IS THE VECTOR LENGTH * AND ZZZ IS THE BASE LOCATION OF THE VECTOR * SX6 X7-1 X6 = VECTOR SIZE - 1 SX5 1 SET ARRAY DIMENSIONS TO 1 LX5 9 BX7 X5+X7 LX7 9 X7 = ARRAY WORD W/NUM WORDS BX7 X6+X7 NUMBER OF ROWS - 1 LX7 36 BY-PASS PLANES FOR 3D MATRIX SA1 OLVARN RESTORE PREVIOUS LVARN SX1 X1+1 VECTOR BEGINS AT NEXT WORD * /--- BLOCK ARGDO 00 000 77/01/26 20.37 SA2 ASVARS X2 = ADDR OF STUDENT VARS SA3 ALVARS X3 = ADDR OF LOCAL VARS IX3 X3-X2 OFFSET TO LOCAL VARS IX1 X1+X3 OFFSET TO LOCAL VECTOR SA2 LTYPE X2 = TYPE GETVAR BX7 X7+X2 ADD GETVAR OF FIRST ELEMENT BX1 X7+X1 RJ =XSTUFLIT SA2 TOKWRD RJ =XAPTWD SX4 6 INDICATE AN ARRAY TYPE DEFINE EQ DEFL530 TREAT LIKE SEGMENT NOW * * * /--- BLOCK ARGDO 00 000 77/01/26 20.37 * ADD LOCAL SCALAR DEFINE * DEFL400 BSS 0 SA1 WORDPT SET LASTKEY FOR EOL TEST SA1 X1-1 BX7 X1 SA7 LASTKEY SA1 LBYTES X1 = BITS PER BYTE SX2 X1-60 NZ X2,DEFL410 IF SEGMENTED SCALAR * * FULL WORD SCALAR * SX6 60 ALL BITS USED IN NEW WORD SA6 LSHIFT SA2 LVARN X2 = NUMBER OF LOCAL VARS SX6 X2+1 RJ =XLBOUND CHECK BOUNDS SA6 A2 NEW NUMBER OF LOCALS SA1 ASVARS ADDRESS OF STUDENT VARS SA3 ALVARS ADDRESS OF LOCAL VARS IX6 X3+X6 ADDRESS OF LOCAL VAR IX6 X6-X1 BIAS TO LOCAL VAR SA1 LTYPE GETVAR TYPE CODE BX4 X6+X1 X4 = NL/VL GETVAR CODE EQ ADNAM ADD LOCAL VAR TO DEFINE TABLE * * ADD LOCAL SCALAR SEGMENT DEFINE * DEFL410 SA2 LSHIFT X2 = BITS USED IN CURRENT WORD SA3 LSIGN X3 = 1 IF SIGNED SA4 LVARN X4 = VARLOC OF SEGMENTF LX3 2 POSITION SIGN BIT SX3 X3+3 INDICATE SEGMENTF LX3 20 BX3 X3+X1 NUMBER OF BITS PER BYTE IX6 X2+X1 INCREMENT BITS USED SX7 X6-61 - BITS LEFT IN WORD NG X7,DEFL420 IF CAN FIT IN THIS WORD * BX6 X1 BITS USED IN NEW WORD MX2 0 START OF NEW BYTE SX4 X4+1 INCREMENT LVARN DEFL420 SA6 A2 STORE NEW NUMBER OF BITS USED BX6 X4 STORE NEW LVARN RJ =XLBOUND CHECK BOUNDS ON LOCAL INDEX SA6 A4 SA1 ASVARS ADDRESS OF STUDENT VARS SA4 ALVARS ADDRESS OF LOCAL VARS IX6 X4+X6 ADDRESS OF LOCAL VAR IX6 X6-X1 BIAS TO LOCAL VAR LX3 18 BX3 X3+X6 BIAS TO SEGMENTF LX3 18 SX2 X2+1 BIT POSITION OF SEGMENTF BX1 X2+X3 RJ =XSTUFLIT STORE SEGMENT DESCIPTOR SA2 TOKWRD IN ECS TOKEN BUFFER * /--- BLOCK ARGDO 00 000 77/01/26 20.37 RJ =XAPTWD SX4 5 X4 = TYPE CODE FOR SEGMENT LX4 XCODEAL POSITION TYPE CODE SA1 TOKWRD SX1 X1-1 X1 = TOKEN ADDR OF SEG LIT BX4 X4+X1 X4 = COMPLETE GETVAR EQ ADNAM * * * ADD LOCAL VECTOR SEGMENT DEFINE * DEFL500 EQ NOTYET NO SEGMENTED VECTOR LOCALS YET PX3 X2 X3 = FLOAT(BYTESIZE) NX3 X3 SA4 K60 X4 = 60.0 * /--- BLOCK ARGDO 00 000 77/01/26 20.37 RX3 X4/X3 X3 = 60/BYTESIZE UX3 X3,B1 LX3 X3,B1 X3 = BYTES PER WORD PX3 X3 NX3 X3 PX4 X1 X4 = FLOAT(BYTES) NX4 X4 RX4 X4/X3 X4 = BYTES/BYTESPERWORD UX4 X4,B4 LX4 X4,B4 X4 = NUMBER OF FULL WORDS USED UX3 X3,B3 LX3 X3,B3 X3 = BYTES/WORD IX5 X3*X4 X3 = BYTES RESIDING IN FULL WDS IX5 X1-X5 X5 = BYTES IN LAST WORD IX7 X5*X2 X7 = BITS USED IN LAST WORD SA7 LSHIFT BX5 X3 SAVE BYTES PER WORD SA3 LVARN X3 = WORDS USED SO FAR ZR X7,DEFL510 IF ALL BITS USED IN LAST WORD * SX4 X4+1 X4 = NUMBER OF WORDS INVOLVED EQ DEFL520 * DEFL510 IX6 X2*X5 ALL BYTES USED IN LAST WORD SA6 LSHIFT DEFL520 IX6 X4+X3 HIGHEST VARLOC IN SEGMENT RJ =XLBOUND MAKE SURE WITHIN RANGE SA6 LVARN SA1 LSIGN X1 = UN/SIGNED SEGMENT LX1 22 BX1 X1+X2 BYTE SIZE LX1 18 SA2 ASVARS ADDRESS OF STUDENT VARS SA4 ALVARS ADDRESS OF LOCAL VARS SX3 X3+1 VARLOC OF FIRST BYTE IX4 X3+X4 ADDRESS OF LOCAL VAR IX4 X4-X2 BIAS TO LOCAL VAR BX1 X1+X4 BIAS TO SEGMENT LX1 18 BX1 X1+X5 NUMBER OF BYTES PER WORD RJ =XSTUFLIT SA2 TOKWRD RJ =XAPTWD SX4 5 X4 = SEGMENT TYPE DEFL530 LX4 XCODEAL POSITION TYPE SA1 TOKWRD BX4 X4+X1 INCLUDE ADDRESS SX4 X4-1 X4 = GETVAR CODE EQ ADNAM * * ARGDO CALL LEX GET NEXT ITEM SA1 OP ZR X1,GOTARG JUMP IF ARG NOT SEPERATOR SX2 X1-OPDEFN ZR X2,ERR6 DEFINE NAME USED AS ARGUMENT SX2 X1-OP) ZR X2,ENDARGS DONE WITH ARGS IF PAREN SX2 X1-OPCOMMA * /--- BLOCK ARGDO 00 000 77/01/26 20.37 NZ X2,ERR1 ERROR IF NOT SEPERATOR SX7 -1 SA7 LASTKEY CLEAR LASTKEY EQ ARGDO * GOTARG SA1 ADTYPE MUST BE UNRECOGNIZED NAME PL X1,ERR12 SA2 NARGS CURRENT NUMBER OF ARGUMENTS SX6 X2+1 SX0 X2-MAXARG CHECK TOO MANY ARGS PL X0,ERR5 SA6 A2 SA1 AD GET NAME OF ARGUMENT BX6 X1 SA6 X2+ARGLIST SAVE NAME OF ARGUMENT * /--- BLOCK ARGDO 00 000 77/01/26 20.37 EQ ARGDO * ENDARGS SA2 NARGS ZR X2,ERR13 JUMP IF ZERO ARGUMENTS F() RJ =XLEX GET NEXT ITEM SA1 OP SX2 X1-OP= LAST CODE MUST BE = ZR X2,DEFIN SX2 X1-OPASIGN OR ASSIGNMENT NZ X2,ERR1 * DEFIN MX6 0 RIGHT SIDE OF A DEFINITION SA6 VSKMODE RESET MODE FOR VSEEK SA6 UREF CLEAR *UNIT* ENCOUNTERED FLAG SA6 UDMODE NO INTERPRETATION OF *UNITS* SA1 TOKWRD BX6 X1 SAVE BEGINNING ADDRESS SA6 DEFLOC SX6 60 INITIALIZE SHIFT COUNT SA6 TOKSHF MX6 0 CLEAR NEXT TOKEN WORD SA6 TWD SA6 DNVAR CLEAR NUMBER VARIABLES MX6 -1 ASSUME CONSTANT OR SIMPLE SA6 DCONST SA1 WORDPT BX6 X1 SAVE *WORDPT* SA6 IWORDPT SA2 LOCAL ZR X2,DEFIN10 IF NOT PROCESSING LOCAL SET * SA1 ENDKEY X1 = TERMINATOR/DELIMITER SX2 X1-OPCOMMA ZR X2,DEFL400 IF SCALAR LOCAL DEFINE * SX2 X1-EOL ZR X2,DEFL400 IF SCALAR LOCAL DEFINE * DEFIN10 BSS 0 SA1 NARGS NUMBER OF ARGS IS FIRST TOKEN RJ STUFF * /--- BLOCK DLEX 00 000 77/02/25 03.58 * * NOW INTERPRET DEFN * DLEX BSS 0 SX7 1 INITIALIZE LITS POINTER SA7 NLITS RJ =XLEX GET NEXT OP/ADD SA1 OP ZR X1,ADDR JUMP IF ADDRESS SX2 X1-OPCOMMA ZR X2,ENDDEF SX2 X1-EOL ZR X2,ENDDEF END OF DEFINE * RJ STUFF SA2 NOPS SX6 X2+1 COUNT OPS SA6 A2 EQ DLEX * * PROCESS ADDRESS * ADDR SA1 NADS SX6 X1+1 INCREMENT ADDRESS COUNT SA6 A1 SA1 ADTYPE NG X1,ARGLOOK UNRECOGNIZED - CHECK ARGLIST BX2 X1 AX2 XCODEAL SHIFT OFF ADDRESS MX0 -4 MASK FOR I/F BIT AND TYPE CODE BX2 -X0*X2 SB1 X2 JP B1+*+1 JUMP BY TYPE * + EQ ADDR1 SHORT LITERAL + EQ ADRLIT LONG LITERAL + EQ ADDRV STUDENT VARIABLE + EQ ADDRV COMMON VARIABLE + EQ ERR11 IMPOSSIBLE + EQ ADRSEG SEGMENT + EQ ADRARY ARRAY + EQ ERR11 IMPOSSIBLE * + EQ ADUNIT UNIT + EQ ADRLIT LONG LITERAL + EQ ADDRV STUDENT VARIABLE + EQ ADDRV COMMON VARIABLE + EQ ERR11 IMPOSSIBLE + EQ ERR11 IMPOSSIBLE + EQ ERR11 IMPOSSIBLE + EQ ERR11 IMPOSSIBLE * * ADDRV SA2 DNVAR INC NUMBER VARS ENCOUNTERED SX6 X2+1 SA6 A2 * ADDR1 RJ STUFADR *STUFF* BOTTOM 24(X1) IN TOKENS EQ DLEX * /--- BLOCK ADRSEG 00 000 77/02/25 04.19 * * PROCESS LONG LITERAL * * SEGMENT HAS A LITERAL ASSOCIATED -- A 60-BIT WORD * DESCRIBING THE SEGMENTATION. SIMILARLY, ARRAYS HAVE * AN INFO WORD (AND BASE-BIAS OR SEGMENTED ARRAYS HAVE TWO) * ADRARY BSS 0 MX6 0 MARK NOT ALL CONSTANT/SIMPLE SA6 DCONST EQ ADDR1 PREVIOUSLY DEFINED * ADRSEG MX6 0 MARK NOT ALL CONSTANT/SIMPLE SA6 DCONST EQ ADDR1 PREVIOUSLY DEFINED * ADRLIT BSS 0 LX1 60-LITSHF1 NG X1,IMMLIT IF IMMEDIATE LITERAL * LX1 LITSHF1 EQ ADDR1 PREVIOUSLY DEFINED * IMMLIT LX1 LITSHF1 RJ STLIT1 LITERAL IMMEDIATELY FOLLOWS ADT EQ DLEX * ADUNIT MX6 1 MARK UNIT ENCOUNTERED LX6 XCODEAL SA6 UREF MX6 0 MARK NOT ALL CONSTANTS SA6 DCONST EQ ADDR1 * * /--- BLOCK ARGLOOK 00 000 76/02/17 20.05 * ARGLOOK SA1 NARGS NUMBER OF ARGUMENTS SA2 AD GET NAME TO SEARCH FOR MX6 0 MARK NOT ALL CONSTANTS SA6 DCONST * ASEEK1 SX1 X1-1 DECREMENT INDEX NG X1,ERR3 JUMP IF NAME NOT FOUND SA3 X1+ARGLIST BX6 X3-X2 SEE IF NAMES MATCH NZ X6,ASEEK1 BX7 X1 SAVE INDEX SX1 OPARG INSERT CODE FOR ARG RJ STUFF BX1 X7 RJ STUFF INSERT ARG NUMBER SA1 LASTKEY SX2 X1-1R( CHECK FOR IMPLIED MULTIPLY ZR X2,ARGMULT SX2 X1-KLBRACK NZ X2,DLEX ARGMULT SX1 OPMULT INSERT MULTIPLY RJ STUFF EQ DLEX * * /--- BLOCK ENDDEF 00 000 76/02/24 19.36 * * FINAL PROCESSING * CHECK FOR PRIMITIVE DEFN * ENDDEF SX1 EOL INSERT AN EOL RJ STUFF SA2 TOKWRD RJ APTWD WRITE OUT CURRENT *TWD* SA1 NARGS CHECK IF FUNCTION NZ X1,ENDD50 SA1 DCONST CHECK IF MAY BE ALL CONSTANTS ZR X1,ENDD50 OR SIMPLE VARIABLES SA1 DNVAR SX1 X1-2 CHECK IF MORE THAN ONE VARIABLE PL X1,ENDD50 ENCOUNTERED * SA1 WORDPT SAVE *WORDPT* BX6 X1 SA6 OWORDPT SA1 INX SAVE *INX* BX6 X1 SA6 OLDINX SA1 IWORDPT RE-SET *WORDPT* TO BEGIN OF BX6 X1 EXPRESSION SA6 WORDPT SA1 LASTKEY BX6 X1 SAVE *LASTKEY* SA6 OLDLAST RJ =XRTOKNAM MAKE READY FOR *INITDEF* RJ =XCOMPILE EVALUATE EXPRESSION SA2 OWORDPT BX6 X2 RESTORE *WORDPT* SA6 WORDPT SA2 OLDINX BX6 X2 RESTORE *INX* SA6 INX SA2 OLDLAST BX6 X2 RESTORE *LASTKEY* SA6 LASTKEY BX4 X1 X4 = -GETVAR- CODE AX1 XCODEAL POSTION -GETVAR- CODE TYPE MX0 -3 BX1 -X0*X1 SB1 X1 PICK UP CODE TYPE JP B1+*+1 * + EQ ENDD40 SHORT LITERAL + EQ ENDD20 LONG LITERAL + EQ ENDD40 STUDENT VARIABLE + EQ ENDD40 COMMON VARIABLE + EQ NORMAL EXPRESSION + EQ NORMAL UNUSED + EQ NORMAL ARRAY + EQ NORMAL SPECIAL JUMP * * /--- BLOCK ENDD20 00 000 76/02/19 02.45 * ENDD20 BSS 0 SA1 DEFLOC RE-SET TOKEN POINTER BX6 X1 SA6 TOKWRD MX0 -XCODEAL BX2 -X0*X4 ISOLATE ADDRESS SA2 X2+INFO LOAD LITERAL BX6 X2 SA6 TWD MX6 0 SA6 TOKSHF INDICATE NO BITS LEFT BX4 X0*X4 ZERO ADDRESS BX4 X4+X1 INSERT ADDR(LIT IN TOKBUFF) RJ ENDDTWD EQ ADNAM * ENDD40 BSS 0 MX6 0 SA6 TWD SA1 DEFLOC RE-SET TOKEN POINTER BX6 X1 SA6 TOKWRD SX6 60 ALL BITS AVAILABLE SA6 TOKSHF EQ ADNAM * ENDD50 SA1 NADS NUMBER OF ADDRESSES SX1 X1-1 NZ X1,NORMAL JUMP IF NOT SIMPLE SA1 NOPS NUMBER OF OPERATIONS NZ X1,NORMAL JUMP IF NOT SIMPLE SA1 DEFLOC ADDRESS OF DEFN RJ =XSETDEF RJ =XGETDEF NUMBER OF ARGUMENTS NZ X1,NORMAL RJ =XGETDEF GET FIRST ITEM MX0 42 (X0) = GETVAR MASK BX4 -X0*X1 SAVE *GETVAR* CODE EQ ADNAM ADD DEFN NAME TO TABLE * * -ENDDTWD- * ADD THE LAST TOKEN WORD TO *TOKBUF* * ENDDTWD EQ * BX6 X4 SAVE GETVAR CODE SA6 GVSAVE SA2 TOKWRD RJ APTWD SA4 GVSAVE EQ ENDDTWD * GVSAVE BSS 1 * /--- BLOCK NORMAL 00 000 75/02/11 02.52 * NORMAL SX4 4 USE CODE FOR CALC LX4 XCODEAL POSITION CODE SA1 UREF BX4 X1+X4 ATTACH *UNIT* BIT SA1 DEFLOC BX4 X4+X1 ATTACH ADDRESS * SA1 TOKWRD * SX6 X1+1 ADVANCE TO NEXT FREE WORD * SA1 ATOKEN * IX5 X1+X6 ECS ADDRESS OF NEXT TWD * SA2 AVAR ECS ADDRESS OF FIRST NAME * IX1 X5-X2 * PL X1,ERR4 BUFFER FULL * SA6 TOKWRD * ADNAM BSS 0 CALL ADDNAM,DEFNAME * /--- BLOCK ENDLIN 00 000 81/07/16 04.21 SA1 LASTKEY CHECK IF MORE TO LINE SA1 X1+KEYTYPE SX2 X1-OPCOMMA NZ X2,ELN1 JUMP IF NOT COMMA SA1 WORDPT SA2 X1 SEE IF END-OF-LINE ZR X2,ELN1 EQ DEFRD CONTINUE IF MORE * ENDLIN SX2 X1-EOL SEE IF END OF LINE CODE ZR X2,ELN1 JUMP IF END-OF-LINE EQ DEFRD * ELN1 RJ =XRTOKNAM FOR CONDITIONAL CSTOP/CSTART RJ =XGETLINE SA1 COMMAND CHECK FOR BLANK COMMAND SA2 COMCONT BX2 X1-X2 BLANK FOR CONTINUED COMMAND ZR X2,DEFRD JUMP IF CONTINUED SA3 LOCAL SEE IF LOCAL SET PROCESSING ZR X3,ELN5 NEXT COMMAND IF GLOBAL SET * RJ =XSAVETAG SAVE THE NEXT LINES TAG SA0 LUNIT RESTORE -UNIT- TAG FOR ARG SA1 ATEMPEC BX0 X1 WE TAGLTH+1 RJ ECSPRTY SA0 TAG RE TAGLTH+1 RJ ECSPRTY * SA1 LWRDPT POINT TO ARGUMENTS LIST BX6 X1 SA6 WORDPT EXEC JOINOV,14 RE-ENTER -UNIT PROCESSING * ELN5 BSS 0 SA2 HOLDEFN IX2 X1-X2 CHECK FOR ANOTHER -DEFINE- ZR X2,DEFNIN * EQ NXTC NOSET SB1 11 NO SET SA2 KE1 EQ ERRX * NAMERR SB1 12 BAD NAME SA2 KE2 EQ ERRX * DUPNAM SB1 13 DUPLICATE SA2 KE3 EQ ERRX * BADVAR SB1 14 BAD VAR SA2 KE4 EQ ERRX * BADFORM SB1 15 BAD FORM SA2 KE5 EQ ERRX * BADCNT SB1 16 BAD COUNT SA2 KE6 EQ ERRX * BADSIZ SB1 17 BAD SIZE SA2 KE7 EQ ERRX * BADTYP1 MX6 0 RESET LOCALS FLAG SA6 LOCAL BADTYP SB1 18 ARRAY TYPE SA2 KE8 * /--- BLOCK ENDLIN 00 000 80/03/23 08.26 EQ ERRX * LITFULL SB1 19 MANY LITS SA2 KE9 EQ ERRX * NAMFULL SB1 20 MANY NAMES SA2 KE10 EQ ERRX * UFULL SB1 21 MANY UNITS SA2 KE11 EQ ERRX * NOTYET SB1 22 NOT YET IN SA2 KE12 EQ ERRX * * * * /--- BLOCK ENDLIN 00 000 80/03/23 08.25 ERR1 EQ CHARERR * ERR2 EQ LITERR * ERR3 SB1 25 UNDEFINED SA1 KERR3 * ERRX BX7 X1 SA7 CERROR1 STORE MESSAGE ERRXX SX7 11 CODE FOR DEFINE ERROR SA7 TFORMOK SA3 LOCAL ZR X3,=XERR IF NOT PROCESING LOCAL SET * SA1 DSET SA1 SETNAMS+X1 X1 = NAME OF CURRENT SET SA2 KLOCAL X2 = NAME OF LOCAL SET IX3 X1-X2 ZR X3,=XERR IF LOCAL SET PROCESSING OK * MX6 0 NO LOCAL SET IN EFFECT SA6 A3 ZERO LOCAL FLAG EQ =XERR * ERR4 SB1 26 TOO MUCH SA1 KERR4 EQ ERRX * ERR5 SB1 27 MANY ARGS SA1 KERR5 EQ ERRX * ERR6 SB1 28 DUPLICATE SA1 KERR6 EQ ERRX * ERR7 SB1 29 BAD NAME SA1 KERR7 EQ ERRX * ERR8 SB1 30 BAD SET SA1 KERR8 EQ ERRX * /--- BLOCK ERR9 00 000 80/03/23 07.50 * LIST X *CALL DEFTEXT LIST * * /--- BLOCK ERR9 00 000 80/03/23 07.50 * ERR9 SB1 31 NO SET SA1 KERR9 EQ ERRX * ERR10 EQ FORMERR * ERR11 SB1 32 SYS ERR 1 SA1 KERR11 EQ ERRX * ERR12 SB1 33 ARG MUST BE UNRECOGNIZED NAME EQ ERRXX * ERR13 SB1 34 CAN'7T HAVE ZERO ARGUMENTS F() EQ ERRXX * * /--- BLOCK PURGE/ALL 00 000 79/02/18 17.47 * PURGE SX3 X2-EOL ZR X3,PURGALL PURGE ALL DEFINE SETS CALL GETNAME,7 GET NAME OF SET TO PURGE SX3 X2-EOL ERROR IF NOT END-OF-LINE NZ X3,ERRORC RJ =XFINDSET SEE IF SET EXISTS NG B1,ERRORC * RJ PURGSET PURGE DSET B1 EQ PNXTLN * PURGALL BSS 0 RJ ALLPURG SUBROUTINE SINCE USED ELSEWHER EQ PNXTLN * * * *PURGSET* * * PURGE DEFINE SET * ON ENTRY B1 = DSET TO PURGE * DSET = CURRENTLY OPEN SET * * ON EXIT DSET = -1 IF ACTIVE SET PURGED * PURGSET EQ * SX6 B1 SAVE DSET TO BE PURGED SA6 PSET SA1 DSET SEE IF IT IS CURRENT SET SB2 X1 NE B1,B2,NOCLOSE IF NOT PURGING ACTIVE DSET * SX1 -1 NULL SET TO BE ACTIVE NOCLOSE BX6 X1 SAVE ACTIVE DSET SA6 ODSET SB1 -1 GET NULL SET RJ =XGETSET SA1 PSET B1 = SET TO PURGE SB1 X1 SA1 TOKADDS+B0 SOURCE OF MOVE SA2 TOKLENS+B1 SA3 NAMLENS+B1 IX2 X2+X3 IX2 X2+X1 DESTINATION OF MOVE SA3 TOKADDS+B1 IX3 X3-X1 LENGTH OF MOVE SB4 B1 SET TO END UPDATE SB3 -1 SET TO BEGIN UPDATE RJ =XUPDNT UPDATE TOK/NAMADDS MX6 0 NO TOKENS OR DEFNAMS SA6 SETNAMS+B1 SA6 NAMLENS+B1 SA6 TOKLENS+B1 SA4 TOKADDS+B1 BX6 X4 SA6 NAMADDS+B1 SA0 VARS SB1 VARLONG RJ =XMVECS DELETE ECS COPY OF DSET SA1 ODSET SB1 X1 RJ =XGETSET SA1 PSET RESTORE B1 SB1 X1 EQ PURGSET PSET BSS 1 * /--- BLOCK ALLPURG 00 000 81/07/16 04.20 * ALLPURG EQ * SB1 B0 BEGIN WITH DSET 0 PURGLP SA1 SETNAMS+B1 DO NOT PURGE STUDENT DEFINE SET SA2 KSTUD X2 = STUDENT SET NAME IX1 X1-X2 ZR X1,NOPURG IF STUDENT SET, DO NOT PURGE * RJ PURGSET NOPURG BSS 0 SB1 B1+1 SB2 MAXSET NE B1,B2,PURGLP IF MORE TO PURGE EQ ALLPURG * PURGEL EQ * RJ =XSETSET SET UP LOCAL DEFINE SET PARMS. SA1 KLOCAL X1 = NAME OF LOCAL SET BX6 X1 RJ =XFINDSET B1 = SET NUMBER OF SET X6 NG B1,LPERR IF NO LOCAL SET * RJ PURGSET PURGE SET NUMBER B1 EQ PURGEL * PURGELU RJ PURGEL SA1 GSET REACTIVATE GLOBAL DEFINE SET SB1 X1 RJ =XGETSET EXEC JOINOV,15 RE-ENTRY TO -UNIT- PROCESSING * PURGELD RJ PURGEL EQ =XDFRD10 * LPERR EQ "CRASH" LOCAL SET DIDNT EXIST * * * PNXTLN RJ =XGETLINE SA1 COMMAND CHECK FOR BLANK COMMAND SA2 COMCONT BX2 X1-X2 BLANK FOR CONTINUED COMMAND ZR X2,ERRORC ERROR IF CONTINUED EQ NXTC * * /--- BLOCK NEWSET 00 000 75/05/29 04.20 * * * -NEWSET- * INITIALIZES A DEFINE GROUP FOR THE NAME IN X6 * ON RETURN B1 CONTAINS THE INDEX OF THE GROUP * NEWSET EQ * SA6 SAVEDNM SAVE THE SET NAME NW1 MX6 0 0 NAME IS EMPTY SLOT RJ =XFINDSET LOOK FOR EMPTY SLOT GE B1,B0,NW2 IF EMPTY SLOT FOUND, INITIALIZE * RJ ALLPURG PURGE ALL BUT -STUDENT- EQ NW1 THIS TIME IT WILL FIND IT * NW2 BSS 0 SA1 SAVEDNM BX6 X1 SA6 SETNAMS+B1 STORE THE SET NAME EQ NEWSET * * /--- BLOCK STUFF 00 000 75/02/11 03.16 * * * -STUFF- * STORES THE 12 BIT BYTE IN LOWER X1 IN THE NEXT * BYTE POSITION OF *TOKBUF* * STUFF EQ * SA2 TOKWRD WORD COUNT SA3 TOKSHF SHIFT COUNT SB1 X3-12 PL B1,STUF1 JUMP IF DONT NEED NEW WORD * RJ APTWD WRITE OUT CURRENT TOKEN WORD SA3 TOKSHF SB1 48 DECREMENT *TOKSHF* STUF1 MX0 48 12 BIT MASK BX1 -X0*X1 SA2 TWD LOAD CURRENT WORD LX1 X1,B1 POSITION NEW BYTE LX0 X0,B1 BX6 X2*X0 CLEAR NEW BYTE POSITION BX6 X6+X1 ATTACH NEW BYTE SA6 A2 STORE NEW *TWD* SX6 B1 STORE NEW *TOKSHF* SA6 A3 EQ STUFF * * * SET THE TOP BIT OF THE FIRST 12 BIT BYTE * OF AN ADDRESS *ADTYPE* TO INDICATE THE * FOLLOWING BYTE CONTAINS FURTHER INFORMATION * AND PUT BOTH BYTES IN THE TOKEN BUFFER * ON ENTRY (X1) = ADTYPE * STUFADR EQ * BX7 X1 AX1 12 STORE FIRST 12 BITS SX2 4000B SET 12TH BIT OF 1ST BYTE BX1 X1+X2 RJ STUFF BX1 X7 RESTORE RJ STUFF STORE 2ND 12 BITS BX1 X7 RESTORE EQ STUFADR * * /--- BLOCK STLIT1 00 000 79/02/20 21.04 * * LITERAL IS IMMEDIATE SO IT ADDS IT TO THE * TOKEN BUFFER IN THE FIRST WHOLE WORD AFTER ITS * ADTYPE WITH THE 22ND BIT OF THE ADTYPE SET * TO INDICATE IMMEDIACY TO *GETDEF* * ON ENTRY (X1) = GETVAR CODE * ADDRESS OF GETVAR CODE POINTS INTO *LITS* * STLIT1 EQ * SA2 TOKSHF PREDICT ADDR OF LIT SA3 TOKWRD SX4 X2-24 PL X4,NXTWD IF LIT CAN BEGIN AT NEXT WORD * SX3 X3+1 MUST BEGIN ONE WORD AFTER THAT NXTWD SX3 X3+1 POINT TO NEXT WORD MX0 -XCODEAL BX2 -X0*X1 GET ADDRESS OF LIT IN *LITS* SA2 LITS+X2 GET LITERAL BX6 X2 SA6 LIT BX1 X0*X1 ZERO OUT ADDRESS BX1 X1+X3 ENTER LIT ADDR IN TOKEN BUFF RJ STUFADR STUFF BOTH BYTES OF (X1) SA1 LIT (X1) = LITERAL RJ STUFLIT WRITE OUT LITERAL TO TOKENS * IN NEXT AVAILABLE WORD EQ STLIT1 * /--- BLOCK CONSTANTS 00 000 80/03/23 07.51 * SUBROUTINE TO CHECK LIST OF SPECIAL NAMES LUPDUN SA7 SEGFLG SET SPECIAL DEFINE TYPE DEFNAMS EQ * ENTER WITH MAX NO NAMES IN X7 LUPNAM SA3 X7+DEFNAM-1 GET SPL NAME IN X3 IX3 X3-X6 NAME IS IN X6 ZR X3,LUPDUN QUIT IF FOUND SX7 X7-1 NZ X7,LUPNAM EQ LUPDUN * * LIST OF SPECIAL DEFINE TYPE NAMES * DEFNAM DATA 7LSEGMENT DATA 8LSEGMENTV DATA 5LUNITS DATA 5LARRAY DATA 8LARRAYSEG DATA 9LARRAYSEGV DATA 7LCOMPLEX DATA 0LSEGMENTF DEFGNML EQU *-DEFNAM DATA 7LINTEGER DATA 8LFLOATING DEFLNML EQU *-DEFNAM DATA 5LPURGE ONLY ACTIVE ON FIRST LINE DEFNAML EQU *-DEFNAM DATA 5LMERGE ONLY ACTIVE IN LOCAL SET, LN 1 * K60 DATA 60.0 KVERT DATA 0LVERTICAL KSIGN DATA 0LSIGNED KS DATA 0LS KE1 DATA 10LNO SET KE2 DATA 10LBAD NAME KE3 DATA 10LDUPLICATE KE4 DATA 10LBAD VAR KE5 DATA 10LBAD FORM KE6 DATA 10LBAD COUNT KE7 DATA 10LBAD SIZE KE8 DATA 10LARRAY TYPE KE9 DATA 10LMANY LITS KE10 DATA 10LMANY NAMES KE11 DATA 10LMANY UNITS KE12 DATA 10LNOT YET IN * KPREVN DATA 8LPREVIOUS KGLOBAL DATA 0LGLOBAL * * KBLANK DATA 10L BLANKS KSTUD DATA 7LSTUDENT * * KERR3 DATA 10LUNDEFINED KERR4 DATA 10LTOO MUCH KERR5 DATA 10LMANY ARGS KERR6 DATA 10LDUPLICATE KERR7 DATA 10LBAD NAME KERR8 DATA 10LBAD SET KERR9 DATA 10LNO SET KERR11 DATA 10LSYS ERR 1 * * SAVEDNM BSS 1 DEFNAME BSS 1 DEFLOC BSS 1 ENDKEY BSS 1 UREF BSS 1 DCONST BSS 1 DNVAR BSS 1 IWORDPT BSS 1 OWORDPT BSS 1 INDLIT BSS 1 OLDINX BSS 1 OLDLAST BSS 1 NARGS BSS 1 ARGLIST BSS MAXARG * * ENDOV * * OVTABLE * * END DEFINE$ * /--- BLOCK SEGMENT 00 000 81/07/13 01.10 IDENT SEGMENT LCC OVERLAY(1,1) * TITLE SEGMENT/ARRAY/UNITS TITLE * * CST * * SEGMNT$ OVFILE * * EXT CHARERR,BADPAR,DECERR,VARERR EXT LOGERR,FORMERR,EQERR,OCTERR EXT ALFERR,INDXERR,DEFERR,SEGERR EXT COMPERR,LNGERR,LITERR,TEMPERR EXT ECSPRTY * EXT COMCONT,DEFREAD,NXTC EXT KEYTYPE,SEGFLG * * SEGOV OVRLAY SA1 OVARG1 GET OVERLAY ARGUMENT SB1 X1 JP B1+*+1 * + EQ SEGRD -SEGMENT- + EQ UNSRD -UNITS- * * * /--- BLOCK SEGMENT 00 000 73/00/00 00.00 TITLE READ-IN FOR -SEGMENT- COMMAND * * * -SEGREAD- * READ-IN ROUTINE FOR -SEGMENT- COMMAND * ADDS THE NAME OF THE SEGMENT TO THE DEFINED * NAME TABLE AND ADDS A LITERAL CONTAINING THE * SEGMENT INFO TO THE DEFINED TOKEN TABLE * * FORMAT OF SEGMENT INFO WORD - * * SIGN BIT = 0 FOR STUDENT, 1 FOR COMMON * NEXT BIT = 0 IF UNSIGNED, 1 IF SIGNED * NEXT BIT = 0 IF HORIZONTAL, 1 IF VERTICAL * NEXT BIT = 1 IF SEGMENTF * NEXT 2 BITS = UNUSED * NEXT 18 BITS = NUMBER OF BITS PER BYTE * NEXT 18 BITS = BIAS TO START OF ARRAY * NEXT 18 BITS = NUMBER OF BYTES PER WORD (HORIZ) * BIT POSITION OF BYTE (VERT) * * /--- BLOCK SEGRD 00 000 76/08/02 00.06 * SEGRD SA1 DSET MUST HAVE DEFINE SET NG X1,NOSET SA1 WORDPT SA1 X1-1 BACK UP TO PREVIOUS CHARACTER SA2 X1+KEYTYPE SX1 X2-OPCOMMA SEE IF ENDED WITH COMMA NZ X1,BADFORM MX6 -1 SET MODE FOR -VSEEK- SEARCH SA6 VSKMODE CALL GETNAME,8 GET NAME OF SEGMENT/ARRAY ZR X6,NAMERR SA6 SEGNAM SB2 B1-8 CHECK HOW MANY CHARACTERS NG B2,SEG005 SA3 KVERT BX3 X3-X6 CHECK FOR SEGMENT,VERTICAL ZR X3,VERTSEG EQ NAMERR 8 CHARACTER NAME NOT LEGAL * SEG005 SA3 SEGFLG IS 1,2 IF SEGMENT,SEGMENTV SX3 X3-3 NG X3,SEG008 IF SEGMENT/SEGMENTV SX3 X3-8+3 NZ X3,ARAYDEF IF NOT SEGMENTF SEG008 SX1 X2-OPCOMMA CHECK FOR COMMA ZR X1,SEG010 SX1 X2-OP= CHECK FOR = ZR X1,SEG010 SX1 X2-OPASIGN CHECK FOR ASSIGNMENT NZ X1,BADFORM * SEG010 RJ =XVSEEK SEE IF ALREADY DEFINED SA1 ADTYPE PL X1,DUPNAM EXIT IF DUPLICATE NAME SA7 DEFNLOC SAVE LOCATION OF DEFINITION CALL SYMCHK,SEGNAM RJ =XRTOKNAM MAKE READY FOR *INITDEF* RJ =XCOMPILE STARTING VARIABLE OF ARRAY MX0 -XCODEAL MASK FOR ADDRESS PORTION BX6 -X0*X1 LX6 18 POSITION ADDRESS AX1 XCODEAL POSITION -GETVAR- CODE TYPE MX0 -3 BX1 -X0*X1 MASK OFF 3 BIT TYPE CODE SX2 X1-2 ZR X2,SEG100 OK IF STUDENT BANK SX2 X1-3 NZ X2,BADVAR ERROR IF NOT COMMON MX7 1 BX6 X6+X7 SET SIGN BIT FOR COMMON SEG100 SA6 SEGWORD SAVE TYPE BIT AND ADDRESS SA1 SEGFLG SX1 X1-1 CHECK FOR SEGMENT NZ X1,VSEG20 IF SEGMENTV/F * /--- BLOCK SEG200 00 000 75/05/29 04.25 * RJ =XRTOKNAM MAKE READY FOR *INITDEF* RJ =XCOMPILE MX0 -XCODEAL BX6 X0*X1 MUST BE SHORT LITERAL NZ X6,BADCNT ZR X1,BADCNT SX6 X1-60 CHECK IF BYTE TOO BIG PL X6,BADCNT PX6 X1 NX6 X6 CONVERT TO FLOATING SA2 K60 FX6 X2/X6 COMPUTE BYTES PER WORD UX6 X6,B1 LX6 X6,B1 BACK TO INTEGER LX1 18+18 BX6 X1+X6 COMBINE BIT AND BYTE COUNTS SA1 SEGWORD BX6 X1+X6 COMBINE WITH INFO WORD SA6 A1 * SEG200 SA2 LASTKEY LOAD LAST CHARACTER ZR X2,ADDLIT JUMP IF END-OF-LINE SA2 X2+KEYTYPE SX6 X2-OPCOMMA CHECK FOR COMMA NZ X6,BADFORM * * CHECK FOR SIGNED SEGMENT OPTION * CALL GETNAME,7 GET OPTION NAME ZR X6,NAMERR NZ X1,BADFORM ERROR IF NOT END-OF-LINE SA3 KSIGN CHECK FOR SIGNED SEGMENT BX3 X6-X3 ZR X3,SIGNSEG SA3 KS ALLOW ABBREVIATION BX3 X6-X3 NZ X3,NAMERR ERROR IF NOT -S- * SIGNSEG MX6 1 LX6 59 POSITION FOR SECOND BIT SA1 SEGWORD BX6 X1+X6 SET SECOND BIT SA6 A1 EQ ADDLIT * * /--- BLOCK VERTSEG 00 000 76/08/02 00.10 * * PROCESS SEGMENT,VERTICAL CASE * VERTSEG SA3 SEGFLG CHECK TYPE FLAG SX3 X3-1 NZ X3,NAMERR ERROR IF NOT -SEGMENT- SX1 X2-OPCOMMA NZ X1,BADFORM ERROR IF DID NOT END WITH COMMA CALL GETNAME,7 GET NAME OF SEGMENT ZR X6,NAMERR SA6 SEGNAM SX7 2 SA7 SEGFLG SET SEGMENTV EQ SEG008 * VSEG20 RJ =XRTOKNAM MAKE READY FOR *INITDEF* RJ =XCOMPILE EVALUATE STARTING BIT POSITION ZR X1,BADCNT EXIT IF BAD BIT POSITION MX0 -XCODEAL BX0 X0*X1 MASK ALL BUT ADDRESS PORTION NZ X0,BADCNT EXIT IF NOT A SHORT LITERAL SX0 X1-61 PL X0,BADCNT EXIT IF ILLEGAL BIT POSITION SA2 SEGWORD BX6 X1+X2 MERGE BIT POSITION WITH INFO SA6 A2 * RJ =XRTOKNAM MAKE READY FOR *INITDEF* RJ =XCOMPILE EVALUATE LENGTH OF BYTE ZR X1,BADCNT EXIT IF BAD BYTE SIZE MX0 -XCODEAL BX0 X0*X1 MASK ALL BUT ADDRESS PORTION NZ X0,BADCNT SX0 X1-60 PL X0,BADCNT EXIT IF BAD BYTE SIZE SA2 SEGWORD SX0 X2-1 PICK UP BIT POSITION IX0 X0+X1 ADD LENGTH OF BYTE SX0 X0-61 PL X0,BADCNT EXIT IF BYTE SIZE TOO BIG LX1 18+18 POSITION LENGTH OF BYTE BX6 X1+X2 MX0 1 LX0 58 POSITION VERTICAL BIT BX6 X0+X6 SA1 SEGFLG CHECK IF SEGMENTF SX1 X1-8 NZ X1,VSEG30 IF NOT SEGMENTF LX0 -1 BX6 X0+X6 VSEG30 SA6 A2 UPDATE SEGMENT INFO WORD EQ SEG200 * * * /--- BLOCK ADDLIT 00 000 81/07/16 04.20 * * ADD SEGMENT INFO WORD TO DEFINED LITERAL TABLE * ARRAY USES THIS IF HAS ONLY ONE LITERAL WORD * ADDLIT BSS 0 SA1 SEGWORD RJ =XSTUFLIT STORE SEGMENT DESCRIPTOR SA2 TOKWRD IN ECS TOKEN BUFFER RJ =XAPTWD SA2 TOKWRD ADDRESS OF LITERAL IN TOKENS SB1 X2-1 SA1 SEGFLG CHECK TYPE SX1 X1-3 NG X1,SEG400 JUMP IF -SEGMENT- ZR X1,SEG400 IN CASE -UNITS- USES THIS LATER SX1 X1-8+3 ZR X1,SEG400 IF SEGMENTF * SEG310 SX4 6 6=CODE FO ARRAY IN *DEFNLEX* EQ SEG410 * SEG400 SX4 5 5=SEGMENT SEG410 LX4 XCODEAL POSITION TYPE SX1 B1 BX4 X4+X1 FORM GETVAR CODE CALL ADDNAM,SEGNAM * ENDSEG EXEC DEFOV,2 RETURN FROM SEGOV * * /--- BLOCK SEGERRS 00 000 76/06/30 02.59 * NOSET SB1 11 NO SET SA2 KE1 EQ ERRX * NAMERR SB1 12 BAD NAME SA2 KE2 EQ ERRX * DUPNAM SB1 13 DUPLICATE SA2 KE3 EQ ERRX * BADVAR SB1 14 BAD VAR SA2 KE4 EQ ERRX * BADFORM SB1 15 BAD FORM SA2 KE5 EQ ERRX * BADCNT SB1 16 BAD COUNT SA2 KE6 EQ ERRX * BADSIZ SB1 17 BAD SIZE SA2 KE7 EQ ERRX * BADTYP SB1 18 ARRAY TYPE SA2 KE8 EQ ERRX * LITFULL SB1 19 MANY LITS SA2 KE9 EQ ERRX * NAMFULL SB1 20 MANY NAMES SA2 KE10 EQ ERRX * UFULL SB1 21 MANY UNITS SA2 KE11 EQ ERRX * NOTYET SB1 22 NOT YET IN SA2 KE12 EQ ERRX * ERRX BX6 X2 PLANT ERROR MESSAGE SA6 CERROR1 SX7 11 DEFINE ERROR SA7 TFORMOK EQ =XERR NEW CONDENSE ERROR PROCESSING * * SEGNAM BSS 1 USNAM EQU SEGNAM * SEGWORD BSS 1 ARAYWD EQU SEGWORD ARAYWD2 BSS 1 * * * /--- BLOCK ADDNAM 00 000 75/02/10 20.14 LIST X *CALL DEFTEXT LIST * * ERR4 SB1 26 TOO MUCH SA1 KERR4 BX7 X1 SA7 CERROR1 STORE MESSAGE SX7 11 CODE FOR DEFINE ERROR SA7 TFORMOK EQ =XERR * KERR4 DATA 10LTOO MUCH * /--- BLOCK ARAYDEF 00 000 76/07/02 01.12 * * TITLE ARRAY DEFINE * * READIN FOR -ARRAY- AND -COMPLEX- * * PERMISSABLE FORMS FOR ARRAY DEFINE... * ARRAY,NAME=V1 (SCALAR ARRAY WITH ROWS=COLS=1) * ARRAY,NAME(ROWS)=N1 (VECTOR WITH COLS=1) * ARRAY,NAME(ROWS,COLS)=VC1 (MATRIX) * ARRAY,NAME(ROW1;ROWS)=V1 (VECTOR BASE REDEFN) * ARRAY,NAME(ROWS,COLS;ROW1,COL1)=N1 (BASE REDEFN) * ARRAY,..ANY ABOVE FORM..=N1,6,S (SEGMENTED ARRAY) * COMPLEX,...ANY REAL NON-SEGMENTED SPEC ABOVE OK * * FORMAT OF ARRAY/COMPLEX INFO WORD * * BIT 59 = 0 FOR STUDVAR, 1 FOR COMMON * BIT 58 = 0 FOR REAL, 1 FOR COMPLEX ARRAY * BIT 57 = 0 FOR BASE INDEX OF 1, =1 FOR OTHER * BIT 56 = 0 FOR WORD, 1 FOR SEGMENTED ARRAY * IF BITS 56OR57 ON, NEXT LITWORD HAS DETAILS * BITS 55,54 HAVE ARRAY DIMENSIONS, 0 IS SCALAR, * 1 FOR VECTOR, 2 FOR MATRIX, 3-D NOT IMPLEMENTED * NEXT 9 BITS ARE SIZE = ROWS"COLS (MAX 511) * NEXT 9 BITS ARE NUMBER OF ROWS-1 * NEXT 9 BITS ARE NUMBER OF COLS-1 * NEXT 9 BITS ARE NUMBER OF PLANES-1 (FOR 3-D) * LOWER 18 BITS ARE GETVAR CODE OF FIRST ELEMENT * I/F BIT,3 TYPEBITS(2=STUD,3=COMM),14BITS REL ADDR * * ARAYWD2 (2D LITWORD) FORMAT USED FOR * SEGMENTED AND BASE-REDEFINED ARRAYS * * BIT 59 SET IF SIGNED SEGMENT * BIT 58 SET IF VERTICAL SEGMENT, 0 IF HORIZONTAL * NEXT 4 BITS UNUSED * NEXT 6 BITS ARE (BITS/BYTE) FOR SEGMENT * NEXT 6 ARE (BYTES/WD) (0-63) FOR HORIZ SEG * OR ARE (BIAS TO START OF SEG) IF VERTICAL * NEXT 14 ARE ROW BASE INDEX * NEXT 14 ARE COL BASE INDEX * LAST 14 ARE PLANE BASE INDEX * * ARAYDEF SX7 1 INITIALIZE SA7 NROW SA7 NCOL SA7 ROW1 SA7 COL1 MX7 0 SA7 ARAYWD SA7 ARAYWD2 SA7 DIMEN BX7 X2 SA7 SIZ SAVE TERMINATOR * * /--- BLOCK ARAYNAM 00 000 76/06/30 03.00 * DETERMINE ARRAY NAME AND ANALYZE DIMENSIONS RJ =XVSEEK SEE IF ALREADY DEFINED SA1 ADTYPE PL X1,DUPNAM ERROR IF DUPLICATE NAME SA7 DEFNLOC SAVE ECS LOC TO INSERT DEFN CALL SYMCHK,SEGNAM CHECK FOR REDEFN WARNING SA2 SIZ RESTORE TERMINATOR SX1 X2-OP= CHECK FOR = ZR X1,ARAYLOC IS SCALAR SX1 X2-OPASIGN CHECK FOR ASSIGNMENT ZR X1,ARAYLOC IS SCALAR SX7 1 SA7 DIMEN SX1 X2-OP( CHECK FOR (SIZE) IN PAREN NZ X1,BADFORM RJ SIZFIL GET 1ST SIZE FIELD SA6 NROW AND SAVE IT SX3 X2-OP) CHECK FOR ONLY ONE FIELD ZR X3,ARAYNUL JUMP IF VECTOR SX3 X2-OPCOMMA CHECK FOR COMMA OR SEMICOLON NZ X3,BADFORM SX3 X1-56B CHECK FOR COMMA ZR X3,ARAYMAT JUMP IF MATRIX SA6 ROW1 IS VECTOR BASE IF SEMICOLON RJ SIZFIL GET ROWS SA6 NROW SX3 X2-OP) NZ X3,BADFORM MUST BE ) EQ ARAYNUL VECTOR DONE * ARAYMAT SX6 2 SA6 DIMEN DIMEN=2 FOR MATRIX RJ SIZFIL GET COLS SA6 NCOL SX3 X2-OP) CHECK FOR LAST FIELD ZR X3,ARAYNUL JUMP IF IS SX3 X1-77B TEST FOR SEMICOLON TERMINATOR NZ X3,BADFORM ERROR IF ISNT SA6 COL1 REDEFINE BASE INDICES SA3 NROW BX7 X3 SA7 ROW1 RJ SIZFIL GET ROWS SA6 NROW SX3 X1-56B TEST FOR COMMA NZ X3,BADFORM ERROR IF NOT RJ SIZFIL GET COLS SA6 NCOL SX3 X2-OP) CHECK IF LAST FIELD NZ X3,BADFORM ERROR IF NOT * * /--- BLOCK ARAYNUL 00 000 76/08/02 03.34 * * CHECK FOR = OR _ FOLLOWING ) * ARAYNUL CALL GETNAME,7 VECTOR,MATRIX ENTER HERE NZ X6,BADFORM NEXT NAME SHOULD BE BLANK SX3 X2-OP= ZR X3,ARAYLOC TERMINATOR SHOULD BE = SX3 X2-OPASIGN OR ASSIGN ARROW NZ X3,BADFORM * * GET STARTLOC AND CHECK IF IN BOUNDS * ARAYLOC RJ =XRTOKNAM MAKE READY FOR *INITDEF* RJ =XCOMPILE GET STARTLOC ADTYPE IN X1 BX6 X1 AX1 XCODEAL POSITION CODETYPE MX3 -3 BX3 -X3*X1 GETVAR CODE TYPE MX4 0 STUD/COM BIT OFF SX2 X3-2 CHECK STARTING VARIABLE TYPE ZR X2,ARAYSTB JUMP IF STUDENT BANK SX2 X3-3 MUST BE COMMON NZ X2,BADVAR ERROR IF NOT MX4 1 SET COMMON BIT ARAYSTB BX6 X4+X6 MERGE IN SA6 ARAYWD SAVE IT SA2 LASTKEY ZR X2,ARAYSTD JUMP IF E.O.L (NOT SEGMENT) * * HANDLE SEGMENTED ARRAY ARGUMENTS * SA2 X2+KEYTYPE GET KEYTYPE SX3 X2-OPCOMMA NZ X3,BADTYP MUST BE COMMA IF SEGMENTED MX0 1 SEE BELOW **ALLOW EITHER V OR N TYPE SA1 DIMEN ZR X1,BADTYP ERROR IF SEGMENTED SCALAR LX0 57 BX6 X6+X0 SET SEGMENT BIT 56 ON LX0 3+XCODEL-XFBIT I/F BIT OFF SINCE BX6 -X0*X6 ALL SEGMENTS ARE INTEGERS SA6 ARAYWD SAVE TEMPORARILY * RJ SIZFIL GET 1ST SEGMENT ARGUMENT ZR X6,BADCNT CANNOT BE ZERO NG X6,BADCNT OR NEGATIVE SX3 X6-61 CHECK IF BYTE TOO BIG PL X3,BADCNT SA6 ATEMP SAVE TEMPORARILY *** SA3 SEGFLG SX0 X3-6 ZR X0,ARAYVER JUMP IF VERTICAL SEGMENT SX0 X3-5 NZ X0,BADFORM ERROR IF NOT HORIZ SEGMENT ZR X1,ARAYSEG IF E.O.L. SIGNBIT(X1)=0 SX3 X2-OPCOMMA NZ X3,BADFORM MUST BE ,SIGNED * CALL GETNAME,7 ZR X6,NAMERR NZ X1,BADFORM MUST BE E.O.L. MX1 1 SET SIGNBIT EQ SIGNCHK * ARAYSTD SA3 SEGFLG IF NO TAGS AFTER LOCATION SX0 X3-6 IT CANNOT BE SEGMENTED ARRAY ZR X0,BADFORM SX0 X3-5 CHECK BOTH SEGMENT,SEGMENTV ZR X0,BADFORM EQ ARAYSIZ * /--- BLOCK ARAYVER 00 000 76/08/02 03.43 * * GET VERTICAL SEGMENT BYTESIZE * ARAYVER SX3 X2-OPCOMMA NZ X3,BADFORM MUST BE , BETWEEN START,BYTE RJ SIZFIL GET SEGMENT BYTESIZ ZR X6,BADCNT CANT BE ZERO NG X6,BADCNT OR NEGATIVE SA3 ATEMP = STARTBIT IX7 X3+X6 SX7 X7-62 PL X7,BADCNT IS .GT.61 LX6 6 BX6 X6+X3 BYTESIZ/STARTBIT SA6 SIZ SAVE AGAIN IN SIZ BX3 X1 SAVE TERMINATOR MX1 1 LX1 59 SET VERTICAL,NONSIGNED BITS ZR X3,ARAYSEG JUMP IF E.O.L. * * CHECK FOR SIGNED OPTION SX3 X2-OPCOMMA NZ X3,BADFORM ERROR IF TERMINATOR NOT COMMA CALL GETNAME,7 ZR X6,NAMERR NZ X1,BADFORM ERROR IF NOT E.O.L. MX1 2 SET SIGN,VERTICAL BITS SIGNCHK SA3 KSIGN BX3 X6-X3 CHECK FOR SIGNED SEGMENT ZR X3,ARAYSEG SA3 KS ALLOW ABBREVIATION BX3 X6-X3 NZ X3,NAMERR ERROR IF NO S AFTER COMMA * * /--- BLOCK ARAYSEG 00 000 78/02/11 00.12 * * HORIZONTALLY SEGMENTED ARRAYS * ARAYSEG SA2 ARAYWD2 BX6 X1+X2 ADD SIGNED+VERT SEGMENT BITS * SA2 SIZ GET BACK SEGMENT SIZE LX1 1 **** * EQ NOTYET **USE THIS TO TURN OFF VERTSEG **** NG X1,ARAYVSG JUMP IF VERTICAL SEG ***** EQ NOTYET **THIS TURNS OFF HORIZ SEG ***** PX7 X2 NX7 X7 FLOAT BITS/BYTE SA3 K60 =60.0 FX7 X3/X7 COMPUTE BYTES/WORD UX7 X7,B1 LX7 X7,B1 AS INTEGER LX2 6 BX2 X7+X2 COMBINE BIT/BYTE COUNT ARAYVSG LX2 42 BX6 X6+X2 MERGE WITH ARAYWD2 SA6 ARAYWD2 AND SAVE * * * CALCULATE ARRAY SIZE * ARAYSIZ SA1 NROW GET LAST,FIRST ROW,COL SA2 NCOL SA3 ROW1 SA4 COL1 IX6 X1-X3 NUMBER OF ROWS-1, COLS-1 IX7 X2-X4 = COLS-1 BX5 X6+X7 BOTH SHOULD BE POSITIVE NG X5,BADSIZ SX1 X6+1 NUMROWS SX2 X7+1 NUMCOLS DX4 X1*X2 NUMROWS*NUMCOLS * IF COMPLEX MUST DOUBLE SIZE SA3 SEGFLG SX3 X3-7 SX0 0 BIT 58 OFF FOR REAL SA2 ARAYWD NZ X3,ARAYPAK JUMP IF NOT COMPLEX IX4 X4+X4 DOUBLE SIZE LX2 60-XCODEL+XFBIT CHECK I/F BIT PL X2,BADTYP ERROR IF COMPLEX INTEGER TYPE SX0 20B SET REAL/COMPLEX BIT ON ***** EQ NOTYET ***TURNS OFF COMPLEX ARRAYS*** ***** * * START BUILDING ARRAY INFORMATION WORD(S) * * ARAYPAK SX3 X4-ARAYLTH MAX SIZE OF ARRAY (256) ARAYPAK SX3 ARAYLTH MAX SIZE OF ARRAY (255) IX3 X4-X3 PL X3,BADSIZ ERROR IF >256 SB1 X4-1 SAVE SIZE -1 SA3 DIMEN START BUILDING ARAYWD BX3 X0+X3 MERGE REAL/CMPLX BIT AND DIMEN LX3 9 BX3 X3+X4 MERGE THIS WITH SIZE LX3 9 THEN MERGE IN BX6 X3+X6 NUMROWS-1, LX6 9 BX6 X7+X6 NUMCOLS-1, LX6 9 N PLANES-1 = 0 FOR NOW LX6 XCODEAL+4 ROOM FOR GETVAR CODE(18BITS) SA2 ARAYWD BX6 X6+X2 MERGE SHAPE,GETVAR,COM+SEG BITS * * AT THIS POINT X6=ARAYWD, X2 HAS GETVAR, X4=SIZE * * NOW GET START LOCATION AND CHECK LENGTH IN BOUNDS. * * /--- BLOCK ARAYCHK 00 000 82/10/06 17.19 MX5 -XCODEAL BX7 -X5*X2 MASK OFF ADDRESS INTO X7 LX2 3 SEGMENT BIT AT LEFT PL X2,ARAYCHK JUMP IF NOT SEGMENTED * * REPLACE SEGMENTED ARRAY SIZE WITH NUMBER OF WORDS USED * SA1 ARAYWD2 LX1 1 MX2 -6 NG X1,ARAYCHK JUMP IF VERTICAL SEGMENT LX1 17 BX1 -X2*X1 BYTES/WD SX4 X4-1 SIZE-1 PX4 X4 NX4 X4 FLOAT SIZE PX1 X1 NX1 X1 FLOAT BYTES/WD FX4 X4/X1 (SIZE-1)/(BYTES/WD) UX4 X4,B2 LX4 X4,B2 +1= SX4 X4+1 NUMBER OF WORDS USED BY SEGARAY * ARAYCHK SX4 X4-1 SIZE-1 IX4 X7+X4 X4=LAST ARRAY ELEMENT INDEX PL X6,ARAYSTU JUMP IF IN STUDENT BANK SX1 X4-NCVRLIM-1 (LAST ELEMENT)-(LIM+1) PL X1,BADSIZ ERROR IF LAST EL NOT IN BOUNDS EQ ARAYOK * ARAYSTU SX2 X4-VARLIM-1 (LAST)-(LIM+1) NG X2,ARAYOK JUMP IF ALL INSIDE STUD BANK SX2 X7-VARLIM-1 COULD BE ROUTER ARRAY NG X2,BADSIZ JUMP IF START LOC NOT ROUTER SA1 ARVARS SA2 ASVARS IX1 X1-X2 BIAS TO ROUTER VARS SA2 RVARL (X2) = NUMBER OF RVARS ALLOWED IX1 X1+X2 OFFSET TO LAST ROUTER VAR SX1 X1+1 LIMIT FOR ROUTER VARS IX2 X4-X1 CHECK IF INDEX IS TOO LARGE NG X2,ARAYOK INSIDE ROUTER VAR LIMIT IX2 X7-X1 CHECK IF BASE WAS ROUTER VAR NG X2,BADSIZ IF SO, INDEX WAS TOO LARGE * * AT THIS POINT, MUST BE A LOCAL VAR OR AN ERROR. THIS * DEPENDS ON THE FACT THAT THE CM ADDRESSES FOR STUDENT * VARS, ROUTER VARS AND LOCAL VARS (WHICH UNFORTUNATELY * ALL HAVE THE SAME GETVAR CODE -- GRR) ASCEND IN THE * ABOVE ORDER. * SA1 ASVARS ADDRESS OF STUDENT VARS SA3 ALVARS ADDRESS OF LOCAL VARS BX0 X6 PRESERVE X6 OVER FOLLOWING IX6 X1-X3 OFFSET INTO LOCAL VARS IX6 X6+X4 OFFSET OF LAST ELEMENT + 1 RJ =XLBOUND CHECK IN BOUNDS (A1/X1 USED) SA1 LVARN NUMBER OF LOCALS USED SO FAR IX3 X6-X1 NUMBER NEEDED - NUMBER AVAIL. NG X3,LVOK MORE THAN ENOUGH AVAILABLE ZR X3,LVOK JUST ENOUGH AVAILABLE SA6 A1 MAKE NUMBER NEEDED NEW NUM USED BX6 X1 SAVE THE OLD NUMBER USED SO FAR SA6 OLVARN * * /--- BLOCK ARAYOK 00 000 82/10/06 17.20 LVOK BX6 X0 RESTORE X6 = ARAYWD ARAYOK SA6 ARAYWD SAVE ARRAY INFO WORD * * ADD BASE REDEFINITION INFO TO ARAYWD2 * SA1 ARAYWD2 CONTAINS SEGMENT INFO SO FAR SA2 ROW1 SA3 COL1 SX4 1 SET PLANE1=1 FOR NOW BX2 -X5*X2 X5 STILL = -XCODEAL 14BIT MASK BX3 -X5*X3 BX4 -X5*X4 LX2 XCODEAL BX2 X2+X3 ROW1,COL1 LX2 XCODEAL BX2 X2+X4 ROW1,COL1,PLANE1 SA4 RCPCHK SUBTRACT 1,1,1 IX7 X2-X4 ZR X7,ARAYDUN JUMP IF NO BASE REDEFINITION MX7 1 LX7 58 POSITION FOR BIT 57 * ARAYDUN BX6 X6+X7 MERGE BASEREDEF BIT INTO ARAYWD SA6 ARAYWD WHICH IS NOW COMPLETE BX7 X2+X1 MERGE SEGMENT + BASEREDEF INFO SA7 ARAYWD2 AND SAVE IT MX0 2 LX6 2 BX6 X0*X6 ZR X6,ADDLIT JUMP IF NO ARAYWD2 INFO SA1 ARAYWD RJ =XSTUFLIT SA1 ARAYWD2 RJ =XSTUFLIT SA1 TOKWRD RJ =XAPTWD SA1 TOKWRD ADDRESS OF SECOND LITERAL SB1 X1-2 POINT TO FIRST LIT EQ SEG310 * * EXIT TO ADDLITS PUTS ARAYWD INTO TOKEN TABLE * AND PUTS ARRAY NAME INTO DEFINED NAMES TABLE. * EXIT TO SEG310 JUST DOES LATTER. * * /--- BLOCK SIZFIL 00 000 80/03/23 07.51 * * SUBROUTINE TO GET SIZE INDEX IN X6 * TERMINATOR IS IN *LASTKEY* AND X1 * RETURN TERMINATOR KEYTYPE IN X2 * INDEX MUST BE + OR - 13BIT MAXIMUM * * SIZFIL EQ * MX7 0 MX6 59 SA6 VSKMODE SET -1...DONT EXPAND DEFINE SA7 SIZ SET 0 FOR +, -0 FOR - RJ =XINITLEX SIZFIL2 RJ =XLEX GET SIZE ELEMENT SA1 ADTYPE SA2 OP ZR X2,SIZFIL8 JUMP IF PURE NUMBER IN X1 SX2 X2-OPSUB ZR X2,SIZFIL4 JUMP IF UNARY MINUS SX2 X2+OPSUB-OPADD ZR X2,SIZFIL2 IGNORE UNARY PLUS SX2 X2+OPADD-OPDEFN ZR X2,SIZFIL5 JUMP IF DEFINE EQ BADFORM NO OTHER OPS ALLOWED * SIZFIL4 SA2 SIZ BX7 -X2 TOGGLE SIGN SA7 A2 EQ SIZFIL2 * SIZFIL5 MX0 -XCODEAL BX6 X0*X1 NZ X6,BADSIZ JUMP IF NOT SHORT LITERAL IN X1 *NOTE...NO USE TRYING LONGLITS, - NUMBERS ARE COMPILED..UGH * SIZFIL8 SA2 SIZ BX6 X1-X2 COMPLEMENTS ADTYPE IF SIZ=-0 BX1 X6 AX1 59 SIGN BX1 X6-X1 ABS VALUE AX1 13 CHECK FOR 13BIT MAXIMUM SIZE NZ X1,BADSIZ ERROR IF GREATER SA1 LASTKEY EXIT WITH TERMINATOR IN X1 SA2 X1+KEYTYPE TERM. KEYTYPE IN X2 EQ SIZFIL AND INTEGER SIZE ELEMENT IN X6 * * NROW BSS 1 NCOL BSS 1 ROW1 BSS 1 COL1 BSS 1 DIMEN BSS 1 SIZ BSS 1 ATEMP BSS 1 RCPCHK DATA 2000040001B SIGNED VFD 42/6LSIGNED,1/1,17/0 SPECIAL GETVAR FOR VFD 42/1LS,1/1,17/0 COMPSYM CHECK * * /--- BLOCK UNITS 00 000 76/07/21 20.54 TITLE READ-IN FOR -UNITS- COMMAND * * * * -UNSREAD- * READ-IN ROUTINE FOR -UNITS- COMMAND - ADDS TO THE * DEFINED NAME TABLE AND TO THE TOTAL UNITS COUNT * (DIMENSIONALITY COUNT) * * UNSRD SA1 DSET MUST HAVE DEFINE SET NG X1,NOSET SA1 WORDPT SA1 X1-1 BACK UP TO PREVIOUS CHARACTER SA2 X1+KEYTYPE SX1 X2-OPCOMMA SEE IF ENDED WITH COMMA NZ X1,BADFORM MX6 -1 SET MODE FOR -VSEEK- SEARCH SA6 VSKMODE SA6 ENDFLG MARK NOT END-OF-LINE YET * UNS100 CALL GETNAME,7 GET NAME OF NEXT *UNIT* ZR X6,NAMERR SA6 USNAM SX1 X2-OPCOMMA CHECK FOR COMMA ZR X1,UNS120 SX1 X2-EOL CHECK FOR END-OF-LINE NZ X1,BADFORM MX7 0 MARK END-OF-LINE ENCOUNTERED SA7 ENDFLG * UNS120 RJ =XVSEEK SEE IF ALREADY DEFINED SA1 ADTYPE PL X1,DUPNAM EXIT IF DUPLICATE NAME SA7 DEFNLOC SAVE ECS LOC TO INSERT NAME CALL SYMCHK,USNAM SA1 NDEFU GET NUMBER OF *UNITS* DEFINED SX6 X1-NUMAX SEE IF TOO MANY *UNITS* PL X6,UFULL SX6 X1+1 SA6 A1 SX4 8 8=SHORT FLOATING LITERAL LX4 XCODEAL BX4 X4+X1 X4=GETVAR CODE CALL ADDNAM,USNAM ADD TO DEFINE TABLES SA1 ENDFLG NZ X1,UNS100 CONTINUE IF NOT END-OF-LINE EQ ENDSEG * * ENDFLG BSS 1 * K60 DATA 60.0 KVERT DATA 0LVERTICAL KSIGN DATA 0LSIGNED KS DATA 0LS KE1 DATA 10LNO SET KE2 DATA 10LBAD NAME KE3 DATA 10LDUPLICATE KE4 DATA 10LBAD VAR KE5 DATA 10LBAD FORM KE6 DATA 10LBAD COUNT KE7 DATA 10LBAD SIZE KE8 DATA 10LARRAY TYPE KE9 DATA 10LMANY LITS KE10 DATA 10LMANY NAMES KE11 DATA 10LMANY UNITS KE12 DATA 10LNOT YET IN * * ENDOV * * OVTABLE * * END SEGMNT$