$JOB ASSIST REPTEST,REPL TITLE 'REPLACE MONITOR TEST DECK #1' * *** TESTS USAGE OF XREPL INSTRUCTION, CREATES MANY ERRORS. * ALSO SHOWS CALL OF NONEXISTENT ENTRYPOINT. BROPS2 CSECT RB EQU 8 REG RB ENTRY BRINIT,BRUSIN,BRDROP NOTE BRDISP IS MISSING * BRINIT FETCHES THE RFLAG AND DUMPS IT AND REGS. * IT ALSO ERASES REGS 12-13, AND SETS RFLAG SO THAT * REGS ARE ONLY PRINTED ON ERRORS. * BRUSIN FETCHES THE INSTRUCTION COUNTER, AND SETS THE RFLAG. * BRDROP SETS RB ALWAYS , THUS MAKING ERRORS SOME TIMES. * BRDISP IS MISSING, SO IT SHOULD ABEND FIRST TIME CALLD SPACE 1 BRINIT EQU * USING *,15 NOTE ENTRY USING XREPL RFLAG,1 FETCH THE RFLAG XDUMP RFLAG,2 DUMP IT TO SEE IF OK XDUMP , DUMP THE REGS TO SEE THEM SR 12,12 MESS UP 12 SR 13,13 MESS UP 13 TOO XREPL RFLAG2,0 SRT THE RLFAG, ALL OFF BR 14 RETURN BRUSIN EQU * USING *,15 NOTE ENTRY USING XREPL RFLAG,1 FETCH TO SEE IF BITS SET XDUMP RFLAG,2 DUMP IT TO SEE IF BITS SET XREPL ICOUNT,2 INSTRUCTION COUNT FECTH L 0,ICOUNT PUT INTO REG XDUMP , REGS XREPL RFLAG1,0 SET TO NEW VALUE, STMTS ONLY BR 14 RETURN, HAVING MESSD 0 SPACE 1 BRDROP EQU * USING *,15 NOTE ENTRY USING LA RB,4 SHOW ERROR BR 14 RETURN, OK ONLY IF BAD DROP DONE SPACE 1 RFLAG DC H'0' TO FETCH RFLAG HERE RFLAG1 DC H'1' ONLY PRINT STMT RFLAG2 DC H'0' ALL FLAGS OFF ICOUNT DC F'0' INSTRUCTION COUNTER END $ENTRY TITLE 'TEST DECK FOR REPLACEMENT OF BR- ' CSECT1 CSECT USING *,15 CALL TO USING USING *,14 ANOTHER CALL TO USING DROP 14 REMOVE USING-PRODUCE REPL ERR AR059 DROP 13 SHOULD BE OK REPL LA 0,CSECT1 SHOULD CALL BR - ZAP HIM LA 0,CSECT1 BRDISP SHOULD HAVE ABENDED LAST TIME DROP 15 END $JOB ASSIST REPTEST,REPL TITLE 'REPLACE TEST # 2 - CANNOT FIND CSECT NAME' * THIS SHOULD PRODUCE MESSAGE AR100 BROPS3 CSECT * WE HAVE MISPELLED BROPS2 BR 14 RETURN END $ENTRY EXECUTION SHOULD NO T BEGIN EVEN THOUGH THIS PRESENT. * FAKE DATA CARD -SHOULD NOT BE SEEN BY ASSEMBLER. $JOB ASSIST REPTEST,REPL TITLE 'REPLACE TEST # 3 - ABEND DURING EXECUTION' * *** SHOULD PRODUCE 224 COMPLETION CODE. BROPS2 CSECT ENTRY BRINIT,BRUSIN,BRDROP,BRDISP ALL ENTRIES BRINIT EQU * LA 15,20 SET UP FOR BAD BRANCH BR 15 BRANCH OUT OF PROGRAM BRUSIN EQU * DC H'0' ABEND NOW END , BRDROP,BRDISP UNDEFINED $ENTRY $JOB ASSIST REPTEST,REPL,NERR=1 TITLE 'REPLACE MONITOR TEST - CALLING ALLOWED' * *** REQUIRES REPLACEMENT OPTION 2 - WILL NOT RUN IF ONLY * REPLACEMENT OPTION 1 EXISTS. EVALUT CSECT EXTRN SDBCDX,SDDTRM MAKE EXTRN, SINCE ASSIST MODS RA EQU 7 RD EQU 10 RE EQU 11 * THIS ROUTINE WILL JUST CALL SDBCDX OR SDDTRM, THUS * ASSUMING THAT IT IS SCANNING A SELF-DEFINING TERM. * IT CLEARS REGS RD,RE FOR SDTERM, SO THAT THE ANSWER * WILL BE CORRECT IF ACTUALLY LOOKING AT SD TERM. USING *,15 ST 14,SAV14 SAVE THIS REG CLI 0(RA),C'0' WAS FIRST ONE A DIGIT BNL EVDIGIT YES, GO THERE L RE,=V(SDBCDX) OVERALL ENTRY CLC 0(3,RA),=C'X''F' SPECIAL-SCREW UP REGS BNE EVCALL NO, GO CALL SR RA,RA MESS THIS UP,ILLEGAL B EVCALL GO CALL EVDIGIT L RE,=V(SDDTRM) DECIMAL SELF DEF TERM EVCALL LR 15,RE MOVE OVER BALR 14,15 CALL ROUTINE USING *,14 NEW USING SR RD,RD CLEAR SR RE,RE CLEAR L 14,SAV14 RESOTER RETURN @ BR 14 RETURN SAV14 DS F DC V(SYFIND) NOT FLAGGED EXTRN, SHOULD BE UNRESV END $ENTRY TITLE 'TEST PROGRAM FOR EVALUT' START DC A(SYMBOL) WILL BE WRONG DC A(255) SHOULD WORK OK DC A(C'12345') SHOULD BE ERROR RETURN ALL OVER DC A(123456789123) ERROR RETURN DC A(X'F0') SHOUL PASS WRONG PARM TO SDBCDX SYMBOL EQU * DC A(0) NO MORE CALLS END $JOB ASSIST REPTEST,REPL TITLE 'REPLACE TEST - CHECK STORAGE PROTECTION' EVALUT CSECT STC 0,0(7) STORE AT SCAN PTR-SHOULD ABEND 0C4 BR 14 END $ENTRY TESTPROG CSECT DC A(X'FF') MAKE SURE EXPRESSION EVAL CALLED END $JOB ASSIST REPTEST,REPL TITLE 'REPLACE MONITOR TEST - CBCONS' CBCONS CSECT ENTRY CBCON1,CBCON2 OK * MODULE ACTS AS THOUGH ALL CONSTAS ARE B'1' USING *,15 CBCON1 LA 7,1(7) BUMP SCAN PTR SR 8,8 SHOW OK LA 9,1 SHOW LENGTH OF 1 BR 14 RETURN USING *,15 CBCON2 LA 7,1(7) BUMP SCAN PTR LA 9,=B'1' @ GOOD ONE BR 14 RET END $ENTRY TITLE 'TEST CBCON1 WITH REPLACE MONITOR' CBCOTEST CSECT DC B'1' COMPLETELY OK DC B'0' RIGHT SCAN, WRONG VALUE DC B'000000001' BAD SCAN PTR, LENGTH DC B'11' BAD SCAN PTR DC B'2' BAD CONST, NOT FLAGGED RIGHT DC B'012' BAD CONST, NOT FLAGGED DC B'01' BAD SCAN PTR, OK VALUE END $JOB ASSIST REPTEST,REPL TITLE 'REPLACE MONITOR TEST - CCCONS' CCCONS CSECT ENTRY CCCON1,CCCON2 * TREATS ALL CONSTANTS AS CL5'A' USING *,15 CCCON1 LA 7,1(7) SCAN PTR SR 8,8 SHOW OK LA 9,1 SHOW LENGTH WE CAN SEE BR 14 USING *,15 CCCON2 LA 7,1(7) SXAN PTR LA 9,=CL5'A' @ OK CONST BR 14 END $ENTRY TITLE 'TEST PROGRAM FOR REPLACE MONITOR CCCONS' CCCOTEST CSECT DC CL5'A' OK DC C'A ' GOO VALUE, LENGTH, BAD SCAN PTR DC C' ' BAD LENGTH,VALUE DC C'&' BAD CONST END $JOB ASSIST REPTEST,REPL TITLE 'REPLACE MONITRO CDECNS TEST' CDECNS CSECT ENTRY CDECN1,CDECN2 * MODULE ACTS AS THOUGH ALL ARE D'1.1' USING *,15 CDECN1 LA 7,3(7) SCAN PTR SR 8,8 SHOW OK BR 14 RETRN CDECN2 LA 7,3(7) SCAN PTR SR 8,8 SHOW OK LA 9,=D'1.1' @ CONST BR 14 RETURN END $ENTRY TITLE 'REPLACE MONITOR TEST PROGRAM - CDECNS' CDECTEST CSECT DC D'1.1' OK DC D'01.1' GOOD VALUE, BAD SCAN PTR DC D'1.0' GOOD SCAN PTR, BAD L VALUE DC D'1.1 ' BAD CONSTANT END $JOB ASSIST REPTEST,REPL TITLE 'REPLACE MONTOR TEST - CFHCNS' CFHCNS CSECT ENTRY CFHCN1,CFHCN2 * ALL ACT AS THOUGH CONST IS F'3' USING *,15 CFHCN1 LA 7,1(7) SCAN PTR SR 8,8 BR 14 RETURN USING *,15 CFHCN2 LA 7,1(7) SCAN PTR SR 8,8 SHOW GOOD LA 9,=F'3' GOOD S CONST END $ENTRY TITLE 'REPLACE MONITOR TEST - CFHCNS' CFHCTEST CSECT DC F'3' OK DC F'1' GOOD SCAN, BAD VALUE DC F'01' GOOD VALUE, BAD SCAN DC F' BAD CONST, WON'T FLAG RIGHT END $JOB ASSIST REPTEST,REPL TITLE 'REPLACE MONITOR TEST - OPCOD1' OPCOD1 CSECT * ANY OPCODE BEGINNING WITH A IS TREATED AS 'A'. * ALL OTHERS ARE TREATED A BAD. ENTRY OPINIT,OPFIND OPINIT BR 14 OK USING *,15 OPFIND CLI 0(7),C'A' WE EXPECT ADD BE FOUND YES GO THER CLI 0(7),C'C' WAS IT C BE FOUND YES, BRANCH, WILL SHOW WORNG LA 8,X'32' SHPW $ERIVOPC FLAG BR 14 RETURN, LEAVING SCAN PTR FOUND LA 7,1(7) SCA NPTR SR 8,8 SHOW GOOD LA 9,A-3 @ FAKE OPCODTB BR 14 RETN A DC C'A' FAKE OPCODTB END $ENTRY TITLE 'TESRT REPL MONITOR WITH OPCOD1' OPCOTEST CSECT A 0,0(1) OK B 0,0(1) WILL FLAG WRONG, ISN'T C 0,0(1) WILL SHOW WRONG SYMBOL IN TA LE AR 0,0 WILL NOT HAVE RIGHT SCAN PTR,OPCDE ST 0,0(1) NOT RIGHT Z 0(0(1) WILL FLAG, CORRECTLY $JOB ASSIST REPTEST,REPL TITLE 'REPLACE MONITOR - SYMOPS TEST' * *** THIS PROGRAM ASSEMBLES CORRECTLY, HAS SYEND2 FLAGGED WITH * MESSAGE AR002, THEN HANDLES A NUMBER OF CALLS UNTIL SYEND2 * IS CALLED, AT WHICH TIME IT STOPS WITH MESSAGE AR101. SYMOPS CSECT ENTRY SYINT1,SYENT1,SYFIND NOTE SYEND2 MISSING SYINT1 BR 14 RETUNR * ANY SYMBOL BEGINNING WITH A IS TREATED AS A, IN TABLE * ANY ONE STARTING WITH B IS TREATED AS B, NEWLY ENTERED * ANY OTHER -NOT IN TABLE USING *,15 SYENT1 EQU * SYFIND CLI 0(7),C'A' DOES IT BEGIN WITH A BE SYMA YES, GO THER CLI 0(7),C'B' BEGIN WITH B BE SYMB YES, GO THER * TREAT AS NOT IN TABLE LA 8,4 SHOW NOT THER BR 14 RETNR SYMA LA 7,A-12 SHOW A FAKE BLOCK SR 8,8 IN TABLE ALREADY BR 14 RETURN SYMB LA 8,4 SHOW NOT INTABLE LA 7,B-12 SHOW @ BR 14 RETUNR A DC C'A' B DC C'B' END $ENTRY A LA 0,A WRONG FIRST TIME, OK NEXT B LA 0,B RIGHT FIRST, WRONG SECOND AA LA 0,AA WRONG ALWAYS BB LA 0,BB WRONG ALWAYS C LA 0,C LABEL OK, WRONG VALE, CALL WRONG LA 0,D NOT IN TABLE, OK FLAGGED RIGHT END $JOB ASSIST REPTEST,REPL * TEST DECK FROM CMPSC 411, SPRING 1971. * *** SAMPLE PROGRAM - 2ND ASSEMBLER COURSE - 123 STMTS, * ABOUT 3 PAGES OF OUTPUT , SHOWING NO DEBUGGING CODE, SINCE * THIS IS A FINAL VERSION OF PROGRAM. BROPS2 CSECT ENTRY BRINIT,BRUSIN,BRDROP,BRDISP RA EQU 7 RB EQU 8 RC EQU 9 RD EQU 10 RE EQU 11 SPACE 3 * THIS ROUTINE REPLACES THE BASE REGISTER ROUTINE CURRENTLY * EMPLOYED BY THE ASSIST PACKAGE. 'TABLE' IS USED TO STORE * SECTION ID'S AND THE CONTENTS OF THE BASE REGISTERS. IF A REGISTER * IS BEING USED AS A BASE REGISTER, THE ID FIELD CONTAINS THE * CSECT'S OR DSECT'S ID. OTHERWISE THE ID FIELD IS ZERO. THE TABLE * WAS CHOOSEN AS COMPOSED ONLY OF FULL WORDS TO INCREASE THE SPEED * OF EXECUTION. THE ADDITIONAL SPACE REQUIRED WAS 48 BYTES. HOWEVER, * THIS ADDITION TO THE SPACE REQUIRED ALLOWED A REDUCTION IN THE * TIME FOR INSERTING THE ADDRESS TO WHICH A REGISTER IS POINTING * AND THE ID OF THE SECTION BY ABOUT 11.45 MICROSECONDS. AN EQUIVALENT * AMOUNT OF TIME IS SAVED IN REMOVING THE SAME INFORMATIO FOR * COMPUTING DISPLACEMENTS SPACE 3 * BRINIT FROM THIS ENTRY POINT ALL INITILIZATION TAKES PLACE SPACE 1 BRINIT B 12(,15) DC X'07' DC CL7'BRINIT ' USING BRINIT,15 MVI TABLE,X'00' INSERT ZERO MVC TABLE+1(127),TABLE FILL WITH ZEROS SPM 14 BR 14 SPACE 3 * BRUSIN THIS ENTRY IS CALLED WHENEVER A USING IS FOUND AND DECODED * TO NOTE THAT A GIVEN REGISTER CAN BE USED WITH A GIVEN ADDRESS * AND ID SPACE 1 BRUSIN B 12(,15) DC X'07' DC CL7'BRUSIN ' USING BRUSIN,15 SLL RA,3 MULTIPLY BY 8 (8 BYTES/ENTRY) A RA,ADDR COMPUTE TABLE ENTRY ADDRESS USING FORM,RA DECLARE DSECT BASE REGISTER ST RC,ID STORE ID ST RB,ADDRESS ADDRESS CONTAINED BY BASE REG SPM 14 RESET CC BR 14 SPACE 3 * BRDROP HANDLES DROPS SPACE 1 BRDROP B 12(,15) DC X'07' DC CL7'BRDROP ' USING BRDROP,15 BASE REG SLL RA,3 MULT BY 8 (8BYTES/ENTRY) A RA,ADDR GET ENTRY ADDRESS USING FORM,RA DSECT BASE REG L RE,ID GET ID FOR 'ACTIVE' TEST LTR RE,RE TEST FOR ID=0;=> REG WAS NOT ACTIVE BP NEXT LA RB,255 SET FLAG => REG WAS NOT ACTIVE B LEAVE NEXT SR RB,RB ZERO FLAG => REG WAS ACTIVE ST RB,ID SET ID=0=>NOW UNASSIGNED LEAVE SPM 14 BR 14 SPACE 3 * BRDISP THIS ENTRY IS CALLED WHENEVER AN ADDRESS MUST BE CONVERTED TO * BASE - DISPLACEMENT FORM * FLAG=N =>HAVE NOT YET COMPUTED A DISP< 4096; FLAG=Y => HAVE COAMPUTE * A DISP < 4096 SPACE 1 BRDISP B 12(,15) DC X'07' DC CL7'BRDISP ' USING BRDISP,15 LA RE,128 SLL RE,5 PUT 4096 IN "SMALLEST" ST RE,SMALLEST MVI FLAG,C'N' INITIALIZE FLAG => NO DISP<4096 YET LA RD,15 INITIALIZE REG # RECORDER LA RC,120 A RC,ADDR SET POINTER TO LAST MEMBER OF TABLE USING FORM,RC BASE REG FOR DSECT AGAIN LR RE,RA SAVE ADDRESS PASSED C RB,ID FROM SAME SECTION? BNE UPDATE BRANCH IF NOT A POSSIBLE BASE REG S RE,ADDRESS FIND DISPLACEMENT LTR RE,RE BM UPDATE ENSURE DISP IS POSITIVE C RE,SMALLEST SMALLER DISPLACEMENT? BNL UPDATE BRANCH IF SMALLEST<= LATEST DISP ST RE,SMALLEST STORE NEWEST DISP STC RD,REGNO STORE REG# MVI FLAG,C'Y' INDICATE INITIAL VALUE CHANGED UPDATE BCTR RD,0 DECREMENT REG# RECORDER S RC,EIGHT POINT TO NEXT LOWER REG# LTR RD,RD TOP OF TABLE? BNM AGAIN IF NOT, GO TO NEXT ENTRY CLI FLAG,C'Y' FINISHED TABLE-COMPUTED DISP<4096? BNE BADOUT BRANCH IF NO DISP<4096 SR RB,RB SET FLAG => CONVERSION WAS OK L RA,SMALLEST LOAD DISP FOR TRANSFER SR RC,RC IC RC,REGNO PICK UP REG NUMB SLL RC,12 PUT IN PROPER COLUMNS OR RA,RC PUT BASE IN WITH DISP IN REG RA BADOUT SPM 14 BR 14 SPACE 3 ADDR DC A(TABLE) EIGHT DC F'8' SMALLEST DS F TABLE DS 128C FLAG DS C REGNO DS C LTORG SPACE 3 FORM DSECT ID DS F ADDRESS DS F END $ENTRY TITLE 'ASSIST BASE REGISTER/USING/DROP TEST PROGRAM' TEST CSECT BALR 12,0 USING *,12 T1 L 0,AA5 L 5,AA4 USING AA5,9 ST 3,AA5 USING AA5,10 A 2,AA5 USING AA4,10 SL 3,AA5 ST 3,AA4 DROP 10 USING DSECT1,7 STH 4,DS1 LH 5,DS6 DROP 8,10 CVB 6,DS8 USING DSECT1,9 CVD 6,DS8 USING DSECT2,10 M 8,DS4 LA 5,CARD D 8,DS5 DROP 10 B T1 IC 10,DS2A LA 11,OUTR USING *,13 ST 5,AA4 AA4 DS F DS 1500F OUTR DS C AA5 DS F DSECT1 DSECT DS1 DS H DS2 DS HL8 DS4 DS A DS8 DS D DSECT2 DSECT CARD DS CL80 DS2A DS P BASE CSECT USING *,13,14,15 DROP 8,12 AH 6,DS1 AH 4,AA6 L 5,AA5 DROP 7,9,10 DROP 13,14,15 AA6 DS H END $JOB ASSIST REPTEST,REPL TITLE 'BASE REGISTER PROBLEM - CHUCK PFLEEGER' * *** SAMPLE PROGRAM - 2ND ASSEMBLER-LEVEL COURSE - * 206 STMTS, WITH NO ERRORS IN PROGRAM. * TEST DECK FROM CMPSC 411, SPRING 1971. *** *** *** *********************************************************** *** *** *** *** CHUCK PFLEEGER - BASE REGISTER PROBLEM *** *** *** *** COMPSC - 411 - MAY 5, 1971 *** *** *** *** SYMBOLS: *** *** A,B,C,D - SYMBOLIC REGISTERS 7,8,9, AND 10 *** *** DSBASE - REG. 11 - USED FOR BASE REG. IN DSECT *** *** HEADLINK - LAVSLINK - LINKS TO THE HEADS OF *** *** THE ACTIVE BASE REGISTER LIST, AND THE *** *** AVAILABLE SPACE LIST. A ZERO IN EITHER OF *** *** THESE INDICATES THE NULL LIST. THEY AND THE *** *** LINKS ARE ARRANGED FROM A DISPLACEMENT OF 2 TO *** *** A DISPLACEMENT OF 122 FROM THE POINT BRTAB, *** *** WHICH IS TWO BYTES BEFORE THE START OF THE *** *** BASE REGISTER TABLE. *** *** ID IS THE PORTION OF A NODE FOR SECTION ID *** *** RNO IS THE PORTION OF A NODE FOR REGISTER NO. *** *** LINK IS THE LOCATION IN THE NODE FOR THE LINK TO *** *** THE NEXT CELL (RELATIVE TO BRTAB) *** *** ADDR IS THE PORTION OF A NODE FOR THE ADDRESS *** *** IN A BASE REGISTER. *** *** NEWID IS THE NEW SECTION ID TO INSERT *** *** NEWNO IS THE NEW REGISTER NO TO ALLOCATE *** *** NEWLINK IS THE LINK OF THIS NEW CELL *** *** NEWADDR IS THE ADDRESS CURRENTLY BEING HANDLED. *** *** *** *** *********************************************************** *** SPACE 4 BROPS2 CSECT ENTRY BRINIT,BRUSIN,BRDROP,BRDISP A EQU 7 B EQU 8 C EQU 9 D EQU 10 DSBASE EQU 11 BASE REG. FOR DSECT SPACE 4 *** BRINIT - INITIALIZE CONSTANT AREAS *** *** *** BRINIT EQU * USING *,15 USING BRDSCT,DSBASE LA D,15 SET UP FOR BCT LA C,2 DITTO STH C,LAVSLINK LINK TO TOP OF LAVS LA DSBASE,BRTAB+2 LOC OF FIRST CELL *** SET UP LINKS WITHIN CELLS. *** INITLOOP LA C,8(C) LINK FOR NEXT CELL STH C,LINK INSERT LINK LA DSBASE,8(DSBASE) MOVE TO NEXT CELL BCT 10,INITLOOP BRANCH TO INITIALIZE ALL *** SET UP PROPER HEAD AND END POINTERS. *** SR C,C STH C,HEADLINK GROUND ACTIVE LIST STH C,LINK GROUND BOTTOM OF LAVS BR 14 RETURN SPACE 4 *** BRUSIN - PROCESS USINGS *** *** *** BRUSIN EQU * USING *,15 STC A,NEWNO INSERT NEW REG, NO *** FIRST BEGIN CELL WITH ID, RNO, AND ADDR FIELDS *** ST B,NEWADDR INSERT NEW B/REG CONTENTS STC C,NEWID INSERT NEW ID LH DSBASE,HEADLINK LTR DSBASE,DSBASE LIST EMPTY? BZ INSERT NO ENTRY FOUND LA DSBASE,BRTAB(DSBASE) START OF LIST *** BEGIN SEARCH FOR THIS REGISTER ALREADY IN USE *** USINLOOP CLC NEWNO,RNO COMPARE REG. NOS. BZ REPLACE SAME REGISTER ALREADY IN USE LH D,LINK LINK TO NEXT CELL LTR D,D LAST CELL? BZ INSERT REGISTER NOT NOW IN LIST LA DSBASE,BRTAB(D) LINK TO NEXT CELL B USINLOOP *** IF REGISTER IS NOW ACTIVE, MERELY INSERT THE SAME LINK *** *** IN A NEW CELL. *** REPLACE MVC NEWLINK,LINK INSERT PROPER LINK B LAST MOVE IN NEW CELL *** IF REGISTER IS NOT ACTIVE, INSERT A CELL FROM LAVS. *** INSERT LH D,LAVSLINK PTR. TO LAVS LA DSBASE,BRTAB(D) GET NEXT AVAILABLE CELL LH C,LINK RETAIN PREVIOUS LINK STH C,LAVSLINK NEW LAVS POINTER LH B,HEADLINK OLD HEADER IS NEW LINK TO NEXT CELL STH B,NEWLINK STH D,HEADLINK POINTER HEADER AT FIST CELL *** MOVE THE TEMPORARY CELL INTO ITS PROPER LOCATION. *** LAST LM A,B,NEWID GET NEW INFO NODE STM A,B,ID PUT AT NEXT AVAILABLE LOCATION BR 14 RETURN SPACE 4 *** BRDROP - HANDLE DROP STATEMENTS *** *** *** BRDROP EQU * USING *,15 STC A,NEWNO INSERT REG. NO DROPPING LH DSBASE,HEADLINK TOP OF LIST LTR DSBASE,DSBASE LIST EMPTY BZ RETBAD IF EMPTY, RETURN CODE=BAD LA DSBASE,BRTAB(DSBASE) GET START OF LIST LA D,HEADLINK-2 TO PLACE HEAD PTR PROPERLY IF SINGLE LIS\ *** CHECK FOR THE OCCURANCE OF THIS REGISTER NO. *** DROPLOOP CLC NEWNO,RNO CHECK REG. NOS. BZ FOUND PROPER REG. FOUND LH C,LINK IF NO, GET LINK TO NEXT CELL LTR C,C LIST EMPTY? BZ RETBAD REGISTER NOT IN LIST LR D,DSBASE BACK POINTER LA DSBASE,BRTAB(C) LINK TO NEXT CELL B DROPLOOP GET NEXT CELL *** IF FOUND, DELETE ITS ENTRY AND RETURN TO LAVS. *** FOUND LH B,2(D) GET PREVIOUS LINK LH C,LINK GET CURRENT LINK STH C,2(D) LINK AROUND THIS CELL LH A,LAVSLINK SAVE PREVIOUS LAVS LINK STH A,LINK POINT TO TOP OF LAVS STH B,LAVSLINK UPDATE TOP OF LAVS SR B,B GOOD RETURN BR 14 *** IF NOT FOUND, RETURN ERROR CODE. *** RETBAD LR B,14 BAD RETURN BR 14 RETURN SPACE 4 *** BRDISP - CALCULATE DISPLACEMENTS *** *** *** BRDISP EQU * USING *,15 STC B,NEWID INSERT NEW ID *** SEEK ADDRESS <= 4095 WITH AVAILABLE REGISTER *** LA D,4095 ADDRESS TO COMPARE AGAINST MVI NEWNO,X'00' CLEAR FOR NEW REG. NO LH DSBASE,HEADLINK TOP OF LIST LTR DSBASE,DSBASE BZ BADDISP LIST EMPTY LA DSBASE,BRTAB(DSBASE) GO T O TOP OF LIST *** CHECK SECTION ID FIRST *** DISPLOOP CLC NEWID,ID CHECK FOR SAME SECTION ID BNZ ADVPNT ADVANCE IF NOT EQUAL *** IF SECTION IDS AGREE, CALCULATE DISPLACEMENT *** LR C,A GET ABSOLUTE ADDR S C,ADDR SUBTRACT BASE ADDR BM ADVPNT BRANCH IF NOT + DISPLACEMENT SR B,B *** SET UP TO COMPARE REGISTER NOS. IF NECESSARY *** IC B,RNO PICK UP REG. NO LA B,1(B) INCREASE REGISTER NO. CR D,C CHECK IF DISPLACEMENT WAS BETTER *** COMPARE DISPLACEMENTS. IF OLD HIGH SWITCH; NEW HIGH SKIP *** BH SWITCH SWITCH IF BETTER BL ADVPNT GET NEXT CELL IF WORSE *** IF DISPLACEMENTS EQUAL, COMPARE REGISTER NUMBERS. *** EX B,CLI COMPARE NUMBERS BNL ADVPNT GET NEW CELL IF NOT HIGHER NO. SWITCH STC B,NEWNO STORE NEW REG. NO LR D,C SHOW NEW DISPLACEMENT ADVPNT LH B,LINK GO TO NEXT NODE LTR B,B CHECK IF END BZ DONEDISP END OF LIST LA DSBASE,BRTAB(B) LINK TO NEXT CELL B DISPLOOP *** CHECK IF ANY REGISTER HAD VALID DISPLACEMENT *** DONEDISP CLI NEWNO,X'00' NO REG FOUND? BZ BADDISP RETURN=BAD *** FORM PROPER BASE DISPLACEMENT REFERENCE IN 16-31 *** SLL D,4 SHIFT FOR PROPER ALIGNMENT ST D,NEWADDR BEST DISPLACEMENT SR B,B IC B,NEWNO PICK UP REG. NO BCTR B,0 MOBE REG. NO DOWN AGAIN STC B,NEWADDR+1 PUT INTO BASE/DISP EXPR. L A,NEWADDR PICK UP BASE/DISP FORM SRL A,4 SHIFT TO ALIGN AGAIN SR B,B RETURN CODE GOOD BR 14 BADDISP LR 8,14 RETURN BAD BR 14 RETURN SPACE 4 *** DC AREA *** *** *** CLI CLI NEWNO,X'00' EXECUTED CLI INSTR. CO COMPARE REG. NOS. DS 0F BRTAB EQU *-2 DS 32F LINKED LIST OF BASE REGS NEWID DS C NEW SECTIO ID TO INSERT NEWNO DS C NEW REG NO. NEWLINK DS H LINK FOR NEXT CELL NEWADDR DS F NEW BASE REG. CONTENTS HEADLINK DS H LINK AT TOP OF LIST (BACK POINTER) LAVSLINK DS H POINTER TO FIRST AVAILABLE CEEL SPACE 4 *** BRDSCT - BASE REGISTER LIST TEMPLATE *** *** *** BRDSCT DSECT * DSECT TO FLOAT OVER LINKED LIST ID DS C SECTION ID. RNO DS C REGISTER NO LINK DS H LINK TO NEXT CELL ADDR DS F CONTENTS OF BASE REG. END $ENTRY TITLE 'ASSIST BASE REGISTER/USING/DROP TEST PROGRAM' TEST CSECT BALR 12,0 USING *,12 T1 L 0,AA5 L 5,AA4 USING AA5,9 ST 3,AA5 USING AA5,10 A 2,AA5 USING AA4,10 SL 3,AA5 ST 3,AA4 DROP 10 USING DSECT1,7 STH 4,DS1 LH 5,DS6 DROP 8,10 CVB 6,DS8 USING DSECT1,9 CVD 6,DS8 USING DSECT2,10 M 8,DS4 LA 5,CARD D 8,DS5 DROP 10 B T1 IC 10,DS2A LA 11,OUTR USING *,13 ST 5,AA4 AA4 DS F DS 1500F OUTR DS C AA5 DS F DSECT1 DSECT DS1 DS H DS2 DS HL8 DS4 DS A DS8 DS D DSECT2 DSECT CARD DS CL80 DS2A DS P BASE CSECT USING *,13,14,15 DROP 8,12 AH 6,DS1 AH 4,AA6 L 5,AA5 DROP 7,9,10 DROP 13,14,15 AA6 DS H END